1 : C TPYR5A SOURCE CHAT 05/01/13 03:43:47 5004 2 : SUBROUTINE TPYR5A(POINTS,QSIGAU,ETAGAU,DZEGAU,POIGAU,SHPTOT) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : ************************************************************************ 6 : * 7 : * T P Y R 5 A 8 : * ----------- 9 : * 10 : * FONCTION: ON ACQUIERT: 11 : * --------- - LES COORDONNEES INTRINSEQUES 12 : * - LES FONCTIONS DE FORME ET LEURS DERIVEES 13 : * POUR L'ELEMENT DE THERMIQUE PYR5 14 : * 15 : * MODULES UTILISES: 16 : * ----------------- 17 : * 18 : -INC CCOPTIO 19 : * 20 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 21 : * ----------- 22 : * 23 : * POINTS (E) CHAINE DE CARACTERES: 24 : * 'NOEUDS' SI ON VEUT LES VALEURS AUX NOEUDS 25 : * 'GAUSS' POUR LES VALEURS AUX POINTS DE GAUSS. 26 : * QSIGAU (S) | 27 : * ETAGAU (S) | COORDONNEES INTRINSEQUES 28 : * DZEGAU (S) | 29 : * POIGAU (S) POIDS D'INTEGRATION 30 : * SHPTOT (S) FOCTIONS DE FORME ET LEURS DERIVEES. 31 : * 32 : REAL*8 QSIGAU(5),ETAGAU(5),DZEGAU(5),POIGAU(5) 33 : REAL*8 SHPTOT(6,5,5) 34 : CHARACTER*(*) POINTS 35 : * 36 : * CONSTANTES: 37 : * ----------- 38 : * 39 : * 40 : PARAMETER ( O0=0.D0 ) 41 : PARAMETER ( O1=1.D0 ) 42 : PARAMETER ( O5=0.5D0 ) 43 : PARAMETER ( POI1=0.1333333333333333D0 ) 44 : PARAMETER ( POI2=0.1333333333333333D0 ) 45 : PARAMETER ( H1=0.1531754163448146D0 ) 46 : PARAMETER ( H2=0.6372983346207416D0 ) 47 : PARAMETER ( O215=2.D0/15.D0 ) 48 : PARAMETER ( O4=4.D0 ) 49 : 50 : 51 : * 52 : * AUTEUR, DATE DE CREATION: 53 : * ------------------------- 54 : * 55 : * SOURCE A1,REPRIS PAR DENIS ROBERT,LE 29 OCTOBRE 1987 56 : * 57 : * LANGAGE: 58 : * -------- 59 : * 60 : * FORTRAN77 61 : * 62 : ************************************************************************ 63 : * 64 : IF (POINTS(1:5).EQ.'NOEUD') GOTO 66 65 : IF (POINTS(1:5).NE.'GAUSS') GOTO 100 66 : * 67 : * COORDONNEES DES 5 POINTS DE GAUSS 68 : * 69 : NBPGAU=5 70 : NBNO=5 71 : QSIGAU(1)= O5 72 : QSIGAU(2)= O0 73 : QSIGAU(3)=-O5 74 : QSIGAU(4)= O0 75 : QSIGAU(5)= O0 76 : ETAGAU(1)= O0 77 : ETAGAU(2)= O5 78 : ETAGAU(3)= O0 79 : ETAGAU(4)=-O5 80 : ETAGAU(5)= O0 81 : DO 251 IA=1,4 82 : DZEGAU(IA)= H1 83 : POIGAU(IA)= POI1 84 : 251 CONTINUE 85 : DZEGAU(5)= H2 86 : POIGAU(5)= POI2 87 : GOTO 2 88 : * 89 : * COORDONNEES DES NOEUDS 90 : * 91 : 66 CONTINUE 92 : NBNO=5 93 : NBPGAU=5 94 : QSIGAU(1)= O1 95 : QSIGAU(2)= O0 96 : QSIGAU(3)=-O1 97 : QSIGAU(4)= O0 98 : ETAGAU(1)= O0 99 : ETAGAU(2)= O1 100 : ETAGAU(3)= O0 101 : ETAGAU(4)=-O1 102 : DZEGAU(5)= O1 103 : DO 261 IA=1,5 104 : POIGAU(IA)=O215 105 : 261 CONTINUE 106 : * 107 : * FONCTIONS DE FORME ET LEURS DERIVEES 108 : * 109 : 2 DO 1 I=1,NBPGAU 110 : DZEM =O1-DZEGAU(I) 111 : DZEM4=(O1-DZEGAU(I))*O4 112 : AUX0 = QSIGAU(I)+ETAGAU(I)+DZEGAU(I)-O1 113 : AUX01=-QSIGAU(I)+ETAGAU(I)+DZEGAU(I)-O1 114 : AUX02=-QSIGAU(I)-ETAGAU(I)+DZEGAU(I)-O1 115 : AUX03= QSIGAU(I)-ETAGAU(I)+DZEGAU(I)-O1 116 : * 117 : IF(ABS(DZEGAU(I)-O1).LT.1.D-6) THEN 118 : DO 271 IB=1,5 119 : DO 271 IA=1,3 120 : SHPTOT(IA,IB,I)= O0 121 : 271 CONTINUE 122 : SHPTOT(1,5,I)= O1 123 : SHPTOT(2,1,I)= O5 124 : SHPTOT(2,3,I)=-O5 125 : SHPTOT(3,2,I)= O5 126 : SHPTOT(3,4,I)=-O5 127 : DO 252 IA=1,4 128 : SHPTOT(4,IA,I)=-O5 129 : 252 CONTINUE 130 : SHPTOT(4,5,I)= O1 131 : GOTO 1 132 : ENDIF 133 : * 134 : SHPTOT(1,1,I)=AUX01*AUX02/DZEM4 135 : SHPTOT(1,2,I)=AUX02*AUX03/DZEM4 136 : SHPTOT(1,3,I)=AUX0 *AUX03/DZEM4 137 : SHPTOT(1,4,I)=AUX0 *AUX01/DZEM4 138 : SHPTOT(1,5,I)=DZEGAU(I) 139 : SHPTOT(2,1,I)=(-AUX01-AUX02)/DZEM4 140 : SHPTOT(2,2,I)=( AUX02-AUX03)/DZEM4 141 : SHPTOT(2,3,I)=( AUX0 +AUX03)/DZEM4 142 : SHPTOT(2,4,I)=( AUX01-AUX0 )/DZEM4 143 : SHPTOT(2,5,I)=O0 144 : SHPTOT(3,1,I)=( AUX02-AUX01)/DZEM4 145 : SHPTOT(3,2,I)=(-AUX02-AUX03)/DZEM4 146 : SHPTOT(3,3,I)=( AUX03-AUX0 )/DZEM4 147 : SHPTOT(3,4,I)=( AUX0 +AUX01)/DZEM4 148 : SHPTOT(3,5,I)=O0 149 : SHPTOT(4,1,I)=(AUX01+AUX02+AUX01*AUX02/DZEM)/DZEM4 150 : SHPTOT(4,2,I)=(AUX02+AUX03+AUX02*AUX03/DZEM)/DZEM4 151 : SHPTOT(4,3,I)=(AUX03+AUX0 +AUX03*AUX0 /DZEM)/DZEM4 152 : SHPTOT(4,4,I)=( AUX0+AUX01+ AUX0*AUX01/DZEM)/DZEM4 153 : SHPTOT(4,5,I)=O1 154 : 1 CONTINUE 155 : RETURN 156 : 100 CONTINUE 156 : CALL ERREUR(19) 157 : * 158 : END 159 :
© Cast3M 2003 - All rights reserved.
Disclaimer