SUBROUTINE FIRST (B)

*** ROUTINE FOR FIRST PASS OF BLUE-BOOK AND G-FILE
*** DETERMINE NUM OF STATIONS, PARAMETERS, AND PROBLEM STRUCTURE

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER ( NVECS = 16 )
      CHARACTER*80 CARD
      CHARACTER*2 BBID
      CHARACTER*1 CC1
      LOGICAL FATAL,LEX,HAVE91,GETSSN
      LOGICAL LDIR,LANG,LZEN,LDIS,LAZI,LGPS
      LOGICAL LBB,LGF,LCS,LVD,LVA,LVZ,LVS,
     &        LVR,LVG,LVC,LIS,LPS,LPG,LDR,LOS,LAP
      DIMENSION B(*)
      COMMON /BYPASS/ LDIR,LANG,LZEN,LDIS,LAZI,LGPS
      COMMON /FOURTH/ NFOT,NFOTS(700)
      COMMON /OPRINT/ CRIT,LBB,LGF,LCS,LVD,LVA,LVZ,LVS,
     &                LVR,LVG,LVC,LIS,LPS,LPG,LDR,LOS,LAP
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON /GPS/ MAXVEC

*** PROCESS BLUE BOOK

      IUNIT = 2
      OPEN (IUNIT,ERR=666,STATUS='OLD',FILE='BBOOK',BLANK='ZERO')
      CALL NEWSSN
      NSTA = 0
      FATAL = .FALSE.
      HAVE91 = .FALSE.
      CALL NEWZ
      NZ = 0
      CALL NEWFOT
      NFOT = 0

   10 READ (IUNIT,11,END = 100) CARD
   11 FORMAT (A80)
      BBID = CARD(8:9)

      IF (BBID.EQ.'80') THEN
        CALL FIR80 (CARD,B,FATAL)
        IF (HAVE91) THEN
          WRITE (6,12)
   12     FORMAT ('0FATAL ERROR - *80* RECORDS'
     &            '  MUST PRECEDE ALL *91* RECORDS')
          FATAL = .TRUE.
        ENDIF
      ELSEIF (BBID.EQ.'84') THEN
        CALL FIR84 (CARD,B)
      ELSEIF (BBID.EQ.'85') THEN
        CALL FIR85 (CARD,B)
      ELSEIF (BBID.EQ.'86') THEN
        CALL FIR86 (CARD,B)
C     ELSEIF (BBID.EQ.'89') THEN
C       CALL FIR89 (CARD,B)
      ELSEIF (BBID.EQ.'91') THEN
        CALL FIR91 (CARD,B,FATAL)
        HAVE91 = .TRUE.
      ELSEIF (BBID.EQ.'20') THEN
        IF (.NOT.LDIR) CALL FIR20 (CARD)
      ELSEIF (BBID.EQ.'22') THEN
        IF (.NOT.LDIR) CALL FIR22 (CARD,FATAL)
      ENDIF

      GO TO 10
  100 CLOSE (IUNIT)

*** ERROR CHECK

      IF (NSTA.LE.0) THEN
        WRITE (6,667)
  667   FORMAT ('0ERROR - NO *80* CONTROL POINT RECORDS ENCOUNTERED--',
     &          'FATAL')
        CALL ABORT2
      ENDIF
      IF (FATAL) THEN
        WRITE (6,668)
  668   FORMAT ('0FATAL ERROR FLAG DUE TO PREVIOUS ERRORS')
        CALL ABORT2
      ENDIF

*** PROCESS G-FILE

      MAXVEC = 0
      IF (.NOT.LGPS) THEN
        IGPS = 13
        INQUIRE(FILE='GFILE',EXIST=LEX,ERR=664,IOSTAT=IOS)
        IF (LEX) THEN
          OPEN (IGPS,ERR=664,IOSTAT=IOS,STATUS='OLD',FILE='GFILE')

*** READ THE MAX NUMBER OF GPS VECTORS IN A GROUP

   20     READ (IGPS,23,END=200) CARD
   23     FORMAT (A80)
          CC1 = CARD(1:1)
          IF (CC1.EQ.'B') THEN
            READ (CARD,21) MAX
   21       FORMAT (25X,I2)
            IF (MAX.GT.MAXVEC) MAXVEC = MAX
          ENDIF
          IF (CC1 .EQ. 'C' .OR. CC1 .EQ. 'F') THEN
            READ (CARD,24) ISSN,JSSN
   24       FORMAT (1X,I4,I4)
            IF (.NOT. GETSSN(ISSN,ISN)) THEN
              WRITE (6,25) ISSN
   25         FORMAT ('0FATAL ERROR - NO *80* RECORD FOR SSN =',I4)
              FATAL=.TRUE.
            ELSEIF (ISN .GT. NSTA) THEN
              WRITE (6,26) ISSN
   26         FORMAT ('FATAL ERROR - THE *91* RECORD FOR SSN = ',
     &                 I4,' NEEDS TO BE AN *80* RECORD')
              FATAL=.TRUE.
            ENDIF
            IF (.NOT. GETSSN(JSSN,JSN)) THEN
              WRITE (6,25) JSSN
              FATAL=.TRUE.
            ELSEIF (JSN .GT. NSTA) THEN
              WRITE (6,26) JSSN
              FATAL=.TRUE.
            ENDIF        
          ENDIF
          GO TO 20
  200     CLOSE (IGPS)

*** ERROR TEST ON MAXVEC

          IF ( MAXVEC.EQ.0 .OR. MAXVEC.GT.NVECS ) THEN
            WRITE (6,22) MAXVEC,NVECS+1
   22       FORMAT ('0ERROR - MAXVEC =',I2,' MAXIMUM GPS VECTORS MUST',
     &              /,' BE GREATER THAN ZERO AND LESS THAN',I2,'.')
            CALL ABORT2
          ENDIF
          IF (FATAL) THEN
            WRITE (6,668)
            CALL ABORT2
          ENDIF
        ENDIF
      ENDIF

*** CONVERT GLAT, GLON, ELLIP HT TO E.C.F. X,Y,Z

*     CALL ALLXYZ (B)
      RETURN

*** NO BLUE BOOK -- FATAL ERROR

  666 WRITE (6,669)
  669 FORMAT ('0NO BLUE BOOK FOUND--FATAL ERROR')
      CALL ABORT2
      RETURN

*** GFILE ERROR

  664 WRITE (6,665) IOS
  665 FORMAT ('0FORTRAN ERROR #',I4,' IN OPENING GFILE--FATAL ERROR')
      CALL ABORT2
      END
      SUBROUTINE FIR80 (CARD,B,FATAL)

*** FIRST ENCOUNTER OF CONTROL POINT RECORD

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      CHARACTER*80 CARD
      CHARACTER*30 NAME,NAMES
      CHARACTER*7 ASLA,ASLO
      CHARACTER*6 AGMSL
      CHARACTER*1 ADLA,ADLO,OT
      LOGICAL FATAL,PUTSSN
      LOGICAL LMSL,LSS,LUP
      LOGICAL INSIDE
      DIMENSION B(*)
      COMMON /FOURTH/ NFOT,NFOTS(700)
      COMMON /NAMTAB/ NAMES(MXSSN)
      COMMON /OPT/ AX,E2,DMSL,DGH,VM,VP,CTOL,ITMAX,ITMIN,IMODE,
     &             LMSL,LSS,LUP
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD

      READ (CARD,1) ISSN,NAME,IDLA,IMLA,ASLA,ADLA,
     &                        IDLO,IMLO,ASLO,ADLO,AGMSL,OT
    1 FORMAT (10X,I4,A30,2I2,A7,A1,
     &                 I3,I2,A7,A1,A6, 4X,A1)
      CALL NBLANK (AGMSL,2,IBLK)
      READ (AGMSL,6) GMSL
  6   FORMAT (F6.2)
      IF (CARD(70:75).EQ.'      ') GMSL = DMSL

      CALL NBLANK (ASLA,5,IBLK)
      CALL NBLANK (ASLO,5,IBLK)
      READ (ASLA,5) ISLA
      READ (ASLO,5) ISLO
    5 FORMAT (I7)

      IF ( .NOT.PUTSSN(ISSN,IDUP) ) THEN
        IF (IDUP.EQ.0) THEN
          CALL LINE (3)
          WRITE (6,2) ISSN
    2     FORMAT ('0',I5,' IS ILLEGAL SSN -- FATAL ERROR',/)
          FATAL = .TRUE.
        ELSE
          CALL LINE (3)
          WRITE (6,3) ISSN,IDUP
    3     FORMAT ('0',I5,' DUPLICATES THE ',I5,
     &            '-TH ENTRY -- FATAL ERROR',/)
          FATAL = .TRUE.
        ENDIF

      ELSE
        NSTA = NSTA + 1
        IF (OT.EQ.'4') THEN
          NFOT = NFOT + 1
          IF (NFOT.GT.700) THEN
            WRITE (6,4)
    4       FORMAT ('0ERROR - OVER 700 LANDMARKS')
            CALL ABORT2
          ENDIF
          NFOTS(NFOT) = NSTA
        ENDIF

*** LATITUDES ARE POSITIVE NORTH IN RADIANS
*** LONGITUDES ARE POSITIVE EAST IN RADIANS

        IF (ADLA.EQ.'S') THEN
          GLASGN = -1.D0
        ELSE
          GLASGN = 1.D0
        ENDIF
        IF (ADLO.EQ.'W') THEN
          GLOSGN = -1.D0
        ELSE
          GLOSGN = 1.D0
        ENDIF
        CALL GETRAD (IDLA,IMLA,ISLA,GLASGN,GLA)
        CALL GETRAD (IDLO,IMLO,ISLO,GLOSGN,GLO)

*** CHECK IF THE POSITIONAL COORDINATES ARE INSIDE THE GRID

        CALL GRDCHK (GLO,GLA,INSIDE)
        IF(.NOT. INSIDE) THEN
            WRITE(6,20) CARD
   20       FORMAT("0FATAL ERROR - POSITIONAL COORDINATES ON ",
     1             "*80* RECORD ARE OUTSIDE OF GRID"/1X,A80)
            FATAL = .TRUE.
        ENDIF

*** LOAD CONTROL POINT VALUES AND DEFAULTS

        CALL PUTALA (GLA,NSTA,B)
        CALL PUTALO (GLO,NSTA,B)
        CALL PUTGLA (GLA,NSTA,B)
        CALL PUTGLO (GLO,NSTA,B)
        CALL PUTMSL (GMSL,NSTA,B)
        CALL PUTGH (DGH,NSTA,B)
        NAMES(NSTA) = NAME
      ENDIF

      RETURN
      END
      SUBROUTINE FIR84 (CARD,B)

*** FIRST ENCOUNTER OF GEOID HEIGHT RECORD

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*80 CARD
      LOGICAL GETSSN
      LOGICAL LMSL,LSS,LUP
      DIMENSION B(*)
      COMMON /OPT/ AX,E2,DMSL,DGH,VM,VP,CTOL,ITMAX,ITMIN,IMODE,
     &             LMSL,LSS,LUP
      COMMON /STATCT/ N84,N85,N86,N89,NDIR,NANG,NGPS,NZD,NDS,NAZ,NQQ,
     &                NREJ,NGPSR

      READ (CARD,1) ISSN, GH
    1 FORMAT (10X, I4, 55X, F6.2)
      IF (CARD(72:76).EQ.'     ') GH = DGH

      IF ( GETSSN(ISSN,ISN) ) THEN
        CALL PUTGH (GH,ISN,B)
        N84 = N84 + 1
      ELSE
        CALL LINE (3)
        WRITE (6,2) CARD
    2   FORMAT ('0ERROR - NO *80* RECORD FOR --',A80,/)
      ENDIF

      RETURN
      END
      SUBROUTINE FIR85 (CARD,B)

*** FIRST ENCOUNTER OF DEFLECTION RECORD

*****************************************************************
*  CODE ASSUMES DATUM IS NAD 1983 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
******************************************************************

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      CHARACTER*80 CARD
      CHARACTER*5 AXI,AETA
      CHARACTER*1 ADXI,ADETA
      LOGICAL GETSSN
      LOGICAL ELFLAG,DFFLAG
      LOGICAL LMSL,LSS,LUP
      DIMENSION B(*)
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI
      COMMON /FLAGS/ ELFLAG(MXSSN),DFFLAG(MXSSN)
      COMMON /OPT/ AX,E2,DMSL,DGH,VM,VP,CTOL,ITMAX,ITMIN,IMODE,
     &             LMSL,LSS,LUP
      COMMON /STATCT/ N84,N85,N86,N89,NDIR,NANG,NGPS,NZD,NDS,NAZ,NQQ,
     &                NREJ,NGPSR

      READ (CARD,1) ISSN,AXI,ADXI,AETA,ADETA
    1 FORMAT (10X,I4,48X,A5,A1, 3X,A5,A1)

*** POS. MER. DEFL. -> ASTRO NORTH OF GEOD.
*** POS. PRIME V.   -> ASTRO EAST OF GEOD.
*** (NOTE: PRIME VERTICAL OPPOSITE SENSE OF DEFLECTION CHART)

      CALL NBLANK (AXI,2,IBLK)
      READ (AXI,5) XI
      CALL NBLANK (AETA,2,IBLK)
      READ (AETA,5) ETA
    5 FORMAT (F5.2)

      IF (ADXI.EQ.'S') XI = -XI
      IF (ADETA.EQ.'W') ETA = -ETA
      IF ( GETSSN(ISSN,ISN) ) THEN
        XI = XI / RADSEC
        ETA = ETA / RADSEC
        CALL GETGLA (GLAT,ISN,B)
        CALL GETGLO (GLON,ISN,B)

        ALAT = GLAT + XI
        ALON = GLON + ETA / DCOS(GLAT)

        CALL PUTALA (ALAT,ISN,B)
        CALL PUTALO (ALON,ISN,B)
        DFFLAG(ISN) = .TRUE.
        N85 = N85 + 1
      ELSE
        CALL LINE (3)
        WRITE (6,2) CARD
    2   FORMAT ('0ERROR - NO *80* RECORD FOR --',A80,/)
      ENDIF

      RETURN
      END
      SUBROUTINE FIR86 (BCARD, B)

*** FIRST ENCOUNTER OF CONTROL POINT RECORD

      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL GETSSN
      LOGICAL LSS, LUP, LMSL
      CHARACTER*80 BCARD
      DIMENSION B(*)
      COMMON /OPT/ AX,E2,DMSL,DGH,VM,VP,CTOL,ITMAX,ITMIN,IMODE,
     &             LMSL,LSS,LUP
      COMMON /STATCT/ N84,N85,N86,N89,NDIR,NANG,NGPS,NZD,NDS,NAZ,NQQ,
     &                NREJ,NGPSR

      READ (BCARD,1,ERR=666,IOSTAT=IOS) ISSN, GMSL, GH
    1 FORMAT (BZ, 10X, I4, 2X, F7.3, 12X, F7.3)

*** DEFAULTS

      IF (BCARD(17:23) .EQ. '      ') GMSL = DMSL
      IF (BCARD(35:41) .EQ. '      ')   GH = DGH

*** LOAD CONTROL POINT VALUES OR DEFAULTS

      IF ( GETSSN(ISSN, ISN) ) THEN
        CALL PUTMSL (GMSL, ISN, B)
        CALL PUTGH (GH, ISN, B)
        N86 = N86 + 1
      ELSE
        CALL LINE (3)
        WRITE (*,2) BCARD
    2   FORMAT ('0NO *80* RECORD FOR --', A80, /)
        GOTO 990
      ENDIF

  990 RETURN

  666 WRITE (6,667) IOS, BCARD
  667 FORMAT (//, ' FORTRAN ERROR #',  I5, ' IN SUBROUTINE FIR86 WHEN'
     &           ' READING THE FOLLOWING RECORD', A80)
      GOTO 990
      END
      SUBROUTINE FIR89 (CARD,B)

*** FIRST ENCOUNTER OF ASTRONOMIC STATION LOCATION RECORD

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      CHARACTER*80 CARD
      CHARACTER*7 ASLA,ASLO
      CHARACTER*1 ADLA,ADLO
      LOGICAL ELFLAG,DFFLAG
      LOGICAL GETSSN
      DIMENSION B(*)
      COMMON /FLAGS/ ELFLAG(MXSSN),DFFLAG(MXSSN)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON /STATCT/ N84,N85,N86,N89,NDIR,NANG,NGPS,NZD,NDS,NAZ,NQQ,
     &                NREJ,NGPSR

      READ (CARD,1) ISSN,IDLA,IMLA,ASLA,ADLA,
     &                   IDLO,IMLO,ASLO,ADLO
    1 FORMAT (10X,I4,30X,I2,I2,A7,A1,
     &                   I3,I2,A7,A1)

      CALL NBLANK (ASLA,5,IBLK)
      CALL NBLANK (ASLO,5,IBLK)
      READ (ASLA,5) ISLA
      READ (ASLO,5) ISLO
    5 FORMAT (I7)

      IF ( GETSSN(ISSN,ISN) ) THEN

*** LATITUDES ARE POSITIVE NORTH IN RADIANS
*** LONGITUDES ARE POSITIVE EAST IN RADIANS

        IF (ADLA.EQ.'S') THEN
          ALASGN = -1.D0
        ELSE
          ALASGN = 1.D0
        ENDIF
        IF (ADLO.EQ.'W') THEN
          ALOSGN = -1.D0
        ELSE
          ALOSGN = 1.D0
        ENDIF
        CALL GETRAD (IDLA,IMLA,ISLA,ALASGN,ALA)
        CALL GETRAD (IDLO,IMLO,ISLO,ALOSGN,ALO)

*** LOAD ASTRONOMIC LATITUDES AND LONGITUDES

        CALL PUTALA (ALA,ISN,B)
        CALL PUTALO (ALO,ISN,B)
        DFFLAG(ISN) = .TRUE.
        N89 = N89 + 1

      ELSE
        CALL LINE (3)
        WRITE (6,2) CARD
    2   FORMAT ('0ERROR - NO *80* RECORD FOR --',A80,/)
      ENDIF

      RETURN
      END
      SUBROUTINE FIR20 (CARD)

*** FIRST PASS OF DIRECTION SET RECORDS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*80 CARD
      LOGICAL DOIT,DUNIT
      COMMON /ZUNKS/ ISSN,LIST,DOIT,DUNIT

      DOIT = .FALSE.
      DUNIT = .FALSE.

      READ (CARD,1) ISSN,LIST
    1 FORMAT (10X,I4,    I2)

      IF ( CARD( 6: 6).EQ.'R' ) RETURN
      DOIT = .TRUE.

      RETURN
      END
      SUBROUTINE FIR22 (CARD,FATAL)

*** FIRST PASS OF DIRECTION RECORDS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*80 CARD
      LOGICAL FATAL,PUTZ,DOIT,DUNIT
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON /ZUNKS/ ISSN,LIST,DOIT,DUNIT

      IF ( CARD( 6: 6).EQ.'R' ) RETURN
      IF (DUNIT) RETURN

      IF (.NOT.DOIT) THEN
        DOIT = .TRUE.
      ELSE
        DUNIT = .TRUE.
        IF ( .NOT.PUTZ(ISSN,LIST,IDUP) ) THEN
          IF (IDUP.EQ.0) THEN
            CALL LINE (3)
            WRITE (6,666) CARD,ISSN
 666        FORMAT ('0',A80,I5.3,' IS ILLEGAL SSN -- FATAL ERROR',/)
            FATAL = .TRUE.
          ELSE
            CALL LINE (3)
            WRITE (6,667) CARD,ISSN,IDUP
 667        FORMAT ('0',A80,I5.3,' DUPLICATES THE',I5,
     &              '-TH ENTRY -- FATAL ERROR',/)
            FATAL = .TRUE.
          ENDIF
        ELSE
          NZ = NZ + 1
        ENDIF
      ENDIF

      RETURN
      END