Download j3iden.eso

Back to the list

   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