You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
123 lines
3.3 KiB
Fortran
123 lines
3.3 KiB
Fortran
5 years ago
|
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
|
||
|
|
|