SUBROUTINE GETFLD115(KFILDO,KFIL10,LD,JDATE,LP, 1 P,FD3,ND2X3, 2 NCEPNO,LAMPNO,NPROJ,ORIENT,XLAT, 3 NXL,NYL,NXPL,NYPL,ALATL,ALONL,MESHB, 4 NX,NY,MESH,ITRPLQ, 5 LSTORE,LITEMS,ND9, 6 IS0,IS1,IS2,IS4,ND7, 7 IPACK,IWORK,ND5, 8 CORE,ND10,NBLOCK,NFETCH,MISTOT,NSLAB, 9 L3264B,IER) C C DECEMBER 2002 GLAHN TDL LAMP-2000 C MODIFIED FROM GETFLD C DECEMBER 2002 RUDACK MODIFIED FORMAT STATEMENTS TO ADHERE C TO THE F90 COMPILER STANDARDS FOUND ON C THE IBM SYSTEM C MARCH 2024 SAMPLATSKY THIS VERSION OF GETFLD1 OPERATES C ON HOURLY MODEL INPUT, AND PERFORMS C TIME INTERPOLATION TO 15 MIN INSTEAD C OF HOURLY TIMES. C C PURPOSE C TO PROVIDE A FIELD ON THE LAMP GRID AT THE DESIRED C PROJECTION FROM THE MOS-2000 INTERNAL RANDOM ACCESS FILE. C THIS MAY REQUIRE ACCESSING TWO FIELDS AND INTERPOLATING C IN TIME. THE FIELD IS PUT ON THE LAMP GRID WITH C THE DESIRED RESOLUTION, MESH. GETFLD1 LOOKS FOR DATA ONLY C FOR THE DATE JDATE; NO ATTEMPT IS MADE TO GO TO A C PREVIOUS CYCLE. C C THE ONLY DIFFERENCE BETWEEN GETFLD AND THIS GETFLD1 C IS (ONLY) WHEN TIME INTERPOLATION IS REQUIRED, THE FIELD C IS PAKCED AND WRITTEN TO THE INTERNAL STORAGE SYSTEM. C THE MINIMUM GROUP SIZE IS USED SUCH THAT SIMPLE C PACKING RESULTS (ONLY ONE GROUP). C C FATAL ERRORS, IER: C 777--CANNOT OBTAIN THE FIELD. C C DATA SET USE C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) C KFIL10 - UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (INPUT) C C VARIABLES C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) C KFIL10 = UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (INPUT/OUTPUT) C LD(J) = THE ID OF THE FIELD NEEDED. (INPUT) C JDATE = DATE/TIME, YYYYMMDDHH. THIS IS THE TIME OF C THE FIELD WANTED. (INPUT) C P(IXY) = HOLDS THE FIELD WANTED (IXY=1,NX*NY). (OUTPUT) C FD3(J) = WORK ARRAY (J=1,ND2X3). (INTERNAL) C ND2X3 = DIMENSION OF P( ) AND FD2( ). (INPUT) C NCEPNO = TDL NUMBER FOR NCEP GRIDS USED: C 8 = AVN, ETC. C (INPUT) C LAMPNO = TDL NUMBER FOR LAMP GRIDS = 5. (INPUT) C NPROJ = NUMBER OF MAP PROJECTION NEEDED. C 5 = POLAR STEREOGRAPHIC. C (INPUT) C ORIENT = ORIENTATION W LONGITUDE, PARALLEL TO GRID C COLUMNS, IN DEGREES. (INPUT) C XLAT = LATITUDE IN DEGREES AT WHICH THE MESH LENGTH C APPLIES. C NXL, NYL = DIMENSION OF BASIC LAMP GRID. (INPUT) C NXPL, NYPL = POLE POSITION OF BASIC LAMP GRID. (INPUT) C ALATL = LATITUDE IN DEGREES OF THE LOWER LEFT CORNER C POINT (1,1) OF THE ANALYSIS (LAMP) GRID. NOTE C THAT THIS REMAINS CONSTANT FOR ALL GRIDS C AFTER THE INPUT GRID IS POSITIONED. (INPUT) C ALONL = LONGITUDE (WEST) IN DEGREES OF THE LOWER LEFT C CORNER POINT OF THE ANALYSIS (LAMP) GRID. NOTE C THAT THIS REMAINS CONSTANT FOR ALL GRIDS C AFTER THE INPUT GRID IS POSITIONED. (INPUT) C MESHB = THE NOMINAL MESH LENGTH OF 1/4 BEDIENT GRID. C 1/4 BEDIENT AT 60 N IS 95.25 KM WHICH IS ABOUT C 80 KM OVER THE U.S. MESH = 80 CORRESPONDS TO C 95.25 STORED WITH THE GRIDS. NXL, NYL, ETC. C ARE IN RELATION TO THIS. (INPUT) C NX, NY = DIMENSION OF GRID NEEDED FOR FIRST GUESS C AND RETURNED. (OUTPUT) C MESH = THE NOMINAL MESH LENGTH OF THE RETURNED GRID. C THIS IS NOT CHANGED IN GETFLD1. (INPUT) C ITRPLQ = TYPE OF INTERPOLATION TO GO FROM ONE MESH C LENGTH TO ONE OF HALF THAT FOR THE C FIRST PASS FOR THE NCEP OPTION. C 1 = BILINEAR C 2 = BIQUADRATIC C (INPUT) C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA C STORED (L=1,12) (J=1,LITEMS). (INPUT/OUTPUT) C LITEMS = THE NUMBER OF ITEMS J IN LSTORE( ,L). C (INPUT/OUTPUT) C ND9 = MAXIMUM NUMBER OF FIELDS STORED IN LSTORE( , ). C SECOND DIMENSION OF LSTORE( , ). (INPUT) C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,4). C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,21+). C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12). C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4). C ND7 = DIMENSION OF IS0( ), IS1( ), IS2( ), AND IS4( ). C (INPUT) C IPACK(J) = WORK ARRAY FOR GFETCH (J=1,ND5). (INTERNAL) C IWORK(J) = WORK ARRAY FOR GFETCH (J=1,ND5). (INTERNAL) C ND5 = DIMENSION OF IPACK( ), AND IWORK( ). (INPUT) C CORE(J) = SPACE ALLOCATED FOR SAVING PACKED GRIDPOINT C FIELDS (J=1,ND10). WHEN THIS SPACE IS C EXHAUSTED, SCRATCH DISK WILL BE USED. THIS IS C THE SPACE USED FOR THE MOS-2000 INTERNAL RANDOM C ACCESS SYSTEM. (INPUT) C ND10 = THE MEMORY IN WORDS ALLOCATED TO THE SAVING OF C DATA CORE( ). WHEN THIS SPACE IS EXHAUSTED, C SCRATCH DISK WILL BE USED. C NBLOCK = BLOCK SIZE IN WORDS OF INTERNAL MOS-2000 DISK C STORAGE. C NFETCH = INCREMENTED EACH TIME DATA ARE FETCHED BY C GFETCH. IT IS A RUNNING COUNT FROM THE C BEGINNING OF THE PROGRAM. THIS COUNT C IS MAINTAINED IN CASE THE USER NEEDS IT C (DIAGNOSTICS, ETC.). (OUTPUT) C MISTOT = RUNNING TOTAL OF RETRIEVED GRIDS WITH ONE OR C MORE MISSING VALUES. (INPUT/OUTPUT) C NSLAB = SLAB OF THE GRID CHARACTERISTICS. THE C RETURNED GRID WILL MATCH NSLAB. (OUTPUT) C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING C USED (EITHER 32 OR 64). (INPUT) C IER = ERROR CODE. C 0 = GOOD RETURN. C 199 = TWO GRIDS FOUND DO NOT HAVE SAME C CHARISTERISTICS. C 777 = MODEL NUMBER DOES NOT MATCH NCEP, LAMP, C OR RADAR NUMBER. FATAL ERROR. C OTHER VALUES FROM CALLED ROUTINES. C (OUTPUT) C LSLAB = SLAB OF THE GRID CHARACTERISTICS. THIS IS USED C IN ALL CALLS TO GFETCH AFTER THE FIRST TO ASSURE C THAT ALL GRIDS MATCH. (INTERNAL) C NWORDS = NUMBER OF WORDS IN THE FIELD READ BY GFETCH. C NOT ACTUALLY USED. (INTERNAL) C JTAU1 = THE FIRST PROJECTION OF NCEP FORECASTS NEEDED. C NCEP FORECASTS ARE AVAILABLE AT 3-HOUR C INTERVALS. IF THE PROJECTION NEEDED IS NOT C ONE OF THE PROJECTIONS AVAILABLE, THEN C INTERPOLATION NEEDS TO BE DONE, AND IN THAT C CASE, JTAU1 IS THE EARLIER PROJECTION NEEDED. C (SEE JTAU2). (INTERNAL) C JTAU2 = THE SECOND PROJECTION OF NCEP FORECASTS NEEDED. C IF JTAU1 IS ONE OF THE PROJECTIONS AVAILABLE, C JTAU2 = 999 WHICH INDICATES INTERPOLATION IS NOT C NECESSARY. (INTERNAL) C TRATIO = THE FRACTION OF THE WAY BETWEEN 3-HOURLY NCEP C FORECASTS TO GET THE PROJECTION NEEDED, WHEN C TIME INTERPOLATION IS NEEDED. WILL BE 0, 1/3, C OR 2/3. (INTERNAL) C MD(J) = ARGUMENT FOR GFETCH WHEN LD( ) IS NOT WHAT IS C WANTED (J=1,4). (INTERNAL) C NRADNO = MODEL NUMBER FOR RADAR DATA. (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES CALLED C GFETCH, CHKGRD, XMSMSH, POSGRD, SIZEGR C DIMENSION P(ND2X3) DIMENSION FD3(ND2X3) DIMENSION IPACK(ND5),IWORK(ND5) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10) DIMENSION LD(4),MD(4) C DATA NRADNO/4/ C IER=0 C D CALL TIMPR(KFILDO,KFILDO,'START GETFLD115 ') C*** WRITE(KFILDO,1002)(LD(J),J=1,4),NCEPNO,LAMPNO,NPROJ,ORIENT,XLAT, C*** 1 NXL,NYL,NXPL,NYPL,ALATL,ALONL,MESHB, C*** 2 NX,NY,MESH,ITRPLQ,ND9,ND7,ND5,ND10 C*** 1002 FORMAT(/' IN GETFLD115 AT 1002--(LD(J),J=1,4),', C*** 1 'NCEPNO,LAMPNO,NPROJ,ORIENT,XLAT,', C*** 2 'NXL,NYL,NXPL,NYPL,ALATL,ALONL,MESHB,', C*** 3 'NX,NY,MESH,ITRPLQ,ND9,ND7,ND5,ND10'/ C*** 4 4I12/3I4,2F10.3,4I4,2F10.3,7I4,2I8) C C TRY TO GET THE FIELD AT THE DESIRED PROJECTION. C CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,P,ND2X3, 2 NWORDS,NPACK,JDATE,NTIMES,CORE,ND10, 3 NBLOCK,NFETCH,NSLAB,MISSP,MISSS,L3264B,1,IER) IF(MISSP.NE.0)MISTOT=MISTOT+1 C C IF(IER.NE.0)THEN IF(IER.NE.0.OR.MOD(LP,4).NE.0)THEN D WRITE(KFILDO,100) D100 FORMAT(' FIELD UNAVAILABLE AT DESIRED PROJECTION;', D 1 ' INTERPOLATION MAY BE NEEDED.') GO TO 101 C IF THE FIELD IS NOT AVAILABLE, INTERPOLATION WILL C BE NEEDED. ENDIF C C CHECK GRID PARAMETERS. C CALL CHKGRD(KFILDO,LD,NPROJ,ORIENT,XLAT,IS2,ND7,IER) C IF(IER.NE.0)THEN D WRITE(KFILDO,1000) D1000 FORMAT(' FIELD UNAVAILABLE AT DESIRED PROJECTION;', D 1 ' INTERPOLATION MAY BE NEEDED.') GO TO 101 C IF THE FIELD IS NOT AVAILABLE, INTERPOLATION MAY C BE NEEDED. ENDIF C GO TO 138 C ACCESS WAS SUCCESSFUL AT THE DESIRED PROJECTION. MAKE SURE C IT IS ON THE LAMP GRID. C C INTERPOLATION IS LIKELY NEEDED. IT IS ASSUMED NCEP C FORECASTS ARE AVAILABLE EVERY 3 HOURS AND LAMP FORECASTS C EVERY HOUR. C C CHANGE FOR 15 MIN: ASSUME MODEL FORECASTS ARE AVAILABLE C HOURLY, AND INTERPOLATE TO BETWEEN THE HOURS. C 101 MODNO=LD(1)-(LD(1)/100)*100 JTAU=LD(3)-(LD(3)/1000)*1000 C IF(MODNO.EQ.NCEPNO)THEN C C IF(MOD(JTAU,3).EQ.0)THEN IF(MOD(LP,4).EQ.0)THEN JTAU1=JTAU JTAU2=999 TRATIO=0. ELSE C JTAU1=JTAU-MOD(JTAU,3) C JTAU2=JTAU1+3 JTAU1=JTAU JTAU2=JTAU1+1 FAC=1./4. TRATIO=FAC*MOD(LP,4) ENDIF C ELSEIF(MODNO.EQ.LAMPNO)THEN JTAU1=JTAU JTAU2=999 TRATIO=0. ELSEIF(MODNO.EQ.NRADNO)THEN JTAU1=JTAU JTAU2=999 TRATIO=0. ELSE WRITE(KFILDO,102)MODNO,NCEPNO,LAMPNO,NRADNO 102 FORMAT(/' ****MODEL NUMBER =',I3,' IN GETFLD115 DOES NOT', 1 ' MATCH NCEP MODEL NUMBER =',I3, 2 ' OR LAMP MODEL NUMBER =',I3, 3 ' OR RADAR MODEL NUMBER =I3'/ 4 ' THIS IS A FATAL ERROR.') IER=777 GO TO 200 ENDIF C C GET THE FIRST FIELD IN ( , ). NO NEED TO LOOK C IF THE PROJECTION IS THE SAME AS LOOKED FOR BEFORE. C IF(JTAU1.EQ.LD(3))GO TO 200 C NOTE THAT FOR NCEP FILEDS, IT IS ASSUMED THEY ARE C AVAILABLE EVERY 3 HOURS AND INTERPOLATION IS DONE C FOR ODD HOURS. FOR LAMP, FIELDS ARE EXPECTED EVERY C HOUR, AND INTERPOLATION WILL NOT BE DONE. C MD(1)=LD(1) MD(2)=LD(2) MD(3)=JTAU1 MD(4)=LD(4) CALL GFETCH(KFILDO,KFIL10,MD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,P,ND2X3, 2 NWORDS,NPACK,JDATE,NTIMES,CORE,ND10, 3 NBLOCK,NFETCH,NSLAB,MISSP,MISSS,L3264B,1,IER) IF(MISSP.NE.0)MISTOT=MISTOT+1 IF(LD(1).EQ.1201005)STOP 66666 C IF(IER.NE.0)THEN WRITE(KFILDO,105)(MD(J),J=1,4),JDATE 105 FORMAT(' FIELD ',3I10,I11,' FOR DATE',I12, 1 ' UNAVAILABLE; TRY ANOTHER CYCLE.') GO TO 200 C IF THE FIELD IS NOT AVAILABLE, TRY ANOTHER RUN CYCLE. ENDIF C C CHECK GRID PARAMETERS. C CALL CHKGRD(KFILDO,LD,NPROJ,ORIENT,XLAT,IS2,ND7,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,115)(MD(J),J=1,4),JDATE 115 FORMAT(' FIELD ',3I10,I11,' FOR DATE',I12, 1 ' UNAVAILABLE; TRY ANOTHER CYCLE.') GO TO 200 C IF THE FIELD IS NOT AVAILABLE, TRY ANOTHER RUN CYCLE. ENDIF C C IT IS ASSUMED THE NCEP ARCHIVE IS ON A PARTICULAR GRID. C IF THIS IS NOT FOUND, TRY ANOTHER RUN CYCLE. C C AT THIS POINT, THE MODEL FIELD FOR THE 1ST PROJECTION NEEDED C FOR (POSSIBLE) TIME INTERPOLATION HAS BEEN READ INTO P( ). C TRY FOR THE SECOND FIELD. C IF(JTAU2.EQ.999)GO TO 138 C TRANSFER WHEN NO SECOND FIELD NECESSARY. LX=IS2(3) LY=IS2(4) C THE DIMENSIONS OF THE FIRST GRID ARE SAVED TO MAKE SURE C THE FOLLOWING ONES ARE OF THE SAME SIZE. MD(3)=JTAU2 CALL GFETCH(KFILDO,KFIL10,MD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,FD3,ND2X3, 2 NWORDS,NPACK,JDATE,NTIMES,CORE,ND10, 3 NBLOCK,NFETCH,LSLAB,MISSP,MISSS,L3264B,1,IER) IF(MISSP.NE.0)MISTOT=MISTOT+1 C IF(IER.NE.0)THEN WRITE(KFILDO,120)(MD(J),J=1,4),JDATE 120 FORMAT(' FIELD ',3I10,I11,' FOR DATE',I12, 1 ' UNAVAILABLE; TRY ANOTHER CYCLE.') GO TO 200 C IF THE FIELD IS NOT AVAILABLE, TRY ANOTHER RUN CYCLE. ENDIF C C CHECK GRID PARAMETERS. C CALL CHKGRD(KFILDO,LD,NPROJ,ORIENT,XLAT,IS2,ND7,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,122)(MD(J),J=1,4),JDATE 122 FORMAT(' FIELD ',3I10,I11,' FOR DATE',I12, 1 ' UNAVAILABLE; TRY ANOTHER CYCLE.') GO TO 200 ENDIF C C IT IS ASSUMED THE DATA ARE ON A PARTICULAR GRID. C IF THIS IS NOT FOUND, TRY ANOTHER RUN CYCLE. C C AT THIS POINT, TWO FIELDS HAVE BEEN RETURNED. C MUST MAKE SURE THE GRIDS ARE THE SAME; CHKGRD CHECKS C ONLY CERTAIN THINGS. C IF(NSLAB.NE.LSLAB.OR.LX.NE.IS2(3).OR.LY.NE.IS2(4))THEN WRITE(KFILDO,125)NSLAB,LSLAB,LX,LY,IS2(3),IS2(4) 125 FORMAT(/' ****TWO GRIDS OBTAINED IN GETFLD115 DO NOT', 1 ' HAVE THE SAME CHARACTERISTICS AT 125'/ 2 ' NSLAB LSLAB LX LY IS2(3) IS2(4)'/ 3 I10,I6,I5,I5,I7,I7/ 4 ' TRY ANOTHER RUN CYCLE.') IER=199 C IER=199 IS THE NUMBER ALSO USED BY CHKGRD WHEN C THE GRIDS DON'T MATCH. GO TO 200 ENDIF C C COMPUTE FINAL FILED INTERPOLATED IN TIME. C THE GRID SIZE IS STILL IS2(3) BY IS2(4) C DO 135 IXY=1,IS2(3)*IS2(4) P(IXY)=(FD3(IXY)-P(IXY))*TRATIO+P(IXY) 135 CONTINUE C C PACK AND WRITE THE GRID TO THE MOS-2000 INTERNAL STORAGE C SYSTEM. (IT COULD BE PUT THROUGH POSGRD AND SIZEGR FIRST, C BUT FOR U150 IT IS LIKELY THE INPUT GRID AND THE NEEDED C GRID ARE THE SAME.) C C 15 MIN UPDATE: SINCE LD(3) DOES NOT SUPPORT 15 MIN TIME C INCREMENTS, DO NOT WRITE INTERPOLATED FIELDS TO INTERNAL C STORAGE. C C CALL PACK2D(KFILDO,P,FD3,IWORK,IS2(3),IS2(4),IS0,IS1,IS2,IS4, C 1 ND7,FLOAT(MISSP),FLOAT(MISSS),IPACK,ND5, C 2 IS2(3)*IS2(4)-2,LX,IOCTET,L3264B,IER) C NOTE THE GROUP SIZE; THIS WILL DEVOLVE TO SIMPLE PACKING. C THE MAXIMUM GROUP SIZE IS THE GRID SIZE MINUS 2. C IF(IER.NE.0)GO TO 200 C IER NE 0 FROM PACK2D TREATED AS FATAL WITH RETURN TO C CALLING PROGRAM. C C CALL GSTORE(KFILDO,KFIL10,LD,MESHB,LSTORE,ND9,LITEMS, C 1 IPACK,(IOCTET*8)/L3264B,2,0,IS1(8), C 2 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,L3264B,IER) C THIS FIELD WILL LIKELY NOT BE CARRIED FROM CYCLE TO CYCLE C EVEN IF ITS COMPONENT FIELDS ARE. IT SHOULD BE RARE C IT WOULD BE NEEDED AND EVEN IF SO THE COMPONENT FILEDS C OUGHT TO BE THERE. THE IDS IN LD( ) ARE THOSE INPUT C THROUGH THE CALLING SEQUENCE AS DESIRED. C IF(IER.NE.0)GO TO 200 C IER NE 0 FROM PACK2D TREATED AS FATAL WITH RETURN TO CALLING C PROGRAM. C C THE GRID IS IN P( ) STILL ON THE GRID AS READ OR C INTERPOLATED. IT NEEDS TO BE ON THE LAMP GRID. C 138 CALL XMSMSH(KFILDO,IS2(8)/1000000.,MESHI,TRASH) C XMSMSH GETS THE NOMINAL MESH LENGTH MESH OF THE CURRENT C GRID GIVEN THE ACTUAL MESH LENGTH IN IS2(8). CALL POSGRD(KFILDO,P,MESHB,ALATL,ALONL,NXL,NYL,NXPL,NYPL, 1 MESHI,XMESHI,XLAT,ORIENT, 2 IS2(3),IS2(4),IS2(5)/10000.,IS2(6)/10000., 3 NX,NY,NXP,NYP, 4 ND2X3) C ALATL, ALONL, NXL, NYL, NXPL, AND NYPL ALL REFER TO THE C MESH LENGTH MESHB. XMESHI IS RETURNED BUT NOT USED. C THE DIVISION OF IS2(5) AND IS2(6) BY A FLOATING POINT C NUMBER MAKES THEM FLOATING POINT FOR POSGRD. C NX, NY, NXP, AND NYP NOW REPRESENT THE GRID IN P( ) AT C MESHL LENGTH MESHI. MESHI IS THE INPUT MESH LENGTH, C AND NOT NECESSARILY EQUAL TO MESH. C CALL SIZEGR(KFILDO,P,NX,NY,NXP,NYP, 1 MESHI,MESH,ITRPLQ,ND2X3) C NX, NY, NXP, NYP ARE MODIFIED IN SIZEGR FROM THE INPUT C TO THE OUTPUT GRID; MESH CORRESPONDS TO THEM. C D CALL TIMPR(KFILDO,KFILDO,'END GETFLD115 ') C 200 RETURN END