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

*** SECOND TRIP THRU ADJUSTMENT FILE

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*80 CARD
      CHARACTER*2 ID
      LOGICAL FATAL
      LOGICAL LBB,LGF,LCS,LVD,LVA,LVZ,LVS,
     &        LVR,LVG,LVC,LIS,LPS,LPG,LDR,LOS,LAP
      DIMENSION B(*),NX(*)
      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
      DATA ICDP/0/

      IF (LCS) THEN
        CALL HEAD
        CALL LINE (4)
        WRITE (6,1)
    1   FORMAT (' ******** CONSTRAINTS *************',/,
     &          '0 OBS #',/)
      ENDIF
*     CALL DIMCON (IOBS,IUO,B)

  100 READ (IUNIT,2,END=777) CARD
    2 FORMAT (A80)
      ID = CARD(1:2)

      IF (ID.EQ.'CC') THEN
        CALL SECCC (CARD,IUO,IOBS,B,FATAL)
      ELSEIF (ID.EQ.'PV') THEN
        CALL SECPV (CARD,IUO,IOBS,B,NX)
      ELSEIF (ID.EQ.'SV') THEN
        CALL SECSV (CARD,IUO,IOBS,B,NX,FATAL)
      ELSEIF (ID.EQ.'SM') THEN
        CALL SECSM (CARD,IUO,IOBS,B,NX,FATAL)
      ELSEIF (ID.EQ.'QQ') THEN
        CALL SECQQ (CARD,NX)
      ELSEIF (ID.EQ.'SS') THEN
        CALL SECSS (CARD,IUO,IOBS,B)
      ELSEIF (ID.EQ.'CA') THEN
        CALL SECCA (CARD,IUO,IOBS,B,NX,FATAL)
      ELSEIF (ID.EQ.'CD') THEN
        CALL SECCD (CARD,IUO,IOBS,B,NX,FATAL)
      ELSEIF (ID.EQ.'CH') THEN
        CALL SECCH (CARD,IUO,IOBS,B,NX,FATAL)
      ELSEIF (ID.EQ.'CZ') THEN
        CALL SECCZ (CARD,IUO,IOBS,B,NX,FATAL)
      ELSEIF (ID.EQ.'GT') THEN
        CALL SECGT (CARD,IUO,IOBS,B,NX,FATAL)
      ELSEIF (ID.EQ.'LT') THEN
        CALL SECLT (CARD,IUO,IOBS,B,NX,FATAL)
*     ELSEIF (ID.EQ.'CM') THEN
*       IF (IDIM.NE.1) CALL SECCM (CARD,IUO,IOBS,B,NX)
*     ELSEIF (ID.EQ.'TT') THEN
*       CALL SECTT (CARD)
*     ELSEIF (ID.EQ.'CT') THEN
*       IF (IDIM.NE.2) CALL SECCT(CARD,IUO,IOBS,B,NX,FATAL)
*     ELSEIF (ID.EQ.'CR') THEN
*       IF (IDIM.NE.1) CALL SECCR(CARD,IUO,IOBS,B,NX,FATAL)
*     ELSEIF (ID.EQ.'CL') THEN
*       IF (IDIM.NE.1) CALL SECCL(CARD,IUO,IOBS,B,NX,FATAL)
      ENDIF
      GO TO 100

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

 777  IF (LCS) THEN
        CALL LINE (2)
        WRITE (6,3)
    3   FORMAT ('0************ END OF CONSTRAINTS *************')
      ENDIF
      RETURN
      END
      SUBROUTINE SECCA (CARD,IUO,IOBS,B,NX,FATAL)

*** WRITE CONSTRAINTS FOR AZIMUTH RECORDS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*80 CARD
      CHARACTER*4 ASS
      LOGICAL FATAL,GETSSN
      LOGICAL LBB,LGF,LCS,LVD,LVA,LVZ,LVS,
     &        LVR,LVG,LVC,LIS,LPS,LPG,LDR,LOS,LAP
      LOGICAL LMSL,LSS,LUP
      LOGICAL ADDCON
      DIMENSION B(*),NX(*)
      DIMENSION IC(31),C(31)
      COMMON /CDGRID/ GRDLX, GRDUX, GRDLY, GRDUY, ICNTX, ICNTY,
     &                ITREF
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI
      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 /STATCT/ N84,N85,N86,N89,NDIR,NANG,NGPS,NZD,NDS,NAZ,NQQ,
     &                NREJ,NGPSR
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD

      READ (CARD,1) ISSN,JSSN,ID,IM,ASS,SD
    1 FORMAT (2X,2I4, 3X,I3,I2,A4,F5.2)
      CALL NBLANK (ASS,4,IBLK)
      READ (ASS,2) SS
    2 FORMAT (F4.2)

*** STD DEV DEFAULT IS 0.01 ARC SECONDS

      IF ( CARD(23:27).EQ.'     ' ) SD = 0.01D0
      SD = SD / RADSEC
      NAZ = NAZ + 1

      IF ( .NOT.GETSSN(ISSN,ISN) ) THEN
        CALL LINE (3)
        WRITE (6,4) CARD
    4   FORMAT ('0ERROR - NO *80* RECORD FOR -- ',A80,/)
      ELSEIF ( .NOT.GETSSN(JSSN,JSN) ) THEN
        CALL LINE (3)
        WRITE (6,4) CARD
      ELSEIF ( CARD(14:22).NE.'         ' ) THEN
        KIND = 12
        NCON = NCON + 1
        IOBS = IOBS + 1
        IAUX = 0
        IVF = 0
        IF (NCD.GT.0) THEN
          ITIME = ITREF
        ELSE
          ITIME = 0
        ENDIF
        OBSB = (ID + IM / 60.D0 + SS / 3600.D0) / RAD
        IF (OBSB.LT.0.D0) OBSB = OBSB + TWOPI
        IF (OBSB.GE.TWOPI) OBSB = OBSB - TWOPI
        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
        VSD = CMO / SD
        IF ( DABS(VSD).GT.VP ) THEN
          CALL LINE (1)
          WRITE (6,19) IOBS,VSD
   19     FORMAT (1X,'   OBS# = ',I5,F70.1,
     &            ' *** WARNING - LARGE MISCLOSURE')
          IF ( DABS(VSD).GT.VM ) FATAL = .TRUE.
        ENDIF

*** UPDATE CONNECTIVITY

        IF ( .NOT.ADDCON(IC,LENG,NX) ) THEN
          WRITE (6,667)
 667      FORMAT ('0ERROR - INSUFFICIENT STORAGE FOR CONSTRAINED',
     &            ' ASTRONOMIC AZIMUTH',/)
          CALL ABORT2
        ENDIF
        WRITE (IUO) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &              IOBS,IVF,IAUX,ITIME

      ELSEIF ( CARD(14:22).EQ.'         ' ) THEN
        KIND = 12
        NCON = NCON + 1
        IOBS = IOBS + 1
        IAUX = 0
        IVF = 0
        IF (NCD.GT.0) THEN
          ITIME = ITREF
        ELSE
          ITIME = 0
         ENDIF
        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)
        OBSB = OBS0
        CMO = 0.D0

*** UPDATE CONNECTIVITY

        IF ( .NOT.ADDCON(IC,LENG,NX) ) THEN
          WRITE (6,667)
          CALL ABORT2
        ENDIF
        WRITE (IUO) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &              IOBS,IVF,IAUX,ITIME

      ENDIF

*** ECHO CONSTRAINT

      IF (LCS) THEN
        CALL LINE (1)
        WRITE (6,7) IOBS,CARD
    7   FORMAT (I7,3X,A80)
      ENDIF

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

*** WRITE CONSTRAINTS FOR ZENITH DISTANCES

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*80 CARD
      CHARACTER*4 ASS
      LOGICAL GETSSN,FATAL
      LOGICAL LBB,LGF,LCS,LVD,LVA,LVZ,LVS,
     &        LVR,LVG,LVC,LIS,LPS,LPG,LDR,LOS,LAP
      LOGICAL LMSL,LSS,LUP
      LOGICAL ADDCON
      DIMENSION B(*),NX(*)
      DIMENSION IC(31),C(31)
      COMMON /CDGRID/ GRDLX, GRDUX, GRDLY, GRDUY, ICNTX, ICNTY,
     &                ITREF
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI
      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 /STATCT/ N84,N85,N86,N89,NDIR,NANG,NGPS,NZD,NDS,NAZ,NQQ,
     &                NREJ,NGPSR
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD

      READ (CARD,1) ISSN,JSSN,ID,IM,ASS,SD
    1 FORMAT (2X,2I4, 3X,I3,I2,A4,F5.2)
      CALL NBLANK (ASS,4,IBLK)
      READ (ASS,2) SS
    2 FORMAT (F4.2)

*** STD DEV DEFAULT IS 0.01 ARC SECONDS

      IF ( CARD(23:27).EQ.'     ' ) SD = 0.01D0
      SD = SD / RADSEC
      NZD = NZD + 1

      IF ( .NOT.GETSSN(ISSN,ISN) ) THEN
        CALL LINE (3)
        WRITE (6,4) CARD
    4   FORMAT ('0ERROR - NO *80* RECORD FOR -- ',A80,/)
      ELSEIF ( .NOT.GETSSN(JSSN,JSN) ) THEN
        CALL LINE (3)
        WRITE (6,4) CARD
      ELSEIF ( CARD(14:22).NE.'         ' ) THEN
        KIND = 14
        NCON = NCON + 1
        IOBS = IOBS + 1
        IAUX = 0
        IVF = 0
        IF (NCD.GT.0) THEN
          ITIME = ITREF
        ELSE
          ITIME = 0
        ENDIF
        OBSB = (ID + IM / 60.D0 + SS / 3600.D0) / RAD
        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
        VSD = CMO / SD
        IF ( DABS(VSD).GT.VP ) THEN
          CALL LINE (1)
          WRITE (6,11) IOBS,VSD
   11     FORMAT (1X,'   OBS#=',I5,F70.1,
     &            ' *** WARNING - LARGE MISCLOSURE')
          IF ( DABS(VSD).GT.VM ) FATAL = .TRUE.
        ENDIF

*** UPDATE CONNECTIVITY

        IF ( .NOT.ADDCON(IC,LENG,NX) ) THEN
          WRITE (6,667)
 667      FORMAT ('0ERROR - INSUFFICIENT STORAGE FOR CONSTRAINED',
     &            ' ZENITH DISTANCES',/)
          CALL ABORT2
        ENDIF
        WRITE (IUO) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &              IOBS,IVF,IAUX,ITIME

      ELSEIF ( CARD(14:22).EQ.'         ' ) THEN
        KIND = 14
        NCON = NCON + 1
        IOBS = IOBS + 1
        IAUX = 0
        IVF = 0
        IF (NCD.GT.0) THEN
          ITIME = ITREF
        ELSE
          ITIME = 0
         ENDIF
        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)
        OBSB = OBS0
        CMO = 0.D0

*** UPDATE CONNECTIVITY

        IF ( .NOT.ADDCON(IC,LENG,NX) ) THEN
          WRITE (6,667)
          CALL ABORT2
        ENDIF
        WRITE (IUO) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &              IOBS,IVF,IAUX,ITIME

      ENDIF

*** ECHO CONSTRAINT

      IF (LCS) THEN
        CALL LINE (1)
        WRITE (6,7) IOBS,CARD
    7   FORMAT (I7,3X,A80)
      ENDIF

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

*** WRITE CONSTRAINTS FOR DISTANCE RECORDS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      CHARACTER*80 CARD
      LOGICAL GETSSN,FATAL
      LOGICAL ADDCON
      LOGICAL LBB,LGF,LCS,LVD,LVA,LVZ,LVS,
     &        LVR,LVG,LVC,LIS,LPS,LPG,LDR,LOS,LAP
      LOGICAL LMSL,LSS,LUP
      DIMENSION B(*),NX(*)
      DIMENSION IC(31),C(31)
      COMMON /CDGRID/ GRDLX, GRDUX, GRDLY, GRDUY, ICNTX, ICNTY,
     &                ITREF
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI
      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 /STATCT/ N84,N85,N86,N89,NDIR,NANG,NGPS,NZD,NDS,NAZ,NQQ,
     &                NREJ,NGPSR
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD

      READ (CARD,1) ISSN,JSSN,OBSB,SD
    1 FORMAT (2X,2I4,F12.4,F5.4)

*** STD DEV DEFAULT IS 0.1 MM

      IF ( CARD(23:27).EQ.'     ' ) SD = 0.0001D0
      NDS = NDS + 1

      IF ( .NOT.GETSSN(ISSN,ISN) ) THEN
        CALL LINE (3)
        WRITE (6,4) CARD
    4   FORMAT ('0ERROR - NO *80* RECORD FOR -- ',A80,/)
      ELSEIF ( .NOT.GETSSN(JSSN,JSN) ) THEN
        CALL LINE (3)
        WRITE (6,4) CARD
      ELSEIF ( CARD(11:22).NE.'            ' ) THEN
        KIND = 13
        NCON = NCON + 1
        IOBS = IOBS + 1
        IAUX = 0
        IVF = 0
        IF (NCD.GT.0) THEN
          ITIME = ITREF
        ELSE
          ITIME = 0
        ENDIF
        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
        VSD = CMO / SD
        IF ( DABS(VSD).GT.VP ) THEN
          CALL LINE (1)
          WRITE (6,11) IOBS,VSD
   11     FORMAT (1X,'   OBS# = ',I5,F70.1,
     &            ' *** WARNING - LARGE MISCLOSURE')
          IF ( DABS(VSD).GT.VM ) FATAL = .TRUE.
        ENDIF

*** UPDATE CONNECTIVITY

        IF ( .NOT.ADDCON(IC,LENG,NX) ) THEN
          WRITE (6,667)
 667      FORMAT ('0ERROR - INSUFFICIENT STORAGE FOR CONSTRAINED',
     &            ' DISTANCES',/)
          CALL ABORT2
        ENDIF
        WRITE (IUO) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &              IOBS,IVF,IAUX,ITIME

      ELSEIF ( CARD(11:22).EQ.'            ' ) THEN
        KIND = 13
        NCON = NCON + 1
        IOBS = IOBS + 1
        IAUX = 0
        IVF = 0
        IF (NCD.GT.0) THEN
          ITIME = ITREF
        ELSE
          ITIME = 0
        ENDIF
        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)
        OBSB = OBS0
        CMO = 0.D0

*** UPDATE CONNECTIVITY

        IF ( .NOT.ADDCON(IC,LENG,NX) ) THEN
          WRITE (6,667)
          CALL ABORT2
        ENDIF
        WRITE (IUO) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &              IOBS,IVF,IAUX,ITIME

      ENDIF

*** ECHO CONSTRAINT

      IF (LCS) THEN
        CALL LINE (1)
        WRITE (6,7) IOBS,CARD
    7   FORMAT (I7,3X,A80)
      ENDIF

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

*** WRITE CONSTRAINTS FOR HEIGHT DIFFERENCES

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      CHARACTER*80 CARD
      LOGICAL GETSSN,FATAL
      LOGICAL ADDCON
      LOGICAL ELFLAG,DFFLAG
      LOGICAL LBB,LGF,LCS,LVD,LVA,LVZ,LVS,
     &        LVR,LVG,LVC,LIS,LPS,LPG,LDR,LOS,LAP
      LOGICAL LMSL,LSS,LUP
      DIMENSION B(*),NX(*)
      DIMENSION IC(31),C(31)
      COMMON /CDGRID/ GRDLX, GRDUX, GRDLY, GRDUY, ICNTX, ICNTY,
     &                ITREF
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI
      COMMON /FLAGS/ ELFLAG(MXSSN),DFFLAG(MXSSN)
      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 /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD

      READ (CARD,1) ISSN,JSSN,OBSB,SD
    1 FORMAT (2X,2I4,F12.4,F5.4)

*** STD DEV DEFAULT IS 0.1 MM

      IF (CARD(23:27).EQ.'     ') SD = 0.0001D0

      IF ( .NOT.GETSSN(ISSN,ISN) ) THEN
        CALL LINE (3)
        WRITE (6,4) CARD
    4   FORMAT ('0ERROR - NO *80* RECORD FOR -- ',A80,/)
      ELSEIF ( .NOT.GETSSN(JSSN,JSN) ) THEN
        CALL LINE (3)
        WRITE (6,4) CARD
      ELSEIF (CARD(11:22).NE.'            ') THEN
        IF ( ELFLAG(ISN) ) THEN
          IF ( ELFLAG(JSN) ) THEN
            KIND = 16
          ELSE
            KIND = 17
          ENDIF
        ELSE
          IF ( ELFLAG(JSN) ) THEN
            KIND = 17
          ELSE
            KIND = 15
          ENDIF
        ENDIF
        NCON = NCON + 1
        IOBS = IOBS + 1
        IAUX = 0
        IVF = 0
        IF (NCD.GT.0) THEN
          ITIME = ITREF
        ELSE
          ITIME = 0
        ENDIF
        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
        VSD = CMO / SD
        IF (DABS(VSD).GT.VP) THEN
          CALL LINE (1)
          WRITE (6,11) IOBS,VSD
   11     FORMAT (1X,'   OBS# = ',I5,F70.1,
     &            ' *** WARNING - LARGE MISCLOSURE')
          IF (DABS(VSD).GT.VM) FATAL = .TRUE.
        ENDIF

*** UPDATE CONNECTIVITY

        IF ( .NOT.ADDCON(IC,LENG,NX) ) THEN
          WRITE (6,667)
 667      FORMAT ('0ERROR - INSUFFICIENT STORAGE FOR CONSTRAINED',
     &            ' HEIGHT DIFFERENCES',/)
          CALL ABORT2
        ENDIF
        WRITE (IUO) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &              IOBS,IVF,IAUX,ITIME

      ELSEIF (CARD(11:22).EQ.'            ') THEN
        IF ( ELFLAG(ISN) ) THEN
          IF ( ELFLAG(JSN) ) THEN
            KIND = 16
          ELSE
            KIND = 17
          ENDIF
        ELSE
          IF ( ELFLAG(JSN) ) THEN
            KIND = 17
          ELSE
            KIND = 15
          ENDIF
        ENDIF
        NCON = NCON + 1
        IOBS = IOBS + 1
        IAUX = 0
        IVF = 0
        IF (NCD.GT.0) THEN
          ITIME = ITREF
        ELSE
          ITIME = 0
        ENDIF
        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)
        OBSB = OBS0
        CMO = 0.D0

*** UPDATE CONNECTIVITY

        IF ( .NOT.ADDCON(IC,LENG,NX) ) THEN
          WRITE (6,667)
          CALL ABORT2
        ENDIF
        WRITE (IUO) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &              IOBS,IVF,IAUX,ITIME

      ENDIF

*** ECHO CONSTRAINT

      IF (LCS) THEN
        CALL LINE (1)
        WRITE (6,7) IOBS,CARD
    7   FORMAT (I7,3X,A80)
      ENDIF

      RETURN
      END
      SUBROUTINE SECQQ (CARD,NX)

*** ADD CONNECTIONS FOR AN ACCURACY RECORD

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL GETSSN
      LOGICAL ADDCON
      CHARACTER*80 CARD
      DIMENSION NX(*)
      DIMENSION IC(13)
      COMMON /CDGRID/ GRDLX, GRDUX, GRDLY, GRDUY, ICNTX, ICNTY,
     &                ITREF
      COMMON /STATCT/ N84,N85,N86,N89,NDIR,NANG,NGPS,NZD,NDS,NAZ,NQQ,
     &                NREJ,NGPSR

      READ (CARD,1) ISSN,JSSN
    1 FORMAT (10X,I4,36X,I4)

      IF ( GETSSN(ISSN,ISN) ) THEN
        IF ( GETSSN(JSSN,JSN) ) THEN
          NQQ = NQQ + 1
          CALL CONEC (ISN,JSN,IC,LENG)
          IF ( .NOT.ADDCON(IC,LENG,NX) ) THEN
            WRITE (6,666)
 666        FORMAT ('0ERROR - INSUFFICIENT STORAGE FOR ACCURACY',
     &              ' COMPUTATION')
            CALL ABORT2
          ENDIF
        ENDIF
      ENDIF

      RETURN
      END
      SUBROUTINE CONEC (I,J,IC,LENG)

*** FILL CONNECTION MATRIX FOR TWO STATIONS

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

      IF (IDIM.EQ.1) THEN
        LENG = 2
        IC(1) = IUNSTA(I,3)
        IC(2) = IUNSTA(J,3)
      ELSEIF (IDIM.EQ.2) THEN
        LENG = 4
        IC(1) = IUNSTA(I,1)
        IC(2) = IUNSTA(I,2)
        IC(3) = IUNSTA(J,1)
        IC(4) = IUNSTA(J,2)
      ELSE
        LENG = 6
        IC(1) = IUNSTA(I,1)
        IC(2) = IUNSTA(I,2)
        IC(3) = IUNSTA(I,3)
        IC(4) = IUNSTA(J,1)
        IC(5) = IUNSTA(J,2)
        IC(6) = IUNSTA(J,3)
      ENDIF

      RETURN
      END
      SUBROUTINE SECSS (CARD,IUO,IOBS,B)

*** WRITE CONSTRAINT OBS. EQS. FOR AUXILIARY PARAMETERS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL GETPRM
      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 LMSL,LSS,LUP
      CHARACTER*80 CARD
      CHARACTER*1 TC1,TC2
      DIMENSION IC(31),C(31)
      DIMENSION B(*)
      COMMON /CDGRID/ GRDLX, GRDUX, GRDLY, GRDUY, ICNTX, ICNTY,
     &                ITREF
      COMMON /BYPASS/ LDIR,LANG,LZEN,LDIS,LAZI,LGPS
      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 /OPRINT/ CRIT,LBB,LGF,LCS,LVD,LVA,LVZ,LVS,
     &                LVR,LVG,LVC,LIS,LPS,LPG,LDR,LOS,LAP

*** EXTRACT INFORMATION FROM RECORD

      READ (CARD,1) ICODE,IYR1,IMO1,IDY1,IHR1,IMN1,TC1,
     &                    IYR2,IMO2,IDY2,IHR2,IMN2,TC2,IVAL,ISD
    1 FORMAT (2X,I2, 2(I4,4I2,A1),2I5)
      IF (ICODE.EQ.42) ICODE = 40
      IF (ICODE.EQ.54) ICODE = 52
      IF (ICODE.GE.26 .AND. ICODE.LE.29) ICODE = 25
      IF (ICODE.EQ.25) THEN
        IF (LGPS) RETURN
      ELSEIF (ICODE.EQ.40) THEN
        IF (LZEN) RETURN
      ELSEIF (ICODE.EQ.52) THEN
        IF (LDIS) RETURN
      ELSE
        RETURN
      ENDIF

      IF (CARD(5:8).EQ.'    ')   IYR1 = 1801
      IF (CARD(9:10).EQ.'  ')    IMO1 = 1
      IF (CARD(11:12).EQ.'  ')   IDY1 = 1
      IF (CARD(17:17).EQ.' ')    TC1 = 'Z'
      IF (CARD(18:21).EQ.'    ') IYR2 = 2099
      IF (CARD(22:23).EQ.'  ')   IMO2 = 12
      IF (CARD(24:25).EQ.'  ')   IDY2 = 31
      IF (CARD(26:27).EQ.'  ')   IHR2 = 23
      IF (CARD(28:29).EQ.'  ')   IMN2 = 59
      IF (CARD(30:30).EQ.' ')    TC2 = 'Z'
      IF (CARD(36:40).EQ.'     ') ISD = 100

      CALL TOMNT (IYR1,IMO1,IDY1,IHR1,IMN1,TC1,IOLD)
      CALL TOMNT (IYR2,IMO2,IDY2,IHR2,IMN2,TC2,INEW)
      ITIME = (IOLD + INEW) / 2

*** WRITE CONSTRAINT OBS. EQ.

      IF ( .NOT.GETPRM(ICODE,ITIME,IAUX) ) THEN
        CALL LINE (1)
        WRITE (6,2) CARD
    2   FORMAT ('0*** ERROR - RECORD NOT IN PARAMETER TABLE',/,1X,A80)
      ELSEIF (CARD(31:40).NE.'          ') THEN
        KIND = 0
        NCON = NCON + 1
        IVF = 0
        IOBS = IOBS + 1
        OBSB = DBLE(IVAL) * 1.0D-8
        SD = DBLE(ISD) * 1.0D-8
        CALL FORMIC (KIND,IAUX,IDUMMY,IDUM2,IC,LENG,B)
        CALL FORMC (KIND,C,B,IAUX,IDUMMY,IDUM2,ITIME)
        CALL COMPIC (IC,C,LENG)
        CALL COMPOB (KIND,OBS0,B,RDUMMY,IAUX,IDUMMY,IDUM2,ITIME)
        CMO = OBS0 - OBSB
        IF (IMODE.EQ.0) CMO = 0.D0
        WRITE (IUO) KIND,IAUX,IDUMMY,IC,C,LENG,CMO,OBSB,SD,
     &              IOBS,IVF,IAUX,ITIME

*** ECHO OBSERVATION NUMBERS

        IF (LCS) THEN
          CALL LINE (1)
          WRITE (6,3) IOBS,CARD
    3     FORMAT (1X,I6,3X,A80)
        ENDIF
      ENDIF

      RETURN
      END
