SUBROUTINE SPRQPW(QDATA,QGES,QTYPE,NQDTA,NQRECS,
     *  PWDATA,PWGES,PWTYPE,NPWDTA,NPWRECS,
     *  NLAT,NLON,NSIG,QFILE,PWFILE,ERMAXPW,ERMINPW,GROSSPW,
     *  ERMAXQ,ERMINQ,GROSSQ,RBQS)
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    SPRQ        STORE INFOR. FOR Q AND P.W. OBS.
C   PRGMMR: PARRISH          ORG: W/NMC22    DATE: 90-10-12
C
C ABSTRACT: STORE INFORMATION FOR Q AND P.W. OBS.
C
C PROGRAM HISTORY LOG:
C   90-10-12  PARRISH
C
C   INPUT ARGUMENT LIST:
C     QDATA    - OBS INFO AT OBS LOCATIONS - Q
C     QGES     - GUESS VALUES FOR OBSERVATIONS - Q
C     QTYPE    - OBSERVATION TYPES - Q
C     NQDTA    - NUMBER OF OBS - Q
C     PWDATA   - OBS INFO AT OBS LOCATIONS - P.W.
C     PWGES    - GUESS VALUES FOR OBSERVATIONS - P.W.
C     PWTYPE   - OBSERVATION TYPES - P.W.
C     NPWDTA   - NUMBER OF OBS - P.W.
C     NLAT     - NUMBER OF LATITUDES ON GAUSSIAN GRID
C     NLON     - NUMBER OF LONGITUDES ON GAUSSIAN GRID
C     NSIG     - NUMBER OF LAYERS ON GAUSSIAN GRID
C     NBLK     - BLOCKING FACTOR FOR OUTPUT FILE CONTAINING DATA
C     IUNIT    - UNIT NUMBER FOR OUTPUT FILE CONTAINING DATA
C     ERMAXPW,ERMINPW,GROSSPW - PARAMETERS FOR GROSS CHECK OF P.W. OBS
C     ERMAXQ,ERMINQ,GROSSQ - PARAMETERS FOR GROSS CHECK OF Q OBS
C     RBQS     - GUESS SATURATION SPEC. HUM.
C
C   OUTPUT ARGUMENT LIST:
C     NQRECS   - NUMBER OF RECORDS FOR Q DATA
C     NPWRECS  - NUMBER OF RECORDS FOR P.W. DATA
C
C ATTRIBUTES:
C   LANGUAGE: CFT77
C   MACHINE:  CRAY YMP
C
C$$$
C
C-CRA          DIMENSION PWDATA(NPWDTA,5)
C-CRA          DIMENSION PWGES(NPWDTA),PWTYPE(NPWDTA)
C-CRA          DIMENSION QDATA(NQDTA,6)
C-CRA          DIMENSION QGES(NQDTA),QTYPE(NQDTA)
C-CRA          DIMENSION NUMQ(NSIG)
C-CRA          DIMENSION QPLTY(NSIG)
C-CRA          DIMENSION ICOUNT(NLAT,NLON,NSIG),NCOUNT(NQDTA)
C-CRA          DIMENSION RBQS(NQDTA)
 
C          DIMENSION PWDATA(_NPWDTA_,5)
          DIMENSION PWDATA(1,5)
C          DIMENSION PWGES(_NPWDTA_),PWTYPE(_NPWDTA_)
          DIMENSION PWGES(1),PWTYPE(1)
C          DIMENSION QDATA(_NQDTA_,6)
          DIMENSION QDATA(15000,6)
C          DIMENSION QGES(_NQDTA_),QTYPE(_NQDTA_)
          DIMENSION QGES(15000),QTYPE(15000)
          DIMENSION NUMQ(28)
          DIMENSION QPLTY(28)
C          DIMENSION ICOUNT(96,192,28),NCOUNT(_NQDTA_)
          DIMENSION ICOUNT(96,192,28),NCOUNT(15000)
C          DIMENSION RBQS(_NQDTA_)
          DIMENSION RBQS(15000)

           DIMENSION QFILE(*),PWFILE(*)
           DIMENSION JL(128,6)
C--------
      NUMTEMPS=0
      IER=1
      ILON=2
      ILAT=3
      IPRES=4
      IPSFC=5
      NLTH=NLAT/2
C   INCREASE OBS ERRORS IN THE N.H. BY A FACTOR OF 2 TO ACCOUNT
      FACTOR=2.
      NSUPERP=0
      PWPLTY=0.
      NPP=11
C     PRINT *,NPP,NGRP,NPWDTA
      IF(NPWDTA .EQ. 0)GO TO 1000
      OBERMAX=-1.E50
      OBERMIN=1.E50
      RESMAX=-1.E50
      RATMAX=-1.E50
      NUMGRSPW=0
      ERMAX=ERMAXPW
      ERMIN=ERMINPW
      GROSS=GROSSPW
      NGRP=0
      IREC=0
      IS=1
      ISSAVE=1
C--------
C-------- INITIALIZE GRIDS
C--------
      ANLON=FLOAT(NLON)
      DO 300 I=1,NPWDTA
        JLAT=PWDATA(I,ILAT)
        IF(PWDATA(I,ILON).GE. ANLON+1.)PWDATA(I,ILON)=
     *    PWDATA(I,ILON)-ANLON
        IF(PWDATA(I,ILON).LT. 1.)PWDATA(I,ILON)=PWDATA(I,ILON)+ANLON
        JLON=PWDATA(I,ILON)
        JLAT=MAX(1,MIN(JLAT,NLAT))
        DY=PWDATA(I,ILAT)-JLAT
        DX=PWDATA(I,ILON)-JLON
        JLONP=JLON+1
        IF(JLONP .GT. NLON)JLONP=JLONP-NLON
        JLATP=JLAT+1
        JLATP=MIN(JLATP,NLAT)
        IF(JLAT .LT. NLTH)PWDATA(I,IER)=PWDATA(I,IER)*FACTOR
        PWDATA(I,IER)=SQRT(PWDATA(I,IER))
C-----------------------------------GROSS ERROR TEST ADDED HERE
        OBSERROR=1./MAX(PWDATA(I,IER),1.E-10)
        OBSERRLM=MAX(ERMIN,MIN(ERMAX,OBSERROR))
        RESIDUAL=ABS(PWDATA(I,IPRES))
        RATIO=RESIDUAL/OBSERRLM
        IF(OBSERROR.LT.1.E5) OBERMAX=MAX(OBERMAX,OBSERROR)
        OBERMIN=MIN(OBERMIN,OBSERROR)
        RESMAX=MAX(RESMAX,RESIDUAL)
        RATMAX=MAX(RATMAX,RATIO)
        IF(RATIO.GT.GROSS) THEN
         NUMGRSPW=NUMGRSPW+1
         PWDATA(I,IER)=0.
        END IF
        VALX=PWDATA(I,IER)*PWDATA(I,IPRES)
        WGT00=PWDATA(I,IER)*(1.0-DX)*(1.0-DY)
        WGT10=PWDATA(I,IER)*(1.0-DX)*DY
        WGT01=PWDATA(I,IER)*DX*(1.0-DY)
        WGT11=PWDATA(I,IER)*DX*DY
        PWFILE(IS+1)=JLAT
        PWFILE(IS+2)=JLON
        PWFILE(IS+3)=JLATP
        PWFILE(IS+4)=JLONP
        PWFILE(IS+5)=WGT00
        PWFILE(IS+6)=WGT10
        PWFILE(IS+7)=WGT01
        PWFILE(IS+8)=WGT11
        PWFILE(IS+9)=PWDATA(I,IPSFC)
        PWFILE(IS+10)=PWDATA(I,IPRES)
        PWFILE(IS+11)=PWDATA(I,IER)
C       PWFILE(IS+12)=PWGES(I)
C       PWFILE(IS+13)=PWTYPE(I)
        IS=IS+NPP
        NGRP=NGRP+1
        PWPLTY=PWPLTY+VALX*VALX
        NSUPERP=NSUPERP+1
300   CONTINUE
      PWFILE(ISSAVE)=NGRP
      IREC=IREC+1
      NPWRECS=IREC
      PRINT *,' NUMBER OF PRECIP. WATER SPROBS=',NSUPERP
      WRITE(6,956)PWPLTY
956   FORMAT(' TOTAL P.W. OBS PENALTY=',E12.4)
       WRITE(6,*)' GROSS ERROR CHECK FOR TOTAL PRECIP WATER:'
       WRITE(6,*)'   OBS ERROR MAX,MIN=',OBERMAX,OBERMIN
       WRITE(6,*)'   FOR CHECK, OBS ERROR BOUNDED BY ',ERMIN,ERMAX
       WRITE(6,*)'   FOR CHECK, MAX RATIO RESIDUAL/OB ERROR =',GROSS
       WRITE(6,*)'   MAX RESIDUAL=',RESMAX
       WRITE(6,*)'   MAX RATIO=',RATMAX
       WRITE(6,*)'   NUMBER OBS THAT FAILED GROSS TEST = ',NUMGRSPW
C  BEGIN MOISTURE OBSERVATIONS
1000  NUMPQ=0
      OBERMAX=-1.E50
      OBERMIN=1.E50
      OLATMIN=0.
      OLONMIN=0.
      OSIGMIN=0.
      RESMAX=-1.E50
      RATMAX=-1.E50
      NUMGRSQ=0
      ERMAX=ERMAXQ
      ERMIN=ERMINQ
      GROSS=GROSSQ
C-CRA                QPLTY=0.
C       DIMENSION QPLTY(NSIG)
          DO ITMP=1,NSIG
          QPLTY(ITMP)=0.
          ENDDO
      NTOT=0
      IER=1
      ILON=2
      ILAT=3
      ISIG=4
      IQRES=5
      IS=1
      IREC=0
      NPP=16
C-CRA                NCOUNT=0
C       DIMENSION ICOUNT(NLAT,NLON,NSIG),NCOUNT(NQDTA)
          DO ITMP=1,NQDTA
          NCOUNT(ITMP)=0
          ENDDO
      NQTTOT=0
      INC=NQDTA/128
      INC=MAX(INC,1)
      ANLON=FLOAT(NLON)
      IS=1
      DO 200 KK=1,NQDTA
C-CRA                ICOUNT=0
C       DIMENSION ICOUNT(NLAT,NLON,NSIG),NCOUNT(NQDTA)
          DO ITMP=1,NLAT*NLON*NSIG
          ICOUNT(ITMP,1,1)=0
          ENDDO
      ISSAVE=IS
      IS=IS+1
      I128=1
      NGRP=0
      DO 100 III=1,5*INC
        IBEG=MOD(III-1,INC)+1
        DO 100 I=IBEG,NQDTA,INC
        IF(NCOUNT(I) .GT. 0)GO TO 100
C--------
        JLAT=QDATA(I,ILAT)
        IF(QDATA(I,ILON).GE. ANLON+1.)QDATA(I,ILON)=
     *     QDATA(I,ILON)-ANLON
        IF(QDATA(I,ILON).LT. 1.)QDATA(I,ILON)=QDATA(I,ILON)+ANLON
        JLON=QDATA(I,ILON)
        JSIG=QDATA(I,ISIG)
        DX=QDATA(I,ILON)-JLON
        DY=QDATA(I,ILAT)-JLAT
        DS=QDATA(I,ISIG)-JSIG
        JLAT=MAX(1,MIN(JLAT,NLAT))
        JSIG=MAX(1,MIN(JSIG,NSIG))
        IF(ICOUNT(JLAT,JLON,JSIG) .EQ. 1)GO TO 100
        JLATP=JLAT+1
        JLATP=MIN(JLATP,NLAT)
        IF(ICOUNT(JLATP,JLON,JSIG) .EQ. 1)GO TO 100
        JSIGP=JSIG+1
        JSIGP=MIN(JSIGP,NSIG)
        IF(ICOUNT(JLATP,JLON,JSIGP) .EQ. 1)GO TO 100
        IF(ICOUNT(JLAT,JLON,JSIGP) .EQ. 1)GO TO 100
        JLONP=JLON+1
        IF(JLONP .GT. NLON)JLONP=JLONP-NLON
        IF(ICOUNT(JLATP,JLONP,JSIG) .EQ. 1)GO TO 100
        IF(ICOUNT(JLAT,JLONP,JSIG) .EQ. 1)GO TO 100
        IF(ICOUNT(JLATP,JLONP,JSIGP) .EQ. 1)GO TO 100
        IF(ICOUNT(JLAT,JLONP,JSIGP) .EQ. 1)GO TO 100
        ICOUNT(JLAT,JLON,JSIG)=1
        ICOUNT(JLAT,JLONP,JSIG)=1
        ICOUNT(JLATP,JLON,JSIG)=1
        ICOUNT(JLATP,JLONP,JSIG)=1
        ICOUNT(JLAT,JLON,JSIGP)=1
        ICOUNT(JLAT,JLONP,JSIGP)=1
        ICOUNT(JLATP,JLON,JSIGP)=1
        ICOUNT(JLATP,JLONP,JSIGP)=1
        JL(I128,1)=JLAT
        JL(I128,2)=JLON
        JL(I128,3)=JSIG
        JL(I128,4)=JLATP
        JL(I128,5)=JLONP
        JL(I128,6)=JSIGP
        IF(JLAT .LE. NLTH)QDATA(I,IER)=QDATA(I,IER)*FACTOR
        QDATA(I,IER)=SQRT(QDATA(I,IER))
C-----------------------------------GROSS ERROR TEST ADDED HERE
        OBSERROR=1./MAX(QDATA(I,IER),1.E-10)
        OBSERROR=OBSERROR*100./RBQS(I)
        OBSERRLM=MAX(ERMIN,MIN(ERMAX,OBSERROR))
        RESIDUAL=ABS(QDATA(I,IQRES)*100./RBQS(I))
        RATIO=RESIDUAL/OBSERRLM
        IF(OBSERROR.LT.1.E5) OBERMAX=MAX(OBERMAX,OBSERROR)
        IF(OBERMIN.GE.OBSERROR) THEN
         OBERMIN=OBSERROR
         OLATMIN=JLAT
         OLONMIN=JLON
         OSIGMIN=JSIG
        END IF
C       OBERMIN=MIN(OBERMIN,OBSERROR)
        RESMAX=MAX(RESMAX,RESIDUAL)
        RATMAX=MAX(RATMAX,RATIO)
        IF(RATIO.GT.GROSS) THEN
         NUMGRSQ=NUMGRSQ+1
         QDATA(I,IER)=0.
        END IF
        VAL=QDATA(I,IER)*QDATA(I,IQRES)
        WGT000=QDATA(I,IER)*(1.0-DX)*(1.0-DY)*(1.0-DS)
        WGT010=QDATA(I,IER)*DX*(1.0-DY)*(1.0-DS)
        WGT100=QDATA(I,IER)*(1.-DX)*DY*(1.0-DS)
        WGT110=QDATA(I,IER)*DX*DY*(1.0-DS)
        WGT001=QDATA(I,IER)*(1.-DX)*(1.-DY)*DS
        WGT011=QDATA(I,IER)*DX*(1.-DY)*DS
        WGT101=QDATA(I,IER)*(1.-DX)*DY*DS
        WGT111=QDATA(I,IER)*DX*DY*DS
        QFILE(IS)=JLAT
        QFILE(IS+1)=JLON
        QFILE(IS+2)=JSIG
        QFILE(IS+3)=JLATP
        QFILE(IS+4)=JLONP
        QFILE(IS+5)=JSIGP
        QFILE(IS+6)=WGT000
        QFILE(IS+7)=WGT100
        QFILE(IS+8)=WGT010
        QFILE(IS+9)=WGT110
        QFILE(IS+10)=WGT001
        QFILE(IS+11)=WGT101
        QFILE(IS+12)=WGT011
        QFILE(IS+13)=WGT111
        QFILE(IS+14)=QDATA(I,IQRES)
        QFILE(IS+15)=QDATA(I,IER)
C       QFILE(IS+16)=QGES(I)
C       QFILE(IS+17)=QTYPE(I)
        NQTTOT=NQTTOT+1
        IS=IS+NPP
        I128=I128+1
        NCOUNT(I)=1
        NGRP=NGRP+1
        QPLTY(JSIG)=QPLTY(JSIG)+VAL*VAL
        NUMQ(JSIG)=NUMQ(JSIG)+1
        IF(I128 .EQ. 129)I128=1
        IF(NGRP .GT. 128)THEN
        ICOUNT(JL(I128,1),JL(I128,2),JL(I128,3))=0
        ICOUNT(JL(I128,4),JL(I128,2),JL(I128,3))=0
        ICOUNT(JL(I128,1),JL(I128,5),JL(I128,3))=0
        ICOUNT(JL(I128,4),JL(I128,5),JL(I128,3))=0
        ICOUNT(JL(I128,1),JL(I128,2),JL(I128,6))=0
        ICOUNT(JL(I128,4),JL(I128,2),JL(I128,6))=0
        ICOUNT(JL(I128,1),JL(I128,5),JL(I128,6))=0
        ICOUNT(JL(I128,4),JL(I128,5),JL(I128,6))=0
        END IF
100   CONTINUE
121   CONTINUE
      IREC=IREC+1
      QFILE(ISSAVE)=NGRP
C     PRINT *,NGRP
      IF(NQTTOT .EQ. NQDTA)GO TO 201
 200  CONTINUE
 201  NQRECS=IREC
      QMPLTY=0.
      DO 251 K=1,NSIG
        QMPLTY=QMPLTY+QPLTY(K)
        NTOT=NTOT+NUMQ(K)
        WRITE(6,240)NUMQ(K),K,QPLTY(K)
240     FORMAT(' THERE ARE ',I9,' Q OBS AT LEVEL ',I4,
     *     ' PEN =',E12.4)
251   CONTINUE
      PRINT *,' TOTAL NUMBER OF Q-COMPONENT OBS=',NTOT
      PRINT *,' TOTAL Q OBS PENALTY=',QMPLTY
       WRITE(6,*)' GROSS ERROR CHECK FOR SPECIFIC HUMIDITY:'
       WRITE(6,*)'  (SCALED AS PRECENT OF GUESS SPECIFIC HUMIDITY)'
       WRITE(6,*)'   OBS ERROR MAX,MIN=',OBERMAX,OBERMIN
       WRITE(6,*)'  COORDS OF MIN ERR, LAT,LON,SIG=',
     *                   OLATMIN,OLONMIN,OSIGMIN
       WRITE(6,*)'   FOR CHECK, OBS ERROR BOUNDED BY ',ERMIN,ERMAX
       WRITE(6,*)'   FOR CHECK, MAX RATIO RESIDUAL/OB ERROR =',GROSS
       WRITE(6,*)'   MAX RESIDUAL=',RESMAX
       WRITE(6,*)'   MAX RATIO=',RATMAX
       WRITE(6,*)'   NUMBER OBS THAT FAILED GROSS TEST = ',NUMGRSQ
      RETURN
      END