      SUBROUTINE RESID (IUO,A,B,NX,G,SIGUWT)

*** LIST ADJUSTED OBSERVATIONS AND RESIDUALS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      DIMENSION A(*),B(*),NX(*),G(*)
      LOGICAL LMSL,LSS,LUP
      DIMENSION IC(31),C(31)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON /OPT/ AX,E2,DMSL,DGH,VM,VP,CTOL,ITMAX,ITMIN,IMODE,
     &             LMSL,LSS,LUP

*** HEADING

      CALL HEAD2

*** INITIALIZE RESIDUAL STATISTICS

      CALL RSINIT
      ISNX = 0
      JSNX = 0
      KSNX = 0

*** LOOP OVER THE OBSERVATION EQUATIONS

      REWIND IUO
  100 READ (IUO,END = 777) KIND,ISN,JSN,IC,C,LENG,CMO,OBSB,SD,
     &                     IOBS,IVF,IAUX,ITIME
      IF (KIND.LE.999) THEN
        CALL ROBS (KIND,IOBS,ISN,ISNX,JSN,JSNX,KSNX,OBSB,SD,B,IAUX,
     &             IVF,SIGUWT,IC,C,LENG,A,NX,ITIME)
      ELSE
        NVEC = ISN
        IAUX = JSN
        LENG = (NVEC + 1) * 3 + 1
        IF (NCD.GT.0) LENG = LENG + 12 * (NVEC + 1)
        NR = 3 * NVEC
        NC = NR + 5 + LENG
        CALL RGPS (IUO,IOBS,NVEC,NR,NC,LENG,G,B,IAUX,IVF,SIGUWT,A,NX,
     &             ITIME)
      ENDIF
      GO TO 100

*** END OF FILE ENCOUNTERED
*** LIST RESIDUAL STATISTICS

  777 CALL RSOUT (SIGUWT)
      RETURN
      END

      SUBROUTINE RSINIT

*** INITIALIZE RESIDUAL STATISTICS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /RESTAT/ VPV(32),RNUM(32),NUM(32),N0                   
      COMMON /TOP20/ VSD20(20),I20(20),NI20

      DO 1 I = 1,20
        VSD20(I) = 0.D0
        I20(I) = 0
    1 CONTINUE
      NI20 = 0

      N0 = 0
      DO 2 I = 1,32
         NUM(I) = 0
         RNUM(I) = 0.D0
         VPV(I) = 0.D0
    2 CONTINUE

      RETURN
      END

      SUBROUTINE ROBS (KIND,IOBS,ISN,ISNX,JSN,JSNX,KSNX,OBSB,SD,B,IAUX,
     &                 IVF,SIGUWT,IC,C,LENG,A,NX,ITIME)

*** LIST ADJUSTED OBSERVATIONS AND RESIDUALS FOR OBS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      PARAMETER (MXSSN = 9999)
      PARAMETER ( PERYR = 365.25D0 * 24.D0 * 60.D0 )
      CHARACTER*30 NAMES,NAME1,NAME2,NAME3
      CHARACTER*5 CT(4)
      CHARACTER*1 ADIR1,ADIR2,ADIR3
      LOGICAL PROP
      LOGICAL LMSL,LSS,LUP
      LOGICAL LBB,LGF,LCS,LVD,LVA,LVZ,LVS,
     &        LVR,LVG,LVC,LIS,LPS,LPG,LDR,LOS,LAP
      DIMENSION B(*),A(*),NX(*),IC(31),C(31)
      DIMENSION WEI(2,2), VEL(2,2,3)
      DIMENSION R1(3,3), R2(3,3)
      DIMENSION WEI1(2,2), WEI2(2,2)
      DIMENSION VEL1(2,2,3), VEL2(2,2,3)
      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 /NAMTAB/ NAMES(MXSSN)
      COMMON /OPRINT/ CRIT,LBB,LGF,LCS,LVD,LVA,LVZ,LVS,
     &                LVR,LVG,LVC,LIS,LPS,LPG,LDR,LOS,LAP
      COMMON /NUMVFS/ NVFTOT,NVFREE
      COMMON /VFTB2/ VFS(30),VTV(30),VFRN(30),VFSS(30)
      COMMON /SMOOTH/ SMCAL
      DATA CT(1) /' GT-X'/, CT(2) /' GT-Y'/, CT(3) /' GT-Z'/,
     &     CT(4) /' DLDT'/
      SAVE GLAT,GLON,EHT,RX,RY
      SAVE NAME1,NAME2,NAME3


*** CHECK FOR NEW ISN

      IF (KIND.LE.18 .OR. (KIND.GE.28 .AND. KIND.LE.31)) THEN
        IF (ISNX.NE.ISN .AND. KIND.GT.0 .AND. KIND.LT.7) THEN
          ISNX = ISN
          CALL LINE2 (1)
          WRITE (6,1)
    1     FORMAT (' ')
          CALL GETGLA (GLAT,ISN,B)
          CALL GETGLO (GLON,ISN,B)
          CALL GETMSL (GMSL,ISN,B)
          CALL GETGH (GHT,ISN,B)
          EHT = GMSL + GHT
          CALL RADCUR(GLAT,RMER,RPV)
          RX = RMER + EHT
          RY = (RPV + EHT) * DCOS(GLAT)
          NAME1 = NAMES(ISN)
          IF (KIND.GT.3 .AND. IMODE.EQ.3) THEN
            CALL LINE2 (1)
            WRITE (6,5) NAME1
 5          FORMAT (93X,A30)
          ENDIF
        ENDIF
        IF (ISNX.NE.ISN .AND. KIND.GE.7) THEN
          ISNX = ISN
          WRITE (6,1)
          CALL LINE2 (1)
          NAME1 = NAMES(ISN)
          IF (IMODE.EQ.3) THEN
            CALL LINE2 (1)
            WRITE (6,5) NAME1
          ENDIF
        ENDIF
        IF (JSNX.NE.JSN .AND. KIND.GE.7) THEN
          JSNX = JSN
          NAME2 = NAMES(JSN)
        ENDIF
        IF (KIND.EQ.10 .AND. KSNX.NE.IAUX) THEN
          KSNX = IAUX
          NAME3 = NAMES(IAUX)
        ENDIF
      ENDIF

*** SCALE BY THE VARIANCE FACTOR

      IF (NVFTOT.GT.0) THEN
        IF (IVF.LT.0 .OR. IVF.GT.NVFTOT) THEN
          WRITE (6,9) IVF,NVFTOT
    9     FORMAT ('0ERROR - ILLEGAL IVF=',I10,' FOR N=',I10,' IN ROBS')
          CALL ABORT2
        ELSEIF (IVF.NE.0) THEN
          SD = SD * DSQRT( VFS(IVF) )
        ENDIF
      ENDIF

*** COMPUTATION OF S.D. FOR RESIDUALS AND
*** COMPUTATION OF REDUNDANCY NUMBERS

      IF (IMODE.EQ.0 .OR. IMODE.EQ.3) THEN
        IF ( PROP(C,IC,LENG,VAR,A,NX,IFLAG) ) THEN
          DVAR = SD * SD - VAR
          IF ( (KIND.GE.8 .AND. KIND.LE.12) .OR. KIND.EQ.14
     &         .OR. KIND.EQ.1 .OR. KIND.EQ.2 .OR. KIND.EQ.20 ) THEN
            IF (DVAR.LT.1.0D-14) DVAR = 0.D0
          ELSEIF (KIND.GE.19 .AND. KIND.LE.24) THEN
            IF (DVAR .LT. 1.D-30) DVAR = 0.D0
          ELSE
            IF (DVAR.LT.1.0D-10) DVAR = 0.D0
          ENDIF
          SD3 = DSQRT(DVAR)
          RN = 1.D0 - VAR / (SD * SD)
          IF (RN.LT. 1.0D-10 ) RN = 0.D0
        ELSEIF (IFLAG.EQ.1) THEN
          WRITE (6,660)
 660      FORMAT ('0ERROR - SYSTEM NOT INVERTED IN ROBS',/)
          CALL ABORT2
        ELSE
          WRITE (6,661)
 661      FORMAT ('0ERROR - ALL COVARIANCE ELEMENTS NOT WITHIN',
     &            ' PROFILE--ROBS')
          CALL ABORT2
        ENDIF
      ENDIF
      IF (IMODE.GE.0 .AND. IMODE.LE.2) SD3 = SD

***COMPUTE THE MARGINAL DETECTABLE ERROR(GMDE) USING 3*SIGMA

      IF (IMODE.EQ.0 .OR. IMODE.EQ.3) THEN
        IF (RN.LT. 1.0D-8 ) THEN
          GMDE = 0.D0
        ELSE
          GMDE = (3.D0 * SD) / DSQRT(RN)
        ENDIF
      ENDIF

*** AUXILIARY PARAMETER CONSTRAINTS

      IF (KIND.EQ.0) THEN
        IAUX = ISN
        CALL GETAUX (AUX,IAUX,B)
        V = AUX - OBSB
        VSD = V / SD
        VSD3 = DIVID(V,SD3)
        IF (LSS) VSD = VSD / SIGUWT
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (2)
            IF (IMODE.EQ.0) THEN
              WRITE (6,11) IOBS,AUX,GMDE,RN,IAUX
 11           FORMAT ('0',I4,' AP',1PD17.2,1PD12.2,0PF16.2,
     &                ' AUX PARM #',I3)
            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,12) IOBS,AUX,OBSB,V,SD3,VSD3,GMDE,RN,IAUX
 12           FORMAT ('0',I4,' AP',1PD17.2,1PD17.2,1PD17.2,0PF8.2,F8.2,
     &                F10.4,F6.2,'  AUX PARM #',I3)
            ELSE
              WRITE (6,10) IOBS,AUX,OBSB,V,VSD,IAUX
   10         FORMAT ('0',I4,' AP',1PD17.2,1PD18.2,1PD18.2,0PF8.1,
     &                ' AUX PARM #',I3)
            ENDIF
          ENDIF
        ENDIF

*** LATITUDE CONSTRAINT, KIND = 1

      ELSEIF (KIND.EQ.1) THEN
        CALL GETDMS (GLAT,ID1,IM1,S1,ISGN)
        IF (ISGN.GT.0) THEN
          ADIR1 = 'N'
        ELSE
          ADIR1 = 'S'
        ENDIF
        CALL GETDMS (OBSB,ID3,IM3,S3,ISGN)
        IF (ISGN.GT.0) THEN
          ADIR3 = 'N'
        ELSE
          ADIR3 = 'S'
        ENDIF
        V = GLAT - OBSB
        VSEC = V * RADSEC
        VMET = V * RX
        VSD = VSEC / SD
        SD1 = (SD/RADSEC)*RX
        VSD3 = DIVID(VSEC,SD3)
        IF (IMODE.EQ.0 .OR. IMODE.EQ.3) GMDE = ( GMDE / RADSEC ) * RX
        IF (IMODE.EQ.3) SD3 = ( SD3 / RADSEC ) * RX
        IF (LSS) VSD = VSD / SIGUWT
        CALL MNTMD(ITIME, IYR,IMON,IDAY,IHR,IMN)
        IF (LVC) THEN
          IF (DABS(VSD3).GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,131) IOBS,ID1,IM1,S1,ADIR1,GMDE,RN,NAME1,
     &                      IMON,IDAY,IYR
 131          FORMAT (' ',I4,' LA',I4,I3,F9.5,A1,F9.3,F19.2,1X,A20,
     &        1X,I2,'/',I2,'/',I4)
            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,132) IOBS,ID1,IM1,S1,ADIR1,ID3,IM3,S3,ADIR3,
     &                      VMET,SD3,VSD3,RN,NAME1,
     &                      IMON,IDAY,IYR
 132          FORMAT (' ',I4,' LA',I4,I3,F9.5,A1,I4,I3,F9.5,A1,
     &                F8.3,F8.3,' METER',F8.2,F6.2,2X,A20,1X,I2,'/',I2,
     &                '/',I4)
            ELSE
              WRITE (6,13) IOBS,ID1,IM1,S1,ADIR1,ID3,IM3,S3,ADIR3,
     &                     VMET,SD1,VSD,NAME1,IMON,IDAY,IYR
   13         FORMAT (' ',I4,' LA',I4,I3,F9.5,A1,I5,I3,F9.5,A1,
     &         F8.3,F8.3,' METER',F8.2,1X,A20,1X,I2,'/',I2,'/',I4)
            ENDIF
          ENDIF
        ENDIF

*** LONGITUDE CONSTRAINT, KIND = 2

      ELSEIF (KIND.EQ.2) THEN
        CALL GETDMS (GLON,ID2,IM2,S2,ISGN)
        IF (ISGN.GT.0) THEN
          ADIR2 = 'E'
        ELSE
          ADIR2 = 'W'
        ENDIF
        CALL GETDMS (OBSB,ID3,IM3,S3,ISGN)
        IF (ISGN.GT.0) THEN
          ADIR3 = 'E'
        ELSE
          ADIR3 = 'W'
        ENDIF
        V = GLON - OBSB
        VSEC = V * RADSEC
        VMET = V * RY
        SD1 = (SD/RADSEC)*RY
        VSD = VSEC / SD
        VSD3 = DIVID(VSEC,SD3)
        IF (IMODE.EQ.0 .OR. IMODE.EQ.3) GMDE = ( GMDE / RADSEC ) * RY
        IF (IMODE.EQ.3) SD3 = ( SD3 / RADSEC ) * RY
        IF (LSS) VSD = VSD / SIGUWT
        CALL MNTMD(ITIME, IYR,IMON,IDAY,IHR,IMN)
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,141) IOBS,ID2,IM2,S2,ADIR2,GMDE,RN,NAME1,
     &                      IMON,IDAY,IYR

 141          FORMAT (' ',I4,' LO',I4,I3,F9.5,A1,F9.3,F19.2,1X,A20,
     &        1X,I2,'/',I2,'/',I4)
            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,142) IOBS,ID2,IM2,S2,ADIR2,ID3,IM3,S3,ADIR3,
     &                      VMET,SD3,VSD3,RN,NAME1,
     &                      IMON,IDAY,IYR

 142          FORMAT (' ',I4,' LO',I4,I3,F9.5,A1,I4,I3,F9.5,A1,
     &                F8.3,F8.3,' METER',F8.2,F6.2,2X,A20,
     &        1X,I2,'/',I2,'/',I4)
            ELSE
              WRITE (6,14) IOBS,ID2,IM2,S2,ADIR2,ID3,IM3,S3,ADIR3,
     &                     VMET,SD1,VSD,NAME1,
     &                      IMON,IDAY,IYR

   14         FORMAT (' ',I4,' LO',I4,I3,F9.5,A1,I5,I3,F9.5,A1,
     &                F8.3,F8.3,' METER',F8.2,1X,A20,
     &        1X,I2,'/',I2,'/',I4)

            ENDIF
          ENDIF
        ENDIF

*** HEIGHT CONSTRAINT, KIND = 3

      ELSEIF (KIND.EQ.3) THEN
        V = EHT - OBSB
        VSD = V / SD
        VSD3 = DIVID(V,SD3)
        IF (LSS) VSD = VSD / SIGUWT
        CALL MNTMD(ITIME, IYR,IMON,IDAY,IHR,IMN)
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,151) IOBS,EHT,GMDE,RN,NAME1,
     &                      IMON,IDAY,IYR

 151          FORMAT (' ',I4,' EH',F14.3,F12.3,F19.2,1X,A20,
     &        1X,I2,'/',I2,'/',I4)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,152) IOBS,EHT,OBSB,V,SD3,VSD3,RN,NAME1,
     &                      IMON,IDAY,IYR

 152          FORMAT (' ',I4,' EH',F14.3,F17.3,F10.3,F8.3,' METER',
     &                F8.2,F6.2,2X,A20,
     &        1X,I2,'/',I2,'/',I4)

            ELSE
              WRITE (6,15) IOBS,EHT,OBSB,V,SD,VSD,NAME1,
     &                      IMON,IDAY,IYR

   15         FORMAT (' ',I4,' EH',F14.3,F18.3,F11.3,F8.3,' METER',
     &                F8.2,1X,A20,
     &        1X,I2,'/',I2,'/',I4)

            ENDIF
          ENDIF
        ENDIF

*** MARK TO MARK DISTANCE, KIND = 7

      ELSEIF (KIND.EQ.7) THEN
        CALL COMPOB (KIND,S,B,OBSB,ISN,JSN,IAUX,ITIME)
        V = S - OBSB
        VSD = V / SD
        VSD3 = DIVID(V,SD3)
        IF (LSS) VSD = VSD / SIGUWT
        CALL MNTMD(ITIME, IYR,IMON,IDAY,IHR,IMN)
        IF (LVS) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,171) IOBS,S,GMDE,RN,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 171          FORMAT (' ',I5,' DIST',F13.4,F11.3,F19.2, 2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,172) IOBS,S,OBSB,V,SD3,VSD3,RN,NAME2,
     &                      IMON,IDAY,IYR,  SD,VSD

 172          FORMAT (' ',I5,' DIST',F13.4,F17.4,F10.3,F8.3,' METER',
     &                F8.2,F6.2,4X,A20,
     &        1X,I2,'/',I2,'/',I4,    2F10.3)

            ELSE
              WRITE (6,17) IOBS,S,OBSB,V,SD,VSD,NAME1,NAME2,
     &                      IMON,IDAY,IYR

  17          FORMAT (' ',I5,' DIST',F12.3,F18.3,F11.3,
     &                F8.3,' METER',F8.2, 2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ENDIF
          ENDIF
        ENDIF

*** ASTRONOMIC AZIMUTH, KIND = 8

      ELSEIF (KIND.EQ.8) THEN
        CALL COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,IAUX,ITIME)
        CALL DIRDMS (OBS0,ID0,IM0,S0)
        V = OBS0 - OBSB
        IF (V.GT.PI) THEN
          V = V - TWOPI
        ELSEIF (V.LT.-PI) THEN
          V = V + TWOPI
        ENDIF
        VSEC = V * RADSEC
        VSD = V / SD
        SD1 = SD*RADSEC
        VSD3 = DIVID(V,SD3)
        IF (IMODE.EQ.0 .OR. IMODE.EQ.3) GMDE = GMDE * RADSEC
        IF (IMODE.EQ.3) SD3 = SD3 * RADSEC
        IF (LSS) VSD = VSD / SIGUWT
        CALL DIRDMS (OBSB,IDB,IMB,SB)
        CALL MNTMD(ITIME, IYR,IMON,IDAY,IHR,IMN)
        IF (LVR) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,191) IOBS,ID0,IM0,S0,GMDE,RN,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 191          FORMAT (' ',I5,' AZ',I4,I3,F6.2,'N',F11.2,F20.2,2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,192) IOBS,ID0,IM0,S0,IDB,IMB,SB,VSEC,SD3,VSD3,
     &                      RN,NAME2,
     &                      IMON,IDAY,IYR

 192          FORMAT (' ',I5,' AZ',I4,I3,F6.2,'N',I7,I3,F6.2,'N',
     &                F9.2,F9.2,' SECOND',F8.2,F8.2,4X,A20,
     &        1X,I2,'/',I2,'/',I4)

            ELSE
              WRITE (6,19) IOBS,ID0,IM0,S0,IDB,IMB,SB,
     &                     VSEC,SD1,VSD,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 19           FORMAT (' ',I5,' AZ',I4,I3,F6.2,'N',I8,I3,F5.1,
     &                'N',4X,F8.2,F8.2,' SECOND',F8.2, 2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ENDIF
          ENDIF
        ENDIF

*** ZENITH DISTANCE, KIND = 9

      ELSEIF (KIND.EQ.9) THEN
        CALL COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,IAUX,ITIME)
        CALL VERDMS (OBS0,ID0,IM0,S0,ISGN)
        V = OBS0 - OBSB
        VSEC = V * RADSEC
        VSD = V / SD
        SD1 = SD*RADSEC
        VSD3 = DIVID(V,SD3)
        IF (IMODE.EQ.0 .OR. IMODE.EQ.3) GMDE = GMDE * RADSEC
        IF (IMODE.EQ.3) SD3 = SD3 * RADSEC
        IF (LSS) VSD = VSD / SIGUWT
        CALL VERDMS (OBSB,IDB,IMB,SB,ISGN)
        CALL MNTMD(ITIME, IYR,IMON,IDAY,IHR,IMN)
        IF (LVZ) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,211) IOBS,ID0,IM0,S0,GMDE,RN,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 211          FORMAT (' ',I5,' ZD',I4,I3,F6.2,' ',F11.2,F20.2,2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,212) IOBS,ID0,IM0,S0,IDB,IMB,SB,VSEC,SD3,VSD3,
     &                      RN,NAME2,
     &                      IMON,IDAY,IYR

 212          FORMAT (' ',I5,' ZD',I4,I3,F6.2,' ',I7,I3,F6.2,
     &                F10.2,F10.2,' SECOND',F8.2,F8.2,4X,A20,
     &        1X,I2,'/',I2,'/',I4)

            ELSE
              WRITE (6,21) IOBS,ID0,IM0,S0,IDB,IMB,SB,
     &                     VSEC,SD1,VSD,NAME1,NAME2,
     &                      IMON,IDAY,IYR

  21          FORMAT (' ',I5,' ZD',I4,I3,F6.2,I9,I3,F6.2,
     &                4X,F8.2,F8.2,' SECOND',F8.2, 2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ENDIF
          ENDIF
        ENDIF

*** HORIZONTAL ANGLE, KIND = 10

      ELSEIF (KIND.EQ.10) THEN
        CALL COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,IAUX,ITIME)
        CALL DIRDMS (OBS0,ID0,IM0,S0)
        V = OBS0 - OBSB
        IF (V.GT.PI) THEN
          V = V - TWOPI
        ELSEIF (V.LT.-PI) THEN
          V = V + TWOPI
        ENDIF
        VSEC = V * RADSEC
        VSD = V / SD
        SD1 = SD*RADSEC
        VSD3 = DIVID(V,SD3)
        IF (IMODE.EQ.0 .OR. IMODE.EQ.3) GMDE = GMDE * RADSEC
        IF (IMODE.EQ.3) SD3 = SD3 * RADSEC
        IF (LSS) VSD = VSD / SIGUWT
        CALL DIRDMS (OBSB,IDB,IMB,SB)
        CALL MNTMD(ITIME, IYR,IMON,IDAY,IHR,IMN)
        IF (LVA) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (2)
            IF (IMODE.EQ.0) THEN
              WRITE (6,231) IOBS,ID0,IM0,S0,GMDE,RN,NAME1,NAME2,NAME3,
     &                      IMON,IDAY,IYR

 231          FORMAT (' ',I5,' HA',I4,I3,F6.2,' ',F11.2,F20.2,2(1X,A30),
     &                /,T86,A20,
     &        1X,I2,'/',I2,'/',I4)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,232) IOBS,ID0,IM0,S0,IDB,IMB,SB,VSEC,SD3,VSD3,
     &                      RN,NAME2,NAME3,
     &                      IMON,IDAY,IYR

 232          FORMAT (' ',I5,' HA',I4,I3,F6.2,' ',I7,I3,F6.2,
     &                F10.2,F10.2,' SECOND',F8.2,F8.2,4X,A30,/,T96,A20,
     &        1X,I2,'/',I2,'/',I4)

            ELSE
              WRITE (6,23) IOBS,ID0,IM0,S0,IDB,IMB,SB,
     &                     VSEC,SD1,VSD,NAME1,NAME2,NAME3,
     &                      IMON,IDAY,IYR

 23           FORMAT (' ',I5,' HA',I4,I3,F6.2,' ',I8,I3,F6.2,
     &                4X,F8.2 ,F8.2 ,' SECOND',F8.2, 2(1X,A30),/,
     &                T102,A20,1X,I2,'/',I2,'/',I4)

            ENDIF
          ENDIF
        ENDIF

*** HORIZONTAL DIRECTION, KIND = 11

      ELSEIF (KIND.EQ.11) THEN
        CALL COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,IAUX,ITIME)
        CALL DIRDMS (OBS0,ID0,IM0,S0)
        V = OBS0 - OBSB
        IF (V.GT.PI) THEN
          V = V - TWOPI
        ELSEIF (V.LT.-PI) THEN
          V = V + TWOPI
        ENDIF
        VSEC = V * RADSEC
        VSD = V / SD
        SD1 = SD*RADSEC
        VSD3 = DIVID(V,SD3)
        IF (IMODE.EQ.0 .OR. IMODE.EQ.3) GMDE = GMDE * RADSEC
        IF (IMODE.EQ.3) SD3 = SD3 * RADSEC
        IF (LSS) VSD = VSD / SIGUWT
        CALL DIRDMS (OBSB,IDB,IMB,SB)
        CALL MNTMD(ITIME, IYR,IMON,IDAY,IHR,IMN)
        IF (LVR) THEN
          IF (DABS(VSD3).GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,251) IOBS,ID0,IM0,S0,GMDE,RN,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 251          FORMAT (' ',I5,' HD',I4,I3,F6.2,F12.2,F20.2, 2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,252) IOBS,ID0,IM0,S0,IDB,IMB,SB,VSEC,SD3,VSD3,
     &                      RN,NAME2,
     &                      IMON,IDAY,IYR

 252          FORMAT (' ',I5,' HD',I4,I3,F6.2,I8,I3,F6.2,
     &                F10.2,F10.2,' SECOND',F8.2,F8.2,4X,A20,
     &        1X,I2,'/',I2,'/',I4)

            ELSE
              WRITE (6,25) IOBS,ID0,IM0,S0,IDB,IMB,SB,
     &                     VSEC,SD1,VSD,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 25           FORMAT (' ',I5,' HD',I4,I3,F6.2,' ',I8,I3,F6.2,
     &                4X,F8.2,F8.2,' SECONDS',F8.2, 2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ENDIF
          ENDIF
        ENDIF

*** CONSTRAINED ASTRONOMIC AZIMUTH, KIND = 12

      ELSEIF (KIND.EQ.12) THEN
        CALL COMPOB (8,OBS0,B,OBSB,ISN,JSN,IAUX,ITIME)
        CALL DIRDMS (OBS0,ID0,IM0,S0)
        V = OBS0 - OBSB
        IF (V.GT.PI) THEN
          V = V - TWOPI
        ELSEIF (V.LT.-PI) THEN
          V = V + TWOPI
        ENDIF
        VSEC = V * RADSEC
        VSD = V / SD
        SD1 = SD* RADSEC
        VSD3 = DIVID(V,SD3)
        IF (IMODE.EQ.0 .OR. IMODE.EQ.3) GMDE = GMDE * RADSEC
        IF (IMODE.EQ.3) SD3 = SD3 * RADSEC
        IF (LSS) VSD = VSD / SIGUWT
        CALL DIRDMS (OBSB,IDB,IMB,SB)
        CALL MNTMD(ITIME, IYR,IMON,IDAY,IHR,IMN)
        IF (LVR) THEN
          IF (DABS(VSD3).GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,271) IOBS,ID0,IM0,S0,GMDE,RN,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 271          FORMAT (' ',I4,' CA',I4,I3,F6.2,'N',F11.2,F20.2,2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,272) IOBS,ID0,IM0,S0,IDB,IMB,SB,VSEC,SD3,VSD3,
     &                      RN,NAME2,
     &                      IMON,IDAY,IYR
 272          FORMAT (' ',I4,' CA',I4,I3,F6.2,'N',I7,I3,F6.2,
     &                'N',2X,F7.2,F9.2,' SECOND',F8.2,F8.2,4X,A20,
     &        1X,I2,'/',I2,'/',I4)

            ELSE
              WRITE (6,27) IOBS,ID0,IM0,S0,IDB,IMB,SB,
     &                     VSEC,SD1,VSD,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 27           FORMAT (' ',I4,' CA',I4,I3,F6.2,'N',I8,I3,F6.2,
     &                'N',3X,F7.2,F7.2,' SECOND',F8.2, 2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ENDIF
          ENDIF
        ENDIF

*** CONSTRAINED MARK TO MARK DISTANCE, KIND = 13

      ELSEIF (KIND.EQ.13) THEN
        CALL COMPOB (7,S,B,OBSB,ISN,JSN,IAUX,ITIME)
        V = S - OBSB
        VSD = V / SD
        VSD3 = DIVID(V,SD3)
        IF (LSS) VSD = VSD / SIGUWT
        CALL MNTMD(ITIME, IYR,IMON,IDAY,IHR,IMN)
        IF (LVS) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,291) IOBS,S,GMDE,RN,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 291          FORMAT (' ',I4,' CD',F15.4,F11.3,F19.2, 2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,292) IOBS,S,OBSB,V,SD3,VSD3,RN,NAME2,
     &                      IMON,IDAY,IYR

 292          FORMAT (' ',I4,' CD',F15.4,F17.4,F10.3,F8.3,' METER',
     &                F8.2,F6.2,4X,A20,
     &        1X,I2,'/',I2,'/',I4)

            ELSE
              WRITE (6,29) IOBS,S,OBSB,V,SD1,VSD,NAME1,NAME2,
     &                      IMON,IDAY,IYR

  29          FORMAT (' ',I4,' CD ',F14.4,F18.4,F11.4,F9.4,' METER',
     &                F8.2, 2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ENDIF
          ENDIF
        ENDIF

*** CONSTRAINED ZENITH DISTANCE, KIND = 14

      ELSEIF (KIND.EQ.14) THEN
        CALL COMPOB (9,OBS0,B,OBSB,ISN,JSN,IAUX,ITIME)
        CALL VERDMS (OBS0,ID0,IM0,S0,ISGN)
        V = OBS0 - OBSB
        VSEC = V * RADSEC
        VSD = V / SD
        SD1 = SD * RADSEC
        VSD3 = DIVID(V,SD3)
        IF (IMODE.EQ.0 .OR. IMODE.EQ.3) GMDE = GMDE * RADSEC
        IF (IMODE.EQ.3) SD3 = SD3 * RADSEC
        IF (LSS) VSD = VSD / SIGUWT
        CALL VERDMS (OBSB,IDB,IMB,SB,ISGN)
        CALL MNTMD(ITIME, IYR,IMON,IDAY,IHR,IMN)
        IF (LVZ) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,311) IOBS,ID0,IM0,S0,GMDE,RN,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 311          FORMAT (' ',I4,' CZ',I4,I3,F6.2,' ',F11.2,F20.2,2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,312) IOBS,ID0,IM0,S0,IDB,IMB,SB,VSEC,SD3,VSD3,
     &                      RN,NAME2,
     &                      IMON,IDAY,IYR

 312          FORMAT (' ',I4,' CZ',I4,I3,F6.2,' ',I7,I3,F6.2,
     &                3X,F7.2,F9.2,' SECOND',F8.2,F8.2,4X,A20,
     &        1X,I2,'/',I2,'/',I4)

            ELSE
              WRITE (6,31) IOBS,ID0,IM0,S0,IDB,IMB,SB,
     &                     VSEC,SD1,VSD,NAME1,NAME2,
     &                      IMON,IDAY,IYR

  31          FORMAT (' ',I4,' CZ',I4,I3,F6.2,I9,I3,F6.2,
     &                4X,F7.2,F7.2,' SECOND',F8.2, 2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ENDIF
          ENDIF
        ENDIF

*** CONSTRAINED GEOID HEIGHT DIFFERENCE, KIND = 15

      ELSEIF (KIND.EQ.15) THEN
        CALL COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,IAUX,ITIME)
        V = OBS0 - OBSB
        VSD = V / SD
        VSD3 = DIVID(V,SD3)
        IF (LSS) VSD = VSD / SIGUWT
        CALL MNTMD(ITIME, IYR,IMON,IDAY,IHR,IMN)
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,411) IOBS,OBS0,GMDE,RN,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 411          FORMAT (' ',I4,' DN',F15.4,F12.4,F18.2, 2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,412) IOBS,OBS0,OBSB,V,SD3,VSD3,RN,NAME2,
     &                      IMON,IDAY,IYR

 412          FORMAT (' ',I4,' DN',F15.4,F17.4,F10.3,F8.3,
     &                ' METER',F8.2,
     &                F6.2,4X,A25,
     &        1X,I2,'/',I2,'/',I4)

            ELSE
              WRITE (6,41) IOBS,OBS0,OBSB,V,SD,VSD,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 41           FORMAT (' ',I4,' DN',F14.3,F18.3,F10.3,F10.3,
     &                ' SECOND',F8.2,2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ENDIF
          ENDIF
        ENDIF

*** CONSTRAINED ORTHOMETRIC HEIGHT DIFFERENCE, KIND = 16

      ELSEIF (KIND.EQ.16) THEN
        CALL COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,IAUX,ITIME)
        V = OBS0 - OBSB
        VSD = V / SD
        VSD3 = DIVID(V,SD3)
        IF (LSS) VSD = VSD / SIGUWT
        CALL MNTMD(ITIME, IYR,IMON,IDAY,IHR,IMN)
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,451) IOBS,OBS0,GMDE,RN,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 451          FORMAT (' ',I4,' DO',F15.4,F12.4,F18.2, 2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,452) IOBS,OBS0,OBSB,V,SD3,VSD3,RN,NAME2,
     &                      IMON,IDAY,IYR

 452          FORMAT (' ',I4,' DO',F15.4,F17.4,F10.3,F8.2,' METER',
     &                F8.2,F6.2,4X,A20,
     &        1X,I2,'/',I2,'/',I4)

            ELSE
              WRITE (6,45) IOBS,OBS0,OBSB,V,SD,VSD,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 45           FORMAT (' ',I4,' DO',F14.3,F18.3,F10.3,F10.3,' METER',
     &                F8.2,2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ENDIF
          ENDIF
        ENDIF

*** CONSTRAINED ELLIPSOIDAL HEIGHT DIFFERENCE, KIND = 17

      ELSEIF (KIND.EQ.17) THEN
        CALL COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,IAUX,ITIME)
        V = OBS0 - OBSB
        VSD = V / SD
        VSD3 = DIVID(V,SD3)
        IF (LSS) VSD = VSD / SIGUWT
        CALL MNTMD(ITIME, IYR,IMON,IDAY,IHR,IMN)
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,491) IOBS,OBS0,GMDE,RN,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 491          FORMAT (' ',I4,' DE',F15.4,F12.4,F18.2, 2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,492) IOBS,OBS0,OBSB,V,SD3,VSD3,RN,NAME2,
     &                      IMON,IDAY,IYR

 492          FORMAT (' ',I4,' DE',F15.4,F17.4,F10.3,F8.2,' METER',
     &                F8.2,F6.2,4X,A20,
     &        1X,I2,'/',I2,'/',I4)

            ELSE
              WRITE (6,49) IOBS,OBS0,OBSB,V,SD,VSD,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 49           FORMAT (' ',I4,' DE',F14.3,F18.3,F10.3,F10.3,' METER',
     &                F8.2,2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ENDIF
          ENDIF
        ENDIF

*** CONSTRAINED MINIMAL DISTANCE PERP. TO A FAULT, KIND = 18

      ELSEIF (KIND.EQ.18) THEN
        CALL COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,IAUX,ITIME)
        V = OBS0 - OBSB
        VSD = V / SD
        VSD3 = DIVID(V,SD3)
        IF (LSS) VSD = VSD / SIGUWT
        CALL MNTMD(ITIME, IYR,IMON,IDAY,IHR,IMN)
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,511) IOBS,OBS0,GMDE,RN,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 511          FORMAT (' ',I4,' CM',F15.4,F12.4,F18.2, 2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,512) IOBS,OBS0,OBSB,V,SD3,VSD3,GMDE,RN,NAME2,
     &                      IMON,IDAY,IYR

 512          FORMAT (' ',I4,' CM',F15.4,F17.4,F19.3,F8.2,F8.2,
     &                F10.4,F6.2,4X,A20,
     &        1X,I2,'/',I2,'/',I4)

            ELSE
              WRITE (6,51) IOBS,OBS0,OBSB,V,VSD,NAME1,NAME2,
     &                      IMON,IDAY,IYR

 51           FORMAT (' ',I4,' CM',F14.3,F18.3,F21.3,F8.1,
     &                2(1X,A25),
     &        1X,I2,'/',I2,'/',I4)

            ENDIF
          ENDIF
        ENDIF

*** CONSTRAINT ON NORTHWARD VELOCITY, KIND = 19

      ELSEIF (KIND.EQ.19) THEN
        CALL GRDPOS(C(6),C(5),I,J)
        CALL GRDWEI(C(6),C(5),I,J,WEI)
        CALL GRDVEC(I,J,VEL,B)
        CALL RADCUR(C(5),RMER,RPV)
        OBS0 = (WEI(1,1) * VEL(1,1,1)
     &        + WEI(2,1) * VEL(2,1,1)
     &        + WEI(1,2) * VEL(1,2,1)
     &        + WEI(2,2) * VEL(2,2,1)) * RADSEC
        OBS0 = OBS0 * (RMER/RADSEC) * 1000.D0
        OBSB = OBSB * (RMER/RADSEC) * 1000.D0
        SD = SD * (RMER/RADSEC) * 1000.D0
        SD3 = SD3 * (RMER/RADSEC) * 1000.D0
        V = OBS0 - OBSB
        VSD = V / SD
        VSD3 = DIVID(V,SD3)

        CALL GETDMS (C(5),ID01,IM01,S01,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR1 = 'N'
        ELSE
          ADIR1 = 'S'
        ENDIF
        CALL GETDMS (C(6),ID02,IM02,S02,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR2 = 'E'
        ELSE
          ADIR2 = 'W'
        ENDIF
        IF (LSS) VSD = VSD / SIGUWT
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,521) IOBS,OBS0,GMDE,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2


 521          FORMAT (' ',I4,' PV-N',F13.4,F12.4,F18.2,
     &                2(I3,I3.2,1X,F5.2,A1,1X))

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,522) IOBS,OBS0,OBSB,V,SD3,VSD3,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2

 522          FORMAT (' ',I4,' PV-N',F13.3,F17.3,F10.3,F8.3,' MM/YR',
     &                F8.2,F6.2,4X, 2(I3,I3.2,1X,F5.2,A1,1X))

            ELSE
              WRITE (6,52) IOBS,OBS0,OBSB,V,SD,VSD,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2

 52           FORMAT (' ',I4,' PV-N',F12.3,F18.3,F10.3,F10.3,' MM/YR',
     &                 F8.2,2(I3,I3.2,1X,F5.2,A1,1X))

            ENDIF
          ENDIF
        ENDIF

*** CONSTRAINT ON EASTWARD VELOCITY, KIND 20

      ELSEIF (KIND.EQ.20) THEN
        CALL GRDPOS(C(6),C(5),I,J)
        CALL GRDWEI(C(6),C(5),I,J,WEI)
        CALL GRDVEC(I,J,VEL,B)
        CALL RADCUR(C(5),RMER,RPV)
        RPAR = RPV * DCOS(C(5))
        OBS0 = (WEI(1,1) * VEL(1,1,2)
     &        + WEI(2,1) * VEL(2,1,2)
     &        + WEI(1,2) * VEL(1,2,2)
     &        + WEI(2,2) * VEL(2,2,2)) * RADSEC
        OBS0 = OBS0 * (RPAR/RADSEC) * 1000.D0
        OBSB = OBSB * (RPAR/RADSEC) * 1000.D0
        SD = SD * (RPAR/RADSEC) * 1000.D0
        SD3 = SD3 * (RPAR/RADSEC) * 1000.D0
        V = OBS0 - OBSB
        VSD = DIVID(V,SD)
        VSD3 = DIVID(V,SD3)
        CALL GETDMS (C(5),ID01,IM01,S01,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR1 = 'N'
        ELSE
          ADIR1 = 'S'
        ENDIF
        CALL GETDMS (C(6),ID02,IM02,S02,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR2 = 'E'
        ELSE
          ADIR2 = 'W'
        ENDIF

        IF (LSS) VSD = VSD / SIGUWT
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,531) IOBS,OBS0,GMDE,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2 

 531          FORMAT (' ',I4,' PV-E',F13.3,F12.3,F10.3,
     &                 2(I3,I3.2,1X,F5.2,A1,1X))

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,532) IOBS,OBS0,OBSB,V,SD3,VSD3,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2

 532          FORMAT (' ',I4,' PV-E',F13.3,F17.3,F10.3,F8.3,' MM/YR',
     &                F8.2,F6.2,4X,2(I3,I3.2,1X,F5.2,A1,1X))

            ELSE
              WRITE (6,53) IOBS,OBS0,OBSB,V,SD,VSD,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2

 53           FORMAT (' ',I4,' PV-E',F12.3,F18.3,F10.3,F10.3,' MM/YR',
     &                F8.2,2(I3,I3.2,1X,F5.2,A1,1X))

            ENDIF
          ENDIF
        ENDIF

*** CONSTRAINT ON UPWARD VELOCITY, KIND 21
      ELSEIF (KIND.EQ.21) THEN

        CALL GRDPOS(C(6),C(5),I,J)
        CALL GRDWEI(C(6),C(5),I,J,WEI)
        CALL GRDVEC(I,J,VEL,B)
        OBS0 = (WEI(1,1) * VEL(1,1,3)
     &        + WEI(2,1) * VEL(2,1,3)
     &        + WEI(1,2) * VEL(1,2,3)
     &        + WEI(2,2) * VEL(2,2,3))
        OBS0 = OBS0 * 1000.D0 
        OBSB = OBSB * 1000.D0
        SD = SD * 1000.D0
        SD3 = SD3 * 1000.D0
        V = OBS0 - OBSB
        VSD = DIVID(V,SD)
        VSD3 = DIVID(V,SD3)
        CALL GETDMS (C(5),ID01,IM01,S01,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR1 = 'N'
        ELSE
          ADIR1 = 'S'
        ENDIF
        CALL GETDMS (C(6),ID02,IM02,S02,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR2 = 'E'
        ELSE
          ADIR2 = 'W'
        ENDIF

        IF (LSS) VSD = VSD / SIGUWT
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,541) IOBS,OBS0,GMDE,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2

 541          FORMAT (' ',I4,' PV-U',F13.4,F12.4,F18.2,1X,
     &                2(I3,I3.2,1X,F5.2,A1,1X))

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,542) IOBS,OBS0,OBSB,V,SD3,VSD3,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2

 542          FORMAT (' ',I4,' PV-U',F13.3,F17.3,F10.3,F8.3,' MM/YR',
     &                F8.2,F6.2,4X,2(I3,I3.2,1X,F5.2,A1,1X))

            ELSE
              WRITE (6,54) IOBS,OBS0,OBSB,V,SD,VSD,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2

 54           FORMAT (' ',I4,' PV-U',F12.3,F18.3,F10.3,F10.3,
     &                ' MM/YR',F8.2,1X,2(I3,I3.2,1X,F5.2,A1,1X))

            ENDIF
          ENDIF
        ENDIF



*** CONSTRAINT ON NORTHWARD VELOCITY, SMOOTHING ON GRID, KIND = 22

      ELSEIF (KIND.EQ.22) THEN
         
        CALL COMPSM(KIND,OBS0,LENG,C,IC,B)

        CALL GRDLOC(ISN,JSN,GLON,GLAT)
        V = OBS0 - OBSB
        VSD = DIVID(V,SD)
        VSD3 = DIVID(V,SD3)

        CALL GETDMS (GLAT,ID01,IM01,S01,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR1 = 'N'
        ELSE
          ADIR1 = 'S'
        ENDIF
        CALL GETDMS (GLON,ID02,IM02,S02,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR2 = 'E'
        ELSE
          ADIR2 = 'W'
        ENDIF

        IF (LSS) VSD = VSD / SIGUWT
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,621) IOBS,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2


 621          FORMAT (' ',I5,' SM-N',25X,F18.2,
     &                2(I3,I3.2,1X,F5.2,A1,1X))

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,622) IOBS,VSD3,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2

 622          FORMAT (' ',I5,' SM-N',53X,F8.2,
     &                F6.2,4X, 2(I3,I3.2,1X,F5.2,A1,1X))

            ELSE
              WRITE (6,62) IOBS,VSD,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2

 62           FORMAT (' ',I5,' SM-N',51X,F8.2,
     &                 2(I3,I3.2,1X,F5.2,A1,1X))

            ENDIF
          ENDIF
        ENDIF

*** CONSTRAINT ON EASTWARD VELOCITY, SMOOTHING ON GRID, KIND 23

      ELSEIF (KIND.EQ.23) THEN

        CALL GRDLOC(ISN,JSN,GLON,GLAT)

        CALL COMPSM(KIND,OBS0,LENG,C,IC,B)

        V = OBS0 - OBSB
        VSD = DIVID (V,SD)
        VSD3 = DIVID(V,SD3)

        CALL GETDMS (GLAT,ID01,IM01,S01,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR1 = 'N'
        ELSE
          ADIR1 = 'S'
        ENDIF
        CALL GETDMS (GLON,ID02,IM02,S02,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR2 = 'E'
        ELSE
          ADIR2 = 'W'
        ENDIF

        IF (LSS) VSD = VSD / SIGUWT
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,631) IOBS,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2


 631          FORMAT (' ',I5,' SM-E',25X,F18.2,
     &                2(I3,I3.2,1X,F5.2,A1,1X))

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,632) IOBS,VSD3,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2

 632          FORMAT (' ',I5,' SM-E',53X,F8.2,
     &                F6.2,4X, 2(I3,I3.2,1X,F5.2,A1,1X))

            ELSE
              WRITE (6,63) IOBS,VSD,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2

 63           FORMAT (' ',I5,' SM-E',51X,F8.2,
     &                 2(I3,I3.2,1X,F5.2,A1,1X))

            ENDIF
          ENDIF
        ENDIF


*** CONSTRAINT ON UPWARD VELOCITY, SMOOTHING ON GRID, KIND 24
      ELSEIF (KIND.EQ.24) THEN

        CALL GRDLOC(ISN,JSN,GLON,GLAT)

        CALL COMPSM(KIND,OBS0,LENG,C,IC,B)

        V = OBS0 - OBSB
        VSD = DIVID(V,SD)
        VSD3 = DIVID(V,SD3)

        CALL GETDMS (GLAT,ID01,IM01,S01,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR1 = 'N'
        ELSE
          ADIR1 = 'S'
        ENDIF
        CALL GETDMS (GLON,ID02,IM02,S02,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR2 = 'E'
        ELSE
          ADIR2 = 'W'
        ENDIF

        IF (LSS) VSD = VSD / SIGUWT
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,641) IOBS,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2


 641          FORMAT (' ',I5,' SM-U',25X,F18.2,
     &                2(I3,I3.2,1X,F5.2,A1,1X))

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,642) IOBS,VSD3,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2

 642          FORMAT (' ',I5,' SM-U',53X,F8.2,
     &                F6.2,4X, 2(I3,I3.2,1X,F5.2,A1,1X))

            ELSE
              WRITE (6,64) IOBS,VSD,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2

 64           FORMAT (' ',I5,' SM-U',51X,F8.2,
     &                 2(I3,I3.2,1X,F5.2,A1,1X))

            ENDIF
          ENDIF
        ENDIF

*** CONSTRAINT ON NORTHWARD VELOCITY, KIND = 25

      ELSEIF (KIND.EQ.25) THEN
        CALL GRDPOS(C(6),C(5),I,J)
        CALL GRDWEI(C(6),C(5),I,J,WEI)
        CALL GRDVEC(I,J,VEL,B)
        CALL RADCUR(C(5),RMER,RPV)
        OBS0 = (WEI(1,1) * VEL(1,1,1)
     &        + WEI(2,1) * VEL(2,1,1)
     &        + WEI(1,2) * VEL(1,2,1)
     &        + WEI(2,2) * VEL(2,2,1)) * RADSEC
        OBS0 = OBS0 * (RMER/RADSEC) * 1000.D0
        OBSB = OBSB * (RMER/RADSEC) * 1000.D0
        SD = SD * (RMER/RADSEC) * 1000.D0
        SD3 = SD3 * (RMER/RADSEC) * 1000.D0
        V = OBS0 - OBSB
        VSD = V / SD
        VSD3 = DIVID(V,SD3)

        CALL GETDMS (C(5),ID01,IM01,S01,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR1 = 'N'
        ELSE
          ADIR1 = 'S'
        ENDIF
        CALL GETDMS (C(6),ID02,IM02,S02,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR2 = 'E'
        ELSE
          ADIR2 = 'W'
        ENDIF
        IF (LSS) VSD = VSD / SIGUWT
        NAME1 = NAMES(ISN)
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,721) IOBS,OBS0,GMDE,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2,
     &                      NAME1         


 721          FORMAT (' ',I4,' SV-N',F13.3,F12.3,F18.2,
     &                2(I3,I3.2,1X,F5.2,A1,1X),A30)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,722) IOBS,OBS0,OBSB,V,SD3,VSD3,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2,NAME1

 722          FORMAT (' ',I4,' SV-N',F13.3,F17.3,F10.3,F10.3,' MM/YR',
     &                F8.2,F6.2,4X, 2(I3,I3.2,1X,F5.2,A1,1X),A30)

            ELSE
              WRITE (6,723) IOBS,OBS0,OBSB,V,SD,VSD,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2,NAME1

 723          FORMAT (' ',I4,' SV-N',F12.3,F18.3,F10.3,F10.3,' MM/YR',
     &                 F8.2,2(I3,I3.2,1X,F5.2,A1,1X),A30)

            ENDIF
          ENDIF
        ENDIF

*** CONSTRAINT ON EASTWARD VELOCITY, KIND = 26

      ELSEIF (KIND.EQ.26) THEN
        CALL GRDPOS(C(6),C(5),I,J)
        CALL GRDWEI(C(6),C(5),I,J,WEI)
        CALL GRDVEC(I,J,VEL,B)
        CALL RADCUR(C(5),RMER,RPV)
        RPAR = RPV * DCOS(C(5))
        OBS0 = (WEI(1,1) * VEL(1,1,2)
     &        + WEI(2,1) * VEL(2,1,2)
     &        + WEI(1,2) * VEL(1,2,2)
     &        + WEI(2,2) * VEL(2,2,2)) * RADSEC
        OBS0 = OBS0 * (RPAR/RADSEC) * 1000.D0
        OBSB = OBSB * (RPAR/RADSEC) * 1000.D0
        SD = SD * (RPAR/RADSEC) * 1000.D0
        SD3 = SD3 * (RPAR/RADSEC) * 1000.D0
        V = OBS0 - OBSB
        VSD = DIVID(V,SD)
        VSD3 = DIVID(V,SD3)
        CALL GETDMS (C(5),ID01,IM01,S01,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR1 = 'N'
        ELSE
          ADIR1 = 'S'
        ENDIF
        CALL GETDMS (C(6),ID02,IM02,S02,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR2 = 'E'
        ELSE
          ADIR2 = 'W'
        ENDIF

        IF (LSS) VSD = VSD / SIGUWT
        NAME1 = NAMES(ISN)                      
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,731) IOBS,OBS0,GMDE,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2,NAME1

 731          FORMAT (' ',I4,' SV-E',F13.4,F12.4,F18.2,
     &                 2(I3,I3.2,1X,F5.2,A1,1X),A30)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,732) IOBS,OBS0,OBSB,V,SD3,VSD3,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2,NAME1

 732          FORMAT (' ',I4,' SV-E',F13.3,F17.3,F10.3,F10.3,' MM/YR',
     &                F8.2,F6.2,4X,2(I3,I3.2,1X,F5.2,A1,1X),A30)

            ELSE
              WRITE (6,733) IOBS,OBS0,OBSB,V,SD,VSD,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2, NAME1

 733          FORMAT (' ',I4,' SV-E',F12.3,F18.3,F10.3,F10.3,
     &                ' MM/YR',F8.2,2(I3,I3.2,1X,F5.2,A1,1X),A30)

            ENDIF
          ENDIF
        ENDIF

*** CONSTRAINT ON UPWARD VELOCITY, KIND =27
      ELSEIF (KIND.EQ.27) THEN

        CALL GRDPOS(C(6),C(5),I,J)
        CALL GRDWEI(C(6),C(5),I,J,WEI)
        CALL GRDVEC(I,J,VEL,B)
        OBS0 = (WEI(1,1) * VEL(1,1,3)
     &        + WEI(2,1) * VEL(2,1,3)
     &        + WEI(1,2) * VEL(1,2,3)
     &        + WEI(2,2) * VEL(2,2,3))
        OBS0 = OBS0 * 1000.D0 
        OBSB = OBSB * 1000.D0
        SD = SD * 1000.D0
        SD3 = SD3 * 1000.D0
        V = OBS0 - OBSB
        VSD = DIVID(V,SD)
        VSD3 = DIVID(V,SD3)
        CALL GETDMS (C(5),ID01,IM01,S01,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR1 = 'N'
        ELSE
          ADIR1 = 'S'
        ENDIF
        CALL GETDMS (C(6),ID02,IM02,S02,ISIGN)
        IF (ISIGN.GT.0) THEN
          ADIR2 = 'E'
        ELSE
          ADIR2 = 'W'
        ENDIF

        IF (LSS) VSD = VSD / SIGUWT
        NAME1 = NAMES(ISN)                      
        IF (LVC) THEN
          IF ( DABS(VSD3) .GE.CRIT) THEN
            CALL LINE2 (1)
            IF (IMODE.EQ.0) THEN
              WRITE (6,741) IOBS,OBS0,GMDE,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2,NAME1

 741          FORMAT (' ',I4,' SV-U',F13.4,F12.4,F18.2,1X,
     &                2(I3,I3.2,1X,F5.2,A1,1X),A30)

            ELSEIF (IMODE.EQ.3) THEN
              WRITE (6,742) IOBS,OBS0,OBSB,V,SD3,VSD3,RN,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2,NAME1

 742          FORMAT (' ',I4,' SV-U',F13.3,F17.3,F10.3,F10.3,' MM/YR',
     &                F8.2,F6.2,4X,2(I3,I3.2,1X,F5.2,A1,1X),A30)

            ELSE
              WRITE (6,743) IOBS,OBS0,OBSB,V,SD,VSD,
     &                      ID01, IM01, S01, ADIR1,
     &                      ID02, IM02, S02, ADIR2,NAME1

 743          FORMAT (' ',I4,' SV-U',F12.3,F18.3,F10.3,F10.3,
     &                ' MM/YR',F8.2,1X,2(I3,I3.2,1X,F5.2,A1,1X),A30)

            ENDIF
          ENDIF
        ENDIF

*** OBSERVATION of D(X2-X1)/DT OR D(Y2-Y1)/DT OR D(Z2-Z1)/DT
      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)

         ITYPE = KIND - 27
         CALL FORMCT(ITYPE,R1,WEI1,VEL1,R2,WEI2,VEL2,C,OBS0)
         V = OBS0 - OBSB
         VSD = V/SD
         VSD3 = DIVID(V,SD3)
         IF(LSS) VSD = VSD/SIGUWT
         IF(LVS) THEN
            IF( DABS(VSD3) .GE. CRIT) THEN
              CALL LINE2(1)
              IF(IMODE.EQ.0) THEN
                WRITE(6,751)IOBS,CT(ITYPE),OBS0,GMDE,RN,NAME1,NAME2
  751           FORMAT(' ',I4,A5,F13.4,F11.4,F19.2, 2(1X,A25))
              ELSEIF( IMODE .EQ. 3) THEN
                WRITE(6,752) IOBS,CT(ITYPE),OBS0,OBSB,V,SD3,VSD3,
     &                       RN,NAME2
  752           FORMAT(' ',I4,A5,F13.4,F17.4,F10.4,F8.4,' M/YR',F8.2,
     &                 F6.2,4x,A20)
              ELSE
                WRITE(6,753) IOBS,CT(ITYPE),OBS0,OBSB,V,SD,VSD,
     &                       NAME1,NAME2
  753           FORMAT(' ',I4,A5,F12.4,F18.4,F10.4,,F10.4,' M/YR',
     &                  F8.2,2(1X,A25))
              ENDIF
           ENDIF
        ENDIF

*** OBSERVATION OF DL/DT

      ELSEIF (KIND .EQ. 31) THEN
        CALL FORMLT(ISN,JSN,B,C,OBS0)
        V = OBS0 - OBSB
        VSD = V/SD
        VSD3 = DIVID(V,SD3)
        IF(LSS) VSD = VSD/SIGUWT
        IF(LVS) THEN
           IF( DABS(VSD3) .GE. CRIT) THEN
             CALL LINE2(1)
             ITYPE = 4
             IF(IMODE .EQ. 0) THEN
               WRITE(6,751)IOBS,CT(ITYPE),OBS0,GMDE,RN,NAME1,NAME2
             ELSEIF (IMODE .EQ. 3) THEN
               WRITE(6,752)IOBS,CT(ITYPE),OBS0,OBSB,V,SD3,VSD3,
     &             RN,NAME2
             ELSE
               WRITE(6,753)IOBS,CT(ITYPE),OBS0,OBSB,V,SD,VSD,
     &                     NAME1,NAME2
             ENDIF
           ENDIF
        ENDIF

*** ILLEGAL KIND

      ELSE
        WRITE (6,667) KIND
  667   FORMAT ('0ERROR - ILLEGAL KIND IN ROBS--',I5)
        CALL ABORT2
      ENDIF

*** ACCUMULATE STATISTICS

      IF (LSS) VSD = VSD * SIGUWT
      CALL RSTAT (VSD,RN,VSD3,IOBS,KIND)

      RETURN
      END

      SUBROUTINE RSTAT (VSD,RN,VSD3,IOBS,KIND)

*** ACCUMULATE RESIDUAL STATISTICS

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

*** ACCUMULATE NO-CHECK

      IF (IMODE.EQ.0 .OR. IMODE.EQ.3) THEN
        IF (RN.LT.1.0D-5 .AND. (KIND.LT.4 .AND. KIND.GT.6) ) N0 = N0 + 1
      ELSE
        IF (V.EQ. 0.D0 ) N0 = N0 + 1
      ENDIF

      VSD2 = VSD * VSD
 
      IF(KIND .EQ. 0) THEN
         K = 32
      ELSE
         K = KIND
      ENDIF

*** ACCUMULATE BY KIND

      NUM(K) = NUM(K) + 1
      VPV(K) = VPV(K) + VSD2
      IF (IMODE.EQ.0 .OR. IMODE.EQ.3) RNUM(K) = RNUM(K) + RN

*** ACCUMULATE 20 LARGEST

      IF (IMODE.NE.3) THEN
        CALL ACUM20 (IOBS,VSD)
      ELSE
        CALL ACUM20 (IOBS,VSD3)
      ENDIF

      RETURN
      END
      SUBROUTINE ACUM20 (IOBS,VSD)

*** ACCUMULATE A LARGE RESIDUAL

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /TOP20/ VSD20(20),I20(20),NI20
*** DEAL ONLY WITH ABSOLUTE VALUES .GT. SMALLEST

      V = DABS(VSD)
      IF ( V.LE. VSD20(20) ) RETURN

*** POINT TO NEW ARRAY LOCATION

      IP = IPOINT(V)

*** SHIFT ARRAY CONTENTS AND LOAD ARRAYS

      CALL VSHIFT(IP,IOBS,V)

      RETURN
      END
      INTEGER FUNCTION IPOINT (V)

*** LOCATE NEW POSITON IN THE MAX V ARRAY

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /TOP20/ VSD20(20),I20(20),NI20
*** FIND NEW POSITION (CHECK MAX VALUES FIRST)

      DO 1 I = 1,20
        IPOINT = I
        IF ( V.GT. VSD20(I) ) RETURN
    1 CONTINUE

*** FALL THRU LOOP--NOT A MAXIMAL RESIDUAL

      IPOINT = 21

      RETURN
      END

      SUBROUTINE VSHIFT (IP,IOBS,V)

*** SHIFT ARRAY CONTENTS AND LOAD ARRAYS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      COMMON /TOP20/ VSD20(20),I20(20),NI20
*** PROTECT AGAINST ILLEGAL VALUES

      IF (IP.LE.0 .OR. IP.GE.21) RETURN

*** SHIFT ARRAY CONTENTS

      IF (IP.LT.20) THEN
        DO 1 I = 19,IP,-1
          VSD20(I+1) = VSD20(I)
          I20(I+1) = I20(I)
    1   CONTINUE
      ENDIF

*** LOAD THE SHIFTED ARRAY

      VSD20(IP) = V
      I20(IP) = IOBS
      IF (NI20.LT.20) NI20 = NI20 + 1

      RETURN
      END
      SUBROUTINE RSOUT (SIGUWT)

*** LIST RESIDUAL STATISTICS

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
      LOGICAL LMSL,LSS,LUP
      DIMENSION VAR(32)
      COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD
      COMMON /RESTAT/ VPV(32),RNUM(32),NUM(32),N0                   
      COMMON /TOP20/ VSD20(20),I20(20),NI20
      COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI
      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

*** CORRECTION TO GPS REDUNDANCY NUMBERS IF REJECTIONS EXIST

      IF (NGPSR.GT.0) THEN
        RNUM(4) = RNUM(4) - NGPSR
        RNUM(5) = RNUM(5) - NGPSR
        RNUM(6) = RNUM(6) - NGPSR
      ENDIF

*** COMPLETE COMPUTATION OF STATS

      IDOF = NOBS + NCON - NUNK
      N = 0                                           
      RN = 0.D0                                               
      VPVTOT = 0.D0                                                   
      DO 1 I = 1,32
         N = N + NUM(I)
         RN = RN + RNUM(I)
         VPVTOT = VPVTOT + VPV(I)
         IF (IMODE .EQ. 3) THEN
            VAR(I) = DIVID(VPV(I),RNUM(I))
         ELSE
            VAR(I) = DIVIDE(VPV(I),NUM(I))
         ENDIF
    1 CONTINUE
 
      IF(IMODE .EQ. 3) THEN
          VARTOT = DIVID(VPVTOT,RN)
      ELSE
          VARTOT = DIVIDE(VPVTOT,IDOF)
      ENDIF

*** HEADING

      CALL HEAD
      CALL LINE (3)
      WRITE (6,1001)
 1001 FORMAT ('0RESIDUAL STATISTICS',/)

*** MAXIMUM RESIDUALS

      IF (IMODE.NE.0) THEN
        CALL LINE (2)
        IF (IMODE.NE.3) THEN
          WRITE (6,2) NI20
    2     FORMAT (' OBSERVATION NUMBERS OF ',I2,' GREATEST',
     &            ' QUASI-NORMALIZED RESIDUALS (V/SD)',/)
        ELSE
          WRITE (6,21) NI20
 21       FORMAT (' OBSERVATION NUMBERS OF ',I2,' GREATEST',
     &            ' STANDARDIZED RESIDUALS (V/SD)',/)
        ENDIF
        CALL LINE (2)
        WRITE (6,3) (I20(I),I = 1,NI20)
    3   FORMAT (1X,20I6,/)

*** STATS

          WRITE (6,5) (NUM(I),VPV(I),RNUM(I),VAR(I),I=1,16)
    5     FORMAT (20X,'N',T28,'VTPV',T38,'RN ',T44,'VTPV/RN',/,
     &            '  1 LAT CNSTR  ',I6,F10.1,F9.2,F11.3,/,
     &            '  2 LON CNSTR  ',I6,F10.1,F9.2,F11.3,/,
     &            '  3 HT  CNSTR  ',I6,F10.1,F9.2,F11.3,/,
     &            '  4 DELTA X    ',I6,F10.1,F9.2,F11.3,/,
     &            '  5 DELTA Y    ',I6,F10.1,F9.2,F11.3,/,
     &            '  6 DELTA Z    ',I6,F10.1,F9.2,F11.3,/,
     &            '  7 DISTANCE   ',I6,F10.1,F9.2,F11.3,/,
     &            '  8 AZIMUTH    ',I6,F10.1,F9.2,F11.3,/,
     &            '  9 ZEN DIST   ',I6,F10.1,F9.2,F11.3,/,
     &            ' 10 H ANGLE    ',I6,F10.1,F9.2,F11.3,/,
     &            ' 11 DIRECTION  ',I6,F10.1,F9.2,F11.3,/,
     &            ' 12 CNSTR AZ   ',I6,F10.1,F9.2,F11.3,/,
     &            ' 13 CNSTR DIST ',I6,F10.1,F9.2,F11.3,/,
     &            ' 14 CNSTR Z-D  ',I6,F10.1,F9.2,F11.3,/,
     &            ' 15 CNSTR G-HT ',I6,F10.1,F9.2,F11.3,/,
     &            ' 16 CNSTR O-HT ',I6,F10.1,F9.2,F11.3,)
          WRITE(6,1006) (NUM(I),VPV(I),RNUM(I),VAR(I),I=17,32),
     &               N,VPVTOT,RN,VARTOT
 1006     FORMAT( ' 17 CNSTR E-HT ',I6,F10.1,F9.2,F11.3,/,
     &            ' 18 NOT USED   ',I6,F10.1,F9.2,F11.3,/,
     &            ' 19 PT VEL: N  ',I6,F10.1,F9.2,F11.3,/,
     &            ' 20 PT VEL: E  ',I6,F10.1,F9.2,F11.3,/,
     &            ' 21 PT VEL: U  ',I6,F10.1,F9.2,F11.3,/,
     &            ' 22 SM CNSTR N ',I6,F10.1,F9.2,F11.3,/,
     &            ' 23 SM CNSTR E ',I6,F10.1,F9.2,F11.3,/,
     &            ' 24 SM CNSTR U ',I6,F10.1,F9.2,F11.3,/,
     &            ' 25 SITE VEL N ',I6,F10.1,F9.2,F11.3,/,
     &            ' 26 SITE VEL E ',I6,F10.1,F9.2,F11.3,/,
     &            ' 27 SITE VEL U ',I6,F10.1,F9.2,F11.3,/,
     &            ' 28 DX/DT      ',I6,F10.1,F9.2,F11.3,/,
     &            ' 29 DY/DT      ',I6,F10.1,F9.2,F11.3,/,
     &            ' 30 DZ/DT      ',I6,F10.1,F9.2,F11.3,/,
     &            ' 31 DL/DT      ',I6,F10.1,F9.2,F11.3,/,
     &            '  0 AUX PARAM  ',I6,F10.1,F9.2,F11.3,/,
     &            '    TOTAL      ',I6,F10.1,F9.2,F11.3,/)


*** COMPUTE VARIANCES

        SUMPVV = VPVTOT
        VARUWT = DIVIDE(SUMPVV,IDOF)
        SIGUWT = DSQRT(VARUWT)

*** PRINT VARIANCE OF UNIT WEIGHT

        WRITE (6,6) IDOF,SUMPVV,SIGUWT,VARUWT
    6   FORMAT ('0DEGREES OF FREEDOM      =',I17,/,
     &          ' VARIANCE SUM            =',F19.1,/,
     &          ' STD.DEV.OF UNIT WEIGHT  =',F20.2,/,
     &          ' VARIANCE OF UNIT WEIGHT =',F20.2)
        IF ( SIGUWT.LT. 0.01D0 .AND. LSS ) THEN
          LSS = .FALSE.
          CALL LINE (2)
          WRITE (6,23)
 23       FORMAT ('0***** WARNING - WILL NOT SCALE BY THE STANDARD',
     &            ' DEV. OF UNIT WEIGHT DUE TO ITS LOW VALUE *****')
        ENDIF
      ELSE

*** EXTREMA

        CALL LINE (2)
        WRITE (6,13) N,N0
 13     FORMAT ('     TOTAL=',I5,T33,'NO-CHECK=',I3)
      ENDIF

      RETURN
      END
