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