SUBROUTINE GTHRES(KFILDO,KFILOG,KFILRA,RACESS,NUMRA,IPRTEL,LD, 1 IP16,IP22, 2 HIRES,ND12,IPACK,DATA,IWORK,ND5, 3 MODNO,NDATE, 4 ALATL,ALONL,NPROJ,ORIENT,XLAT, 5 NXL,NYL,MESHB,BMESH,IOPTB, 6 NXE,NYE,MESHE,EMESH,MESHL, 7 IS0,IS1,IS2,IS4,ND7, 8 JTOTBY,JTOTRC,PLAINT,IPLANT, 9 L3264B,L3264W,MINPK,ISTOP,IER) C C JULY 2004 GLAHN TDL MOS-2000 C ADAPTED FROM GETELE FROM LAMP C OCTOBER 2004 GLAHN MODIFIED FOR LAT/LON VICE POLE C OCTOBER 2004 GLAHN NAME CHANGE FROM GETELV TO GENERALIZE C OCTOBER 2004 GLAHN CHANGED CALL TO PAWOTG TO PAWGTS C OCTOBER 2004 GLAHN INSERTED LAMBERT AND MERCATOR C CAPABILITY C NOVEMBER 2004 GLAHN EXCHANGED NOMINL FOR XMSMSH C NOVEMBER 2004 GLAHN IMPROVED COMMENTS AND FORMATS; C ELIMINATED MESHLD FROM CALL C NOVEMBER 2004 GLAHN SWAPPED CKGRID FOR CHKGRD C DECEMBER 2004 GLAHN CHANGED IOPT( ) TO IOPTB( ); PUT C MESHL IN CALL; RECALCULATED RATIO C DECEMBER 2004 GLAHN PUT IN COMMENT ABOUT ND12 BEFORE CUTIT C DECEMBER 2004 GLAHN CHANGED BASE CONTOUR FOR GRIDPRINTING; C CHANGED JOPT(2)-1 TO JOPT(2) AND C JOPT4)-1 TO JOPT(4) IN CALLS TO C LMIJLL, PSIJLL, AND MCIJLL; COMMENTS C DECEMBER 2004 GLAHN CHANGED EMESH TO XMESHL*1000 IN CALLS C TO PSIJLL, LMIJLL, AND MCIJLL; CALLED C SZGIRD AND ACTUAL PRIOR TO CUTIT; C INVERTED RATIO AT 270 C JANUARY 2005 GLAHN SET SPECIFIC VALUES FOR GRIDPRINT C FEBRUARY 2005 GLAHN MADE INTERPOLATION OF GRID POSSIBLE C AUGUST 2005 GLAHN ADDED TEST ON IOPT(1) TO BYPASS C GRIDDED OUTPUT C SEPTEMBER 2005 GLAHN COMMA IN 2 FORMATS; ALL FLOATS TO REALS C PER TRIMARCO C SEPTEMBER 2005 GLAHN EXCLUDED UNIT 42 FOR READING IN DO 340 C JUNE 2006 GLAHN ADDED COMMENT ABOUT SZGRID BELOW 380 C JULY 2007 GLAHN ADDED COMMA IN D364 C JUNE 2008 GLAHN MOD TO /D DIAGNOSTIC 098 C JUNE 2008 GLAHN ISTOP INCREMENTED AND EXIT AT 380 C JUNE 2009 GLAHN CORRECTED A COMMENT; SPELLING C AUGUST 2009 GLAHN ADDED POSITIVE READ DIAGNOSTIC 357 C JUNE 2014 GLAHN REVISED TO ACCOMMODATE 2 INPUT FILES, C NOS. 43 AND 44 C SEPTEMBER 2016 GLAHN MADE SURE FDX WAS GE ND5 IN SIZE C C PURPOSE C TO ACCESS THE MOS-2000 EXTERNAL RANDOM ACCESS FILE SYSTEM C AND RETRIEVE A "HIGH RESOLUTION CONSTANT" GRID. THE GRID C IS TDLPACKED AND WRITTEN TO UNIT KFILOG AND GRIDPRINTED TO C UNIT IP22 DEPENDING ON IPRTEL KFILOG, AND IP22. THE GRID C IS READ INTO HIRES( ) WITH THE GRID CHARACTERISTICS C IN IS1( ), ETC. CUTIT PUTS IT ONTO THE ANALYSIS GRID WITH C THE SAME MESH LENGTH DETERMINED TO BE MESHI. THE C CHARACTERISTICS OF HIRES( ) ON RETURN ARE NXE, NYE, C AND MESHE. THE GRIDPRINT AND TDLPACK TO KFILOG, IF ANY, C ARE TO THE SUBSET GRID. WHILE WRITTEN FOR THE TERRAIN AND C LAND/SEA MASK FOR U155, IT IS NOT LIMITED TO THOSE FIELDS. C C IT IS EXPECTED THE INPUT GRID HAS THE CHARACTERISTICS C IN THE CALL SEQUENCE, BUT IT CAN BE CUT TO THE CORRECT C AREA AND THE MESH LENGHT BE ADJUSTED BY FACTORS OF 2. C INPUT UNIT NUMBERS 43 AND 44 ARE ACCOMMODATED. C C DATA SET USE C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C KFILOG - UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. (OUTPUT) C KFILRA(J)- UNIT NUMBERS FOR ACCESSING THE MOS-2000 C EXTERNAL RANDOM ACCESS FILES (J=1,6). (INPUT) C IP16 - UNIT NUMBER FOR INDICATING WHEN A RECORD IS C WRITTEN TO THE SEQUENTIAL FILE WITH UNIT C NO. KFILOG. (OUTPUT) C IP22 - UNIT NUMBER FOR GRIDPRINTING. (OUTPUT) C C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C KFILOG = UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. WRITING OF GRID IS NOT DONE WHEN C KFILOG = 0 OR IPRTEL = 0. THIS IS FOR C DIAGNOSTIC INFORMATION. C KFILRA(J) = THE UNIT NUMBERS FOR ACCESSING THE MOS-2000 C EXTERNAL RANDOM ACCESS FILES (J=1,6). C THE ACCESS ROUTINES ALLOW 6 RANDOM ACCESS C FILES. (INPUT) C RACESS(J) = THE FILE NAMES CORRESPONDING TO KFILRA(J) C (J=1,6). (CHARACTER*60) (INPUT) C NUMRA = THE NUMBER OF UNIT NUMBERS IN KFILRA( ) AND C NAMES IN RACESS( ). (INPUT) C IPRTEL = 1 = GRID IS TO BE WRITTEN TO FILE KFILOG C AND GRIDPRINTED FOR THE SUBSETTED AREA; C 0 OTHERWISE. THE FORMER ALSO REQUIRES C KFILOG NE 0 AND THE LATTER REQUIRES IP22 NE 0. C (INPUT) C LD(J) = 4-WORD ID OF CONSTANT GRID TO RETRIEVE. (INPUT) C IP16 = INDICATES WHETHER (>0) OR NOT (=0) C A STATEMENT WILL BE OUTPUT TO IP16 C WHEN A SEQUENTIAL FILE IS WRITTEN THROUGH C PAWGTS. (INPUT) C IP22 = UNIT NUMBER FOR GRIDPRINTING. WRITING TO IP22 C OF GRIDPOINT VALUES IS NOT DONE WHEN C IP22 = 0 OR IPRTEL = 0. (INPUT) C HIRES(J) = THE "HIGH RES" GRID FROM THE MOS-2000 EXTERNAL C RANDOM ACCESS FILE (J=1,NXE*NYE). THIS IS C RETURNED AT ITS ORIGINAL INPUT RESOLUTION, BUT C CUT TO THE AREA OF THE ANALYSIS GRID. THE C GRIDPRINTING, IF ANY, IS AT THAT SAME RESOLUTION, C BUT CUT TO THE DISPOSABLE GRID AREA. THE C OUTPUT TO THE DISPOSABLE GRID, IF ANY, IS C ON THAT AREA AT MESHL RESOLUTION. (OUTPUT) C ND12 = DIMENSION OF HIRES( ). THIS MAY BE LESS THAN C ND5 AND GREATER THAN ND2X3. (INPUT) C IPACK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C DATA(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C IWORK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C ND5 = DIMENSION OF IPACK( ), IWORK( ), AND DATA( ). C (INPUT) C MODNO = OUTPUT MODEL NUMBER. (INPUT) C NDATE = THE DATE/TIME OF THE RUN. (INPUT) C ALATL = NORTH LATITUDE IN DEGREES OF LOWER LEFT CORNER C POINT OF THE ANALYSIS GRID OF MESH SIZE MESHB C AND SIZE SPECIFIED BY NXL AND NYL. (INPUT) C ALONL = WEST LONGITUDE IN DEGREES OF LOWER LEFT CORNER C POINT OF THE ANALYSIS GRID OF MESH SIZE MESHB C AND SIZE SPECIFIED BY NXL AND NYL. (INPUT) C NPROJ = NUMBER OF THE MAP PROJECTION TO WHICH THIS GRID C APPLIES. C 3 = LAMBERT. C 5 = POLAR STEREOGRAPHIC. C 7 = MERCATOR. C (INPUT) C ORIENT = ORIENTATION OF GRID IN WEST LONGITUDE. (INPUT) C XLAT = NORTH LATITUDE AT WHICH GRIDLENGTH IS SPECIFIED C IN DEGREES. (INPUT) C NXL = THE SIZE OF THE ANALYSIS GRID FOR THIS RUN C IN THE X DIRECTION IN MESHB UNITS. (INPUT) C NYL = THE SIZE OF THE ANALYSIS GRID FOR THIS RUN C IN THE Y DIRECTION IN MESHB UNITS. (INPUT) C MESHB = THE NOMINAL MESH LENGTH OF THE ANALYSIS GRID C SPECIFIED BY NXL, NYL AT LATITUDE XLAT. C FOR INSTANCE, NOMINAL 80 CORRESPONDS C TO 95.25 KM FOR POLAR STEREOGRAPHIC. FOR C ALL ROUTINES TO WORK, THIS VALUE MUST BE C 1, 3, 5, 10, 20, 40, 80, 160, OR 320. C THE LOWER NUMBERS ARE INTEGERS APPROXIMATING C EVEN FRACTIONS OF BEDIENTS. C BMESH = ACTUAL MESH LENGTH ASSOCIATED WITH MESHB. C (INPUT) C IOPTB(J) = SUBSETTING VALUES USED IN GRIDPRINTING (J=1,8) C IN RELATION TO THE SUBSETTED AREA AT MESH C LENGTH MESHB. (INPUT) C NXE = X-EXTENT OF HIRES( ). (OUTPUT) C NYE = Y-EXTENT OF HIRES( ). (OUTPUT) C MESHE = NOMINAL MESH LENGTH OF RETURNED CONSTANT GRID C IN HIRES( ). THIS IS THE SAME AS THE INPUT C GRID. (INPUT) C EMESH = ACTUAL MESH LENGTH CORRESPONDING TO MESHE. C (INPUT) C MESHL = MESH LENGTH OF DISPOSABLE GRID. (INPUT) C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,4). C (INTERNAL) C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,21+). 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 C IS4( ). (INPUT) C JTOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED C WITH UNIT NO. KFILOG. (INPUT/OUTPUT) C JTOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE ON UNIT C NUMBER KFILOG. (INPUT/OUTPUT) C PLAINT = THE PLAIN LANGUAGE DESCRIPTION USED TO PACK C TERRAIN, SEA/LAND MASK, OR OTHER GRID. C EQUIVALENCED TO IPLANT. (INPUT) C IPLANT(L,J) = 32 CHARACTERS (L=1,L3264W) (J=1,4) OF PLAIN C LANGUAGE DESCRIPTION OF USED TO PACK C TERRAIN, SEA/LAND MASK, OR OTHER GRID. C EQUIVALENCED TO PLAINT. (INPUT) 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 MINPK = MINIMUM GROUP SIZE WHEN PACKING THE DATA. C (INPUT) C ISTOP = ISTOP IS INCREMENTED BY 1 EACH TIME AN ERROR C OCCURS. (INPUT/OUTPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C 777 = FATAL ERROR C SEE CALLED ROUTINES FOR OTHER VALUES. C ANY NON ZERO VALUE WILL CLOSE OUT THIS C DATE/TIME IN U150. (OUTPUT) C JOPT(J) = VALUES OF IOPTB(J) THAT APPLY TO THE HIRES C GRID INPUT (J=1,8). USED IN GRIDPRINTING. C (INTERNAL) C FDX(J) = ARRAY TO HOLD CUT GRID (J=1,NSIZ). USUALLY, C NSIZ = NXE*NYE. (ALLOCATABLE) (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C CONSTG, CKGRID, PRTGR, TRNSFR, NOMINL, TIMPR, PAWGTS, C CUTIT, DATPRS, PSLLIJ, LMLLIJ, MCLLIJ, PSIJLL, LMIJLL, C MCIJLL C CHARACTER*32 PLAINT CHARACTER*60 RACESS(6) CHARACTER*61 TITLT/' '/ C DIMENSION IPACK(ND5),DATA(ND5),IWORK(ND5) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION HIRES(ND12) DIMENSION IPLANT(L3264W,4) DIMENSION KFILRA(6) DIMENSION IOPTB(8),LD(4),MDATE(4),JOPT(8) DIMENSION FDX(:) C ALLOCATABLE FDX C IER=0 C CALL TIMPR(KFILDO,KFILDO,'START GTHRES ') C D WRITE(KFILDO,098)ND7,ND5,ND12,LD D098 FORMAT(' AT 098--ND7,ND5,ND12,LD',10I10) D WRITE(KFILDO,099)NDATE,KFILOG,NUMRA,KFILRA(1),RACESS(1) D099 FORMAT(' AT 099--NDATE,KFILOG,NUMRA,KFILRA(1),RACESS(1)', D 1 4I11,2X,A60) C C PUT DATE/TIME INTO TITLT(46:61). FIRST PARSE IT INTO C MDATE( ). C TITLT(41:45)=' FOR ' CALL DATPRS(KFILDO,NDATE,MDATE) JMIN=0 D WRITE(TITLT(46:61),100)(MDATE(J),J=1,4),JMIN D100 FORMAT(I4,1X,I2.2,1X,I2.2,1X,2I2.2,1X) C C GET THE GRID IN DATA( ). THE ID HAS DD = 00. ANY C INFORMATION ABOUT HOW THE GRID WAS PRODUCED OR THE C GRID LENGTH IS IN THE CCCFFF. C C FIND THE RANDOM ACCESS UNIT NO. IN RANGE 43 TO 44. C UNIT 42 IS USED FOR WRITING IN U155. C DO 340 J=1,NUMRA IF(KFILRA(J).LT.43.OR.KFILRA(J).GT.44)GO TO 340 C UNIT NO. 42 IS USED FOR WRITING BY U155. GO TO 345 340 CONTINUE C C FALL THROUGH HERE MEANS A RANDOM ACCESS UNIT 43 TO 44 IS C NOT AVAILABLE. THIS IS A FATAL ERROR. TRYING ANOTHER C CYCLE IS NOT CALLED FOR. NOTE THAT ONLY ONE FILE IS C TRIED, WHICH MEANS ALL DATA ACCESSED BY GTHRES MUST BE C ON THE SAME FILE. C WRITE(KFILDO,343) 343 FORMAT(/' ****RANDOM ACCESS UNIT 43-44 NOT AVAILABLE IN GTHRES;', 1 ' THIS IS A TREATED AS A FATAL ERROR.') GO TO 600 C 345 CALL CONSTG(KFILDO,KFILRA(J),RACESS(J),LD, 1 IPACK,IWORK,DATA,ND5, 2 IS0,IS1,IS2,IS4,ND7, 3 ISTAV,L3264B,IER) C IF(IER.NE.0)THEN C IF(J.LT.NUMRA)THEN CALL CONSTG(KFILDO,KFILRA(J+1),RACESS(J+1),LD, 1 IPACK,IWORK,DATA,ND5, 2 IS0,IS1,IS2,IS4,ND7, 3 ISTAV,L3264B,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,350)LD,PLAINT,KFILRA(J),KFILRA(J+1) 350 FORMAT(' ****CONSTANT GRID',4I12,3X,A32, 1 ' UNAVAILABLE IN GTHRES ON UNITS',2I4) GO TO 600 ENDIF C ELSE C WRITE(KFILDO,351)LD,PLAINT,KFILRA(J) 351 FORMAT(' ****CONSTANT GRID',4I12,3X,A32, 1 ' UNAVAILABLE IN GTHRES ON UNIT',I4) GO TO 600 ENDIF C ENDIF C C CHECK GRID PARAMETERS. CKGRID CHECKS ONLY CERTAIN c THINGS. THE GRID JUST READ MIGHT NOT MATCH IN c LOCATION, ETC., THE ANALYSIS GRID. THE INPUT GRID c AT ITS SIZE AND LOCATION IS IN HIRES( ). C CALL CKGRID(KFILDO,LD,NPROJ,ORIENT,XLAT,IS2,ND7,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,355)LD,PLAINT 355 FORMAT(' CONSTANT GRID',4I12,3X,A32,/, 1 ' WITH THE CORRECT GRID CHARACTERISTICS', 2 ' UNAVAILABLE IN GTHRES AT 155.') C CONSTANT GRID IS NOT AVAILABLE WITH THE RIGHT C CHARACTERISTICS; THIS IS A FATAL ERROR. C MORE THAN ONE GRID WITH THE SAME IDS WON'T BE IN C THE FILE. IF THERE WERE, THEY COULDN'T BE C DISTINGUISHED BECAUSE THE IDS WOULD BE THE SAME. GO TO 600 ELSE WRITE(KFILDO,357)LD,PLAINT 357 FORMAT(' CONSTANT GRID READ ',4I12,3X,A32) ENDIF C D WRITE(KFILDO,358)IS2 D358 FORMAT(/' IN GTHRES AT 358--IS2'/(' ',10I12)) C CALL NOMINL(KFILDO,IS2(8)/1000000.,MESHI,TRASH,NPROJ,IER) C NOMINL GETS THE NOMINAL MESH LENGTH MESHI OF THE CONSTANT C GRID GIVEN THE ACTUAL MESH LENGTH IN IS2(8). C IF(IER.NE.0)THEN WRITE(KFILDO,359)LD,PLAINT 359 FORMAT(' FATAL ERROR IN GTHRES AT 359 ACCESSING ', 1 4I12,3X,A32) GO TO 600 ENDIF C IF(MESHI.NE.MESHE)THEN WRITE(KFILDO,360)MESHI,MESHE,LD,PLAINT 360 FORMAT(/' ****THE CONSTANT GRID READ HAS', 1 ' A NOMINAL GRID LENGTH OF ',I5,' KM INSTEAD', 2 ' OF THE ',I5,' EXPECTED.',/, 3 ' LOOKING FOR ',4I12,3X,A32) GO TO 600 ENDIF C C POSITION THIS GRID (WITH THE ITS INPUT GRID LENGTH) C OVER THE ANALYSIS AREA. IT IS ASSUMED IT IS LARGE C ENOUGH TO COVER THE ANALYSIS AREA. C C WE KNOW THE SIZE OF THE ANALYSIS GRID (NXL BY NYL) C AT THE MESH LENGTH BMESH. WE CAN CALCULATE C THE SIZE OF AREA OF THE ANALYSIS GRID AT THE GRIDLENGTH EMESH C OF THE AVAILABLE GRID HIRES( , ) (NXE BY NYE), REGARDLESS OF C THE LOCATION OF THE ANALYSIS GRID WITHIN THE GRID C AVAILABLE. HOWEVER, THE LATITUDE AND LONGITUDE OF THE C (1,1) POSITION OF THE GRID HIRES( , ) IN TERMS OF THE ANALYSIS C GRID MUST BE CALCULATED. C D WRITE(KFILDO,364)ALATL,ALONL,EMESH,ORIENT,XLAT,IS2(5),IS2(6) D364 FORMAT(/' AT 364 IN GTHRES--ALATL,ALONL,EMESH,ORIENT,XLAT,', D 1 'IS2(5),IS2(6)',/,5F10.5,2I10) C IF(NPROJ.EQ.3)THEN CALL LMLLIJ(KFILDO,ALATL,ALONL,EMESH*1000.,ORIENT,XLAT, 1 REAL(IS2(5)/10000.),REAL(IS2(6)/10000.),XIE,YJE) ELSEIF(NPROJ.EQ.5)THEN CALL PSLLIJ(KFILDO,ALATL,ALONL,EMESH*1000.,ORIENT,XLAT, 1 REAL(IS2(5)/10000.),REAL(IS2(6)/10000.),XIE,YJE) ELSEIF(NPROJ.EQ.7)THEN CALL MCLLIJ(KFILDO,ALATL,ALONL,EMESH*1000.,XLAT, 1 REAL(IS2(5)/10000.),REAL(IS2(6)/10000.),XIE,YJE) ELSE WRITE(KFILDO,365)NPROJ,LD,PLAINT 365 FORMAT(/' ****MAP PROJECTION NUMBER NPROJ =',I3, 1 ' NOT 3, 5, OR 7. FATAL ERROR IN GTHRES AT 365.',/, 2 ' LOOKING FOR ',4I12,3X,A32) GO TO 600 ENDIF C C XIE AND YJE ARE THE IX AND JY GRID LOCATIONS OF THE C GRID HIRES( , ) AT THE (1,1) POINT ON THE ANALYSIS GRID AT THE C MESH LENGTH BMESH. MESH LENGTH TO LMLLIJ, PSLLIJ, AND MCLLIJ C MUST BE IN M. (REAL IS INSERTED FOR SAFETY; ACTUALLY, C DIVISION OF IS2( ) BY A FLOATING POINT NUMBER MAKES IT C FLOATING POINT FOR THE ROUTINE.) C RATIO=BMESH/EMESH C D WRITE(KFILDO,266)BMESH,EMESH,RATIO D266 FORMAT(/' AT 266--BMESH,EMESH,RATIO',3F10.5) C NXE=NINT((NXL-1)*RATIO)+1 NYE=NINT((NYL-1)*RATIO)+1 C NXE AND NYE ARE THE EXTENTS OF THE CONSTANT GRID AT C MESH LENGTH EMESH. CUTIT INSURES NXE*NYE LE ND12. NXOFF=NINT(XIE)-1 NYOFF=NINT(YJE)-1 C NXOFF AND NYOFF ARE THE OFFSETS TO PUT THE CONSTANT C GRID ON THE ANALYSIS GRID. C D WRITE(KFILDO,267)RATIO,XIE,YJE,NXE,NYE,NXOFF,NYOFF,IS2(3),IS2(4) D267 FORMAT(/' IN GTHRES AT 267--', D 1 'RATIO,XIE,YJE,NXE,NYE,NXOFF,NYOFF,IS2(3),IS2(4)', D 2 3F9.2,6i6) C CALL CUTIT(KFILDO,DATA,IS2(3),IS2(4),NXOFF,NYOFF, 1 HIRES,NXE,NYE,IER) C IS2(3) AND IS2(4) ARE THE EXTENTS OF THE GRID HIRES( , ) C BEFORE CUTTING IT TO SIZE NXE, NYE. THE MESH LENGTH OF THE C HIRES GRID IS USED AS READ, NOT MADE THE SAME AS THAT OF C THE ANALYSIS GRID. IF(IER.NE.0)GO TO 600 C IF IER NE 0, CUTIT WILL HAVE PRODUCED A DIAGNOSTIC. C C AT THIS POINT, HIRES(NXE,NYE) CONTAINS THE GRID TO RETURN C AT ITS ORIGINAL INCOMING GRID LENGTH CUT TO THE ANALYSIS C AREA. THE BELOW IS FOR POSSIBLE OUTPUT OVER THE DISPOSABLE C AREA AND DISPOSABLE MESH LENGTH MESHL. C C TDLPACK AND WRITE INPUT GRID WHEN IPRTEL NE 0 AND C KFILOG NE 0. ALSO GRIDPRINT WHEN IP22 NE 0 AND IPRTEL C NE 0. C IF(IPRTEL.NE.0.AND.(KFILOG.GT.0.OR.IP22.GT.0). 1 AND.IOPTB(1).NE.0)THEN C NOT THAT WRITING OF THE GRID WILL NOT BE DONE UNLESS C IOPTB(1) NE.0. WRITING IS TO THE SUBSETTED GRID. CALL ACTUAL(KFILDO,MESHL,XMESHL,TRASH,NPROJ,IER) C XMESHL IS THE ACTUAL MESH LENGTH OF THE DISPOSABLE C GRID. C IF(IER.NE.0)THEN WRITE(KFILDO,268)IER 268 FORMAT(/' FATAL ERROR IN ACTUAL FROM GTHRES AT 268,', 1 ' IER =',I4,'. NOT WRITING HIRES GRID.') GO TO 600 ENDIF C RATIO=XMESHL/EMESH C D WRITE(KFILDO,270)XMESHL,EMESH,RATIO D270 FORMAT(/' AT 270--XMESHL,EMESH,RATIO',3F10.5) C C RATIO RELATES THE INCOMING MESH LENGTH EMESH TO THE C SUBSET AREA GRID LENGTH XMESHL. C IF(IP22.NE.0)THEN C RATIO IS THE RATIO OF THE GRIDLENGTH REPRESENTED BY C IOPTB( ) TO THE INPUT GRID LENGTH. SET JOPT( ) TO C APPLY TO THE INPUT GRID LENGTH. JOPT(1)=IOPTB(1) JOPT(2)=NINT((IOPTB(2)-1)*RATIO)+1 JOPT(3)=NINT((IOPTB(3)-1)*RATIO)+1 JOPT(4)=NINT((IOPTB(4)-1)*RATIO)+1 JOPT(5)=NINT((IOPTB(5)-1)*RATIO)+1 JOPT(6)=IOPTB(6) JOPT(7)=IOPTB(7) JOPT(8)=IOPTB(8) TITLT(1:40)=PLAINT(1:32) TITLT(33:40)=' ' C C SET CONTOUR INTERVAL FOR TERRAIN HEIGHT, LAND/SEA MASK, C OR DEFAULT. C IF(LD(1)/1000000.EQ.409)THEN CONINT=200 START=.5 ELSEIF(LD(1)/1000000.EQ.400)THEN CONINT=100 START=.5 ELSE CONINT=100. START=0. ENDIF C CALL PRTGR(IP22,HIRES,NXE,NYE, 1 CONINT,START,1.,0.,JOPT,TITLT,IER) IF(IER.NE.0)ISTOP=ISTOP+1 C ERROR GRIDPRINTING NOT COUNTED AS FATAL. ENDIF C IF(KFILOG.NE.0)THEN C C THE GRID IS ON THE ANALYSIS AREA AT ITS ORIGINAL MESH LENGTH. C PRTGR ABOVE WILL PRINT A SUBSET OF THIS GRID, THE SUBSET C AREA. THE OUTPUT TO KFILOG IS FOR THIS SAME SUBSET AREA, C BUT MUST BE CUT TO THAT AREA BEFORE PACKING AND WRITING. C LD(1)=LD(1)+MODNO C THIS ASSUMES THE CONSTANT GRID IS ON THE RANDOM ACCESS C FILE WITHOUT A MODEL NUMBER. NOTE THAT THIS MODIFIES C THE INPUT LD( ). ITAUH=0 ITAUM=0 NSEQ=0 ISCAL=0 NCHAR=32 XMISSP=0 XMISSS=0 C THESE ARE CONSTANTS AND NO MISSING VALUES ARE C PROVIDED FOR. IF THERE EVER ARE, JUST SET XMISSP=9999, C OR WHATEVER THE MISSING VALUE IS. C C SET UP DYNAMIC STORAGE FOR WORK ARRAY NDX( ). NORMALLY, C RATIO WILL BE 1, AND NSIZ = NXE*NYE. HOWEVER, IF RATIO > 1, C A LARGER AREA WILL BE NEEDED. C RATIO=EMESH/XMESHL NSIZ=(NINT((NXE-1)*RATIO)+1.)*(NINT((NYE-1)*RATIO)+1.) NSIZ=MAX(NXE*NYE,NSIZ,ND5) C ALLOCATE(FDX(NSIZ),STAT=IOS) C IF(IOS.NE.0)THEN IER=IOS WRITE(KFILDO,380)IOS,LD,PLAINT 380 FORMAT(/' ****UNABLE TO ALLOCATE FDX( ) IN GTHRES,', 1 ' IOS=',I4,'. WILL NOT BE ABLE WRITE INPUT',/, 2 ' GRID ',4I12,3X,A32,' TO KFILOG.', 3 ' PROCEEDING.') ISTOP=ISTOP+1 GO TO 700 C THIS IS A NOT A FATAL ERROR, BUT FDX IS NOT AVAILABLE C SO BYPASS THE BELOW. ENDIF C C TRANSFER INPUT GRID INTO FDX( ). HIRES( ) IS INTACT. C CALL TRNSFR(HIRES,FDX,NXE*NYE) NXG=NXE NYG=NYE MESHG=MESHE C NXG, NYG, AND MESHG ARE NECESSARY BECAUSE SZGRID CHANGES C THEM, AND NXE, NYE, AND MESHE MUST BE RETAINED. CALL SZGRID(KFILDO,FDX,NXG,NYG,MESHG,MESHL,1,NSIZ) C "1" IS USED IN THE CALL (WHICH WOULD CONFORM TO LINEAR). C THAT IS, THE HIGH RESOLUTION GRID WILL USUALLY NOT BE C INTERPOLATED, BUT MIGHT BE SAMPLED TO A LARGER MESH LENGTH C FOR OUTPUT. C C NOTE: IT IS ASSUMED THE HIGH RESOLUTION GRID WILL NOT C CONTAIN MISSING (9999) VALUES, SO SZGRID IS CALLED. C IF IT DOES CONTAIN MISSINGS, THEN JUST CALL SZGRDM C INSTEAD OF SZGRID. C RATIO=BMESH/XMESHL C THE GRID IN FDX IS AT MESHL LENGTH MESHL = XMESHL. C IOPTB( ) IS IN TERMS OF MESH LENGTH MESHB = BEMSH. C HAVE TO CONVERT THE SIZE. NXD=NINT((IOPTB(3)-IOPTB(2))*RATIO)+1 NYD=NINT((IOPTB(5)-IOPTB(4))*RATIO)+1 C NXD AND NYD ARE THE CUT (DISPOSABLE) GRID DIMENSIONS. C D WRITE(KFILDO,390)(IOPTB(I),I=1,8),NXE,NYE,NXD,NYD,RATIO D390 FORMAT(/' IN GTHRES AT 390--','IOPTB,NXE,NYE,NXD,NYD,RATIO'/ D 1 ' ',12I8,F10.3) C IF(IOPTB(2)-1.NE.0.OR.IOPTB(4)-1.NE.0.OR.NXE.NE.NXD. 1 OR.NYE.NE.NYD)THEN CALL CUTIT(KFILDO,FDX,NXG,NYG,IOPTB(2)-1,IOPTB(4)-1, 1 FDX,NXD,NYD,IER) C NOTE THAT THIS CUTIT TAKES THE GRID FROM THE ANALYSIS C AREA TO THE SUBSET AREA. THE PREVIOUS CALL TO CUTIT C TOOK THE GRID FROM THE INCOMING AREA TO THE ANALYSIS C AREA. THERE IS NO NEED TO CALL CUTIT IF THE INPUT C AND OUTPUT GRIDS ARE THE SAME. THE GRID IS WRITTEN C AT MESH LENGTH MESHL. ENDIF C IF(IER.NE.0)GO TO 600 C IF IER NE 0, CUTIT WILL HAVE PRODUCED A DIAGNOSTIC. C C MUST COMPUTE LAT/LON OF LL CORNER POINT. C LLXPOS=NINT((IOPTB(2)-1)*RATIO)+1 LLYPOS=NINT((IOPTB(4)-1)*RATIO)+1 C RATIO=BMESH/XMESHL C D WRITE(KFILDO,391)BMESH,XMESHL,RATIO, D 1 IOPTB(2),IOPTB(4),LLXPOS,LLYPOS D391 FORMAT(/' AT 391 IN GTHRES--BMESH,XMESHL,RATIO,', D 1 'IOPTB(2),IOPTB(4),LLXPOS,LLYPOS',3F6.2,4I6) C IF(NPROJ.EQ.3)THEN CALL LMIJLL(KFILDO,REAL(LLXPOS),REAL(LLYPOS), 1 XMESHL*1000.,ORIENT,XLAT, 2 ALATL,ALONL,ALATD,ALOND,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,392)IER,LD,PLAINT 392 FORMAT(/' FATAL ERROR IN LMIJLL FROM GTHRES,', 1 ' IER =',I4,' FOR GRID ',4I12,3X,A32) GO TO 600 ENDIF C ELSEIF(NPROJ.EQ.5)THEN CALL PSIJLL(KFILDO,REAL(LLXPOS),REAL(LLYPOS), 1 XMESHL*1000.,ORIENT,XLAT, 2 ALATL,ALONL,ALATD,ALOND) ELSEIF(NPROJ.EQ.7)THEN CALL MCIJLL(KFILDO,REAL(LLXPOS),REAL(LLYPOS), 1 XMESHL*1000.,XLAT, 2 ALATL,ALONL,ALATD,ALOND) ELSE WRITE(KFILDO,395)NPROJ,LD,PLAINT 395 FORMAT(/' ****MAP PROJECTION NUMBER NPROJ NOT', 1 ' 3, 5, OR 7 FOR GRID ',4I12,3X,A32,/, 2 ' FATAL ERROR IN GTHRES AT 395.') GO TO 600 ENDIF C D WRITE(KFILDO,397)ALATL,ALONL,ALATD,ALOND,XMESHL,XLAT D397 FORMAT(/' AT 397 IN GTHRES--ALATL,ALONL,', D 1 'ALATD,ALOND,XMESHL,XLAT--',6F8.4) C C ALATD AND ALOND ARE THE LL LAT/LON GRID POSITION. C TRUNCATE TO THREE DECIMAL PLACES TO ASSURE C COMPATIBILITY WITH AVN ARCHIVE FOR U203 AND GEMPAK. C ALATD=NINT(ALATD*1000.)/1000. ALOND=NINT(ALOND*1000.)/1000. CALL PAWGTS(KFILDO,KFILOG,'KFILOG',IP16,NDATE, 1 LD,ITAUH,ITAUM,MODNO,NSEQ,ISCAL, 2 NPROJ,ALATD,ALOND,ORIENT,MESHL,XLAT,NXD,NYD, 3 FDX,DATA,IWORK,IPACK,ND5,MINPK, 4 IS0,IS1,IS2,IS4,ND7, 5 IPLANT,PLAINT,NCHAR, 6 XMISSP,XMISSS,LX,IOCTET, 7 JTOTBY,JTOTRC,L3264B,L3264W,IER) IF(IER.NE.0)ISTOP=ISTOP+1 C ERROR WRITING DISPOSABLE GRIDS NOT COUNTED AS FATAL. DEALLOCATE(FDX,STAT=IOS) C D WRITE(KFILDO,500)ALATL,ALONL,ALATD,ALOND D500 FORMAT(/' AT 500 IN GTHRES--ALATL,ALONL,ALATD,ALOND',4F10.4) ENDIF C ENDIF C IER=0 C IER = 0 FOR NON FATAL ERROR. NON FATAL ERRORS COULD HAVE C BEEN CREATED IN PAWOTG AND PRTGR; IN THAT CASE, A DIAGNOSTIC C WILL HAVE BEEN CREATED AND ISTOP INCREMENTED. GO TO 700 C C FOR THIS DEVELOPMENTAL PROGRAM, IF U452 CANNOT COMPLETE C IT IS INDICATED BY IER = 777. 600 IER=777 ISTOP=ISTOP+1 C C AT THIS POINT THE UNSMOOTHED CONSTANT VALUES ARE IN C HIRES( ) AT THE INCOMING UNITS. 700 CONTINUE C D CALL TIMPR(KFILDO,KFILDO,'END GTHRES ') C RETURN END