1 : C TCOQ8C SOURCE FANDEUR 11/07/19 21:17:39 7042 2 : 3 : ************************************************************************ 4 : * 5 : * T C O Q 8 C 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * TRAITEMENT DU CAS DES ELEMENTS-FINIS COQUE EPAISSE A 8 11 : * OU A 6 NOEUDS 12 : * 13 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 14 : * ----------- 15 : * 16 : * NEF (E) NUMERO DE L'ELEMENT-FINI DANS NOMTP (VOIR CCHAMP) 17 : * IMAIL (E) NUMERO DU MAILLAGE ELEMENTAIRE CONSIDERE,DANS 18 : * L'OBJET MODELE 19 : * IPMODE (E) POINTEUR SUR UN SEGMENT IMODEL 20 : * IPCHEM (E) POINTEUR SUR LE CHAMELEM DE CARACTERISTIQUE 21 : * IPRIGI (E/S) POINTEUR SUR L'OBJET RESULTAT,DE TYPE RIGIDITE 22 : * 23 : * VARIABLES: 24 : * ---------- 25 : * 26 : * NBNN NOMBRE DE NOEUDS DANS L'ELEMENT CONSIDERE 27 : * NEF NUMERO DE L'ELEMENT FINI DANS NOMTP (VOIR CCHAMP) 28 : * NBELEM NOMBRE D'ELEMENTS DANS LE MAILLAGE ELEMENTAIRE 29 : * NBPGAU NOMBRE DE POINTS DE GAUSS DANS L'ELEMENT-FINI 30 : * NDIM NOMBRE DE LIGNES DE LA MATRICE GRADIENT 31 : * CEL(3*NBNN,3*NBNN) MATRICE DE CONDUCTIVITE ELEMENTAIRE 32 : * XE(3,NBNN) COORDONNEES DE L'ELEMENT DANS LE REPERE GLOBAL 33 : * GRAD(NDIM,2*NBNN) MATRICE GRADIENT DES FONCTIONS DE FORME BIDIM. 34 : * XK(3,NBPGAU) LES CONDUCTIVITES AUX POINTSDE GAUSS 35 : * EP(NBPGAU) LES EPAISSEURS AUX POINTS DE GAUSS 36 : * TXR(3,3,NBNN) LES AXES LOCAUX AUX NOEUDS 37 : ************************************************************************ 38 : 39 : SUBROUTINE TCOQ8C (NEF,IPMAIL,IPINTE,IMATE,IVAMAT,NVAMAT, 40 : & IPMATR,NLIGR) 41 : 42 : IMPLICIT INTEGER(I-N) 43 : IMPLICIT REAL*8(A-H,O-Z) 44 : 45 : -INC CCOPTIO 46 : -INC CCREEL 47 : 48 : -INC SMCOORD 49 : -INC SMINTE 50 : -INC CCHAMP 51 : -INC SMRIGID 52 : -INC SMELEME 53 : -INC SMCHAML 54 : 55 : SEGMENT,MMAT1 56 : REAL*8 EP(NBNN),XK(3,NBPGAU),TXR(3,3,NBNN),EXC(NBNN) 57 : REAL*8 CEL(NLIGR,NLIGR),XE(3,NBNN),GRAD(NDIM,NLIGR) 58 : REAL*8 COSA(NBPGAU),SINA(NBPGAU) 59 : REAL*8 XJ(3,3),XJI(3,3),TT(9),YK(3,3) 60 : ENDSEGMENT 61 : * 62 : SEGMENT NOTYPE 63 : CHARACTER*16 TYPE(NBTYPE) 64 : ENDSEGMENT 65 : * 66 : SEGMENT MPTVAL 67 : INTEGER IPOS(NS) ,NSOF(NS) 68 : INTEGER IVAL(NCOSOU) 69 : CHARACTER*16 TYVAL(NCOSOU) 70 : ENDSEGMENT 71 : * 72 : PARAMETER (UN=1.D0,DEUX=2.D0,X577=.577350269189626D0) 73 : * 74 : * RECUPERATION DES CARACTERISTIQUES GEOMETRIQUES DU MAILLAGE 75 : * ELEMENTAIRE 76 : * 77 : MELEME = IPMAIL 78 : c* SEGACT,MELEME 79 : NBNN = NUM(/1) 80 : NBELEM = NUM(/2) 81 : * 82 : * RECUPERATION DES CARACTERISTIQUES D'INTEGRATION DE L'ELEMENT 83 : * FINI LIE A NOTRE MAILLAGE 84 : * 85 : MINTE = IPINTE 86 : C* SEGACT,MINTE 87 : NBPGAU=POIGAU(/1) 88 : * 88 : CALL TSHAPE(NEF,'NOEUD',IPINT1) 89 : IF (IERR.NE.0) RETURN 90 : MINTE1 = IPINT1 91 : SEGACT,MINTE1 92 : * 93 : XMATRI= IPMATR 94 : c* SEGACT,XMATRI*MOD 95 : * 96 : MPTVAL = IVAMAT 97 : IPMELV = IVAL(NVAMAT) 98 : * Verification de la constance de l'epaisseur : 98 : c* CALL QUELCH(IPMELV,ICONS) 99 : c* IF (ICONS.NE.0) THEN 99 : c* CALL ERREUR(566) 100 : c* GOTO 999 101 : c* ENDIF 102 : * 103 : NDIM = IDIM 104 : SEGINI,MMAT1 105 : * 106 : * BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAIL 107 : * 108 : DO 10 IEL = 1, NBELEM 109 : * 110 : * MISE A ZERO DES TABLEAUX CEL ET GRAD ET EXC 111 : * 111 : CALL ZERO(CEL,NLIGR,NLIGR) 111 : CALL ZERO(EXC,NBNN,1) 112 : * 113 : * ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IEL, 114 : * DANS LE REPERE GLOBAL 115 : * 115 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE) 116 : * 117 : * CALCUL DES AXES LOCAUX A TOUS LES NOEUDS DE L'ELEMENT 118 : * 118 : CALL CQ8LOC (XE,NBNN,MINTE1.SHPTOT,TXR,IRR) 119 : * ECHEC DANS LE CALCUL DES AXES LOCAUX 120 : IF (IRR.EQ.0) THEN 120 : CALL ERREUR (515) 121 : GOTO 999 122 : ENDIF 123 : * 124 : * ON CHERCHE LES CONDUCTIVITES ET LES COSINUSDIRECTEURS 125 : * DES AXES LOCAUX (CAS ORTHOTROPE) AUX POINTS DE GAUSS 126 : * 127 : IF (IMATE.EQ.1) THEN 128 : MELVAL = IVAL(1) 129 : IBMN = MIN(IEL,VELCHE(/2)) 130 : DO 20 IG = 1,NBPGAU 131 : IGMN=MIN(IG,VELCHE(/1)) 132 : XK(1,IG) = VELCHE(IGMN,IBMN) 133 : 20 CONTINUE 134 : ELSE 135 : DO 30 IM = 1, 5 136 : MELVAL = IVAL(IM) 137 : IBMN = MIN(IEL,VELCHE(/2)) 138 : IF (IM.LE.3) THEN 139 : DO IG = 1, NBPGAU 140 : IGMN = MIN(IG,VELCHE(/1)) 141 : XK(IM,IG) = VELCHE(IGMN,IBMN) 142 : ENDDO 143 : ELSE IF (IM.EQ.4) THEN 144 : DO IG = 1, NBPGAU 145 : IGMN = MIN(IG,VELCHE(/1)) 146 : COSA(IG) = VELCHE(IGMN,IBMN) 147 : ENDDO 148 : ELSE 149 : DO IG = 1,NBPGAU 150 : IGMN = MIN(IG,VELCHE(/1)) 151 : SINA(IG) = VELCHE(IGMN,IBMN) 152 : ENDDO 153 : ENDIF 154 : 30 CONTINUE 155 : ENDIF 156 : * 157 : * ON CHERCHE LES EPAISSEURS 158 : MELVAL = IPMELV 159 : IBMN = MIN(IEL,VELCHE(/2)) 160 : DO IG = 1, NBNN 161 : IGMN = MIN(IG,VELCHE(/1)) 162 : EP(IG) = VELCHE(IGMN,IBMN) 163 : * 164 : * L'ELEMENT (IEL) AU POINT DE GAUSS (IG)DE TYPE (NOMTP(NEF)) A 165 : * UNE EPAISSEUR NULLE 166 : IF (EP(IG).LE.XPETIT) THEN 167 : INTERR(1)=IEL 168 : INTERR(2)=IG 169 : MOTERR(1:4)=NOMTP(NEF) 169 : CALL ERREUR(355) 170 : GOTO 999 171 : ENDIF 172 : ENDDO 173 : * 174 : * BOUCLE SUR LES POINTS D ' INTEGRATION 175 : * 176 : DO 40 IGAU = 1,NBPGAU 177 : * 178 : * CALCUL DU JACOBIEN ET DE SON DETERMINENT EN CE POINT DE GAUSS 179 : * 179 : CALL ZERO(GRAD,NDIM,NLIGR) 180 : * 181 : E3 = DZEGAU(IGAU) 182 : * 182 : CALL CQ8JCE(IGAU,NBNN,E3,XE,EP,EXC,TXR,SHPTOT,XJ,DJAC,IRR) 183 : * JACOBIEN NUL DANS L'ELEMENT IEL 184 : IF (IRR.LT.0)THEN 185 : INTERR(1)=IEL 185 : CALL ERREUR (405) 186 : GOTO 999 187 : ENDIF 188 : * 189 : * INVERSION DU JACOBIEN 190 : * 191 : DUM =UN/DJAC 192 : XJI(1,1) = DUM*( XJ(2,2)*XJ(3,3) - XJ(2,3)*XJ(3,2)) 193 : XJI(2,1) = DUM*(-XJ(2,1)*XJ(3,3) + XJ(2,3)*XJ(3,1)) 194 : XJI(3,1) = DUM*( XJ(2,1)*XJ(3,2) - XJ(2,2)*XJ(3,1)) 195 : XJI(1,2) = DUM*(-XJ(1,2)*XJ(3,3) + XJ(1,3)*XJ(3,2)) 196 : XJI(2,2) = DUM*( XJ(1,1)*XJ(3,3) - XJ(1,3)*XJ(3,1)) 197 : XJI(3,2) = DUM*(-XJ(1,1)*XJ(3,2) + XJ(1,2)*XJ(3,1)) 198 : XJI(1,3) = DUM*( XJ(1,2)*XJ(2,3) - XJ(1,3)*XJ(2,2)) 199 : XJI(2,3) = DUM*(-XJ(1,1)*XJ(2,3) + XJ(1,3)*XJ(2,1)) 200 : XJI(3,3) = DUM*( XJ(1,1)*XJ(2,2) - XJ(1,2)*XJ(2,1)) 201 : * 202 : * TRAITEMENT SPECIFIQUE DU CAS ORTHOTROPE 203 : IF (IMATE.EQ.2) THEN 204 : * 205 : * DETERMINATION DES COSINUS DIRECTEURS DES AXES LOCAUX EN CE POINT 206 : * COQ8 COQ6 207 : IF(NEF.EQ.41.OR.NEF.EQ.56)THEN 208 : * 209 : DO 50 I=1,3 210 : DO 50 J=1,2 211 : K=3*(J-1)+I 212 : TT(K) = XJ(J,I) 213 : 50 CONTINUE 214 : * 215 : * PRODUITS VECTORIELS ET NORMALISATIONS 216 : * 216 : CALL CROSS2(TT(1),TT(4),TT(7),IRR1) 216 : CALL CROSS2(TT(7),TT(1),TT(4),IRR1) 216 : CALL CROSS2(TT(4),TT(7),TT(1),IRR1) 217 : * 218 : ELSE 219 : IF(IGAU.EQ.1)THEN 220 : * 221 : * CALCUL DES AXES LOCAUX DE L 'ELEMENT COQ4 222 : * 222 : CALL TQ4LOC(XE,TT,IRR1) 223 : * 224 : ENDIF 225 : ENDIF 226 : IF(IRR1.EQ.0) THEN 227 : * ECHEC DANS LE CALCUL DES AXES LOCAUX 227 : CALL ERREUR(515) 228 : GO TO 999 229 : ENDIF 230 : * 231 : * PRODUIT MATRICIEL TT TRANSPOSE * XJI 232 : * 233 : DO 60 I=1,3 234 : DO 60 J=1,3 235 : r_z = XZERO 236 : DO 61 K=1,3 237 : K1 = 3*(I-1)+K 238 : r_z = r_z + TT(K1)*XJI(K,J) 239 : 61 CONTINUE 240 : XJ(I,J) = r_z 241 : 60 CONTINUE 242 : * 243 : ENDIF 244 : * 245 : * CALCUL DE LA MATRICE DE GRADIENT DES FONCTIONS DE FORME DANS LE 246 : * REPERE GLOBAL POUR LE CAS ISOTROPE ET DANS LE REPERE LOCAL 247 : * POUR LE CAS ORTHOTROPE 248 : * 249 : NBNN2=2*NBNN 250 : DO 70 K = 1,NLIGR 251 : DO 70 I = 1,3 252 : r_z = XZERO 253 : DO J = 1,3 254 : JJ=J+1 255 : IF(JJ.EQ.4)JJ=1 256 : IF(K.LE.NBNN)THEN 257 : KK=K 258 : IF(J.LE.2)THEN 259 : COEF=(E3/DEUX)*(E3-UN) 260 : ELSE 261 : COEF=E3-UN/DEUX 262 : ENDIF 263 : ELSEIF(K.GT.NBNN.AND.K.LE.NBNN2)THEN 264 : KK=K-NBNN 265 : IF(J.LE.2)THEN 266 : COEF=UN-E3*E3 267 : ELSE 268 : COEF=-DEUX*E3 269 : ENDIF 270 : ELSE 271 : KK=K-NBNN2 272 : IF(J.LE.2)THEN 273 : COEF=(E3/DEUX)*(E3+UN) 274 : ELSE 275 : COEF=E3+UN/DEUX 276 : ENDIF 277 : ENDIF 278 : IF (IMATE.EQ.1) THEN 279 : r_z = r_z + COEF*SHPTOT(JJ,KK,IGAU)*XJI(I,J) 280 : ELSE 281 : r_z = r_z + COEF*SHPTOT(JJ,KK,IGAU)*XJ(I,J) 282 : ENDIF 283 : ENDDO 284 : GRAD(I,K) = r_z 285 : 70 CONTINUE 286 : * 287 : * ON MULTIPLIE LE DETERMINENT JACOBIEN PAR LE POIDS D' INTEG- 288 : * RATION POUR LE POINT DE GAUSS CONSIDERE 289 : * 290 : DJAC = DJAC*POIGAU(IGAU) 291 : * 292 : IF (IMATE.EQ.1) THEN 293 : * 294 : * CAS DU MATERIAU ISOTROPE 295 : 296 : FACT = XK(1,IGAU)*DJAC 297 : * 298 : * ON AJOUTE LE PRODUIT K*DJAC*TRANSPOSEE(GRAD)*GRAD POUR LE 299 : * POINT DE GAUSS CONSIDERE 300 : * 300 : CALL NTNST(GRAD,FACT,NLIGR,NDIM,CEL) 301 : * 302 : * CAS ORTHOTROPE 303 : ELSE 304 : * 305 : * CALUL DE LA MATRICE DES COEFFICIENTS DE CONDUCTIVITES DANS LE 306 : * PLAN,PAR RAPPORT AU REPERE LOCAL DE L'ELEMANT 307 : * 308 : IF (NEF.EQ.41.OR.NEF.EQ.56) THEN 309 : IGAU2 = IGAU 310 : ELSE 311 : NBPGA1 = NBPGAU/2 312 : IF (IGAU.LE.NBPGA1) THEN 313 : IGAU2 = IGAU 314 : ELSE 315 : IGAU2 = IGAU-NBPGA1 316 : ENDIF 317 : ENDIF 318 : * 319 : COS2 = COSA(IGAU2) * COSA(IGAU2) 320 : SIN2 = SINA(IGAU2) * SINA(IGAU2) 321 : SINCOS=SINA(IGAU2) * COSA(IGAU2) 322 : YK(1,1)=COS2*XK(1,IGAU) + SIN2*XK(2,IGAU) 323 : YK(2,1)=SINCOS*(XK(1,IGAU)-XK(2,IGAU)) 324 : YK(3,1)=XZERO 325 : YK(1,2)=YK(2,1) 326 : YK(2,2)=SIN2*XK(1,IGAU)+COS2*XK(2,IGAU) 327 : YK(3,2)=XZERO 328 : YK(1,3)=XZERO 329 : YK(2,3)=XZERO 330 : YK(3,3)=XK(3,IGAU) 331 : * 332 : * ON AJOUTE LE PRODUIT DJAC*TRANSPOSEE(GRAD)*XK*GRAD POUR LE 333 : * POINT DE GAUSS CONSIDERE A LA MATRICE CEL 334 : * 334 : CALL BDBST(GRAD,DJAC,YK,NLIGR,NDIM,CEL) 335 : * 336 : ENDIF 337 : * 338 : 40 CONTINUE 339 : * 340 : * REMPLISSAGE DE XMATRI 341 : * 341 : CALL REMPMT(CEL,NLIGR,RE(1,1,iel)) 342 : * 343 : 10 CONTINUE 344 : * 345 : * DESACTIVATION DES SEGMENTS 346 : * 347 : 999 CONTINUE 348 : SEGDES,MINTE1 349 : SEGSUP,MMAT1 350 : * 351 : RETURN 352 : END 353 : 354 :
© Cast3M 2003 - All rights reserved.
Disclaimer