1 : C J3FAC1 SOURCE CHAT 05/01/13 00:46:38 5004 2 : SUBROUTINE J3FAC1(VWORK,TOL,IRET) 3 : C---------------------------------------------------- 4 : C TEST POUR LES FACES 5 : C PP 6/97 6 : C Pierre Pegon/JRC Ispra 7 : C---------------------------------------------------- 8 : IMPLICIT INTEGER(I-N) 9 : IMPLICIT REAL*8(A-H,O-Z) 10 : -INC CCOPTIO 11 : SEGMENT VWORK 12 : INTEGER FWWORK(NFACE) 13 : ENDSEGMENT 14 : POINTEUR VWORK1.VWORK,VWORK2.VWORK,VWORK3.VWORK,VWORK4.VWORK 15 : C 16 : SEGMENT WWORK 17 : REAL*8 PORIG(3),VNORM(3),VI(3),VJ(3) 18 : INTEGER FWORK 19 : INTEGER TWORK(NTROU) 20 : ENDSEGMENT 21 : POINTEUR WWORK1.WWORK,WWORK2.WWORK 22 : C 23 : SEGMENT FUSE 24 : INTEGER BLFA(2,NFAMA) 25 : ENDSEGMENT 26 : C 27 : NFAMA=50 28 : SEGINI,FUSE 29 : C 30 : C ON RENTRE AVEC DES ENSEMBLE DE VWORK REPRESENTANT CHACUN 31 : C UN BLOCK COMPOSE DE FACE 32 : C 33 : NBLOCK=FWWORK(/1) 34 : C 35 : C ON BOUCLE SUR CHAQUE BLOCK ET SUR CHAQUE FACE ... 36 : C 37 : DO IE1=1,NBLOCK 38 : VWORK1=FWWORK(IE1) 39 : NFACE1=VWORK1.FWWORK(/1) 40 : C 41 : C INITIALISATION DES VALEURS DE DEBUT DE BOUCLE POUR LES 42 : C FACES DE TRAVAIL (BLFA(1,.)=DEBUT BLOCK, BLFA(2,.)=DEBUT FACE) 43 : C 44 : IF(NFACE1.GT.NFAMA)THEN 45 : NFAMA=NFAMA+50 46 : SEGADJ,FUSE 47 : ENDIF 48 : DO KE1=1,NFACE1 49 : BLFA(1,KE1)=1 50 : BLFA(2,KE1)=1 51 : ENDDO 52 : C 53 : C "DO 1 JE1=1,NFACE1" 54 : C 55 : JE1=0 56 : 1 JE1=JE1+1 57 : IF(JE1.GT.NFACE1)GOTO 2 58 : C 59 : WWORK1=VWORK1.FWWORK(JE1) 60 : C 61 : C ... QUE L'ON COMPARE AU AUTRES BLOCKS ET FACES 62 : C 63 : DO 11 IE2=BLFA(1,JE1),NBLOCK 64 : IF(IE1.EQ.IE2)GOTO 11 65 : VWORK2=FWWORK(IE2) 66 : NFACE2=VWORK2.FWWORK(/1) 67 : DO 10 JE2=BLFA(2,JE1),NFACE2 68 : WWORK2=VWORK2.FWWORK(JE2) 69 : C 70 : C ON APPEL FAFA 71 : C 71 : CALL J3FAFA(WWORK1,WWORK2,TOL,IRET,ICAS,VWORK3,VWORK4) 72 : IF(IRET.NE.0)THEN 73 : RETURN 74 : ENDIF 75 : C 76 : C ON OPERE DIFFERENTS TRAITEMENTS SELON LES CAS 77 : C 78 : IF(ICAS.EQ.1)GOTO 10 79 : C 80 : IF(ICAS.EQ.2)GOTO 1 81 : C 82 : IF(ICAS.EQ.3)THEN 83 : C 84 : C DANS LE CAS 3 ON AJOUTE 1(le trou)+N(les coalescences) FACES 85 : C LA FACE DE TRAVAIL SE RETOUVE EN JE1+1 ET DOIT CONTINUER 86 : C L'INSPECTION DES FACES A PARTIR DE LA AINSI QUE LES NOUVELLES 87 : C FACES 88 : C 89 : C CONCATENATION DES FACES 90 : NFACE10=NFACE1 90 : CALL J3VPLU(VWORK3,VWORK1) 91 : VWORK1=VWORK3 91 : CALL J3VPLU(VWORK1,VWORK4) 92 : NFACE1=VWORK1.FWWORK(/1) 93 : FWWORK(IE1)=VWORK1 94 : C 95 : IF(NFACE1.GT.NFAMA)THEN 96 : NFAMA=NFAMA+50 97 : SEGADJ,FUSE 98 : ENDIF 99 : C LES N FACES DE COALESCENCE AJOUTEE A LA FIN DOIVENT ETRE TRAITEES 100 : C A PARTIR DE LA FACE DE TEST COURRANTE 101 : IF(NFACE10+1.LT.NFACE1)THEN 102 : DO KE1=NFACE10+2,NFACE1 103 : BLFA(1,KE1)=IE2 104 : BLFA(2,KE1)=JE2+1 105 : ENDDO 106 : ENDIF 107 : C ON SHIFTE LES INDICES A PARTIR DE LA FACE COURANTE (JE1) 108 : C 109 : DO KE1=NFACE10,JE1,-1 110 : BLFA(1,KE1+1)=BLFA(1,KE1) 111 : BLFA(2,KE1+1)=BLFA(2,KE1) 112 : ENDDO 113 : C ON MODIFIE LES INDICES DE LA FUTURE FACE COURRANTE (JE1+1) 114 : C 115 : BLFA(1,JE1+1)=IE2 116 : BLFA(2,JE1+1)=JE2+1 117 : GOTO 1 118 : ENDIF 119 : C 120 : IF(ICAS.EQ.4)THEN 121 : C 122 : C DANS LE CAS 4 ON SUBSTITUE A LA FACE COURRANTE NFACE3 FACES 123 : C (intersection interne) ET ON AJOUTE NFACE4 FACES (intersection 124 : C externe et coalescence de trou). LES NFACE3 DOIVENT ETRE SAUTEES 125 : C LES NFACE4 NOUVELLES DOIVENT ETRE TRAITEES A PARTIR DES INDICES 126 : C COURRANTS. 127 : C 128 : C AJOUT DES NFACE3 FACES: SHIFT D'INDICES 129 : NFACE3=VWORK3.FWWORK(/1) 130 : NFACE=NFACE1+NFACE3-1 131 : SEGADJ,VWORK1 132 : IF(NFACE.GE.JE1+NFACE3)THEN 133 : DO KE1=NFACE,JE1+NFACE3,-1 134 : VWORK1.FWWORK(KE1)=VWORK1.FWWORK(KE1-NFACE3+1) 135 : ENDDO 136 : ENDIF 137 : C AJOUT DES NFACE3 FACES: AJOUT EFFECTIFS 138 : DO KE1=1,NFACE3 139 : VWORK1.FWWORK(JE1-1+KE1)=VWORK3.FWWORK(KE1) 140 : ENDDO 141 : SEGSUP,VWORK3 142 : C AJOUT DES NFACE3 FACES A LA FIN 143 : NFACE4=VWORK4.FWWORK(/1) 143 : CALL J3VPLU(VWORK1,VWORK4) 144 : NFACE1=VWORK1.FWWORK(/1) 145 : FWWORK(IE1)=VWORK1 146 : C GESTION DES LIMITES 147 : IF(NFACE1.GT.NFAMA)THEN 148 : NFAMA=NFAMA+50 149 : SEGADJ,FUSE 150 : ENDIF 151 : IF(NFACE.GE.JE1+NFACE3)THEN 152 : DO KE1=NFACE,JE1+NFACE3,-1 153 : BLFA(1,KE1)=BLFA(1,KE1-NFACE3+1) 154 : BLFA(2,KE1)=BLFA(2,KE1-NFACE3+1) 155 : ENDDO 156 : ENDIF 157 : DO KE1=NFACE1-NFACE4+1,NFACE1 158 : BLFA(1,KE1)=IE2 159 : BLFA(2,KE1)=JE2+1 160 : ENDDO 161 : C 162 : JE1=JE1+NFACE3-1 163 : GOTO 1 164 : ENDIF 165 : C 166 : 10 CONTINUE 167 : BLFA(2,JE1)=1 168 : 11 CONTINUE 169 : C 170 : GOTO 1 171 : 2 CONTINUE 172 : C 173 : ENDDO 174 : C 175 : SEGSUP,FUSE 176 : C 177 : RETURN 178 : END 179 : 180 :
© Cast3M 2003 - All rights reserved.
Disclaimer