1 : C TRJPEL SOURCE CHAT 05/01/13 03:50:28 5004 2 : SUBROUTINE TRJPEL(IZPART,IZREF,MELEME,IZVIT,IZCOU,IZCENT,IELTFA, 3 : * IZSH,TTEMP) 4 : C 5 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 6 : C 7 : C PREMIERE LOCALISATION DE CHAQUE PARTICULE 8 : C ON FINIT DE REMPLIR LES SEGMENTS IZPART ET IZREF : 9 : C CALCUL DES APPARTENANCES (NLEPA) DES PARTICULES 10 : C ET DES COORDONNEES DE REFERENCES (IZREF.COORPA) 11 : C 12 : C ISSU DU SP PELTAR DE TRIO-EF 13 : C 14 : C IZPART segment contenant la position de chaque particule dans 15 : C les coordonnées reelles 16 : C NLEPA = numéro de l'élément dans lequel se trouve la particule 17 : C NUMPA = numéro de la particule( diff du no d'ordre ) 18 : C COORPA = coordonnées de la particule 19 : C 20 : C IZREF segment contenant la position de chaque particule dans 21 : C les coordonnées de référence 22 : C 23 : C MELEME pointeur du maillage 24 : C 25 : C IZVIT segment genere dans TRJVIT ou TRJFLU et servant a decrire 26 : C les vitesses 27 : C 28 : C IZCENT pointeur du maillage centre des elements ( table DOMAINE) 29 : C 30 : C IELTFA pointeur du maillage DOMAINE.ELTFA 31 : C 32 : C IZSH pointeur du segment de travail pour le calcul des 33 : C fonctions de forme 34 : C 35 : C TTEMP temps auquel est faite la recherche 36 : C 37 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 38 : C 39 : C 40 : IMPLICIT INTEGER(I-N) 41 : IMPLICIT REAL*8 (A-H,O-Z) 42 : C 43 : -INC CCOPTIO 44 : -INC SMCOORD 45 : -INC SMELEME 46 : -INC SMCHPOI 47 : C 48 : POINTEUR IZCENT.MELEME,IELTFA.MELEME,IZFAC1.MELEME 49 : C 50 : SEGMENT IZPART 51 : INTEGER NLEPA(NPART),NUMPA(NPART) 52 : REAL*8 COORPA(NDIM,NPART) 53 : ENDSEGMENT 54 : POINTEUR IZREF.IZPART 55 : SEGMENT IZCOU 56 : REAL*8 DTCO(NEL),COU 57 : ENDSEGMENT 58 : C 59 : SEGMENT IZTRAV 60 : REAL*8 COOR(NDIM,NPART) 61 : ENDSEGMENT 62 : SEGMENT IZSH 63 : REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9) 64 : ENDSEGMENT 65 : C 66 : SEGMENT IZNOEU 67 : REAL*8 XELE(IDIM,NOEL) 68 : INTEGER NOEGLO(NOEL) 69 : ENDSEGMENT 70 : C 71 : C ce segment de travail ne sort pas de TRJPEL il est chargé dans 72 : C TRJTRI TRJQUA TRJPRI TRJCUB 73 : SEGMENT IZAPAR 74 : INTEGER IAPAR(4,NPART) 75 : ENDSEGMENT 76 : C IAPART( ,IPART) où se trouve la particule IPART 77 : C IAPAR(1,IPART) NUMERO DE L'ELEMENT OU 0 78 : C IAPAR(2,IPART) NUMERO DE LA FACE OU 0 (3D) 79 : C IAPAR(3,IPART) NUMERO DE L'ARETE OU 0 80 : C IAPAR(4,IPART) NUMERO DU NOEUD OU 0 81 : C 82 : SEGMENT IZVIT 83 : REAL*8 TEMTRA(NVIPT) 84 : INTEGER IPUN(NBS),IDUN(NBS),IPVPT(NVIPT),IFORML 85 : ENDSEGMENT 86 : C IDUN(I) nombre d elements avant le sous maillage I 87 : C IPVPT pointeurs de izvpt pour chaque pas de temps 88 : SEGMENT IZVPT 89 : INTEGER IPUN1(NBS),IPUMAX 90 : ENDSEGMENT 91 : SEGMENT IZUN 92 : REAL*8 UN(I1,I2,I3) 93 : ENDSEGMENT 94 : POINTEUR IZUN1.IZUN ,IZUN2.IZUN 95 : SEGMENT IZUMAX 96 : REAL*8 UMAX(NBREL) 97 : ENDSEGMENT 98 : POINTEUR IZUMA1.IZUMAX 99 : C 100 : C 101 : DIMENSION XYREF(3),ZXY(3),UELEM(3) 102 : DIMENSION XNTRI1(2,3),XNTRI2(2,7),XNQUA1(2,4),XNQUA2(2,9) 103 : DIMENSION XNPRI(3,6),XNCUB(3,8),XNTET(3,4),TLI(4) 104 : C 105 : DATA XNTRI1/0.D0,0.D0, 1.D0,0.D0, 0.D0,1.D0/ 106 : DATA XNTRI2/0.D0,0.D0, 0.5D0,0.D0, 1.D0,0.D0, 0.5D0,0.5D0, 107 : * 0.D0,1.D0, 0.D0,0.5D0, 0.33333333D0,0.33333333D0/ 108 : DATA XNQUA1/-1.D0,-1.D0, 1.D0,-1.D0, 1.D0,1.D0, -1.D0,1.D0/ 109 : DATA XNQUA2/-1.D0,-1.D0, 0.D0,-1.D0, 1.D0,-1.D0, 1.D0,0.D0, 110 : * 1.D0,1.D0, 0.D0,1.D0, -1.D0,1.D0, -1.D0,0.D0, 0.D0,0.D0/ 111 : DATA XNPRI/0.D0,0.D0,-1.D0, 1.D0,0.D0,-1.D0, 0.D0,1.D0,-1.D0, 112 : * 0.D0,0.D0,1.D0, 1.D0,0.D0,1.D0, 0.D0,1.D0,1.D0/ 113 : DATA XNCUB/-1.D0,-1.D0,-1.D0, 1.D0,-1.D0,-1.D0, 1.D0,1.D0,-1.D0, 114 : * -1.D0,1.D0,-1.D0, -1.D0,-1.D0,1.D0, 1.D0,-1.D0,1.D0, 115 : * 1.D0,1.D0,1.D0, -1.D0,1.D0,1.D0/ 116 : DATA XNTET/0.D0,0.D0,0.D0, 1.D0,0.D0,0.D0, 0.D0,1.D0,0.D0, 117 : * 0.D0,0.D0,1.D0/ 118 : C 119 : NEL=DTCO(/1) 120 : EPS=1.D-05 121 : COUR=0.001D0 122 : NPART=COORPA(/2) 123 : NDIM=COORPA(/1) 124 : SEGINI IZAPAR,IZTRAV 125 : C write(6,*)' SEGINI IZAPAR,IZTRAV', IZAPAR,IZTRAV 126 : DO 1 IPART=1,NPART 127 : IZREF.NUMPA(IPART)=IPART 128 : 1 CONTINUE 129 : LONG=4*NPART 129 : CALL INITI(IAPAR,LONG,0) 130 : DO 3 IPART=1,NPART 131 : DO 2 I=1,NDIM 132 : COOR(I,IPART)=COORPA(I,IPART) 133 : 2 CONTINUE 134 : 3 CONTINUE 135 : SEGACT IZVIT 136 : NVIPT=TEMTRA(/1) 137 : IF(NVIPT.EQ.1)THEN 138 : IVIPT=1 139 : IZVPT=IPVPT(1) 140 : SEGACT IZVPT 141 : IZUMAX=IPUMAX 142 : IZUMA1=IPUMAX 143 : SEGACT IZUMAX 144 : SEGDES IZVPT 145 : ELSE 146 : IVIPT=2 146 : CALL TRJTPT(IZVIT,TTEMP,IVIPT) 147 : IZVPT=IPVPT(IVIPT) 148 : SEGACT IZVPT 149 : IZUMAX=IPUMAX 150 : SEGACT IZUMAX 151 : SEGDES IZVPT 152 : IZVPT=IPVPT(IVIPT-1) 153 : SEGACT IZVPT 154 : IZUMA1=IPUMAX 155 : SEGACT IZUMA1 156 : SEGDES IZVPT 157 : ENDIF 158 : IFORMU=IFORML 159 : C 160 : C*** BOUCLE ELEMENT 161 : C 162 : NPAPAR=0 163 : NEL0=0 164 : SEGACT MELEME,IELTFA,IZCENT 165 : NBSOUS=LISOUS(/1) 166 : NBS=NBSOUS 167 : IF(NBSOUS.EQ.0) NBS=1 168 : IPT1=MELEME 169 : IZFAC1=IELTFA 170 : DO 93 ISOUS=1,NBS 171 : IF(NBSOUS.GT.0)THEN 172 : IPT1=LISOUS(ISOUS) 173 : IZFAC1=IELTFA.LISOUS(ISOUS) 174 : ENDIF 175 : SEGACT IPT1 176 : SEGACT IZFAC1 177 : NEL1=IPT1.NUM(/2) 178 : NEL=NEL0+NEL1 179 : DO 94 IEL=1,NEL1 180 : IEL1=IEL+NEL0 180 : CALL TRJVEL(IZVIT,IZUN,IEL1,IVIPT,TTEMP) 181 : IF(NPAPAR.GE.NPART)GO TO 100 182 : NOEL=IPT1.NUM(/1) 183 : ITP=IPT1.ITYPEL 184 : SEGINI IZNOEU 185 : C write(6,*)'SEGINI IZNOEU ', IZNOEU 185 : CALL PREXN(IPT1,IEL,IZNOEU) 186 : C ON RECUPERE LE NUMERO DU POINT CENTRE DE L ELEMENT 187 : C PUIS ON VA CALCULER LA PLUS GRANDE DISTANCE CENTRE NOEUD 188 : C DE FACON A IGNORER LES PARTICULES TROP ELOIGNEES 189 : NUCENT=IZCENT.NUM(1,IEL1) 190 : IPCENT=(NUCENT-1)*(IDIM+1)+1 190 : CALL TRJDIS(XELE,XCOOR(IPCENT),DIAM2,NOEL,NDIM) 191 : DIAM2=DIAM2*1.4D+0 192 : C 1.4 COEF DE SECURITE POUR LES MAILLAGES TORDUS 193 : C 194 : C*** BOUCLE PARTICULES 195 : C 196 : DO 4 IPART=1,NPART 197 : IF(NPAPAR.GE.NPART)THEN 198 : SEGSUP IZNOEU 199 : GO TO 100 200 : ENDIF 201 : NAP=NPAPAR 202 : RAUX=0.D0 203 : DO 5 ID=1,NDIM 204 : RAUX=RAUX+(XCOOR(IPCENT+ID-1)-COORPA(ID,IPART))**2 205 : 5 CONTINUE 206 : RAUX=SQRT(RAUX) 207 : DIFF=DIAM2-RAUX 208 : C write(6,*)' raux diam2 ',iel,ipart,raux,diam2 209 : IF(DIFF.GE.0.D0) THEN 210 : NAP=NPAPAR 211 : C 212 : C*** TRIANGLES 213 : C 214 : IF(ITP.EQ.4.OR.ITP.EQ.6.OR.ITP.EQ.7)THEN 214 : CALL TRJTRI(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1, 215 : * INOELO,TLI) 216 : C write(6,*)' iapar t3',iel,ipart,(iapar(iii,ipart),iii=1,4) 217 : IF(NAP.EQ.NPAPAR) GO TO 4 218 : C 219 : C*** NOMBRE DE COURANT 220 : C 221 : IF(DTCO(IEL1).EQ.0.D0)THEN 221 : CALL DOXE(XCOOR,NDIM,NOEL,IPT1.NUM,IEL,XYZL) 221 : C CALL TRJCN5(ITP,IZSH) 222 : IF(IERR.GT.0) RETURN 223 : IF(IZUMAX.EQ.IZUMA1)THEN 224 : UEM=UMAX(IEL1) 225 : ELSE 226 : UEM=MAX(UMAX(IEL1),IZUMA1.UMAX(IEL1)) 227 : ENDIF 227 : CALL TRJCOU(UEM,IZCOU,IZFAC1,IEL,IEL1,NUCENT) 228 : ENDIF 229 : IF(IAPAR(4,IPART).NE.0)THEN 230 : C 231 : C*** APARTENANCE NOEUD 232 : C 233 : IF(ITP.EQ.4)THEN 234 : C 235 : C TRI3 236 : C 237 : XYREF(1)=XNTRI1(1,INOELO) 238 : XYREF(2)=XNTRI1(2,INOELO) 239 : ELSE 240 : C 241 : C TRI6-TRI7 242 : C 243 : XYREF(1)=XNTRI2(1,INOELO) 244 : XYREF(2)=XNTRI2(2,INOELO) 245 : ENDIF 246 : NPAPAR=NAP 246 : CALL TRJNOE(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL, 247 : * INOELO,IZPART,IZUN,IZCOU,ITP,IFORMU,XYREF) 248 : IF(NAP.EQ.NPAPAR)GO TO 4 249 : IZREF.COORPA(1,IPART)=XYREF(1) 250 : IZREF.COORPA(2,IPART)=XYREF(2) 251 : GO TO 200 252 : ENDIF 253 : IF(IAPAR(3,IPART).NE.0)THEN 254 : C 255 : C*** APARTENANCE ARETE 256 : C 257 : NPAPAR=NAP 257 : CALL TRJAPF(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL, 258 : * INOELO,IZPART,IZUN,IZCOU,ITP,IFORMU,IZSH) 259 : IF(NAP.EQ.NPAPAR)GO TO 4 260 : IZREF.COORPA(1,IPART)=TLI(2) 261 : IZREF.COORPA(2,IPART)=TLI(3) 262 : GO TO 200 263 : ENDIF 264 : C 265 : C*** APARTENANCE ELEMENT 266 : C 267 : DO 10 ID=1,NDIM 268 : ZXY(ID)=COOR(ID,IPART) 269 : 10 CONTINUE 270 : IER=0 270 : IF(ITP.EQ.4)CALL TRJ302(XELE,ZXY,XYREF) 270 : IF(ITP.EQ.6)CALL TRJ602(XELE,ZXY,XYREF,IER) 270 : IF(ITP.EQ.7)CALL TRJ702(XELE,ZXY,XYREF,IER) 271 : IF(IER.NE.0)THEN 271 : CALL ERREUR(IER) 272 : ENDIF 273 : DO 11 ID=1,NDIM 274 : IZREF.COORPA(ID,IPART)=XYREF(ID) 275 : 11 CONTINUE 276 : C 277 : C*** QUADRANGLES 278 : C 279 : ELSEIF(ITP.EQ.8.OR.ITP.EQ.11)THEN 279 : CALL TRJQUA(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1, 280 : * INOELO,TLI) 281 : C write(6,*)' iapar q4',iel,ipart,(iapar(iii,ipart),iii=1,4) 282 : C write(6,*)' nap npapar ' ,nap,npapar 283 : IF(NAP.EQ.NPAPAR) GO TO 4 284 : C 285 : C*** NOMBRE DE COURANT 286 : C 287 : IF(DTCO(IEL).EQ.0.D0)THEN 287 : CALL DOXE(XCOOR,NDIM,NOEL,IPT1.NUM,IEL,XYZL) 287 : C CALL TRJCN5(ITP,IZSH) 288 : IF(IERR.GT.0) RETURN 289 : IF(IZUMAX.EQ.IZUMA1)THEN 290 : UEM=UMAX(IEL1) 291 : ELSE 292 : UEM=MAX(UMAX(IEL1),IZUMA1.UMAX(IEL1)) 293 : ENDIF 293 : CALL TRJCOU(UEM,IZCOU,IZFAC1,IEL,IEL1,NUCENT) 294 : ENDIF 295 : C 296 : C*** APARTENANCE NOEUD 297 : C 298 : IF(IAPAR(4,IPART).NE.0)THEN 299 : IF(ITP.EQ.8)THEN 300 : C 301 : C QUA4 302 : C 303 : XYREF(1)=XNQUA1(1,INOELO) 304 : XYREF(2)=XNQUA1(2,INOELO) 305 : ELSE 306 : C 307 : C QUA9 308 : C 309 : XYREF(1)=XNQUA2(1,INOELO) 310 : XYREF(2)=XNQUA2(2,INOELO) 311 : ENDIF 312 : NPAPAR=NAP 312 : CALL TRJNOE(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL, 313 : * INOELO,IZPART,IZUN,IZCOU,ITP,IFORMU,XYREF) 314 : IF(NAP.EQ.NPAPAR)GO TO 4 315 : C 316 : IZREF.COORPA(1,IPART)=XYREF(1) 317 : IZREF.COORPA(2,IPART)=XYREF(2) 318 : GO TO 200 319 : ENDIF 320 : IF(IAPAR(3,IPART).NE.0)THEN 321 : C 322 : C*** APARTENANCE ARETE 323 : C 324 : NPAPAR=NAP 325 : I1=IAPAR(1,IPART) 326 : I3=IAPAR(3,IPART) 326 : CALL TRJAPF(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL, 327 : * INOELO,IZPART,IZUN,IZCOU,ITP,IFORMU,IZSH) 328 : IF(NAP.EQ.NPAPAR)GO TO 4 329 : IARET=I3 330 : GO TO (300,310,320,330)IARET 331 : 300 CONTINUE 332 : IZREF.COORPA(1,IPART)=1.D0-2.D0*TLI(3) 333 : IZREF.COORPA(2,IPART)=-1.D0 334 : GO TO 200 335 : 310 CONTINUE 336 : IZREF.COORPA(1,IPART)=1.D0 337 : IZREF.COORPA(2,IPART)=2.D0*TLI(2)-1.D0 338 : GO TO 200 339 : 320 CONTINUE 340 : IZREF.COORPA(1,IPART)=2.D0*TLI(3)-1.D0 341 : IZREF.COORPA(2,IPART)=1.D0 342 : GO TO 200 343 : 330 CONTINUE 344 : IZREF.COORPA(1,IPART)=-1.D0 345 : IZREF.COORPA(2,IPART)=1.D0-2.D0*TLI(2) 346 : GO TO 200 347 : ENDIF 348 : C 349 : C*** APARTENANCE ELEMENT 350 : C 351 : DO 16 ID=1,NDIM 352 : ZXY(ID)=COOR(ID,IPART) 353 : 16 CONTINUE 354 : IER=0 354 : IF(ITP.EQ.8)CALL TRJ402(XELE,ZXY,XYREF,IER) 354 : IF(ITP.EQ.11)CALL TRJ902(XELE,ZXY,XYREF,IER) 355 : IF(IER.NE.0)THEN 355 : CALL ERREUR(IER) 356 : ENDIF 357 : DO 17 ID=1,NDIM 358 : IZREF.COORPA(ID,IPART)=XYREF(ID) 359 : 17 CONTINUE 360 : C 361 : C*** PRISMES 362 : C 363 : ELSEIF(ITP.EQ.16)THEN 363 : CALL TRJPRI(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,INOELO, 364 : * TLI,ITRI) 365 : C write(6,*)' iapar ',iel,(iapar(idd,ipart),idd=1,4) 366 : IF(NAP.EQ.NPAPAR) GO TO 4 367 : C 368 : C*** NOMBRE DE COURANT 369 : C 370 : IF(DTCO(IEL).EQ.0.D0)THEN 370 : CALL DOXE(XCOOR,NDIM,NOEL,IPT1.NUM,IEL,XYZL) 370 : C CALL TRJCN5(ITP,IZSH) 371 : IF(IERR.GT.0) RETURN 372 : IF(IZUMAX.EQ.IZUMA1)THEN 373 : UEM=UMAX(IEL1) 374 : ELSE 375 : UEM=MAX(UMAX(IEL1),IZUMA1.UMAX(IEL1)) 376 : ENDIF 376 : CALL TRJCOU(UEM,IZCOU,IZFAC1,IEL,IEL1,NUCENT) 377 : ENDIF 378 : IF(IAPAR(4,IPART).NE.0) THEN 379 : C 380 : C*** APARTENANCE NOEUD 381 : C 382 : DO 21 ID=1,NDIM 383 : XYREF(ID)=XNPRI(ID,INOELO) 384 : 21 CONTINUE 385 : NPAPAR=NAP 385 : CALL TRJNOE(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL, 386 : * INOELO,IZPART,IZUN,IZCOU,ITP,IFORMU,XYREF) 387 : IF(NAP.EQ.NPAPAR)GO TO 4 388 : DO 20 ID=1,NDIM 389 : IZREF.COORPA(ID,IPART)=XNPRI(ID,INOELO) 390 : 20 CONTINUE 391 : GO TO 200 392 : ENDIF 393 : IF(IAPAR(3,IPART).NE.0) THEN 394 : C 395 : C*** APARTENANCE ARETE 396 : C 397 : NPAPAR=NAP 398 : I1=IAPAR(1,IPART) 399 : I3=IAPAR(3,IPART) 399 : CALL TRJART(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL, 400 : * INOELO,IZPART,IZUN,IZCOU,ITP,IFORMU,IZSH) 401 : IF(NAP.EQ.NPAPAR)GO TO 4 402 : IARET=I3 403 : GO TO (400,410,420,430,440,450)IARET 404 : 400 CONTINUE 405 : IZREF.COORPA(1,IPART)=0.D0 406 : IF(ITRI.EQ.3)IZREF.COORPA(2,IPART)=1.D0-TLI(2) 407 : IF(ITRI.EQ.2)IZREF.COORPA(2,IPART)=1.D0-TLI(3) 408 : IZREF.COORPA(3,IPART)=-1.D0 409 : GO TO 200 410 : 410 CONTINUE 411 : IZREF.COORPA(1,IPART)=0.D0 412 : IZREF.COORPA(2,IPART)=TLI(2) 413 : IZREF.COORPA(3,IPART)=1.D0 414 : GO TO 200 415 : 420 CONTINUE 416 : IZREF.COORPA(1,IPART)=1.D0-TLI(3) 417 : IZREF.COORPA(2,IPART)=0.D0 418 : IZREF.COORPA(3,IPART)=-1.D0 419 : GO TO 200 420 : 430 CONTINUE 421 : IZREF.COORPA(1,IPART)=TLI(3) 422 : IZREF.COORPA(2,IPART)=0.D0 423 : IZREF.COORPA(3,IPART)=1.D0 424 : GO TO 200 425 : 440 CONTINUE 426 : IZREF.COORPA(1,IPART)=1.D0-TLI(2) 427 : IZREF.COORPA(2,IPART)=TLI(2) 428 : IZREF.COORPA(3,IPART)=-1.D0 429 : GO TO 200 430 : 450 CONTINUE 431 : IF(ITRI.EQ.1)IZREF.COORPA(1,IPART)=TLI(3) 432 : IF(ITRI.EQ.2)IZREF.COORPA(1,IPART)=TLI(2) 433 : IF(ITRI.EQ.1)IZREF.COORPA(2,IPART)=1.D0-TLI(3) 434 : IF(ITRI.EQ.2)IZREF.COORPA(2,IPART)=1.D0-TLI(2) 435 : IZREF.COORPA(3,IPART)=1.D0 436 : GO TO 200 437 : ENDIF 438 : IF(IAPAR(2,IPART).NE.0)THEN 439 : C 440 : C*** APPARTENANCES FACE ( 3D ) 441 : C 442 : NPAPAR=NAP 443 : I1=IAPAR(1,IPART) 444 : I2=IAPAR(2,IPART) 444 : CALL TRJAPF(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL, 445 : * INOELO,IZPART,IZUN,IZCOU,ITP,IFORMU,IZSH) 446 : IF(NPAPAR.EQ.NAP)GO TO 4 447 : IAPAR(1,IPART)=I1 448 : IAPAR(2,IPART)=I2 449 : ENDIF 450 : C 451 : C*** APARTENANCE ELEMENT 452 : C 453 : DO 25 ID=1,NDIM 454 : ZXY(ID)=COOR(ID,IPART) 455 : 25 CONTINUE 456 : IER=0 456 : CALL TRJ603(XELE,ZXY,XYREF,IER) 457 : IF(IER.NE.0)THEN 457 : CALL ERREUR(IER) 458 : ENDIF 459 : DO 26 ID=1,NDIM 460 : IZREF.COORPA(ID,IPART)=XYREF(ID) 461 : 26 CONTINUE 462 : C 463 : C*** CUBES 464 : C 465 : ELSEIF(ITP.EQ.14)THEN 465 : CALL TRJCUB(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL, 466 : * INOELO,TLI) 467 : IF(NAP.EQ.NPAPAR) GO TO 4 468 : C 469 : C*** NOMBRE DE COURANT 470 : C 471 : IF(DTCO(IEL).EQ.0.D0)THEN 471 : CALL DOXE(XCOOR,NDIM,NOEL,IPT1.NUM,IEL,XYZL) 471 : C CALL TRJCN5(ITP,IZSH) 472 : IF(IERR.GT.0) RETURN 473 : IF(IZUMAX.EQ.IZUMA1)THEN 474 : UEM=UMAX(IEL1) 475 : ELSE 476 : UEM=MAX(UMAX(IEL1),IZUMA1.UMAX(IEL1)) 477 : ENDIF 477 : CALL TRJCOU(UEM,IZCOU,IZFAC1,IEL,IEL1,NUCENT) 478 : ENDIF 479 : C 480 : C*** APARTENANCE NOEUD 481 : C 482 : IF(IAPAR(4,IPART).NE.0) THEN 483 : DO 28 ID=1,NDIM 484 : XYREF(ID)=XNCUB(ID,INOELO) 485 : 28 CONTINUE 486 : NPAPAR=NAP 486 : CALL TRJNOE(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL, 487 : * INOELO,IZPART,IZUN,IZCOU,ITP,IFORMU,XYREF) 488 : IF(NAP.EQ.NPAPAR)GO TO 4 489 : DO 29 ID=1,NDIM 490 : IZREF.COORPA(ID,IPART)=XNCUB(ID,INOELO) 491 : 29 CONTINUE 492 : GO TO 200 493 : ENDIF 494 : IF(IAPAR(3,IPART).NE.0)THEN 495 : C 496 : C*** APARTENANCE ARETE 497 : C 498 : NPAPAR=NAP 499 : I1=IAPAR(1,IPART) 500 : I3=IAPAR(3,IPART) 500 : CALL TRJART(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL, 501 : * INOELO,IZPART,IZUN,IZCOU,ITP,IFORMU,IZSH) 502 : IF(NAP.EQ.NPAPAR)GO TO 4 503 : IARET=I3 504 : GOTO (500,510,520,530,540,550,560,570,580,590,600,610), 505 : * IARET 506 : 500 CONTINUE 507 : IZREF.COORPA(1,IPART)=-1.D0 508 : IZREF.COORPA(2,IPART)=2.D0*TLI(3)-1.D0 509 : IZREF.COORPA(3,IPART)=-1.D0 510 : GO TO 200 511 : 510 CONTINUE 512 : IZREF.COORPA(1,IPART)=1.D0 513 : IZREF.COORPA(2,IPART)=1.D0-2.D0*TLI(2) 514 : IZREF.COORPA(3,IPART)=-1.D0 515 : GO TO 200 516 : 520 CONTINUE 517 : IZREF.COORPA(1,IPART)=1.D0 518 : IZREF.COORPA(2,IPART)=2.D0*TLI(3)-1.D0 519 : IZREF.COORPA(3,IPART)=1.D0 520 : GO TO 200 521 : 530 CONTINUE 522 : IZREF.COORPA(1,IPART)=-1.D0 523 : IZREF.COORPA(2,IPART)=1.D0-2.D0*TLI(3) 524 : IZREF.COORPA(3,IPART)=1.D0 525 : GO TO 200 526 : 540 CONTINUE 527 : IZREF.COORPA(1,IPART)=2.D0*TLI(2)-1.D0 528 : IZREF.COORPA(2,IPART)=-1.D0 529 : IZREF.COORPA(3,IPART)=-1.D0 530 : GO TO 200 531 : 550 CONTINUE 532 : IZREF.COORPA(1,IPART)=1.D0-2.D0*TLI(4) 533 : IZREF.COORPA(2,IPART)=1.D0 534 : IZREF.COORPA(3,IPART)=-1.D0 535 : GO TO 200 536 : 560 CONTINUE 537 : IZREF.COORPA(1,IPART)=2.D0*TLI(2)-1.D0 538 : IZREF.COORPA(2,IPART)=1.D0 539 : IZREF.COORPA(3,IPART)=1.D0 540 : GO TO 200 541 : 570 CONTINUE 542 : IZREF.COORPA(1,IPART)=1.D0-2.D0*TLI(2) 543 : IZREF.COORPA(2,IPART)=-1.D0 544 : IZREF.COORPA(3,IPART)=1.D0 545 : GO TO 200 546 : 580 CONTINUE 547 : IZREF.COORPA(1,IPART)=-1.D0 548 : IZREF.COORPA(2,IPART)=-1.D0 549 : IZREF.COORPA(3,IPART)=2.D0*TLI(4)-1.D0 550 : GO TO 200 551 : 590 CONTINUE 552 : IZREF.COORPA(1,IPART)=1.D0 553 : IZREF.COORPA(2,IPART)=-1.D0 554 : IZREF.COORPA(3,IPART)=1.D0-2.D0*TLI(4) 555 : GO TO 200 556 : 600 CONTINUE 557 : IZREF.COORPA(1,IPART)=1.D0 558 : IZREF.COORPA(2,IPART)=1.D0 559 : IZREF.COORPA(3,IPART)=2.D0*TLI(3)-1.D0 560 : GO TO 200 561 : 610 CONTINUE 562 : IZREF.COORPA(1,IPART)=-1.D0 563 : IZREF.COORPA(2,IPART)=1.D0 564 : IZREF.COORPA(3,IPART)=1.D0-2.D0*TLI(4) 565 : GO TO 200 566 : ENDIF 567 : IF(IAPAR(2,IPART).NE.0) THEN 568 : C 569 : C*** APPARTENANCES FACE ( 3D ) 570 : C 571 : NPAPAR=NAP 572 : I1=IAPAR(1,IPART) 573 : I2=IAPAR(2,IPART) 573 : CALL TRJAPF(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL, 574 : * INOELO,IZPART,IZUN,IZCOU,ITP,IFORMU,IZSH) 575 : IF(NPAPAR.EQ.NAP)GO TO 94 576 : IAPAR(1,IPART)=I1 577 : IAPAR(2,IPART)=I2 578 : ENDIF 579 : C 580 : C*** APARTENANCE ELEMENT 581 : C 582 : DO 34 ID=1,NDIM 583 : ZXY(ID)=COOR(ID,IPART) 584 : 34 CONTINUE 585 : IER=0 585 : CALL TRJ803(XELE,ZXY,XYREF,IER) 586 : IF(IER.NE.0)THEN 586 : CALL ERREUR(IER) 587 : ENDIF 588 : DO 35 ID=1,NDIM 589 : IZREF.COORPA(ID,IPART)=XYREF(ID) 590 : 35 CONTINUE 591 : C 592 : C*** TETRAEDRE 593 : C 594 : ELSEIF(ITP.EQ.23)THEN 594 : CALL TRJTET(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL,INOELO, 595 : * TLI) 596 : C write(6,*)' iapar ',iel,(iapar(idd,ipart),idd=1,4) 597 : C write(6,*)' inoelo',inoelo 598 : IF(NAP.EQ.NPAPAR) GO TO 4 599 : C 600 : C*** NOMBRE DE COURANT 601 : C 602 : IF(DTCO(IEL).EQ.0.D0) THEN 602 : CALL DOXE(XCOOR,NDIM,NOEL,IPT1.NUM,IEL,XYZL) 602 : C CALL TRJCN5(ITP,IZSH) 603 : IF(IERR.GT.0) RETURN 604 : IF(IZUMAX.EQ.IZUMA1)THEN 605 : UEM=UMAX(IEL1) 606 : ELSE 607 : UEM=MAX(UMAX(IEL1),IZUMA1.UMAX(IEL1)) 608 : ENDIF 608 : CALL TRJCOU(UEM,IZCOU,IZFAC1,IEL,IEL1,NUCENT) 609 : ENDIF 610 : IF(IAPAR(4,IPART).NE.0) THEN 611 : C 612 : C*** APARTENANCE NOEUD 613 : C 614 : DO 41 ID=1,NDIM 615 : XYREF(ID)=XNTET(ID,INOELO) 616 : 41 CONTINUE 617 : NPAPAR=NAP 617 : CALL TRJNOE(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL, 618 : * INOELO,IZPART,IZUN,IZCOU,ITP,IFORMU,XYREF) 619 : IF(NAP.EQ.NPAPAR)GO TO 4 620 : DO 40 ID=1,NDIM 621 : IZREF.COORPA(ID,IPART)=XNTET(ID,INOELO) 622 : 40 CONTINUE 623 : GO TO 200 624 : ENDIF 625 : IF(IAPAR(3,IPART).NE.0) THEN 626 : C 627 : C*** APARTENANCE ARETE 628 : C 629 : NPAPAR=NAP 630 : I1=IAPAR(1,IPART) 631 : I3=IAPAR(3,IPART) 631 : CALL TRJART(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL, 632 : * INOELO,IZPART,IZUN,IZCOU,ITP,IFORMU,IZSH) 633 : IF(NAP.EQ.NPAPAR)GO TO 4 634 : IARET=I3 635 : IZREF.COORPA(1,IPART)=TLI(2) 636 : IZREF.COORPA(2,IPART)=TLI(3) 637 : IZREF.COORPA(3,IPART)=TLI(4) 638 : GO TO 200 639 : ENDIF 640 : IF(IAPAR(2,IPART).NE.0)THEN 641 : C 642 : C*** APPARTENANCES FACE ( 3D ) 643 : C 644 : NPAPAR=NAP 645 : I1=IAPAR(1,IPART) 646 : I2=IAPAR(2,IPART) 646 : CALL TRJAPF(IZNOEU,IZTRAV,IZAPAR,NPAPAR,IPART,IEL1,IEL, 647 : * INOELO,IZPART,IZUN,IZCOU,ITP,IFORMU,IZSH) 648 : IF(NPAPAR.EQ.NAP)GO TO 4 649 : IAPAR(1,IPART)=I1 650 : IAPAR(2,IPART)=I2 651 : ENDIF 652 : C 653 : C*** APARTENANCE ELEMENT 654 : C 655 : DO 36 ID=1,NDIM 656 : ZXY(ID)=COOR(ID,IPART) 657 : 36 CONTINUE 657 : CALL TRJ403(XELE,ZXY,XYREF) 658 : DO 37 ID=1,NDIM 659 : IZREF.COORPA(ID,IPART)=XYREF(ID) 660 : 37 CONTINUE 661 : ENDIF 662 : 200 CONTINUE 663 : IZREF.NLEPA(IPART)=IEL1 664 : NLEPA(IPART)=IEL1 665 : ENDIF 666 : 4 CONTINUE 667 : C write(6,*)' SEGSUP IZNOEU ', IZNOEU 668 : SEGSUP IZNOEU 669 : 94 CONTINUE 670 : NEL0=NEL0+NEL1 671 : 93 CONTINUE 672 : 100 CONTINUE 673 : C write(6,*)'SEGSUP IZAPAR,IZTRAV',IZAPAR,IZTRAV 674 : SEGSUP IZAPAR,IZTRAV 675 : C 676 : END 677 : 678 : 679 : 680 : 681 :
© Cast3M 2003 - All rights reserved.
Disclaimer