      SUBROUTINE SECBB (IUNIT,IUO,IOBS,B,NX,FATAL)

*** FORM OBS EQ. FOR NON-GPS BB RECORDS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*80 CARD
      CHARACTER*2 IRT
      LOGICAL LDIR,LANG,LZEN,LDIS,LAZI,LGPS
      LOGICAL LBB,LGF,LCS,LVD,LVA,LVZ,LVS,
     &        LVR,LVG,LVC,LIS,LPS,LPG,LDR,LOS,LAP
      LOGICAL FATAL,LSN
      DIMENSION B(*),NX(*)
      COMMON /OPRINT/ CRIT,LBB,LGF,LCS,LVD,LVA,LVZ,LVS,
     &                LVR,LVG,LVC,LIS,LPS,LPG,LDR,LOS,LAP
      COMMON /BYPASS/ LDIR,LANG,LZEN,LDIS,LAZI,LGPS

*** PRINT HEADING, THEN PROCESS BBOOK

      IF (LBB) THEN
        CALL HEAD
        CALL LINE (4)
        WRITE (6,3)
  3     FORMAT (' ************ BLUE BOOK ************',/,
     &          '0 OBS #',/)
      ENDIF

*** LOOP OVER RECORDS OF BLUE BOOK

  100 READ (IUNIT,2,END = 777) CARD
  2   FORMAT (A80)
      IRT = CARD(8:9)

      LSN = .FALSE.

      IF (IRT.EQ.'20' .OR. IRT.EQ.'22') THEN
          IF (.NOT.LDIR) CALL HORDIR (CARD,IUO,IOBS,B,NX,FATAL,LSN)
        ELSEIF (IRT.EQ.'30' .OR. IRT.EQ.'32') THEN
          IF (.NOT.LANG) CALL HORANG (CARD,IUO,IOBS,B,NX,FATAL,LSN)
        ELSEIF (IRT.EQ.'40' .OR. IRT.EQ.'42') THEN
          IF (.NOT.LZEN) CALL VERTAN (CARD,IUO,IOBS,B,NX,FATAL,LSN)
        ELSEIF (IRT.EQ.'52' .OR. IRT.EQ.'54') THEN
          IF (.NOT.LDIS) CALL DISTOB (CARD,IUO,IOBS,B,NX,FATAL,LSN)
        ELSEIF (IRT.EQ.'60') THEN
          IF (.NOT.LAZI) CALL ASTRAZ (CARD,IUO,IOBS,B,NX,FATAL,LSN)
      ENDIF

*** ECHO THE BLUE BOOK OBSERVATIONS

      IF (LBB) CALL ECHOBB (CARD,IOBS,LSN)
      GO TO 100

*** END OF PROCESSING -- END OF FILE ENCOUNTERED ***

  777 IF (LBB) THEN
        CALL LINE (2)
        WRITE (6,4)
  4     FORMAT (' ******** END OF BLUE BOOK ********')
      ENDIF

      RETURN
      END
      SUBROUTINE ECHOBB (CARD,IOBS,LSN)

*** ECHO THE BLUE BOOK RECORDS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*80 CARD
      LOGICAL LSN,LBV
      LOGICAL LEB,LLB,LEG,LLG
      COMMON /PECHO/ LEB,LLB,LEG,LLG
      COMMON /ECHO/ VSD,LBV

*** ECHO ALL OF THE BLUE BOOK

      IF (.NOT.LEB) THEN
        IF (.NOT.LLB) THEN
          IF (LSN) THEN
            IF (CARD(6:6).NE.'R') THEN
              IF (LBV) THEN
                CALL LINE (1)
                WRITE (6,1) IOBS,CARD,VSD
    1           FORMAT (1X,I6,3X,A80,F10.1,
     &                  '  *** WARNING - LARGE MISCLOSURE')
              ELSE
                CALL LINE (1)
                WRITE (6,3) IOBS,CARD
    3           FORMAT (1X,I6,3X,A80)
              ENDIF
            ELSE
              CALL LINE (1)
              WRITE (6,2) CARD
            ENDIF
          ELSE
            CALL LINE (1)
            WRITE (6,2) CARD
    2      FORMAT (10X,A80)
          ENDIF
        ENDIF
      ENDIF

*** ECHO OBSERVATIONS ONLY

      IF (LEB) THEN
        IF (LSN) THEN
          IF (CARD(6:6).NE.'R') THEN
            IF (LBV) THEN
              CALL LINE (1)
              WRITE (6,1) IOBS,CARD,VSD
            ELSE
              CALL LINE (1)
              WRITE (6,3) IOBS,CARD
            ENDIF
          ENDIF
        ENDIF
      ENDIF

*** ECHO LARGE MISCLOSURES ONLY

      IF (LLB) THEN
        IF (LSN) THEN
          IF (CARD(6:6).NE.'R') THEN
            IF (LBV) THEN
              CALL LINE (1)
              WRITE (6,1) IOBS,CARD,VSD
            ENDIF
          ENDIF
        ENDIF
      ENDIF

      RETURN
      END
      SUBROUTINE HORDIR (CARD,IUO,IOBS,B,NX,FATAL,LSN)

*** OBSERVATION EQUATIONS FOR HORIZONTAL DIRECTIONS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*80 CARD
      CHARACTER*13 DATE
      CHARACTER*4 ASS
      LOGICAL FATAL,LSN
      LOGICAL GETSSN,GETZ,GETIVF
      LOGICAL ADDCON
      LOGICAL LMSL,LSS,LUP
      DIMENSION IC(31),C(31)
      DIMENSION B(*),NX(*)
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI
      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
      COMMON /IZS/ IZ2
      COMMON /STATCT/ N84,N85,N86,N89,NDIR,NANG,NGPS,NZD,NDS,NAZ,NQQ,
     &                NREJ,NGPSR
      SAVE ITIME

      READ (CARD,1) IRT,ISSN,LIST,JSSN,ID,IM,ASS
    1 FORMAT (7X,I2, 1X,I4,    I2,34X,I4, 9X,I3,I2,A4)
      CALL NBLANK (ASS,4,IBLK)
      READ (ASS,3) SS
 3    FORMAT (F4.2)
      IF (IRT.EQ.20) THEN
        DATE = CARD(38:50)
        CALL TRNDAT(DATE,ITIME)
      ENDIF
      IF (CARD(6:6).EQ.'O') NREJ = NREJ + 1

      IF ( CARD( 6: 6).NE.'O' ) THEN
        IF ( .NOT.GETSSN(ISSN,ISN) ) THEN
          CALL LINE (3)
          WRITE (6,2) CARD
 2        FORMAT ('0ERROR - NO *80* RECORD FOR--',A80,/)
        ELSEIF ( .NOT.GETSSN(JSSN,JSN) ) THEN
          CALL LINE (3)
          WRITE (6,2) CARD
        ELSE

*** RETRIEVE THE STD DEV

          CALL STDDEV (CARD,IRT,SD)

*** KIND = 11 HORIZONTAL DIRECTION

          IF ( .NOT.GETZ(ISSN,LIST,IZ) ) RETURN
          OBSB = (ID + IM / 60.D0 + SS / 3600.D0) / RAD
          IF (IZ.NE.IZ2) CALL STOREZ (ISN,JSN,B,IZ,OBSB,ITIME)
          KIND = 11
          IOBS = IOBS + 1
          NOBS = NOBS + 1
          NDIR = NDIR + 1
          LSN = .TRUE.
          IF ( .NOT.GETIVF(20,ITIME,IVF) ) IVF = 0
          CALL FORMIC (KIND,ISN,JSN,IZ,IC,LENG,B)
          CALL FORMC (KIND,C,B,ISN,JSN,IZ,ITIME)
          CALL COMPIC (IC,C,LENG)
          CALL COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,IZ,ITIME)
          CMO = OBS0 - OBSB
          IF (CMO.GT.PI) THEN
            CMO = CMO - TWOPI
          ELSEIF (CMO.LT.-PI) THEN
            CMO = CMO + TWOPI
          ENDIF
          IF (IMODE.EQ.0) CMO = 0.D0
          CALL BIGV (KIND,ISN,JSN,IOBS,IVF,CMO,SD,FATAL)

*** UPDATE CONNECTIVITY

          IF ( .NOT.ADDCON(IC,LENG,NX) ) THEN
            WRITE (6,667)
 667        FORMAT ('0ERROR - INSUFFICIENT STORAGE FOR HORIZONTAL',
     &              ' DIRECTIONS',/)
            CALL ABORT2
          ENDIF

          WRITE (IUO) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &                IOBS,IVF,IZ,ITIME

        ENDIF
      ENDIF

      RETURN
      END
      SUBROUTINE STOREZ (ISN,JSN,B,IZ,OBSB,ITIME)

*** STORE THE ROTATION PARM

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

      KIND = 8
      CALL COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,IAUX,ITIME)
      ROT = OBS0 - OBSB
 1    IF (ROT.GE.TWOPI) THEN
        ROT = ROT - TWOPI
        GO TO 1
      ENDIF
 2    IF (ROT.LT.0.D0) THEN
        ROT = ROT + TWOPI
        GO TO 2
      ENDIF
      CALL PUTROT (ROT,IZ,B)
      IZ2 = IZ

      RETURN
      END
      SUBROUTINE HORANG (CARD,IUO,IOBS,B,NX,FATAL,LSN)

*** OBSERVATION EQUATIONS FOR HORIZONTAL ANGLES

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*80 CARD
      CHARACTER*13 DATE
      CHARACTER*3 ASS
      LOGICAL LMSL,LSS,LUP
      LOGICAL GETSSN,ADDCON,GETIVF
      LOGICAL FATAL,LSN
      DIMENSION IC(31),C(31)
      DIMENSION B(*),NX(*)
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI
      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
      COMMON /STATCT/ N84,N85,N86,N89,NDIR,NANG,NGPS,NZD,NDS,NAZ,NQQ,
     &                NREJ,NGPSR
      SAVE ITIME

      READ (CARD,1) IRT,ISSN,JSSN,ID,IM,ASS,KSSN
    1 FORMAT (7X,I2, 1X,I4,36X,I4, 9X,I3,I2,A3,I4)
      CALL NBLANK (ASS,3,IBLK)
      READ (ASS,3) SS
 3    FORMAT (F3.1)
      IF (IRT.EQ.30) THEN
        DATE = CARD(38:50)
        CALL TRNDAT(DATE, ITIME)
      ENDIF
      IF (CARD(6:6).EQ.'O') NREJ = NREJ + 1

      IF ( CARD(6:6).NE.'O' )  THEN
        IF ( .NOT.GETSSN(ISSN,ISN) ) THEN
          CALL LINE (3)
          WRITE (6,2) CARD
 2        FORMAT ('0ERROR - NO *80* RECORD FOR--',A80,/)
        ELSEIF ( .NOT.GETSSN(JSSN,JSN) ) THEN
          CALL LINE (3)
          WRITE (6,2) CARD
        ELSEIF ( .NOT.GETSSN(KSSN,KSN) ) THEN
          CALL LINE (3)
          WRITE (6,2) CARD
        ELSE

*** RETRIEVE THE STD DEV

          CALL STDDEV (CARD,IRT,SD)

*** KIND = 10 HORIZONTAL ANGLES

          KIND = 10
          IOBS = IOBS + 1
          NOBS = NOBS + 1
          NANG = NANG + 1
          LSN = .TRUE.
          OBSB = (ID + IM / 60.D0 + SS / 3600.D0) / RAD
          IF ( .NOT.GETIVF(30,ITIME,IVF) ) IVF = 0
          CALL FORMIC (KIND,ISN,JSN,KSN,IC,LENG,B)
          CALL FORMC (KIND,C,B,ISN,JSN,KSN,ITIME)
          CALL COMPIC(IC,C,LENG)
          CALL COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,KSN,ITIME)
          CMO = OBS0 - OBSB
          IF (CMO.GT.PI) THEN
            CMO = CMO - TWOPI
          ELSEIF (CMO.LT.-PI) THEN
            CMO = CMO + TWOPI
          ENDIF
          IF (IMODE.EQ.0) CMO = 0.D0
          CALL BIGV (KIND,ISN,JSN,IOBS,IVF,CMO,SD,FATAL)

*** UPDATE CONNECTIVITY

          IF ( .NOT.ADDCON(IC,LENG,NX) ) THEN
            WRITE (6,667)
 667        FORMAT ('0ERROR - INSUFFICIENT STORAGE FOR HORIZONTAL',
     &              ' ANGLES',/)
            CALL ABORT2
          ENDIF

          WRITE (IUO) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &                IOBS,IVF,KSN,ITIME

        ENDIF
      ENDIF

      RETURN
      END
      SUBROUTINE VERTAN (CARD,IUO,IOBS,B,NX,FATAL,LSN)

*** OBSERVATION EQUATIONS FOR ZENITH DISTANCES

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*80 CARD
      CHARACTER*13 DATE
      CHARACTER*3 ASS
      LOGICAL FATAL,LSN
      LOGICAL GETSSN,GETPRM,GETIVF
      LOGICAL ADDCON
      LOGICAL LMSL,LSS,LUP
      DIMENSION B(*),NX(*)
      DIMENSION IC(31),C(31)
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI
      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
      COMMON /STATCT/ N84,N85,N86,N89,NDIR,NANG,NGPS,NZD,NDS,NAZ,NQQ,
     &                NREJ,NGPSR
      SAVE DATE       

      READ (CARD,1) IRT,ISSN,JSSN,ID,IM,ASS
    1 FORMAT (7X,I2, 1X,I4,36X,I4, 9X,I3,I2,A3)
      CALL NBLANK (ASS,3,IBLK)
      READ (ASS,3) SS
 3    FORMAT (F3.1)

      IF (IRT.EQ.40) THEN
        DATE = CARD(38:50)
      ELSE
        DATE(9:13) = CARD(46:50)
      ENDIF
      CALL TRNDAT(DATE, ITIME)
      IF (CARD(6:6).EQ.'O') NREJ = NREJ + 1

      IF ( CARD( 6: 6).NE.'O' ) THEN
        IF ( .NOT.GETSSN(ISSN,ISN) ) THEN
          CALL LINE (3)
          WRITE (6,2) CARD
 2        FORMAT ('0ERROR - NO *80* RECORD FOR--',A80,/)
        ELSEIF ( .NOT.GETSSN(JSSN,JSN) ) THEN
          CALL LINE (3)
          WRITE (6,2) CARD
        ELSE

*** RETRIEVE THE STD DEV

          CALL STDDEV (CARD,IRT,SD)

*** KIND = 9 ZENITH DISTANCE

          KIND = 9
          IOBS = IOBS + 1
          NOBS = NOBS + 1
          NZD = NZD + 1
          LSN = .TRUE.
          OBSB = (ID + IM / 60.D0 + SS / 3600.D0) / RAD
          IF ( .NOT.GETPRM(40,ITIME,IAUX) ) IAUX = 0
          IF ( .NOT.GETIVF(40,ITIME,IVF) ) IVF = 0
          CALL FORMIC (KIND,ISN,JSN,IAUX,IC,LENG,B)
          CALL FORMC (KIND,C,B,ISN,JSN,IAUX,ITIME)
          CALL COMPIC (IC,C,LENG)
          CALL COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,IAUX,ITIME)
          CMO = OBS0 - OBSB
          IF (IMODE.EQ.0) CMO = 0.D0
          CALL BIGV (KIND,ISN,JSN,IOBS,IVF,CMO,SD,FATAL)

*** UPDATE CONNECTIVITY

          IF ( .NOT.ADDCON(IC,LENG,NX) ) THEN
            WRITE (6,667)
 667        FORMAT ('0ERROR - INSUFFICIENT STORAGE FOR ZENITH',
     &              ' DISTANCES',/)
            CALL ABORT2
          ENDIF

          WRITE (IUO) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &                IOBS,IVF,IAUX,ITIME

        ENDIF
      ENDIF

      RETURN
      END
      SUBROUTINE ASTRAZ (CARD,IUO,IOBS,B,NX,FATAL,LSN)

*** OBSERVATION EQUATIONS FOR ASTRONOMIC AZIMUTHS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*80 CARD
      CHARACTER*13 DATE
      CHARACTER*3 ASS
      CHARACTER*4 PVC
      LOGICAL FATAL,LSN
      LOGICAL GETSSN,GETIVF
      LOGICAL ADDCON
      LOGICAL LMSL,LSS,LUP
      DIMENSION IC(31),C(31)
      DIMENSION B(*),NX(*)
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI
      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
      COMMON /STATCT/ N84,N85,N86,N89,NDIR,NANG,NGPS,NZD,NDS,NAZ,NQQ,
     &                NREJ,NGPSR

      READ (CARD,1) IRT,ISSN,PVC,AC,JSSN,ID,IM,ASS
 1    FORMAT (7X,I2,1X,I4,A4,A1,31X,I4,9X,I3,I2,A3)
      CALL NBLANK (ASS,3,IBLK)
      READ (ASS,3) SS
 3    FORMAT (F3.1)
      CALL NBLANK (PVC,3,IBLK)
      READ (PVC,4) ETA
 4    FORMAT (F4.1)
      IF (CARD(19:19).EQ.'W') ETA = -ETA

      DATE = CARD(38:50)
      CALL TRNDAT(DATE, ITIME)
      IF (CARD(6:6).EQ.'O') NREJ = NREJ + 1

*** CHECK IF AZIMUTH ORIGIN IS NORTH OR SOUTH

      IF (CARD(72:72).EQ.'S') THEN
        IF (ID.GE.0 .AND. ID.LE.179) THEN
          ID=ID + 180
        ELSEIF (ID.GE.180 .AND. ID.LE.359) THEN
          ID = ID - 180
        ELSE
          WRITE (6,666) ID
 666      FORMAT ('0ERROR - ILLEGAL AZIMUTH DEGREES  = ',I4)
          CALL ABORT2
        ENDIF
      ENDIF

      IF (CARD( 6: 6).NE.'O' ) THEN
        IF ( .NOT.GETSSN(ISSN,ISN) ) THEN
          CALL LINE (3)
          WRITE (6,2) CARD
 2        FORMAT ('0ERROR - NO *80* RECORD FOR--',A80,/)
        ELSEIF ( .NOT.GETSSN(JSSN,JSN) ) THEN
          CALL LINE (3)
          WRITE (6,2) CARD
        ELSE

*** RETRIEVE THE STD DEV

          CALL STDDEV (CARD,IRT,SD)

*** KIND = 8  ASTRONOMIC AZIMUTH

          KIND = 8
          IOBS = IOBS + 1
          NOBS = NOBS + 1
          NAZ = NAZ + 1
          LSN = .TRUE.
          OBSB = (ID + IM / 60.D0 + SS / 3600.D0) / RAD

*** CHANGE TO ASTRO AZ IF OBS IS LAPLACE AZIMUTH

          IF (AC .NE. 'A'  .AND.  CARD(15:19) .NE. '     ') THEN
            CALL GETGLA (GLA, ISN, B)
            OBSB = OBSB + DTAN(GLA)*( ETA/(3600.D0*RAD) )
          ENDIF
          IF (OBSB.LT.0.D0) OBSB = OBSB + TWOPI
          IF (OBSB.GE.TWOPI) OBSB = OBSB - TWOPI
          IF ( .NOT.GETIVF(60,ITIME,IVF) ) IVF = 0
          CALL FORMIC (KIND,ISN,JSN,IDUMMY,IC,LENG,B)
          CALL FORMC (KIND,C,B,ISN,JSN,IDUMMY,ITIME)
          CALL COMPIC (IC,C,LENG)
          CALL COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,IDUMMY,ITIME)
          CMO = OBS0 - OBSB
          IF (CMO.GT.PI) THEN
            CMO = CMO - TWOPI
          ELSEIF (CMO.LT.-PI) THEN
            CMO = CMO + TWOPI
          ENDIF
          IF (IMODE.EQ.0) CMO = 0.D0
          CALL BIGV (KIND,ISN,JSN,IOBS,IVF,CMO,SD,FATAL)

*** UPDATE CONNECTIVITY

          IF ( .NOT.ADDCON(IC,LENG,NX) ) THEN
            WRITE (6,667)
 667        FORMAT ('0ERROR - INSUFFICIENT STORAGE FOR LAPLACE',
     &              ' AZIMUTHS',/)
            CALL ABORT2
          ENDIF

          WRITE (IUO) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &                IOBS,IVF,IAUX,ITIME

        ENDIF
      ENDIF

      RETURN
      END
      SUBROUTINE STDDEV (CARD,IRT,SD)

*** DETERMINE THE STD DEV OF A OBSERVATION

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*3 AM,AMM
      CHARACTER*4 ASS
      CHARACTER*80 CARD
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI
      COMMON /VF/ VFACTR(31)

*** NOT FULLY IMPLEMENTED YET
*** STANDARD DEVIATIONS FOR DIRECTIONS, AZIMUTHS AND ZEN. DIST.

      IF ( IRT.EQ.20 .OR. IRT.EQ.22 .OR.
     &     IRT.EQ.40 .OR. IRT.EQ.42 .OR. IRT.EQ.60 ) THEN
        IF (CARD(77:80).NE.'    ') THEN
          READ (CARD,1) ASS
  1       FORMAT (76X,A4)
          CALL NBLANK (ASS,4,IBLK)
          READ (ASS,2) SD
  2       FORMAT (F4.2)
          SD = SD / RADSEC
        ELSE
          SD = 1.D0 / RADSEC
        ENDIF
        IF(IRT.EQ.20 .OR. IRT.EQ.22) THEN
          SD = SD * DSQRT(VFACTR(11))
        ELSEIF (IRT.EQ.40 .OR. IRT.EQ.42) THEN
          SD = SD * DSQRT(VFACTR(9))
        ELSEIF (IRT.EQ.60) THEN
          SD = SD * DSQRT(VFACTR(8))
        ENDIF

*** STD DEV FOR REDUCED DISTANCES

      ELSEIF (IRT.EQ.52) THEN
        IF (CARD(77:80).NE.'   ') THEN
          READ (CARD,3) ASS
  3       FORMAT (76X,A4)
          CALL NBLANK (ASS,4,IBLK)
          READ (ASS,4) SD
  4       FORMAT (F4.1)
          SD = SD / 1000.D0
        ELSE
          SD = 0.01D0
        ENDIF
        SD = SD * DSQRT(VFACTR(7))

*** STD DEV FOR REDUCED LONG DISTANCES

      ELSEIF (IRT.EQ.54) THEN
        IF (CARD(78:80).NE.'   ') THEN
          READ (CARD,5) AM
  5       FORMAT (77X,A3)
          CALL NBLANK (AM,3,IBLK)
          READ (AM,6) SD
  6       FORMAT (F3.2)
        ELSE
          SD = 0.1D0
        ENDIF
        SD = SD * DSQRT(VFACTR(7))

*** STD DEV FOR HORIZONTAL ANGLES

      ELSEIF (IRT.EQ.30 .OR. IRT.EQ.32) THEN
        READ (CARD,7) AMM
 7      FORMAT (68X,A3)
        CALL NBLANK (AMM,3,IBLK)
        IF (IBLK.EQ.3) THEN
          SD = 60.D0 / RADSEC
        ELSEIF (IBLK.EQ.2) THEN
          SD = 10.D0 / RADSEC
        ELSE
          SD = 1.D0 / RADSEC
        ENDIF
        SD = SD * DSQRT(VFACTR(10))
  
      ENDIF
      RETURN
      END
      SUBROUTINE FORMOB (IUO,IUO2,B,G)

*** REFORM OBS EQUATIONS USING MOST RECENT PARAMETERS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL LMSL,LSS,LUP
      LOGICAL FATAL
      DIMENSION B(*),G(*)
      DIMENSION IC(31),C(31)
      DIMENSION R1(3,3), R2(3,3)
      DIMENSION WEI1(2,2), VEL1(2,2,3)
      DIMENSION WEI2(2,2), VEL2(2,2,3)
      DIMENSION WEI(2,2), VEL(2,2,3)
      DIMENSION LSTA(2)
      COMMON /OPT/ AX,E2,DMSL,DGH,VM,VP,CTOL,ITMAX,ITMIN,IMODE,
     &             LMSL,LSS,LUP
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI

*** LOOP OVER THE OBSERVATIONS

      FATAL = .FALSE.
      REWIND IUO
      REWIND IUO2

  100 READ (IUO,END = 777) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &                     IOBS,IVF,IAUX,ITIME
      IF (KIND.LE.18) THEN
        CALL FORMIC (KIND,ISN,JSN,IAUX,IC,LENG,B)
        CALL FORMC (KIND,C,B,ISN,JSN,IAUX,ITIME)
        CALL COMPIC (IC,C,LENG)
        CALL COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,IAUX,ITIME)
        IF (KIND.EQ.1 .OR. KIND.EQ.2) THEN
          CMO = ( OBS0 - OBSB ) * RADSEC
        ELSE
          CMO = OBS0 - OBSB
        ENDIF
        IF ( KIND.EQ. 8 .OR. KIND.EQ.10 .OR.
     &       KIND.EQ.11 .OR. KIND.EQ.12 .OR. KIND.EQ.20 ) THEN
          IF (CMO.GT.PI) THEN
            CMO = CMO - TWOPI
          ELSEIF (CMO.LT.-PI) THEN
            CMO = CMO + TWOPI
          ENDIF
        ENDIF
        CALL BIGL (KIND,ISN,JSN,IOBS,IVF,CMO,SD,FATAL)
        WRITE (IUO2) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &               IOBS,IVF,IAUX,ITIME
      ELSEIF (KIND .EQ. 19 .OR. KIND .EQ. 20 .OR. KIND .EQ. 21) THEN
        GLAT  = C(5)
        GLON  = C(6)
        CALL GRDWEI(GLON,GLAT,ISN,JSN,WEI)
        CALL GRDVEC(ISN,JSN,VEL,B)
        K = KIND - 18
        OBS0 = WEI(1,1)*VEL(1,1,K)
     &       + WEI(2,1)*VEL(2,1,K)
     &       + WEI(1,2)*VEL(1,2,K)
     &       + WEI(2,2)*VEL(2,2,K)
        IF(KIND .EQ. 19 .or. KIND .EQ. 20) THEN
             OBS0 = OBS0*RADSEC
        ENDIF
        CMO = OBS0 - OBSB
        WRITE( IUO2) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &               IOBS,IVF,IAUX,ITIME
      ELSEIF (KIND .EQ. 22 .OR. KIND .EQ. 23 .OR. KIND .EQ. 24) THEN

        CALL COMPSM(KIND,OBS0,LENG,C,IC,B)
        CMO = OBS0 - OBSB

        WRITE( IUO2) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &               IOBS,IVF,IAUX,ITIME
*** SITE VELOCITY RECORD
      ELSEIF (KIND .EQ. 25 .OR. KIND .EQ. 26 .OR. KIND .EQ. 27) THEN
        CALL GETGLA(GLAT,ISN,B)
        CALL GETGLO(GLON,ISN,B)
        CALL GRDPOS(GLON,GLAT,IGR,JGR)
        CALL GRDWEI(GLON,GLAT,IGR,JGR,WEI)
        CALL GRDVEC(IGR,JGR,VEL,B)
        K = KIND - 24
        LENG = 4
        C(1) = WEI(1,1)
        C(2) = WEI(2,1)
        C(3) = WEI(1,2)
        C(4) = WEI(2,2)
        IC(1) = IUNGRD(IGR    ,JGR    ,K)
        IC(2) = IUNGRD(IGR + 1,JGR    ,K)
        IC(3) = IUNGRD(IGR    ,JGR + 1,K)
        IC(4) = IUNGRD(IGR + 1,JGR + 1,K)
        OBS0 = WEI(1,1) * VEL(1,1,K)
     &       + WEI(2,1) * VEL(2,1,K)
     &       + WEI(1,2) * VEL(1,2,K)
     &       + WEI(2,2) * VEL(2,2,K)
        IF(KIND .EQ. 25 .OR. KIND .EQ. 26) THEN
           OBS0 = OBS0 * RADSEC
        ENDIF
        CMO = OBS0 - OBSB
        WRITE(IUO2) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &              IOBS,IVF,IAUX,ITIME
*** D(X,Y,Z)/DT OBSERVATIONS
      ELSEIF(KIND.EQ.28 .OR. KIND.EQ.29 .OR. KIND.EQ.30)THEN
        CALL BUILDG(R1,GLAT1,GLON1,DTIME,X1,Y1,Z1,ISN,ITIME,B)
        CALL BUILDG(R2,GLAT2,GLON2,DTIME,X2,Y2,Z2,JSN,ITIME,B)
        CALL GRDPOS(GLON1,GLAT1,I1,J1)
        CALL GRDPOS(GLON2,GLAT2,I2,J2)
        CALL GRDWEI(GLON1,GLAT1,I1,J1,WEI1)
        CALL GRDWEI(GLON2,GLAT2,I2,J2,WEI2)
        CALL GRDVEC(I1,J1,VEL1,B)
        CALL GRDVEC(I2,J2,VEL2,B)
        LCNT = 2
        LSTA(1) = ISN
        LSTA(2) = JSN
        LENG = 0
        CALL ADDCD(IC,LENG,LSTA,LCNT,B,KIND)
        ITYPE = KIND - 27
        CALL FORMCT(ITYPE,R1,WEI1,VEL1,R2,WEI2,VEL2,C,OBS0)
        CALL COMPIC(IC,C,LENG)
        CMO = OBS0 - OBSB
        WRITE(IUO2) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &              IOBS,IVF,IAUX,ITIME
*** DL/DT OBSERVATION
      ELSEIF (KIND .EQ. 31) THEN
        LCNT = 2
        LSTA(1) = ISN
        LSTA(2) = JSN
        LENG = 0
        CALL ADDCD(IC,LENG,LSTA,LCNT,B,KIND)
        CALL FORMLT(ISN,JSN,B,C,OBS0)
        CALL COMPIC(IC,C,LENG)
        CMO = OBS0 - OBSB
        WRITE(IUO2) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &              IOBS,IVF,IAUX,ITIME

      ELSEIF (KIND .GT. 999) THEN
        NVEC = ISN
        IAUX = JSN
        NR = 3 * NVEC
        WRITE (IUO2) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &               IOBS,IVF,IAUX,ITIME
        CALL FORMG (IUO,IUO2,NVEC,NR,G,B,FATAL,IVF,IAUX,ITIME)
      ELSE
        WRITE(6,776)
  776   FORMAT('0ABORTED IN FORMOB--UNRECOGNIZED KIND OF OBSERVATION')
        CALL ABORT2
      ENDIF
      GO TO 100

*** ABORT DUE TO LARGE MISCLOSURES

  777 IF (FATAL) THEN
        CALL LINE (3)
        WRITE (6,3) VM
    3   FORMAT ('0ERROR - TERMINATED DUE TO MISCLOSURES (C-O)/SD',
     &          ' EXCEEDING ' ,F7.1,/)
        CALL ABORT2
      ENDIF

      REWIND IUO
      REWIND IUO2

*** EXCHANGE PRIMARY/SECONDARY OBS EQ FILE INDICATOR

      ITEMP = IUO
      IUO = IUO2
      IUO2 = ITEMP

      RETURN
      END
      SUBROUTINE BIGV (KIND,ISN,JSN,IOBS,IVF,CMO,SD,FATAL)

*** LIST LARGE RESIDUALS (MISCLOSURES)

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL FATAL,LBV,LOCSSN
      LOGICAL LMSL,LSS,LUP
      LOGICAL LBB,LGF,LCS,LVD,LVA,LVZ,LVS,
     &        LVR,LVG,LVC,LIS,LPS,LPG,LDR,LOS,LAP
      COMMON /OPRINT/ CRIT,LBB,LGF,LCS,LVD,LVA,LVZ,LVS,
     &                LVR,LVG,LVC,LIS,LPS,LPG,LDR,LOS,LAP
      COMMON /OPT/ AX,E2,DMSL,DGH,VM,VP,CTOL,ITMAX,ITMIN,IMODE,
     &             LMSL,LSS,LUP
      COMMON /ECHO/ VSD,LBV
      COMMON /NUMVFS/ NVFTOT,NVFREE
      COMMON /VFTB2/ VFS(30),VTV(30),VFRN(30),VFSS(30)

      LBV = .FALSE.
      VSD = CMO / SD
      IF (NVFTOT.GT.0) THEN
        IF (IVF.LT.0 .OR. IVF.GT.NVFTOT) THEN
          WRITE (6,3) IVF,NVFTOT
 3        FORMAT ('0ERROR - ILLEGAL IVF = ',I10,'  FOR N=',I10,
     &            ' FOR OBS#',I10,'  IN BIGV')
          CALL ABORT2
        ELSEIF (IVF.NE.0) THEN
          VSD = VSD / DSQRT( VFS(IVF) )
        ENDIF
      ENDIF
      IF (KIND.GE.7) THEN
        IF (DABS(VSD).GT.VP) LBV = .TRUE.
        IF (DABS(VSD).GT.VM) FATAL = .TRUE.
      ELSE
        IF (DABS(VSD).GT.VP) THEN
          CALL LINE (1)
          LBV = .TRUE.
          IF ( .NOT.LOCSSN(ISN,ISSN) ) THEN
            WRITE (6,666) ISN
 666        FORMAT ('0SSN TABLE ERROR IN BIGV--',I5)
            CALL ABORT2
          ENDIF
          IF ( .NOT.LOCSSN(JSN,JSSN) ) THEN
            WRITE (6,666) JSN
            CALL ABORT2
          ENDIF
          WRITE (6,1) IOBS,ISSN,JSSN,VSD
 1        FORMAT (' ','   OBSERVATION #',I5,' BETWEEN STATIONS',
     &            I5,' AND',I5,F30.1,' *** WARNING - LARGE MISCLOSURE')
          IF (DABS(VSD).GT.VM) FATAL = .TRUE.
        ENDIF
      ENDIF

      IF (.NOT.LBB) WRITE (6,2) IOBS,ISN,JSN,VSD
 2    FORMAT (' ','   OBS# = ',I5,10X,'FROM#',I4,10X,'TO#',I4,
     &        F20.1,' *** WARNING - LARGE MISCLOSURE')

      RETURN
      END
      SUBROUTINE BIGL (KIND,ISN,JSN,IOBS,IVF,CMO,SD,FATAL)

*** LIST LARGE RESIDUALS (MISCLOSURES)

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL LMSL,LSS,LUP
      LOGICAL FATAL
      COMMON /NUMVFS/ NVFTOT,NVFREE
      COMMON /VFTB2/ VFS(30),VTV(30),VFRN(30),VFSS(30)
      COMMON /OPT/ AX,E2,DMSL,DGH,VM,VP,CTOL,ITMAX,ITMIN,IMODE,
     &             LMSL,LSS,LUP

      VSD = CMO / SD
      IF (NVFTOT.GT.0) THEN
        IF (IVF.LT.0 .OR. IVF.GT.NVFTOT) THEN
          WRITE (6,3) IVF,NVFTOT
    3     FORMAT ('0ERROR - ILLEGAL IVF = ',I10,'  FOR N=',I10,
     &            ' IN BIGL')
          CALL ABORT2
        ELSEIF (IVF.NE.0) THEN
          VSD = VSD / DSQRT( VFS(IVF) )
        ENDIF
      ENDIF
      IF (DABS(VSD).GT.VP) THEN
        CALL LINE (1)
        WRITE (6,1) IOBS,VSD
    1   FORMAT (' ','   OBS# ',I5,F70.1,
     &          ' *** WARNING - LARGE MISCLOSURE')
        IF (DABS(VSD).GT.VM) FATAL = .TRUE.
      ENDIF

      RETURN
      END
      LOGICAL FUNCTION VFCVRG (IUO,IUO2,B,G,A,NX,GOOGE)

*** REFORM OBS. EQS., COMPUTE INVERSE AND V.F.'S, AND TEST CONVERGE

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL LMSL,LSS,LUP
      LOGICAL GETA
      LOGICAL FATAL,FATAL2,FIXVF,PROP,INVERT
      DIMENSION B(*),G(*),A(*),NX(*),GOOGE(*)
      DIMENSION IC(31),C(31)
      COMMON /OPT/ AX,E2,DMSL,DGH,VM,VP,CTOL,ITMAX,ITMIN,IMODE,
     &             LMSL,LSS,LUP
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI
      COMMON /NUMVFS/ NVFTOT,NVFREE
      COMMON /VFTB2/ VFS(30),VTV(30),VFRN(30),VFSS(30)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD

      VFCVRG = .TRUE.
      VFSTOL = 1.D-5
      VFCTOL = 1.D-2

***  COMPLETE THE COMPUTATION OF THE GOOGE NUMBERS

      DO 44 I = 1,NUNK
        IF ( .NOT.GETA(I,I,VAL,A,NX) ) THEN
          CALL INVIUN (I,ISN,ITYP,IUCODE)
          WRITE (6,55) I,ISN,ITYP,IUCODE
   55     FORMAT ('0 FATAL ERROR IN GOOGE COMPUTATION IN VFCVRG',4I5)
          CALL ABORT2
        ENDIF
        GOOGE(I) = VAL * VAL / GOOGE(I)
   44 CONTINUE

*** INVERT WITHIN PROFILE

      IF (IMODE.NE.1) THEN
        IF ( .NOT.INVERT(A,NX) ) THEN
          WRITE (6,666)
  666     FORMAT ('0STATE ERROR IN INVERSION OF VFCVRG')
          CALL ABORT2
        ENDIF
      ENDIF

*** INITIALIZE VARIANCE FACTORS

      DO 1 IVF = 1,NVFTOT
        IF ( .NOT.FIXVF(IVF) ) THEN
          VTV(IVF) = 0.D0
          VFRN(IVF) = 0.D0
        ENDIF
    1 CONTINUE

*** LOOP OVER THE OBSERVATIONS

      FATAL2 = .FALSE.
      FATAL = .FALSE.
      REWIND IUO
      REWIND IUO2

  100 READ (IUO,END = 777) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &                     IOBS,IVF,IAUX,ITIME
      IF (KIND.LE.999.AND. .NOT.(KIND.GE.19 .AND. 
     &                           KIND.LE.21)) THEN
        CALL FORMIC (KIND,ISN,JSN,IAUX,IC,LENG,B)
        CALL FORMC (KIND,C,B,ISN,JSN,IAUX,ITIME)
        CALL COMPIC (IC,C,LENG)
        CALL COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,IAUX,ITIME)
        IF (KIND.EQ.1 .OR. KIND.EQ.2) THEN
          CMO = ( OBS0 - OBSB ) * RADSEC
        ELSE
          CMO = OBS0 - OBSB
          IF ( KIND.EQ. 8 .OR. KIND.EQ.10 .OR.
     &         KIND.EQ.11 .OR. KIND.EQ.12 ) THEN
            IF (CMO.GT.PI) THEN
              CMO = CMO - TWOPI
            ELSEIF (CMO.LT.-PI) THEN
              CMO = CMO + TWOPI
            ENDIF
          ENDIF
        ENDIF

        IF (IVF.NE.0) THEN
          IF ( .NOT.FIXVF(IVF) ) THEN
            IF ( PROP(C,IC,LENG,VARL0,A,NX,IFLAG) ) THEN
              VARLB = SD * SD * VFS(IVF)
              RN = 1.D0 - VARL0 / VARLB
              IF ( RN .LT. 1.0D-6 ) RN = 0.D0
              VFRN(IVF) = VFRN(IVF) + RN
              VTV(IVF) = VTV(IVF) + CMO * CMO / VARLB
            ELSEIF (IFLAG.EQ.1) THEN
              WRITE (6,668)
  668         FORMAT ('0STATE ERROR IN VFCVRG')
              CALL ABORT2
            ELSE
              WRITE (6,669)
  669         FORMAT ('0PROFILE ERROR IN VFCVRG')
              CALL ABORT2
            ENDIF
          ENDIF
        ENDIF

        CALL BIGL (KIND,ISN,JSN,IOBS,IVF,CMO,SD,FATAL)
        WRITE (IUO2) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &               IOBS,IVF,IAUX,ITIME

*** GPS OBSERVATIONS

      ELSE
        NVEC = ISN
        IAUX = JSN
        NR = 3 * NVEC
        WRITE (IUO2) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &               IOBS,IVF,IAUX,ITIME
        CALL FORMG2 (IUO,IUO2,NVEC,NR,G,B,A,NX,FATAL,
     &               IVF,IAUX,ITIME)
      ENDIF
      GO TO 100

*** ABORT DUE TO LARGE MISCLOSURES

  777 IF (FATAL) THEN
        CALL LINE (3)
        WRITE (6,3) VM
    3   FORMAT ('0ERROR - TERMINATED DUE TO MISCLOSURES (C-O)/SD',
     &          ' EXCEEDING ' ,F11.1,/)
        CALL ABORT2
      ENDIF

      REWIND IUO
      REWIND IUO2

*** EXCHANGE PRIMARY/SECONDARY OBS EQ FILE INDICATOR

      ITEMP = IUO
      IUO = IUO2
      IUO2 = ITEMP

*** HEADING

      CALL LINE (3)
      WRITE (6,20)
   20 FORMAT ('0NUM    VAR. FACTOR    DEG. OF FREE.',
     &        T44,'V.F. RATIO(COMP/INIT)',/)

*** COMPUTE VARIANCE FACTOR AND TEST CONVERGENCE

      DO 2 IVF = 1,NVFTOT
        IF ( FIXVF(IVF) ) THEN
          CALL LINE (1)
          WRITE (6,10) IVF,VFS(IVF)
   10     FORMAT (1X,I3,F14.3,'   *** FIXED ***')
        ELSEIF (VFRN(IVF).LT.VFSTOL) THEN
          CALL LINE (1)
          WRITE (6,11) IVF,VFRN(IVF)
   11     FORMAT (1X,I3,' ERROR - FIXED VARIANCE FACTOR = ',1PD8.2,
     &            ' **** IS SINGULAR ********')
          FATAL2 = .TRUE.
        ELSE
          VF = VTV(IVF) / VFRN(IVF)
          IF ( DABS(VF - 1.D0) .GT. VFCTOL ) VFCVRG = .FALSE.
          VFS(IVF) = VF * VFS(IVF)
          VFRAT = VFS(IVF) / VFSS(IVF)
          CALL LINE (1)
          WRITE (6,12) IVF,VFS(IVF),VFRN(IVF),VFRAT
   12     FORMAT (1X,I3,2F14.3,T44,F15.3)
        ENDIF
   2  CONTINUE

*** ABORT IF SINGULAR VARIANCE FACTORS

      IF (FATAL2) THEN
        CALL LINE (3)
        WRITE (6,4)
    4   FORMAT ('0ERROR - TERMINATED DUE TO VARIANCE FACTOR',
     &          ' SINGULARITIES  ')
        CALL ABORT2
      ENDIF

      RETURN
      END

      SUBROUTINE TRNDAT(DATE, ITIME)
*** Read blue-book date-time
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER*4 (I-N)
      CHARACTER*13 DATE
      CHARACTER*2 CENTRY
      CHARACTER*1 TC

      READ(DATE,5) CENTRY,IYR,IMO,IDY,IHR,IMN,TC
    5 FORMAT(A2,5I2,A1)
      IF(DATE(3:4) .EQ. '  ') IYR = 84
      IF(DATE(5:6) .EQ. '  ') IMO = 1
      IF(DATE(7:8) .EQ. '  ') IDY = 1
      IF(DATE(9:10) .EQ. '  ') IHR = 0
      IF(DATE(11:12) .EQ. '  ') IMN = 0
      IF(DATE(13:13) .EQ. ' ')  TC = 'Z'
      IF(DATE(1:2) .EQ. '18') THEN
         IYR = IYR + 1800
      ELSE
         IYR = IYR + 1900
      ENDIF
      CALL TOMNT(IYR,IMO,IDY,IHR,IMN,TC,ITIME)
      RETURN
      END
