1 : C TCOQ3C SOURCE FANDEUR 11/07/19 21:17:36 7042 2 : 3 : ************************************************************************ 4 : * 5 : * T C O Q 3 C 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * TRAITEMENT DU CAS DES ELEMENTS-FINIS COQUE TRIANGLE 11 : * A INTEGRATION-SEMI ANALYTIQUE (INTEGRATION ANALYTIQUE DANS L' 12 : * EPAISSEUR )POUR UN MAILLAGE ELEMENTAIRE 13 : * 14 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 15 : * ----------- 16 : * 17 : * NEF (E) NUMERO DE L'ELEMENT-FINI DANS NOMTP (VOIR CCHAMP) 18 : * IPMAIL (E) NUMERO DU MAILLAGE ELEMENTAIRE CONSIDERE,DANS 19 : * L'OBJET MODELE 20 : * IPCHEM (E) POINTEUR SUR LE CHAMELEM DE CARACTERISTIQUE 21 : * IPRIGI (E/S) POINTEUR SUR L'OBJET RESULTAT,DE TYPE RIGIDITE 22 : * 23 : * AUTEUR, DATE DE CREATION: 24 : * ------------------------- 25 : * 26 : * P. DOWLATYARI JUILLET 1990 27 : * 28 : * LANGAGE: 29 : * -------- 30 : * 31 : * ESOPE + FORTRAN77 32 : ************************************************************************ 33 : 34 : SUBROUTINE TCOQ3C (NEF,IPMAIL,IPINTE,IMATE,IVAMAT,NVAMAT, 35 : & IPMATR,NLIGR) 36 : 37 : IMPLICIT INTEGER(I-N) 38 : IMPLICIT REAL*8(A-H,O-Z) 39 : 40 : -INC CCOPTIO 41 : -INC CCREEL 42 : -INC CCHAMP 43 : 44 : -INC SMCHAML 45 : -INC SMCOORD 46 : -INC SMELEME 47 : -INC SMINTE 48 : -INC SMRIGID 49 : * 50 : SEGMENT,MMAT1 51 : REAL*8 VALMAT(NMATR) 52 : REAL*8 XE(3,NBNN),XE1(3,NBNN) 53 : REAL*8 SHP(6,NBNN),GRAD(NDIM,NBNN),FORME(NBNN) 54 : REAL*8 CEL1(NBNN,NBNN),CEL2(NBNN,NBNN) 55 : REAL*8 COSD1(3),COSD2(3),COSD3(3),YK(2,2) 56 : ENDSEGMENT 57 : * 58 : SEGMENT MPTVAL 59 : INTEGER IPOS(NS) ,NSOF(NS) 60 : INTEGER IVAL(NCOSOU) 61 : CHARACTER*16 TYVAL(NCOSOU) 62 : ENDSEGMENT 63 : 64 : * MAILLAGE ELEMENTAIRE 65 : MELEME = IPMAIL 66 : C* SEGACT,MELEME 67 : NBNN = NUM(/1) 68 : NBELEM = NUM(/2) 69 : * 70 : * INFORMATION SUR L'ELEMENT 71 : MINTE = IPINTE 72 : C* SEGACT,MINTE 73 : NBPGAU = POIGAU(/1) 74 : * 75 : XMATRI = IPMATR 76 : c* SEGACT,XMATRI*MOD 77 : * 78 : * SEGMENTS MELVAL correspondant aux composantes de la conductivite et 79 : * de l'epaisseur des elements (epaisseur toujours placee a la fin !) 80 : MPTVAL = IVAMAT 81 : c* SEGACT,MPTVAL 82 : * Verification de la constance de l'epaisseur : 83 : * IPMELV = IVAL(NVAMAT) 83 : * CALL QUELCH(IPMELV,ICONS) 84 : * IF (ICONS.NE.0) THEN 84 : * CALL ERREUR(566) 85 : * RETURN 86 : * ENDIF 87 : * 88 : NMATR = NVAMAT 89 : NDIM = IDIM-1 90 : SEGINI,MMAT1 91 : NFIN = NDIM+1 92 : * 93 : * BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAIL 94 : * 95 : DO 10 iel = 1, NBELEM 96 : * 97 : * MISE A ZERO DES TABLEAUX CEL1 ET CEL2 98 : * 98 : CALL ZERO(CEL1,NBNN,NBNN) 98 : CALL ZERO(CEL2,NBNN,NBNN) 99 : * 100 : * ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IEL, 101 : * DANS LE REPERE GLOBAL 102 : * 102 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE) 103 : * 104 : * CALCUL DES COORDONNEES DES NOEUDS DANS LE REPERE LOCAL DE L' 105 : * ELEMENT COQUE 106 : * 107 : DO 60 I=1,3 108 : COSD1(I) = XE(I,2)-XE(I,1) 109 : COSD2(I) = XE(I,3)-XE(I,1) 110 : 60 CONTINUE 111 : * 112 : COSD3(1)=COSD1(2)*COSD2(3)-COSD1(3)*COSD2(2) 113 : COSD3(2)=COSD1(3)*COSD2(1)-COSD1(1)*COSD2(3) 114 : COSD3(3)=COSD1(1)*COSD2(2)-COSD1(2)*COSD2(1) 115 : * 116 : COSD1L=SQRT(COSD1(1)*COSD1(1)+COSD1(2)*COSD1(2)+ 117 : & COSD1(3)*COSD1(3)) 118 : COSD3L=SQRT(COSD3(1)*COSD3(1)+COSD3(2)*COSD3(2)+ 119 : & COSD3(3)*COSD3(3)) 120 : * 121 : DO 70 I=1,3 122 : COSD1(I)=COSD1(I)/COSD1L 123 : COSD3(I)=COSD3(I)/COSD3L 124 : 70 CONTINUE 125 : * 126 : COSD2(1)=COSD3(2)*COSD1(3)-COSD3(3)*COSD1(2) 127 : COSD2(2)=COSD3(3)*COSD1(1)-COSD3(1)*COSD1(3) 128 : COSD2(3)=COSD3(1)*COSD1(2)-COSD3(2)*COSD1(1) 129 : * 130 : DO 80 NOE=1,NBNN 131 : r_z1 = XZERO 132 : r_z2 = XZERO 133 : DO I = 1, 3 134 : r_z1 = r_z1 + XE(I,NOE)*COSD1(I) 135 : r_z2 = r_z2 + XE(I,NOE)*COSD2(I) 136 : ENDDO 137 : XE1(1,NOE) = r_z1 138 : XE1(2,NOE) = r_z2 139 : 80 CONTINUE 140 : * 141 : * BOUCLE SUR LES POINTS DE GAUSS 142 : * 143 : IFOIS=0 144 : IFOI2=0 145 : EPAI = XZERO 146 : 147 : DO 20 IGAU=1,NBPGAU 148 : * 149 : * CALCUL DE LA MATRCIE GRADIENT DES FONCTIONS DE FORME ET 150 : * DU JACOBIEN(DANS LE PLAN), EN UN POINT DE GAUSS 151 : * 152 : DO 90 NP=1,NBNN 153 : DO 90 I=1,NFIN 154 : SHP(I,NP)=SHPTOT(I,NP,IGAU) 155 : 90 CONTINUE 156 : * 157 : * DERIVES DES FONCTIONS DE FORME DANS LA GEOMETRIE REELLE 158 : * ET LE JACOBIEN 158 : CALL JACOBI(XE1,SHP,NDIM,NBNN,DJAC) 159 : IF (DJAC.LT.XZERO) IFOIS=IFOIS+1 160 : IF (ABS(DJAC).LT.XPETIT) IFOI2=IFOI2 +1 161 : 162 : DO 100 NP=1,NBNN 163 : FORME(NP)=SHP(1,NP) 164 : DO 100 I= 1,NDIM 165 : GRAD(I,NP)=SHP(I+1,NP) 166 : 100 CONTINUE 167 : * 168 : * ON MULTIPLIE LE JACOBIEN PAR LE POIDS D'INTEGRATION,POUR LE 169 : * POINT DE GAUSS CONSIDERE 170 : * 171 : DJAC=ABS(DJAC)*POIGAU(IGAU) 172 : * 173 : * ON CHERCHE LES VALEURS DE COMPOSANTES DE LA CONDUCTIVITE 174 : * ET L'EPAISSEUR DE LA COQUE 175 : DO i = 1, NMATR 176 : c* IF (IVAL(i).NE.0) THEN 177 : MELVAL = IVAL(i) 178 : IBMN = MIN(IEL,VELCHE(/2)) 179 : IGMN = MIN(IGAU,VELCHE(/1)) 180 : VALMAT(i) = VELCHE(IGMN,IBMN) 181 : c* ELSE 182 : c* VALMAT(i) = XZERO 183 : c* ENDIF 184 : ENDDO 185 : * 186 : EP = VALMAT(NMATR) 187 : * L'ELEMENT (IEL) AU POINT DE GAUSS (IGAU)DE TYPE (NOMTP(NEF)) A 188 : * UNE EPAISSEUR NULLE 189 : IF (EP.LE.XPETIT) THEN 190 : INTERR(1) = IEL 191 : INTERR(2) = IGAU 192 : MOTERR(1:4) = NOMTP(NEF) 192 : CALL ERREUR(355) 193 : GOTO 999 194 : ENDIF 195 : EPAI = EPAI + EP 196 : * 197 : * MATERIAU ISOTROPE 198 : * 199 : IF (IMATE.EQ.1) THEN 200 : * 201 : XK3 = VALMAT(1) * DJAC 202 : * 203 : * ON AJOUTE LE PRODUIT K3*DJAC*TRANSPOSEE(GRAD)*GRAD 204 : * POUR LE POINT DE GAUSS CONSIDERE,A LA MATRICE CEL1 205 : * 205 : CALL NTNST(GRAD,XK3,NBNN,NDIM,CEL1) 206 : * 207 : ELSE IF (IMATE.EQ.2) THEN 208 : * 209 : XK1 = VALMAT(1) 210 : XK2 = VALMAT(2) 211 : XK3 = VALMAT(3) * DJAC 212 : * 213 : COSA = VALMAT(5) 214 : SINA = VALMAT(6) 215 : * 216 : * CALUL DE LA MATRICE DES COEFFICIENTS DE CONDUCTIVITES DANS LE 217 : * PLAN PAR RAPPORT AU REPERE LOCAL DE L'ELEMENT 218 : * 219 : COS2 = COSA*COSA 220 : SIN2 = SINA*SINA 221 : YK(1,1) = COS2*XK1 + SIN2*XK2 222 : YK(1,2) = SINA*COSA*(XK1-XK2) 223 : YK(2,1) = YK(1,2) 224 : YK(2,2) = SIN2*XK1 + COS2*XK2 225 : * 226 : * ON AJOUTE LE PRODUIT DJAC*TRANSPOSEE(GRAD)*YK*GRAD 227 : * POUR LE POINT DE GAUSS CONSIDERE,A LA MATRICE CEL1 228 : * 228 : CALL BDBST(GRAD,DJAC,YK,NBNN,NDIM,CEL1) 229 : * 230 : ENDIF 231 : * 232 : * ON AJOUTE LE PRODUIT K3*DJAC*TRANSPOSEE(FORME)*FORME POUR LE 233 : * DE GAUSS CONSIDERE A LA MATRICE CEL2 234 : * 234 : CALL NTNST(FORME,XK3,NBNN,1,CEL2) 235 : * 236 : 20 CONTINUE 237 : * 238 : * LE JACOBIEN EST NEGATIF ,MAILLAGE INCORRECT 239 : IF (IFOIS.NE.0.AND.IFOIS.NE.NBPGAU) THEN 240 : INTERR(1) = iel 240 : CALL ERREUR(195) 241 : GOTO 999 242 : ELSE IF (IFOI2.EQ.NBPGAU) THEN 243 : * CAS OU LE JACOBIEN EST TRES PETIT 244 : INTERR(1) = iel 244 : CALL ERREUR (259) 245 : GOTO 999 246 : ENDIF 247 : * 248 : * REMPLISSAGE DE XMATRI 249 : * EN SUPPOSANT UNE EPAISSEUR MOYENNE CONSTANTE ! 250 : * 251 : EPAI = EPAI / NBPGAU 251 : CALL MCONDT(CEL1,CEL2,NBNN,EPAI,RE(1,1,iel)) 252 : * 253 : 10 CONTINUE 254 : * 255 : * DESACTIVATION DES SEGMENTS 256 : 999 CONTINUE 257 : SEGSUP,MMAT1 258 : 259 : RETURN 260 : END 261 : 262 :
© Cast3M 2003 - All rights reserved.
Disclaimer