SUBROUTINE PREPW(DRPTPS,DLONS,DLATS,DPRES,
* RTYPES,RSPRES,
* MWDAT,PSG,FACT,FACTOR,NLAT,NLON,NSIG,GLATS,GLONS,SIGL)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C . . . .
C SUBPROGRAM: PREPW PRELIMINARY STUFF BEFORE RES. CALC. W
C PRGMMR: PARRISH ORG: W/NMC22 DATE: 90-10-11
C
C ABSTRACT: PRELIMINARY STUFF BEFORE RESIDUAL CALCULATION FOR WINDS
C
C PROGRAM HISTORY LOG:
C 90-10-11 PARRISH
C
C INPUT ARGUMENT LIST:
C DRPTPS - OBS TYPE IN, OBS ERROR OUT (LN(PS) UNITS)
C DLONS,DLATS - OBS LONGITUDES AND LATITUDES (RADIANS IN AND OUT)
C DPRES - PRES (MB*10+QM IN, GRID COORDS IN SIGMA OUT)
C RTYPES - PREPDA OBSERVATION TYPES
C MWDAT - NUMBER OF OBSERVATIONS
C PSG - MODEL GUESS LOG(PSFC), P IN CB
C FACTOR - ARRAY OF 10M WIND FACTORS
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
C SIGL - SIGMA LAYER MIDPOINT VALUES
C
C OUTPUT ARGUMENT LIST:
C RSPRES - OBSERVATION PRESSURES
C FACT - NEAR SURFACE REDUCTION IN WIND FACTOR AT OBS.
C AND AS INDICATED ABOVE
C
C ATTRIBUTES:
C LANGUAGE: CFT77
C MACHINE: CRAY YMP
C
C$$$
C--------
C
C-CRA DIMENSION DRPTPS(MWDAT),DLONS(MWDAT),DLATS(MWDAT),DPRES(MWDAT)
C-CRA DIMENSION PSG(NLAT+1,NLON+2)
C-CRA DIMENSION GLATS(NLAT),GLONS(NLON),SIGL(NSIG)
C-CRA DIMENSION RTYPES(MWDAT)
C-CRA DIMENSION RSPRES(MWDAT),FACT(MWDAT)
C-CRA DIMENSION RBPRES(MWDAT)
C-CRA DIMENSION RLOW(MWDAT),RHGH(MWDAT)
C-CRA DIMENSION SIGLL(NSIG+1)
C DIMENSION DRPTPS(_MWDAT_),DLONS(_MWDAT_)
DIMENSION DRPTPS(85000),DLONS(85000)
C DIMENSION DLATS(_MWDAT_),DPRES(_MWDAT_)
DIMENSION DLATS(85000),DPRES(85000)
DIMENSION PSG(96+1,192+2)
DIMENSION GLATS(96),GLONS(192),SIGL(28)
C DIMENSION RTYPES(_MWDAT_)
DIMENSION RTYPES(85000)
C DIMENSION RSPRES(_MWDAT_),FACT(_MWDAT_)
DIMENSION RSPRES(85000),FACT(85000)
C DIMENSION RBPRES(_MWDAT_)
DIMENSION RBPRES(85000)
C DIMENSION RLOW(_MWDAT_),RHGH(_MWDAT_)
DIMENSION RLOW(85000),RHGH(85000)
DIMENSION SIGLL(28+1)
C-------
C-------- LOCAL SPACE
C--------
C--------
C-------- GET LOG(SIG)
C--------
SIGLL(1)=0.
DO 100 K=1,NSIG
SIGLL(K+1)=LOG(SIGL(K))
100 CONTINUE
C--------
C-------- CONVERT OBS LATS AND LONS TO GRID COORDINATES
C--------
CALL GDCRDP(DLATS,MWDAT,GLATS,NLAT)
CALL GDCRDP(DLONS,MWDAT,GLONS,NLON)
C-------
C-------- 3. INTERPOLATE SURFACE PRESSURE
C--------
C-------- OBTAIN GUESS SURFACE PRESSURE AT OBS LOCATIONS
C--------
CALL INTRP2(PSG,RBPRES,DLATS,DLONS,NLAT,NLON,MWDAT)
CALL INTRP2(FACTOR,FACT,DLATS,DLONS,NLAT,NLON,MWDAT)
C--------
C-------- CONVERT OBS PRESSURE TO SIGMA, THEN GET GRID COORDINATES
C--------
C-CRA RSPRES=10.*EXP(DPRES)
C DIMENSION RSPRES(MWDAT),FACT(MWDAT)
DO ITMP=1,MWDAT
RSPRES(ITMP)=10.*EXP(DPRES(ITMP))
ENDDO
C-CRA DPRES=DPRES-RBPRES
C DIMENSION DRPTPS(MWDAT),DLONS(MWDAT),DLATS(MWDAT),DPRES(MWDAT)
DO ITMP=1,MWDAT
DPRES(ITMP)=DPRES(ITMP)-RBPRES(ITMP)
ENDDO
C--------
C-------- FOR SSMI WIND SPEEDS, SET VERT POS TO 10M
C--------
ALOG20=ALOG(.9976)
ALOG10=ALOG(.9988)
DO 45 I=1,MWDAT
IF(NINT(RTYPES(I)).EQ.280) DPRES(I)=ALOG20
IF(NINT(RTYPES(I)).EQ.281) DPRES(I)=ALOG10
IF(NINT(RTYPES(I)).EQ.282) DPRES(I)=ALOG20
IF(NINT(RTYPES(I)).EQ.283) DPRES(I)=ALOG20
IF(NINT(RTYPES(I)).EQ.284) DPRES(I)=ALOG10
IF(NINT(RTYPES(I)).EQ.285) DPRES(I)=ALOG10
IF(NINT(RTYPES(I)).EQ.286) DPRES(I)=ALOG10
45 CONTINUE
DO 46 I=1,MWDAT
IF(DPRES(I) .LT. ALOG10 .AND. DPRES(I) .GT. SIGLL(2))
* FACT(I)=(DPRES(I)-ALOG10+FACT(I)*(SIGLL(2)-
* DPRES(I)))/
* (SIGLL(2)-ALOG10)
IF(DPRES(I) .LT. SIGLL(2))FACT(I)=1.
46 CONTINUE
CALL GDCRDN(DPRES,MWDAT,SIGLL,NSIG+1)
NUMHGH=0
NUMLOW=0
HGH=-1.E9
XLOW=-1.E9
RSIG=NSIG
DO 58 I=1,MWDAT
RLOW(I)=MIN(DPRES(I),0.)
DPRES(I)=DPRES(I)-1.
RHGH(I)=MAX(DPRES(I)-.001-RSIG,0.)
RHGH(I)=ABS(RHGH(I))
RLOW(I)=ABS(RLOW(I))
IF(RHGH(I).NE.0.) NUMHGH=NUMHGH+1
IF(RLOW(I).NE.0.) NUMLOW=NUMLOW+1
HGH=MAX(RHGH(I),HGH)
XLOW=MAX(RLOW(I),XLOW)
58 CONTINUE
WRITE(6,900)MWDAT,NUMHGH,NUMLOW,HGH,XLOW
900 FORMAT(' NUMBER OF WINDS=',I8,' NUMBER EXTRAPOLATED ABOVE',
* ' TOP SIGMA LAYER=',I8,/,' NUMBER EXTRAPOLATED BELOW',
* ' BOTTOM SIGMA LAYER=',I8,/,' LARGEST EXTRAPOLATION',
* ' ABOVE=',F12.2,/,' LARGEST EXTRAPOLATION BELOW=',F12.2)
CDIR$ IVDEP
DO 908 I=1,MWDAT
DRPTPS(I)=1./(DRPTPS(I)
* +1.E6*RHGH(I)+4.*RLOW(I))**2
908 CONTINUE
RETURN
END