Sources Esope | Cast3M

j3junc
C J3JUNC    SOURCE    CHAT      05/01/13    00:46:54     5004
      SUBROUTINE J3JUNC(WORK1,WORK2,TOL,IRET)
C----------------------------------------------------
C     ON REGARDE LE STATUS DES SEGMENTS ADJACENTS A CHAQUE
C     POINT DE XYC1 PAR RAPPORT A XYC2
C
C     CODE IST(1,I): 0 point non traite
C                    1 est sur le segment IST(2,I)
C                    2 est sur les segments IST(2,I) et IST(3,I)
C                   -1 est a l'interieur
C                   -2 est a l'exterieur
C
C     CODE CRO(J,I): 1 cote sur le segment
C                   -1 cote interieur
C                   -2 cote exterieur
C
C     PP 6/97
C     Pierre Pegon/JRC Ispra
C----------------------------------------------------
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
      SEGMENT WORK
        REAL*8 XYC(2,NPTO)
        INTEGER IST(3,NPTO)
        REAL*8 DENS(NPTO)
        INTEGER JUN
      ENDSEGMENT
      POINTEUR WORK1.WORK, WORK2.WORK
C
      SEGMENT JUNC
        INTEGER CRO(2,NPTO)
      ENDSEGMENT
C
      DIMENSION XY1(2),XY2(2),XY3(2),XY4(2)
C
      NPTO1=WORK1.XYC(/2)
      NPTO2=WORK2.XYC(/2)
C
C     ENFIN ON REGARDE LE STATUS DES SEGMENTS ADJACENTS A CHAQUE
C     POINT DE XYC1 SUR LES COTES DE XYC2
C
      JUNC=WORK1.JUN
      NPTO=NPTO1
      IF (JUNC.EQ.0)THEN
        SEGINI,JUNC
        WORK1.JUN=JUNC
      ELSE
        SEGADJ,JUNC
      ENDIF
C
      DO IE1=1,NPTO1
C
C     ON TRAITE FACILEMENT LE CAS OU XYC1(IE1) EST DANS OU HORS XYC2
C
        J1=WORK1.IST(1,IE1)
        IF(J1.LT.0)THEN
          DO IE2=1,2
            CRO(IE2,IE1)=J1
          ENDDO
C
C     A PARTIR D'ICI ON ATTAQUE LES POINTS SUR LES COTES
C
        ELSE
C
C     ON REGARDE LES VOISINS XYC1(I2) DE XYC1(IE1)
C
          DO IE2=1,2
            IF(IE2.EQ.1)THEN
              I2=IE1-1+(1/IE1)*NPTO1
            ELSE
              I2=IE1+1-(IE1/NPTO1)*IE1
            ENDIF
C
C      ON TRAITE FACILEMENT LE CAS OU CE POINT EST DANS OU HORS XYC2
C
            J2=WORK1.IST(1,I2)
            CRO(IE2,IE1)=J2
C
C     MAIS SI XYC1(I2) EST AUSSI SUR XYC2, ON REGARDE SI CE POINTS
C        ET XYC1(IE1) SONT SUR LE MEME SEGMENT DE XYC2
C
C
            IF(J2.GT.0)THEN
              DO IE3=2,J1+1
                J3=WORK1.IST(IE3,IE1)
                DO IE4=2,J2+1
                  J4=WORK1.IST(IE4,I2)
                  IF(J3.EQ.J4)GOTO 1
                ENDDO
              ENDDO
C
C     SI XYC1(I2) ET XYC1(IE1) NE SONT PAS SUR LE MEME SEGMENT DE XYC2
C        ON REGARDE OU SE TROUVE LE MILIEU PAR RAPPORT A XYC2
C
              DO IE3=1,2
                XY1(IE3)=(WORK1.XYC(IE3,IE1)+WORK1.XYC(IE3,I2))/2
              ENDDO
              CALL J3INEX(XY1,WORK2.XYC,NPTO2,TOL,ICOD,ISIGM,IRET)
              CRO(IE2,IE1)=ICOD
              GOTO 2
C
C     SI XYC1(I2) ET XYC1(IE1) SONT SUR LE MEME SEGMENT DE XYC2
C        ALORS ON A LE CODE 1
C
 1            CONTINUE
              CRO(IE2,IE1)=1
 2            CONTINUE
            ENDIF
          ENDDO
C
C     FIN DES POINTS SUR LES COTES
C
        ENDIF
      ENDDO
C
      IF (IIMPI.EQ.1789)THEN
        WRITE(IOIMP,*)'J3JUNC'
        NPTO1=WORK1.XYC(/2)
        WRITE(IOIMP,*)'WORK1/WORK2: NUM,CRO1, CRO2, ',WORK1,WORK2
        DO IE1=1,NPTO1
          WRITE(IOIMP,*)IE1,CRO(1,IE1),CRO(2,IE1)
        ENDDO
      ENDIF
 
C
      RETURN
      END