1 : C IDMAT4 SOURCE CHAT 07/02/16 21:15:00 5668 2 : SUBROUTINE IDMAT4 (NUMP1,NUMP2,NUDIR1,NUDIR2,ANG,MELEME,MINTE, 3 : . IPVAL,NPG2,MINTE2) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : * 7 : ************************************************************************ 8 : * 9 : * I D M A T 4 10 : * ----------- 11 : * 12 : * FONCTION: 13 : * --------- 14 : * 15 : * CALCUL DES COS-DIR. DES AXES ORTH. (OU ANISO.)PAR RAPPORT AU 16 : * 17 : * REPERE LOCAL D'ELEMENT , A PARTIR D'UNE DEFINITION GLOBALE 18 : * 19 : * 20 : * MODULES UTILISES: 21 : * ----------------- 22 : * 23 : -INC SMCOORD 24 : -INC CCOPTIO 25 : -INC CCREEL 26 : -INC SMELEME 27 : -INC SMINTE 28 : * 29 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 30 : * ----------- 31 : * 32 : * NUMP1 (E) NUMERO DU POINT P1 ASSOCIE A NUDIR1 33 : * NUMP2 (E) NUMERO DU POINT P2 ASSOCIE A NUDIR1 34 : * NUDIR1 (E) NUMERO DE DIRECTIVE UTILISEE DANS LA LISTE: 35 : * "DIRECTION", "RADIAL" 36 : * NUDIR2 (E) NUMERO DE DIRECTIVE UTILISEE DANS LA LISTE: 37 : * "PARALLELE", "PERPENDIC.", "INCLINE", 38 : * POUR LA DEFINITION DES DIRECTIONS D'ORTHOTROPIE. 39 : * ANG (E) ANGLE UTILISE DANS LA DEFINITION DES DIRECTIONS 40 : * D ORTHOTROPIE (INCLINE) 41 : * MELEME (E) POINTEUR DE "MAILLAGE" A 1 SEUL TYPE D'ELEMENT. 42 : * MINTE (E) SEGMENT CONTENANT LES FONCTIONS DE FORME,ET LEURS 43 : * DERIVEES 44 : * XVAL (S) DIRECTIONS D'ORTHOTROPIE PAR ELEMENT, 45 : * ON FOURNIT LES COSINUS DIRECTEURS DE L'AXE 1 46 : * EN BIDIM ,ET LES COSINUS DIRECTEURS DES AXES 1 ET 47 : * 2 EN TRIDIM,PAR RAPPORT AU REPERE LOCAL DE L'ELEMENT 48 : * 49 : * 50 : * VARIABLES: 51 : *----------- 52 : * VGLOB1,VGLOB2,VGLOB3 = COS.DIRECTEURS DES AXES 1, 2 ET 3 D'ORTH. PAR 53 : * RAPPOT AU REPERE GLOBAL 54 : * TXR = TABLEAU CONTENANT LES COS.DIRECTEURS DES AXES LOCAUX PAR 55 : * RAPPORT AU REPERE GLOBAL 56 : * 57 : * 58 : * REMARQUES: 59 : * ---------- 60 : * 61 : * LES DIRECTION P1 ET P2 DEFINISSENT LE PLAN QUI CONTIENT LES AXES 1,2 62 : * NUDIR2 =1 SIGNIFIE QUE L'AXE 1 EST PARALLELE A LA DIRECTION P1, 63 : * NUDIR2 =2 SIGNIFIE QUE L'AXE 1 EST PERPENDICULAIRE A LA DIRECTION P1, 64 : * NUDIR2 =3 SIGNIFIE QUE L'AXE 1 FAIT AN ANGLE DE (ANG) AVEC LA 65 : * DIRECTION P1 66 : * 67 : * 68 : * AUTEUR, DATE DE CREATION: 69 : * ------------------------- 70 : * 71 : * P. DOWLATYARI OCT. 1990 72 : * 73 : * LANGAGE: 74 : * -------- 75 : * FORTRAN 77 + ESOPE 76 : * 77 : * 78 : ************************************************************************ 79 : * 80 : * 81 : DIMENSION VGLOB1(3),VGLOB2(3),VGLOB3(3),VAUX1(3),VAUX2(3) 82 : DIMENSION VPT1(3),VPT2(3) 83 : * 84 : SEGMENT YVAL 85 : REAL*8 VLOC1(IDIM,NPG2,NBELEM),VLOC2(IDIM,NPG2,NBELEM) 86 : ENDSEGMENT 87 : * 88 : SEGMENT WORK 89 : REAL*8 XE(3,NBNN),TXR(IDIM,IDIM) 90 : ENDSEGMENT 91 : * 92 : SEGACT MELEME 93 : NBELEM=NUM(/2) 94 : NBNN=NUM(/1) 95 : SEGACT MINTE 96 : IF(NUDIR1.EQ.2) SEGACT MINTE2 97 : * 98 : * DIRECTIONS FOURNIES 99 : * 100 : IF (IDIM.EQ.2)THEN 101 : * 102 : * EXTRAIRE LES COORDONNEES DU POINT NUMP1 103 : * 103 : CALL EXCOO1 (NUMP1,VPT1(1),VPT1(2),VPT1(3),REEL1) 104 : * 105 : IF(NUDIR1.EQ.2) THEN 106 : VAUX1(1)=VPT1(1) 107 : VAUX1(2)=VPT1(2) 108 : GO TO 15 109 : ENDIF 110 : * 111 : * NORMALISATION 112 : * 113 : VNORM=DSQRT(VPT1(1)*VPT1(1)+VPT1(2)*VPT1(2)) 114 : IF (VNORM.EQ.0.) THEN 114 : CALL ERREUR (524) 115 : SEGDES,MINTE,MELEME 116 : RETURN 117 : ENDIF 118 : VGLOB1(1)=VPT1(1)/VNORM 119 : VGLOB1(2)=VPT1(2)/VNORM 120 : VGLOB2(1)=-VGLOB1(2) 121 : VGLOB2(2)=VGLOB1(1) 122 : * 123 : IF(NUDIR2.EQ.2)THEN 124 : * 125 : * ON EFFECTUE UNE ROTATION DE 90 DEGRE AUTOUR DE L'AXE 3 126 : * 127 : VGLOB1(1)=VGLOB2(1) 128 : VGLOB1(2)=VGLOB2(2) 129 : * 130 : ELSEIF(NUDIR2.EQ.3)THEN 131 : * 132 : * ON EFFECTUE UNE ROTATION DE (ANG) DEGRE AUTOUR DE L'AXE 3 133 : * 134 : COSA=DCOS(ANG) 135 : SINA=DSIN(ANG) 136 : VGLOB1(1)=VGLOB1(1)*COSA+VGLOB2(1)*SINA 137 : VGLOB1(2)=VGLOB1(2)*COSA+VGLOB2(2)*SINA 138 : ENDIF 139 : * 140 : ELSEIF(IDIM.EQ.3)THEN 141 : * 142 : * COORDONNEES DU POINT P1 143 : * 143 : CALL EXCOO1 (NUMP1,VPT1(1),VPT1(2),VPT1(3),REEL1) 144 : * 145 : IF(NUDIR1.NE.2) THEN 146 : * 147 : * NORMALISATION 148 : * 149 : VNORM=DSQRT(VPT1(1)*VPT1(1)+VPT1(2)*VPT1(2)+ 150 : . VPT1(3)*VPT1(3)) 151 : IF (VNORM.EQ.0.) THEN 151 : CALL ERREUR (524) 152 : SEGDES,MINTE,MELEME 153 : RETURN 154 : ENDIF 155 : VGLOB1(1)=VPT1(1)/VNORM 156 : VGLOB1(2)=VPT1(2)/VNORM 157 : VGLOB1(3)=VPT1(3)/VNORM 158 : ENDIF 159 : * 160 : * COORDONNEES DU POINT P2 161 : * 161 : CALL EXCOO1 (NUMP2,VPT2(1),VPT2(2),VPT2(3),REEL1) 162 : * 163 : IF(NUDIR1.EQ.2) THEN 164 : VGLOB1(1)=VPT2(1)-VPT1(1) 165 : VGLOB1(2)=VPT2(2)-VPT1(2) 166 : VGLOB1(3)=VPT2(3)-VPT1(3) 167 : * 168 : * NORMALISATION 169 : * 170 : VNORM=DSQRT(VGLOB1(1)*VGLOB1(1)+VGLOB1(2)*VGLOB1(2)+ 171 : . VGLOB1(3)*VGLOB1(3)) 172 : VGLOB1(1)=VGLOB1(1)/VNORM 173 : VGLOB1(2)=VGLOB1(2)/VNORM 174 : VGLOB1(3)=VGLOB1(3)/VNORM 175 : GO TO 15 176 : ENDIF 177 : * 178 : * PRODUIT VECTORIEL DES DEUX VECTEURS ET NORMALISATION 179 : * 179 : CALL CROSS2 (VGLOB1(1),VPT2(1),VGLOB3(1),IRR) 180 : IF (IRR.EQ.0)THEN 181 : * 182 : * DIRECTIONS D'ORTHOTROPIE MAL FOURNIES 183 : * 183 : CALL ERREUR (524) 184 : SEGDES,MINTE,MELEME 185 : IF(NUDIR1.EQ.2) SEGDES MINTE2 186 : RETURN 187 : ENDIF 187 : CALL CROSS2 (VGLOB3(1),VGLOB1(1),VGLOB2(1),IRR) 188 : * 189 : IF(NUDIR2.EQ.2)THEN 190 : * 191 : * ON EFFECTUE UNE ROTATION DE 90 DEGRE AUTOUR DE L'AXE 3 192 : * 193 : REEL1=VGLOB1(1) 194 : VGLOB1(1)=VGLOB2(1) 195 : VGLOB2(1)=-REEL1 196 : REEL1=VGLOB1(2) 197 : VGLOB1(2)=VGLOB2(2) 198 : VGLOB2(2)=-REEL1 199 : REEL1=VGLOB1(3) 200 : VGLOB1(3)=VGLOB2(3) 201 : VGLOB2(3)=-REEL1 202 : * 203 : ELSEIF(NUDIR2.EQ.3)THEN 204 : * 205 : * ON EFFECTUE UNE ROTATION DE (ANG) DEGRE AUTOUR DE L'AXE 3 206 : * 207 : COSA=DCOS(ANG) 208 : SINA=DSIN(ANG) 209 : REEL1=VGLOB1(1) 210 : VGLOB1(1)=VGLOB1(1)*COSA+VGLOB2(1)*SINA 211 : VGLOB2(1)=-REEL1*SINA+VGLOB2(1)*COSA 212 : REEL1=VGLOB1(2) 213 : VGLOB1(2)=VGLOB1(2)*COSA+VGLOB2(2)*SINA 214 : VGLOB2(2)=-REEL1*SINA+VGLOB2(2)*COSA 215 : REEL1=VGLOB1(3) 216 : VGLOB1(3)=VGLOB1(3)*COSA+VGLOB2(3)*SINA 217 : VGLOB2(3)=-REEL1*SINA+VGLOB2(3)*COSA 218 : ENDIF 219 : ENDIF 220 : * 221 : 15 CONTINUE 222 : * 223 : SEGINI YVAL 224 : IPVAL=YVAL 225 : SEGINI WORK 226 : * 227 : * BOUCLE SUR LES ELEMENTS 228 : * 229 : DO 10 IEL=1,NBELEM 230 : * 231 : DO 20 NC=1,IDIM 232 : DO 20 NV=1,NPG2 233 : VLOC1(NC,NV,IEL)=0.D0 234 : VLOC2(NC,NV,IEL)=0.D0 235 : 20 CONTINUE 236 : * 237 : * COORDONNEES DES NOEUDS 238 : * 238 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE) 239 : * 240 : * CALCUL DU REPERE LOCAL DE L'ELEMENT 241 : * 242 : NBSH=SHPTOT(/2) 242 : CALL RLOCAL(XE,SHPTOT,NBSH,NBNN,TXR) 243 : if (nbsh.eq.-1) then 243 : call erreur(525) 244 : return 245 : endif 246 : IF(IERR.NE.0)THEN 247 : SEGSUP,WORK,YVAL 248 : SEGDES , MELEME,MINTE 249 : IF(NUDIR1.EQ.2) SEGDES MINTE2 250 : RETURN 251 : ENDIF 252 : * 253 : * ON BOUCLE SUR LES POINTS DE GAUSS 254 : * 255 : DO 80 IGAU=1,NPG2 256 : 257 : IF (NUDIR1.EQ.2) THEN 258 : DO 25 ICO=1,IDIM 259 : VAUX2(ICO)=0.D0 260 : DO 25 ID=1,NBNN 261 : VAUX2(ICO)=VAUX2(ICO)+ 262 : . MINTE2.SHPTOT(1,ID,IGAU)*XE(ICO,ID) 263 : 25 CONTINUE 264 : * 265 : IF(IDIM.EQ.2) THEN 266 : VGLOB1(1)=VAUX1(1)-VAUX2(1) 267 : VGLOB1(2)=VAUX1(2)-VAUX2(2) 268 : * 269 : * NORMALISATION 270 : * 271 : VNORM=DSQRT(VGLOB1(1)*VGLOB1(1)+VGLOB1(2)*VGLOB1(2)) 272 : VGLOB1(1)=VGLOB1(1)/VNORM 273 : VGLOB1(2)=VGLOB1(2)/VNORM 274 : VGLOB2(1)=-VGLOB1(2) 275 : VGLOB2(2)=VGLOB1(1) 276 : * 277 : IF(NUDIR2.EQ.2)THEN 278 : * 279 : * ON EFFECTUE UNE ROTATION DE 90 DEGRE AUTOUR DE L'AXE 3 280 : * 281 : VGLOB1(1)=VGLOB2(1) 282 : VGLOB1(2)=VGLOB2(2) 283 : * 284 : ELSEIF(NUDIR2.EQ.3)THEN 285 : * 286 : * ON EFFECTUE UNE ROTATION DE (ANG) DEGRE AUTOUR DE L'AXE 3 287 : * 288 : COSA=DCOS(ANG) 289 : SINA=DSIN(ANG) 290 : VGLOB1(1)=VGLOB1(1)*COSA+VGLOB2(1)*SINA 291 : VGLOB1(2)=VGLOB1(2)*COSA+VGLOB2(2)*SINA 292 : ENDIF 293 : ENDIF 294 : * 295 : IF(IDIM.EQ.3) THEN 296 : VAUX1(1)=VAUX2(1)-VPT2(1) 297 : VAUX1(2)=VAUX2(2)-VPT2(2) 298 : VAUX1(3)=VAUX2(3)-VPT2(3) 299 : PSC=VAUX1(1)*VGLOB1(1)+VAUX1(2)*VGLOB1(2)+VAUX1(3)*VGLOB1(3) 300 : VGLOB2(1)=VAUX1(1)-PSC*VGLOB1(1) 301 : VGLOB2(2)=VAUX1(2)-PSC*VGLOB1(2) 302 : VGLOB2(3)=VAUX1(3)-PSC*VGLOB1(3) 303 : * NORMALISATION 304 : VNORM=DSQRT(VGLOB2(1)*VGLOB2(1)+VGLOB2(2)*VGLOB2(2)+ 305 : . VGLOB2(3)*VGLOB2(3)) 306 : VGLOB2(1)=VGLOB2(1)/VNORM 307 : VGLOB2(2)=VGLOB2(2)/VNORM 308 : VGLOB2(3)=VGLOB2(3)/VNORM 309 : * 310 : * PRODUIT VECTORIEL DES DEUX VECTEURS ET NORMALISATION 311 : * 311 : CALL CROSS2 (VGLOB1(1),VGLOB2(1),VGLOB3(1),IRR) 312 : * 313 : IF (IRR.EQ.0)THEN 313 : CALL ERREUR (524) 314 : SEGDES,MINTE,MELEME 315 : IF(NUDIR1.EQ.2) SEGDES MINTE2 316 : RETURN 317 : ENDIF 318 : * 319 : IF(NUDIR2.EQ.2)THEN 320 : * 321 : * ON EFFECTUE UNE ROTATION DE 90 DEGRE AUTOUR DE L'AXE 3 322 : * 323 : REEL1=VGLOB1(1) 324 : VGLOB1(1)=VGLOB2(1) 325 : VGLOB2(1)=-REEL1 326 : REEL1=VGLOB1(2) 327 : VGLOB1(2)=VGLOB2(2) 328 : VGLOB2(2)=-REEL1 329 : REEL1=VGLOB1(3) 330 : VGLOB1(3)=VGLOB2(3) 331 : VGLOB2(3)=-REEL1 332 : * 333 : ELSEIF(NUDIR2.EQ.3)THEN 334 : * 335 : * ON EFFECTUE UNE ROTATION DE (ANG) DEGRE AUTOUR DE L'AXE 3 336 : * 337 : COSA=DCOS(ANG) 338 : SINA=DSIN(ANG) 339 : REEL1=VGLOB1(1) 340 : VGLOB1(1)=VGLOB1(1)*COSA+VGLOB2(1)*SINA 341 : VGLOB2(1)=-REEL1*SINA+VGLOB2(1)*COSA 342 : REEL1=VGLOB1(2) 343 : VGLOB1(2)=VGLOB1(2)*COSA+VGLOB2(2)*SINA 344 : VGLOB2(2)=-REEL1*SINA+VGLOB2(2)*COSA 345 : REEL1=VGLOB1(3) 346 : VGLOB1(3)=VGLOB1(3)*COSA+VGLOB2(3)*SINA 347 : VGLOB2(3)=-REEL1*SINA+VGLOB2(3)*COSA 348 : ENDIF 349 : ENDIF 350 : ENDIF 351 : * 352 : * CALCUL DES COS.DIRECTEURS DU REPERE LOCAL / REPERE GLOBAL 353 : * 354 : IF(IDIM.EQ.2)THEN 355 : VLOC1(1,IGAU,IEL)=TXR(1,1)*VGLOB1(1)+TXR(2,1)*VGLOB1(2) 356 : VLOC1(2,IGAU,IEL)=TXR(1,2)*VGLOB1(1)+TXR(2,2)*VGLOB1(2) 357 : * 358 : ELSEIF(IDIM.EQ.3)THEN 359 : DO 40 J=1,3 360 : DO 40 I=1,3 361 : VLOC1(J,IGAU,IEL)=VLOC1(J,IGAU,IEL)+VGLOB1(I)*TXR(I,J) 362 : VLOC2(J,IGAU,IEL)=VLOC2(J,IGAU,IEL)+VGLOB2(I)*TXR(I,J) 363 : 40 CONTINUE 364 : ENDIF 365 : * 366 : 80 CONTINUE 367 : 10 CONTINUE 368 : * 369 : * DESACTIVATION DES SEGMENTS 370 : * 371 : SEGSUP,WORK 372 : SEGDES , MELEME,MINTE,YVAL 373 : IF(NUDIR1.EQ.2) SEGDES MINTE2 374 : * 375 : RETURN 376 : END 377 : 378 : 379 : 380 : 381 : 382 : 383 : 384 :
© Cast3M 2003 - All rights reserved.
Disclaimer