Télécharger la plaquette Cast3M


fr en

Télécharger trjpel.eso

Retour à la liste

Numérotation des lignes : 

trjpel

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales