1 : C J3IDEN SOURCE CHAT 05/01/13 00:46:47 5004 2 : SUBROUTINE J3IDEN(WORK1,WORK2,TOL) 3 : C---------------------------------------------------- 4 : C ON REGARDE SI DEUX FACES SONT IDENTIQUES MAIS PAS 5 : C DANS LE MEME ORDRE 6 : C SI OUI ON FAIT WORK1=WORK2 7 : C 8 : C PP 9/97 9 : C Pierre Pegon/JRC Ispra 10 : C---------------------------------------------------- 11 : IMPLICIT INTEGER(I-N) 12 : IMPLICIT REAL*8(A-H,O-Z) 13 : -INC CCOPTIO 14 : DIMENSION BAR1(2),BAR2(2) 15 : C 16 : SEGMENT WORK 17 : REAL*8 XYC(2,NPTO) 18 : INTEGER IST(3,NPTO) 19 : REAL*8 DENS(NPTO) 20 : INTEGER JUN 21 : ENDSEGMENT 22 : POINTEUR WORK1.WORK,WORK2.WORK 23 : C 24 : NPTO1=WORK1.DENS(/1) 25 : NPTO2=WORK2.DENS(/1) 26 : IF(NPTO1.NE.NPTO2)RETURN 27 : C 28 : DO IE1=1,2 29 : BAR1(IE1)=0.D0 30 : BAR2(IE1)=0.D0 31 : ENDDO 32 : DO IE1=1,NPTO1 33 : DO IE2=1,2 34 : BAR1(IE2)=BAR1(IE2)+WORK1.XYC(IE2,IE1) 35 : BAR2(IE2)=BAR2(IE2)+WORK2.XYC(IE2,IE1) 36 : ENDDO 37 : ENDDO 38 : DIS12=SQRT((BAR2(1)-BAR1(1))**2+(BAR2(1)-BAR1(1))**2) 39 : IF(DIS12.GT.TOL)RETURN 40 : C 41 : DO IE1=1,NPTO1 42 : DIS12=SQRT((WORK1.XYC(1,1)-WORK2.XYC(1,IE1))**2 43 : > +(WORK1.XYC(2,1)-WORK2.XYC(2,IE1))**2) 44 : IF(DIS12.LT.TOL)GOTO 1 45 : ENDDO 46 : RETURN 47 : C 48 : 1 CONTINUE 49 : JE1=IE1-1 50 : DO IE1=1,NPTO1 51 : JE1=JE1+1 52 : IF(JE1.GT.NPTO1)JE1=1 53 : DIS12=SQRT((WORK1.XYC(1,IE1)-WORK2.XYC(1,JE1))**2 54 : > +(WORK1.XYC(2,IE1)-WORK2.XYC(2,JE1))**2) 55 : IF(DIS12.GT.TOL)RETURN 56 : ENDDO 57 : C 58 : SEGSUP,WORK1 59 : SEGINI,WORK1=WORK2 60 : WORK1.JUN=0 61 : RETURN 62 : END 63 : 64 :
© Cast3M 2003 - All rights reserved.
Disclaimer