SUBROUTINE JLINE(ILIN,CVAL) ! Routine to join up points USE BLKMAP USE BLK1MOD ! INCLUDE 'BLK1.COM' INCLUDE 'TXFRM.COM' COMMON /CCGEN/ XCLIN(4000,2),YCLIN(4000,2),ALIN(-4000:4000,2),IUSED(4000) VOID=-1.0E+10 DO K=1,MAXLIN IF(LINTYP(K) .EQ. -999) THEN NLIN=K-1 GO TO 100 ENDIF ENDDO NLIN=MAXLIN 100 CONTINUE DO I=1,ILIN IUSED(I)=0 ENDDO ! Loop through remaining poins DO I=1,ILIN IF(IUSED(I) .EQ. 0) THEN ! Set first points IFW=2 IFB=1 IUSED(I)=1 ALIN(1,1)=XCLIN(I,1) ALIN(1,2)=YCLIN(I,1) ALIN(2,1)=XCLIN(I,2) ALIN(2,2)=YCLIN(I,2) ! Look at remaining points for match 200 CONTINUE DO J=I,ILIN IF(IUSED(J) .EQ. 0) THEN ! First for forward points IF(XCLIN(J,1) .EQ. ALIN(IFW,1) .AND. YCLIN(J,1) .EQ. ALIN(IFW,2)) THEN IFW=IFW+1 ALIN(IFW,1)=XCLIN(J,2) ALIN(IFW,2)=YCLIN(J,2) IUSED(J)=1 ELSEIF(XCLIN(J,2) .EQ. ALIN(IFW,1) .AND. YCLIN(J,2) .EQ. ALIN(IFW,2)) THEN IFW=IFW+1 ALIN(IFW,1)=XCLIN(J,1) ALIN(IFW,2)=YCLIN(J,1) IUSED(J)=1 ELSEIF(XCLIN(J,1) .EQ. ALIN(IFB,1) .AND. YCLIN(J,1) .EQ. ALIN(IFB,2)) THEN IFB=IFB-1 ALIN(IFB,1)=XCLIN(J,2) ALIN(IFB,2)=YCLIN(J,2) IUSED(J)=1 ELSEIF(XCLIN(J,2) .EQ. ALIN(IFB,1) .AND. YCLIN(J,2) .EQ. ALIN(IFB,2)) THEN IFB=IFB-1 ALIN(IFB,1)=XCLIN(J,1) ALIN(IFB,2)=YCLIN(J,1) IUSED(J)=1 ENDIF IF(IUSED(J) .EQ. 1) GO TO 200 ENDIF ENDDO ! No new points found line must be complete ! Check for loops ! First end points 250 CONTINUE ! IF((ALIN(IFB,1) .EQ. ALIN(IFW,1)) .AND. (ALIN(IFB,2) .EQ. ALIN(IFW,2))) THEN ! IFB=IFB+1 ! IF(IFB .EQ. IFW) GO TO 300 ! GO TO 250 ! ENDIF NLIN=NLIN+1 LINTYP(NLIN)=3 IF(IMP .EQ. 0) IMP=9 N=0 IF(MAXPTS .EQ. MAXPL) MAXPTS=0 IF(MAXPTS .GT. 0) THEN MAXPTS=MAXPTS+1 CMAP(MAXPTS,1) = VOID CMAP(MAXPTS,2) = VOID XMAP(MAXPTS) = VOID YMAP(MAXPTS) = VOID ! WRITE(198,'(I5,3F15.6)') MAXPTS,XMAP(MAXPTS),YMAP(MAXPTS),VAL(MAXPTS) ENDIF A1= VOID A2= VOID DO J=IFB,IFW IF(ALIN(J,1) .EQ. A1 .AND. ALIN(J,2) .EQ. A2) GO TO 275 MAXPTS=MAXPTS+1 ! Check for double points XMAP(MAXPTS) = ALIN(J,1) YMAP(MAXPTS) = ALIN(J,2) VAL(MAXPTS) = CVAL CMAP(MAXPTS,1)=(XMAP(MAXPTS)+XS)/TXSCAL CMAP(MAXPTS,2)=(YMAP(MAXPTS)+YS)/TXSCAL ! WRITE(198,'(I5,3F15.6)') MAXPTS,XMAP(MAXPTS),YMAP(MAXPTS),VAL(MAXPTS) 275 CONTINUE ENDDO 300 CONTINUE ENDIF ! Copy values into contour line array ENDDO klint=nlin RETURN END