SUBROUTINE INITQPW(RT,NLATH,NLON,NSIG,NQRECS,NPWRECS,
     *     PWCON,QFILE,PWFILE)
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    INITQPW       SET UP INITIAL RHS FOR Q AND PW.
C   PRGMMR: DERBER          ORG: W/NMC23    DATE: 91-02-26
C
C ABSTRACT: SET UP INITIAL RHS FOR Q AND PRECIP. WATER
C
C PROGRAM HISTORY LOG:
C   91-02-26  DERBER
C
C   INPUT ARGUMENT LIST:
C     NLATH    - HALF THE NUMBER OF LATITUDES ON GAUSSIAN GRID
C     NLON     - NUMBER OF LONGITUDES ON GAUSSIAN GRID
C     NSIG     - NUMBER OF SIGMA LEVELS
C     NQRECS   - NUMBER OF Q RECORDS
C     NPWRECS  - NUMBER OF PRECIP. WATER RECORDS
C     PWCON    - VERTICAL INTEGRATION PRECIP. WATER CONSTANTS
C     NBLK     - BLOCKING FACTOR FOR IUNIT
C     IUNIT    - DATA SCRATCH FILE
C
C   OUTPUT ARGUMENT LIST:
C     RT       - RESULTS FROM OBSERVATION OPERATOR (0 FOR NO DATA)
C
C ATTRIBUTES:
C   LANGUAGE: CFT77
C   MACHINE:  CRAY YMP
C
C$$$
C
C-CRA          DIMENSION PWCON(NSIG)
C-CRA          DIMENSION RT(2*NLATH+1,NLON+2,NSIG)
C-CRA          DIMENSION QFILE(*),PWFILE(*)
 
          DIMENSION PWCON(28)
          DIMENSION RT(2*48+1,192+2,28)
          DIMENSION QFILE(*),PWFILE(*)
C--------
C-CRA                RT=0.
C       DIMENSION RT(2*NLATH+1,NLON+2,NSIG)
          DO ITMP=1,(2*NLATH+1)*(NLON+2)*NSIG
          RT(ITMP,1,1)=0.
          ENDDO
      IF(NPWRECS .EQ. 0)GO TO 1000
      NPP=11
C--------
C-------- INITIALIZE GRIDS
C--------
      IS=1
      DO 700 I=1,NPWRECS
        NGRP=PWFILE(IS)
        IS=IS+1
CCCDIR$ IVDEP
        DO 701 IRPT=1,NGRP
        JLAT=PWFILE((IRPT-1)*NPP+IS)
        JLON=PWFILE((IRPT-1)*NPP+IS+1)
        JLATP=PWFILE((IRPT-1)*NPP+IS+2)
        JLONP=PWFILE((IRPT-1)*NPP+IS+3)
        WGT00=PWFILE((IRPT-1)*NPP+IS+4)
        WGT10=PWFILE((IRPT-1)*NPP+IS+5)
        WGT01=PWFILE((IRPT-1)*NPP+IS+6)
        WGT11=PWFILE((IRPT-1)*NPP+IS+7)
        PSFC=PWFILE((IRPT-1)*NPP+IS+8)
        VAL=-PWFILE((IRPT-1)*NPP+IS+9)*PWFILE((IRPT-1)*NPP+IS+10)
C       AERR=PWFILE((IRPT-1)*NPP+IS+11)
C       PWGE=PWFILE((IRPT-1)*NPP+IS+12)
C       PWTY=PWFILE((IRPT-1)*NPP+IS+13)
        VAL=VAL*PSFC
C       VAL=(VAL-PDAT*AERR)*PSFC*PSFC
        DO 401 K=1,NSIG
        RT(JLAT,JLON,K)=RT(JLAT,JLON,K)+WGT00*VAL*PWCON(K)
        RT(JLATP,JLON,K)=RT(JLATP,JLON,K)+WGT10*VAL*PWCON(K)
        RT(JLAT,JLONP,K)=RT(JLAT,JLONP,K)+WGT01*VAL*PWCON(K)
        RT(JLATP,JLONP,K)=RT(JLATP,JLONP,K)+WGT11*VAL*PWCON(K)
 401    CONTINUE
 701  CONTINUE
      IS=IS+NGRP*NPP
700   CONTINUE
1000  IF(NQRECS .EQ. 0)RETURN
      NPP=16
C--------
C
C--------
      IS=1
      DO 100 I=1,NQRECS
        NGRP=QFILE(IS)
        IS=IS+1
CDIR$ IVDEP
      DO 101 K=1,NGRP
        JLAT=QFILE((K-1)*NPP+IS)
        JLON=QFILE((K-1)*NPP+IS+1)
        JSIG=QFILE((K-1)*NPP+IS+2)
        JLATP=QFILE((K-1)*NPP+IS+3)
        JLONP=QFILE((K-1)*NPP+IS+4)
        JSIGP=QFILE((K-1)*NPP+IS+5)
        WGT000=QFILE((K-1)*NPP+IS+6)
        WGT100=QFILE((K-1)*NPP+IS+7)
        WGT010=QFILE((K-1)*NPP+IS+8)
        WGT110=QFILE((K-1)*NPP+IS+9)
        WGT001=QFILE((K-1)*NPP+IS+10)
        WGT101=QFILE((K-1)*NPP+IS+11)
        WGT011=QFILE((K-1)*NPP+IS+12)
        WGT111=QFILE((K-1)*NPP+IS+13)
        VAL=-QFILE((K-1)*NPP+IS+14)*QFILE((K-1)*NPP+IS+15)
C       AERR=QFILE((K-1)*NPP+IS+15)
C       QGES=QFILE((K-1)*NPP+IS+16)
C       QTYP=QFILE((K-1)*NPP+IS+17)
        RT(JLAT,JLON,JSIG)=RT(JLAT,JLON,JSIG)+WGT000*VAL
        RT(JLATP,JLON,JSIG)=RT(JLATP,JLON,JSIG)+WGT100*VAL
        RT(JLAT,JLONP,JSIG)=RT(JLAT,JLONP,JSIG)+WGT010*VAL
        RT(JLATP,JLONP,JSIG)=RT(JLATP,JLONP,JSIG)+WGT110*VAL
        RT(JLAT,JLON,JSIGP)=RT(JLAT,JLON,JSIGP)+WGT001*VAL
        RT(JLATP,JLON,JSIGP)=RT(JLATP,JLON,JSIGP)+WGT101*VAL
        RT(JLAT,JLONP,JSIGP)=RT(JLAT,JLONP,JSIGP)+WGT011*VAL
        RT(JLATP,JLONP,JSIGP)=RT(JLATP,JLONP,JSIGP)+WGT111*VAL
 101   CONTINUE
       IS=IS+NPP*NGRP
100   CONTINUE
      RETURN
      END