Télécharger la plaquette Cast3M


fr en

Télécharger trjior.eso

Retour à la liste

Numérotation des lignes : 

trjior

  1. C TRJIOR    SOURCE    CHAT      05/01/13    03:50:04     5004
  2.       SUBROUTINE TRJIOR(IELL,IELL2,IPT1,IPT2,IFA,JFA,IOR)
  3. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  4. C
  5. C  RECHERCHE IOR DEGRE DE ROTATION DES FACES EN CORRESPONDANCE
  6. C         IELL NUMERO DE L' ELEMENT DE DEPART (DANS LE SOUS MAILLAGE)
  7. C         IELL2 NUMERO DE L' ELEMENT D ARRIVE (DANS LE SOUS MAILLAGE)
  8. C         IPT1 POINTEUR DU SOUS MAILLAGE CONTENANT L'ELEMENT DE DEPART
  9. C         IPT2 POINTEUR DU SOUS MAILLAGE CONTENANT L'ELEMENT D ARRIVEE
  10. C         IFA NUMERO DE LA FACE DANS L'ELEMENT DE DEPART
  11. C         JFA NUMERO DE LA FACE DANS L'ELEMENT D'ARRIVEE
  12. C
  13. C
  14. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  15.       IMPLICIT INTEGER(I-N)
  16.       IMPLICIT REAL*8(A-H,O-Z)
  17. -INC SMELEME
  18.       DIMENSION ICUB1(4,6),ICUB2(4,6),IPRI1(4,5),IPRI2(4,5)
  19.       DIMENSION ITET1(3,4),ITET2(3,4)
  20.       DIMENSION LE(2,3),LF(3,4)
  21.       DATA ICUB1/1,2,3,4, 5,8,7,6, 1,5,6,2, 2,6,7,3, 4,3,7,8, 1,4,8,5/
  22.       DATA ICUB2/1,4,3,2, 5,6,7,8, 1,2,6,5, 2,3,7,6, 4,8,7,3, 1,5,8,4/
  23.       DATA IPRI2/1,3,2,0, 4,5,6,0, 1,2,5,4, 2,3,6,5, 1,4,6,3/
  24.       DATA IPRI1/1,2,3,0, 4,6,5,0, 1,4,5,2, 2,5,6,3, 1,3,6,4/
  25.       DATA ITET1/1,4,2, 1,2,3, 2,4,3, 1,3,4/
  26.       DATA ITET2/1,2,4, 1,3,2, 2,3,4, 1,4,3/
  27.       DATA LF/2,3,4, 3,4,1, 4,1,2, 1,2,3/
  28.       DATA LE/2,3, 3,1, 1,2/
  29. C
  30.       ITY=NUMGEO(IPT1.ITYPEL)
  31.       JTY=NUMGEO(IPT2.ITYPEL)
  32. C           PRI6  ITYPEL=16   CUB8  ITYPEL=14  TET4 ITYPEL=23
  33.       IF(ITY.EQ.16)THEN
  34.           IF(JTY.EQ.16)THEN
  35. C                                 PRI6 PRI6
  36.               IF(IFA.GT.2)THEN
  37. C    FACES RECTANGULAIRES
  38.                   DO 10 KJ=1,4
  39.                        IF(IPT1.NUM(IPRI1(KJ,IFA),IELL).EQ.
  40.      *                             IPT2.NUM(IPRI2(1,JFA),IELL2))THEN
  41.                           DO 12 J=1,3
  42.                                LJ=LF(J,KJ)
  43.                                LI=J+1
  44.                                IF(IPT1.NUM(IPRI1(LJ,IFA),IELL).EQ.
  45.      *                           IPT2.NUM(IPRI2(LI,JFA),IELL2))THEN
  46.                                     IOR=KJ
  47.                                     GO TO 99
  48.                                ENDIF
  49.    12                     CONTINUE
  50.                        ENDIF
  51.    10             CONTINUE
  52.               ELSE
  53. C    FACES TRIANGULAIRES
  54.                   DO 15 KJ=1,3
  55.                        IF(IPT1.NUM(IPRI1(KJ,IFA),IELL).EQ.
  56.      *                             IPT2.NUM(IPRI2(1,JFA),IELL2))THEN
  57.                           DO 17 J=1,2
  58.                                LJ=LE(J,KJ)
  59.                                LI=J+1
  60.                                IF(IPT1.NUM(IPRI1(LJ,IFA),IELL).EQ.
  61.      *                            IPT2.NUM(IPRI2(LI,JFA),IELL2))THEN
  62.                                   IOR=KJ
  63.                                   GO TO 99
  64.                                ENDIF
  65.    17                  CONTINUE
  66.                        ENDIF
  67.    15             CONTINUE
  68.               ENDIF
  69.           ELSEIF(JTY.EQ.14)THEN
  70. C                                 PRI6 CUB8
  71.              DO 20 KJ=1,4
  72.                   IF(IPT1.NUM(IPRI1(KJ,IFA),IELL).EQ.
  73.      *                        IPT2.NUM(ICUB2(1,JFA),IELL2))THEN
  74.                   DO 22 J=1,3
  75.                        LJ=LF(J,KJ)
  76.                        LI=J+1
  77.                        IF(IPT1.NUM(IPRI1(LJ,IFA),IELL).EQ.
  78.      *                        IPT2.NUM(ICUB2(LI,JFA),IELL2))THEN
  79.                               IOR=KJ
  80.                               GO TO 99
  81.                        ENDIF
  82.    22             CONTINUE
  83.                   ENDIF
  84.    20        CONTINUE
  85.           ELSEIF(JTY.EQ.23)THEN
  86. C                                 PRI6 TET4
  87.                   DO 25 KJ=1,3
  88.                        IF(IPT1.NUM(IPRI1(KJ,IFA),IELL).EQ.
  89.      *                             IPT2.NUM(ITET2(1,JFA),IELL2))THEN
  90.                           DO 27 J=1,2
  91.                                LJ=LE(J,KJ)
  92.                                LI=J+1
  93.                                IF(IPT1.NUM(IPRI1(LJ,IFA),IELL).EQ.
  94.      *                            IPT2.NUM(ITET2(LI,JFA),IELL2))THEN
  95.                                   IOR=KJ
  96.                                   GO TO 99
  97.                                ENDIF
  98.    27                  CONTINUE
  99.                        ENDIF
  100.    25             CONTINUE
  101.           ENDIF
  102.       ELSEIF(ITY.EQ.14)THEN
  103.           IF(JTY.EQ.14)THEN
  104. C                                 CUB8 CUB8
  105.              DO 30 KJ=1,4
  106.                   IF(IPT1.NUM(ICUB1(KJ,IFA),IELL).EQ.
  107.      *                        IPT2.NUM(ICUB2(1,JFA),IELL2))THEN
  108.                   DO 35 J=1,3
  109.                        LJ=LF(J,KJ)
  110.                        LI=J+1
  111.                        IF(IPT1.NUM(ICUB1(LJ,IFA),IELL).EQ.
  112.      *                        IPT2.NUM(ICUB2(LI,JFA),IELL2))THEN
  113.                            IOR=KJ
  114.                            GO TO 99
  115.                       ENDIF
  116.    35             CONTINUE
  117.                   ENDIF
  118.    30        CONTINUE
  119.           ELSEIF(JTY.EQ.16)THEN
  120. C                                 CUB8 PRI6
  121.              DO 40 KJ=1,4
  122.                   IF(IPT1.NUM(ICUB1(KJ,IFA),IELL).EQ.
  123.      *                        IPT2.NUM(IPRI2(1,JFA),IELL2))THEN
  124.                   DO 45 J=1,3
  125.                        LJ=LF(J,KJ)
  126.                        LI=J+1
  127.                        IF(IPT1.NUM(ICUB1(LJ,IFA),IELL).EQ.
  128.      *                        IPT2.NUM(IPRI2(LI,JFA),IELL2))THEN
  129.                            IOR=KJ
  130.                            GO TO 99
  131.                       ENDIF
  132.    45             CONTINUE
  133.                   ENDIF
  134.    40        CONTINUE
  135.           ENDIF
  136.       ELSEIF(ITY.EQ.23)THEN
  137.           IF(JTY.EQ.23)THEN
  138. C                                 TET4 TET4
  139.                   DO 50 KJ=1,3
  140.                        IF(IPT1.NUM(ITET1(KJ,IFA),IELL).EQ.
  141.      *                             IPT2.NUM(ITET2(1,JFA),IELL2))THEN
  142.                           DO 52 J=1,2
  143.                                LJ=LE(J,KJ)
  144.                                LI=J+1
  145.                                IF(IPT1.NUM(ITET1(LJ,IFA),IELL).EQ.
  146.      *                            IPT2.NUM(ITET2(LI,JFA),IELL2))THEN
  147.                                   IOR=KJ
  148.                                   GO TO 99
  149.                                ENDIF
  150.    52                  CONTINUE
  151.                        ENDIF
  152.    50             CONTINUE
  153.           ELSEIF(JTY.EQ.16)THEN
  154. C                                 TET4 PRI6
  155.                   DO 55 KJ=1,3
  156.                        IF(IPT1.NUM(ITET1(KJ,IFA),IELL).EQ.
  157.      *                             IPT2.NUM(IPRI2(1,JFA),IELL2))THEN
  158.                           DO 57 J=1,2
  159.                                LJ=LE(J,KJ)
  160.                                LI=J+1
  161.                                IF(IPT1.NUM(ITET1(LJ,IFA),IELL).EQ.
  162.      *                            IPT2.NUM(IPRI2(LI,JFA),IELL2))THEN
  163.                                   IOR=KJ
  164.                                   GO TO 99
  165.                                ENDIF
  166.    57                  CONTINUE
  167.                        ENDIF
  168.    55             CONTINUE
  169.           ENDIF
  170.       ENDIF
  171.    99 CONTINUE
  172.       RETURN
  173.       END
  174.  
  175.  
  176.  
  177.  

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