Sources Esope | Cast3M

j3coto
C J3COTO    SOURCE    CHAT      05/01/13    00:46:10     5004
      SUBROUTINE J3COTO(WORK1,WORK2,TOL,IRET)
C----------------------------------------------------
C     RAPPORT ENTRE LE CONTOUR DE WORK1 AVEC CELUI DE WORK2
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     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
      DIMENSION XY1(2),XY2(2),XY3(2),XY4(2),XY(2)
C
      IRET=0
C
      NPTO1=WORK1.XYC(/2)
      CALL J3ZERI(WORK1.IST,3,NPTO1)
      NPTO2=WORK2.XYC(/2)
      CALL J3ZERI(WORK2.IST,3,NPTO2)
C
C     ON CHERCHE A SAVOIR SI LES POINTS DE XYC1 SONT CONFONDU
C     AVEC DES POINTS DE XYC2, OU SUR LES COTES DE XYC2, OU BIEN
C     DEDANS OU DEHORS DE XYC2
C
      DO IE1=1,NPTO1
        DO IE2=1,2
          XY1(IE2)=WORK1.XYC(IE2,IE1)
        ENDDO
C
        ICOD=0
C
        CALL J3NOCO(XY1,WORK2.XYC,NPTO2,TOL,IE2)
        IF(IE2.NE.0)THEN
          ICOD=2
          CALL J3BOCO(WORK1,IE1,IE2,IRET)
          IE2=IE2-1+(1/IE2)*NPTO2
          CALL J3BOCO(WORK1,IE1,IE2,IRET)
        ENDIF
C
        IF(ICOD.EQ.0)THEN
          CALL J3DESS(XY1,WORK2.XYC,NPTO2,TOL,IE2)
          IF(IE2.NE.0)THEN
            ICOD=1
            CALL J3BOCO(WORK1,IE1,IE2,IRET)
          ENDIF
        ENDIF
C
        IF(ICOD.EQ.0)THEN
          CALL J3INEX(XY1,WORK2.XYC,NPTO2,TOL,ICOD,ISIGM,IRET)
          WORK1.IST(1,IE1)=ICOD
        ENDIF
C
        IF(IRET.GT.0)THEN
          RETURN
        ENDIF
      ENDDO
C
C     ON REGARDE MAINTENANT S'IL Y A DES POINTS DE XYC2 QUI SONT
C     SUR XYC1. IL FAUT AJOUTER CES POINTS
C
      DO IE1=1,NPTO2
        DO IE2=1,2
          XY2(IE2)=WORK2.XYC(IE2,IE1)
        ENDDO
        CALL J3NOCO(XY2,WORK1.XYC,NPTO1,TOL,IE2)
        IF(IE2.EQ.0)THEN
          CALL J3DESS(XY2,WORK1.XYC,NPTO1,TOL,IE2)
          IF(IE2.NE.0)THEN
            NPTO1=NPTO1+1
            IE2=IE2+1
            DENS1=WORK2.DENS(IE1)
            CALL J3POIN(WORK1,NPTO1,IE2,XY2,DENS1)
            CALL J3BOCO(WORK1,IE2,IE1,IRET)
            I1=IE1-1+(1/IE1)*NPTO2
            CALL J3BOCO(WORK1,IE2, I1,IRET)
          ENDIF
        ENDIF
      ENDDO
C
C     ON REGARDE MAINTENANT LES INTERSECTIONS DE XYC1 AVEC XYC2
C     ET ON AJOUTE LES POINTS D'INTERSECTION
C
      IE1=0
 1      IE1=IE1+1
        IF(IE1.GT.NPTO1)GOTO 3
C
        I1=IE1
        I2=IE1+1-(IE1/NPTO1)*IE1
C
        IB1=WORK1.IST(2,I1)
        IB2=WORK1.IST(3,I1)
        IB3=WORK1.IST(2,I2)
        IB4=WORK1.IST(3,I2)
C
        DO IE2=1,2
          XY1(IE2)=WORK1.XYC(IE2,I1)
          XY2(IE2)=WORK1.XYC(IE2,I2)
        ENDDO
C
        DO 2 IE2=1,NPTO2
C
C     (ON ELIMINE LES COTES DE XYC2 DEJA COUPES PAR XYC1)
C
          IB=MIN(ABS(IB1-IE2),ABS(IB2-IE2),ABS(IB3-IE2),ABS(IB4-IE2))
          IF(IB.EQ.0)GOTO 2
C
          I3=IE2
          I4=IE2+1-(IE2/NPTO2)*IE2
          DO IE3=1,2
            XY3(IE3)=WORK2.XYC(IE3,I3)
            XY4(IE3)=WORK2.XYC(IE3,I4)
          ENDDO
C
          CALL J3SINT(XY1,XY2,XY3,XY4,TOL,XLAM,XGAM,XY)
C
          IF((XLAM.GT.0.D0).AND.(XLAM.LT.1.D0).AND.
     >       (XGAM.GT.0.D0).AND.(XGAM.LT.1.D0))THEN
            NPTO1=NPTO1+1
            DENS1=XLAM*WORK1.DENS(I2)+(1-XLAM)*WORK1.DENS(I1)
            CALL J3POIN(WORK1,NPTO1,IE1+1,XY,DENS1)
            CALL J3BOCO(WORK1,IE1+1,IE2,IRET)
            IE1=IE1-1
            GOTO 1
          ENDIF
 2      CONTINUE
C
        GOTO 1
 3    CONTINUE
      IF(IRET.GT.0)RETURN
C
C     ON CHERCHE A SAVOIR SI LES POINTS DE XYC2 SONT CONFONDU
C     AVEC DES POINTS DE XYC1, OU SUR LES COTES DE XYC1, OU BIEN
C     DEDANS OU DEHORS DE XYC1
C
      DO IE1=1,NPTO2
        DO IE2=1,2
          XY2(IE2)=WORK2.XYC(IE2,IE1)
        ENDDO
C
        ICOD=0
C
        CALL J3NOCO(XY2,WORK1.XYC,NPTO1,TOL,IE2)
        IF(IE2.NE.0)THEN
          ICOD=2
          CALL J3BOCO(WORK2,IE1,IE2,IRET)
          IE2=IE2-1+(1/IE2)*NPTO1
          CALL J3BOCO(WORK2,IE1,IE2,IRET)
        ENDIF
C
        IF(ICOD.EQ.0)THEN
          CALL J3DESS(XY2,WORK1.XYC,NPTO1,TOL,IE2)
          IF(IE2.NE.0)THEN
            ICOD=1
            CALL J3BOCO(WORK2,IE1,IE2,IRET)
          ENDIF
        ENDIF
C
        IF(ICOD.EQ.0)THEN
          CALL J3INEX(XY2,WORK1.XYC,NPTO1,TOL,ICOD,ISIGM,IRET)
          WORK2.IST(1,IE1)=ICOD
        ENDIF
C
        IF(IRET.GT.0)THEN
          RETURN
        ENDIF
      ENDDO
C
      IF (IIMPI.EQ.1789)THEN
        WRITE(IOIMP,*)'J3COTO'
        NPTO1=WORK1.XYC(/2)
        WRITE(IOIMP,*)'WORK1: NUM,X,Y,IST1,IST2,IST3,DENS ',WORK1
        DO IE1=1,NPTO1
          WRITE(IOIMP,*)IE1,WORK1.XYC(1,IE1),WORK1.XYC(2,IE1),
     > WORK1.IST(1,IE1),WORK1.IST(2,IE1),WORK1.IST(3,IE1),
     >                  WORK1.DENS(IE1)
        ENDDO
        NPTO2=WORK2.XYC(/2)
        WRITE(IOIMP,*)'WORK2: NUM,X,Y,IST1,IST2,IST3,DENS ',WORK2
        DO IE1=1,NPTO2
          WRITE(IOIMP,*)IE1,WORK2.XYC(1,IE1),WORK2.XYC(2,IE1),
     > WORK2.IST(1,IE1),WORK2.IST(2,IE1),WORK2.IST(3,IE1),
     >                  WORK2.DENS(IE1)
        ENDDO
      ENDIF
C
      RETURN
      END