SUBROUTINE HRRRLAG(KFILDO,KFIL10, 1 ID,IDPARS,JD,THRESH,NDATE, 2 IPACK,IWORK,DATA,ND5, 3 LSTORE,ND9,LITEMS,CORE,ND10, 4 NBLOCK,NFETCH,NSLAB, 5 IS0,IS1,IS2,IS4,ND7, 6 ISTAV,L3264B,IER) C C MAY 2016 GLAHN MDL MOS-2000 C DECEMBER 2016 GHIRARDELLI CHANGED NAME FROM HRRLAG C MAY 2017 SCHNAPP MODIFIED FOR DIFFERENT CCCFFF'S C MAY 2017 SCHNAPP CHANGED DATA, ND5 TO SDATA, ND1 C MAY 2017 SCHNAPP PERSIST HRRR 18-HOUR DATA C MAY 2017 SCHNAPP MAINTAIN REQUESTED TAU, C DO NOT INCREMENT TAU BY RR C C PURPOSE C TO COMPUTE A LAGGED MODEL FIELD. IN COMBINING 3 OR MORE C LAGGED RUNS, EACH HAS THE SAME ID INCLUDING MODEL NUMBER, C THIS ROUTINE IS NEEDED FOR PERSISTING THE LAST FCSTS C PROJECTION OF OLDER RUNS. C C DATA SET USE C KFILDO - DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. C (OUTPUT) C KFIL10 - UNIT NUMBER OF MDL MOS-2000 INTERNAL RANDOM ACCESS C FILE SYSTEM ACCESS. C (INPUT-OUTPUT) C C VARIABLES C KFILDO = DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. C (INPUT) C KFIL10 = UNIT NUMBER OF MDL MOS-2000 INTERNAL RANDOM C ACCESS FILE SYSTEM ACCESS. (INPUT) C ID(J) = THE PREDICTOR ID (J=1,4). (INPUT) C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE C PREDICTOR 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 IN C 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,N) = THE BASIC INTEGER VARIABLE ID (J=1,4) C (N=1,NPRED). C THIS IS THE SAME AS ID(J,N), 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 C THRESH( ). C THRESH = THE THRESHOLD FOR THE RF. (INPUT) C NDATE = THE DATE/TIME FOR WHICH PREDICTOR IS NEEDED. C (INPUT) C IPACK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C IWORK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C DATA(J) = ARRAY TO HOLD RETURNED VECTOR DATA. (J=1,ND1). C (OUTPUT) C ND5 = DIMENSION OF IPACK( ), IWORK( ), DATA( ) AND C CCALLD( ). (INPUT) 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 NOT. C L=8 --THE DATE/TIME OF THE DATA IN FORMAT C YYYYMMDDHH. C L=9 --NUMBER OF TIMES DATA HAVE BEEN 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 PREDICTOR IN THE SORTED C LIST IN ID( ,N) (N=1,NPRED) FOR WHICH C THIS VARIABLE IS NEEDED, WHEN IT IS C NEEDED ONLY ONCE FROM LSTORE( , ). WHEN C IT IS NEEDED MORE THAN ONCE, THE VALUE IS C SET = 7777. C L=12 --USED INITIALLY IN ESTABLISHING C MSTORE( , ). 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. C CORE(J) = THE ARRAY TO STORE OR RETRIEVE THE DATA C IDENTIFIED IN LSTORE( , ) (J=1,ND10). WHEN C CORE( ) IS FULL C DATA ARE STORED ON DISK. (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 = THE NUMBER OF TIMES GFETCH HAS BEEN ENTERED. C GFETCH KEEPS TRACK OF THIS AND RETURNS THE C VALUE. (OUTPUT) C NSLAB = THE NUMBER OF THE SLAB IN DIR( , , ) AND C IN NGRIDC( , ) DEFINING THE CHARACTERISTICS C OF THIS GRID. SEE LSTORE(10, ). FOR THE C COMPUTATION ROUTINES RETURNING A GRID, THIS C VALUE MUST BE OUTPUT BY GFETCH. (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( ). C NOT ALL LOCATIONS ARE USED. (INPUT) C ISTAV = 1 WHEN THE DATA RETURNED ARE STATION DATA. C 0 WHEN THE DATA RETURNED ARE GRID DATA OR DATA C ARE NOT AVAILABLE FOR RETURN. (OUTPUT) C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING C USED (EITHER 32 OR 64). (INPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C SEE CALLED ROUTINES FOR OTHER VALUES. C (INTERNAL-OUTPUT) C ITABLE(2,L) = THE VARIABLES THAT CAN BE COMPUTED (J=1) AND C WHAT THEY ARE COMPUTED FROM (J=2) (L=1,IDEM) C (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C GFETCH C PARAMETER (IDEM=4) C DIMENSION ID(4),IDPARS(15),JD(4) DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5) C IPACK( ) AND IWORK( ) ARE DIMENSIONED ND5 IN CALLING PROGRAM. C THIS IS OK BECAUSE ND5 > ND1. DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10) DIMENSION LD(4) DIMENSION ITABLE(2,IDEM) C DATA ITABLE/008025, 008020, 1 008035, 008030, 2 008125, 008120, 3 008340, 008335/ C CALL TIMPR(KFILDO,KFILDO,'START HRRRLAG ') IER=0 ISTAV=0 C VARIABLE RETURNED IS A VECTOR. C C FIND THE FIELD DEALT WITH. C DO 200 L=1,IDEM C IF(ID(1)/1000.EQ.ITABLE(1,L))THEN C THIS VARIABLE IS ACCOMMODATED. NRR=IDPARS(9) C C READ VARIABLE INTERNAL STORAGE WITH RR = NRR C INTO SDATA( ). C LD(1)=ITABLE(2,L)*1000+IDPARS(3)*100+IDPARS(4) LD(2)=JD(2) C PERSIST 18-HR HRRR DATA OUT IF(IDPARS(12).GT.18)THEN LD(3)=NRR*1000000+IDPARS(11)*1000+18 ELSE LD(3)=NRR*1000000+IDPARS(11)*1000+IDPARS(12) ENDIF LD(4)=JD(4) C CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,DATA,ND5, 2 NWORDS,NPACK,NDATE,NTIMES,CORE,ND10,NBLOCK, 3 NFETCH,NSLAB,MISSP,MISSS,L3264B,1,IER) C D WRITE(KFILDO,185)IER,NWORDS,(DATA(J),J=1,NWORDS) D185 FORMAT(/' AT 185 IN HRRRLAG--IER,NWORDS,(DATA(J),J-1,NWORDS', D 1 2I6/(15F8.0)) C C TRUST GFETCH TO RETURN MISSING WHEN DATA NOT FOUND. THIS C ELIMINATES A "GO TO" STATEMENT. THIS HAS NOT BEEN C OUR PRACTICE PREVIOUSLY. GO TO 300 ENDIF C 200 CONTINUE C C DROP THROUGH HERE MEANS VARIABLE NOT COMPUTED. MUST C EXIT WITH ERROR. C IER=103 D WRITE(KFILDO,210)(ID(J),J=1,4) D210 FORMAT(/' ****VARIABLE ',I9.9,I10.9,I10.9,I4.3,' NOT', D 1 ' ACCOMMODATED IN HRRRLAG. IER =',I4) C C SET THE RETURNED VALUES TO MISSING. C DO 220 J=1,ND5 DATA(J)=9999. 220 CONTINUE C 300 CONTINUE C D CALL TIMPR(KFILDO,KFILDO,'END HRRRLAG ') RETURN END