1 : C IDMAT3 SOURCE CHAT 05/01/13 00:29:39 5004 2 : SUBROUTINE IDMAT3 (NUDIR1,NUMP1,NUDIR2,NUMP3,ANG,MELEME,MINTE, 3 : 1 NPG2,ICALC,MFR,IPVAL) 4 : * 5 : ************************************************************************ 6 : * 7 : * I D M A T 3 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * DEFINITION DES DIRECTIONS D'ORTHOTROPIE D'UNE COQUE EN 3D ET D'UN 14 : * JOINT EN 3D JOT3 ET JOI4. 15 : * (MODIF. DE DIMENSION A FAIRE POUR PLUS DE 8 NOEUDS) 16 : * 17 : * REMARQUE : ROUTINE ANALOGUE A MATEO2 ET COBIOR 18 : * 19 : * MODULES UTILISES: 20 : * ----------------- 21 : * 22 : IMPLICIT INTEGER(I-N) 23 : -INC CCOPTIO 24 : -INC CCREEL 25 : -INC SMELEME 26 : -INC SMINTE 27 : -INC SMCOORD 28 : * 29 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 30 : * ----------- 31 : * 32 : * NUDIR1 (E) NUMERO DE DIRECTIVE UTILISEE DANS LA LISTE: 33 : * "DIRECTION", "RADIAL", 34 : * POUR LA DEFINITION DES DIRECTIONS D'ORTHOTROPIE. 35 : * NUMP1 (E) NUMERO DU POINT P ASSOCIE A NUDIR1 36 : * NUDIR2 (E) NUMERO DE DIRECTIVE UTILISEE DANS LA LISTE: 37 : * "PARALLELE", "PERPENDIC.", "INCLINE", 38 : * POUR LA DEFINITION DES DIRECTIONS D'ORTHOTROPIE. 39 : * NUMP3 (E) NUMERO DU POINT P ASSOCIE A NUDIR2 40 : * ANG (E) ANGLE UTILISE DANS LA DEFINITION DES DIRECTIONS 41 : * D ORTHOTROPIE (INCLINE) 42 : * MELEME (E) POINTEUR DE "MAILLAGE" A 1 SEUL TYPE D'ELEMENT. 43 : * MINTE (E) SEGMENT CONTENANT LES FONCTIONS DE FORME, NECESSAIRE 44 : * AVEC L'OPTION "RADIAL". 45 : * XVAL (S) DIRECTIONS D'ORTHOTROPIE, PAR ELEMENT ET, SI OPTION 46 : * "RADIAL", PAR POINT DE GAUSS. 47 : * ON FOURNIT LE COSINUS ET LE SINUS DE L'ANGLE QUE FAIT 48 : * LA DIRECTION 1 D'ORTHOTROPIE AVEC LA DIRECTION 1 DE 49 : * L'ELEMENT. 50 : * MFR NUMERO DE FORMULATION D'ELEMENT. 51 : * =3 SI COQUE @ 3 NOEUDS. 52 : * =9 SI COQUE @ 4 NOEUDS. 53 : * =35 SI JOINT @ 6 OU @ 8 NOEUDS. 54 : * ICALC FLAG POUR ORIENTER LE CALCUL (POUR COQ EN BIDI) 55 : * +IDIM (E) VOIR LE COMMUN "COPTIO". 56 : * +MCOORD (E) VOIR LE COMMUN "COPTIO". Segment suppos{ actif. 57 : * 58 : INTEGER NUDIR1,NUMP1,NUDIR2,NUMP3,ICALC 59 : INTEGER NPG2,IPVAL 60 : REAL*8 ANG 61 : * 62 : * VARIABLES: 63 : * ---------- 64 : * 65 : * COSA = COSINUS DE L'ANGLE DE LA DIRECTION 1 D'ORTHOTROPIE AVEC 66 : * LA DIRECTION 1 DE L'ELEMENT. 67 : * SINA = SINUS DE L'ANGLE DE LA DIRECTION 1 D'ORTHOTROPIE AVEC 68 : * LA DIRECTION 1 DE L'ELEMENT. 69 : * XI,YI,ZI = COORDONNEES DE LA DIRECTION 1 DANS LE REPERE LOCAL. 70 : * XN,YN,ZN = COORDONNEES DE LA NORMALE A L'ELEMENT. 71 : * XDIR1,.. = COORDONNEES DE LA DIRECTION FOURNIE POUR DETERMINER LES 72 : * DIRECTIONS D'ORTHOTROPIE. 73 : * XE = COORDONNEES DES NOEUDS DE L'ELEMENT. 74 : * 75 : REAL*8 XN,YN,ZN,XI,YI,ZI,XJ,YJ,ZJ,XNORM,P1N,COSA,SINA 76 : & ,XDIR1,YDIR1,ZDIR1,XDIR2,YDIR2,ZDIR2,COSB,SINB 77 : & ,REEL1 78 : REAL*8 XE(3,8),XEL(3,8),BPSS(3,3) 79 : * 80 : * CONSTANTES: 81 : * ----------- 82 : * 83 : * COS1D = VALEUR APPROCHEE DE COSINUS(1 DEGRE). 84 : * 85 : REAL*8 COS1D 86 : PARAMETER (COS1D = 0.999 85 D0) 87 : * 88 : * REMARQUES: 89 : * ---------- 90 : * 91 : * 1. LE PLAN MOYEN EST DEFINI PAR LES SOUS-PROGRAMMES USUELS DE 92 : * CALCUL DE REPERE POUR LES ELEMENTS CONSIDERES. 93 : * 94 : * 2. HYP.: LA PLACE DES NOMS DE COMPOSANTES DANS "NOMYO" (COMMUN 95 : * "CHAMP") EST FIGEE. C'EST UNE HYPOTHESE COURAMMENT UTILISEE POUR 96 : * D'AUTRES TABLEAUX DE "CHAMP". 97 : * 98 : * AUTEUR, DATE DE CREATION: 99 : * ------------------------- 100 : * 101 : * PASCAL MANIGOT 30 AVRIL 1987 102 : * P.M. 09/07/91: PRISE EN COMPTE DES DIFFERENCES DE REPERAGE ENTRE 103 : * TRIANGLE(COQ3 ET DKT) ET QUADRANGLE (COQ4). 104 : * 105 : * LANGAGE: 106 : * -------- 107 : * 108 : * ESOPE77 FORTRAN77 + EXTENSION: DECLARATION "REAL*8". 109 : * 110 : * MISE A NIVEAU DE MATR AVEC MATE 111 : * ------------------------------- 112 : * 113 : * JM CAMPENON LE 30 08 90 114 : * 115 : ************************************************************************ 116 : * 117 : C 118 : SEGMENT XVAL 119 : REAL*8 CVAL(NPG2,NBELEM),SVAL(NPG2,NBELEM) 120 : ENDSEGMENT 121 : C 122 : IF (ICALC.EQ.0) THEN 123 : SEGACT MELEME 124 : IF ((NUDIR1 .EQ. 2).OR.((NUDIR1.EQ.1).AND.(MFR.EQ.35)) ) 125 : . SEGACT MINTE 126 : NBELEM=NUM(/2) 127 : NBNN =NUM(/1) 128 : * 129 : * DIRECTION FOURNIE, AVANT PROJECTION SUR LA COQUE. 130 : C 131 : C ON CHERCHE LE POINT NUMP1 RATACHER A LA DIRECTIVE DIRECTION 132 : C 132 : CALL EXCOO1 (NUMP1,XDIR1,YDIR1,ZDIR1,REEL1) 133 : IF (NUDIR1 .EQ. 1) THEN 134 : XNORM = SQRT(XDIR1**2 + YDIR1**2 + ZDIR1**2) 135 : XDIR1 = XDIR1 / XNORM 136 : YDIR1 = YDIR1 / XNORM 137 : ZDIR1 = ZDIR1 / XNORM 138 : END IF 139 : XDIR2 = XDIR1 140 : YDIR2 = YDIR1 141 : ZDIR2 = ZDIR1 142 : C 143 : SEGINI XVAL 144 : IPVAL=XVAL 145 : C 146 : C 147 : C 148 : DO 100 IEL=1,NBELEM 149 : C 149 : CALL DOXE (XCOOR,IDIM,NBNN,NUM,IEL, XE) 150 : IF (MFR.EQ.35.AND.NBNN.EQ.8) THEN 150 : CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL) 151 : ELSE IF (MFR.EQ.35.AND.NBNN.EQ.6) THEN 151 : CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL) 152 : ELSE IF (MFR.EQ. 9.AND.NBNN.EQ.4) THEN 152 : CALL CQ4LOC (XE,XEL,BPSS,IRRT,0) 153 : ELSE 154 : * "MFR" EST SUPPOS{ VALOIR 3 (COQ3, DKT,DST) 154 : CALL VPAST (XE,BPSS) 155 : END IF 156 : XI = BPSS(1,1) 157 : YI = BPSS(1,2) 158 : ZI = BPSS(1,3) 159 : XN = BPSS(3,1) 160 : YN = BPSS(3,2) 161 : ZN = BPSS(3,3) 162 : * 163 : DO 120 INOG=1,NPG2 164 : * 165 : IF (NUDIR1 .EQ. 1) THEN 166 : XDIR1 = XDIR2 167 : YDIR1 = YDIR2 168 : ZDIR1 = ZDIR2 169 : ELSE 170 : * OPTION "RADIAL": L'ORIENTATION DE L'ORTHOTROPIE EST 171 : * DETERMINEE A PARTIR DU VECTEUR DE VALEUR (PTGAUSS - P1 172 : XDIR1 = - XDIR2 173 : YDIR1 = - YDIR2 174 : ZDIR1 = - ZDIR2 175 : DO 130 INOE=1,NBNN 176 : XDIR1 = XDIR1 + SHPTOT(1,INOE,INOG)*XE(1,INOE) 177 : YDIR1 = YDIR1 + SHPTOT(1,INOE,INOG)*XE(2,INOE) 178 : ZDIR1 = ZDIR1 + SHPTOT(1,INOE,INOG)*XE(3,INOE) 179 : 130 CONTINUE 180 : XNORM = SQRT(XDIR1**2 + YDIR1**2 + ZDIR1**2) 181 : XDIR1 = XDIR1 / XNORM 182 : YDIR1 = YDIR1 / XNORM 183 : ZDIR1 = ZDIR1 / XNORM 184 : END IF 185 : * 186 : * PROJECTION SUR LA COQUE DU VECTEUR D'ORIENTATION DE 187 : * L'ORTROTHOPIE. 188 : * 189 : P1N = XDIR1*XN + YDIR1*YN + ZDIR1*ZN 190 : IF (ABS(P1N) .GT. COS1D) THEN 191 : * DIRECTION FOURNIE ORTHOGONALE A LA COQUE. 191 : CALL ERREUR (344) 192 : GOTO 9990 193 : END IF 194 : XDIR1 = XDIR1 - P1N*XN 195 : YDIR1 = YDIR1 - P1N*YN 196 : ZDIR1 = ZDIR1 - P1N*ZN 197 : XNORM = SQRT(XDIR1**2 + YDIR1**2 + ZDIR1**2) 198 : XDIR1 = XDIR1 / XNORM 199 : YDIR1 = YDIR1 / XNORM 200 : ZDIR1 = ZDIR1 / XNORM 201 : * 202 : * ANGLE DU VECTEUR PROJETE AVEC LA DIRECTION 1 DE LA COQUE: 203 : COSA = XI * XDIR1 + YI * YDIR1 + ZI * ZDIR1 204 : SINA = XN * (YI*ZDIR1 - ZI*YDIR1) 205 : & + YN * (ZI*XDIR1 - XI*ZDIR1) 206 : & + ZN * (XI*YDIR1 - YI*XDIR1) 207 : * 208 : * 209 : IF (NUDIR2 .EQ. 2) THEN 210 : * ON AJOUTE PI/2 A L'ANGLE: 211 : REEL1 = COSA 212 : COSA = - SINA 213 : SINA = REEL1 214 : ELSE IF (NUDIR2 .EQ. 3) THEN 215 : COSB = COS(ANG) 216 : SINB = SIN(ANG) 216 : CALL EXCOO1 (NUMP3, XDIR1,YDIR1,ZDIR1,REEL1) 217 : XNORM = SQRT(XDIR1**2 + YDIR1**2 + ZDIR1**2) 218 : IF(XNORM .LT. XPETIT) THEN 219 : C POINT P3 est trop proche de l'origine 219 : CALL ERREUR (239) 220 : GOTO 9990 221 : ENDIF 222 : XDIR1 = XDIR1 / XNORM 223 : YDIR1 = YDIR1 / XNORM 224 : ZDIR1 = ZDIR1 / XNORM 225 : REEL1 = XN * XDIR1 + YN * YDIR1 + ZN * ZDIR1 226 : IF (REEL1 .GT. XPETIT) THEN 227 : * ON AJOUTE "ANGLE": 228 : REEL1 = SINA*COSB + COSA*SINB 229 : COSA = COSA*COSB - SINA*SINB 230 : SINA = REEL1 231 : ELSE IF (REEL1 .LT. (-XPETIT) ) THEN 232 : * ON RETRANCHE "ANGLE": 233 : REEL1 = SINA*COSB - COSA*SINB 234 : COSA = COSA*COSB + SINA*SINB 235 : SINA = REEL1 236 : ELSE 237 : C POINT P3 DONNE POUR ORIENTATION INAPROPRIE. 237 : CALL ERREUR (278) 238 : GOTO 9990 239 : END IF 240 : END IF 241 : C 242 : CVAL(INOG,IEL) = COSA 243 : SVAL(INOG,IEL) = SINA 244 : C 245 : 120 CONTINUE 246 : C 247 : 100 CONTINUE 248 : C 249 : C 250 : C 251 : SEGDES XVAL 252 : SEGDES,MELEME 253 : IF ((NUDIR1.EQ.2).OR.( (NUDIR1.EQ.1).AND.(MFR.EQ.35) ) ) 254 : . SEGDES,MINTE 255 : C 256 : RETURN 257 : C 258 : 9990 CONTINUE 259 : SEGSUP XVAL 260 : SEGDES MELEME 261 : IF ((NUDIR1.EQ.2).OR.( (NUDIR1.EQ.1).AND.(MFR.EQ.35) ) ) 262 : . SEGDES,MINTE 263 : RETURN 264 : C 265 : ELSE 266 : C 267 : C COQUES EN BIDIMENSIONNEL 268 : C 269 : SEGACT MELEME 270 : NBELEM=NUM(/2) 271 : C 272 : SEGINI XVAL 273 : IPVAL=XVAL 274 : C 275 : COSA=1.D0 276 : SINA=0.D0 277 : IF (NUDIR2.EQ.2) THEN 278 : COSA=0.D0 279 : SINA=1.D0 280 : END IF 281 : C 282 : DO 1100 IB=1,NBELEM 283 : DO 1100 INOG=1,NPG2 284 : CVAL(INOG,IB)=COSA 285 : SVAL(INOG,IB)=SINA 286 : 1100 CONTINUE 287 : C 288 : SEGDES,XVAL 289 : SEGDES,MELEME 290 : C 291 : RETURN 292 : ENDIF 293 : C 294 : END 295 : 296 : 297 : 298 : 299 :
© Cast3M 2003 - All rights reserved.
Disclaimer