Esope source files

   1 : C J3JUNC    SOURCE    CHAT      05/01/13    00:46:54     5004           
   2 :       SUBROUTINE J3JUNC(WORK1,WORK2,TOL,IRET)
   3 : C----------------------------------------------------
   4 : C     ON REGARDE LE STATUS DES SEGMENTS ADJACENTS A CHAQUE
   5 : C     POINT DE XYC1 PAR RAPPORT A XYC2
   6 : C
   7 : C     CODE IST(1,I): 0 point non traite
   8 : C                    1 est sur le segment IST(2,I)
   9 : C                    2 est sur les segments IST(2,I) et IST(3,I)
  10 : C                   -1 est a l'interieur
  11 : C                   -2 est a l'exterieur
  12 : C
  13 : C     CODE CRO(J,I): 1 cote sur le segment
  14 : C                   -1 cote interieur
  15 : C                   -2 cote exterieur
  16 : C
  17 : C     PP 6/97
  18 : C     Pierre Pegon/JRC Ispra
  19 : C----------------------------------------------------
  20 : C
  21 :       IMPLICIT INTEGER(I-N)
  22 :       IMPLICIT REAL*8(A-H,O-Z)
  23 : -INC CCOPTIO
  24 :       SEGMENT WORK
  25 :         REAL*8 XYC(2,NPTO)
  26 :         INTEGER IST(3,NPTO)
  27 :         REAL*8 DENS(NPTO)
  28 :         INTEGER JUN
  29 :       ENDSEGMENT
  30 :       POINTEUR WORK1.WORK, WORK2.WORK
  31 : C
  32 :       SEGMENT JUNC
  33 :         INTEGER CRO(2,NPTO)
  34 :       ENDSEGMENT
  35 : C
  36 :       DIMENSION XY1(2),XY2(2),XY3(2),XY4(2)
  37 : C
  38 :       NPTO1=WORK1.XYC(/2)
  39 :       NPTO2=WORK2.XYC(/2)
  40 : C
  41 : C     ENFIN ON REGARDE LE STATUS DES SEGMENTS ADJACENTS A CHAQUE
  42 : C     POINT DE XYC1 SUR LES COTES DE XYC2
  43 : C
  44 :       JUNC=WORK1.JUN
  45 :       NPTO=NPTO1
  46 :       IF (JUNC.EQ.0)THEN
  47 :         SEGINI,JUNC
  48 :         WORK1.JUN=JUNC
  49 :       ELSE
  50 :         SEGADJ,JUNC
  51 :       ENDIF
  52 : C
  53 :       DO IE1=1,NPTO1
  54 : C
  55 : C     ON TRAITE FACILEMENT LE CAS OU XYC1(IE1) EST DANS OU HORS XYC2
  56 : C
  57 :         J1=WORK1.IST(1,IE1)
  58 :         IF(J1.LT.0)THEN
  59 :           DO IE2=1,2
  60 :             CRO(IE2,IE1)=J1
  61 :           ENDDO
  62 : C
  63 : C     A PARTIR D'ICI ON ATTAQUE LES POINTS SUR LES COTES
  64 : C
  65 :         ELSE
  66 : C
  67 : C     ON REGARDE LES VOISINS XYC1(I2) DE XYC1(IE1)
  68 : C
  69 :           DO IE2=1,2
  70 :             IF(IE2.EQ.1)THEN
  71 :               I2=IE1-1+(1/IE1)*NPTO1
  72 :             ELSE
  73 :               I2=IE1+1-(IE1/NPTO1)*IE1
  74 :             ENDIF
  75 : C
  76 : C      ON TRAITE FACILEMENT LE CAS OU CE POINT EST DANS OU HORS XYC2
  77 : C
  78 :             J2=WORK1.IST(1,I2)
  79 :             CRO(IE2,IE1)=J2
  80 : C
  81 : C     MAIS SI XYC1(I2) EST AUSSI SUR XYC2, ON REGARDE SI CE POINTS
  82 : C        ET XYC1(IE1) SONT SUR LE MEME SEGMENT DE XYC2
  83 : C       
  84 : C
  85 :             IF(J2.GT.0)THEN
  86 :               DO IE3=2,J1+1
  87 :                 J3=WORK1.IST(IE3,IE1)
  88 :                 DO IE4=2,J2+1
  89 :                   J4=WORK1.IST(IE4,I2)
  90 :                   IF(J3.EQ.J4)GOTO 1
  91 :                 ENDDO
  92 :               ENDDO
  93 : C
  94 : C     SI XYC1(I2) ET XYC1(IE1) NE SONT PAS SUR LE MEME SEGMENT DE XYC2
  95 : C        ON REGARDE OU SE TROUVE LE MILIEU PAR RAPPORT A XYC2 
  96 : C
  97 :               DO IE3=1,2
  98 :                 XY1(IE3)=(WORK1.XYC(IE3,IE1)+WORK1.XYC(IE3,I2))/2
  99 :               ENDDO
  99 :               CALL J3INEX(XY1,WORK2.XYC,NPTO2,TOL,ICOD,ISIGM,IRET)
 100 :               CRO(IE2,IE1)=ICOD
 101 :               GOTO 2
 102 : C
 103 : C     SI XYC1(I2) ET XYC1(IE1) SONT SUR LE MEME SEGMENT DE XYC2
 104 : C        ALORS ON A LE CODE 1
 105 : C
 106 :  1            CONTINUE
 107 :               CRO(IE2,IE1)=1
 108 :  2            CONTINUE
 109 :             ENDIF
 110 :           ENDDO
 111 : C
 112 : C     FIN DES POINTS SUR LES COTES
 113 : C
 114 :         ENDIF
 115 :       ENDDO
 116 : C
 117 :       IF (IIMPI.EQ.1789)THEN
 118 :         WRITE(IOIMP,*)'J3JUNC'
 119 :         NPTO1=WORK1.XYC(/2)
 120 :         WRITE(IOIMP,*)'WORK1/WORK2: NUM,CRO1, CRO2, ',WORK1,WORK2
 121 :         DO IE1=1,NPTO1
 122 :           WRITE(IOIMP,*)IE1,CRO(1,IE1),CRO(2,IE1)
 123 :         ENDDO
 124 :       ENDIF
 125 : 
 126 : C
 127 :       RETURN
 128 :       END
 129 :  
 130 :