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