Sources Esope | Cast3M

j3iden
C J3IDEN    SOURCE    CHAT      05/01/13    00:46:47     5004
      SUBROUTINE J3IDEN(WORK1,WORK2,TOL)
C----------------------------------------------------
C     ON REGARDE SI DEUX FACES SONT IDENTIQUES MAIS PAS
C     DANS LE MEME ORDRE
C     SI OUI ON FAIT WORK1=WORK2
C
C     PP 9/97
C     Pierre Pegon/JRC Ispra
C----------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC PPARAM
-INC CCOPTIO
      DIMENSION BAR1(2),BAR2(2)
C
      SEGMENT WORK
        REAL*8 XYC(2,NPTO)
        INTEGER IST(3,NPTO)
        REAL*8 DENS(NPTO)
        INTEGER JUN
      ENDSEGMENT
      POINTEUR WORK1.WORK,WORK2.WORK
C
      NPTO1=WORK1.DENS(/1)
      NPTO2=WORK2.DENS(/1)
      IF(NPTO1.NE.NPTO2)RETURN
C
      DO IE1=1,2
        BAR1(IE1)=0.D0
        BAR2(IE1)=0.D0
      ENDDO
      DO IE1=1,NPTO1
        DO IE2=1,2
          BAR1(IE2)=BAR1(IE2)+WORK1.XYC(IE2,IE1)
          BAR2(IE2)=BAR2(IE2)+WORK2.XYC(IE2,IE1)
        ENDDO
      ENDDO
      DIS12=SQRT((BAR2(1)-BAR1(1))**2+(BAR2(1)-BAR1(1))**2)
      IF(DIS12.GT.TOL)RETURN
C
      DO IE1=1,NPTO1
        DIS12=SQRT((WORK1.XYC(1,1)-WORK2.XYC(1,IE1))**2
     >            +(WORK1.XYC(2,1)-WORK2.XYC(2,IE1))**2)
        IF(DIS12.LT.TOL)GOTO 1
      ENDDO
      RETURN
C
 1    CONTINUE
      JE1=IE1-1
      DO IE1=1,NPTO1
        JE1=JE1+1
        IF(JE1.GT.NPTO1)JE1=1
        DIS12=SQRT((WORK1.XYC(1,IE1)-WORK2.XYC(1,JE1))**2
     >            +(WORK1.XYC(2,IE1)-WORK2.XYC(2,JE1))**2)
        IF(DIS12.GT.TOL)RETURN
      ENDDO
C
      SEGSUP,WORK1
      SEGINI,WORK1=WORK2
      WORK1.JUN=0
      RETURN
      END