C    Updated    18.16    2 November 1984   PMS1
C
C     SU     VERSION 5.13C
C
C                                          Friday  2 November 1984   |
C          EXIT option now calls suplot with scale=0.0 so that the   |
C          plotter dependent package can do all the opening and      |
C          closing of the plotter streams properly. Essential for    |
C          CAMPLOT.                                                  |
C                                                                    |
      PARAMETER  (  ISZ=1008, ISZM1=(ISZ-1) , ISZ7=(7*ISZ) , NOPTS=5 )
      EXTERNAL SUINIT
      REAL    E(ISZ),    N(ISZ),     H(ISZ),      DIST(ISZ),
     &        EAST(ISZ), NORTH(ISZ), HEIGHT(ISZ), SCRTCH(ISZ),
     &        PX(ISZ),   PY(ISZ),    LENGTH
      INTEGER IF(ISZ),   IT(ISZ),    OINDEX(ISZ),
     &        SIZE  ,DBSIZE,SYSIN ,PCIN  ,TTYIN ,DBASE ,TTYOUT,SYSOUT
      LOGICAL DBCORE,WCORE,INFEET,UWATER,PXDEF
      CHARACTER*4  OPTS(NOPTS),OPTION
      CHARACTER*6  STA(ISZ)
      CHARACTER*48 TITLE,OPTDAT
      COMMON /TITL / TITLE
      COMMON /PARMS/ SYSIN ,PCIN  ,TTYIN ,DBASE ,TTYOUT,SYSOUT,LINES
      COMMON /SIZES/ SIZE  ,DBSIZE,NO    ,LISTLN
      COMMON /FLAGS/ DBCORE,WCORE
      COMMON /PXBLK/ PXMIN, PXMAX, PXDEF
      COMMON /SUBLK/ VERSHN,INFEET,UWATER,LENGTH,PLANLN,DEC,CLINO
      DATA OINDEX,IF,IT,STA/1,ISZM1*0,ISZ*0,ISZ*0,ISZ*'      '/
      DATA E,N,H,DIST,EAST,NORTH,HEIGHT/ISZ7*0.0/
      DATA OPTS/'EXIT','DATA','ROSE','PLAN','ELEV'/
  100 WRITE(TTYOUT,5000) VERSHN
C     OPTDAT = '                                                '
      READ(TTYIN,3000) OPTION,OPTDAT
      IF    ( OPTION .EQ. OPTS(1) ) THEN
           WRITE(TTYOUT,5001) VERSHN
           CALL SUPLOT(0.,1.,1.,1.,1.,1,1)
           STOP
      ELSE IF ( OPTION.EQ.OPTS(2) ) THEN
           CALL SU(E,N,H,EAST,NORTH,HEIGHT,DIST,IF,IT,STA,OINDEX,SCRTCH)
      ELSE IF ( OPTION.EQ.OPTS(3) ) THEN
           CALL ROSE
      ELSE IF ( OPTION.EQ.OPTS(4) ) THEN
           CALL PPLAN(EAST,NORTH,HEIGHT,IF,IT,STA,PX,PY)
      ELSE IF ( OPTION.EQ.OPTS(5) ) THEN
           CALL PELEV(EAST,NORTH,HEIGHT,IF,IT,STA,PX)
      ELSE
           WRITE(TTYOUT,5002)
           GOTO 100
      ENDIF
      WRITE(TTYOUT,5003) OPTION
      GOTO 100
C
 3000 FORMAT(A4,A48)
 5000 FORMAT(' SURVEY VERSION ',F4.2,': ENTER COMMANDS')
 5001 FORMAT(' SURVEY VERSION ',F4.2,' COMPLETED')
 5002 FORMAT(' OPTION ',A4,' UNKNOWN OR NOT IMPLEMENTED IN SU',F4.2)
 5003 FORMAT(' ',A4,' COMPLETED.')
      END
      BLOCK DATA SUINIT
      PARAMETER ( ISZ=1008 )
      REAL    LENGTH
      INTEGER SIZE  ,DBSIZE,SYSIN ,PCIN  ,TTYIN ,DBASE ,TTYOUT,SYSOUT
      LOGICAL DBCORE,WCORE, INFEET,UWATER,PXDEF
      CHARACTER*48   TITLE
      COMMON /TITL / TITLE
      COMMON /SIZES/ SIZE  ,DBSIZE,NO    ,LISTLN
      COMMON /PARMS/ SYSIN ,PCIN  ,TTYIN ,DBASE ,TTYOUT,SYSOUT,LINES
      COMMON /FLAGS/ DBCORE,WCORE
      COMMON /PXBLK/ PXMIN,PXMAX,PXDEF
      COMMON /SUBLK/ VERSHN,INFEET,UWATER,LENGTH,PLANLN,DEC,CLINO
      DATA SIZE,SYSIN,PCIN,TTYIN,DBASE,TTYOUT,SYSOUT/ISZ,1,2,3,4,5,6/
      DATA LINES,DBCORE,INFEET,UWATER,PXDEF,VERSHN/40,4*.FALSE.,5.13/
      DATA LISTLN,LENGTH,PLANLN/1,0.,0./
      DATA TITLE/'                                                '/
      END
      SUBROUTINE SU( E,N,H, EAST,NORTH,HEIGHT,DIST,
     &               IF,IT,STA, OINDEX, DEPTH )
C
C     VERSION 5.11                                        1983.10.25
C     VERSION 5.12 TO INCORPORATE UNDERWATER SURVEY       1983.11.09
C     VERSION 5.13 SPLIT OFF VECTOR CONVERSION TO CONVEC  1983.11.14
C
      INTEGER SIZE,DBSIZE,SYSIN,PCIN,TTYIN,DBASE,TTYOUT,SYSOUT,OCOUNT
      INTEGER IF(SIZE),IT(SIZE),OINDEX(SIZE)
      LOGICAL DBCORE,WCORE ,INFEET,UWATER
      REAL       E(SIZE),    N(SIZE),     H(SIZE),  DIST(SIZE)
      REAL    EAST(SIZE),NORTH(SIZE),HEIGHT(SIZE), DEPTH(SIZE)
      REAL    LEG,       LENGTH,     PLANLN
      CHARACTER*1  REPLY ,NEGATV
      CHARACTER*6  FROM  ,TO    ,ORIGIN,CHANGE,END   ,FEET  ,METRIC,
     &             DIVING,NORMAL,       STA(SIZE)
      CHARACTER*48 TITLE
      COMMON /TITL / TITLE
      COMMON /PARMS/ SYSIN ,PCIN  ,TTYIN ,DBASE ,TTYOUT,SYSOUT,LINES
      COMMON /SIZES/ SIZE  ,DBSIZE,NO    ,LISTLN
      COMMON /FLAGS/ DBCORE,WCORE
      COMMON /SUBLK/ VERSHN,INFEET,UWATER,LENGTH,PLANLN,DEC,CLINO
C
C      INITIALIZE VARIABLES
C
      DATA NEGATV / 'N' /,OCOUNT / 1 /,
     &  ORIGIN , END    , CHANGE , FEET   , METRIC , DIVING , NORMAL
     &/'ORIGIN','END   ','CHANGE','FEET  ','METRIC','DIVING','NORMAL'/
      IF ( DBCORE ) THEN
         WRITE(TTYOUT,5000)
         READ(TTYIN,5001)REPLY
         IF(REPLY.EQ.NEGATV) RETURN
         OCOUNT = 1
         LENGTH = 0.
         PLANLN = 0.
         LISTLN = 1
         DO 150 I=2,SIZE
  150    OINDEX(I) = 0
      ENDIF
      J = 0
C
C***********************************************************************
C
C           C O D E
C
      READ(SYSIN,'(A48)')TITLE
C
C     TITLE : TITLE FOR THIS CASE, TO BE PRINTED ON OUTPUT
C
      READ(SYSIN,1004) STA(1),EAST(1),NORTH(1),HEIGHT(1)
C
C----------------R E A D   L O O P--------------------------------------
C
      DO 400 I = 1,SIZE
C
  300    READ(SYSIN,1002)FROM,TO,LEG,BEAR,ELEV,VERT
C
C        TRAP END OF DATA
C
         IF( FROM .EQ. END    ) GOTO 500
C
C        TRAP CHANGES OF CALIBRATION, RECALIBRATE AND READ NEXT LOT
C         OF DATA WITHOUT ADVANCING I.
C
         IF( FROM .NE. CHANGE ) GOTO 301
C
C     DEC : CORRECTION FOR MAGNETIC NORTH / COMPASS ERROR
C     CLINO : CORRECTION FOR CLINOMETER ERROR
C
            DEC    = BEAR
            CLINO  = ELEV
            CALL SHEAD(J)
            WRITE(SYSOUT,6004) DEC,CLINO
            GOTO 300
C
C        TRAP CHANGE OF UNITS
C
  301    IF( FROM .NE. FEET   ) GOTO 302
            INFEET = .TRUE.
            GOTO 300
  302    IF( FROM .NE. METRIC ) GOTO 303
            INFEET = .FALSE.
            GOTO 300
C
C        TRAP CHANGE OF SURVEY FORMAT
C
  303    IF( FROM .NE. DIVING ) GOTO 304
            UWATER = .TRUE.
            CALL SCAN1(STA,TO,ISURF)
            IF( ISURF.LT.0 ) CALL KILL(1)
            DEPTH(ISURF) = 0.0
            GOTO 300
  304    IF( FROM .NE. NORMAL ) GOTO 310
            UWATER = .FALSE.
            GOTO 300
C
C     TRAP DEFINITION OF NEW ORIGIN
C
  310 IF( FROM .NE. ORIGIN ) GOTO 320
         NL = LISTLN + 1
         READ(SYSIN,1004) STA(NL),EAST(NL),NORTH(NL),HEIGHT(NL)
         CALL SCAN1(STA,STA(NL),IS)
         IF( IS .GT. 0 ) CALL KILL(2)
         LISTLN = NL
         OCOUNT = OCOUNT + 1
         OINDEX(LISTLN) = OCOUNT
         GOTO 300
  320    CALL CONVEC( STA, FROM,TO, LEG,BEAR,ELEV,VERT,
     &        DIST(I),E(I),N(I),H(I), IF(I),IT(I), DEPTH ,J )
  400 CONTINUE
C
C------------- E N D   O F   R E A D   L O O P -------------------------
C
C      ONLY REACH HERE IF MORE LEGS THAN PROGRAM DESIGNED FOR.
C      REDEFINE I FOR USE OUTSIDE LOOP
C
      READ(SYSIN,1002)FROM,TO
      IF(FROM.NE.END) WRITE(TTYOUT,5002)FROM,TO
      I = SIZE + 1
C
C     ALL DATA NOW READ IN AND LIST OF SURVEY STATIONS COMPLETE.
C     GENERATE COORDINATES, PRINT STATISTICS AND STORE DATA.
C
  500 REWIND SYSIN
      NO = I - 1
      CALL COORDS(E,N,H,DIST,EAST,NORTH,HEIGHT,IF,IT,STA,OINDEX)
      WRITE(SYSOUT,6005)PLANLN,LENGTH
      DBSIZE = 24 * ( 1 + ( LISTLN - 1 ) / 24 )
      CALL DBOUT(STA,IF,IT,EAST,NORTH,HEIGHT)
      RETURN
C
C***********************************************************************
C
C            I N P U T   &   O U T P U T   F O R M A T S
C
 1002 FORMAT(2A6,F6.2,2F6.1,F6.2)
 1004 FORMAT(A6,6X,3F12.3)
C
 5000 FORMAT(' SURVEY DATABASE IS ALREADY IN MEMORY.'/
     &       ' DO YOU WISH TO REDEFINE IT ?'         )
 5001 FORMAT(A1)
 5002 FORMAT(' *** WARNING ***  SURVEY LEG FROM ',A6,' TO ',
     &    A6,' EXCEEDS AVAILABLE DATA SPACE.'              )
C
 6004 FORMAT(2X,'CALIBRATION :',16X,2F8.1)
 6005 FORMAT(1X//'  TOTAL PLAN LENGTH OF SURVEY : ',F9.3/
     +           '  TOTAL TRAVERSE LENGTH : ',     F15.3)
      END
      SUBROUTINE CONVEC( STA, FROM,TO, LEG,BEAR,ELEV,VERT,
     &                   DIST, E,N,H, IF,IT, DEPTH ,J )
C
C     VERSION 1.00 TO CONVERT DATA TO VECTOR FORM          1983.11.14
C
      INTEGER SIZE,DBSIZE,SYSIN,PCIN,TTYIN,DBASE,TTYOUT,SYSOUT,OCOUNT
      LOGICAL INFEET,    UWATER
      REAL    LEG,       LENGTH,     PLANLN,   DEPTH(SIZE),  N
      CHARACTER*6  FROM  ,TO    ,STA(SIZE)
      CHARACTER*48 TITLE
      COMMON /TITL / TITLE
      COMMON /PARMS/ SYSIN ,PCIN  ,TTYIN ,DBASE ,TTYOUT,SYSOUT,LINES
      COMMON /SIZES/ SIZE  ,DBSIZE,NO    ,LISTLN
      COMMON /SUBLK/ VERSHN,INFEET,UWATER,LENGTH,PLANLN,DEC,CLINO
      DATA RAD/0.01745329/
C
C     CONVERT DATA TO VECTOR FORM :
C
      CALL LIST( STA,FROM,TO,IF,IT,NFLAG )
      IF( INFEET ) THEN
         LEG  = LEG  * 0.3048
         VERT = VERT * 0.3048
         IF( UWATER ) ELEV = ELEV * 0.3048
      ENDIF
C
C     FROM : SURVEY STATION AT START OF LEG
C     TO   : SURVEY STATION AT END OF LEG
C     LEG  : LENGTH OF LEG
C     BEAR : COMPASS BEARING
C     DIST : PLAN LENGTH
C     E,N,H : EAST,NORTH,VERTICAL COMPONENTS OF VECTOR
C
      IF ( UWATER ) THEN
C
C        ELEV : DEPTH OF STATION FROM
C        VERT : DEPTH OF STATION TO
C        DEPTH : USED AS SCRATCH STORE FOR DEPTH UNDERWATER.
C
         IF ( NFLAG .NE. 0 ) THEN
            IF ( IT .GT. IF ) THEN
                DEPTH(IT) = VERT
            ELSE
                DEPTH(IF) = ELEV
            ENDIF
         ENDIF
         IF ( ELEV * VERT .EQ. 0 ) THEN
C      ****************************************************************
C      * WARNING - THIS COULD FAIL FOR LOOPS CLOSING TO WATER SURFACE *
C      ****************************************************************
             H = DEPTH(IF) - DEPTH(IT)
         ELSE
             H = ELEV - VERT
         ENDIF
         DIST = SQRT ( LEG * LEG - H * H )
         LENGTH = LENGTH + LEG
      ELSE
C
C        ELEV : INCLINATION OF LEG
C        VERT : ANY VERTICAL COMPONENT PRODUCED BY PLUMBING
C
         ELEV2   = ( ELEV - CLINO ) * RAD
         H       = LEG     * SIN(ELEV2) + VERT
         DIST    = LEG     * COS(ELEV2)
         LENGTH  = LENGTH  + LEG + ABS(VERT)
      ENDIF
      BEAR2 = ( BEAR - DEC ) * RAD
      E       = DIST   * SIN(BEAR2)
      N       = DIST   * COS(BEAR2)
      PLANLN  = PLANLN + DIST
C
C     OUTPUT NEW SET OF HEADINGS AFTER LINES LEGS ON ONE PAGE :
C
      CALL SHEAD(J)
      IF ( UWATER ) THEN
         WRITE(SYSOUT,6002) FROM,TO,LEG,BEAR,H,DIST,E,N,H
      ELSE
         WRITE(SYSOUT,6003) FROM,TO,LEG,BEAR,ELEV,VERT,DIST,E,N,H
      ENDIF
      RETURN
 6002 FORMAT(2X,2A8,5X,F8.2,F8.1,'  UWATER',F8.2,10X,4F8.3)
 6003 FORMAT(2X,2A8,5X,F8.2,2F8.1,F8.2,10X,4F8.3)
      END
      SUBROUTINE SHEAD(J)
C     VERSION 1.00 TO ENABLE SU/CONVEC SPLIT.              1983.11.14
      INTEGER        SYSIN ,PCIN  ,TTYIN ,DBASE ,TTYOUT,SYSOUT
      CHARACTER*48   TITLE
      COMMON /TITL / TITLE
      COMMON /PARMS/ SYSIN ,PCIN  ,TTYIN ,DBASE ,TTYOUT,SYSOUT,LINES
      COMMON /SUBLK/ VERSHN,INFEET,UWATER,LENGTH,PLANLN,DEC,CLINO
      J = J + 1
      IF( MOD(J,LINES) .EQ. 1 ) WRITE(SYSOUT,6001) VERSHN,TITLE
      RETURN
 6001 FORMAT('1'//16X,'SU',F6.2,' : ',A48
     + //23X,'SURVEY DATA',31X,'COMPUTED VECTOR'/23X,32('-'),10X,32('-')
     + /5X,'FROM      TO',8X,'TAPE   COMPASS  CLINO   PLUMB',13X,'PLAN'
     + ,5X,'EAST   NORTH   HEIGHT'/)
      END
      SUBROUTINE LIST(STA,FROM,TO,IF,IT,NFLAG)
C
C     SUBROUTINE TO CREATE AND EXTEND LIST OF STATION NAMES
C     VERSION 1.01 ALSO GENERATES INDEX LIST IF,IT 1983.01.11
C     VERSION 1.11 FORTRAN77 SU5.1                 1983.10.26
C     VERSION 1.20 RETURNS NFLAG FOR SU5.12        1983.11.11
C
      INTEGER SIZE,DBSIZE
      CHARACTER*6 FROM,TO,STA(SIZE)
      COMMON /SIZES/ SIZE,DBSIZE,NO,LISTLN
      CALL SCAN(STA,FROM,TO,IF,IT)
      NFLAG = 0
      IF(IF.LE.0) THEN
        LISTLN = LISTLN + 1
        NFLAG = 1
        STA(LISTLN) = FROM
        IF = LISTLN
      ENDIF
      IF(IT.LE.0) THEN
        LISTLN = LISTLN + 1
        NFLAG = NFLAG + 1
        STA(LISTLN) = TO
        IT = LISTLN
      ENDIF
      RETURN
      END
      SUBROUTINE SCAN(STA,FROM,TO,IF,IT)
C
C     SUBROUTINE TO SEARCH LIST OF STATIONS
C     VERSION 1.20 FORTRAN77 FASTER SEARCH               1983.10.26
C
      INTEGER SIZE,DBSIZE
      CHARACTER*6 FROM,TO,STA(LISTLN)
      COMMON /SIZES/ SIZE,DBSIZE,NO,LISTLN
      IF = -1
      IT = -1
      IFOUND = -2
      DO 1 I = LISTLN,1,-1
        IF   ( STA(I) .EQ. FROM ) THEN
           IF = I
           IFOUND = IFOUND + 1
        ELSE IF( STA(I) .EQ. TO ) THEN
           IT = I
           IFOUND = IFOUND + 1
        ENDIF
        IF(IFOUND.EQ.0) RETURN
    1 CONTINUE
      RETURN
      END
      SUBROUTINE SCAN1(STA,SEARCH,IS)
C
C     FAST SEARCH FOR SINGLE STATION, FROM SCAN 1.20     1983.11.11
C
      INTEGER SIZE,DBSIZE
      CHARACTER*6 SEARCH,STA(LISTLN)
      COMMON /SIZES/ SIZE,DBSIZE,NO,LISTLN
      DO 1 I = LISTLN,1,-1
        IF   ( STA(I) .EQ. SEARCH ) GOTO 2
    1 CONTINUE
      IS = -1
      RETURN
    2 IS = I
      RETURN
      END
      SUBROUTINE COORDS(E,N,H,DIST,EAST,NORTH,HEIGHT,IF,IT,STA,OINDEX)
C
C     COORDS 1.00  FOR SU 4.2  1982.08.24  WITH BACKSIGHTS
C     COORDS 2.00         5.00 1983.01.13  'SURVEY' IMPLEMENTATION
C     COORDS 2.10         5.10 1983.01.28 MULTIPLE ORIGINS
C     COORDS 2.13              1983.10.26 CHEAD INTERFACE AGAIN
C
      INTEGER SIZE,DBSIZE,SYSIN,PCIN,TTYIN,DBASE,TTYOUT,SYSOUT,OCURR
      INTEGER   IF(SIZE),   IT(SIZE),OINDEX(SIZE)
      REAL       E(SIZE),    N(SIZE),     H(SIZE),  DIST(SIZE)
      REAL    EAST(SIZE),NORTH(SIZE),HEIGHT(SIZE)
      REAL    MISCE,     MISCN,      MISCH,       LENGTH
      LOGICAL DBCORE,WCORE, INFEET,UWATER
      CHARACTER*6 STA(SIZE)
      CHARACTER*48 TITLE
      COMMON /TITL / TITLE
      COMMON /PARMS/ SYSIN ,PCIN  ,TTYIN ,DBASE ,TTYOUT,SYSOUT,LINES
      COMMON /SIZES/ SIZE  ,DBSIZE,NO    ,LISTLN
      COMMON /FLAGS/ DBCORE,WCORE
      COMMON /SUBLK/ VERSHN,INFEET,UWATER,LENGTH,PLANLN,DEC,CLINO
      OCURR = 0
      J = 0
C
      DO 590 I = 1,NO
        IF(OINDEX(IF(I)).GT.0) GOTO 510
        IF(OINDEX(IT(I)).GT.0) GOTO 520
C         LEG IS ISOLATED FROM REST OF SURVEY.
          CALL CHEAD(J,1)
          WRITE(SYSOUT,2010)STA(IF(I)),STA(IT(I)),E(I),N(I),H(I),DIST(I)
          GOTO 590
  510   IF(OINDEX(IT(I)).GT.0) GOTO 550
C       FORWARD SIGHTING LEG :
        A = 1.
        ID = IF(I)
        IU = IT(I)
        GOTO 530
C
C       BACKSIGHT :
  520   A = -1.
        ID = IT(I)
        IU = IF(I)
  530   EAST(  IU) = EAST(  ID) + A * E(I)
        NORTH( IU) = NORTH( ID) + A * N(I)
        HEIGHT(IU) = HEIGHT(ID) + A * H(I)
        OINDEX(IU) = OINDEX(ID)
        IF (OINDEX(ID).GT.OCURR) THEN
           CALL CHEAD(J,2)
           OCURR = OINDEX(ID)
           WRITE(SYSOUT,2004)OCURR,STA(ID),EAST(ID),NORTH(ID),HEIGHT(ID)
        ELSE
           CALL CHEAD(J,1)
        ENDIF
        WRITE(SYSOUT,2003)STA(IF(I)),STA(IT(I)),E(I),N(I),H(I),DIST(I),
     &                    STA( IU  ),EAST(IU),NORTH(IU),HEIGHT(IU)
        GOTO 590
C       BOTH ENDS OF LEG ALREADY DEFINED.
  550   MISCE = EAST(  IF(I)) + E(I) - EAST(IT(I))
        MISCN = NORTH( IF(I)) + N(I) - NORTH(IT(I))
        MISCH = HEIGHT(IF(I)) + H(I) - HEIGHT(IT(I))
        IF(OINDEX(IF(I)).NE.OINDEX(IT(I))) THEN
          IF(MAX(OINDEX(IF(I)),OINDEX(IT(I))).GT.OCURR) THEN
           CALL CHEAD(J,3)
           IO = IF(I)
           IF(OINDEX(IT(I)).GT.OINDEX(IO)) IO = IT(I)
           OCURR = OINDEX(IO)
           WRITE(SYSOUT,2004)OCURR,STA(IO),EAST(IO),NORTH(IO),HEIGHT(IO)
          ELSE
           CALL CHEAD(J,2)
          ENDIF
  558     WRITE(SYSOUT,2007) OINDEX(IF(I)),OINDEX(IT(I))
        ELSE
          CALL CHEAD(J,1)
        ENDIF
  570   WRITE(SYSOUT,2006) STA(IF(I)),STA(IT(I)),E(I),N(I),H(I),DIST(I),
     &                     MISCE,MISCN,MISCH
  590 CONTINUE
      DBCORE = .TRUE.
      RETURN
 2003 FORMAT( 1X,A6,A8,4F9.3,5X,A8,3F10.3)
 2004 FORMAT(40X,'ORIGIN',I4,'  AT  ',A8,3F10.3)
 2006 FORMAT( 1X,A6,A8,4F9.3,4X,'MISCLOSES',3F10.3)
 2007 FORMAT(15X,'SURVEYS',I4,' AND',I4,' CONNECT :')
 2010 FORMAT(1X,A6,A8,4F9.3,4X,'UNDEFINED')
      END
      SUBROUTINE CHEAD(J,I)
C
C     SUBROUTINE TO PRINT COORDS HEADINGS IF NEEDEDV 1.03  83.10.26
C
C     J = NO. OF LINES OUTPUT SO FAR.  I = SPARE LINES NEEDED THIS PAGE
C
      CHARACTER*48 TITLE
      INTEGER UNITS(5),SYSOUT
      COMMON /TITL / TITLE
      COMMON /PARMS/ UNITS ,SYSOUT,LINES
      COMMON /SUBLK/ VERSHN,INFEET,UWATER,LENGTH,PLANLN,DEC,CLINO
C
      DO 100 K = 0,I-1
         IF(MOD(J+K,LINES).EQ.0) GOTO 200
  100 CONTINUE
      J = J + I
      RETURN
  200 WRITE(SYSOUT,2009) VERSHN,TITLE
      J = J + K + I
      RETURN
 2009 FORMAT('1'//' SU',F6.2,25X,A48 //
     & 22X,'VECTOR',45X,'POSITION' / 2X,49('-'),5X,38('-') /
     & 3X,'FROM     TO     EAST    NORTH    HEIGHT',
     & 4X,'PLAN',7X,'STATION     EAST     NORTH     HEIGHT'/)
      END
      SUBROUTINE DBOUT(STA,IF,IT,EAST,NORTH,HEIGHT)
C
      INTEGER SIZE,DBSIZE,SYSIN,PCIN,TTYIN,DBASE,TTYOUT,SYSOUT
      INTEGER IF(DBSIZE),IT(DBSIZE)
      REAL EAST(DBSIZE),NORTH(DBSIZE),HEIGHT(DBSIZE)
      CHARACTER*6 STA(DBSIZE)
      CHARACTER*48 TITLE
      COMMON /TITL / TITLE
      COMMON /PARMS/ SYSIN,PCIN,TTYIN,DBASE,TTYOUT,SYSOUT,LINES
      COMMON /SIZES/ SIZE,DBSIZE,NO,LISTLN
C
      WRITE(DBASE,4000) TITLE,DBSIZE,NO,LISTLN
      WRITE(DBASE,4001) STA
      WRITE(DBASE,4002) IF,IT
      WRITE(DBASE,4003) EAST,NORTH,HEIGHT
      RETURN
 4000 FORMAT(1X,A48/1X,3I6)
 4001 FORMAT(1X,12A6)
 4002 FORMAT(1X,12I6)
 4003 FORMAT(1X,8F10.3)
      END
      SUBROUTINE PPLAN(EAST,NORTH,HEIGHT,IF,IT,STA,PX,PY)
C
C     TO INTERROGATE DATABASE AND PLOT SURVEY PLAN.
C     VERSION 2.00
C
      INTEGER SIZE,DBSIZE,SYSIN,PCIN,TTYIN,DBASE,TTYOUT,SYSOUT
      INTEGER IF(SIZE),IT(SIZE)
      REAL    EAST(SIZE),NORTH(SIZE),HEIGHT(SIZE),WRANGE(2,3)
      REAL    PX(SIZE),PY(SIZE)
      LOGICAL DBCORE,WCORE,PXDEF
      CHARACTER*6  STA(SIZE)
      CHARACTER*48 TITLE
      COMMON / TITL/ TITLE
      COMMON /PARMS/ SYSIN, PCIN,  TTYIN, DBASE, TTYOUT,SYSOUT,LINES
      COMMON /SIZES/ SIZE,  DBSIZE,NO,    LISTLN
      COMMON /FLAGS/ DBCORE,WCORE
      COMMON /PXBLK/ PXMIN, PXMAX, PXDEF
      READ(PCIN,1001)SCALE, ORIENT,WRANGE
      REWIND PCIN
      IF(DBCORE) GOTO 100
      READ(DBASE,2001)TITLE,DBSIZE,NO,LISTLN
      CALL DBREAD(STA,IF,IT,EAST,NORTH,HEIGHT)
  100 CALL PLAN(SCALE,ORIENT,WRANGE,STA,IF,IT,EAST,NORTH,PX,PY)
      RETURN
 1001 FORMAT(2F6.0,6F8.0)
 2001 FORMAT(1X,A48/1X,3I6)
      END
      SUBROUTINE PLAN(SCALE,ANGLE,WRANGE,STA,IF,IT,EAST,NORTH,PX,PY)
C
C     SUBROUTINE TO PLOT A SURVEY FROM SAVED COORDINATE DATA AT A USER
C     DEFINED SCALE, INTO A USER ORIENTATED AND SIZED WINDOW AREA.
C
C     VERSION 1.00  A.E.R.WADDINGTON                         1982.09.07
C     VERSION 1.10  FOR SU 5 SUITE                           1983.01.11
C     VERSION 1.20  PACKAGE INDEPENDENT PLOT                 1983.08.26
C
      INTEGER SIZE,DBSIZE,SYSIN,PCIN,TTYIN,DBASE,TTYOUT,SYSOUT
      INTEGER IF(NO),IT(NO)
      REAL WRANGE(2,3),EAST(LISTLN),NORTH(LISTLN),PX(LISTLN),PY(LISTLN)
      LOGICAL PXDEF
      CHARACTER*6 STA(LISTLN)
      CHARACTER*48 TITLE
      COMMON /TITL / TITLE
      COMMON /PARMS/ SYSIN, PCIN,  TTYIN, DBASE, TTYOUT,SYSOUT,LINES
      COMMON /SIZES/ SIZE,  DBSIZE,NO,    LISTLN
      COMMON /PXBLK/ PXMIN, PXMAX, PXDEF
      DATA RAD/.01745329/
C
C     CONVERT SURVEY SPACE COORDINATES TO PAPER-SPACE COORDINATES WITH
C     PLOTTER X-AXIS ALIGNED ON A BEARING OF , AND CALCULATE
C     RANGE OF X AND Y COORDINATES.
C
      BE = RAD * ANGLE
      SINB = SIN(BE)
      COSB = COS(BE)
      IF(PXDEF) GOTO 100
         PX(1) = NORTH(1) * COSB + EAST(1) * SINB
         PXMAX      = PX(1)
         PXMIN      = PXMAX
  100 PY(1) = NORTH(1) * SINB - EAST(1) * COSB
      PYMAX      = PY(1)
      PYMIN      = PYMAX
      DO 150 I = 2,LISTLN
         IF(PXDEF) GOTO 140
            PX(I) = NORTH(I) * COSB + EAST(I) * SINB
            IF(PX(I).LT.PXMIN) PXMIN = PX(I)
            IF(PX(I).GT.PXMAX) PXMAX = PX(I)
  140    PY(I) = NORTH(I) * SINB - EAST(I) * COSB
         IF(PY(I).LT.PYMIN) PYMIN = PY(I)
         IF(PY(I).GT.PYMAX) PYMAX = PY(I)
  150 CONTINUE
      WRITE(SYSOUT,2004) ANGLE,PYMIN,PYMAX,PXMIN,PXMAX
     &            ,WRANGE(1,2),WRANGE(2,2),WRANGE(1,1),WRANGE(2,1)
      WRITE(TTYOUT,2004) ANGLE,PYMIN,PYMAX,PXMIN,PXMAX
     &            ,WRANGE(1,2),WRANGE(2,2),WRANGE(1,1),WRANGE(2,1)
      IF(     PYMAX.GT.WRANGE(2,2)  .OR.  PYMIN.LT.WRANGE(1,2)
     &    .OR.PXMAX.GT.WRANGE(2,1)  .OR.  PXMIN.LT.WRANGE(1,1) )
     &                      WRITE(TTYOUT,2005)
      WRITE(TTYOUT,*) I
      CALL SUPLOT(SCALE,WRANGE(1,1),WRANGE(1,2),PX,PY,IF,IT)
      RETURN
 2004 FORMAT('1'/' PAPER LONG AXIS IS ON A BEARING OF',F5.0,' DEGREES'//
     +' EXTENT OF SURVEY IN SCALE PAPER SPACE:'/'   WIDTH  AXIS',2F11.3/
     + '   LENGTH AXIS',2F11.3//
     +' EXTENT OF WINDOW IN SCALE PAPER SPACE:'/'   WIDTH  AXIS',2F11.3/
     + '   LENGTH AXIS',2F11.3//)
 2005 FORMAT('0 *** WARNING *** SURVEY EXTENDS BEYOND WINDOW AREA')
      END
      SUBROUTINE PELEV(EAST,NORTH,HEIGHT,IF,IT,STA,PX)
C
C     TO INTERROGATE DATABASE AND PLOT SURVEY ELEVATION.
C     VERSION 2.00
C
      INTEGER SIZE,DBSIZE,SYSIN,PCIN,TTYIN,DBASE,TTYOUT,SYSOUT
      INTEGER IF(SIZE),  IT(SIZE)
      REAL    EAST(SIZE),NORTH(SIZE),HEIGHT(SIZE),PX(SIZE),WRANGE(2,3)
      LOGICAL DBCORE,WCORE,PXDEF
      CHARACTER*6 STA(SIZE)
      CHARACTER*48 TITLE
      COMMON / TITL/ TITLE
      COMMON /PARMS/ SYSIN, PCIN,  TTYIN, DBASE, TTYOUT,SYSOUT,LINES
      COMMON /SIZES/ SIZE,  DBSIZE,NO,    LISTLN
      COMMON /FLAGS/ DBCORE,WCORE
      COMMON /PXBLK/ PXMIN, PXMAX, PXDEF
      READ(PCIN,1001)SCALE, ORIENT,WRANGE
      REWIND PCIN
      IF(DBCORE) GOTO 100
      READ(DBASE,2001)TITLE,DBSIZE,NO,LISTLN
      CALL DBREAD(STA,IF,IT,EAST,NORTH,HEIGHT)
  100 CALL ELEV(SCALE,ORIENT,WRANGE,STA,IF,IT,EAST,NORTH,PX,HEIGHT)
      RETURN
 1001 FORMAT(2F6.0,6F8.0)
 2001 FORMAT(1X,A48/1X,3I6)
      END
      SUBROUTINE ELEV(SCALE,ANGLE,WRANGE,STA,IF,IT,EAST,NORTH,PX,HEIGHT)
C
C     SUBROUTINE TO PLOT A SURVEY FROM SAVED COORDINATE DATA AT A USER
C     DEFINED SCALE, INTO A USER ORIENTATED AND SIZED WINDOW AREA.
C
C     VERSION 1.20  PACKAGE INDEPENDENT IMPLEMENTATION       1983.08.26
C
      INTEGER SIZE,DBSIZE,SYSIN,PCIN,TTYIN,DBASE,TTYOUT,SYSOUT
      INTEGER IF(NO),IT(NO)
      REAL WRANGE(2,3),EAST(LISTLN),NORTH(LISTLN),HEIGHT(LISTLN),
     &                 PX(LISTLN)
      LOGICAL      PXDEF
      CHARACTER*6  STA(LISTLN)
      CHARACTER*48 TITLE
      COMMON / TITL/ TITLE
      COMMON /PARMS/ SYSIN, PCIN,  TTYIN, DBASE, TTYOUT,SYSOUT,LINES
      COMMON /SIZES/ SIZE,  DBSIZE,NO,    LISTLN
      COMMON /PXBLK/ PXMIN, PXMAX, PXDEF
      DATA RAD/.01745329/
C
C     CONVERT SURVEY SPACE COORDINATES TO PAPER-SPACE COORDINATES WITH
C     PLOTTER X-AXIS ALIGNED ON A BEARING OF , AND CALCULATE
C     RANGE OF X AND Y COORDINATES.
C
      BE = RAD * ANGLE
      SINB = SIN(BE)
      COSB = COS(BE)
      IF(PXDEF) GOTO 100
         PX(1)   = NORTH(1) * COSB + EAST(1) * SINB
         PXMAX   = PX(1)
         PXMIN   = PXMAX
  100 PZMAX      = HEIGHT(1)
      PZMIN      = PZMAX
      DO 150 I = 2,LISTLN
         IF(PXDEF) GOTO 140
            PX(I) = NORTH(I) * COSB + EAST(I) * SINB
            IF(PX(I).LT.PXMIN) PXMIN = PX(I)
            IF(PX(I).GT.PXMAX) PXMAX = PX(I)
  140    IF(HEIGHT(I).LT.PZMIN) PZMIN = HEIGHT(I)
         IF(HEIGHT(I).GT.PZMAX) PZMAX = HEIGHT(I)
  150 CONTINUE
      WRITE(SYSOUT,2004) ANGLE,PZMIN,PZMAX,PXMIN,PXMAX
     &            ,WRANGE(1,3),WRANGE(2,3),WRANGE(1,1),WRANGE(2,1)
      WRITE(TTYOUT,2004) ANGLE,PZMIN,PZMAX,PXMIN,PXMAX
     &            ,WRANGE(1,3),WRANGE(2,3),WRANGE(1,1),WRANGE(2,1)
      IF(    PZMAX.GT.WRANGE(2,3)  .OR.  PZMIN.LT.WRANGE(1,3)
     &   .OR.PXMAX.GT.WRANGE(2,1)  .OR.  PXMIN.LT.WRANGE(1,1) )
     &                      WRITE(TTYOUT,2005)
      CALL SUPLOT(SCALE,WRANGE(1,1),WRANGE(1,3),PX,HEIGHT,IF,IT)
      RETURN
 2004 FORMAT('1'/' PAPER LONG AXIS IS ON A BEARING OF',F5.0,' DEGREES'//
     +' EXTENT OF SURVEY IN SCALE PAPER SPACE:'/'   HEIGHT AXIS',2F11.3/
     +'   LENGTH AXIS',2F11.3//
     +' EXTENT OF WINDOW IN SCALE PAPER SPACE:'/'   HEIGHT AXIS',2F11.3/
     +'   LENGTH AXIS',2F11.3//)
 2005 FORMAT('0',' *** WARNING *** SURVEY EXTENDS BEYOND WINDOW AREA')
      END
      SUBROUTINE DBREAD(STA,IF,IT,EAST,NORTH,HEIGHT)
C
C     TO RETRIEVE DATABASE FROM DISC. V 1.00     1983.  .
C
      INTEGER SIZE,DBSIZE,SYSIN,PCIN,TTYIN,DBASE,TTYOUT,SYSOUT
      INTEGER IF(DBSIZE),IT(DBSIZE)
      REAL    EAST(DBSIZE),NORTH(DBSIZE),HEIGHT(DBSIZE)
      LOGICAL DBCORE,WCORE
      CHARACTER*6 STA(DBSIZE)
      COMMON /PARMS/ SYSIN, PCIN,  TTYIN, DBASE,TTYOUT,SYSOUT,LINES
      COMMON /SIZES/ SIZE,  DBSIZE,NO,    LISTLN
      COMMON /FLAGS/ DBCORE,WCORE
      READ(DBASE,3001)STA
      READ(DBASE,3002)IF,IT
      READ(DBASE,3003)EAST,NORTH,HEIGHT
      REWIND DBASE
      DBCORE = .TRUE.
      RETURN
 3001 FORMAT(1X,12A6)
 3002 FORMAT(1X,12I6)
 3003 FORMAT(1X,8F10.3)
      END
      SUBROUTINE ROSE
C
C     VERSION 1.00 A.E.R.WADDINGTON                       1983.01.12
C     VERSION 1.02 IMPLEMENTED USING ROSPLT AS INTERFACE  1983.08.30
C
      INTEGER SIZE,DBSIZE,SYSIN,PCIN,TTYIN,DBASE,TTYOUT,SYSOUT
      REAL LEG,LENGTH,PLANLN,BELEN(45),BEFRCT(45),RANGE(0:45),INTSZ
      CHARACTER*6 FROM,    TO, START,   END,CHANGE,  FEET,METRIC,
     &                 ORIGIN,DIVING,NORMAL
      CHARACTER*48 TITLE
      LOGICAL INFEET,UWATER
      COMMON /TITL / TITLE
      COMMON /PARMS/ SYSIN,PCIN,TTYIN,DBASE,TTYOUT,SYSOUT,LINES
      COMMON /SIZES/ SIZE  ,DBSIZE,NO    ,LISTLN
C
C      INITIALIZE VARIABLES
C
      DATA  INFEET, UWATER / 2* .FALSE. /,
     &  ORIGIN , END    , CHANGE , FEET   , METRIC , DIVING , NORMAL
     &/'ORIGIN','END   ','CHANGE','FEET  ','METRIC','DIVING','NORMAL'/,
     &  RAD , RANGE(0) , BELEN , RVERS  /.01745329 , 46*0. , 1.03/
      LENGTH = 0.
      PLANLN = 0.
C
C***********************************************************************
C
C           C O D E
C
      WRITE(TTYOUT,5001)RVERS
      READ(TTYIN,*) INTSZ
      NINTS  = MIN( INT( 180. / INTSZ ) , 45 )
      INTSZ  = 180. / NINTS
      WRITE(TTYOUT,5002) RVERS, NINTS, INTSZ
      READ(SYSIN,'(A48)')TITLE
C
      READ(SYSIN,'(A6)')START
C
C----------------R E A D   L O O P--------------------------------------
C
      DO 400 I = 1,SIZE
C
  300    READ(SYSIN,1002)FROM,TO,LEG,BEAR,ELEV,VERT
         IF( FROM .EQ. END    ) GOTO 500
         IF( FROM .NE. CHANGE ) GOTO 301
            DEC    = BEAR
            CLINO  = ELEV
            GOTO 300
  301    IF( FROM .NE. FEET   ) GOTO 302
            INFEET = .TRUE.
            GOTO 300
  302    IF( FROM .NE. METRIC ) GOTO 303
            INFEET = .FALSE.
            GOTO 300
  303    IF( FROM .NE. DIVING ) GOTO 304
            UWATER = .TRUE.
            GOTO 300
  304    IF( FROM .NE. NORMAL ) GOTO 310
            UWATER = .FALSE.
            GOTO 300
  310    IF( FROM .EQ. ORIGIN ) GOTO 300
C
         BEAR1 = ( BEAR - DEC )
         BEAR2 = BEAR1 * RAD
         IF( INFEET ) THEN
                            LEG  = LEG  * 0.3048
                            VERT = VERT * 0.3048
                      ENDIF
         IF( UWATER ) THEN
C                           THIS IS SOMEWHAT DUFF - BUT EASIER THAN
C                           DOING IT PROPERLY AS IN SU
C
                            DIST   = LEG
                            LENGTH = LENGTH + LEG
                      ELSE
                            ELEV2 = ( ELEV - CLINO ) * RAD
                            DIST   = LEG    * COS(ELEV2)
                            LENGTH = LENGTH + LEG + ABS(VERT)
                      ENDIF
         PLANLN = PLANLN + DIST
         ITEMP  = INT( BEAR1 / INTSZ )
         IBEAR  = 1 + MOD( NINTS + MOD( ITEMP , NINTS ), NINTS )
  400    BELEN(IBEAR) = BELEN(IBEAR) + DIST
C
C------------- E N D   O F   R E A D   L O O P -------------------------
C
      I = SIZE + 1
  500 REWIND SYSIN
      WRITE(SYSOUT,6001) RVERS, TITLE, PLANLN, LENGTH
      DO 550 I = 1,NINTS
         RANGE(I) = INTSZ * REAL(I)
  550    BEFRCT(I) = 100. * BELEN(I) / PLANLN
      WRITE(SYSOUT,6002)(RANGE(I-1),RANGE(I),BELEN(I),BEFRCT(I)
     &                                        ,I=1,NINTS)
C---------------------!!        CALL ROSPLT(INTSZ,NINTS,RANGE,BEFRCT)
      RETURN
C
C***********************************************************************
C
 1002 FORMAT(2A6,F6.2,2F6.1,F6.2)
C
 5001 FORMAT(' ROSE',F5.2,': SPECIFY INTERVAL SIZE ( DEGREES )')
 5002 FORMAT(' ROSE',F5.2,': USING',I3,' INTERVALS OF',F6.2,' DEGREES.')
C
 6001 FORMAT('1'//' ROSE',F5.2,' : ',A48/
     & '  TOTAL  PLAN  LENGTH OF SURVEY : ',F9.3/
     & '  TOTAL  TRAVERSE  LENGTH : ',F15.3)
 6002 FORMAT('0 +------------------+------------+---------+'/
     &       '  |  BEARING  RANGE  | CUMULATIVE |         |'/
     &       '  |   OF  INTERVAL   |   LENGTH   | PERCENT |'/
     &       '  +------------------+------------+---------+'/
     &     ('  |',F7.2,' TO',F7.2,' |',F9.2,'   |',F8.3,' |'/
     &       '  +------------------+------------+---------+'))
      END
      SUBROUTINE KILL(I)
C
C     SUBROUTINE TO TERMINATE IN ERROR CONDITIONS.
C
      CHARACTER*50 MESAGE(10)
      DATA MESAGE
     &/ 'SURFACE STATION IN UNDERWATER SURVEY NOT DEFINED. ',
     &  'NEW ORIGIN ATTEMPTS TO REDEFINE EXISTING STATION. ',
     &  '                                                  ',
     &  '                                                  ',
     &  '                                                  ',
     &  '                                                  ',
     &  '                                                  ',
     &  '                                                  ',
     &  '                                                  ',
     &  '                                                  '/
      WRITE(5,5999) MESAGE(I)
      STOP
 5999 FORMAT(' FATAL ERROR : ',A50)
      END
