C TCUB8A SOURCE CHAT 05/01/13 03:35:30 5004 SUBROUTINE TCUB8A(POINTS,QSIGAU,ETAGAU,DZEGAU,POIGAU,SHPTOT) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) ************************************************************************ * * T C U B 8 A * ----------- * * FONCTION: ON ACQUIERT: * --------- - LES COORDONNEES INTRINSEQUES * - LES FONCTIONS DE FORME ET LEURS DERIVEES * POUR L'ELEMENT DE THERMIQUE CUB8. * * MODULES UTILISES: * ----------------- * -INC CCOPTIO * * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) * ----------- * * POINTS (E) CHAINE DE CARACTERES: * 'NOEUDS' SI ON VEUT LES VALEURS AUX NOEUDS * 'GAUSS' POUR LES VALEURS AUX POINTS DE GAUSS. * QSIGAU (S) | * ETAGAU (S) | COORDONNEES INTRINSEQUES. * DZEGAU (S) | * POIGAU (S) POIDS D'INTEGRATION,SI ON A 'GAUSS'. * SHPTOT (S) FONCTIONS DE FORME ET LEURS DERIVEES. * REAL*8 QSIGAU(8),ETAGAU(8),DZEGAU(8),POIGAU(8) REAL*8 SHPTOT(6,8,8) CHARACTER*(*) POINTS * * CONSTANTES: * ----------- * * PARAMETER ( X=0.577350269289626D0 ) PARAMETER ( O1=1.D0 ) PARAMETER ( O125=0.125D0 ) * * * AUTEUR, DATE DE CREATION: * ------------------------- * * J-P.SAUSSAIS OCT.77,REPRIS PAR DENIS ROBERT,LE 23 OCTOBRE 1987. * * LANGAGE: * -------- * * FORTRAN77 * ************************************************************************ * IF (POINTS(1:5).EQ.'NOEUD') GOTO 66 IF (POINTS(1:5).NE.'GAUSS') GOTO 200 * * COORDONNEES DES 8 POINTS DE GAUSS * NBPGAU=8 NBNO=8 QSIGAU(1)=-X ETAGAU(1)=-X DZEGAU(1)=-X QSIGAU(2)=X ETAGAU(2)=-X DZEGAU(2)=-X QSIGAU(3)=X ETAGAU(3)=X DZEGAU(3)=-X QSIGAU(4)=-X ETAGAU(4)=X DZEGAU(4)=-X QSIGAU(5)=-X ETAGAU(5)=-X DZEGAU(5)=X QSIGAU(6)=X ETAGAU(6)=-X DZEGAU(6)=X QSIGAU(7)=X ETAGAU(7)=X DZEGAU(7)=X QSIGAU(8)=-X ETAGAU(8)=X DZEGAU(8)=X * * POIDS * DO 10 I=1,NBPGAU POIGAU(I)=O1 10 CONTINUE GOTO 2 * * COORDONNEES INTRINSEQUES DES NOEUDS * 66 CONTINUE NBNO=8 NBPGAU=NBNO QSIGAU(1)=-O1 ETAGAU(1)=-O1 DZEGAU(1)=-O1 QSIGAU(2)=O1 ETAGAU(2)=-O1 DZEGAU(2)=-O1 QSIGAU(3)=O1 ETAGAU(3)=O1 DZEGAU(3)=-O1 QSIGAU(4)=-O1 ETAGAU(4)=O1 DZEGAU(4)=-O1 QSIGAU(5)=-O1 ETAGAU(5)=-O1 DZEGAU(5)=O1 QSIGAU(6)=O1 ETAGAU(6)=-O1 DZEGAU(6)=O1 QSIGAU(7)=O1 ETAGAU(7)=O1 DZEGAU(7)=O1 QSIGAU(8)=-O1 ETAGAU(8)=O1 DZEGAU(8)=O1 * * FONCTIONS DE FORME ET LEURS DERIVEES * 2 DO 20 I=1,NBPGAU XI=QSIGAU(I) YI=ETAGAU(I) ZI=DZEGAU(I) SHPTOT(1,1,I)=O125*(O1-XI)*(O1-YI)*(O1-ZI) SHPTOT(1,2,I)=O125*(O1+XI)*(O1-YI)*(O1-ZI) SHPTOT(1,3,I)=O125*(O1+XI)*(O1+YI)*(O1-ZI) SHPTOT(1,4,I)=O125*(O1-XI)*(O1+YI)*(O1-ZI) SHPTOT(1,5,I)=O125*(O1-XI)*(O1-YI)*(O1+ZI) SHPTOT(1,6,I)=O125*(O1+XI)*(O1-YI)*(O1+ZI) SHPTOT(1,7,I)=O125*(O1+XI)*(O1+YI)*(O1+ZI) SHPTOT(1,8,I)=O125*(O1-XI)*(O1+YI)*(O1+ZI) C SHPTOT(2,1,I)=-O125*(O1-YI)*(O1-ZI) SHPTOT(2,2,I)=O125*(O1-YI)*(O1-ZI) SHPTOT(2,3,I)=O125*(O1+YI)*(O1-ZI) SHPTOT(2,4,I)=-O125*(O1+YI)*(O1-ZI) SHPTOT(2,5,I)=-O125*(O1-YI)*(O1+ZI) SHPTOT(2,6,I)=O125*(O1-YI)*(O1+ZI) SHPTOT(2,7,I)=O125*(O1+YI)*(O1+ZI) SHPTOT(2,8,I)=-O125*(O1+YI)*(O1+ZI) C SHPTOT(3,1,I)=-O125*(O1-XI)*(O1-ZI) SHPTOT(3,2,I)=-O125*(O1+XI)*(O1-ZI) SHPTOT(3,3,I)=O125*(O1+XI)*(O1-ZI) SHPTOT(3,4,I)=O125*(O1-XI)*(O1-ZI) SHPTOT(3,5,I)=-O125*(O1-XI)*(O1+ZI) SHPTOT(3,6,I)=-O125*(O1+XI)*(O1+ZI) SHPTOT(3,7,I)=O125*(O1+XI)*(O1+ZI) SHPTOT(3,8,I)=O125*(O1-XI)*(O1+ZI) C SHPTOT(4,1,I)=-O125*(O1-XI)*(O1-YI) SHPTOT(4,2,I)=-O125*(O1+XI)*(O1-YI) SHPTOT(4,3,I)=-O125*(O1+XI)*(O1+YI) SHPTOT(4,4,I)=-O125*(O1-XI)*(O1+YI) SHPTOT(4,5,I)=O125*(O1-XI)*(O1-YI) SHPTOT(4,6,I)=O125*(O1+XI)*(O1-YI) SHPTOT(4,7,I)=O125*(O1+XI)*(O1+YI) SHPTOT(4,8,I)=O125*(O1-XI)*(O1+YI) 20 CONTINUE RETURN 200 CONTINUE CALL ERREUR(19) * END