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 :
© Cast3M 2003 - All rights reserved.
Disclaimer