SUBROUTINE PREPP(DRPTPS,DLONS,DLATS,DPS,TOPOGD,TD,
     *  TTYPES,
     *  MPSDAT,TG,PSG,TOPOGM,NLAT,NLON,
     *  NSIG,GLATS,GLONS,SIGL)
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    PREPP      PRELIMINARY STUFF BEFORE RES. CALC. P
C   PRGMMR: DERBER         ORG: W/NMC23    DATE: 90-10-10
C
C ABSTRACT: PRELIMINARY STUFF BEFORE RESIDUAL CALCULATION FOR SFC. PRES.
C
C PROGRAM HISTORY LOG:
C   90-10-10  PARRISH
C
C   INPUT ARGUMENT LIST:
C     DRPTPS   - OBS TYPE IN, OBS ERROR OUT (LN(PS) UNITS)
C     DLONS,DLATS - OBS LONGITUDES, LATITUDES (RADIANS IN AND OUT)
C     DPS      - PRES (MB*10+QM IN, LN(PS) RESIDUAL OUT--P IN CB)
C     TOPOGD   - OBS ELEVATION (M) IN AND OUT
C     TTYPES   - PREPDA OBSERVATION TYPES
C     MPSDAT   - NUMBER OF OBSERVATIONS
C     TG       - MODEL GUESS TEMPERATURE
C     PSG      - MODEL GUESS LOG(PSFC), P IN CB
C     TOPOGM   - MODEL TERRAIN
C     NLAT     - NUMBER OF GAUSSIAN LATS POLE TO POLE
C     NLON     - NUMBER OF LONGITUDES
C     NSIG     - NUMBER OF SIGMA LEVELS
C     GLATS,GLONS - GRID LATITUDES AND LONGITUDES
C     SIGL     - SIGMA LAYER MIDPOINT VALUES
C
C   OUTPUT ARGUMENT LIST:
C     AND AS INDICATED ABOVE
C
C ATTRIBUTES:
C   LANGUAGE: CFT77
C   MACHINE:  CRAY YMP
C
C$$$
C--------
C
C-CRA          DIMENSION DRPTPS(MPSDAT),DLONS(MPSDAT)
C-CRA          DIMENSION DLATS(MPSDAT),DPS(MPSDAT),TD(MPSDAT)
C-CRA          DIMENSION TOPOGD(MPSDAT),TG(NLAT+1,NLON+2,NSIG)
C-CRA          DIMENSION PSG(NLAT+1,NLON+2)
C-CRA          DIMENSION TOPOGM(NLAT+1,NLON+2)
C-CRA          DIMENSION GLATS(NLAT),GLONS(NLON),SIGL(NSIG)
C-CRA          DIMENSION TTYPES(MPSDAT)
C-CRA          DIMENSION RBTR(MPSDAT)
C-CRA          DIMENSION RDELZ(MPSDAT),RBPRES(MPSDAT),RBPRS2(MPSDAT)
C-CRA          DIMENSION RBTPS(MPSDAT),RBTPS2(MPSDAT),RDP(MPSDAT)
C-CRA          DIMENSION SIGLL(NSIG)
 
C          DIMENSION DRPTPS(_MPSDAT_),DLONS(_MPSDAT_)
          DIMENSION DRPTPS(18000),DLONS(18000)
C          DIMENSION DLATS(_MPSDAT_),DPS(_MPSDAT_),TD(_MPSDAT_)
          DIMENSION DLATS(18000),DPS(18000),TD(18000)
C          DIMENSION TOPOGD(_MPSDAT_),TG(96+1,192+2,28)
          DIMENSION TOPOGD(18000),TG(96+1,192+2,28)
          DIMENSION PSG(96+1,192+2)
          DIMENSION TOPOGM(96+1,192+2)
          DIMENSION GLATS(96),GLONS(192),SIGL(28)
C          DIMENSION TTYPES(_MPSDAT_)
          DIMENSION TTYPES(18000)
C          DIMENSION RBTR(_MPSDAT_)
          DIMENSION RBTR(18000)
C          DIMENSION RDELZ(_MPSDAT_),RBPRES(_MPSDAT_),RBPRS2(_MPSDAT_)
          DIMENSION RDELZ(18000),RBPRES(18000),RBPRS2(18000)
C          DIMENSION RBTPS(_MPSDAT_),RBTPS2(_MPSDAT_),RDP(_MPSDAT_)
          DIMENSION RBTPS(18000),RBTPS2(18000),RDP(18000)
          DIMENSION SIGLL(28)
C--------
C-------- LOCAL ARRAYS
C--------
C--------
C-------- GET LOG(SIG)
C--------
C-CRA                SIGLL=LOG(SIGL)
C       DIMENSION SIGLL(NSIG)
          DO ITMP=1,NSIG
          SIGLL(ITMP)=LOG(SIGL(ITMP))
          ENDDO
C--------
C-------- CONVERT OBS LATS AND LONS TO GRID COORDINATES
C--------
      CALL GDCRDP(DLATS,MPSDAT,GLATS,NLAT)
      CALL GDCRDP(DLONS,MPSDAT,GLONS,NLON)
C--------
C-------- 3.  INTERPOLATE SURFACE PRESSURE
C--------
      CALL INTRP2(TOPOGM,RBTR,DLATS,DLONS,NLAT,NLON,MPSDAT)
      NGRD=NLAT*NLON
CDIR$ IVDEP
      DO 54 I=1,MPSDAT
        RDELZ(I)=TOPOGD(I)-RBTR(I)
        DRPTPS(I)=1./(DRPTPS(I)+.000005*ABS(RDELZ(I)))**2
54    CONTINUE
C--------
C-------- OBTAIN GUESS SURFACE PRESSURE AT OBS LOCATIONS
C--------
      CALL INTRP2(PSG,RBPRES,DLATS,DLONS,NLAT,NLON,MPSDAT)
C
C   FIND MIDPOINT OF EXTRAPOLATION LAYER IN LN(SIGMA) UNITS, THEN
C   CONVERT TO GRID COORDINATES
C
C-CRA                RBPRS2=DPS-RBPRES
C       DIMENSION RDELZ(MPSDAT),RBPRES(MPSDAT),RBPRS2(MPSDAT)
          DO ITMP=1,MPSDAT
          RBPRS2(ITMP)=DPS(ITMP)-RBPRES(ITMP)
          ENDDO
C-CRA                RBPRES=0.
C       DIMENSION RDELZ(MPSDAT),RBPRES(MPSDAT),RBPRS2(MPSDAT)
          DO ITMP=1,MPSDAT
          RBPRES(ITMP)=0.
          ENDDO
      CALL GDCRDN(RBPRES,MPSDAT,SIGLL,NSIG)
      CALL GDCRDN(RBPRS2,MPSDAT,SIGLL,NSIG)
C--------
C--------     INTERPOLATE TEMPS
C--------
      CALL INTRP3(TG,RBTPS,DLATS,DLONS,RBPRES,
     *  NLAT,NLON,NSIG,MPSDAT)
      CALL INTRP3(TG,RBTPS2,DLATS,DLONS,RBPRS2,
     *  NLAT,NLON,NSIG,MPSDAT)
      DO 78 I=1,MPSDAT
        IF(TD(I).GT.150..AND.TD(I).LT.350.) THEN
          RBTPS(I)=.5*(RBTPS(I)+TD(I))
        ELSE
          RBTPS(I)=.5*(RBTPS(I)+RBTPS2(I))
        END IF
78    CONTINUE
C
C   EXTRAPOLATE SURFACE TEMPERATURE BELOW GROUND AT 6.5 K/KM
C   NOTE ONLY EXTRAPOLATING .5DZ, IF NO SURFACE TEMPERATURE AVAILABLE.
C
CDIR$ IVDEP
      DO 88 I=1,MPSDAT
        IF((TD(I).LT.150..OR.TD(I).GT.350.).AND.
     *    RDELZ(I).LT.0.) RBTPS(I)=
     *    RBTPS(I)-.00325*RDELZ(I)
 88   CONTINUE
      GORM=9.8076/287.16
C-CRA                RDP=GORM*RDELZ/RBTPS
C       DIMENSION RBTPS(MPSDAT),RBTPS2(MPSDAT),RDP(MPSDAT)
          DO ITMP=1,MPSDAT
          RDP(ITMP)=GORM*RDELZ(ITMP)/RBTPS(ITMP)
          ENDDO
      IP10=10
C-CRA                DPS=DPS+RDP
C       DIMENSION DLATS(MPSDAT),DPS(MPSDAT),TD(MPSDAT)
          DO ITMP=1,MPSDAT
          DPS(ITMP)=DPS(ITMP)+RDP(ITMP)
          ENDDO
      RETURN
      END