SUBROUTINE RATLGRDAK(KFILDO,KFIL10,IP12,ID,IDPARS,JD,NDATE,
2 IPACK,IWORK,DATA,ND5,KFILRA,RACESS,
3 FD1,ND2X3,ND11,
4 NSLAB,LSTORE,ND9,LITEMS,CORE,ND10,
5 NBLOCK,NFETCH,
6 IS0,IS1,IS2,IS4,ND7,
7 ISTAV,L3264B,L3264W,IER)
C
C APRIL 2015 CHARBA MDL MOS-2000
C MAY 2015 CHARBA REMOVED COUPLE 'CONTROL' BUGS IN
C ORIGINAL CODE.
C MAY 2015 KOCHENASH ADDED CALL TO SMTH9VW, TO SMOOTH OVER
C WINDOW OF VARIABLE SIZE (3X3, 5X5,
C 7X7, ETC.
C MAY 2015 KOCHENASH ADDED VARIABLE WT, WHICH IS THE
C SMOOTHING INDEX FOR EACH OUTPUT
C VARIABLE.
C JUNE 2015 CHARBA MODIFIED SUCH THAT THE MINUTES IN
C SECOND WORD OF THE OUTPUT VARIABLE IS
C CONSISTENTLY 00, 14, 30, AND 44 EVEN
C THOUGH THE MINUTES FOR THE CORRE-
C SPONDING INPUT VARIABLE IS 00, 15,
C 30, AND 45 FOR DATES THROUGH
C 31 JULY 2013 (PRIOR TO A MAJOR NSSL
C UPGRADE WHEREBY THE TIME RESOULTION
C CHANGED FROM 5 MIN TO 2 MIN). NOTE
C THAT THE MINUTES SET IN U201.CN IS
C THE TRUE VALUE FOR THE DATE INVOLVED.
C JUNE 2015 KOCHENASH ADDED PARAMETER NUMPASS (=3) WHICH IS
C THE NUMBER OF PASSES TO SMTH9VW. BUT
C SMTH9VW NOT CALLED WHERE SMOOTHING WT
C IS SET TO 0.0.
C JUNE 2015 KOCHENASH CHANGED WT TO A 2D ARRAY (3,6) FOR
C 3 WEIGHTING INDICES AND 6 GRIDDED
C VARIABLES.
C JUNE 2015 KOCHENASH CHANGED THE OUTPUT GRID SPECS TO THE
C CORRECTED 10KM LCC GRID (599X447).
C JUNE 2015 CHARBA ALSO REPLACED COMPUTATION OF THE INPUT
C GRID SPECS WITH VALUES IN A PARAMETER
C STATEMENT, AS THE COMPUTED VALUES WERE
C INCORRECT.
C JUNE 2015 CHARBA MODIFIED THE RESIDENT ROUTINE CNVTGRD
C SUCH THAT A PREDICTOR VARIABLE WILL
C NOT BE MISSING FOR POINTS WHERE UP TO
C THREE OF THE SUMMED 2X2 WINDOW POINTS
C ARE MISSING.
C JUNE 2015 CHARBA IMPROVED DOC AND CORRECTED COORDS OF
C 2X2 WINDOW (5KM GRID) FOR CORRECTED
C 10KM GRID. ALSO MODIFIED CNVTGRD TO
C PROPERLY ACCOUNT FOR OUTSIDE-5KM-GRID
C AND MISSING 5KM GRID VALUES.
C JUNE 2015 CHARBA REVIEWED AND CORRECTED ERROR IN CK FOR
C MISSING INVOLVING COMPUTATION OF
C 30-MIN TL TIME CHANGE.
C JULY 2015 SAMPLATS (CHARBA ADDED DOC 08/17/2015) FRED
C ASSIGNED FINAL 3-PASS SMOOTHING WTS
C ON 07/11/2015 WHICH CHARBA ASSIGNED ON
C 06/10/2015. SMOOTHING IS PERFORMED ON
C 10KM GRID AFTER VARIABLE IS SPECIFIED
C ON THAT GRID (HEREIN).
C SEPTEMBER 2015 CHARBA ADDED VIL AT TIME HH+1:00 TO LIST OF
C DERIVED VARIABLES.
C OCTOBER 2015 CHARBA CHANGED NAME FROM RALTPDR TO RATLGRD
C NOVEMBER 2015 CHARBA REVERTED FROM 10KM 599X447 OUTPUT GRID
C BACK TO 10KM 601X449 OUTPUT GRID.
C THIS WAS DONE FOR CONSISTENCY AMONG
C ALL (LTG, MRMS, AND HRRR) GRIDDING
C CODES.
C NOVEMBER 2015 CHARBA REMOVED SUBROUTINE CNVTGRD AND PLACED
C IT IN THE NEW FILE cnvtgrd.f.
C DECEMBER 2015 CHARBA ADDED DOC FOR TWO CODE CHANGES FRED
C MADE ON 11/26/2015:
C (1) REPLACED ALLOCATED ARRAY
C WRKIN( , ) WITH AUTOMATIC ARRAY
C WRKIN( , ) ...HE VAGUELY RECALLED
C GETTING CORE DUMP IN FORMER CASE;
C (2) ADDED SPECS FOR OUTPUT GRID WHEN
C AN ERROR OCCURRED (IN WHICH CASE ALL
C MISSING VALUES ARE SUPPLIED TO OUTPUT
C GRID). WHILE I QUESTION THE NEED FOR
C THESE CHANGES I TOOK HIS WORD THIS
C REMOVED THE CORE DUMP HE BELIEVES HE
C GOT OTHERWISE AND MOVED ON.
C MARCH 2016 CHARBA ADJUSTING THE DATA CUTOFF TIME FOR ALL
C MRMS AND TL VARIABLES FROM HH:00 TO
C HH:15 ...THE MOST RECENT OBS DATA FOR
C HH LAMP CYCLE.
C USE NEW APPROACH TO COMPUTE 30-MIN TL
C TIME CHANGE (SEE CODE). FINALLY, ADD-
C ING INGEST OF THE MOST RECENT 30-MIN
C IC AND CG GRIDS, WHICH ARE USED FOR
C SPECIFYING TWO CORRESPONDING (NEW)
C OUTPUT PREDICTORS.
C MARCH 2016 CHARBA ADAPTED THIS CODE VERSION TO MAKE IT
C APPLICABLE TO ANY 15MIN TIME.
C APRIL 2016 CHARBA CORRECTED CHECKING OF OUTPUT ID
C AGAINST IDS STORED IN DATA STATEMENT.
C APRIL 2016 CHARBA INCREASED SMOOTHING FOR DELTA CREF;
C DECREASED SMOOTHING FOR VIL.
C APRIL 2016 SAMPLATSKY ADDED LOGIC TO TRUNCATE EACH
C VARIABLE TO A SPECIFIED UPPER AND
C LOWER BOUND.
C MAY 2016 CHARBA MADE COSMETIC EDITS.
C MAY 2016 SAMPLATSKY RESTRUCTURED CODE, TO BE MORE IN
C ALIGNMENT WITH NCO STANDARDS. ADDED
C LOGIC TO FILL IN MISSING CREF AND VIL
C WITH HRRR DATA. HRRR FILL OF CREF
C AND VIL WAS RENDERED (FROM NATIVE 3KM
C GRID) WITH EXACTLY THE SAME PROCEDURE
C AS FOR MRMS RENDERING FROM 5KM GRID.
C JUNE 2016 CHARBA ADDED 0.0 - 67.0 TRUNCATION BOUNDS FOR
C MRMS CREF.
C APRIL 2017 SAMPLATSKY UPDATED ITABLE FOR FINAL IDS.
C MAY 2017 SAMPLATSKY ADDED LOGIC, PRIOR TO PERFORMING
C THE HRRR REPLACEMENT, TO FIND HOW
C MUCH MRMS DATA IS MISSING WITHIN THE
C LAMP FORECAST DOMAIN. IF TOO MUCH
C DATA IS MISSING, AN ERROR WILL BE
C PRINTED AND THE ROUTINE WILL STOP,
C LEADING TO FAILURE OF THE 1H CNV/LTG
C SYSTEM. THIS IS TO AVOID THE CASE
C WHERE PERFORMING THE HRRR REPLACEMENT
C OVER MOST OR ALL OF THE DOMAIN LEADS
C TO UNDESIRABLE FORECASTS.
C SEPTEMBER 2018 SAMPLATSKY REMOVED LOGIC FOR IC/CG LTG, AND
C ADDED LOGIC FOR 1H PRECIP AC AND NN.
C SEPTEMBER 2020 SAMPLATSKY UPDATED PROCESSING IDS
C
C PURPOSE
C COMPUTE AND RETURN CONVECTION AND LIGHTNING PREDICTORS ON A
C 10KM LCC GRID. THE INPUT GRIDS CONSIST OF 5 KM MAX CREF AND
C 5 KM TL COUNTS. THUS, TO OBTAIN AN OUTPUT GRID AN INPUT
C GRID MUST BE PROCESSED OVER 2X2 SUB-GRIDS. ALSO, SINCE THE
C OUTPUT GRID IS NEW (THIS GRID IS NOT INHERENT TO THE U201
C INGEST) THE GRID MUST BE DEFINED AND STORED IN THE U201
C INFRASTRUCTURE.
C
C FOR CREF PREDICTORS, THE INGEST CONSISTS MAX CREF FOR HH:30
C AND HH+1:00 (TWO GRIDS). THE OUTPUT CONSISTS OF THREE
C 10 KM GRIDS: (1) MAX CREF AT HH:30, (2) MAX CREF AT
C HH+1:00, AND (3) ITEM 2 - ITEM 1 (MAX CREF TIME CHANGE).
C FOR TL PREDICTORS THE INPUT CONSISTS OF THE TL COUNT FOR
C THREE TIME PERIODS: (A) FOR HH:00 - HH:59, (B) HH:00 -
C HH:29, AND (C) HH:30 - HH:59 (THREE GRIDS). THE OUTPUT
C CONSISTS OF THREE 10 KM GRIDS: (1) HH:00 - HH:59 TL COUNT,
C (2) HH:30 - HH:59 TL COUNT, AND (3) (HH:30 - HH:59) TL COUNT
C - (HH:00 -HH:29) TL COUNT (TL COUNT TIME CHANGE). EACH OF
C CREF AND TL GRIDS ARE RETURNED TO CALLING ROUTINES, WHICH
C ALLOWS FOR POST-PROCESSING AND THE OPTION OF SPECIFYING ADD-
C ITIONAL PREDICTOR FORMS.
C
C NOTE THAT GRIDBOXES FOR THE INGESTED 5KM CREF AND TL GRIDS
C ARE POSITIONED WRT TO THE LOWER-LEFT CORNER. THIS IS REQ-
C UIRED FOR THE ENSUING 10KM PREDICTAND BOXES TO BE POSITIONED
C WRT TO THEIR CENTERS.
C
C THE ROUTINE IS STRUCTURED SUCH THAT FOR A NEW YYMMDDHH
C ALL SIX POSSIBLE OUTPUT VARIABLES (GRIDS) ARE COMPUTED AND
C STORED IN AN ALLOCATED ARRAY AND ONLY THE DESIRED VARIABLE
C IS RETURNED. THEN ON SUBSEQUENT ENTRIES FOR THE SAME
C YYMMDDHH, PREVIOUSLY PERFORMED COMPUTATIONS ARE BYPASSED
C AND THE DESIRED VARIABLE IS RETRIEVED AND RETURNED.
C
C
C IDPARS(1) - IDPARS(2) FOR INPUT GRIDS ARE:
C 707 - 801 QCD MAX CREF ON 5KM GRID (LL CORNER OF BOX)
C 707 - 807 QCD MAX VIL ON 5KM GRID (LL CORNER OF BOX)
C 707 - 545 60MIN TL COUNT ON 5KM GRID (LL CORNER OF BOX)
C 707 - 550 30MIN TL COUNT ON 5KM GRID (LL CORNER OF BOX)
C 707 - 552 30MIN IC COUNT ON 5KM GRID (LL CORNER OF BOX)
C 707 - 553 30MIN CG COUNT ON 5KM GRID (LL CORNER OF BOX)
C
C IMP NOTES: FOR MRMS GRIDS THE "MINUTES" FOR
C THE QTR HOUR TIMES CHGS FROM 2013073123
C (:15 OR :45) TO 2013080100 (:14 OR :44) ...
C THIS IS HOW THE RAW MRMS DATA ARE ARCHIVED.
C FOR LTG COUNT GRIDS THE "MINUTES"
C APPLY TO THE BEGINNING OF THE 60- OR 30-MIN
C PERIOD AND ARE SET IN ID(2) (IN U523). SO,
C FOR BOTH INGEST GRID DATA TYPES ID(2) IS
C CONTROLLED UPSTREAM OF THIS ROUTINE.
C
C IDPARS(1) - IDPARS(2) FOR OUTPUT GRIDS ARE:
C 007 - 801 MAX CREF ON 10KM GRID (CENTER OF 10KM BOX) AT
C TIME HH:15(14) ...MIN SET IN ID(2) ...HH IS
C LAMP CYCLE (HOUR).
C 007 - 801 MAX CREF ON 10KM GRID (CENTER OF 10KM BOX) AT
C TIME HH-1:45 ... MIN SET IN ID(2)
C 2 ...MIN SET IN ID(2)
C 007 - 805 30MIN MAX CREF TIME CHANGE ON 10KM GRID (CEN-
C TER OF 10KM BOX) AT TIME HH:15(14) ...MIN SET
C IN ID(2).
C 007 - 807 MAX VIL ON 10KM GRID (CENTER OF 10KM BOX) AT
C TIME HH:15(14)
C 007 - 545 60MIN TL COUNT ON 10KM GRID ENDING HH:15
C (CENTER OF 10KM BOX)
C 007 - 550 30MIN TL COUNT ON 10KM GRID ENDING HH:15
C (CENTER OF 10KM BOX)
C 007 - 551 30MIN TL COUNT TIME CHANGE ENDING HH:15
C (CENTER OF 10KM BOX) ...MIN APPLY TO HH:15.
C 007 - 552 30MIN IC COUNT ON 10KM GRID ENDING HH:15
C (CENTER OF 10KM BOX)
C 007 - 553 30MIN CG COUNT ON 10KM GRID ENDING HH:15
C (CENTER OF 10KM BOX)
C
C IMP NOTE: THE "MINUTES" CONVENTION FOR ALL
C OUTPUT GRIDS IS THE SAME AS THE DATA CUT-OFF
C HH:MM. FOR THE MRMS GRIDS THE DATA CUT-OFF
C "MINUTES" FOR THE QTR HOUR TIMES IS DATE
C DEPENDENT BUT THE MINUTES IN ID(2) IS ALWAYS
C SET AT EITHER 15 OR 45, SO CODE LOGIC IN THIS
C ROUTINE IS NEEDED TO ACCOUNT FOR THIS.
C SINCE THE "MINUTES" FOR ALL INGESTED
C LTG GRIDS APPLIES TO THE BEGINNING OF THE
C VALID PERIOD, CODE LOGIC IN THIS ROUTINE IS
C REQUIRED TO ACCOUNT FOR THE ID(2) CONVENTION
C SHIFT BETWEEN THE INPUT AND OUTPUT GRIDS.
C
C DATA SET USE
C KFILDO - DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE
C (OUTPUT).
C KFIL10 - UNIT NUMBER OF TDL MOS-2000 FILE SYSTEM ACCESS
C (INPUT-OUTPUT).
C IP12 - INDICATES WHETHER (>1) OR NOT (=0) THE LIST OF
C STATIONS ON THE INPUT FILES WILL BE PRINTED TO
C THE FILE WHOSE UNIT NUMBER IS IP12.
C
C VARIABLES
C KFILDO = DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE.
C (OUTPUT)
C KFIL10 = UNIT NUMBER OF TDL MOS-2000 FILE SYSTEM ACCESS.
C (INPUT-OUTPUT)
C IP12 = INDICATES WHETHER (>1) OR NOT (=0) THE LIST OF
C STATIONS ON THE INPUT FILES WILL BE PRINTED TO
C THE FILE WHOSE UNIT NUMBER IS IP12.
C ID(J) = IDENTIFIERS FOR THE VARIABLE BEING COMPUTED.
C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE
C OUTPUT ID CORRESPONDING TO ID( ) (J=1,15).
C (INPUT)
C J=1--CCC (CLASS OF VARIABLE),
C J=2--FFF (SUBCLASS OF VARIABLE),
C J=3--B (BINARY INDICATOR),
C J=4--DD (DATA SOURCE, MODEL NUMBER),
C J=5--V (VERTICAL APPLICATION),
C J=6--LBLBLBLB (BOTTOM OF LAYER, 0 IF ONLY 1
C LAYER),
C J=7--LTLTLTLT (TOP OF LAYER),
C J=8--T (TRANSFORMATION),
C J=9--RR (RUN TIME OFFSET, ALWAYS + AND BACK
C IN TIME),
C J=10--OT (TIME APPLICATION),
C J=11--OH (TIME PERIOD IN HOURS),
C J=12--TAU (PROJECTION IN HOURS),
C J=13--I (INTERPOLATION TYPE),
C J=14--S (SMOOTHING INDICATOR), AND
C J=15--G (GRID INDICATOR).
C JD(J) = THE BASIC INTEGER OUTPUT ID (J=1,4).
C THIS IS THE SAME AS ID(J), EXCEPT THAT THE
C PORTIONS PERTAINING TO PROCESSING ARE OMITTED:
C B = IDPARS(3),
C T = IDPARS(8),
C I = IDPARS(13),
C S = IDPARS(14),
C G = IDPARS(15), AND THRESH.
C JD( ) IS USED TO IDENTIFY THE BASIC MODEL
C FIELDS AS READ FROM THE ARCHIVE. (INPUT)
C NDATE = THE DATE/TIME FOR OUTPUT VARIABLE. (INPUT)
C KFILRA(J) = THE UNIT NUMBERS FOR WHICH RANDOM ACCESS FILES
C ARE AVAILABLE (J=1,NUMRA). (INPUT)
C RACESS(J) = THE FILE NAMES ASSOCIATED WITH KFILRA(J)
C (J=1,NUMRA)(CHARACTER*60). (INPUT)
C NUMRA = THE NUMBER OF VALUES IN KFILRA( ) AND RACESS( ).
C (INPUT)
C CCALL(K,J) = 8-CHARACTER STATION CALL LETTERS (OR GRIDPOINT
C LOCATIONS FOR GRID DEVELOPMENT) TO PROVIDE
C OUTPUT FOR (J=1) AND 5 POSSIBLE OTHER STATION
C CALL LETTERS (J=2,6) THAT CAN BE USED INSTEAD
C IF THE PRIMARY (J=1) STATION CANNOT BE FOUND
C IN AN INPUT DIRECTORY (K=1,NSTA). ALL STATION
C DATA ARE KEYED TO THIS LIST, EXCEPT POSSIBLY
C CCALLD( ). EQUIVALENCED TO ICALL( , )
C (CHARACTER*8). (INPUT/OUTPUT)
C ICALLD(L,K) = 8 STATION CALL LETTERS AS CHARACTERS IN AN INTE-
C GER VARIABLE (L=1,L3264W) (K=1,ND5).
C EQUIVALENCED TO CCALLD( ). (INTERNAL)
C CCALLD(K) = 8 STATION CALL LETTERS (K=1,ND5). THIS LIST IS
C USED IN L1D1 TO READ THE REGION LISTS
C (CHARACTER*8). (INTERNAL)
C ISDATA(K) = WORK ARRAY (K=1,ND1). (INTERNAL)
C SDATA(N) = CONTAINS VECTOR DATA RETURNED FROM CALL TO
C CONST (N=1,NSTA). (INTERNAL)
C DIR(K,J,M) = THE IX (J=1) AND JY (J=2) POSITIONS ON THE GRID
C FOR THE COMBINATION OF GRID CHARACTERISTICS M
C (M=1,NGRID) AND STATION K (K=1,NSTA) IN
C NGRIDC( ,M). (INPUT/OUTPUT)
C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT
C WITH. DIMENSION OF SEVERAL ARRAYS. (INPUT)
C NSTA = NUMBER OF OUTPUT STATIONS. (INPUT)
C IPACK(J) = WORK ARRAY (J=1,ND5). (INTERNAL)
C IWORK(J) = WORK ARRAY (J=1,ND5). (INTERNAL)
C DATA(K) = DATA (GRIDDED) RETURNED (K=1,NX10*NY10). NOTE:
C DATA( ) IS DIMENSIONED ND5. (OUTPUT)
C ND5 = DIMENSION OF IPACK( ), IWORK( ), AND
C DATA( ). (INPUT)
C FD1(J) = WORK ARRAY (J=1,ND2X3). (INTERNAL)
C FD2(I,J) = WORK ARRAY TO HOLD OUTPUT VARIABLE IN GRID ARRAY
C FORM (I=1,NX10,J=1,NY10). NOTE: DIMENSION OF
C FD3( ) IN DRU201 IS ND2X3, SO A CHECK IS MADE
C TO SEE IF NX10*NY10 LE ND2X3. (INTERNAL)
C FD3(I,J) = WORK ARRAY TO HOLD OUTPUT VARIABLE IN GRID ARRAY
C FORM (I=1,NX10,J=1,NY10). NOTE: DIMENSION OF
C FD3( ) IN DRU201 IS ND2X3, SO A CHECK IS MADE
C TO SEE IF NX10*NY10 LE ND2X3. (INTERNAL)
C ND2X3 = DIMENSION OF FD1( ),FD2( ), AND FD3( ).
C (INTERNAL)
C NGRIDC(L,M) = HOLDS THE GRID CHARACTERISTICS (L=1,6) FOR EACH
C GRID COMBINATION. (M=1,NGRID)
C L=1--MAP PROJECTION NUMBER (3=LAMBERT, 5=POLAR
C STEREOGRAPHIC).
C L=2--GRID LENGTH IN MILLIMETERS,
C L=3--LATITUDE AT WHICH GRID LENGTH IS CORRECT
C *10000,
C L=4--GRID ORIENTATION IN DEGREES *10000,
C L=5--LATITUDE OF LL CORNER IN DEGREES *10000,
C L=6--LONGITUDE OF LL CORNER IN DEGREES *10000.
C NGRID = THE NUMBER OF GRID COMBINATIONS IN NGRIDC( , ),
C MAXIMUM OF ND11. NOTE: NGRID IS INCREMENTED BY
C ONE IN THIS ROUTINE IF THE OUTPUT GRID IS ADDED.
C (INPUT/OUTPUT)
C ND11 = SECOND DIMENSION OF NGRIDC( , ). (INPUT)
C NSLAB = SLAB OF THE GRID IN USE...SET EQUAL TO NCHECK
C (THE OUTPUT GRID) BEFORE RETURNING TO OPTION.
C (OUTPUT)
C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA
C STORED (L=1,12) (J=1,LITEMS). (INPUT-OUTPUT)
C L=1,4--THE 4 ID'S FOR THE DATA.
C L=5 --LOCATION OF STORED DATA. WHEN IN CORE,
C THIS IS THE LOCATION IN CORE( ) WHERE
C THE DATA START. WHEN ON DISK,
C THIS IS MINUS THE RECORD NUMBER WHERE
C THE DATA START.
C L=6 --THE NUMBER OF 4-BYTE WORDS STORED.
C L=7 --2 FOR DATA PACKED IN TDL GRIB, 1 FOR
C NOT.
C L=8 --THE DATE/TIME OF THE DATA IN FORMAT
C YYYYMMDDHH.
C L=9 --NUMBER OF TIMES DATA HAVE BEEN
C RETRIEVED.
C L=10 --NUMBER OF THE SLAB IN DIR( , ,L) AND
C IN NGRIDC( ,L) DEFINING THE
C CHARACTERISTICS OF THIS GRID.
C L=11 --THE NUMBER OF THE PREDICTAND IN THE
C SORTED LIST IN ID( ,N) (N=1,NPRED)
C FOR WHICH THIS VARIABLE IS NEEDED, WHEN
C IT IS NEEDED ONLY ONCE FROM
C LSTORE( , ). WHEN IT IS NEEDED MORE
C THAN ONCE, THE VALUE IS SET = 7777.
C L=12 --USED INITIALLY IN ESTABLISHING
C MOSTORE( , ). LATER USED AS A WAY OF
C DETERMINING WHETHER TO KEEP THIS
C VARIABLE.
C ND9 = THE SECOND DIMENSION OF LSTORE( , ). (INPUT)
C LITEMS = THE NUMBER OF ITEMS (COLUMNS) IN LSTORE( , )
C THAT HAVE BEEN USED IN THIS RUN. (INPUT)
C CORE(J) = THE ARRAY TO STORE OR RETRIEVE THE DATA
C IDENTIFIED IN LSTORE( , ) (J=1,ND10). WHEN
C CORE( ) IS FULL DATA ARE STORED ON DISK.
C (OUTPUT)
C ND10 = DIMENSION OF CORE( ). (INPUT)
C NBLOCK = THE BLOCK SIZE IN WORDS OF THE MOS-2000 RANDOM
C DISK FILE. (INPUT)
C NFETCH = INCREMENTED EACH TIME GFETCH IS ENTERED.
C IT IS A RUNNING COUNT FROM THE BEGINNING OF
C THE PROGRAM. THIS COUNT IS MAINTAINED IN
C CASE THE USER NEEDS IT (DIAGNOSTICS, ETC.).
C NEEDS IT (DIAGNOSTICS, ETC.). (INTERNAL)
C LASTL = THE LAST LOCATION IN CORE( ) USED FOR MOS-2000
C INTERNAL STORAGE. INITIALIZED TO 0 ON FIRST
C ENTRY TO GSTORE. ALSO INITIALIZED IN U201 IN
C CASE GSTORE IS NOT ENTERED. (INPUT-OUTPUT)
C LASTD = TOTAL NUMBER OF PHYSICAL RECORDS ON DISK FOR
C MOS-2000 INTERNAL STORAGE. MUST BE CARRIED
C WHENEVER GSTORE IS TO BE CALLED. (INPUT)
C NSTORE = THE NUMBER OF TIMES GSTORE HAS BEEN ENTERED.
C GSTORE KEEPS TRACK OF THIS AND RETURNS THE
C VALUE. (OUTPUT)
C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,3).
C (INTERNAL)
C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,22+).
C (INTERNAL)
C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12).
C (INTERNAL)
C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4).
C (INTERNAL)
C ND7 = DIMENSION OF IS0, IS1, IS2, AND IS4. NOT ALL
C LOCATIONS ARE USED. (INPUT)
C ISTAV = SET TO 0 TO INDICATE A GRID FIELD IS BEING RE-
C TURNED. (OUTPUT)
C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING
C USED (EITHER 32 OR 64). (INPUT)
C L3264W = NUMBER OF WORDS IN 64 BITS, EITHER 1 OR 2.
C (INPUT)
C IER = STATUS RETURN. (OUTPUT)
C 0 = GOOD RETURN.
C 33 = ERROR READING STATION IDS.
C 53 = OUTPUT GRID IS LARGER THAN WORK ARRAYS OR
C ND11 MUST BE INCREASED.
C 103 = REQUESTED PREDICTOR ID IS NOT SUPPORTED.
C IOS = NOT ABLE TO ALLOCATE MEMORY FOR STORING
C CONSTANT DATA.
C SEE GFETCH AND CONST FOR OTHER VALUES. WHEN AN
C ERROR IS ENCOUNTERED, MISSING VALUES ARE ENTERED
C FOR THE DESIRED VARIABLE. (OUTPUT)
C
C OTHER VARIABLES
C THMIN = MINIMUM NUMBER OF NON-MISSING INPUT GRIDPOINT
C VALUES, BELOW WHICH MISSING IS RETURNED FOR
C THE MAX, SUM AND AVERAGE VALUES. (PARAMETER)
C NCHECK = A PARAMETER THAT SPECIFIES THE ARRAY INDEX OF
C THE OUTPUT GRID. (INTERNAL)
C NX10 = NUMBER OF GRIDPOINTS IN THE X-DIRECTION OF THE
C COMPUTATIONAL (OUTPUT) GRID. (PARAMETER)
C NY10 = NUMBER OF GRIDPOINTS IN THE Y-DIRECTION OF THE
C COMPUTATIONAL (OUTPUT) GRID. (PARAMETER)
C XMESHL2 = GRID MESHLENGTH (M) OF THE COMPUTATIONAL/OUTPUT
C GRID. (PARAMETER)
C ORIENT2 = STANDARD LONGITUDE (DEG) OF THE COMPUTATIONAL/-
C OUTPUT GRID. (PARAMETER)
C XLAT2 = STANDARD LATITUDE (DEG) OF THE COMPUTATIONAL/-
C OUTPUT GRID. (PARAMETER)
C XLATLL2 = LATITUDE (DEG) OF THE LOWER-LEFT CORNER OF
C THE COMPUTATIONAL/OUTPUT GRID. (PARAMETER)
C XLONLL2 = LONGITUDE (DEG) OF THE LOWER-LEFT CORNER OF
C THE COMPUTATIONAL/OUTPUT GRID. (PARAMETER)
C NPROJ2 = MAP PROJECTION TYPE OF THE COMPUTATIONAL/OUTPUT
C GRID;
C =3 FOR LAMBERT;
C =5 FOR POLAR STEREOGRAPHIC. (PARAMETER)
C ID1IN(I) = ID1(1) FOR LIST OF INPUT GRIDS (I=1,3). (DATA)
C NX = NUMBER OF POINTS IN X-DIRECTION OF INPUT 5-KM
C GRID. (INTERNAL)
C NY = NUMBER OF POINTS IN Y-DIRECTION OF INPUT 5-KM
C GRID. (INTERNAL)
C WRKIN(I,J) = WORK ARRAY TO HOLD INPUT 5-KM GRID ...SPECIFI-
C ED AS ALLOCATABLE BECAUSE DIMENSION IS KNOWN
C ONLY DYNAMICALLY (I=1,NX,J=1,NY). (ALLOCATED)
C NUMOUT = NUMBER OF VARIABLES THAT CAN BE PROCESSED AND
C OUTPUT FOR A GIVEN DATE. (PARAMETER)
C ID1OUT(I) = ID1(1) FOR LIST OF OUTPUT GRIDS (I=1,NUMOUT).
C (DATA)
C WT(NUMPASS,I) = WEIGHTING INDEX FOR SMOOTHING OF OUTPUT GRIDS
C (I=1,NUMOUT).
C GRDOUT(I,J) = HOLDS ALL COMPUTED OUTPUT GRIDS (I=1,NX10,
C J=1,NY10). (ALLOCATED)
C NTIMES = THE NUMBER OF TIMES, INCLUDING THIS ONE, THAT
C THE RECORD HAS BEEN FETCHED. THIS IS STORED
C IN LSTORE(9, ). (INTERNAL)
C LD(J) = HOLDS THE 4 ID WORDS OF THE DATA RETRIEVED INTO
C FD1( ) (J=1,4). (INTERNAL)
C MISSP = PRIMARY MISSING VALUE INDICATOR. RETURNED AS
C ZERO WHEN DATA ARE NOT PACKED. (INTERNAL)
C MISSS = SECONDARY MISSING VALUE INDICATOR. RETURNED AS
C ZERO WHEN DATA ARE NOT PACKED. (INTERNAL)
C NPACK = 2 FOR TDL GRIB PACKED DATA: 1 FOR NOT PACKED.
C THIS IS STORED IN LSTORE(7, ). (INTERNAL)
C NWORDS = NUMBER OF WORDS RETURNED IN DATA( ). (INTERNAL)
C
C NONSYSTEM SUBROUTINES CALLED
C GFETCH, CNVTGRD, SMTH9VW, W3TAGE
C
C***********************************************************************
C
C SPECIFY THE PARAMETERS OF THE COMPUTATIONAL/OUTPUT GRID.
C
PARAMETER (NX=1089,NY=641,MNRAP=03)
PARAMETER (NUMPASS=3) ! NUMPASS IS NUMBER OF PASSES TO SMTH9VW
PARAMETER (NUMOUT=4) ! NUMOUT IS NUMBER OF OUTPUT VARIABLES
C
CHARACTER*60 RACESS
C
INTEGER,ALLOCATABLE :: RMASKC(:,:) ! COOL SEASON AK MRMS MASK
INTEGER,ALLOCATABLE :: RMASKW(:,:) ! WARM SEASON AK MRMS MASK
C
INTEGER KFILDO,KFIL10,IDPARS(15),ID(4),JD(4),KD(4),LD(4),
1 NDATE,NSLAB,ND7,NSTA,
2 ND2X3,LSTORE(12,ND9),LITEMS,ND10,NBLOCK,NFETCH,
3 IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7),IPACK(ND5),
4 IWORK(ND5),ISTAV,L3264B,IER
C
INTEGER IDATADJ_CURRAD(4),IDATADJ_PRVRAD(4),IDATADJ_LTG60(4),
1 IDATADJ_LTG30(4),IMIN_CURRADLTG(4),IMIN_PRVRAD(4),
2 IMIN_LTG60(4),IMIN_LTG30(4),ITABLE(3,NUMOUT)
C
REAL,ALLOCATABLE :: GRDOUT(:,:,:)
REAL GRD2(NX,NY)
REAL WT(NUMPASS,NUMOUT)
C
REAL DATA(ND5),CORE(ND10),FD1(ND2X3),
1 WRKIN(NX,NY),TRUNC(3,NUMOUT),
2 WRKINH(NX,NY),RMASK(NX,NY)
C
DATA NDATEO/0/ ! NDATEO = DATE ALL OUTPUT ALREADY PROCESSED
C
C ITABLE( , ) HANDLES IDS FOR PROCESSING.
C ITABLE(1, ) IS THE OUTPUT ID
C ITABLE(2, ) IS THE INPUT ID
C ITABLE(3, ) IS THE HRRR INPUT ID
C VALUES OF 999 ARE JUST A PLACEHOLDER.
C
DATA ((ITABLE(I,J),I=1,3),J=1,NUMOUT)
1 /007801,707800,007800, ! MAX CREF, CURRENT TIME
2 007545,707380, 999, ! SUM 60-MIN TL
3 007550,707431, 999, ! SUM 30-MIN TL
4 007551, 999, 999/ ! SUM 30-MIN TL TIME CHANGE
C
C FOR MRMS OUTPUT GRIDS 2ND ID WORD SPECIFIES THE "MINUTES"
C PAST THE TOP OF THE HOUR (SAME AS FOR INPUT GRIDS). FOR
C LTG OUTPUT GRIDS 2ND ID WORD DENOTES THE "MINUTES" AT THE
C END OF THE (60- OR 30-MIN) VALID PERIOD.
C
C 'MINUTES' = :00 :15 :30 :45
C
DATA (IDATADJ_CURRAD(K),K=1,4) ! INGEST DATE ADJ FOR CURR RADAR
1 / 0, 0, 0, 0/
DATA (IDATADJ_PRVRAD(K),K=1,4) ! INGEST DATE ADJ FOR PREV RADAR
1 / -1, -1, 0, 0/
DATA (IDATADJ_LTG60(K),K=1,4) ! INGEST DATE ADJ FOR 60MIN LTG
1 / -1, -1, -1, -1/
DATA (IDATADJ_LTG30(K),K=1,4) ! INGEST DATE ADJ FOR 30MIN LTG
1 / -1, -1, 0, 0/
DATA (IMIN_CURRADLTG(K),K=1,4) ! 'MINUTES' FOR CURR RAD/LTG DATA
1 / 00, 15, 30, 45/
DATA (IMIN_PRVRAD(K),K=1,4) ! 'MINUTES' FOR 30M PREV RAD DATA
1 / 30, 45, 00, 15/
DATA (IMIN_LTG60(K),K=1,4) ! 'MINUTES' FOR 60M PREV LTG DATA
1 / 00, 15, 30, 45/
DATA (IMIN_LTG30(K),K=1,4) ! 'MINUTES' FOR 30M PREV LTG DATA
1 / 30, 45, 00, 15/
C
DATA ((WT(I,J),I=1,3),J=1,NUMOUT) ! 3 SM PASS...NOT CALLED WHEN W=0.0
1 /1.00,0.50,0.00, ! MAX CREF AT HH:15 ...CENTERED ON 10KM BOX
2 1.00,0.00,0.00, ! 60MIN TL COUNT ENDING HH:15 ...10KM BOX
3 1.00,0.00,0.00, ! 30MIN TL COUNT ENDING HH:15 ...10KM BOX
4 1.00,0.00,0.00/ ! 30MIN TL COUNT TIME CHG AT HH:15, 10KM BOX
C
DATA TRUNC/1.0, 0.00, 67.00, ! CREF CURRENT
2 1.0, 0.00, 1200.00, ! 60 MIN TL
3 1.0, 0.00, 600.00, ! 30 MIN TL
4 0.0, 0.00, 0.00/ ! 30 MIN TL TIME CHANGE
C
DATA IFIRST/0/ ! IFIRST IS FLAG FOR ONE ALLOCATE OF GRDOUT(,,,)
DATA NDX/0/ ! INDEX CORRESPONDING TO MINUTES
C
SAVE NDATEO,GRDOUT,IFIRST,NDX,RMASKC,RMASKW
C
C CALL TIMPR(KFILDO,KFILDO,'START RATLGRD ')
C
IER=0
C
C ON FIRST ENTRY, DETERMINE INDEX CORRESPONDING TO 'IMINUTES'
C FOR CURRENT CREF. IF THE INDEX CANNOT BE DETERMINED,
C SET IER=103 AND RETURN MISSING VALUES IN DATA( ).
C
IF(IFIRST.EQ.0) THEN
C
DO KK=1,4
IF(ID(2).EQ.IMIN_CURRADLTG(KK)) NDX=KK
END DO
C
IF (NDX.EQ.0) THEN
WRITE(KFILDO,20) ID(2)
20 FORMAT(/,' **** ID(2) = ',I10.9,' CONTAINS A MINUTES VALUE',
1 ' THAT IS NOT ACCOMMODATED. SET IER=103 AND ',
2 ' RETURN MISSING VALUES.')
IER=103
DO NN=1,ND5
DATA(N)=9999.0
END DO
RETURN ! EXIT SUBROUTINE
END IF
C
END IF
C
C CHECK TO SEE IF VARIABLE IS ACCOMMODATED IN THIS ROUTINE. IF
C NOT, RETURN ERROR CODE 103 AND MISSING VALUES IN DATA( ).
C
JVAR=0
DO NN=1,NUMOUT
IF (IDPARS(1).EQ.ITABLE(1,NN)/1000.AND.
1 IDPARS(2).EQ.MOD(ITABLE(1,NN),1000)) THEN
C
JVAR=NN
C
END IF
END DO
C
C JVAR REMAINING 0 MEANS THE VARIABLE IS NOT PART OF THE ITABLE.
C
IF (JVAR.EQ.0) THEN
WRITE(KFILDO,40) (ID(J),J=1,4)
40 FORMAT(/,' **** VARIABLE ',4I11.9,' NOT ACCOMODATED IN',
1 ' RATLGRD ...SET IER=103 AND SUPPLY MISSING',
2 ' VALUES.')
IER=103
DO NN=1,ND5
DATA(N)=9999.0
END DO
RETURN ! EXIT SUBROUTINE
ENDIF
C
C FIRST ENTRY PROCESSING: ALLOCATE GRDOUT( , , ), ALSO
C ALLOCATE AND POPULATE IXHROUT( , ) AND JYHROUT( , ).
C
100 IF(IFIRST.EQ.0) THEN
C
IF(NX*NY.GT.ND2X3) THEN
C
C OUTPUT GRID IS LARGER THAN WORK ARRAYS; MUST ABORT COMPUTA-
C TION OF OUTPUT VARIABLE.
C
WRITE(KFILDO,110) NX10,NY10
110 FORMAT(/,' ****IN RATLGRD THE',I4,'X',I4,' OUTPUT GRID CON',
1 'TAINS MORE THAN ND2X3 POINTS ...SUPPLY MISSING VAL',
2 'UES AND SET IER = 53')
IER=53
DO NN=1,ND5
DATA(N)=9999.0
END DO
RETURN ! EXIT SUBROUTINE
END IF
C
C ALLOCATE ARRAYS
C
ALLOCATE (GRDOUT(NX,NY,NUMOUT))
ALLOCATE (RMASKC(NX,NY))
ALLOCATE (RMASKW(NX,NY))
C
C READ IN WARM SEASON MASK, STORE IN RMASKW( , )
C
LD(1)=447531000
LD(2)=010170005
LD(3)=0
LD(4)=0
C
CALL CONSTG(KFILDO,KFILRA,RACESS,LD,
1 IPACK,IWORK,FD1,ND5,
2 IS0,IS1,IS2,IS4,ND7,
3 ISTAV,L3264B,IER)
C
NN=1
DO JY=1,NY
DO IX=1,NX
RMASKW(IX,JY)=FD1(NN)
NN=NN+1
END DO
END DO
C
C READ IN COOL SEASON MASK, STORE IN RMASKC( , )
C
LD(1)=447531000
LD(2)=010180005
LD(3)=0
LD(4)=0
C
CALL CONSTG(KFILDO,KFILRA,RACESS,LD,
1 IPACK,IWORK,FD1,ND5,
2 IS0,IS1,IS2,IS4,ND7,
3 ISTAV,L3264B,IER)
C
NN=1
DO JY=1,NY
DO IX=1,NX
RMASKC(IX,JY)=FD1(NN)
NN=NN+1
END DO
END DO
C
IFIRST=1
C
END IF ! IF IFIRST=0
C
C ON THE FIRST ENTRY FOR A GIVEN DATE, COMPUTE ALL PREDICTORS,
C STORING FINAL DATA IN THE GRDOUT( , , ) ARRAY. PROCESSING
C SUBSEQUENT ENTRIES FOR A GIVEN DATE CONTINUES AT LABEL 600.
C
200 IF (NDATE.NE.NDATEO) THEN
C
C FIRST, DETERMINE PROPER MASK TO USE ON MRMS DATA, BASED
C ON DATE.
C
MMDD=MOD((NDATE/100),10000)
IF (MMDD.GE.0516.AND.MMDD.LE.0915) THEN
DO J=1,NY
DO I=1,NX
RMASK(I,J)=RMASKW(I,J)
END DO
END DO
ELSE
DO J=1,NY
DO I=1,NX
RMASK(I,J)=RMASKC(I,J)
END DO
END DO
END IF
C
C LOOP OVER EACH VARIABLE TO DO APPROPRIATE PROCESSING.
C
DO 490 NN=1,NUMOUT
C
C SET UP LD( ) FOR CALLING GFETCH TO FETCH DATA.
C
SELECT CASE (NN)
C
C MRMS CREF CURRENT TIME.
C
CASE (1)
CALL UPDAT(NDATE,IDATADJ_CURRAD(NDX),LDATE)
LD(1)=ITABLE(2,NN)*1000+(IDPARS(4)-1)
LD(2)=IMIN_CURRADLTG(NDX)
IF(LDATE.GE.2013080100.AND.(LD(2).EQ.15.OR.LD(2).EQ.45))
1 THEN
LD(2)=LD(2)-1
ENDIF
LD(3)=0
LD(4)=JD(4)
C
C 60 MIN TL.
C
CASE (2)
CALL UPDAT(NDATE,IDATADJ_LTG60(NDX),LDATE)
LD(1)=ITABLE(2,NN)*1000+(IDPARS(4)-1)
LD(2)=IMIN_LTG60(NDX)
LD(3)=0
LD(4)=JD(4)
C
C 30 MIN TL.
C
CASE (3)
CALL UPDAT(NDATE,IDATADJ_LTG30(NDX),LDATE)
LD(1)=ITABLE(2,NN)*1000+(IDPARS(4)-1)
LD(2)=IMIN_LTG30(NDX)
LD(3)=0
LD(4)=JD(4)
C
C NO DATA NEEDS TO BE FETCHED, SET BOGUS LD(1) VALUE.
C
CASE (4)
LD(1)=999999999
C
END SELECT
C
C CALL GFETCH TO FETCH DATA, WHILE WILL BE RETURNED
C IN FD1( ).
C
IF (LD(1).NE.999999999) THEN
CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS,
1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,FD1,ND2X3,
2 NWORDS,NPACK,LDATE,NTIMES,CORE,ND10,NBLOCK,
3 NFETCH,NSLAB,MISSP,MISSS,L3264B,1,IER)
C
IF (IER.NE.0) THEN
WRITE (KFILDO,250) (LD(J),J=1,4),LDATE
250 FORMAT(/,' **** IN RATLGRD THE NEEDED VARIABLE ',4I11.9,
1 ' FOR DATE ',I10,' COULD NOT BE FETCHED. ',
2 ' SUPPLY MISSING VALUES TO PREDICTOR VARIABLE.')
DO N=1,ND2X3
FD1(N)=9999.0
END DO
END IF
C
C TRANSFER FD1( ) INTO THE GRID ARRAY WRKIN(NX,NY).
C
KK=0
DO JY=1,NY
DO IX=1,NX
KK=KK+1
WRKIN(IX,JY)=FD1(KK)
END DO
END DO
C
END IF ! IF (LD(1).NE.999999999)
C
C FOR MRMS CREF, INGEST RAP CREF FOR THE PURPOSE OF
C SUBSTITUTING RAP DATA WHERE THE MRMS DATA ARE MISSING.
C
300 IF (NN.EQ.1) THEN
C
C CALL GFETCH TO FETCH RAP GRID. NOTE THAT FOR THE RAP,
C THE MODEL DATE WILL ALWAYS BE 3 HR EARLIER THAN THE MRMS
C OBS DATE. THE 3 HR PROJECTION WILL BE USED FOR FETCHING
C A TIME MATCHED RAP GRID.
C
CALL UPDAT(NDATE,-3,LDATE)
LD(1)=(ITABLE(3,NN)*1000)+MNRAP
LD(2)=0
LD(3)=3 ! 3H PROJ
LD(4)=0
C
CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS,
1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,FD1,ND2X3,
2 NWORDS,NPACK,LDATE,NTIMES,CORE,ND10,NBLOCK,
3 NFETCH,NSLAB,MISSP,MISSS,L3264B,1,IER)
C
C IF THERE IS AN ERROR IN FETCHING THE RAP, JUST SET
C THE FD1( ) ARRAY TO MISSING, AND ALLOW PROCESSING TO
C CONTINUE.
C
IF (IER.NE.0) THEN
WRITE(KFILDO,310) (LD(J),J=1,4),LDATE
310 FORMAT(/,' UNABLE TO FETCH HRRR DATA ',4I10.9,
1 ' FOR DATE ',I10,' ... SET HRRR DATA TO',
2 ' MISSING.')
DO KK=1,ND2X3
FD1(KK)=9999.0
END DO
END IF
C
C TRANSFER DATA FROM FD1( ) TO WRKINH( , ).
C CHANGE (PRESUMABLY) UNDEFINED NEGATIVE CREF
C VALUES TO 0.
C
KK=0
DO JY=1,NY
DO IX=1,NX
KK=KK+1
WRKINH(IX,JY)=FD1(KK)
IF (WRKINH(IX,JY).LT.0.0) WRKINH(IX,JY)=0.0
ENDDO
ENDDO
C
C WRKINH( , ) WILL CONTAINS THE RAP CREF.
C WRKIN( , ) WILL CONTAIN THE MRMS CREF.
C APPLY MASK TO THE MRMS, AND MERGE THE MRMS+RAP.
C
DO JY=1,NY
DO IX=1,NX
C
IF ((RMASK(IX,JY).LT.0.5).OR.(RMASK(IX,JY).GT.1.5)) THEN
WRKIN(IX,JY)=9999.0
END IF
C
IF (WRKIN(IX,JY).GT.9998.5) THEN
WRKIN(IX,JY)=WRKINH(IX,JY)
END IF
END DO
END DO
C
END IF ! IF (NN=1)
C
C TRANSFER DATA FROM WRKIN( , ) TO GRDOUT( , , ).
C
IF (NN.LE.3) THEN
DO JY=1,NY
DO IX=1,NX
GRDOUT(IX,JY,NN)=WRKIN(IX,JY)
END DO
END DO
C
C SPECIAL PROCESSING - NN=4
C COMPUTE AND STORE IN GRDOUT( , ,4) THE 30-MIN TL COUNT TIME
C CHANGE ENDING HH:IMIN_CURRADLTG(NDX).
C
ELSE IF (NN.EQ.4) THEN
DO JY=1,NY
DO IX=1,NX
IF (GRDOUT(IX,JY,2).LT.9998.5.AND.
1 GRDOUT(IX,JY,3).LT.9998.5) THEN
GRDOUT(IX,JY,4)=2.0*GRDOUT(IX,JY,3)-GRDOUT(IX,JY,2)
ELSE
GRDOUT(IX,JY,4)=9999.0
END IF
END DO
END DO
END IF
C
490 CONTINUE ! DO NN=1,NUMOUT
C
C ALL OUTPUT GRIDS ARE NOW COMPUTED AND STORED. SET NDATEO TO
C NDATE.
C
500 NDATEO=NDATE
C
END IF ! IF (NDATE.NE.NDATEO)
C
C TRUNCATE VARIABLE AS DEFINED IN TRUNC( , ) ARRAY.
C TRUNC(1, ) = 1 MEANS PERFORM TRUNCATION.
C TRUNC(2, ) IS THE LOWER TRUNCATION BOUND.
C TRUNC(3, ) IS THE UPPER TRUNCATION BOUND.
C
600 IF (NINT(TRUNC(1,JVAR)).EQ.1) THEN
C
C INITIALIZE COUNTERS FOR TRUNCATION RESULTS.
C
NTRUNCLO=0
NTRUNCHI=0
C
C PERFORM TRUNCATION. NOTE THAT FOR THE VIL, CODED
C INDETERMINE VALUES WILL GET SET TO 0 IF TRUNCATION
C IS ACTIVATED, AND MIN SET TO 0.0. THIS WILL SHOW
C A HIGH COUNT OF TRUNCATED VALUES IN THE FORT.
C
DO JY=1,NY
DO IX=1,NX
C
IF (GRDOUT(IX,JY,JVAR).LT.9998.5) THEN
IF (GRDOUT(IX,JY,JVAR).LT.TRUNC(2,JVAR)) THEN
GRDOUT(IX,JY,JVAR)=TRUNC(2,JVAR)
NTRUNCLO=NTRUNCLO+1
END IF
IF (GRDOUT(IX,JY,JVAR).GT.TRUNC(3,JVAR)) THEN
GRDOUT(IX,JY,JVAR)=TRUNC(3,JVAR)
NTRUNCHI=NTRUNCHI+1
END IF
END IF
C
END DO
END DO
C
C DIAGNOSTIC PRINT FOR TRUNCATION, IF IT OCCURRED.
C
IF ((NTRUNCLO.GT.0).OR.(NTRUNCHI.GT.0)) THEN
WRITE(KFILDO,620) NDATE,(ID(K),K=1,4),NTRUNCLO,TRUNC(2,JVAR),
1 NTRUNCHI,TRUNC(3,JVAR)
620 FORMAT(' ON DATE ',I10,' FOR VARIABLE ',4I11.9,' THERE WERE',
1 I7,' VALUES BELOW ',F8.2,' AND ',I7,' VALUES ABOVE',
2 F8.2,' TRUNCATED.')
END IF
C
END IF ! END OF TRUNCATION
C
C PRIOR TO SMOOTHING, FOR THE MRMS VARIABLES, NON-MISSING
C DATA AT THIS POINT DOES NOT FILL THE ENTIRE 10KM GRID, DUE
C TO THE 3KM HRRR GRID JUST BEING A SUBSET. IF ONLY A SUBSET
C OF THE GRID IS MISSING THEN SET MISSING VALUES TO 0. THIS
C IS DONE FOR THE FOLLOW-UP U150 RUN, SO THERE ARE NO MISSING
C VALUES ON THE GRID.
C
IF (JVAR.LE.4) THEN
C
C FIRST LOOP COUNTS UP MISSING VALUES
C
NMISS=0
DO JY=1,NY
DO IX=1,NX
IF (GRDOUT(IX,JY,JVAR).GT.9998.5) NMISS=NMISS+1
END DO
END DO
C
C SECOND LOOP WILL SET MISSING VALUES TO 0, PROVIDED
C ONLY A SUBSET OF THE DOMAIN IS MISSING.
C
IF (NMISS.LT.NX*NY) THEN
DO JY=1,NY
DO IX=1,NX
IF (GRDOUT(IX,JY,JVAR).GT.9998.5) GRDOUT(IX,JY,JVAR)=0.0
END DO
END DO
END IF
C
END IF ! IF JVAR.LE.4
C
C PERFORM SMOOTHING ON 10KM OUTPUT GRID TO BE RETURNED
C
DO 640 II=1,NUMPASS
IF (WT(II,JVAR).NE.0.0) THEN
CALL SMTH9VW(GRDOUT(1,1,JVAR),NX,NY,WT(II,JVAR),GRD2,
1 9999.,1)
ENDIF
640 CONTINUE
C
C MOVE GRIDDED VARIABLE TO THE ONE-DIMENSIONAL OUTPUT ARRAY.
C
KK=0
DO JY=1,NY
DO IX=1,NX
KK=KK+1
DATA(KK)=GRDOUT(IX,JY,JVAR)
END DO
END DO
C
C SET NSLAB AND ISTAV TO SPECIFY GRID OUTPUT.
C
NSLAB=1
ISTAV=0
C
c WRITE(KFILDO,670) NGRID,NSLAB,ID
c670 FORMAT(/,' AT THE END OF RATLGRD, NGRID=',I4,2X,'NSLAB=',I4,
c 1 ' ID( ) = ',4I11.9)
C
C CALL TIMPR(KFILDO,KFILDO,'END RATLGRD ')
C
999 RETURN
END