PROGRAM MRMSPREP
C
C$$$ MAIN PROGRAM DOCUMENTATION BLOCK ***
C
C MAIN PROGRAM: MRMSPREP
C PRGMMER: KITZMILLER ORG: OHD?? DATE: 2009-03
C
C ABSTRACT: TO PERFORM GRIDDING OF MRMS LAT/LONG PIXEL DATA AND OUTPUT
C GRIDS IN TDLPAK VECTOR AND/OR GRID FORMAT. MRMS INGEST
C FILES ARE TIME-MATCHED AND IN NETCDF FORMAT. THE NUMBER
C OF TIME-MATCHED INGEST FILES IS SPECIFIED IN THE CONTROL FILE,
C AND IT IS ASSUMED THAT ALL INGEST FILES BETWEEN A BEGINNING AND
C ENDING (DATE) PROCESSING PERIOD ARE AVAILABLE, I.E., IF AN
C INGEST FILE IS ACTUALLY MISSING, A BOGUS FILE MUST BE
C SPECIFIED IN THE CONTROL FILE NEVERTHELESS, WHEREBY MISSING
C VALUES APPEAR IN THE OUTPUT GRID. CODE IS CONFIGURED TO
C PROCESS JUST ONE OF THE VARIABLES ACCOMMODATED IN A GIVEN
C RUN.
C
C SPECIAL NOTE: THIS CODE USES A NETCDF FILE CREATED BY WGRIB2, WHICH
C IS PART OF THE NCO GRIB_UTIL MODULE. THIS SOFTWARE
C IS BASED ON VERSION 1.0.0. IN MARCH 2017, A NEWER
C MODULE (V1.0.5) WAS INTRODUCED, AND THE ASSOCIATED
C WGRIB2 RESULTS IN DIFFERENT META DATA BEING WRITTEN
C TO THE NETCDF FILE. THEREFORE, WHENEVER V1.0.5 (OR
C NEWER) IS FORCED ON US, THE SECTION OF CODE THAT SETS
C NETCDF_VAR2 WILL NEED TO BE MODIFIED TO READ THE
C UPDATED META DATA. YOU CAN FIND THE CORRECT STRING
C OF CHARACTERS FROM THE NETCDF FILE IF YOU DO THE
C FOLLOWING FROM COMMAND LINE:
C
C ncdump -h netcdf.file
C
C THE BLOCK OF CODE IN QUESTION IS AT LABEL 170.
C
C
C PROGRAM HISTORY LOG:
C CHARBA SEP 2011 ADDED CODE TO ALSO OUTPUT A TDLPAK VECTOR
C FILE AND/OR A TDLPAK GRID FILE
C CHARBA DEC 2012 MODIFIED TO SPECIFY MAX VALUE IN THE OUT-
C PUT GRIDBOX ...PREVIOUSLY THE AVG VALUE
C WAS COMPUTED. ALSO CHANGED MINCOUNT FROM
C 5 TO 1 TO PREVENT APPEARANCE OF MISSINGS
C IN 2.5KM LC GRID.
C CHARBA JAN 2013 CLEANED UP THIS MAXVAL VERSION FOR REFLEC-
C TIVITY. ALSO REMOVED IXMRG( , ), WHICH
C WAS AN INTEGER*2 ARRAY CONTAINING THE
C GRIDDED OUTPUT VARIABLE ...USE OF THIS
C VARIABLE RESULTED IN TRUNCATION OF FRAC-
C TIONAL REFLECTIVITIES. CODE IS NOW
C SET UP TO RETAIN FRACTIONAL VALUES OF OUT-
C PUT VARIABLE, AND THE PACKING SCALING CON-
C STANT IS SET AS A PARAMETER IN .CTL FILE.
C CHARBA JAN 2013 ADDED PRINTS FOR STARTING AND ENDING TIME.
C ALSO, MODIFIED LOGIC FOR OPENING OUTPUT
C FILES TO AVOID 0-BYTE FILES WHEN
C 'ITYPE' = 1/2.
C CHARBA JAN 2013 ADDED 'IFIRST' TO CONTROL PRINT AT LABEL
C 1006.
C CHARBA JAN 2013 MADE CORRECTIONS WHERE CODE DEALS WITH
C THE VARIABLE UNITS AND SCALING.
C CHARBA JAN 2013 REVAMPED ENTIRE CODE AFTER LEARNING ABOUT
C NMQ VARIABLE UNITS/SCALING. ALSO CODE IS
C NOW CONFIGURED TO PROCESS ANY ONE OF THREE
C NMQ VARIABLES ...MAX 'cref', MAX 'etp18',
C AND AVG 'rad_hsr_1h'.
C CHARBA JAN 2013 AUGMENTED DOC AND ADDED DIAGNOSTIC PRINT
C FOR EACH GRIDDED VARIABLE FOR EACH DATE.
C CHARBA FEB 2013 ADDED A FOURTH NMQ VARIABLE, WHICH IS
C MAX 'preciprate_hsr'.
C CHARBA MAR 2013 ADDED A FIFTH NMQ VARIABLE, WHICH IS
C MAX 'vil '.
C CHARBA APR 2013 ADDED A FIX FOR VIL TO ACCOUNT FOR INCOR-
C RECT CODING OF MISSING.
C CHARBA APR 2013 CREATED THIS VERSION FOR ARCHIVING, WHERE-
C IN MOST DIAGNOSTIC WRITES ARE COMMENTED.
C CHARBA APR 2013 MODIFIED DOC FOR VIL. ALSO INCREASED
C UPPER BOUND ERROR THRESHOLD FROM 20 MM TO
C 25 MM.
C CHARBA APR 2013 INCREASED ERROR THRESHOLD FOR VIL FROM 25
C MM TO 50 MM. ALSO MODIFIED SUCH THAT A
C MISSING TILE DOES NOT ABORT CODE. INSTEAD
C MISSING VALUES ARE ASSIGNED FOR THE DO-
C MAIN OF THE MISSING TILE(S).
C FINALLY, WHEN A DATA VALUE FALLS OUTSIDE
C THE ERROR BOUNDS, A PRINT IS EXECUTED FOR
C EACH INSTANCE.
C CHARBA APR 2013 INCREASED UPPER ERROR BOUND FOR VIL FROM
C 25 MM TO 30 MM.
C CHARBA APR 2013 INCREASED UPPER ERROR BOUND FOR VIL FROM
C 30 MM TO 40 MM.
C CHARBA AUG 2013 ADJUSTED TEXT CHARACTERS IN 'CALL TIMPR'
C CHARBA AUG 2013 CONVERTED TO WCOSS, WHICH REQUIRED OPENING
C OUTPUT FILE AS BIG ENDIAN
C CHARBA SEP 2013 IMPROVED DOCUMENTATION
C CHARBA DEC 2013 ADDED A 6TH VARIABLE = MAX 'strmtop30'
C CHARBA JAN 2014 UPGRADED PRINT OUTPUT AND INPUT NUMBER OF
C MRMS INPUT FILES.
C CHARBA JAN 2014 REMOVED EXTRANEOUS PRINT FOR 'strmtop30'
C CHARBA JAN 2014 INCREASED UPPER ERROR BOUND FOR VIL FROM
C 40 MM TO 75 MM
C CHARBA JAN 2014 INCREASED UPPER ERROR BOUND FOR rad_hsr_1h
C FROM 70 MM TO 75 MM
C CHARBA JAN 2014 CHANGED GRIDBOX POSITIONING CONVENTION
C FROM LOWER-LEFT CORNER TO CENTERED
C CHARBA JAN 2014 MAJOR UPGRADE TO FORMAT OF CONTROL FILE,
C WHERE ONE CONTROL FILE IS USED FOR ALL
C VARIABLES, AND ADDED PARAMETER WHICH
C SPECIFIES CENTERED (0) OR LL (1) POSI-
C TIONING OF GRIDBOX. NEW FORMAT IS
C PATTERNED AFTER U523.CN.
C CHARBA JAN 2014 CORRECTED ERROR IN FORMAT SPECIFICATION.
C SAMPLATSKY FEB 2014 MADE ADJUSTMENTS TO ACCOUNT FOR READING
C NETCDF FILES WHICH ORIGINATED AS BINARY
C FILES. THIS CODE AS-IS WILL NOT WORK
C WITH THE NATIVE NETCDF FILES!
C CHARBA FEB 2014 INCREASED ARRAY DIMENSION FROM 1700 TO
C 2100 TO ALLOW CODE TO RUN FOR 8 CONVERT-
C ED TILES.
C KOCHENASH APR 2014 CONVERTED MRMS CREF REFLECTIVITIES (dBZ)
C TO RCM CATEGORIES.
C GHIRARDELLISEP 2016 CONVERTED TO RUN IN OPERATIONS
C SAMPLATSKY MAR 2017 TOOK MRMS2RCM AND SLIGHTLY ADJUSTED
C LOGIC TO PROCESS CONTINUOUS CREF, STP,
C VIL. ALSO ADDED SPECIAL NOTE ABOVE.
C CLEANED UP DOCUMENTATION WITHIN CODE
C AND REMOVED EXCESSIVE AMOUNT OF
C COMMENTED LINES.
C KOCHENASH MAR 2017 FIXED BUG IN PROCESSING OF STP AND VIL
C WHERE DATA VALUES WERE NOT BEING SCALED
C PROPERLY.
C SAMPLATSKY APR 2017 UPDATED W3TAGS TO SAY CORRECT CODE
C NAME
C SAMPLATSKY JUN 2017 COMMENTED SEVERAL PRINT STATEMENTS
C RELATING TO FERRCK WHICH COULD PRODUCE
C VOLUMINOUS OUTPUT.
C HUANG APR 2018 REDIFINED PLAIN TO BE 32 CHARACTER TO
C BE CONSISTENT WITH OTHER SUBROUTINES.
C ALSO INITIALIZED PLAIN AS 32 BLANK
C CHARACTERS.
C SAMPLATSKY SEP 2018 ADDED PROCESSING FOR 1H PRECIP NN AND
C AC GRIDS.
C
C USAGE:
C
C DATA SET USE
C INPUT FILES:
C FORT.KFILDI - UNIT NUMBER OF INPUT FILE. (INPUT)
C FORT.KFILDT - UNIT NUMBER WHERE THE DATE LIST IS LOCATED.
C (INPUT)
C CTL_FILE - CONTROL FILE NAME, COMMAND LINE ARGUMENT. (INPUT)
C INFILE - INPUT NETCDF FILE NAME DEFINED IN CONTROL FILE.
C (INPUT)
C
C OUTPUT FILES:
C FORT.KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT)
C OUTFILE - OUTPUT FILE NAME DEFINED IN CONTROL FILE. (OUTPUT)
C
C VARIABLES
C CREF = MAXIMUM COMPOSITE REFLECTIVITY (DBZ).
C ETP18 = MAXIMUM ECHO TOP HEIGHT (KM).
C KFILDT = THE UNIT NUMBER FOR WHERE THE DATE LIST IS
C LOCATED.
C RAD_HSR_1H = AVERAGE 1-HR PRECIPITATION AMOUNT (MM).
C PRECIPRATE_HSR = MAXIMUM PRECIPITATION RATE (MM/HR).
C VERT_INT_LIQ = MAXIMUM VERTICALLY INTEGRATED LIQUID (MM).
C STP30 = MAXIMUM STORM TOP HEIGHT (KM).
C
C PARAMETERS -
C RLAT1,RLON1, XMESH, ORIENT
C XLAT, NCOLS, NROWS : VALUES FOR NATIONAL-SCALE GRID
C NMQ_DIM, NMQ_2DIM: MAXIMUM COL/ROW DIMENSIONS OF
C INPUT NMQ DATA GRIDS
C NCOLS,NROWS: DIMENSIONS OF OUTPUT -GRID DATA
C DX, DY: LON/LAT NMQ GRID MESH LENGTHS, FROM GLOBAL ATTRIBS
C VSCALE: VARIABLE SCALE FACTOR, FROM VARIABLE ATTRIBS
C RMISS_UNSCALED, RMISS: FORMAL MISSING VALUE BOUND (UNSCALED),
C AND FINAL SCALED VALUE USED TO CHECK FOR MISSING POINTS. FROM
C VARIABLE ATTRIBUTES
C I_ONE: FIXED VALUE FOR INTEGER 1
C MINCOUNT: MINIMUM NUMBER OF NMQ VALUES REQUIRED TO DEFINE AN
C GRID BOX VALUE, PRESENTLY 5
C
C NETCDF_VAR: NETCDF VARIABLE TO BE INTERPOLATED (INPUT) (CHAR*20)
C APPLICATION CURRENTLY SUPPORTS 1h_hsr_rad, 24h_hsr_rad, hsr, vil, ETC.
C ISTRING: 66-CHAR STRING TO BE PUT IN OUTPUT XMRG FILE (INPUT THROUGH CONTROL
C FILE)
C ICOL1,IROW1,NCOLSX,NROWSX: GRID ANCHOR POINT AND NUMBER OF COLS, ROWS
C FOR OUTPUT (INPUT THROUGH CONTROL FILE)
C LON_ID,LAT_ID,IC_UNITS: INTERNAL CHARACTER*20 VARIABLES FOR RETRIEVING
C DATA THROUGH NETCDF INTERFACE
C
C I4XMRG(,): INTEGER ACCUMULATOR FOR INPUT DATA, DEFINED AS DIMENSIONS
C IXMRG(,): INTEGER*2 OUTPUT ARRAY FOR -GRIDDED DATA
C (NCOLS,NROWS) ...ELIMINATED JAN 2013 SINCE NOT NEEDED
C NMQTMP(NMQ_2DIM): HOLDS INPUT FROM NMQ DATASETS IN VECTOR FORM. INDEX
C INCREASES FIRST BY COLUMN (LONGITUDE) THEN BY ROW (LATITUDE) WHEN USING
C THESE FORTRAN API'S
C IX_MDR(113,89): TEMPORARY ARRAY, HOLDS 40-KM MDR GRID SUMMARY OF OUTPUT.
C OUTPUT VALUE IS MAX 4-KM VALUE IN THE 40-KM GRID BOX
C NCOUNT(NCOLS,NROWS): NUMBER OF NMQ VALUES FALLING IN EACH GRID BOX
C RLAT00, RLON00: ANCHOR LAT/LON OF NMQ TILE, IN DEG N AND DEG E (INPUT FROM
C NETCDF FILE)
C NLATS, NLONS: DIMENSIONS OF NMQ TILE (INPUT FROM NETCDF FILE)
C NCID: LOGICAL UNIT FOR NETCDF FILE, RETRIEVED FROM NF_OPEN (INTERNAL)
C IVID: VARIABLE NUMBER FOR NETCDF FIELD (INTERNAL)
C L_DBZ: LOGICAL*1 FLAG TO SPECIFY INTERPOLATION OF A DBZ VARIABLE
C (LOG-SCALE) RATHER THAN REGULAR-SCALE PRECIPITATION OR VIL
C OUTVAR: TEMPORARY VARIABLE FOR REAL-INTEGER CONVERSION
C ISCALD: SCALING CONSTANT USED FOR PACKING OUTPUT VARIABLE
C (INPUT)
C IFIRST: CONTROLS PRINT AT LABEL 1006. (DATA)
C
C SUBPROGRAMS CALLED: TIMPR, W3FB06, W3FB11, WRVTGD, PWOTGM,
C GET_NCEPDATE, W3TAGB, W3TAGE
C UNIQUE: - W3FB06, W3FB11, WRVTGD, PWOTGM
C LIBRARY:
C LMPMDL - TIMPR
C
C$$$
C
INCLUDE 'mrms2rcm_netcdf.inc'
C
C SET NMQ_2DIM LARGE ENOUGH TO ACCOMMODATE ALL PIXELS
C IN THE INPUT NETCDF TILES. FOR THE 4-TILE SETUP,
C THERE ARE 1750 LAT AND 3500 LON PIXELS.
C
PARAMETER (NMQ_2DIM=7000*3500)
C
C ND5 MUST BE AT LEAST 2953665 FOR 2145X1377 2.5KM NDFD GRID
C
PARAMETER (ND5=2960000,ND7=60,L3264B=32,L3264W=64/L3264B,NUMVAR=1)
PARAMETER (THRESH=0.01)
C
CHARACTER*80 INFILE, OUTFILE, CTL_FILE
CHARACTER*66 ISTRING
CHARACTER*20 LON_ID, LAT_ID,IC_UNITS
CHARACTER*14 NETCDF_VAR, CREF, ETP18, RAD_HSR_1H, PRECIPRATE_HSR,
1 VERT_INT_LIQ, STP30, RAD_1H_AC, RAD_1H_NN
CHARACTER*55 NETCDF_VAR2
C
CHARACTER*8 CCALL(ND5),STA8(1)
CHARACTER*1 STA1(8),XTMP
CHARACTER*32 PLAIN
CHARACTER*60 FILRO(3)
C
EQUIVALENCE (IPLAIN,PLAIN)
EQUIVALENCE (STA8,STA1)
C
INTEGER*4 NMQTMP(NMQ_2DIM)
INTEGER*4 ICOL,IROW
C
INTEGER*4,ALLOCATABLE :: I4XMRG(:,:)
INTEGER*2,ALLOCATABLE :: NCOUNT(:,:)
INTEGER*2,ALLOCATABLE :: NTOTAL(:,:)
INTEGER*2,ALLOCATABLE :: NTHRESH(:,:)
C
C NCOUNT( , ) NOT USED FOR MAX VALUE PROCESSING.
C
REAL,ALLOCATABLE :: F4XMRG(:,:)
REAL,ALLOCATABLE :: F4XMRGTMP(:,:)
REAL,ALLOCATABLE :: DATANN(:,:)
REAL,ALLOCATABLE :: DIST(:,:)
C
DIMENSION ISTA(ND5),NBYTES(2),KFILRO(3),ID(4)
C
REAL*4 RLAT00,RLON00,RNMQTMP(NMQ_2DIM)
REAL*4 RLAT01(3500),RLON01(7000)
C
DATA MINCOUNT/1/,IFIRST/0/
C
DATA CREF/'CREF '/ ! MX COMPOSITE REFLEC (DBZ)
DATA ETP18/'ETP '/ ! MX ECHO TOP HGT (KM)
DATA RAD_HSR_1H/'RAD_1H '/ ! AV 1H PRECIP AMT (MM)
DATA RAD_1H_AC/'RAD_1H_AC '/ ! RAD-ONLY 1H PCP AC (IN)
DATA RAD_1H_NN/'RAD_1H_NN '/ ! RAD-ONLY 1H PCP NN (IN)
DATA PRECIPRATE_HSR/'PRECIPRATE '/ ! MX PRECIP RATE (MM/HR)
DATA VERT_INT_LIQ/'VIL '/ ! MX VERT INT LIG (MM)
DATA STP30/'STRMTOP '/ ! MX STORM TOP HGT (KM)
C
DATA KFILDI/5/,KFILDO/6/,KFILDT/10/
DATA PLAIN/' '/
C
CALL W3TAGB('LMP_MRMSPREP',2016,0100,0050,'STI21')
CALL TIMPR(KFILDO,KFILDO,'START MRMSPREP ')
C
C GET CONTROL INFORMATION
C
C ALL CONTROL PARAMETERS FOR A RUN ARE INPUT FROM KFILDI, WHERE
C THE CORRESPONDING FILE IS SPECIFIED IN AN EXPORT FILE (___.CN)
C IN THE RUN SCRIPT.
C
C READ TEXT STRING THAT DESCRIBES A RUN SPECIFIED BY THE INPUT
C CONTROL FILE.
C
READ (KFILDI,50) ISTRING
50 FORMAT (A66)
WRITE(KFILDO,50) ISTRING
C
C READ IN VARIABLE ID TO FETCH.
C
DO NN=1,NUMVAR
READ (KFILDI,100) NETCDF_VAR,ISWITCH,VSCALE,RMISS_UNSCALED
C WRITE(KFILDO,*)"NETCDF_VAR (AJK) = ", NETCDF_VAR
100 FORMAT (A14,I2,1X,F7.1,1X,F7.1)
IF(ISWITCH.NE.1) THEN
C
C DID NOT SWITCH ON A VARIABLE TO PROCESS ...ABORT
C
WRITE(KFILDO,115)
115 FORMAT(' DID NOT SWITCH ON AN MRMS VARIABLE TO PROCESS',
2 ' ...STOP 115')
CALL W3TAGE('LMP_MRMSPREP')
STOP 115
ENDIF
C
116 WRITE (KFILDO,117) NETCDF_VAR,RMISS_UNSCALED,VSCALE
117 FORMAT(' RETRIEVE VARIABLE: ',A14,/,
1 ' MISSING INDICATOR: ',F7.1,/,
2 ' VSCALE: ',F7.1)
C
C READ TO END OF VARIABLE LIST, IF NECESSARY
C
IF(NN.LT.NUMVAR) THEN
DO MM=NN+1,NUMVAR
READ(KFILDI,100)
ENDDO
ENDIF
C
C READ IN OUTPUT GRID SPECS, GRIDBOX POSITION CONVEN, AND NUMBER
C OF INPUT FILES.
C
READ (KFILDI,120) RLAT1, RLON1, XMESH, ORIENT, XLAT,
2 MESH,NCOLS, NROWS, NPROJ, IPBOX, NUMFILE
120 FORMAT(5(F11.4/),5(I11/),I11)
C
WRITE (KFILDO,130) RLAT1, RLON1, XMESH, ORIENT, XLAT,
2 MESH,NCOLS, NROWS, NPROJ, IPBOX, NUMFILE
130 FORMAT(' LL CORNER LAT (DEG N) OF OUTPUT GRID = ',F12.4/,
2 ' LL CORNER LONG (DEG E) OF OUTPUT GRID = ',F12.4/,
3 ' GRID MESH (M) TRUE AT STD LAT OF OUTPUT GRID = ',F12.4/,
4 ' STD LONG (DEG E) OF OUTPUT GRID = ',F12.4/,
5 ' STD LAT (DEG N) OF OUTPUT GRID = ',F12.4/,
6 ' NOMINAL MESH LENGTH = ',I4/,
7 ' NUM GRID PTS IN X-DIR OF OUTPUT GRID = ',I4/,
8 ' NUM GRID PTS IN Y-DIR OF OUTPUT GRID = ',I4/,
9 ' MAP PROJECTION OF OUTPUT GRID = ',I2/,
A ' GRIDBOX POSITION (0 = CENTER; 1 = LWR LEFT) = ',I2/,
B ' NUMBER OF INPUT FILES (TILES) = ',I2)
C
C ALLOCATE AND INITIALIZE WORKING ARRAYS.
C
ALLOCATE(DIST(NCOLS,NROWS))
ALLOCATE(NTOTAL(NCOLS,NROWS))
ALLOCATE(NTHRESH(NCOLS,NROWS))
ALLOCATE(I4XMRG(NCOLS,NROWS))
ALLOCATE(NCOUNT(NCOLS,NROWS))
ALLOCATE(F4XMRG(NCOLS,NROWS))
ALLOCATE(DATANN(NCOLS,NROWS))
ALLOCATE(F4XMRGTMP(NCOLS,NROWS))
C
C INITIALIZE ALL VARIABLES WITH -9999
C
DO J=1,NROWS
DO I=1,NCOLS
NCOUNT(I,J) = 0 ! COUNTER ARRAY FOR OUTPUT VARIABLE
NTOTAL(I,J) = 0 ! WORK ARRAY FOR 1H PCP AC
NTHRESH(I,J) = 0 ! WORK ARRAY FOR 1H PCP AC
I4XMRG(I,J) = -9999 ! WORK ARRAY FOR OUTPUT VARIABLE
DIST(I,J) = 9999.0 ! WORK ARRAY FOR 1H PCP NN
DATANN(I,J) = 9999.0 ! WORK ARRAY FOR 1H PCP NN
END DO
END DO
C
C READ NAMES AND OPEN NMQ NETCDF INPUT FILES. LOOP OVER THE 8
C NETCDF TILES THAT SPAN THE CONUS.
C
DO N=1,NUMFILE
READ (KFILDI,160) INFILE
160 FORMAT (A80)
WRITE (KFILDO,*) 'INPUT NETCDF FILENAME/: ',INFILE
IEC = NF_OPEN(INFILE, NF_NOWRITE, NCID) ! NCID DEFINED HERE
C WRITE (KFILDO,*) 'RETCODE FROM NF_OPEN: ',IEC
IF (IEC .NE. NF_NOERR) WRITE (KFILDO,*) 'CANNOT OPEN NETCDF: ',
1 INFILE,' ...SUBSTITUTE MISSING INPUT DATA'
C
IF (IEC .EQ. NF_NOERR) THEN
C
C NF_NOERR SET TO 0 IN netcdf.inc
C
C PROCEED BELOW WHEN INGEST FILE WAS OPENED SUCCESSFULLY.
C RETRIEVE LAT AND LON DIMENSIONS.
C
LAT_ID = 'latitude'
LON_ID = 'longitude'
IEC1 = NF_INQ_DIMID(NCID,LAT_ID, IVID)
C WRITE (KFILDO,*) 'RETCODE FROM INQ FOR Lat ',IEC1,IVID
IEC2 = NF_INQ_DIMLEN(NCID,IVID,NLATS)
C WRITE (KFILDO,*) 'RETCODE FROM GET-DIM FOR Lat ',IEC2,NLATS
C
IEC1 = NF_INQ_DIMID(NCID,LON_ID, IVID)
C WRITE (KFILDO,*) 'RETCODE FROM INQ FOR Lon ',IEC1,IVID
IEC2 = NF_INQ_DIMLEN(NCID,IVID,NLONS)
C WRITE (KFILDO,*) 'RETCODE FROM GET-DIM FOR Lon ',IEC2,NLONS
C
C RETRIEVE UNITS TO DETERMINE IF IT IS REFLECTIVITY AND
C RETRIEVE OTHER VARIABLE ATTRIBUTES.
C
C TWO FUNCTIONS BELOW FETCH DESIRED (FLOATING PT) VARIABLE.
C
170 IF(NETCDF_VAR.EQ.CREF) THEN
NETCDF_VAR2=
1 'MergedReflectivityQCComposite_500mabovemeansealevel'
ELSEIF(NETCDF_VAR.EQ.ETP18) THEN
NETCDF_VAR2='EchoTop18_500mabovemeansealevel'
ELSEIF(NETCDF_VAR.EQ.PRECIPRATE_HSR) THEN
NETCDF_VAR2='var209_6_1_0mabovemeansealevel'
ELSEIF(NETCDF_VAR.EQ.VERT_INT_LIQ) THEN
NETCDF_VAR2='VIL_500mabovemeansealevel'
ELSEIF(NETCDF_VAR.EQ.STP30) THEN
NETCDF_VAR2='EchoTop30_500mabovemeansealevel'
ELSEIF(NETCDF_VAR.EQ.RAD_1H_AC) THEN
NETCDF_VAR2='RadarOnlyQPE01H_0mabovemeansealevel'
ELSEIF(NETCDF_VAR.EQ.RAD_1H_NN) THEN
NETCDF_VAR2='RadarOnlyQPE01H_0mabovemeansealevel'
ENDIF
C WRITE (KFILDO,*) 'VAR:', NETCDF_VAR2
IEC1 = NF_INQ_VARID(NCID,NETCDF_VAR2,IVID)
IEC2 = NF_GET_VAR_REAL(NCID,IVID,RNMQTMP)
C WRITE (KFILDO,*) 'RETCODES FROM DESIRED VARIABLE INQUIRY ',
C 1 'AND RETRIEVE: ',IEC1,IEC2
C WRITE (KFILDO,*) RNMQTMP
IEC1 = NF_INQ_VARID(NCID,'latitude',IVID)
IEC2 = NF_GET_VAR_REAL(NCID,IVID,RLAT01)
C WRITE (KFILDO,*) 'LAT: '
C WRITE (KFILDO,*) RLAT01
IEC1 = NF_INQ_VARID(NCID,'longitude',IVID)
IEC2 = NF_GET_VAR_REAL(NCID,IVID,RLON01)
RLON01=RLON01-360.0
C WRITE (KFILDO,*) 'LON: '
C WRITE (KFILDO,*) RLON01
C
C FETCH UNITS FOR VARIABLE READ INTO NMQTMP( ).
C
IC_UNITS=' ' ! IC_UNITS - CHAR*20
C IEC1 = NF_GET_ATT_TEXT(NCID,IVID,'Units',IC_UNITS)
C WRITE (KFILDO,*) 'RET CODE AND VALUE FOR Units: ',IEC1,
C 1 IC_UNITS
C
C BOTH VSCALE AND RMISS_UNSCALED READ IN FROM CTL FILE
C
RMISS = VSCALE * RMISS_UNSCALED
C
C For 'CREF' VSCALE=10.0; RMISS_UNSCALED=-999.0;
C RMISS=-9990.0.
C Lowest value=-99.0 which denotes no radar
C return signal (later set to 0.0 dbz)
C For 'ETP' VSCALE=1000.0; RMISS_UNSCALED=-1.0;
C RMISS=-1000.0.
C Echo top not avail=-1.0 (later set to 9999.0;
C units=km-msl)
C For 'PRECIPRATE' VSCALE=10.0; RMISS_UNSCALED=-999.0;
C RMISS=-9990.0; No precip = 0.0 mm/hr
C For 'RAD_1H' VSCALE=10.0; RMISS_UNSCALED=-999.0;
C RMISS=-9990.0; No precip = 0.0 mm
C For 'VIL' VSCALE=10.0; RMISS_UNSCALED=-999.0;
C RMISS=-9990.0;
C Vil not avail = -999.0 (arc error
C ...later set to 9999.0)
C For 'STRMTOP' VSCALE=1000.0; RMISS_UNSCALED=-1.0;
C RMISS=-1000.0.
C Storm top not avail=-1.0 (later set to 9999.0;
C units=km-msl)
C
IEC = NF_CLOSE(NCID)
C
NPT = 0
NMQD = NLATS*NLONS
ICOL = 0
IROW = 1
C
C TO MINIMIZE PROCESSING TIME SEPARATE GRIDDING LOOPS ARE
C USED FOR EACH VARIABLE.
C
IF (NETCDF_VAR.EQ.CREF) THEN
C
C OBTAIN MAX CREF (DBZ) IN GRIDBOX
C
rmaxtmp=-9999.0
rmintmp=9999.0
DO I=1,NMQD
NMQTMP(I)=IFIX(VSCALE*RNMQTMP(I))
if (nmqtmp(i).gt.rmaxtmp) rmaxtmp=nmqtmp(i)
if (nmqtmp(i).lt.rmintmp) rmintmp=nmqtmp(i)
ICOL = ICOL + 1
IF (ICOL.GT.NLONS) THEN
IROW = IROW + 1
ICOL = 1
END IF
RLAT = RLAT01(IROW)
RLON = RLON01(ICOL)
IF (NMQTMP(I).GT.RMISS) THEN ! RMISS=-9990.
C
C PROCEED BELOW FOR NON-MISSING VALUE. RLAT AND RLON
C SPECIFY LOCATION OF NMQ PIXEL.
C
IF (NPROJ.EQ.5) THEN
CALL W3FB06(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XI,XJ)
ELSE IF (NPROJ.EQ.3) THEN
CALL W3FB11(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XLAT,XI,XJ)
ELSE
WRITE(KFILDO,200) NPROJ
200 FORMAT(' NPROJ NE 3 OR 5 ... =',I4,' ...STOP 200')
CALL W3TAGE('LMP_MRMSPREP')
STOP 200
END IF
C
IF(IPBOX.EQ.0) THEN
C PIXEL IS POSITIONED AT CENTER OF (OUTPUT) GRIDBOX
IH = NINT(XI)
JH = NINT(XJ)
ELSE
C PIXEL IS POSITIONED AT LL CORNER OF (OUTPUT) GRIDBOX
IH = XI
JH = XJ
ENDIF
C
C IF NMQ PIXEL FALLS WITHIN THE OUTPUT GRID, INCREMENT
C COUNTER AND OBTAIN MAX PIXEL VALUE FALLING IN GRIDBOX
C (IH,JH).
C
IF ((IH.LT.1).OR.(IH.GT.NCOLS)) CYCLE
IF ((JH.LT.1).OR.(JH.GT.NROWS)) CYCLE
NCOUNT(IH,JH) = NCOUNT(IH,JH) + 1 ! NA FOR MAX CALC
C
C NMQTMP(I)=-990, WHERE BACKSCATTER SIGNAL DETECTED BUT
C IT IS BELOW MEASURABLE LEVEL ...SET NMQTMP(I) = 0.
C
IF (NMQTMP(I).EQ.-990) NMQTMP(I) = 0
C
C I4XMRG( , ) INITIALIZED TO -9999, SO CK BELOW IS
C VALID.
C
IF (NMQTMP(I).GT.I4XMRG(IH,JH)) I4XMRG(IH,JH) =
1 NMQTMP(I)
C
C PRINT OUT NMQTMP(I) IF IT LIES OUTSIDE OF ERROR
C BOUNDS.
C
FERRCK=NMQTMP(I)/VSCALE
C IF((FERRCK.LT.-7.5).OR.(FERRCK.GT.75.0))
C 1 WRITE(KFILDO,210) IH,JH,I,RLAT,RLON,NMQTMP(I),
C 2 I4XMRG(IH,JH)
210 FORMAT(' FOR IH JH I = ',2I4.3,I8,
1 ' AT RLAT RLON = ',2F9.4,
2 ' NMQTMP I4XMRG = ',2I6,
3 ' ARE OUTSIDE ERROR BOUNDS')
C
C NPT IS THE SUM (OVER THIS TILE) OF ALL PIXELS USED
C FOR SPECIFYING THE DESIRED VARIABLE.
C
NPT = NPT + 1
C
ELSE
C
IF(IFIRST.EQ.0) THEN
C
C HERE NMQTMP(I) AND RMISS HAVE VALUES OF -9990 AND
C -9990.0, RESPECTIVELY. PRINT BELOW PRODUCES
C MASSIVE OUTPUT, SO PRINT ONLY FOR FIRST INSTANCE.
C
C WRITE(KFILDO,220) I,RLAT,RLON,NMQTMP(I),RMISS
C220 FORMAT(' FOR I LAT LONQ = ',I10,2F10.4,
C 1 ' NMQ CREF, RMISS = ',I10,F10.4,
C 2 ' ...PRINT ONLY FIRST INSTANCE ...CONTINUE')
IFIRST=1
C
ENDIF
C
ENDIF
C
END DO
write(kfildo,211) rmintmp,rmaxtmp
211 format(/,' for cref, min and max from netcdf = ',2f8.1)
C
ELSEIF(NETCDF_VAR.EQ.ETP18) THEN
C
C OBTAIN MAX ECHO TOP HGT (KM MSL) IN GRIDBOX
C
DO I=1,NMQD
ICOL = ICOL + 1
IF (ICOL.GT.NLONS) THEN
IROW = IROW + 1
ICOL = 1
END IF
RLAT = RLAT01(IROW)
RLON = RLON01(ICOL)
IF (NMQTMP(I).GT.RMISS) THEN ! RMISS=-1000.
C
C PROCEED BELOW FOR NON-MISSING VALUE. RLAT AND RLON
C SPECIFY LOCATION OF NMQ PIXEL.
C
IF (NPROJ.EQ.5) THEN
CALL W3FB06(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XI,XJ)
ELSE IF (NPROJ.EQ.3) THEN
CALL W3FB11(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XLAT,XI,XJ)
ELSE
WRITE(KFILDO,240) NPROJ
240 FORMAT(' NPROJ NE 3 OR 5 ... =',I4,' ...STOP 240')
CALL W3TAGE('LMP_MRMSPREP')
STOP 240
END IF
C
IF(IPBOX.EQ.0) THEN
C PIXEL IS POSITIONED AT CENTER OF (OUTPUT) GRIDBOX
IH = NINT(XI)
JH = NINT(XJ)
ELSE
C PIXEL IS POSITIONED AT LL CORNER OF (OUTPUT) GRIDBOX
IH = XI
JH = XJ
ENDIF
C
C IF NMQ PIXEL FALLS WITHIN THE OUTPUT GRID, INCREMENT
C COUNTER AND OBTAIN MAX PIXEL VALUE FALLING IN GRIDBOX
C (IH,JH).
C
IF ((IH.LT.1).OR.(IH.GT.NCOLS)) CYCLE
IF ((JH.LT.1).OR.(JH.GT.NROWS)) CYCLE
NCOUNT(IH,JH) = NCOUNT(IH,JH) + 1 ! NA FOR MAX CALC
C
C FOR NO ECHO TOP NMQTMP(I)=-1000 (WHICH IS THE SAME AS
C FOR MISSING!). IN THIS CASE "NEGATIVE" BRANCH OF
C IF/THEN ABOVE IS TAKEN, SO I4XMRG( , ) IS UNCHANGED.
C
IF (NMQTMP(I).GT.I4XMRG(IH,JH)) I4XMRG(IH,JH) =
1 NMQTMP(I)
C
C PRINT OUT NMQTMP(I) IF IT LIES OUTSIDE OF ERROR
C BOUNDS.
C
FERRCK=NMQTMP(I)/VSCALE
C IF((FERRCK.LT.0.0).OR.(FERRCK.GT.19.0))
C 1 WRITE(KFILDO,210) IH,JH,I,RLAT,RLON,NMQTMP(I),
C 2 I4XMRG(IH,JH)
C
C NPT IS THE SUM (OVER THIS TILE) OF ALL PIXELS USED
C FOR SPECIFYING THE DESIRED VARIABLE.
C
NPT = NPT + 1
C
ELSE
C
IF(IFIRST.EQ.0) THEN
C
C HERE NMQTMP(I) AND RMISS HAVE VALUES OF -1000 AND
C -1000.0, RESPECTIVELY. PRINT BELOW PRODUCES
C MASSIVE OUTPUT, SO PRINT ONLY FOR FIRST INSTANCE.
C
C WRITE(KFILDO,260) I,RLAT,RLON,NMQTMP(I),RMISS
C260 FORMAT(' FOR I LAT LONQ = ',I10,2F10.4,
C 1 ' NMQ ETP18, RMISS = ',I10,F10.4,
C 2 ' ...PRINT ONLY FIRST INSTANCE ...CONTINUE')
IFIRST=1
C
ENDIF
C
ENDIF
C
END DO
C
ELSEIF(NETCDF_VAR.EQ.PRECIPRATE_HSR) THEN
C
C OBTAIN MAX PRECIP RATE (MM/HR) IN GRIDBOX
C
DO I=1,NMQD
ICOL = ICOL + 1
IF (ICOL.GT.NLONS) THEN
IROW = IROW + 1
ICOL = 1
END IF
RLAT = RLAT01(IROW)
RLON = RLON01(ICOL)
IF (NMQTMP(I).GT.RMISS) THEN ! RMISS=-9990.
C
C PROCEED BELOW FOR NON-MISSING VALUE. RLAT AND RLON
C SPECIFY LOCATION OF NMQ PIXEL.
C
IF (NPROJ.EQ.5) THEN
CALL W3FB06(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XI,XJ)
ELSE IF (NPROJ.EQ.3) THEN
CALL W3FB11(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XLAT,XI,XJ)
ELSE
WRITE(KFILDO,270) NPROJ
270 FORMAT(' NPROJ NE 3 OR 5 ... =',I4,' ...STOP 270')
CALL W3TAGE('LMP_MRMSPREP')
STOP 270
END IF
C
IF(IPBOX.EQ.0) THEN
C PIXEL IS POSITIONED AT CENTER OF (OUTPUT) GRIDBOX
IH = NINT(XI)
JH = NINT(XJ)
ELSE
C PIXEL IS POSITIONED AT LL CORNER OF (OUTPUT) GRIDBOX
IH = XI
JH = XJ
ENDIF
C
C IF NMQ PIXEL FALLS WITHIN THE OUTPUT GRID, INCREMENT
C COUNTER AND OBTAIN MAX PIXEL VALUE FALLING IN GRIDBOX
C (IH,JH).
C
IF ((IH.LT.1).OR.(IH.GT.NCOLS)) CYCLE
IF ((JH.LT.1).OR.(JH.GT.NROWS)) CYCLE
NCOUNT(IH,JH) = NCOUNT(IH,JH) + 1 ! NA FOR MAX CALC
C
C I4XMRG( , ) INITIALIZED TO -9999, SO CK BELOW IS
C VALID.
C
IF (NMQTMP(I).GT.I4XMRG(IH,JH)) I4XMRG(IH,JH) =
1 NMQTMP(I)
C
C PRINT OUT NMQTMP(I) IF IT LIES OUTSIDE OF ERROR
C BOUNDS.
C
FERRCK=NMQTMP(I)/VSCALE
C IF((FERRCK.LT.0.0).OR.(FERRCK.GT.150.0))
C 1 WRITE(KFILDO,210) IH,JH,I,RLAT,RLON,NMQTMP(I),
C 2 I4XMRG(IH,JH)
C
C NPT IS THE SUM (OVER THIS TILE) OF ALL PIXELS USED
C FOR SPECIFYING THE DESIRED VARIABLE.
C
NPT = NPT + 1
C
ELSE
C
IF(IFIRST.EQ.0) THEN
C
C HERE NMQTMP(I) AND RMISS HAVE VALUES OF -9990 AND
C -9990.0, RESPECTIVELY. PRINT BELOW PRODUCES
C MASSIVE OUTPUT, SO PRINT ONLY FOR FIRST INSTANCE.
C
C WRITE(KFILDO,275) I,RLAT,RLON,NMQTMP(I),RMISS
C275 FORMAT(' FOR I LAT LONQ = ',I10,2F10.4,
C 1 ' NMQ PRECIPRATE_HSR, RMISS = ',I10,F10.4,
C 2 ' ...PRINT ONLY FIRST INSTANCE ...CONTINUE')
IFIRST=1
C
ENDIF
C
ENDIF
C
END DO
C
ELSEIF(NETCDF_VAR.EQ.VERT_INT_LIQ) THEN
C
C OBTAIN MAX VIL (MM) IN GRIDBOX
C
DO I=1,NMQD
NMQTMP(I)=IFIX(VSCALE*RNMQTMP(I)) ! fgs
ICOL = ICOL + 1
IF (ICOL.GT.NLONS) THEN
IROW = IROW + 1
ICOL = 1
END IF
RLAT = RLAT01(IROW)
RLON = RLON01(ICOL)
C
C MISSING IS DENOTED -99.0 IN INGESTED (REAL) DATA.
C AFTER APPLYING SCALE FACTOR AND SETTING TO INTEGER,
C THIS BECOMES -990.
C
IF (NMQTMP(I).GT.RMISS) THEN ! RMISS=-990.
C
C PROCEED BELOW FOR NON-MISSING VALUE. RLAT AND RLON
C SPECIFY LOCATION OF NMQ PIXEL.
C
IF (NPROJ.EQ.5) THEN
CALL W3FB06(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XI,XJ)
ELSE IF (NPROJ.EQ.3) THEN
CALL W3FB11(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XLAT,XI,XJ)
ELSE
WRITE(KFILDO,276) NPROJ
276 FORMAT(' NPROJ NE 3 OR 5 ... =',I4,' ...STOP 276')
CALL W3TAGE('LMP_MRMSPREP')
STOP 276
END IF
C
IF(IPBOX.EQ.0) THEN
C PIXEL IS POSITIONED AT CENTER OF (OUTPUT) GRIDBOX
IH = NINT(XI)
JH = NINT(XJ)
ELSE
C PIXEL IS POSITIONED AT LL CORNER OF (OUTPUT) GRIDBOX
IH = XI
JH = XJ
ENDIF
C
C IF NMQ PIXEL FALLS WITHIN THE OUTPUT GRID, INCREMENT
C COUNTER AND OBTAIN MAX PIXEL VALUE FALLING IN GRIDBOX
C (IH,JH).
C
IF ((IH.LT.1).OR.(IH.GT.NCOLS)) CYCLE
IF ((JH.LT.1).OR.(JH.GT.NROWS)) CYCLE
NCOUNT(IH,JH) = NCOUNT(IH,JH) + 1 ! NA FOR MAX CALC
C
C I4XMRG( , ) INITIALIZED TO -9999, SO CK BELOW IS
C VALID.
C
IF (NMQTMP(I).GT.I4XMRG(IH,JH)) I4XMRG(IH,JH) =
1 NMQTMP(I)
C
C PRINT OUT NMQTMP(I) IF IT LIES OUTSIDE OF ERROR
C BOUNDS.
C
FERRCK=NMQTMP(I)/VSCALE
C IF((FERRCK.LT.0.0).OR.(FERRCK.GT.75.0))
C 1 WRITE(KFILDO,210) IH,JH,I,RLAT,RLON,NMQTMP(I),
C 2 I4XMRG(IH,JH)
C
C NPT IS THE SUM (OVER THIS TILE) OF ALL PIXELS USED
C FOR SPECIFYING THE DESIRED VARIABLE.
C
NPT = NPT + 1
C
ELSE
C
IF(IFIRST.EQ.0) THEN
C
C HERE NMQTMP(I) AND RMISS HAVE VALUES OF -990 AND
C -990.0, RESPECTIVELY. PRINT BELOW PRODUCES
C MASSIVE OUTPUT, SO PRINT ONLY FOR FIRST INSTANCE.
C
C WRITE(KFILDO,277) I,RLAT,RLON,NMQTMP(I),RMISS
C277 FORMAT(' FOR I LAT LONQ = ',I10,2F10.4,
C 1 ' NMQ VERT_INT_LIQ, RMISS = ',I10,F10.4,
C 2 ' ...PRINT ONLY FIRST INSTANCE ...CONTINUE')
IFIRST=1
C
ENDIF
C
ENDIF
C
END DO
C
ELSEIF(NETCDF_VAR.EQ.STP30) THEN
C
C OBTAIN MAX STORM HGT (KM MSL) IN GRIDBOX
C
DO I=1,NMQD
NMQTMP(I)=IFIX(VSCALE*RNMQTMP(I)) ! fgs
ICOL = ICOL + 1
IF (ICOL.GT.NLONS) THEN
IROW = IROW + 1
ICOL = 1
END IF
RLAT = RLAT01(IROW)
RLON = RLON01(ICOL)
IF (NMQTMP(I).GT.RMISS) THEN ! RMISS=-1000.
C
C PROCEED BELOW FOR NON-MISSING VALUE. RLAT AND RLON
C SPECIFY LOCATION OF NMQ PIXEL.
C
IF (NPROJ.EQ.5) THEN
CALL W3FB06(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XI,XJ)
ELSE IF (NPROJ.EQ.3) THEN
CALL W3FB11(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XLAT,XI,XJ)
ELSE
WRITE(KFILDO,278) NPROJ
278 FORMAT(' NPROJ NE 3 OR 5 ... =',I4,' ...STOP 278')
CALL W3TAGE('LMP_MRMSPREP')
STOP 278
END IF
C
IF(IPBOX.EQ.0) THEN
C PIXEL IS POSITIONED AT CENTER OF (OUTPUT) GRIDBOX
IH = NINT(XI)
JH = NINT(XJ)
ELSE
C PIXEL IS POSITIONED AT LL CORNER OF (OUTPUT) GRIDBOX
IH = XI
JH = XJ
ENDIF
C
C IF NMQ PIXEL FALLS WITHIN THE OUTPUT GRID, INCREMENT
C COUNTER AND OBTAIN MAX PIXEL VALUE FALLING IN GRIDBOX
C (IH,JH).
C
IF ((IH.LT.1).OR.(IH.GT.NCOLS)) CYCLE
IF ((JH.LT.1).OR.(JH.GT.NROWS)) CYCLE
NCOUNT(IH,JH) = NCOUNT(IH,JH) + 1 ! NA FOR MAX CALC
C
C FOR NO STORM TOP NMQTMP(I)=-1000 (WHICH IS THE SAME AS
C FOR MISSING!). IN THIS CASE "NEGATIVE" BRANCH OF
C IF/THEN ABOVE IS TAKEN, SO I4XMRG( , ) IS UNCHANGED.
C
IF (NMQTMP(I).GT.I4XMRG(IH,JH)) I4XMRG(IH,JH) =
1 NMQTMP(I)
C
C PRINT OUT NMQTMP(I) IF IT LIES OUTSIDE OF ERROR
C BOUNDS.
C
FERRCK=NMQTMP(I)/VSCALE
C IF((FERRCK.LT.0.0).OR.(FERRCK.GT.19.0))
C 1 WRITE(KFILDO,210) IH,JH,I,RLAT,RLON,NMQTMP(I),
C 2 I4XMRG(IH,JH)
C
C NPT IS THE SUM (OVER THIS TILE) OF ALL PIXELS USED
C FOR SPECIFYING THE DESIRED VARIABLE.
C
NPT = NPT + 1
C
ELSE
C
IF(IFIRST.EQ.0) THEN
C
C HERE NMQTMP(I) AND RMISS HAVE VALUES OF -1000 AND
C -1000.0, RESPECTIVELY. PRINT BELOW PRODUCES
C MASSIVE OUTPUT, SO PRINT ONLY FOR FIRST INSTANCE.
C
C WRITE(KFILDO,279) I,RLAT,RLON,NMQTMP(I),RMISS
C279 FORMAT(' FOR I LAT LONQ = ',I10,2F10.4,
C 1 ' NMQ STP30, RMISS = ',I10,F10.4,
C 2 ' ...PRINT ONLY FIRST INSTANCE ...CONTINUE')
IFIRST=1
C
ENDIF
C
ENDIF
C
END DO
C
ELSEIF(NETCDF_VAR.EQ.RAD_HSR_1H) THEN
C
C BELOW IS FOR 1-H PRECIP AMT ...COMPUTE AVG VALUE
C
C READ IN AND ACCUMULATE PRECIP AMT FOR FOR NMQ PIXELS THAT
C FALL IN GRIDBOXES.
C
C INITIALIZE COUNTER FOR NUMBER OF PIXELS IN TILE WITH NEG
C "NON-MISSING" 1-H PRECIP.
C
NEGPCPIX=0
DO I=1,NMQD
ICOL = ICOL + 1
IF (ICOL.GT.NLONS) THEN
IROW = IROW + 1
ICOL = 1
END IF
RLAT = RLAT01(IROW)
RLON = RLON01(ICOL)
IF (NMQTMP(I).GT.RMISS) THEN ! RMISS=-9990.
IF (NPROJ.EQ.5) THEN
CALL W3FB06(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XI,XJ)
ELSE IF (NPROJ.EQ.3) THEN
CALL W3FB11(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XLAT,XI,XJ)
ELSE
WRITE(KFILDO,280) NPROJ
280 FORMAT(' NPROJ NE 3 OR 5 ... =',I4,' ...STOP 280')
CALL W3TAGE('LMP_MRMSPREP')
STOP 280
END IF
C
IF(IPBOX.EQ.0) THEN
C PIXEL IS POSITIONED AT CENTER OF (OUTPUT) GRIDBOX
IH = NINT(XI)
JH = NINT(XJ)
ELSE
C PIXEL IS POSITIONED AT LL CORNER OF (OUTPUT) GRIDBOX
IH = XI
JH = XJ
ENDIF
C
IF ((IH.LT.1).OR.(IH.GT.NCOLS)) CYCLE
IF ((JH.LT.1).OR.(JH.GT.NROWS)) CYCLE
C INCREMENT COUNTER FOR PIXELS WITH NEGATIVE PRECIP AMT
C AND "CYCLE"
IF (NMQTMP(I).LT.0) NEGPCPIX=NEGPCPIX+1
IF (NMQTMP(I).LT.0) CYCLE
NCOUNT(IH,JH) = NCOUNT(IH,JH) + 1
C
C NON-MISSING PRECIP IN NMQTMP( ) SHOULD BE 0 OR POS,
C SO SUM THEM UP. NOTE: I4XMRG( , ) INITIALIZED TO
C -9999, SO MUST FIRST SET IT TO 0.
C
IF(I4XMRG(IH,JH).EQ.-9999) I4XMRG(IH,JH)=0
I4XMRG(IH,JH) = I4XMRG(IH,JH) + NMQTMP(I)
C
C PRINT OUT NMQTMP(I) IF IT LIES OUTSIDE OF ERROR
C BOUNDS.
C
FERRCK=NMQTMP(I)/VSCALE
C IF((FERRCK.LT.0.0).OR.(FERRCK.GT.75.0))
C 1 WRITE(KFILDO,210) IH,JH,I,RLAT,RLON,NMQTMP(I),
C 2 I4XMRG(IH,JH)
C
NPT = NPT + 1
ELSE
C
IF(IFIRST.EQ.0) THEN
C
C HERE NMQTMP(I) AND RMISS HAVE VALUES OF -9990 AND
C -9990.0, RESPECTIVELY. PRINT BELOW PRODUCES
C MASSIVE OUTPUT, SO PRINT ONLY FOR FIRST INSTANCE.
C
C WRITE(KFILDO,290) I,RLAT,RLON,NMQTMP(I),RMISS
C290 FORMAT(' FOR I LAT LONQ = ',I10,2F10.4,
C 1 ' NMQ RAD_HSR_1H, RMISS = ',I10,F10.4,
C 2 ' ...PRINT ONLY FIRST INSTANCE ...CONTINUE')
IFIRST=1
C
ENDIF
C
ENDIF
C
END DO
C
C PRINT NUMBER OF PIXELS IN TILE WITH NEG "NON-MISSING"
C PRECIP.
C
IF(NEGPCPIX.GT.0) WRITE(KFILDO,290) N,NEGPCPIX
290 FORMAT(' TILE = ',I2,' HAD ',I10,' PIXELS WITH NEG RAD_HSR',
1 '_1H WHICH WERE NOT USED IN THE AVG COMPUTATION')
C
ELSE IF(NETCDF_VAR.EQ.RAD_1H_NN) THEN
C
C RNMQTMP( ) CONTAINS THE MRMS DATA AT THE RAW .01 DEGREE
C LAT/LON PIXELS. BELOW WILL DETERMINE WHAT GRID BOX
C EACH PIXEL FALLS IN. NOTE THAT RNMQTMP( ) WILL BE IN MM
C SO IF THE VALUE IS POSITIVE, CONVERT TO INCHES.
C
DO I=1,NMQD
C NMQTMP(I)=IFIX(VSCALE*RNMQTMP(I))
IF (RNMQTMP(I).GE.0.0) RNMQTMP(I)=RNMQTMP(I)/25.4
ICOL = ICOL + 1
IF (ICOL.GT.NLONS) THEN
IROW = IROW + 1
ICOL = 1
END IF
RLAT = RLAT01(IROW)
RLON = RLON01(ICOL)
C RLAT = RLAT00 - DY*(FLOAT(IROW-1))
C RLON = RLON00 + DX*(FLOAT(ICOL-1))
C
C WHEN THE VALUES ARE POSITIVE (NEGATIVE REPRESENTS
C MISSING OR AN ERROR), COMPUTE THE GRID COORDINATE
C OF THIS MRMS PIXEL.
C
IF (RNMQTMP(I).GE.0.0) THEN
IF (NPROJ.EQ.5) THEN
CALL W3FB06(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XI,XJ)
ELSE IF (NPROJ.EQ.3) THEN
CALL W3FB11(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XLAT,XI,XJ)
ELSE
WRITE(KFILDO,291) NPROJ
291 FORMAT(' NPROJ NE 3 OR 5, NPROJ =',I4,' ...STOP 291')
STOP 291
END IF
C
C IF IPBOX=0, THE DATA IS CENTERED IN THE GRID BOX
C IF IPBOX=1, THE DATA IS AT THE LOWER LEFT CORNER
C
IF(IPBOX.EQ.0) THEN
IH = NINT(XI)
JH = NINT(XJ)
ELSE
IH = XI
JH = XJ
ENDIF
C
C ONLY WORK WITH DATA THAT FALLS WITHIN THE BOUNDS OF
C THE GRID.
C
IF ((IH.LT.1).OR.(IH.GT.NCOLS)) CYCLE
IF ((JH.LT.1).OR.(JH.GT.NROWS)) CYCLE
C
C AT THIS POINT, THE DATA WILL BE TREATED AS VALID.
C PERFORM ALL NECESSARY PROCESSING FOR EACH NEEDED
C GRID. N=1 TO NTRESH IS FOR ALL THRESHOLDS TO BE
C PROCESSED FOR FRACTIONAL COVERAGE, AND N=NTHRESH+1
C WILL BE FOR THE NEAREST NEIGHBOR.
C
RDIST=(((XI-FLOAT(IH))**2)+((XJ-FLOAT(JH))**2))**0.5
IF (RDIST.LT.DIST(IH,JH)) THEN
DIST(IH,JH)=RDIST
DATANN(IH,JH)=RNMQTMP(I)
END IF
C
ENDIF
C
END DO
C
ELSE IF(NETCDF_VAR.EQ.RAD_1H_AC) THEN
C
C RNMQTMP( ) CONTAINS THE MRMS DATA AT THE RAW .01 DEGREE
C LAT/LON PIXELS. BELOW WILL DETERMINE WHAT GRID BOX
C EACH PIXEL FALLS IN. NOTE THAT RNMQTMP( ) WILL BE IN MM
C SO IF THE VALUE IS POSITIVE, CONVERT TO INCHES.
C
DO I=1,NMQD
C NMQTMP(I)=IFIX(VSCALE*RNMQTMP(I))
IF (RNMQTMP(I).GE.0.0) RNMQTMP(I)=RNMQTMP(I)/25.4
ICOL = ICOL + 1
IF (ICOL.GT.NLONS) THEN
IROW = IROW + 1
ICOL = 1
END IF
RLAT = RLAT01(IROW)
RLON = RLON01(ICOL)
C RLAT = RLAT00 - DY*(FLOAT(IROW-1))
C RLON = RLON00 + DX*(FLOAT(ICOL-1))
C
C WHEN THE VALUES ARE POSITIVE (NEGATIVE REPRESENTS
C MISSING OR AN ERROR), COMPUTE THE GRID COORDINATE
C OF THIS MRMS PIXEL.
C
IF (RNMQTMP(I).GE.0.0) THEN
IF (NPROJ.EQ.5) THEN
CALL W3FB06(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XI,XJ)
ELSE IF (NPROJ.EQ.3) THEN
CALL W3FB11(RLAT,RLON,RLAT1,RLON1,
1 XMESH,ORIENT,XLAT,XI,XJ)
ELSE
WRITE(KFILDO,292) NPROJ
292 FORMAT(' NPROJ NE 3 OR 5, NPROJ =',I4,' ...STOP 292')
STOP 292
END IF
C
C IF IPBOX=0, THE DATA IS CENTERED IN THE GRID BOX
C IF IPBOX=1, THE DATA IS AT THE LOWER LEFT CORNER
C
IF(IPBOX.EQ.0) THEN
IH = NINT(XI)
JH = NINT(XJ)
ELSE
IH = XI
JH = XJ
ENDIF
C
C ONLY WORK WITH DATA THAT FALLS WITHIN THE BOUNDS OF
C THE GRID.
C
IF ((IH.LT.1).OR.(IH.GT.NCOLS)) CYCLE
IF ((JH.LT.1).OR.(JH.GT.NROWS)) CYCLE
C
C AT THIS POINT, THE DATA WILL BE TREATED AS VALID.
C INCREMENT SUM OF PIXELS ABOVE THRESHOLD, AND SUM
C OF PIXELS WITHIN THE GRID BOX.
C
NTOTAL(IH,JH)=NTOTAL(IH,JH)+1
IF (RNMQTMP(I).GE.THRESH) THEN
NTHRESH(IH,JH)=NTHRESH(IH,JH)+1
END IF
ENDIF
C
END DO
C
ELSE
C
WRITE(KFILDO,295) NETCDF_VAR
295 FORMAT(A10,' IS NOT ACCOMMODATED ...STOP 295')
CALL W3TAGE('LMP_MRMSPREP')
STOP 295
C
END IF ! DONE PROCESSING TILE FOR DESIRED VARIABLE
C
C FINISHED PROCESSING THIS TILE
C
C WRITE (KFILDO,300) NPT
C300 FORMAT(' FOR THIS TILE USED ',I10,' NMQ LAT LONG PIXELS',
C 1 ' WITH NON-MISSING DATA')
C
ELSE
C
C HERE FOR CASE WHERE INPUT TILE COULD NOT BE OPENED.
C CONTINUE PROCESSING (PROCEED WITH NEXT TILE), AS MISSING
C VALUES WILL BE ASSIGNED FOR DOMAIN OF MISSING TILE.
C
WRITE(KFILDO,305) N,INFILE
305 FORMAT(' CANNOT OPEN FILE #, NAME = ',I2,A80,' ...CONTINUE')
C
ENDIF
C
END DO ! END OF LOOP FOR INGEST TILES
C
CLOSE (1) ! INGEST FILES ON UNIT(1)
C
C FINALIZE OUTPUT VARIABLE (F4XMRG( , ))
C
C PERFORM GROSS ERROR CHECKS AND PRINT DIAGNOSTIC AS NEEDED, BUT
C DO NOT CORRECT DATA. ALSO DETERMINE MIN AND MAX VALUES AND
C PRINT THEM.
C
RNEGERR=9999.
RPOSERR=-9999.
RMINVAL=9999.
RMAXVAL=-9999.
NUMNEG=0
NUMPOS=0
C
IF(NETCDF_VAR.EQ.CREF) THEN
DO J=1,NROWS
DO I=1,NCOLS
C
F4XMRG(I,J) = 9999.
F4XMRGTMP(I,J) = 9999.
IF (I4XMRG(I,J).EQ.-9999.OR.NCOUNT(I,J).LT.MINCOUNT) CYCLE
F4XMRG(I,J)=I4XMRG(I,J)/VSCALE
C
IF(F4XMRG(I,J).LT.0.0) THEN ! 00 dBZ MIN
NUMNEG=NUMNEG+1
IF(F4XMRG(I,J).LT.RNEGERR) RNEGERR=F4XMRG(I,J)
ENDIF
IF(F4XMRG(I,J).GT.75.0) THEN ! 75 dBZ MAX
NUMPOS=NUMPOS+1
IF(F4XMRG(I,J).GT.RPOSERR) RPOSERR=F4XMRG(I,J)
ENDIF
C
IF(F4XMRG(I,J).LT.RMINVAL) RMINVAL=F4XMRG(I,J)
IF(F4XMRG(I,J).GT.RMAXVAL) RMAXVAL=F4XMRG(I,J)
C
ENDDO
ENDDO
C
IF(NUMNEG.GT.0.OR.NUMPOS.GT.0)
1 WRITE(KFILDO,310) NUMNEG,RNEGERR,NUMPOS,RPOSERR
310 FORMAT(/,' FOR MAX CREF NUMNEG RNEGERR NUMPOS RPOSERR = ',
1 2(I10,F12.4))
C
ELSEIF(NETCDF_VAR.EQ.ETP18) THEN
C
DO J=1,NROWS
DO I=1,NCOLS
C
F4XMRG(I,J) = 9999.
IF (I4XMRG(I,J).EQ.-9999.OR.NCOUNT(I,J).LT.MINCOUNT) CYCLE
F4XMRG(I,J)=I4XMRG(I,J)/VSCALE
C
C NOTE: NO ECHO TOP AND MISSING ARE BOTH 9999.
C
IF(F4XMRG(I,J).LT.0.0) THEN ! 00 KM MIN
NUMNEG=NUMNEG+1
IF(F4XMRG(I,J).LT.RNEGERR) RNEGERR=F4XMRG(I,J)
ENDIF
IF(F4XMRG(I,J).GT.19.0) THEN ! 19 KM MAX
NUMPOS=NUMPOS+1
IF(F4XMRG(I,J).GT.RPOSERR) RPOSERR=F4XMRG(I,J)
ENDIF
C
IF(F4XMRG(I,J).LT.RMINVAL) RMINVAL=F4XMRG(I,J)
IF(F4XMRG(I,J).GT.RMAXVAL) RMAXVAL=F4XMRG(I,J)
C
ENDDO
ENDDO
C
IF(NUMNEG.GT.0.OR.NUMPOS.GT.0)
1 WRITE(KFILDO,312) NUMNEG,RNEGERR,NUMPOS,RPOSERR
312 FORMAT(/,' FOR MAX ETP18 NUMNEG RNEGERR NUMPOS RPOSERR = ',
1 2(I10,F12.4))
C
ELSEIF(NETCDF_VAR.EQ.PRECIPRATE_HSR) THEN
C
DO J=1,NROWS
DO I=1,NCOLS
C
F4XMRG(I,J) = 9999.
IF (I4XMRG(I,J).EQ.-9999.OR.NCOUNT(I,J).LT.MINCOUNT) CYCLE
F4XMRG(I,J)=I4XMRG(I,J)/VSCALE
C
IF(F4XMRG(I,J).LT.0.0) THEN ! 00 MM/HR MIN
NUMNEG=NUMNEG+1
IF(F4XMRG(I,J).LT.RNEGERR) RNEGERR=F4XMRG(I,J)
ENDIF
IF(F4XMRG(I,J).GT.150.0) THEN ! 150 MM/HR MAX
NUMPOS=NUMPOS+1
IF(F4XMRG(I,J).GT.RPOSERR) RPOSERR=F4XMRG(I,J)
ENDIF
C
IF(F4XMRG(I,J).LT.RMINVAL) RMINVAL=F4XMRG(I,J)
IF(F4XMRG(I,J).GT.RMAXVAL) RMAXVAL=F4XMRG(I,J)
C
ENDDO
ENDDO
C
IF(NUMNEG.GT.0.OR.NUMPOS.GT.0)
1 WRITE(KFILDO,313) NUMNEG,RNEGERR,NUMPOS,RPOSERR
313 FORMAT(/,' FOR MAX PRECIPRATE_HSR NUMNEG RNEGERR NUMPOS',
1 ' RPOSERR = ',2(I10,F12.4))
C
ELSEIF(NETCDF_VAR.EQ.VERT_INT_LIQ) THEN
C
DO J=1,NROWS
DO I=1,NCOLS
C
C NOTE: ZERO VIL AND MISSING ARE BOTH 9999.
C
F4XMRG(I,J) = 9999.
IF (I4XMRG(I,J).EQ.-9999.OR.NCOUNT(I,J).LT.MINCOUNT) CYCLE
F4XMRG(I,J)=I4XMRG(I,J)/VSCALE
C
IF(F4XMRG(I,J).LT.0.0) THEN ! 00 MM MIN
NUMNEG=NUMNEG+1
IF(F4XMRG(I,J).LT.RNEGERR) RNEGERR=F4XMRG(I,J)
ENDIF
IF(F4XMRG(I,J).GT.75.0) THEN ! 75 MM MAX
NUMPOS=NUMPOS+1
IF(F4XMRG(I,J).GT.RPOSERR) RPOSERR=F4XMRG(I,J)
ENDIF
C
IF(F4XMRG(I,J).LT.RMINVAL) RMINVAL=F4XMRG(I,J)
IF(F4XMRG(I,J).GT.RMAXVAL) RMAXVAL=F4XMRG(I,J)
C
ENDDO
ENDDO
C
IF(NUMNEG.GT.0.OR.NUMPOS.GT.0)
1 WRITE(KFILDO,314) NUMNEG,RNEGERR,NUMPOS,RPOSERR
314 FORMAT(/,' FOR MAX VERT_INT_LIQ NUMNEG RNEGERR NUMPOS',
1 ' RPOSERR = ',2(I10,F12.4))
C
ELSEIF(NETCDF_VAR.EQ.STP30) THEN
C
DO J=1,NROWS
DO I=1,NCOLS
C
F4XMRG(I,J) = 9999.
IF (I4XMRG(I,J).EQ.-9999.OR.NCOUNT(I,J).LT.MINCOUNT) CYCLE
F4XMRG(I,J)=I4XMRG(I,J)/VSCALE
C
C NOTE: NO ECHO TOP AND MISSING ARE BOTH 9999.
C
IF(F4XMRG(I,J).LT.0.0) THEN ! 00 KM MIN
NUMNEG=NUMNEG+1
IF(F4XMRG(I,J).LT.RNEGERR) RNEGERR=F4XMRG(I,J)
ENDIF
IF(F4XMRG(I,J).GT.19.0) THEN ! 19 KM MAX
NUMPOS=NUMPOS+1
IF(F4XMRG(I,J).GT.RPOSERR) RPOSERR=F4XMRG(I,J)
ENDIF
C
IF(F4XMRG(I,J).LT.RMINVAL) RMINVAL=F4XMRG(I,J)
IF(F4XMRG(I,J).GT.RMAXVAL) RMAXVAL=F4XMRG(I,J)
C
ENDDO
ENDDO
C
IF(NUMNEG.GT.0.OR.NUMPOS.GT.0)
1 WRITE(KFILDO,315) NUMNEG,RNEGERR,NUMPOS,RPOSERR
315 FORMAT(/,' FOR MAX STP30 NUMNEG RNEGERR NUMPOS RPOSERR = ',
1 2(I10,F12.4))
C
ELSEIF(NETCDF_VAR.EQ.RAD_HSR_1H) THEN
C
DO J=1,NROWS
DO I=1,NCOLS
C
F4XMRG(I,J) = 9999.
IF (NCOUNT(I,J).LT.MINCOUNT) CYCLE
F4XMRG(I,J)=I4XMRG(I,J)/(NCOUNT(I,J)*VSCALE)
C
IF(F4XMRG(I,J).LT.0.0) THEN ! 00 MM MIN...SHOULD NOT OCCUR
NUMNEG=NUMNEG+1
IF(F4XMRG(I,J).LT.RNEGERR) RNEGERR=F4XMRG(I,J)
ENDIF
IF(F4XMRG(I,J).GT.75.0) THEN ! 75 MM MAX
NUMPOS=NUMPOS+1
IF(F4XMRG(I,J).GT.RPOSERR) RPOSERR=F4XMRG(I,J)
ENDIF
C
IF(F4XMRG(I,J).LT.RMINVAL) RMINVAL=F4XMRG(I,J)
IF(F4XMRG(I,J).GT.RMAXVAL) RMAXVAL=F4XMRG(I,J)
C
ENDDO
ENDDO
C
IF(NUMNEG.GT.0.OR.NUMPOS.GT.0)
1 WRITE(KFILDO,316) NUMNEG,RNEGERR,NUMPOS,RPOSERR
316 FORMAT(/,' FOR AVG RAD_HSR_1H NUMNEG RNEGERR NUMPOS RPOSERR ='
1 ,' ',2(I10,F12.4))
C
ELSEIF(NETCDF_VAR.EQ.RAD_1H_NN) THEN
C
C FOR 1H PRECIP NN, COMPUTATION WAS COMPLETED ABOVE, SIMPLY
C TRANSFER VALUES TO F4XMRG( , ) FOR OUTPUT.
C
DO J=1,NROWS
DO I=1,NCOLS
F4XMRG(I,J)=DATANN(I,J)
END DO
END DO
C
ELSEIF(NETCDF_VAR.EQ.RAD_1H_AC) THEN
C
C COMPUTE 1H PRECIP AC BASED ON NTOTAL( , ) AND NTHRESH( , )
C DETERMINED ABOVE.
C
DO J=1,NROWS
DO I=1,NCOLS
IF (NTOTAL(I,J).GT.0) THEN
F4XMRG(I,J)=FLOAT(NTHRESH(I,J))/FLOAT(NTOTAL(I,J))
ELSE
F4XMRG(I,J)=9999.0
END IF
END DO
END DO
C
ENDIF ! PROCESSING FINISHED
C
C SECTION OF CODE BELOW OUTPUTS A TDLPAK VECTOR AND/OR GRID FILE.
C GENERATE INTEGER GRIDPOINT LIST.
C
NBLK=0
DO J=1,NROWS
DO I=1,NCOLS
NBLK=NBLK+1
INS=I*10000
ISTA(NBLK)=INS+J
END DO
END DO
C
C CONVERT INTEGER GRID POINT LIST TO CHARACTER FORMAT
C
DO I=1,NBLK
ITMP=ISTA(I)
DO J=1,8
K=9-J
ITMP1=ITMP/10
KTM=(ITMP-ITMP1*10)
WRITE(XTMP,320) KTM
320 FORMAT(I1)
STA1(K)=XTMP
ITMP=ITMP1
END DO
CCALL(I)=STA8(1)
END DO
C
C OPEN THE FILE WITH CONVERT= SPECIFIER
C
OPEN(UNIT=KFILDT,FORM='FORMATTED',STATUS='OLD',
1 IOSTAT=IOS,ERR=326)
326 IF (IOSTAT.NE.0) THEN
WRITE(KFILDO,327)KFILDT,IOS
327 FORMAT(/,' ****TROUBLE OPENING FILE ON UNIT NO.',I3,
1 '. IOSTAT =',I5,' STOP AT 327')
CALL W3TAGE('LMP_MRMSPREP')
STOP 327
ENDIF
C READ AND PRINT THE DATE TO BE PROCESSED
CALL GET_NCEPDATE(KFILDT,IYR,IMO,IDA,IHR,KDATE,IER)
IF(IER.NE.0)THEN
WRITE(KFILDO,328)
328 FORMAT(/' ****ERROR: CAN NOT READ NCEP DATE FILE - ',
1 'CATASTROPHIC ERROR IN 201. STOP AT 328.')
CALL W3TAGE('LMP_MRMSPREP')
STOP 328
ENDIF
C
WRITE(KFILDO,329) KDATE,RMINVAL,RMAXVAL
329 FORMAT(/,'DATE-HOUR WRITTEN TO OUTPUT FILE MIN VALUE ',
1 ' MAX VALUE = ',I11,2F9.2)
C
C READ 4-WORD OUTPUT VARIABLE ID, AND TDLPAK OUTPUT CONTROL VARIA-
C BLE + SCALE FACTOR. NOTE THAT IMIN IS NOT INSERTED INTO ID(2)
C IN THIS VERSION.
C
C
DO KK=1,NUMVAR
READ(KFILDI,330)(ID(J),J=1,4),ITYPE,ISCALD
330 FORMAT(4I10,2X,2I2)
IF(ITYPE.EQ.0) THEN
WRITE(KFILDO,332)
332 FORMAT(/' ONE OF THE VARIABLES IN THE LIST MUST HAVE A 1, 2,',
2 ' OR 3 SPECIFIED FOR THE OUTPUT CONTROL ...STOP 332')
CALL W3TAGE('LMP_MRMSPREP')
STOP 332
ENDIF
ENDDO
C
C334 ID(2)=ID(2)+IMIN
C IMIN INSERTED INTO ID(2)
WRITE(KFILDO,340) (ID(J),J=1,4),ITYPE,ISCALD
340 FORMAT(/,' ID TO OUTPUT = ',4I10.9,/,
2 ' OUTPUT CONTROL = ',I4,/,
3 ' ISCALD = ',I4)
C
C READ TO END OF VARIABLE LIST, IF NECESSARY
C
IF(KK.LT.NUMVAR) THEN
DO LL=KK+1,NUMVAR
READ(KFILDI,330)
ENDDO
ENDIF
C
C READ TDLPAK VECTOR AND GRID OUTPUT FILE(S).
C
DO NRO=1,2
READ(KFILDI,420) KFILRO(NRO),FILRO(NRO)
420 FORMAT(I3,4X,A60)
ENDDO
NROMX=NRO-1
WRITE(KFILDO,510) NROMX
510 FORMAT(/,I3,' NMQ OUTPUT FILENAME(S) AND UNIT NUMBER(S):')
DO 600 N=1,NROMX
WRITE(KFILDO,520) FILRO(N), KFILRO(N)
520 FORMAT(3X,A60,I5)
IF(N.EQ.1.AND.ITYPE.EQ.1) THEN
OPEN(UNIT=KFILRO(N),FORM='UNFORMATTED',
1 STATUS='NEW',CONVERT='BIG_ENDIAN',IOSTAT=IOS,ERR=560)
ELSEIF(N.EQ.2.AND.ITYPE.EQ.2) THEN
OPEN(UNIT=KFILRO(N),FORM='UNFORMATTED',
1 STATUS='NEW',CONVERT='BIG_ENDIAN',IOSTAT=IOS,ERR=560)
ELSEIF(ITYPE.EQ.3) THEN
OPEN(UNIT=KFILRO(N),FORM='UNFORMATTED',
1 STATUS='NEW',CONVERT='BIG_ENDIAN',IOSTAT=IOS,ERR=560)
ENDIF
C
560 IF (IOSTAT.NE.0) THEN
WRITE(KFILDO,580) FILRO(N),KFILRO(N)
580 FORMAT(/,'ERROR OPENING NMQ OUTPUT FILE ',A60,' UNIT NO.',
1 I3,' ...STOP 580')
CALL W3TAGE('LMP_MRMSPREP')
STOP 580
ELSE
WRITE(KFILDO,590) KFILRO(N),FILRO(N)
590 FORMAT(/,'OPENING NMQ BIG ENDIAN OUTPUT FILE ON UNIT NO.',I3,
1 ' FILE = ',A60)
ENDIF
600 CONTINUE
C
C SUBROUTINE WRVTGD OUTPUTS THE VECTOR AND/OR GRID FILE.
C
C KDATE IN ARG LIST OF WRVTGD IS DATE-TIME OF OUTPUT DATA
C
NSTA=NROWS*NCOLS
RLON1=RLON1*(-1)
ORIENT=ORIENT*(-1)
C
CALL WRVTGD(KFILDO,KFILRO(1),KFILRO(2),ID,KDATE,CCALL,F4XMRG,
1 NSTA,RLAT1,RLON1,ORIENT,MESH,
2 XLAT,NCOLS,NROWS,ND7,
3 ISCALD,0,ITYPE,L3264B,L3264W,ISTOP,
4 IPLAIN,PLAIN,IERV,IERG,NPROJ)
ENDDO
C
C END OF JOB
C
WRITE (KFILDO,*) 'END OF JOB...'
C
CALL TIMPR(KFILDO,KFILDO,'END MRMSPREP ')
CALL W3TAGE('LMP_MRMSPREP')
C
STOP
END