SUBROUTINE TOXYZ (GLAT,GLON,EHT,X,Y,Z)

*** COMPUTE X,Y,Z
*** REF P.17 GEOMETRIC GEODESY NOTES VOL 1, OSU, RAPP

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL LMSL,LSS,LUP
      COMMON /OPT/ AX,E2,DMSL,DGH,VM,VP,CTOL,ITMAX,ITMIN,IMODE,
     &             LMSL,LSS,LUP

      SLAT = DSIN(GLAT)
      CLAT = DCOS(GLAT)
      W = DSQRT( 1.D0 - E2 * SLAT * SLAT )
      EN = AX / W

      X = (EN + EHT) * CLAT * DCOS(GLON)
      Y = (EN + EHT) * CLAT * DSIN(GLON)
      Z = (EN * (1.D0 - E2) + EHT) * SLAT

      RETURN
      END
      SUBROUTINE NEWFOT

*** INITIALIZE THE TABLE TO ZERO LENGTH

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /FOURTH/ NFOT,NFOTS(700)

      DO 1 I = 1,700
        NFOTS(I) = 0
 1    CONTINUE

      RETURN
      END
      SUBROUTINE NEWSSN

*** INITIALIZE THE TABLE TO ZERO LENGTH

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      COMMON /SSNTBL/ NSSN,ISSISN(MXSSN)

      DO 1 I = 1,MXSSN
        ISSISN(I) = 0
    1 CONTINUE
      NSSN = 0

      RETURN
      END
      LOGICAL FUNCTION GETSSN (ISSN,I)

*** TABLE LOOKUP

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      COMMON /SSNTBL/ NSSN,ISSISN(MXSSN)

      IF (ISSN.LE.0 .OR. ISSN.GT.MXSSN) THEN
        WRITE (6,1) ISSN
    1   FORMAT ('0ERROR - ILLEGAL ISSN ',I9)
        CALL ABORT2
      ENDIF

      I = ISSISN(ISSN)
      IF (I.EQ.0) THEN
        GETSSN = .FALSE.
      ELSE
        GETSSN = .TRUE.
      ENDIF

      RETURN
      END
      LOGICAL FUNCTION PUTSSN (ISSN,IDUP)

*** ADD ENTRY TO TABLE
*** IDUP IS LOCATION OF DUPLICATE ENTRY IN LIST
*** IDUP = 0 INDICATES ILLEGAL ISSN

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      LOGICAL GETSSN
      COMMON /SSNTBL/ NSSN,ISSISN(MXSSN)

      IF (ISSN.LE.0 .OR. ISSN.GT.MXSSN) THEN
        IDUP = 0
        PUTSSN = .FALSE.
      ELSEIF ( GETSSN(ISSN,ISN) ) THEN
        IDUP = ISN
        PUTSSN = .FALSE.
      ELSE
        IDUP = 0
        NSSN = NSSN + 1
        ISSISN(ISSN) = NSSN
        PUTSSN = .TRUE.
      ENDIF

      RETURN
      END
      LOGICAL FUNCTION LOCSSN (ISN,ISSN)

*** SCAN TABLE FOR THE ISN-TH SSN

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      COMMON /SSNTBL/ NSSN,ISSISN(MXSSN)
      SAVE IPOINT
      DATA IPOINT /1/

      IF (ISN.LE.0 .OR. ISN.GT.NSSN) THEN
        LOCSSN = .FALSE.
        RETURN
      ELSE
        DO 1 I = IPOINT,MXSSN
          IF ( ISSISN(I).EQ.ISN ) THEN
            IPOINT = I
            ISSN = I
            LOCSSN = .TRUE.
            RETURN
          ENDIF
    1   CONTINUE

*** WRAP AROUND

        I1 = IPOINT - 1
        DO 2 I = 1,I1
          IF ( ISSISN(I).EQ.ISN ) THEN
            IPOINT = I
            ISSN = I
            LOCSSN = .TRUE.
            RETURN
          ENDIF
    2   CONTINUE

*** FELL THRU TABLE--ISN NOT LOCATED

        LOCSSN = .FALSE.
        RETURN
      ENDIF

      RETURN
      END
      INTEGER FUNCTION ITCODE (TC)

*** FIND HOUR SHIFT TO MOVE TO GMT (ZULU) FOR A NAVY TIME CODE

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*1 TC

*** THE 'IF' CLAUSES ARE USED IN ADDITION TO THE 'ELSEIF' CLAUSES
*** TO PREVENT THE COMPILER FROM COMPLAINING ABOUT THE MAXIMUM
*** ALLOWABLE NUMBER OF NESTED LEVELS.
*** IF THIS ERROR MESSAGE OCCURS, EITHER HAVE THE COMPILER INCREASE
*** ITS LIMIT ON THE NUMBER OF NESTED LEVELS, OR CONVERT MORE OF THE
*** 'ELSEIF' CLAUSES INTO 'IF' CLAUSES WITH 'RETURN' STATEMENTS.

      IF (TC.EQ.'Z') THEN
        ITCODE = 0
        RETURN
      ENDIF
      IF (TC.EQ.'N') THEN
        ITCODE = +1
        RETURN
      ENDIF
      IF (TC.EQ.'O') THEN
        ITCODE = +2
        RETURN
      ENDIF
      IF (TC.EQ.'P') THEN
        ITCODE = +3
      ELSEIF (TC.EQ.'Q') THEN
        ITCODE = +4
      ELSEIF (TC.EQ.'R') THEN
        ITCODE = +5
      ELSEIF (TC.EQ.'S') THEN
        ITCODE = +6
      ELSEIF (TC.EQ.'T') THEN
        ITCODE = +7
      ELSEIF (TC.EQ.'U') THEN
        ITCODE = +8
      ELSEIF (TC.EQ.'V') THEN
        ITCODE = +9
      ELSEIF (TC.EQ.'W') THEN
        ITCODE = +10
      ELSEIF (TC.EQ.'X') THEN
        ITCODE = +11
      ELSEIF (TC.EQ.'Y') THEN
        ITCODE = +12
      ELSEIF (TC.EQ.'A') THEN
        ITCODE = -1
      ELSEIF (TC.EQ.'B') THEN
        ITCODE = -2
      ELSEIF (TC.EQ.'C') THEN
        ITCODE = -3
      ELSEIF (TC.EQ.'D') THEN
        ITCODE = -4
      ELSEIF (TC.EQ.'E') THEN
        ITCODE = -5
      ELSEIF (TC.EQ.'F') THEN
        ITCODE = -6
      ELSEIF (TC.EQ.'G') THEN
        ITCODE = -7
      ELSEIF (TC.EQ.'H') THEN
        ITCODE = -8
      ELSEIF (TC.EQ.'I') THEN
        ITCODE = -9
      ELSEIF (TC.EQ.'K') THEN
        ITCODE = -10
      ELSEIF (TC.EQ.'L') THEN
        ITCODE = -11
      ELSEIF (TC.EQ.'M') THEN
        ITCODE = -12
      ELSE
        WRITE (6,1) TC
    1   FORMAT ('0ERROR - ILLEGAL TIME CODE--',A1)
        CALL ABORT2
      ENDIF

      RETURN
      END
      SUBROUTINE NEWPRM

*** INITIALIZE THE TABLE TO ZERO LENGTH

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /PRMTB1/ NPARMS,ICODES(30),IOLDS(30),INEWS(30)

      NPARMS = 0

      RETURN
      END
      SUBROUTINE NEWZ

*** INITIALIZE THE ROT. PARM. TABLE

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /ROTTB2/ LOOK(977),IPTRS(4000),NKEY,MAX,IFREE

      NKEY = 977
      MAX = 4000
      IFREE = 1

      DO 1 I = 1,NKEY
        LOOK(I) = 0
 1    CONTINUE

      RETURN
      END
      SUBROUTINE NEWIVF

*** INITIALIZE THE TABLE TO ZERO LENGTH

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL LFIXS
      COMMON /IVFTB1/ NIVFS,ICODES(30),IOLDS(30),INEWS(30),LFIXS(30)
      COMMON /NUMVFS/ NVFTOT,NVFREE

      NIVFS = 0
      NVFTOT = 0
      NVFREE = 0

      RETURN
      END
      LOGICAL FUNCTION GETPRM (ICODE,ITIME,IPARM)

*** TABLE LOOKUP

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /PRMTB1/ NPARMS,ICODES(30),IOLDS(30),INEWS(30)

      IPARM = 1
  100 IF (IPARM.LE.NPARMS) THEN
        IF ( ICODE.EQ.ICODES(IPARM) .AND.
     &       ITIME.GE.IOLDS(IPARM)  .AND.
     &       ITIME.LE.INEWS(IPARM) ) THEN
          GETPRM = .TRUE.
          RETURN
        ELSE
          IPARM = IPARM + 1
        ENDIF
        GO TO 100
      ENDIF

*** FELL THRU TABLE

      GETPRM = .FALSE.

      RETURN
      END
      LOGICAL FUNCTION GETZ (ISSN,LIST,IZ)

*** TABLE LOOKUP

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL LOKZ
      COMMON /ROTTB1/ IZNS(4000)
      COMMON /ROTTB2/ LOOK(977),IPTRS(4000),NKEY,MAX,IFREE

      IZN = ISSN * 1000 + LIST
      IF ( LOKZ(IZN,ILOOK,IPTR) ) THEN
        IZ = IPTR
        GETZ = .TRUE.
      ELSE
        IZ = IFREE
        GETZ = .FALSE.
      ENDIF

      RETURN
      END
      LOGICAL FUNCTION GETIVF (ICODE,ITIME,IVF)

*** TABLE LOOKUP

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL LFIXS
      COMMON /IVFTB1/ NIVFS,ICODES(30),IOLDS(30),INEWS(30),LFIXS(30)

      IVF = 1
  100 IF (IVF.LE.NIVFS) THEN
        IF ( ICODE.EQ.ICODES(IVF) .AND.
     &       ITIME.GE.IOLDS(IVF)  .AND.
     &       ITIME.LE.INEWS(IVF) ) THEN
          GETIVF = .TRUE.
          RETURN
        ELSE
          IVF = IVF + 1
        ENDIF
        GO TO 100
      ENDIF

*** FELL THRU TABLE

      GETIVF = .FALSE.

      RETURN
      END
      LOGICAL FUNCTION PUTPRM (ICODE,IOLD,INEW,IDUP)

*** ADD ENTRY TO TABLE
*** IDUP IS LOCATION OF DUPLICATE ENTRY IN LIST
*** IDUP = 0 INDICATES EXCEEDED MAXIMUM LENGTH OF LIST

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL GETPRM
      COMMON /PRMTB1/ NPARMS,ICODES(30),IOLDS(30),INEWS(30)

      IF ( GETPRM(ICODE,IOLD,IPARM) ) THEN
        IDUP = IPARM
        PUTPRM = .FALSE.
        RETURN
      ELSEIF ( GETPRM(ICODE,INEW,IPARM) ) THEN
        IDUP = IPARM
        PUTPRM = .FALSE.
        RETURN
      ELSE
        IDUP = 0
        IF (IPARM.GT.30) THEN
          PUTPRM = .FALSE.
          RETURN
        ELSE
          NPARMS = IPARM
          ICODES(NPARMS) = ICODE
          IOLDS(NPARMS) = IOLD
          INEWS(NPARMS) = INEW
          PUTPRM = .TRUE.
        ENDIF
      ENDIF

      RETURN
      END
      LOGICAL FUNCTION PUTZ (ISSN,LIST,IDUP)

*** ADD ENTRY TO TABLE
*** IDUP IS LOCATION OF DUPLICATE ENTRY IN LIST
*** IDUP = 0 INDICATES TABLE OVERFLOW

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL LOKZ
      COMMON /ROTTB1/ IZNS(4000)
      COMMON /ROTTB2/ LOOK(977),IPTRS(4000),NKEY,MAX,IFREE

      IZN = ISSN * 1000 + LIST
      IF ( LOKZ(IZN,ILOOK,IPTR) ) THEN

*** DUPLICATE ENTRY

        IDUP = IPTR
        PUTZ = .FALSE.
      ELSE
        IF (IFREE.GT.MAX) THEN

*** TABLE OVERFLOW

          IDUP = 0
          PUTZ = .FALSE.
        ELSE

*** PUT ENTRY IN TABLE
          IF (IPTR.EQ.0) THEN
            LOOK(ILOOK) = IFREE
          ELSE
            IPTRS(IPTR) = IFREE
          ENDIF
          IZNS(IFREE) = IZN
          IPTRS(IFREE) = 0
          IFREE = IFREE + 1
          PUTZ = .TRUE.
        ENDIF
      ENDIF

      RETURN
      END
      LOGICAL FUNCTION PUTIVF (ICODE,IOLD,INEW,LFIX,IDUP)

*** ADD ENTRY TO TABLE
*** IDUP IS LOCATION OF DUPLICATE ENTRY IN LIST
*** IDUP = 0 INDICATES EXCEEDED MAXIMUM LENGTH OF LIST

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL LFIX,LFIXS
      LOGICAL GETIVF
      COMMON /IVFTB1/ NIVFS,ICODES(30),IOLDS(30),INEWS(30),LFIXS(30)
      COMMON /NUMVFS/ NVFTOT,NVFREE

      IF ( GETIVF(ICODE,IOLD,IVF) ) THEN
        IDUP = IVF
        PUTIVF = .FALSE.
        RETURN
      ELSEIF ( GETIVF(ICODE,INEW,IVF) ) THEN
        IDUP = IVF
        PUTIVF = .FALSE.
        RETURN
      ELSE
        IDUP = 0
        IF (IVF.GT.30) THEN
          PUTIVF = .FALSE.
          RETURN
        ELSE
          NIVFS = IVF
          ICODES(NIVFS) = ICODE
          IOLDS(NIVFS) = IOLD
          INEWS(NIVFS) = INEW
          LFIXS(NIVFS) = LFIX
          NVFTOT = NVFTOT + 1
          IF (.NOT.LFIX) NVFREE = NVFREE + 1
          PUTIVF = .TRUE.
        ENDIF
      ENDIF

      RETURN
      END
      LOGICAL FUNCTION FIXVF (I)

*** RETURN TRUE IF FIXED VARIANCE FACTOR

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL LFIXS
      COMMON /IVFTB1/ NIVFS,ICODES(30),IOLDS(30),INEWS(30),LFIXS(30)
      COMMON /NUMVFS/ NVFTOT,NVFREE

      IF (I.LE.0 .OR. I.GT.NVFTOT) THEN
        WRITE (6,1) I,NVFTOT
    1   FORMAT ('0ERROR - ILLEGAL IVF=',I10,' FOR N=',I10,' IN FIXVF')
        CALL ABORT2
      ENDIF
      FIXVF = LFIXS(I)

      RETURN
      END
      LOGICAL FUNCTION LOKZ (IZN,ILOOK,IPTR)

*** TABLE LOOKUP & POINTER RETURN

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /ROTTB1/ IZNS(4000)
      COMMON /ROTTB2/ LOOK(977),IPTRS(4000),NKEY,MAX,IFREE

*** CHARACTER TYPE HASH FUNCTIONS

      KEY = MOD(IZN,NKEY) + 1

*** CHARACTER TYPE HASH FUNCTION

      ILOOK = LOOK(KEY)
      IF (ILOOK.EQ.0) THEN

*** IMMEDIATE FAILURE TO FIND ENTRY
        ILOOK = KEY
        IPTR = 0
        LOKZ = .FALSE.
      ELSE
        IPTR = ILOOK
        ILOOK = 0
 1      IF ( IZN.EQ.IZNS(IPTR) ) THEN

*** SUCCESSFUL LOCATION OF ENTRY AT IPTR

          LOKZ = .TRUE.
        ELSE
          IF ( IPTRS(IPTR).EQ.0 ) THEN

*** FAILURE TO FIND ENTRY

            LOKZ = .FALSE.
          ELSE

*** CHAIN TO NEXT LOCATION

            IPTR = IPTRS(IPTR)
            GO TO 1
          ENDIF
        ENDIF
      ENDIF

      RETURN
      END
      LOGICAL FUNCTION INVZ (IZ,ISSN,ILIST)

*** GIVEN THE ROTATION UNKNOWN NUMBER, RETURN STA NUM & LIST NUM

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /ROTTB1/ IZNS(4000)
      COMMON /ROTTB2/ LOOK(977),IPTRS(4000),NKEY,MAX,IFREE

      IF (IZ.LE.0 .OR. IZ.GE.IFREE) THEN
        INVZ = .FALSE.
      ELSE
        IZZZ = IZNS(IZ)
        ISSN = IZZZ / 1000
        ILIST = IZZZ - ISSN * 1000
        INVZ = .TRUE.
      ENDIF

      RETURN
      END
      SUBROUTINE GETDMS (VAL,ID,IM,S,ISIGN)

*** CONVERT RADIANS TO DEG, MIN, SEC

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI

      TOL = 0.000005D0
    1 IF (VAL.GT.PI) THEN
        VAL = VAL - TWOPI
        GO TO 1
      ENDIF

    2 IF (VAL.LT.-PI) THEN
        VAL = VAL + TWOPI
        GO TO 2
      ENDIF

      IF (VAL.LT.0.D0) THEN
        ISIGN = -1
      ELSE
        ISIGN = +1
      ENDIF

      S = DABS(VAL * RAD)
      ID = IDINT(S)
      S = (S - ID) * 60.D0
      IM = IDINT(S)
      S = (S - IM) * 60.D0

      IF(DABS(60.D0 - S) .LT. TOL) THEN
         S = 0.0D0
         IM = IM + 1
         IF(IM .EQ. 60) THEN
           IM = 0
           ID = ID + 1
         ENDIF
      ENDIF

      RETURN
      END
      SUBROUTINE DIRDMS (VAL,ID,IM,S)

*** CONVERT DIRECTION,ANGLE,AZIMUTH RADIANS TO DEG, MIN, SEC

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI

    1 IF (VAL.GT.TWOPI) THEN
        VAL = VAL - TWOPI
        GO TO 1
      ENDIF

    2 IF (VAL.LT.0.D0) THEN
        VAL = VAL + TWOPI
        GO TO 2
      ENDIF

      S = DABS(VAL * RAD)
      ID = IDINT(S)
      S = (S - ID) * 60.D0
      IM = IDINT(S)
      S = (S - IM) * 60.D0

      RETURN
      END
      SUBROUTINE VERDMS (VAL,ID,IM,S,ISIGN)

*** CONVERT ZENITH DISTANCE RADIANS TO DEG, MIN, SEC

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI

    1 IF (VAL.GT.PI) THEN
        VAL = VAL - TWOPI
        GO TO 1
      ENDIF

    2 IF (VAL.LT.-PI) THEN
        VAL = VAL + TWOPI
        GO TO 2
      ENDIF

      IF (VAL.LT.0.D0) THEN
        ISIGN = -1
      ELSE
        ISIGN = +1
      ENDIF

      S = DABS(VAL * RAD)
      ID = IDINT(S)
      S = (S - ID) * 60.D0
      IM = IDINT(S)
      S = (S - IM) * 60.D0

      RETURN
      END
      DOUBLE PRECISION FUNCTION DIVID (X,Y)

*** DIVIDE X BY Y -- ALLOW FOR Y = 0

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)

      IF (Y.EQ. 0.D0 ) THEN
        DIVID = 0.D0
      ELSE
        DIVID = X / Y
      ENDIF

      RETURN
      END
      DOUBLE PRECISION FUNCTION DIVIDE (X,N)

*** DIVIDE X BY N -- ALLOW FOR N = 0

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)

      IF (N.EQ.0) THEN
        DIVIDE = 0.D0
      ELSE
        DIVIDE = X / N
      ENDIF

      RETURN
      END
      SUBROUTINE RADCUR (GLAT,RMER,RPV)

*** COMPUTE RADII OF CURVATURE
*** SEE RAPP, GEOMETRIC GEOD. VOL I, P 19 AND 24

      IMPLICIT INTEGER (I-N)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      LOGICAL LMSL,LSS,LUP
      COMMON /OPT/ AX,E2,DMSL,DGH,VM,VP,CTOL,ITMAX,ITMIN,IMODE,
     &             LMSL,LSS,LUP

      SLAT = DSIN(GLAT)
      SLAT2 = SLAT * SLAT
      W = DSQRT(1.D0 - E2 * SLAT2)

*** RADIUS OF CURVATURE IN MERIDIAN

      RMER = AX * (1.D0 - E2) / (W * W * W)

*** RADIUS OF CURVATURE IN PRIME VERTICAL

      RPV = AX / W

      RETURN
      END
      SUBROUTINE GETRAD (ID,IM,IS,SIGN,VAL)

*** CONVERT DEG, MIN, SEC TO RADIANS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI

      S = DBLE(IS) / 1.D5

      VAL = (ID + IM / 60.D0 + S / 3600.D0) / RAD
      VAL = DSIGN(VAL,SIGN)

      RETURN
      END
      SUBROUTINE PUTALA (ALA,I,B)

*** ROUTINE TO INSERT ASTRO LAT INTO CONTROL POINT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON /SSNTBL/ NSSN,ISSISN(MXSSN)

      IF (I.LE.0 .OR. I.GT.NSSN) THEN
        WRITE (6,1) I,NSSN
    1   FORMAT ('0ERROR - ILLEGAL ISN',I5,' FOR NSSN=',I5,' IN PUTALA')
        CALL ABORT2
      ENDIF
      N = NCD + NAUX + NZ + (I - 1) * 6
      B(1+N) = ALA

      RETURN
      END
      SUBROUTINE PUTALO (ALO,I,B)

*** ROUTINE TO INSERT ASTRO LON INTO CONTROL POINT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON /SSNTBL/ NSSN,ISSISN(MXSSN)

      IF (I.LE.0 .OR. I.GT.NSSN) THEN
        WRITE (6,1) I,NSSN
    1   FORMAT ('0ERROR - ILLEGAL ISN',I5,' FOR NSSN=',I5,' IN PUTALO')
        CALL ABORT2
      ENDIF
      N =  NCD + NAUX + NZ + (I - 1) * 6
      B(2+N) = ALO

      RETURN
      END
      SUBROUTINE PUTGLA (GLA,I,B)

*** ROUTINE TO INSERT GEOD. LAT INTO CONTROL POINT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON / SSNTBL / NSSN,ISSISN(MXSSN)

      IF (I.LE.0 .OR. I.GT.NSSN) THEN
        WRITE (6,1) I,NSSN
    1   FORMAT ('0ERROR - ILLEGAL ISN',I5,' FOR NSSN=',I5,' IN PUTGLA')
        CALL ABORT2
      ENDIF
      N = NCD + NAUX + NZ + (I - 1) * 6
      B(3+N) = GLA

      RETURN
      END
      SUBROUTINE PUTGLO (GLO,I,B)

*** ROUTINE TO INSERT GEOD. LON INTO CONTROL POINT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON / SSNTBL / NSSN,ISSISN(MXSSN)

      IF (I.LE.0 .OR. I.GT.NSSN) THEN
        WRITE (6,1) I,NSSN
    1   FORMAT ('0ERROR - ILLEGAL ISN',I5,' FOR NSSN=',I5,' IN PUTGLO')
        CALL ABORT2
      ENDIF
      N = NCD + NAUX + NZ + (I - 1) * 6
      B(4+N) = GLO

      RETURN
      END
      SUBROUTINE PUTMSL (GMSL,I,B)

*** ROUTINE TO INSERT MSL INTO CONTROL POINT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON / SSNTBL / NSSN, ISSISN(MXSSN)

      IF (I.LE.0 .OR. I.GT.NSSN) THEN
        WRITE (6,1) I,NSSN
    1   FORMAT ('0ERROR - ILLEGAL ISN',I5,' FOR NSTA=',I5,' IN PUTMSL')
        CALL ABORT2
      ENDIF
      N = NCD + NAUX + NZ + (I - 1) * 6
      B(5+N) = GMSL

      RETURN
      END
      SUBROUTINE PUTGH (GH,I,B)

*** ROUTINE TO INSERT GEOID HT. INTO CONTROL POINT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON / SSNTBL / NSSN, ISSISN(MXSSN)

      IF (I.LE.0 .OR. I.GT.NSSN) THEN
        WRITE (6,1) I,NSSN
    1   FORMAT ('0ERROR - ILLEGAL ISN',I5,' FOR NSSN=',I5,' IN PUTGH ')
        CALL ABORT2
      ENDIF
      N = NCD + NAUX + NZ + (I - 1) * 6
      B(6+N) = GH

      RETURN
      END
      SUBROUTINE PUTAUX (AUX,I,B)

*** ROUTINE TO INSERT AUX. PARM. INTO CONTROL POINT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD

      IF (I.LE.0 .OR. I.GT.NAUX) THEN
        WRITE (6,1) I,NAUX
    1   FORMAT ('0ERROR - ILLEGAL IAUX',I5,' FOR NAUX=',I5,' IN PUTAUX')
        CALL ABORT2
      ENDIF

      B(I + NCD) = AUX

      RETURN
      END
      SUBROUTINE PUTROT (ROT,I,B)

*** ROUTINE TO INSERT ROTATION PARM INTO CONTROL PT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD

      IF (I.LE.0 .OR. I.GT.NZ) THEN
        WRITE (6,1) I,NZ
    1   FORMAT ('0ERROR - ILLEGAL IZ',I5,' FOR NZ=',I5,' IN PUTROT')
        CALL ABORT2
      ENDIF

      B(I+NCD+NAUX) = ROT

      RETURN
      END
      SUBROUTINE GETALA (ALA,I,B)

*** ROUTINE TO RETRIEVE ASTRO LAT FROM CONTROL POINT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON / SSNTBL / NSSN, ISSISN(MXSSN)

      IF (I.LE.0 .OR. I.GT.NSSN) THEN
        WRITE (6,1) I,NSSN
    1   FORMAT ('0ERROR - ILLEGAL ISN',I5,' FOR NSSN=',I5,' IN GETALA')
        CALL ABORT2
      ENDIF
      N = NCD + NAUX + NZ + (I - 1) * 6
      ALA = B(1+N)

      RETURN
      END
      SUBROUTINE GETALO (ALO,I,B)

*** ROUTINE TO RETRIEVE ASTRO LON FROM CONTROL POINT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON / SSNTBL / NSSN, ISSISN(MXSSN)

      IF (I.LE.0 .OR. I.GT.NSSN) THEN
        WRITE (6,1) I,NSSN
    1   FORMAT ('0ERROR - ILLEGAL ISN',I5,' FOR NSSN=',I5,' IN GETALO')
        CALL ABORT2
      ENDIF
      N = NCD + NAUX + NZ + (I - 1) * 6
      ALO = B(2+N)

      RETURN
      END
      SUBROUTINE GETGLA (GLA,I,B)

*** ROUTINE TO RETRIEVE GEOD. LAT FROM CONTROL POINT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON / SSNTBL / NSSN, ISSISN(MXSSN)

      IF (I.LE.0 .OR. I.GT.NSSN) THEN
        WRITE (6,1) I,NSSN
    1   FORMAT ('0ERROR - ILLEGAL ISN',I5,' FOR NSSN=',I5,' IN GETGLA')
        CALL ABORT2
      ENDIF
      N = NCD + NAUX + NZ + (I - 1) * 6
      GLA = B(3+N)

      RETURN
      END
      SUBROUTINE GETGLO (GLO,I,B)

*** ROUTINE TO RETRIEVE GEOD. LON FROM CONTROL POINT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON / SSNTBL / NSSN, ISSISN(MXSSN)

      IF (I.LE.0 .OR. I.GT.NSSN) THEN
        WRITE (6,1) I,NSSN
    1   FORMAT ('0ERROR - ILLEGAL ISN',I5,' FOR NSSN=',I5,' IN GETGLO')
        CALL ABORT2
      ENDIF
      N = NCD + NAUX + NZ + (I - 1) * 6
      GLO = B(4+N)

      RETURN
      END
      SUBROUTINE GETMSL (GMSL,I,B)

*** ROUTINE TO RETRIEVE MSL FROM CONTROL POINT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON / SSNTBL / NSSN, ISSISN(MXSSN)

      IF (I.LE.0 .OR. I.GT.NSSN) THEN
        WRITE (6,1) I,NSSN
    1   FORMAT ('0ERROR - ILLEGAL ISN',I5,' FOR NSSN=',I5,' IN GETMSL')
        CALL ABORT2
      ENDIF
      N = NCD + NAUX + NZ + (I - 1) * 6
      GMSL = B(5+N)

      RETURN
      END
      SUBROUTINE GETGH (GH,I,B)

*** ROUTINE TO RETRIEVE GEOID HT. FROM CONTROL POINT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON / SSNTBL / NSSN, ISSISN(MXSSN)

      IF (I.LE.0 .OR. I.GT.NSSN) THEN
        WRITE (6,1) I,NSSN
    1   FORMAT ('0ERROR - ILLEGAL ISN',I5,' FOR NSSN=',I5,' IN GETGH ')
        CALL ABORT2
      ENDIF
      N = NCD + NAUX + NZ + (I - 1) * 6
      GH = B(6+N)

      RETURN
      END
      SUBROUTINE GETAUX (AUX,I,B)

*** ROUTINE TO RETRIEVE AUX. PARM. FROM CONTROL POINT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD

      IF (I.LE.0 .OR. I.GT.NAUX) THEN
        WRITE (6,1) I,NAUX
    1   FORMAT ('0ERROR - ILLEGAL IAUX',I20,' FOR NAUX=',I5,
     &          ' IN GETAUX')
        CALL ABORT2
      ENDIF

      AUX = B(I+NCD)

      RETURN
      END
      SUBROUTINE GETROT (ROT,I,B)

*** ROUTINE TO RETRIEVE ROT. PARM. FROM CONTROL POINT DATA BLOCK

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      DIMENSION B(*)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD

      IF (I.LE.0 .OR. I.GT.NZ) THEN
        WRITE (6,1) I,NZ
    1   FORMAT ('0ERROR - ILLEGAL IZ',I20,' FOR NZ=',I5,' IN GETROT')
        CALL ABORT2
      ENDIF

      ROT = B(I+NCD+NAUX)

      RETURN
      END
      INTEGER FUNCTION IUNSTA (ISTA,I)

*** DETERMINE UNKNOWN NUMBER OF STATION COORDINATE

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD

*** STATIONS STORED THREEWISE--PHI,LAM,H IN GLOBAL GEOD.
*** STATIONS STORED AFTER AUXILIARY PARAMETERS

      IF ( ISTA.LE.0 .OR. ISTA.GT.NSTA .OR. I.LE.0 .OR. I.GT.3 ) THEN
        WRITE (6,1) ISTA,I,NSTA
    1   FORMAT ('0ERROR - ILLEGAL VALUES IN IUNSTA',3I5)
        CALL ABORT2
      ELSE
        IUNSTA = NCD + NAUX + NZ + 3 * (ISTA - 1) + I
      ENDIF

      RETURN
      END
      INTEGER FUNCTION IUNAUX (IAUX)

*** DETERMINE UNKNOWN NUMBER OF AUXILIARY PARAMETER

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD

*** PARAMETERS STORED AHEAD OF STATIONS

      IF (IAUX.LE.0 .OR. IAUX.GT.NAUX) THEN
        WRITE (6,1) IAUX,NAUX
    1   FORMAT ('0ERROR - ILLEGAL VALUES IN IUNAUX',2I5)
        CALL ABORT2
      ELSE
        IUNAUX = NCD + IAUX
      ENDIF

      RETURN
      END
      INTEGER FUNCTION IUNROT (IZ)

*** DETERMINE UNKNOWN NUMBER FOR ROTATION PARAMETER

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD

*** PARAMETER STORED AHEAD OF STATIONS

      IF (IZ.LE.0 .OR. IZ.GT.NZ) THEN
        WRITE (6,1) IZ,NZ
    1   FORMAT ('0ERROR - ILLEGAL VALUES IN IUNROT: IZ =',I5,'  NZ=',I5)
        CALL ABORT2
      ELSE
        IUNROT = NCD + NAUX + IZ
      ENDIF

      RETURN
      END
      SUBROUTINE INVIUN (IUNK,I,J,IUCODE)

*** GIVEN AN UNKNOWN INDEX NUMBER, GET STATION/PARM NUMBER

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD

***   INDICES STORED IN THE ORDER OF AUXILIARY INDICES, CRUSTAL DYNAMIC
***   INDICES, ROTATION INDICES, AND STATIONS INDICES

      N0 = 0
      N1 = NCD 
      N2 = N1 + NAUX           
      N3 = N2 + NZ
      N4 = N3 + 3 * NSTA

*** INDEX IS A STATION INDEX  (IUCODE = 0)

      IF (IUNK.GT.N3 .AND. IUNK.LE.N4) THEN
        I = (IUNK - N3 - 1) / 3
        J = IUNK - N3 - I * 3
        I = I + 1
        IUCODE = 0

*** INDEX IS AUXILIARY PARAMETER INDEX  (IUCODE = 1)

      ELSEIF (IUNK.GT.N1 .AND. IUNK.LE.N2) THEN
        I = IUNK - N1
        J = 0
        IUCODE = 1

*** INDEX IS CRUSTAL DYNAMICS PARAMETER INDEX(IUCODE = 2)

      ELSEIF (IUNK.GT.N0 .AND. IUNK.LE.N1) THEN
        I = IUNK - N0 
        ITEMP = (I - 1)/ 3            
        J = I - ITEMP*3             
        IUCODE = 2

*** INDEX IS ROTATION PARAMETER INDEX(IUCODE = 3)

      ELSEIF (IUNK.GT.N2 .AND. IUNK.LE.N3) THEN
        I = IUNK - N2
        J = 0
        IUCODE = 3

*** ILLEGAL INPUT

      ELSE
        WRITE (6,1) IUNK,NUNK,N1,N2,N3,N4
    1   FORMAT ('0ERROR - ILLEGAL VALUE IN INVIUN',6I5)
        CALL ABORT2
      ENDIF

      RETURN
      END
      INTEGER FUNCTION IUNSHF (ISTA,I)

*** DETERMINE SHIFT INDEX OF A STATION

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD

*** SHIFTS STORED THREEWISE--U,V,W IN LOCAL GEOD. HOR.

      IF ( ISTA.LE.0 .OR. ISTA.GT.NSTA .OR. I.LE.0 .OR. I.GT.3 ) THEN
        WRITE (6,1) ISTA,I,NSTA
    1   FORMAT ('0ERROR - ILLEGAL VALUES IN IUNSHF',3I5)
        CALL ABORT2
      ELSE
        IUNSHF = (ISTA - 1) * 3 + I
      ENDIF

      RETURN
      END
      SUBROUTINE GETGLB (DX,DY,DZ,RI,RJ,P1,Q1,R1,T1,P2,Q2,R2,T2,S)

*** RETRIEVE THE GLOBAL SYSTEM(P,Q,R,S,T)

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      DIMENSION RI(3,3),RJ(3,3)

      P1 = -( RI(1,1) * DX + RI(1,2) * DY + RI(1,3) * DZ )
      Q1 = -( RI(2,1) * DX + RI(2,2) * DY + RI(2,3) * DZ )
      R1 = DSQRT( P1 * P1 + Q1 * Q1 )
      T1 = -( RI(3,1) * DX + RI(3,2) * DY + RI(3,3) * DZ )

      P2 = +( RJ(1,1) * DX + RJ(1,2) * DY + RJ(1,3) * DZ )
      Q2 = +( RJ(2,1) * DX + RJ(2,2) * DY + RJ(2,3) * DZ )
      R2 = DSQRT( P2 * P2 + Q2 * Q2 )
      T2 = +( RJ(3,1) * DX + RJ(3,2) * DY + RJ(3,3) * DZ )

      S = DSQRT( DX * DX + DY * DY + DZ * DZ )

      RETURN
      END
      SUBROUTINE NBLANK (A,INUM,IBLK)

*** RETURN PRECISION OF NUMBER AND ZERO FILL

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*(*) A

      LENG = LEN(A)
      L1 = LENG - INUM + 1
      IBLK = 0
      DO 1 I = L1,LENG
        IF (A(I:I).EQ.' ') THEN
          IBLK = IBLK + 1
          A(I:I) = '0'
        ENDIF
    1 CONTINUE

      RETURN
      END
      SUBROUTINE ABORT2

*** PRINT MESSAGE OF FATAL TERMINATION

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)

      WRITE (6,1)
    1 FORMAT ('0')
      WRITE (6,2)
    2 FORMAT (1X,130('*') )
      WRITE (6,3)
    3 FORMAT (' ***** FATAL TERMINATION -- FATAL TERMINATION !!',/,
     &        ' ***** THIS DUMP IS INTENTIONAL !',/,
     &        ' ***** REFER TO PRIOR ERROR MESSAGES')
      WRITE (6,2)

      STOP 666
      END
      SUBROUTINE HEAD

*** GO TO A NEW PAGE AND PRINT A HEADING

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /PAGEIT/ MAXLIN,IPAGE,ILINE

      WRITE (6,1) IPAGE
    1 FORMAT ('1',T54,'NATIONAL GEODETIC SURVEY',/,
     &        ' PROGRAM DYNAP-G',T48,'DYNAMIC ADJUSTMENT PROGRAM',
     &        ' FOR GRIDS',
     &        T124,'PAGE',I4,/,
     &        T59,'VERSION   1.1   ',//)

      IPAGE = IPAGE + 1
      ILINE = 5

      RETURN
      END
      SUBROUTINE LINE (I)

*** MAINTAIN A LINE COUNT AND PERFORM PAGE INTERRUPTS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /PAGEIT/ MAXLIN,IPAGE,ILINE

      ILINE = ILINE + I
      IF (ILINE.GT.MAXLIN) THEN
        CALL HEAD
        ILINE = ILINE + I
      ENDIF

      RETURN
      END
      SUBROUTINE HEAD2

*** PRINT A HEADING AND SUBHEADING #2

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL LMSL,LSS,LUP
      COMMON /PAGEIT/ MAXLIN,IPAGE,ILINE
      COMMON /OPT/ AX,E2,DMSL,DGH,VM,VP,CTOL,ITMAX,ITMIN,IMODE,
     &             LMSL,LSS,LUP

      CALL HEAD

      IF (IMODE.EQ.0) THEN
        WRITE (6,1)
 1      FORMAT ('0SIMULATION',/,T18,'COMPUTED',T30,'MDE(3-SIGMA)',
     &          T50,'RN')
      ELSEIF (IMODE.EQ.3) THEN
        WRITE (6,2)
 2      FORMAT ('0NORMALIZED RESIDUALS',/,T18,'COMPUTED',T34,'OBSERVED',
     &          T46,'V=C-O',T55,'SDV',T67,'V/SDV',T76,'RN',T84,
     &          'FROM STATION',/,
     &          T86,'TO STATION(S)')
      ELSE
        WRITE (6,3)
 3      FORMAT ('0QUASI-NORMALIZED RESIDUALS',/,
     &   T18,'COMPUTED',T36,'OBSERVED',T48,'V=C-O',T56,'SD',T71,'V/SDV')
      ENDIF

      ILINE = 9

      RETURN
      END
      SUBROUTINE LINE2 (I)

*** MAINTAIN A LINE COUNT AND PERFORM PAGE INTERRUPTS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /PAGEIT/ MAXLIN,IPAGE,ILINE

      ILINE = ILINE + I
      IF (ILINE.GT.MAXLIN) THEN
        CALL HEAD2
        ILINE = ILINE + I
      ENDIF

      RETURN
      END
      SUBROUTINE HEAD3

*** PRINT A HEADING AND SUBHEADING #3

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /PAGEIT/ MAXLIN,IPAGE,ILINE

      CALL HEAD

      WRITE (6,1)
    1 FORMAT ('0ADJUSTED POSITIONS', //,
     +        8X, 'SSN', 1X, 'NAME', 29X, 'LATITUDE', 9X, 'LONGITUDE',
     +        10X, 'M.S.L.',  3X, 'G. HT.', 4X, 'E. HT.')

      ILINE = 10

      RETURN
      END
      SUBROUTINE LINE3 (I)

*** MAINTAIN A LINE COUNT AND PERFORM PAGE INTERRUPTS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /PAGEIT/ MAXLIN,IPAGE,ILINE

      ILINE = ILINE + I
      IF (ILINE.GT.MAXLIN) THEN
        CALL HEAD3
        ILINE = ILINE + I
      ENDIF

      RETURN
      END
      SUBROUTINE HEAD4

*** PRINT A HEADING AND SUBHEADING #4

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL LMSL,LSS,LUP
      COMMON /OPT/ AX,E2,DMSL,DGH,VM,VP,CTOL,ITMAX,ITMIN,IMODE,
     &             LMSL,LSS,LUP
      COMMON /PAGEIT/ MAXLIN,IPAGE,ILINE

      CALL HEAD

      IF (LSS) THEN
        WRITE (6,1)
    1   FORMAT ('0LENGTH RELATIVE ACCURACIES',
     &          3X,'(USING A-POSTERIORI WEIGHTS)')
      ELSE
        WRITE (6,2)
    2   FORMAT ('0LENGTH RELATIVE ACCURACIES',
     &          3X,'(USING A-PRIORI WEIGHTS)')
      ENDIF

      ILINE = 7

      RETURN
      END
      SUBROUTINE LINE4 (I)

*** MAINTAIN A LINE COUNT AND PERFORM PAGE INTERRUPTS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /PAGEIT/ MAXLIN,IPAGE,ILINE

      ILINE = ILINE + I
      IF (ILINE.GT.MAXLIN) THEN
        CALL HEAD4
        ILINE = ILINE + I
      ENDIF

      RETURN
      END
      SUBROUTINE HEAD5

*** PRINT A HEADING AND SUBHEADING #5

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /PAGEIT/ MAXLIN,IPAGE,ILINE

      CALL HEAD

      WRITE (6,1)
    1 FORMAT ('0ADJUSTED AUXILIARY PARAMETERS',//,T2,'NUM',T34,'VALUE')

      ILINE = 9

      RETURN
      END
      SUBROUTINE LINE5 (I)

*** MAINTAIN A LINE COUNT AND PERFORM PAGE INTERRUPTS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /PAGEIT/ MAXLIN,IPAGE,ILINE

      ILINE = ILINE + I
      IF (ILINE.GT.MAXLIN) THEN
        CALL HEAD5
        ILINE = ILINE + I
      ENDIF

      RETURN
      END
      SUBROUTINE HEAD6

*** PRINT A HEADING AND SUBHEADING #6

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /PAGEIT/ MAXLIN,IPAGE,ILINE

      CALL HEAD

      WRITE (6,1)
 1    FORMAT ('0*** OBSERVATIONAL SUMMARY ***',/,
     &        T4,'SSN',T10,'STATION',' NAME',T43,'DIR',T55,'ANG',
     &        T67,'AZI',T79,'DIS',T91,'ZD',T103,'GPS',T115,'CM',/,
     &        T41,'FRM   TO',T53,'FRM   TO', T65,'FRM   TO',
     &        T77,'FRM   TO',T89,'FRM   TO',T101,'FRM   TO',
     &        T113,'FRM   TO',/)

      ILINE = 10
      RETURN
      END
      SUBROUTINE LINE6 (I)

*** MAINTAIN A LINE COUNT AND PREFORM PAGE INTERUPTS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /PAGEIT/ MAXLIN,IPAGE,ILINE

      ILINE = ILINE + I
      IF (ILINE.GT.MAXLIN) THEN
        CALL HEAD6
        ILINE = ILINE + I
      ENDIF

      RETURN
      END
      SUBROUTINE HEAD7

*** PRINT A HEADING AND SUBHEADING #7

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL LMSL,LSS,LUP
      COMMON /PAGEIT/ MAXLIN,IPAGE,ILINE
      COMMON /OPT/ AX,E2,DMSL,DGH,VM,VP,CTOL,ITMAX,ITMIN,IMODE,
     &             LMSL,LSS,LUP

      CALL HEAD

      IF (IMODE.EQ.3) THEN
        WRITE (6,1)
 1      FORMAT ('0NORMALIZED RESIDUALS GROUPED AROUND INTERSECTION',
     &          ' STATIONS',/,T14,'COMPUTED',T31,'OBSERVED',T50,'V=C-O',
     &          T62,'V/SDV RN',/,T47,'SEC',T55,'METER')
      ELSE
        WRITE (6,2)
 2      FORMAT ('0QUASI-NORMALIZED RESIDUALS GROUPED AROUND',
     &          ' INTERSECTION STATIONS',/,
     &          T14,'COMPUTED',T33,'OBSERVED',T52,'V=C-O',T66,'V/SDO',/,
     &          T49,'SEC',T57,'METER')
      ENDIF

      ILINE = 8

      RETURN
      END
      SUBROUTINE LINE7 (I)

*** MAINTAIN A LINE COUNT AND PREFORM PAGE INTERRUPTS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /PAGEIT/ MAXLIN,IPAGE,ILINE

      ILINE = ILINE + I
      IF (ILINE.GT.MAXLIN) THEN
        CALL HEAD7
        ILINE = ILINE + I
      ENDIF

      RETURN
      END