awips2/ncep/gov.noaa.nws.ncep.ui.nsharp/BigNsharp/mruadtjh.f
root 133dc97f67 Initial revision of AWIPS2 11.9.0-7p5
Former-commit-id: 06a8b51d6d [formerly 9f19e3f712 [formerly 64fa9254b946eae7e61bbc3f513b7c3696c4f54f]]
Former-commit-id: 9f19e3f712
Former-commit-id: a02aeb236c
2012-01-06 08:55:05 -06:00

189 lines
6.2 KiB
Fortran

SUBROUTINE MR_UADTJH ( datman, nman, datsgt, nsgt, datsgw, nsgw,
+ datamn, namn, datast, nast, datasw, nasw,
+ datmnw, nmnw, datamw, namw, dattrp, ntrp,
+ datmxw, nmxw, datatr, natr, datamx, namx,
+ selv, iztype, stndat, nlev, idtype, iret )
C************************************************************************
C* MR_UADT *
C* *
C* This subroutine merges mandatory and significant level data. *
C* *
C* MR_UADT ( DATMAN, NMAN, DATSGT, NSGT, DATSGW, NSGW, DATAMN, NAMN, *
C* DATAST, NAST, DATASW, NASW, DATMNW, NMNW, DATAMW, NAMW, *
C* DATTRP, NTRP, DATMXW, NMXW, DATATR, NATR, DATAMX, NAMX, *
C* SELV, IZTYPE, STNDAT, NLEV, IDTYPE, IRET ) *
C* *
C* Input parameters: *
C* DATMAN (6,NMAN) REAL Mandatory data below 100 mb *
C* NMAN INTEGER Number of levels *
C* DATSGT (3,NSGT) REAL Sig temp data below 100 mb *
C* NSGT INTEGER Number of levels *
C* DATSGW (3,NSGW) REAL Sig wind data below 100 mb *
C* NSGW INTEGER Number of levels *
C* DATAMN (6,NAMN) REAL Mandatory data above 100 mb *
C* NAMN INTEGER Number of levels *
C* DATAST (3,NAST) REAL Sig temp data above 100 mb *
C* NAST INTEGER Number of levels *
C* DATASW (3,NASW) REAL Sig wind data above 100 mb *
C* NASW INTEGER Number of levels *
C* DATMNW (3,NMNW) REAL Mandatory wind data below 100 mb*
C* NMNW INTEGER Number of levels *
C* DATAMW (3,NAMW) REAL Mandatory wind data above 100 mb*
C* NAMW INTEGER Number of levels *
C* DATTRP (5,NTRP) REAL Tropopause data below 100 mb *
C* NTRP INTEGER Number of levels *
C* DATMXW (3,NMXW) REAL Max wind data below 100 mb *
C* NMXW INTEGER Number of levels *
C* DATATR (5,NATR) REAL Tropopause data above 100 mb *
C* NATR INTEGER Number of levels *
C* DATAMX (3,NAMX) REAL Max wind data above 100 mb *
C* NAMX INTEGER Number of levels *
C* SELV REAL Surface elevation *
C* IZTYPE INTEGER Type of height interpolation *
C* 1 = int wrt log p *
C* 2 = moist hydrostatic comp *
C* 3 = scaled moist hydro comp *
C* *
C* Output parameters: *
C* STNDAT (6,NLEV) REAL Station data *
C* NLEV INTEGER Number of levels *
C* IDTYPE (NLEV) INTEGER Data type flags *
C* 1 = mandatory *
C* 2 = sig temperature *
C* 3 = sig wind *
C* IRET INTEGER Return code *
C* 0 = normal return *
C** *
C* Log: *
C* M. desJardins/GSFC 8/86 *
C* M. desJardins/GSFC 9/87 Added sig winds on pressure surfaces *
C* M. desJardins/GSFC 1/89 Added IDTYPE *
C* M. desJardins/GSFC 4/89 Changes for missing data *
C* K. Brill/NMC 01/92 Pass IZTYPE=1 to MR_INTP; CALL MR_COND *
C* to add below ground mand lvls *
C* D. Kidwell/NCEP 2/01 Added mand wind args and call to MR_MANW*
C* D. Kidwell/NCEP 3/01 Added tropopause and max wind data *
C************************************************************************
INCLUDE 'GEMPRM.PRM'
C
REAL datman (6,*), datsgt (3,*), datsgw (3,*),
+ datamn (6,*), datast (3,*), datasw (3,*),
+ datmnw (3,*), datamw (3,*), dattrp (5,*),
+ datmxw (3,*), datatr (5,*), datamx (3,*),
+ stndat (6,*)
INTEGER idtype (*)
C
INTEGER ipt ( LLMXLV )
REAL sclhgt ( LLMXLV )
LOGICAL zbwind, zawind
C------------------------------------------------------------------------
iret = 0
C
C* Initialize the scale height array.
C
DO i = 1, LLMXLV
sclhgt (i) = RMISSD
END DO
C
C* Check significant wind data to see if the data is reported on
C* pressure or height surfaces.
C
CALL MR_CHKW ( datsgw, nsgw, datasw, nasw, zbwind, zawind, ier )
C
C* Find the surface data.
C
CALL MR_SRFC ( datman, nman, datsgt, nsgt, datsgw, nsgw,
+ zbwind, selv, nlev, ipt, stndat, idtype, ier )
C
C* Merge the mandatory below 100 mb data and the mandatory above
C* data.
C
IF ( (nman .ge. 2) .or. (namn .ge. 1) )
+ CALL MR_MAND ( datman, nman, datamn, namn, nlev, ipt,
+ stndat, idtype, ier )
C
C* Merge the mandatory below 100 mb wind data and the mandatory
C* above wind data.
C
IF ( ( (nmnw .ge. 1) .or. (namw .ge. 1) ) .and. (nlev .ge. 2) )
+ CALL MR_MANW ( datmnw, nmnw, datamw, namw, nlev, stndat,
+ ier )
C
C* Merge the tropopause data.
C
IF ( ( ntrp .ge. 1 ) .or. ( natr .ge. 1 ) ) THEN
CALL MR_TROP ( dattrp, ntrp, datatr, natr, nlev, ipt,
+ stndat, idtype, ier )
END IF
C
C* Merge the significant temperature data.
C
IF ( ( nsgt .gt. 1 ) .or. ( nast .gt. 1 ) ) THEN
CALL MR_SIGT ( datsgt, nsgt, datast, nast, nlev, ipt,
+ stndat, idtype, ier )
END IF
C
C* Interpolate the height field.
C
IF ( iztype .eq. 2 ) THEN
CALL MR_MHGT ( nlev, ipt, stndat, sclhgt, ier )
ELSE IF ( iztype .eq. 3 ) THEN
CALL MR_SCMZ ( nlev, ipt, stndat, sclhgt, ier )
ELSE
CALL MR_INTZ ( nlev, ipt, stndat, ier )
END IF
C
C* Merge the significant wind data on pressure surfaces.
C
IF ( ( .not. zbwind ) .or. ( .not. zawind ) ) THEN
msgw = 0
masw = 0
IF ( .not. zbwind ) msgw = nsgw
IF ( .not. zawind ) masw = nasw
CALL MR_PWND ( datsgw, msgw, datasw, masw, nlev,
+ ipt, stndat, idtype, ier )
END IF
C
C* Merge the maximum wind data on pressure surfaces.
C
IF ( ( nmxw .ge. 1 ) .or. ( namx .ge. 1 ) ) THEN
CALL MR_PWND ( datmxw, nmxw, datamx, namx, nlev,
+ ipt, stndat, idtype, ier )
END IF
C
C* Reinterpolate height for wind surfaces.
C
CALL MR_INTZ ( nlev, ipt, stndat, ier )
C
C* Process the significant wind on height surfaces.
C
IF ( zbwind .or. zawind ) THEN
msgw = 0
masw = 0
IF ( zbwind ) msgw = nsgw
IF ( zawind ) masw = nasw
C
C* Merge the data.
C
CALL MR_SIGW ( datsgw, msgw, datasw, masw, nlev,
+ ipt, stndat, idtype, sclhgt, ier )
C
C* Interpolate missing pressures using heights.
C
CALL MR_INTP ( sclhgt, 1, nlev, ipt, stndat, ier )
END IF
C
C* Order data in output array.
C
CALL MR_ORDR ( nlev, ipt, stndat, idtype, ier )
C
C* Interpolate missing data.
C
C CALL MR_MISS ( nlev, stndat, ier )
C
C* Add in the underground mandatory levels.
C
CALL MR_COND ( datman, nman, nlev, stndat, idtype, ipt, ier )
C*
RETURN
END