1 : C SFRIDE SOURCE CHAT 05/01/13 03:15:17 5004 2 : SUBROUTINE SFRIDE(NN,NBNN,IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX, 3 : > NOETRI,NBE,IT1,IT2,I1,I2) 4 : C ************************************************************* 5 : C OBJET : FRONTIERE IDE-1 COMMUNE AUX ELEMENTS 6 : C RECHERCHE DES TRIANGLES QUI PARTAGENT L'ARETE NN(1..2) 7 : C RECHERCHE DES TETRA. QUI PARTAGENT LE TRIANGLE NN(1..3) 8 : C EN ENTREE: 9 : C NN : TABLEAU DES SOMMETS DE L'ELEMENT FRONTIERE 10 : C NBNN : NOMBRE DE SOMMETS 11 : C IDE : DIMENSION DES ELEMENTS DU MAILLAGE 12 : C NBE : NOMBRE D'ELEMENTS DU MAILLAGE 13 : C 14 : C EN SORTIE: 15 : C IT1 : LE TRIANGLE QUI CONTIENT L'ARETE NN(1),NN(2) 16 : C I1 : L'INDICE DE L'ARETE DE IT1 EGALE A NN(1),NN(2) 17 : C IT2 : LE TRIANGLE QUI CONTIENT L'ARETE NN(2),NN(1) 18 : C I2 : L'INDICE DE L'ARETE DE IT2 EGALE A NN(2),NN(1) 19 : C 20 : C ************************************************************* 21 : IMPLICIT INTEGER(I-N) 22 : INTEGER NN(*),NBNN,IDE,ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX 23 : INTEGER NOETRI(*),NBE,IT1,IT2,I1,I2 24 : C 25 : INTEGER J1, J2, ISENS, IT, J, IDEBUT, NNT, ITAMPO 26 : C 27 : IT1 = 0 28 : IT2 = 0 29 : I1 = 0 30 : I2 = 0 31 : ISENS = 1 32 : 510 IDEBUT = NOETRI(NN(1)) 33 : IT = IDEBUT 34 : C 35 : C --- ON RECHERCHE LE PREMIER NOEUD : NN(1) --- 36 : C 37 : 500 J1 = 0 38 : DO 360 J=1,NBNMAX 39 : IF(ITRNOE((IT-1)*NBNMAX+J) .EQ. NN(1))J1 = J 40 : 360 CONTINUE 41 : IF((J1.EQ.0).OR.(IDE.EQ.3))GO TO 999 42 : C ---------------------------------------------------- 43 : C SENS DIRECT => ARETE PARTANT DU NOEUD N1 44 : C SENS INDIRE => ARETE ARRIVANT AU NOEUD => ARETE PREC 45 : C ---------------------------------------------------- 46 : IF( ISENS .EQ. -1 )J1 = MOD(J1+(NBNMAX-2),NBNMAX)+1 47 : C 48 : IF( IDE .EQ. 1 )THEN 49 : C 50 : C --- INCIDENCE DE 2 ARETES SUR UN NOEUD --- 51 : C 52 : IT1 = IT 53 : I1 = J1 54 : IT2 = ITRTRI((IT1-1)*NBCMAX+J1) 55 : IF( IT2 .EQ. 0 )GO TO 999 56 : IF( IT2 .LT. 0 )IT2 = -IT2 57 : DO 370 J=1,NBNMAX 58 : IF( NN(1) .EQ. ITRNOE((IT2-1)*NBNMAX+J))THEN 59 : I2 = J 60 : GOTO 999 61 : ENDIF 62 : 370 CONTINUE 63 : C --- ERREUR --- 64 : GO TO 999 65 : ENDIF 66 : C 67 : C --- INCIDENCE DE 2 TRIANGLES SUR UNE ARETE --- 68 : C --- ON RECHERCHE LE DEUXIEME NOEUD : NN(2) --- 69 : C 70 : C --- CAS QUADRANGLES --- 71 : NNT = NBNMAX 72 : IF((IDE.EQ.2).AND.(NBNMAX.EQ.4).AND. 73 : > (ITRNOE((IT-1)*NBNMAX+4).EQ.0))NNT =3 74 : IF( ISENS .EQ. 1 )THEN 75 : C 76 : C --- ARETE PARTANT DU NOEUD N1 =>TEST DU NOEUD EXTREMITE 77 : C 78 : J2 = MOD(J1,NNT)+1 79 : ELSE 80 : C 81 : C --- ARETE ARRIVANT AU NOEUD N1 =>TEST DU NOEUD ORIGINE 82 : C 83 : J2 = J1 84 : ENDIF 85 : IF( NN(2) .EQ. ITRNOE((IT-1)*NBNMAX+J2))THEN 86 : IT1 = IT 87 : I1 = J1 88 : IT2 = ITRTRI((IT1-1)*NBCMAX+J1) 89 : IF( IT2 .EQ. 0 )THEN 90 : IF( ISENS.EQ.1 )GOTO 999 91 : C --- BUG5 POUR RESPECTER L'ORIENTATION NN(1),NN(2) 92 : IT2 = IT1 93 : I2 = I1 94 : I1 = 0 95 : IT1 = 0 96 : GO TO 999 97 : ENDIF 98 : IF( IT2 .LT. 0 )IT2 = -IT2 99 : DO 380 J=1,NBNMAX 100 : IF((ISENS.EQ.1).AND. 101 : > (NN(2).EQ.ITRNOE((IT2-1)*NBNMAX+J)))THEN 102 : I2 = J 103 : GOTO 999 104 : ENDIF 105 : C --- BUG5 POUR RESPECTER L'ORIENTATION NN(1),NN(2) 106 : IF((ISENS.EQ.-1).AND. 107 : > (NN(1).EQ.ITRNOE((IT2-1)*NBNMAX+J)))THEN 108 : I2 = J 109 : ITAMPO = IT1 110 : IT1 = IT2 111 : IT2 = ITAMPO 112 : ITAMPO = I1 113 : I1 = I2 114 : I2 = ITAMPO 115 : GOTO 999 116 : ENDIF 117 : 380 CONTINUE 118 : C --- ERREUR --- 119 : GOTO 999 120 : ENDIF 121 : C --- ON PASSE AU TRIANGLE SUIVANT --- 122 : C IF( ISENS .EQ. 1 )THEN 123 : IT = ITRTRI((IT-1)*NBCMAX+J1) 124 : C ELSE 125 : C IT = ITRTRI((IT-1)*NBCMAX+J2) 126 : C ENDIF 127 : IF( IT .EQ. 0 )THEN 128 : IF( ISENS .EQ. 1 )THEN 129 : C --- ON EST ARRIVE SUR LA FRONTIERE : ON CHANGE DE SENS --- 130 : ISENS = -1 131 : GO TO 510 132 : ELSE 133 : C --- ON ARRIVE SUR LA FRONTIERE EN TOURNANT DANS LES 2 SENS --- 134 : GOTO 999 135 : ENDIF 136 : ELSE IF( IT .LT. 0 )THEN 137 : IT = -IT 138 : ENDIF 139 : IF( IT .NE. IDEBUT )THEN 140 : GO TO 500 141 : ENDIF 142 : 999 END 143 : 144 :
© Cast3M 2003 - All rights reserved.
Disclaimer