SUBROUTINE SPOTRM(KFILDO,KFILOG,IP16,NAREA, 1 CCALL,XP,YP,LNDSEA,NOPTN,LTAG,LTAGPT, 2 STALAT,STALON,NSTA, 3 ID,IDPARS,P,HOLD,MESH,NX,NY, 4 TELEV,SEALND,CPNDFD,NXE,NYE,MESHE, 5 IPACK,DATA,IWORK,ND5, 6 MODNO,NDATE,NCLIP, 7 ALATL,ALONL,NPROJ,ORIENT,XLAT,ISCALD, 8 DIFFA,NOCEAN,LAKE,DISTX,DPOWER,RAY,RMAX, 9 LH, A IS0,IS1,IS2,IS4,ND7, B JTOTBY,JTOTRC,PLAINT,IPLANT, C L3264B,L3264W,MINPK,ISTOP,IER) C C MARCH 2010 GLAHN MDL MOS-2000 C NEW ON-THE-FLY VERSION C APRIL 2010 GLAHN ADDED LTAGPT( ) AND CHECK FOR DATA C APRIL 2010 GLAHN CHANGED WHERE DIST( , ) IS SET LARGE C MAY 2010 GLAHN ADDED 3 CLOSEST STATIONS C MAY 2010 GLAHN IMPLEMENTED SQUEZE AS COMBINATION C OF IOCEXT AND WT( , ) C MAY 2010 GLAHN REMOVED GO TO'S THAT HAMPERED C PARALLELIZATION; TESTED NSQEQ C EARLIER AT 100; SPELL CHECK; IPRTEL C CHANGED FROM 1 TO ZERO C JULY 2010 SCALLION/GLAHN INSERTED OPEN MP C OCTOBER 2010 GLAHN ADDED TEST ON DPOWER LT .001 C FEBRUARY 2011 GLAHN SPELLING CHECK C MARCH 2011 GLAHN OPTIMIZATION CHANGES; STRIPPED C SQUEZE = 1,2 OPTIONS; LOCATED ONLY C ONE NEIGHBOR; ELIMINATED NDQEQ C MARCH 2011 GLAHN IOCEXT STATEMENT = MODIFIED; ADDED C SQUARE C MARCH 2011 GLAHN MODIFIED DO 200 LOOP; ADDED LAKE; c MODIFIED DO 280 C JUNE 2011 GLAHN CORRECTED ERROR, LAND TO LAKE BELOW C 146 TO 'IF(NOCEAN.EQ.2.AND.LAKE.EQ.2)' C (THIS ERROR IS NOT IN OPERATIONAL) C JUNE 2011 GLAHN CCALL(8) CHANGED TO CCALL(NSTA) C JUNE 2011 GLAHN REMOVED PERIOD FROM IF(LTAGPT(K).NE.0. C BELOW 143 C JUNE 2011 GLAHN OPTIMIZE FOR POWER 6: C DISABLED SQUARE C DEFINED NDFD( , ) = CPNDFD( , ) C DEFINED LWMASK( , ) = SEALND( , ) C DEFINED ITELEV( , ) = TELEV( , ) C DEFINED IDIFFA = DIFFA C ELIMINATED OCEXTS C SOME NON FATAL ERRORS SET TO 666 C JUNE 2011 GLAHN CHANGED SQUARE IN SPOTRM TO DISTX C JUNE 2011 GLAHN OCEXTS OUT OF PRIVATE C JULY 2011 GLAHN MODIFIED NOCEAN AND LAKE CHECKS C (NOTED IN CODE AS CHANGES ON 7/18/11) C JULY 2011 GLAHN MODIFIED LAKE AND LAKE/LAND STATION C CHECKS C JULY 2011 GLAHN REMOVED OPEN MP AROUND DO 250 LOOP C AUGUST 2011 GLAHN ADDED NOPTN AND LTAG( ) TO CALL C AUGUST 2011 GLAHN ADDED CODE AT 150 TO NOT SMOOTH C ANY GRIDPOINT BRACKETING THE STATION C SEPTEMBER 2011 GLAHN CHANGED ALGORITHM IN DO 269 LOOP; C INSERTED CHECK ON RANGE OF DPOWER C JANUARY 2012 GLAHN CHANGED DEFINITION OF DISTX C JANUARY 2012 IM CHANGED DEFINITION OF IOCEXT ACCORDING C TO DISTX CHANGE C FEBRUARY 2012 GLAHN/IM CORRECTED DO 280 LOOP C JULY 2012 GLAHN CHANGE IN DO 258 LOOP FROM C DIST(IX,JY)=9999. TO DIST(IX,JY)=MDIST C SEPTEMBER 2013 GLAHN CORRECTED A COUPLE OF COMMENTS C NOVEMBER 2013 GLAHN REMOVED DYNAMIC SCHEDULING FOR OPM; C REARRANGED SOME IF TESTS IN DO 250 C NOVEMBER 2013 GLAHN MOVED ONE IF TEST IN DO 200 C JANUARY 2014 GLAHN ADDED TABLE( , , ) AND ABILITY TO USE C IT C JANUARY 2014 GLAHN ADDED STALAT( ), STALON( ), AND NAREA C TO CALL; USED LATITUDE TO ADJUST SEARCH C RADII WHEN NAREA=1 C FEBRUARY 2014 IM/GLAHN USED LATITUDE AND LONGITUDE TO ADJUST C SEARCH RADII C FEBRUARY 2014 GLAHN MDIST CHANGED FROM *2 TO *3.5 FOR C CANADA BELOW 143; COMMENTS C MARCH 2014 GLAHN 3.5 DIDN'T IMPROVE, CHANGED BACK TO 2 C JUNE 2014 GLAHN CHANGED IER=666 TO IER=777 IN 2 PLACES C JUNE 2014 GLAHN ADDED CAPABILITY TO PARTIALLY SMOOTH C OUT AUGMENTED POINTS C JUNE 2014 GLAHN MADE SMOOTHING A FUNCTION OF ELEMENT; C ADDED JTABLE( , ),Q( , ) AND QPROJ C JULY 2014 GLAHN REVISED USE OF QPROJ C AUGUST 2014 IM/GLAHN REVISED Q FOR WIND AND GUST C AFTER CHECKING WITH VERIFICATION C GRIDS C NOVEMBER 2014 GLAHN JTABLE( , ) AND Q( , ) ARE NOT C CURRENTLY USED AND QPROJ ALWAYS = 1 C JANUARY 2015 GLAHN ADDED LAMP=5 AND NOCEAN=5 CAPABILITY C FEBRUARY 2015 GLAHN ADDED VISIBILITY PROBABILITY TO C JTABLE( , ); CORRECTED FORMAT 1007; C ELIMINATED CHECKING ID(4) WITH C JTABLE( , ) C FEBRUARY 2015 GLAHN SET MDIST WHEN NAREA NE 1 C FEBRUARY 2015 GLAHN INCLUDED FULL DEFINITION FOR NOCEAN C AND LAKE; SPELL CHECK C APRIL 2015 GLAHN REMOVED JTABLE( , ), Q( , ), C DISTA( , ), QPROJ, IDCAT C MAY 2015 GHIRARDELLI, GLAHN MADE THE VARIABLES C "IOCSQ,RAYT,DIFFAT,DIFF,RA,IDIFFA" C PRIVATE IN OMP LOOP C MAY 2015 GLAHN REMOVED A REPEAT CAPABILITY WHEN C ID( ) AND NDATE MATCHES C MAY 2015 GLAHN DEFINED RAYT AND IDIFFA INSIDE C MAY 2015 GHIRARDELLI MODIFIED OMP DIRECTIVES TO MAKE C IOCSQ,DIFF,RA TO BE PRIVATE, AND TO C MAKE RAYT,DIFFAT,IDIFFA FIRSTPRIVATE C OMP LOOP C JULY 2015 GLAHN CHANGED LINE 5 IN TABLE( , ) C SEPTEMBER 2015 IM/GLAHN CHANGED C IF(LAKE.EQ.3.OR.LAKE.EQ.5.OR.LAKE.EQ.1) C TO IF(LAKE.GE.3) BELOW 146 C SEPTEMBER 2016 GLAHN CHANGED ND5 TO NX*NY IN CALL TO PAWGTS C OCTOBER 2016 GLAHN ADDED NCLIP TO CALL, ADDED NCLIP TO C TEST TO NOT SMOOTH OUTSIDE CLIP AREA; C ADDED TEST ON WT( , ) GT.0.999 TO C NOT SMOOTH THE 4 POINTS AROUND A C STATION C NOVEMBER 2018 GLAHN CHECK TO BYPASS SMOOTHING FOR BOGUS C OVER WATER AND NOPTNT( ) = 4; CHECK C TO BYPASS WATER AND SIBERIA CORRECTION C FOR ALASKA AREA BELOW 274 C FEBRUARY 2019 GLAHN REMOVED TABLE( , ) AND RELATED CODE; C NOPTN DOES NOT HAVE DUAL ROLE C APRIL 2019 GLAHN MOD TO KEEP PEAKS HIgH AND VALLEYS C LOW FOR CIG PROBS; LH=1 ACTIVATES. C LH ADDED TO CALL C APRIL 2019 GLAHN LH=2 DOES THE OPPOSITE OF LH=1 C C PURPOSE C TO SMOOTH POINTS ON A GRID OVER A CIRCLE. THE CIRCLE WILL C BE OF DIAMETER IOCEXT = RAY*DISTANCE TO NEAREST STATION. C IF THE ELEVATION DIFFERENCE BETWEEN A POINT AND THE POINT C BEING SMOOTHED IS GT DIFFA METERS, THE POINT IS NOT C INCLUDED IN THE SMOOTHING. P(NX,JY), TELEV(NXE,NYE), C AND SEALND(NXE,NYE) MUST COVER THE SAME AREA AND BE OF C THE SAME MESH LENGTH. THE GRID SIZES AND MESH LENGTHS C ARE CHECKED. A MISSING POINT IS KEPT AS MISSING. C C SEVERAL INTEGER ARRAYS AND VARIABLES ARE DEFINED FROM C THEIR CORRESPONDING FP ARRAYS AND VARIABLES. THIS WAS DONE C FOR EFFICIENCY ON THE POWER 6, BUT ALSO IMPROVED CP C TIME BY ABOUT 20% ON THE POWER 5. C C JTABLE( , ) AND ASSOCIATED CODE WAS ADDED TO DIFFERENTIATE C SMOOTHING OF BASE DATA FROM OTHER TYPES (E.G., BOGUS) C BUT DID NOT PROVE USEFUL, SO CAPABILITY WAS REMOVED C APRIL 2015 C C PREVIOUS TO MAY 24, 2015, SEVERAL VARIABLES AND ARRAYS C WERE SAVED AND DID NOT HAVE TO BE RECOMPUTED WHEN ID( ) C AND NDATE MATCHED. THIS CAPABILITY WOULD BE USED ONLY C IF SPOTRM WERE ACCESSED TWICE OR MORE FOR THE SAME C VARIABLE. THIS IS NOT DONE, PARTLY BECAUSE OF THE LONG C SPOTRM RUN TIME. THE CODING IS PROBLEMATIC, SO THE C REPEAT CAPABILITY HAS BEEN REMOVED. C C OPEN MP ISTOP AND IER ARE NOT DECLARED PRIVATE IN OPEN MP. C IER IS ONLY SET = 777 AND ANY OPEN MP LOOP SHOULD DO c THAT. C ISTOP COULD BE CONFLICTED, BUT IT WOULD JUST MAKE THE C ERROR COUNT LESS THAN IT SHOULD BE; THIS SHOULD NOT C HAPPEN OR BE VERY RARE. C SCHEDULING--11/2/13 DEFAULT SEEMS BEST, AND BETTER THAN C NO OPEN MP C C DATA SET USE C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) C KFILOG - UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. (OUTPUT) C KFILRA(J) - HOLDS THE UNIT NUMBERS FOR ACCESSING THE C MOS-2000 EXTERNAL RANDOM ACCESS FILES (J=1,6). C (INPUT) C IP16 - UNIT NUMBER FOR INDICATING WHEN A RECORD IS C WRITTEN TO THE SEQUENTIAL FILE. (OUTPUT) C C VARIABLES C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) C KFILOG = UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. THIS IS FOR DIFFERENT PASSES OF THE C ANALYSES AND THEIR SMOOTHINGS. USED HERE C FOR DISTANCE MAP. (INPUT) C IP16 = INDICATES WHETHER (>0) OR NOT (=0) C A STATEMENT WILL BE OUTPUT TO IP(16) C WHEN A SEQUENTIAL FILE IS WRITTEN THROUGH C PAWGTS. (INPUT)) C NAREA = THE AREA OVER WHICH THE ANALYSIS IS MADE: C 1 = CONUS, C 2 = ALASKA, C 3 = HAWAII, C 4 = PUERTO. C CCALL(J) = STATION CALL LETTERS (J=1,NSTA). (CHARACTER*8) C (INPUT) C XP(K) = THE X POSITION FOR STATION K (K=1,NSTA) ON C THE ANALYSIS GRID AREA AT THE CURRENT GRID MESH C LENGTH MESH. (INPUT) C YP(K) = THE Y POSITION FOR STATION K (K=1,NSTA) ON C THE ANALYSIS GRID AREA AT THE CURRENT GRID MESH C LENGTH MESH. (INPUT) C LNDSEA(K) = LAND/SEA INFLUENCE FLAG FOR EACH STATION C (K=1,NSTA). C 0 = WILL BE USED FOR ONLY OCEAN WATER (=0) C GRIDPOINTS. C 3 = WILL BE USED FOR ONLY INLAND WATER (=3) C GRIDPOINTS. C 6 = WILL BE USED FOR BOTH INLAND WATER (=3) C AND LAND (=9) GRIDPOINTS. C 9 = WILL BE USED FOR ONLY LAND (=9) GRIDPOINTS. C (INPUT) C NOPTN = INDICATES OPTION FOR WHICH DATA TO SMOOTH OUT. C COMES FROM U405A.CN IN CALL TO SPOTRM CONST( ). C 1 = SMOOTH OUT BOGUS ONLY C 2 = SMOOTH OUT BOGUS AND 2ND LEVE AUGMENTATION. C 3 = SMOOTH OUT BOGUS AND ALL AUGMENTATION C 4 = KEEP ALL. C LEFT 2 DIGITS INDICATE WHETHER TO INSURE THE C LOW ELEVATIONS HAVE LOW VALUES AND VICE VERSA. C USED FOR PROBS. C (INPUT) C LTAG(K) = DENOTES USE OF DATA CORRESPONDING TO CCALL(K). C +4 = TOSSED IN A PREVIOUS OBS RUN AND C MAINTAINED DOWNSTREAM. C +2 = STATION LOCATION UNKNOWN. NOT USED FOR ANY C PURPOSE. C +1 = STATION OUTSIDE RADIUS OF INFLUENCE FOR C AREA BEING ANALYZED OR MISSING DATUM. C PERMANENTLY DISCARDED. C 0 = USE ON CURRENT PASS THROUGH DATA IN BCD5. C -1 = ON RETURN FROM BCD5, THE DATUM WAS NOT C USED ON THE LAST PASS. C -3 = ACCEPT THIS STATION ON EVERY PASS IN BCD5. C (NOT IMPLEMENTED IN U405A) C (INTERNAL) C LTAGPT(K) = FOR STATION K (K=1NSTA), C 1 = AUGMENTED DATA (FIRST PASS) C 2 = AUGMENTED DATA (2ND PASS) C 3 = BOGUS DATA C 4 = BOGUS DATA FROM BOGUSG C 0 = EVERYTHING ELSE C (INPUT) C STALAT(K) = LATITUDE OF STATIONS (K=1,NSTA). (INPUT) C STALON(K) = LONGITUDE OF STATIONS (K=1,NSTA). (INPUT) C NSTA = NUMBER OF STATIONS IN CCALL( ). (INPUT) C ID(J) = 4 WORD ID OF VARIABLE BEING ANALYZED. (INPUT) C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE C PREDICTOR ID'S CORRESPONDING TO ID( ,N) C (J=1,15), (N=1,ND4). 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 C 1 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 (INPUT) C P(IX,JY) = HOLDS A FIELD TO BE SMOOTHED (INPUT) AND C THE SMOOTHED GRID (OUTPUT) (IX=1,NX) C (JY=1,NY). (INPUT/OUTPUT) C HOLD(IX,JY) = SCRATCH ARRAY USED IN COMPUTING THE SMOOTHED C FIELD (IX=1,NX) (JY=1,NY). (INTERNAL) C MESH = NOMINAL MESH LENGTH OF GRID IN P( , ). C (INPUT) C NX = SIZE OF P( , ) IN X DIRECTION. (INPUT) C NY = SIZE OF P( , ) IN Y DIRECTION. (INPUT) C TELEV(IX,JY) = THE TERRAIN ELEVATION (IX=1,NX) (JY=1,NY) AT C NOMINAL MESHLENGTH MESHE. (INPUT) C SEALND(IX,JY) = THE LAND/SEA MASK (IX=1,NX) (JY=1,NY). C 0 = OCEAN WATER GRIDPOINTS; C 3 = INLAND WATER GRIDPOINTS. C 9 = LAND GRIDPOINTS. C (INPUT) C CPNDFD(IX,JY) = THE NDFD MASK (IX=1,NXE) (JY=1,NYE) AT C NOMINAL MESHLENGTH MESHE. A "1" MEANS THE C GRIDPOINT IS WITHIN THE AREA; A "0" MEANS IT C IS OUTSIDE THE AREA. (INPUT) C NXE = X-EXTENT OF TELEV( , ), SEALND( , ), AND C CPNDFD( , ) AT MESH LENGTH MESHE. (INPUT) C NYE = Y-EXTENT OF TELEV( , ), SEALND( , ), AND C CPNDFD( , ) AT MESH LENGTH MESHE. (INPUT) C MESHE = NOMINAL MESH LENGTH OF GRID IN SEALND( , ), C TELEV( , ), AND CPNDFD( , ). (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 = DATE/TIME, YYYYMMDDHH. THIS IS THE ANALYSIS C RUN TIME, INCLUDING HH. (INPUT) C NCLIP = 1 TO CLIP TO NDFD MASK; 0 OTHERWISE. ALSO, C IN SPOTRM HELPS CONTROL SMOOTHING. (INPUT) C ALATL = NORTH LATITUDE OF LOWER LEFT CORNER POINT C OF A GRID OF THE SIZE NXL, NYL. TRUNCATED C TO TEN THOUSANDTHS OF DEGREES. NOTE THAT THE C MOS-2000 ARCHIVE IS ONLY TO THOUSANDTHS OF C DEGREES. (INPUT) C ALONL = WEST LONGITUDE OF LOWER LEFT CORNER POINT C OF A GRID OF THE SIZE NXL, NYL. TRUNCATED C TO TEN THOUSANDTHS OF DEGREES. NOTE THAT THE C MOS-2000 ARCHIVE IS ONLY TO THOUSANDTHS OF C DEGREES. (INPUT) C NPROJ = NUMBER OF 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 ISCALD = DECIMAL SCALING FOR TDLPACKING. (INPUT) C DIFFA = THE MAXIMUM DIFFERENCE IN ELEVATION IN METERS C BETWEEN THE GRIDPOINT BEING SMOOTHED AND THE C GRIDPOINT USED IN SMOOTHING. (INPUT) C NOCEAN = TAKES ONE OF 5 VALUES DEPENDING ON HOW THE C OCEAN TYPE OF STATION AFFECTS THE TYPE OF C GRIDPOINT. C 1 = SMOOTH OVER OCEAN, BUT OCEAN GRIDPOINTS C DO NOT CONTRIBUTE TO OCEAN OR LAND C SMOOTHING. C 2 = NO SMOOTHING OVER OCEAN, AND OCEAN C GRIDPOINTS DO NOT CONTRIBUTE TO LAND C SMOOTHING. C 3 = SMOOTH OVER OCEAN AND LAND TOGETHER, AND C OCEAN GRIDPOINTS CONTRIBUTE TO THE SMOOTHING C 4 = SMOOTH OVER THE OCEAN AND OCEAN GRIDPOINTS C CONTRIBUTE TO THE SMOOTHING, BUT OCEAN AND C LAND ARE SMOOTHED SEPARATELY. C 5 = SMOOTH OVER OCEAN AND LAND; OCEAN AND LAND C GRIDPOINTS CONTRIBUTE TO OCEAN SMOOTHING, C BUT ONLY LAND GRIDPOINTS CONTRIBUTE TO LAND C SMOOTHING. C (INPUT) C LAKE = TAKES ONE OF 5 VALUES DEPENDING ON HOW THE C LAKE TYPE OF STATION AFFECTS THE TYPE OF C GRIDPOINT. (THE NUMBERS FOR LAKE MEAN THE SAME C FOR LAKE AS NOCEAN MEAN FOR OCEAN (SEE ABOVE). C DISTX = VALUE TO MULTIPLY BY RMAX IN SPOTRM = R(1) C IN U405A.CN TO SEARCH FOR CLOSEST STATION. C FOR OCEAN, LAKE, AND LAKE/LAND STATIONS OR C CANADA: MDIST=DISTX*RMAX*2; C OTHERWISE: MDIST=MIN(DISTX,2.)*RMAX, C WHERE MDIST = THE DISTANCE FOR SEARCHING FOR C A STATION. ALSO, FOR ANY STATION NOT LAND: C IOCEXT=MIN(DIST(IX,JY),RMAX*DISTX)*RAYT+1.,AND C IOCEXT=MIN(DIST(IX,JY),RMAX*MIN(DISTX,2.))*RAYT+1. C OTHERWISE, WHERE IOCEXT IS THE SMOOTHING RADIUS C (INPUT) C DPOWER = THE POWER OF THE DISTANCE TO USE IN WEIGHTING. C WT(IX,JY)=1/DIST(IX,JY)**POWER. SHOULD BE C EITHER ZERO OR GE 1. (INPUT) C RAY = THE MULTIPLIER OF THE DISTANCE TO THE CLOSEST C STATION TO USE AS THE RADIUS OF THE SMOOTHING C CIRCLE (OR MAJOR AXIS OF ELLIPSE). (INPUT) C RMAX = MAXIMUM RADIUS OF CIRCLE, TAKEN FROM THE C CONSTANT RADIUS OF THE FIRST PASS R(1). THIS C ELIMINATES EXCESSIVE COMPUTATIONS OUTSIDE C AREAS OF DATA. (INPUT) C LH = SWITCH (=1) TO ASSURE LOW VALUES ARE IN C VALLEYS AND HIGH VALUES ARE IN HIGH ELEVATIONS C (E.G. FOR PROB OF CIG OR VIS CATEGORY). C WHEN LH = 2, THE OPPOSITE IS TRUE (E.G., FOR C CIG AND VIS SPECIFIC VALUES) C (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 TO FURNISH TO C GTHRES. EQUIVALENCED TO IPLANT IN CALLING C ROUTINE. (INPUT) C IPLANT(I,J) = EQUIVALENCED TO PLAINT IN CALLING ROUTINE C (I=1,L3264W) (J=1,4). (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 = INCREMENTED BY 1 IF THERE IS AN ERROR. C (INPUT/OUTPUT) C IER = RETURN CODE. C 0 = GOOD RETURN. C 666 = NON FATAL ERROR, INDICATES THE WRITING C OF THE GRID TO THE DISPOSABLE FILE HAS C NOT BEEN DONE. C 777 = ANY FATAL ERROR IS RETURNED WITH A 777. C BCD5 WILL TREAT IT THAT WAY. ANY OTHER C VALUE IS IGNORED. C (OUTPUT) C DIST(IX,JY) = THE FIELD OF DISTANCES TO THE NEAREST C STATION (IX=1,NX) (JY=1,NY). C (INTERNAL) (ALLOCATABLE) C WT(IX,JY) = WEIGHTS FOR SMOOTHING (IX=1,NX) (JY=1,NY). C (INTERNAL) (ALLOCATABLE) C IOCEXT = THE NUMBER OF GRIDPOINTS PLUS AND MINUS C OF THE POINT P(IX,JY) TO SMOOTH. IT IS C A FUNCTION OF RAY*DIST(IX,JY). (INTERNAL) C ITABLE(J,L) = CORRESPONDENCE BETWEEN NOMINAL MESH LENGTH C (L=1) AND VALUE FOR X IN 408CX0000 (L=2), C (J=1,7). C IPRTEL = 1 TO WRITE THE RETRIEVED DISTANCE GRID TO THE C OUTPUT FILE VIA GTHRES. (INTERNAL) C NXSAVE, NYSAVE = SAVED VALUES OF NX AND NY TO MAKE SURE THE C ALLOCATED ARRAYS ARE OF CORRECT SIZE. C (INTERNAL) C IFIRST = CONTROLS THE ALLOCATION OF ARRAYS. (INTERNAL) C JFIRST = CONTROLS THE WRITING OF THE DISTANCE GRID. IT C IS WRITTEN ONLY ONCE. (INTERNAL) C LFIRST = CONTROLS WRITING OF DIAGNOSTIC ABOUT USE OF C SOSPT AT 260. (INTERNAL) C ODIST = DISTANCE IN GRID UNITS OUTSIDE THE GRID A C STATION IS USED FOR THIS PURPOSE. SET BY C DATA STATEMENT TO 1. (INTERNAL) C NDFD(IX,JY) = THE NDFD MASK (IX=1,NXE) (JY=1,NYE) AT C NOMINAL MESHLENGTH MESHE. A "1" MEANS THE C GRIDPOINT IS WITHIN THE AREA; A "0" MEANS IT C IS OUTSIDE THE AREA. INITIALIZED AS INTEGERS C FROM CPNDFD( , ). (ALLOCATABLE) (INTERNAL) C LWMASK(IX,JY) = THE LAND/SEA MASK (IX=1,NX) (JY=1,NY). C 0 = OCEAN WATER GRIDPOINTS; C 3 = INLAND WATER GRIDPOINTS. C 9 = LAND GRIDPOINTS. C INITIALIZED AS INTEGERS FROM SEALND( , ). C (ALLOCATABLE) (INTERNAL) C ITELEV(IX,JY) = THE TERRAIN ELEVATION (IX=1,NX) (JY=1,NY) AT C NOMINAL MESHLENGTH MESHE. INITIALIZED AS C INTEGERS FROM TELEV( , ). (ALLOCATABLE) C (INTERNAL) C IDIFFA = THE MAXIMUM DIFFERENCE IN ELEVATION IN METERS C BETWEEN THE GRIDPOINT BEING SMOOTHED AND THE C GRIDPOINT USED IN SMOOTHING. DEFINED AS C INTEGER FROM DIFFA. (INTERNAL) C DPOWERT = TEMPORARY VALUE OF DPOWER. (INTERNAL) C DIFFAT = TEMPORARY VALUE OF DIFFA. (INTERNAL) C RAYT = TEMPORARY VALUE OF RAY. (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES CALLED C PAWGTS, TIMPR C CHARACTER*6 RACESS(6) CHARACTER*8 CCALL(NSTA) CHARACTER*32 PLAINT C DIMENSION ID(4),LD(4),IDPARS(15) DIMENSION XP(NSTA),YP(NSTA),LNDSEA(NSTA),LTAG(NSTA),LTAGPT(NSTA), 1 STALAT(NSTA),STALON(NSTA) DIMENSION P(NX,NY),HOLD(NX,NY) DIMENSION TELEV(NXE,NYE),SEALND(NXE,NYE),CPNDFD(NXE,NYE) DIMENSION IPLANT(L3264W,4) C EQUIVALENCED TO PLAINT IN DRIVER. DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION ITABLE(7,2),IDSAVE(4) C ALLOCATABLE WT(:,:),DIST(:,:),NDFD(:,:),LWMASK(:,:),ITELEV(:,:), 1 VALUE(:,:) SAVE WT,DIST,NDFD,LWMASK,ITELEV,VALUE SAVE NXSAVE,NYSAVE DATA ITABLE/80, 40, 20, 10, 5, 3, 1, 1 0, 1, 2, 3, 4, 5, 6/ DATA IPRTEL/1/ C THIS WRITES THE CLOSEST INSTANCE GRID TO THE OUTPUT FILE C LFILOG. AFTER CHECKOUT, THIS CAN GE CHANGED TO 0. DATA NXSAVE/0/,NYSAVE/0/ DATA ODIST/1/ DATA IFIRST/0/, 1 JFIRST/0/ DATA IDSAVE/4*0/ DATA NDTSAV/0/ C CALL TIMPR(KFILDO,KFILDO,'START SPOTRM ') C IER=0 LFIRST=0 C CCCC WRITE(KFILDO,99)DIFFA,NOCEAN,LAKE,DISTX,DPOWER,RAY,RMAX,LH, CCCC 1 NOPTN CCCC 99 FORMAT(/' IN SPOTRM--DIFFA,NOCEAN,LAKE,DISTX,DPOWER,RAY,RMAX,', CCCC 1 'LH,NOPTN',F6.0,2I4,4F8.2,2I4) C SET DPOWER, DIFFA, AND RAY TO TEMPORARY VALUES AS THEY C MAY BE CHANGED BY VALUES IN TABLE( , , ) WHEN NOPTN NE 0. C DPOWERT=DPOWER DIFFAT=DIFFA RAYT=RAY C IF(LH.EQ.1)THEN WRITE(KFILDO,1000) 1000 FORMAT(/' SWITCH IS SET TO KEEP LOW VALUES AT POINTS WITH', 1 ' LOW ELEVATION AND VICE VERSA OPERATIVE (E.G. FOR', 2 ' PROBABILITIES OF CIG CATEGORIES AND PROBS.') ELSEIF(LH.EQ.2)THEN WRITE(KFILDO,1001) 1001 FORMAT(/' SWITCH IS SET TO KEEP HIGH VALUES AT POINTS WITH', 1 ' LOW ELEVATIONS AND VICE VERSA OPERATIVE (E.G. FOR', 2 ' CIG SPECIFIC VALUES.') ENDIF C C CHECK VALUES OF NOCEAN AND LAKE. C IF(NOCEAN.LT.1.OR.NOCEAN.GT.5.OR.LAKE.LT.1.OR.LAKE.GT.5)THEN WRITE(KFILDO,1002)NOCEAN,LAKE 1002 FORMAT(/' ****VALUE OF NOCEAN =',I3,' OR LAKE =',I3, 1 ' NOT IN RANGE 1 TO 5. CORRECT THE ERROR.', 2 ' SMOOTHING NOT DONE.') ISTOP=ISTOP+1 IER=777 GO TO 400 ENDIF C C CHECK POWER. IT SHOULD NOT BE BETWEEN ZERO AND 1. C IF(DPOWERT.GT..001.AND.DPOWERT.LT.1.)THEN WRITE(KFILDO,1005)DPOWERT 1005 FORMAT(/' ****DPOWERT =',F8.5,' IS BETWEEN ZERO AND 1.', 1 ' THIS WILL NOT GIVE GOOD RESULTS. ABORT SPOTRM.') ISTOP=ISTOP+1 IER=777 GO TO 400 ENDIF C C THE DISTANCES AND WEIGHTS HAVE TO BE COMPUTED. C CHECK THE SIZE OF P( , ) AND SEALND( , ). C 104 IF(NX.NE.NXE.OR.NY.NE.NYE)THEN WRITE(KFILDO,105)NX,NY,NXE,NYE 105 FORMAT(/' ****THE GRID P( , ) OF SIZE',I5,' X',I5, 1 ' IS NOT THE SAME SIZE OF SEALND',I5,' X',I5, 2 '. SMOOTHING IN SPOTRM NOT DONE. CONTINUING.') ISTOP=ISTOP+1 IER=777 GO TO 400 ENDIF C C CHECK THE MESH LENGTHS OF P( , ) AND SEALND( , ). C IF(MESH.NE.MESHE)THEN WRITE(KFILDO,107)MESH,MESHE 107 FORMAT(/' ****THE GRID P( , ) HAS A DIFFERENT NOMINAL', 1 ' MESH LENGTH =',I3,' THAN SEALND( , ) =',I3, 2 '. SMOOTHING IN SPOTRM NOT DONE. CONTINUING.') ISTOP=ISTOP+1 IER=777 GO TO 400 ENDIF C 108 IF(IFIRST.EQ.0)THEN C C ALLOCATE THE ARRAYS DIST( , ), WT( , ), NDFD( , ), C LWMASK( , ), ITELEV( , ), AND VALUE( , ). C ALLOCATE (DIST(NX,NY),WT(NX,NY),NDFD(NX,NY), 1 LWMASK(NX,NY),ITELEV(NX,NY),VALUE(NX,NY),STAT=IOS) C IF(IOS.EQ.1)THEN WRITE(KFILDO,110) 110 FORMAT(/' ****ALLOCATION OF DIST( , ),', 1 ' WT( , ), NDFD( , ),LWMASK( , ), ITELEV( , ) AND', 2 ' VALUE( , ) FAILED IN SPOTRM', 3 ' AT 110. ARRAY ALREADY ALLOCATED.',/, 4 ' THIS IS AN ERROR. SMOOTHING NOT DONE.') ISTOP=ISTOP+1 IER=777 GO TO 400 C ELSEIF(IOS.EQ.2)THEN WRITE(KFILDO,111) 111 FORMAT(/' ****ALLOCATION OF DIST( , ),', 1 ' WT( , ), NDFD( , ),LWMASK( , ), ITELEV( , ) AND', 2 ' VALUE( , ) FAILED IN SPOTRM', 3 ' AT 111. ARRAY NOT ALLOCATED.',/, 4 ' SMOOTHING NOT DONE.') ISTOP=ISTOP+1 IER=777 GO TO 400 ENDIF C IFIRST=1 NXSAVE=NX NYSAVE=NY ELSE C IF(NX.NE.NXSAVE.OR.NY.NE.NYSAVE)THEN C IT IS NOT EXPECTED THAT THIS WILL HAPPEN. C IF IT DOES, IT IS PROBABLY AN ERROR OF SOME KIND. WRITE(KFILDO,120)NX,NY,NXSAVE,NYSAVE 120 FORMAT(/' ****GRID SIZE NX =',I5,' NY =',I5, 1 ' IN SPOTRM NOT THE SAME AS FOR', 2 ' THE PREVIOUS ENTRY NX =',I5,' NY =',I5,'.',/, 3 ' REALLOCATING THE ARRAYS WT( , ) AND', 4 ' DIST( , ) AND RECALCULATING THE DISTANCES.') C DEALLOCATE(DIST,WT,NDFD,LWMASK,ITELEV,STAT=IOS) IFIRST=0 GO TO 108 ENDIF C ENDIF C JFIRST=0 C C SET THE DISTANCES TO A LARGE NUMBER AND INITIALIZE C NDFD( , ), LWMASK( , ), AND ITELEV( , ). C SET IDIFFA = DIFFAT. C DO 139 JY=1,NY DO 138 IX=1,NX DIST(IX,JY)=99999999. VALUE(IX,JY)=9999. NDFD(IX,JY)=NINT(CPNDFD(IX,JY)) LWMASK(IX,JY)=NINT(SEALND(IX,JY)) ITELEV(IX,JY)=NINT(TELEV(IX,JY)) 138 CONTINUE 139 CONTINUE C IDIFFA=NINT(DIFFAT) C D WRITE(KFILDO,140) D140 FORMAT(/' ARRAYS INITIALIZED.') C ************************************************************** C THIS DIAGNOSTIC TO PRINT A 5 BY 5 GRID AROUND PAGM. CCCC DO 142 JY=755,751,-1 CCCC WRITE(KFILDO,141)(P(IX,JY),IX=534,538), CCCC 1 (TELEV(IX,JY),IX=534,538), CCCC 2 (SEALND(IX,JY),IX=534,538) CCCC 141 FORMAT(/' AT 141 IN SPOTRM--(P(IX,JY),IX=534,538)', CCCC 1 '(TELEV(IX,JY),IX=534,538)',5F10.3,4X,5F10.3,5F10.3) CCCC 142 CONTINUE ************************************************************** C DO 250 K=1,NSTA C C MAKE SURE STATION LOCATION IS PRESENT. C IF(XP(K).GT.9998..OR.YP(K).GT.9998.)THEN WRITE(KFILDO,143)CCALL(K) 143 FORMAT(/' ****THE LOCATION OF STATION ',A8,' MISSING.', 1 ' IN SPOTRM. STATION COULD NOT BE USED.', 2 ' CONTINUING.') ISTOP=ISTOP+1 GO TO 250 ENDIF C C SET MDIST. VALUE DEPENDS ON DISTX , TYPE OF STATION, c AND LATITUDE. C IF(NAREA.EQ.1)THEN C IF((LNDSEA(K).LE.6).OR.(STALAT(K).GE.50.AND.STALON(K).GE.85. 1 AND.STALON(K).LE.130).OR.(STALAT(K).GE.47.5.AND. 2 STALON(K).GE.55.AND.STALON(K).LE.85))THEN MDIST=DISTX*RMAX*2. C THIS APPLIES DISTX TO OCEAN, LAKE, AND LAKE/LAND C STATIONS, AND TO STATIONS IN NORTH CANADA WHEN NAREA=1. ELSE MDIST=MIN(DISTX,2.)*RMAX C FOR COMPATIBILITY, ANY DISTX VALUE LE 2 WILL STILL C OPERATE THE SAME WAY AS BEFORE FOR LAND STATIONS. WITH C THIS ARRANGEMENT, DISTX WILL PROBABLY = 1. ENDIF ELSE MDIST=MIN(DISTX,2.)*RMAX ENDIF C C RMAX COMES IN AS THE FIRST PASS RADIUS FROM THE U405A.CN FILE. C THIS IS THE MAXIMUM DISTANCE TO SEARCH IN DEFINING DISTANCES. C FOR CONUS AND R(1) = 84, THIS BECOMES 168 IF MULTIPLIED BY 2, C WHICH AGREES WELL WITH THE 165 NECESSARY IN U178 TO DEFINE C VARIABLE RADII. A SMALLER NUMBER DOES NOT REACH THE TOP OF C THE NDFD RECTANGLE. DISTX COMES FROM THE U405A.CN FILE. C A VALUE OF 1. WILL WORK IN MANY CASES. HOWEVER, TO REACH C TO THE TOP OF THE GRID IN CANADA, A VALUE OF 2 IS REQUIRED. C VALUES > 2. ARE ACCOMMODATED FOR OCEAN, AND MAY BE NEEDED C IN THE PACIFIC OCEAN (E.G., DEW POINT), AND IN ALASKA. C C CHECK FOR GOOD DATA AND EXERCISE NOPTN OPTIONS FOR C WHICH DATA TO SMOOTH OUT. C IF(LTAG(K).NE.0)GO TO 250 C ONLY GOOD DATA USED ON LAST PASS ARE NOT SMOOTHED OUT. IF(NOPTN.EQ.1.AND.LTAGPT(K).GE.3)GO TO 250 C WHEN NOPTN = 1, BOGUS ARE SMOOTHED OUT; AUGMENTED NOT. IF(NOPTN.EQ.2.AND.LTAGPT(K).GE.2)GO TO 250 C WHEN NOPTN = 2, BOGUS AND 2ND LEVEL AUGMENTED SMOOTHED OUT. IF(NOPTN.EQ.3.AND.LTAGPT(K).NE.0)GO TO 250 C WHEN NOPTN = 3, BOGUS AND ALL AUGMENTED SMOOTHED OUT. C**********************PUT IN 11/30/16 CCCC IF(NOPTN.EQ.4.AND.LTAGPT(K).EQ.3.AND.LNDSEA(K).EQ.0)GO TO 250 CCCC ABOVE TOOK TOO LONG IF(NOPTN.EQ.4.AND.LTAGPT(K).EQ.4)GO TO 250 C**********************PUT IN 11/30/16 C IF(XP(K).LT.1.-ODIST.OR.XP(K).GT.NX+ODIST)GO TO 250 IF(YP(K).LT.1.-ODIST.OR.YP(K).GT.NY+ODIST)GO TO 250 C STATION HAS TO BE WITHIN ODIST OF GRID. THIS VALUE SHOULD C AGREE WITH PARAMETERS USED IN U155, GENERALLY ONLY 1 OR 2 C GRIDPOINTS. AS LONG AS A LOW VALUE IS USED, IT WON'T BE C VERY SENSITIVE TO THE EXACT VALUE. IXK=NINT(XP(K)) JYK=NINT(YP(K)) C DO 200 JY=MAX(1,JYK-MDIST),MIN(NY,JYK+MDIST) DO 199 IX=MAX(1,IXK-MDIST),MIN(NX,IXK+MDIST) C IN THE ABOVE, IF THE INITIAL VALUE IS GT THE TERMINAL C VALUE, THE LOOP WILL NOT EXECUTE. C IF(LWMASK(IX,JY).EQ.9999)GO TO 199 C MOVING TEST DOWN DID NOT HELP TIMING. C C THE FINAL IF TEST IN THE STRUCTURES COULD BE ELIMINATED, C BUT ARE THERE TO GIVE POSITIVE CONTROL ON THE VALUES C OF LWMASK( , ). C IF(LNDSEA(K).EQ.9)THEN C THIS IS A LAND STATION. C IF(LWMASK(IX,JY).EQ.9)THEN C THIS IS A LAND GRIDPOINT. GO TO 150 C ELSEIF(LWMASK(IX,JY).EQ.3)THEN C THIS IS A LAKE GRIDPOINT. C IF(LAKE.EQ.3.OR.LAKE.EQ.5.OR.LAKE.EQ.1)THEN C MODIFIED ABOVE JAN. 30, 2015. GO TO 150 ELSE GO TO 199 ENDIF C ELSEIF(LWMASK(IX,JY).EQ.0)THEN C THIS IS AN OCEAN GRIDPOINT. C IF(NOCEAN.EQ.3.OR.NOCEAN.EQ.5.OR.NOCEAN.EQ.1)THEN C MODIFIED ABOVE JAN. 30, 2015. GO TO 150 ELSE GO TO 199 ENDIF C ELSE WRITE(KFILDO,148)LWMASK(IX,JY),IX,JY 148 FORMAT(/,' ****SEALND( , ) =',I3,' NOT ONE OF THE', 1 ' PERMISSIBLE VALUES OF 0, 3,OR 9 FOR IX,JY =',2I6, 2 ' AT 148. SMOOTHING NOT DONE IN SPOTRM.') ISTOP=ISTOP+1 IER=555 C THIS WILL BE TREATED AS FATAL BELOW THE OPEN MP LOOP. C TRANSFER CANNOT BE MADE. ENDIF C ELSEIF(LNDSEA(K).EQ.0)THEN C THIS IS AN OCEAN STATION. C IF(LWMASK(IX,JY).EQ.0)THEN C THIS IS AN OCEAN GRIDPOINT. C IF(NOCEAN.GE.3)THEN GO TO 150 ELSE GO TO 199 ENDIF C ELSEIF(LWMASK(IX,JY).EQ.9)THEN C THIS IS A LAND GRIDPOINT. C IF(NOCEAN.EQ.3)THEN GO TO 150 ELSE GO TO 199 ENDIF C ELSEIF(LWMASK(IX,JY).EQ.3)THEN C THIS IS A LAKE GRIDPOINT. AN OCEAN STATION C DOES NOT CONTRIBUTE TO LAKE GRIDPOINTS. GO TO 199 ELSE WRITE(KFILDO,145)LWMASK(IX,JY),IX,JY 145 FORMAT(/,' ****SEALND( , ) =',I3,' NOT ONE OF THE', 1 ' PERMISSIBLE VALUES OF 0, 3,OR 9 FOR IX,JY =',2I6, 2 ' AT 145. SMOOTHING NOT DONE IN SPOTRM.') ISTOP=ISTOP+1 IER=555 C THIS WILL BE TREATED AS FATAL BELOW THE OPEN MP LOOP. C TRANSFER CANNOT BE MADE. ENDIF C ELSEIF(LNDSEA(K).EQ.3)THEN C THIS IS A LAKE STATION. C IF(LWMASK(IX,JY).EQ.3)THEN C THIS IS A LAKE GRIDPOINT. C IF(LAKE.GE.3)THEN GO TO 150 ELSE GO TO 199 ENDIF C ELSEIF(LWMASK(IX,JY).EQ.9)THEN c THIS IS A LAND GRIDPOINT. C IF(LAKE.EQ.3)THEN GO TO 150 ELSE GO TO 199 ENDIF C ELSEIF(LWMASK(IX,JY).EQ.0)THEN C THIS IS AN OCEAN GRIDPOINT. A LAKE STATION C DOES NOT CONTRIBUTE TO OCEAN GRIDPOINTS. GO TO 199 ELSE WRITE(KFILDO,146)LWMASK(IX,JY),IX,JY 146 FORMAT(/,' ****SEALND( , ) =',I3,' NOT ONE OF THE', 1 ' PERMISSIBLE VALUES OF 0, 3,OR 9 FOR IX,JY =',2I6, 2 ' AT 146. SMOOTHING NOT DONE IN SPOTRM.') ISTOP=ISTOP+1 IER=555 C THIS WILL BE TREATED AS FATAL BELOW THE OPEN MP LOOP. C TRANSFER CANNOT BE MADE. ENDIF C ELSEIF(LNDSEA(K).EQ.6)THEN C THIS IS A LAKE STATION OR A LAKE AND LAND STATION. C IF(LWMASK(IX,JY).EQ.3)THEN C THIS IS A LAKE GRIDPOINT. C IF(LAKE.GE.3)THEN GO TO 150 ELSE GO TO 199 ENDIF C ELSEIF(LWMASK(IX,JY).EQ.0)THEN c THIS IS AN OCEAN GRIDPOINT. C IF(NOCEAN.EQ.3)THEN GO TO 150 ELSE GO TO 199 ENDIF C ELSEIF(LWMASK(IX,JY).EQ.9)THEN C THIS IS A LAND GRIDPOINT. IT IS TREATED THE SAME C FOR BOTH A LAND AND A LAND/LAKE STATION. CCCCC GO TO 150 CHANGED 7/1/14 GO TO 199 ELSE WRITE(KFILDO,147)LWMASK(IX,JY),IX,JY 147 FORMAT(/,' ****SEALND( , ) =',I3,' NOT ONE OF THE', 1 ' PERMISSIBLE VALUES OF 0, 3,OR 9 FOR IX,JY =',2I6, 2 ' AT 147. SMOOTHING NOT DONE IN SPOTRM.') ISTOP=ISTOP+1 IER=555 C THIS WILL BE TREATED AS FATAL BELOW THE OPEN MP LOOP. C TRANSFER CANNOT BE MADE. ENDIF C ELSE WRITE(KFILDO,149)LNDSEA(K),K 149 FORMAT(/,' ****LNDSEA( ) =',I3,' NOT ONE OF THE', 1 ' PERMISSIBLE VALUES OF 0, 3, 6,OR 9 FOR K =',I6, 2 ' AT 149. SMOOTHING NOT DONE IN SPOTRM.') ISTOP=ISTOP+1 IER=555 C THIS WILL BE TREATED AS FATAL BELOW THE OPEN MP LOOP. C TRANSFER CANNOT BE MADE. ENDIF C 150 DISTSQ=(IX-XP(K))**2+(JY-YP(K))**2 C C THE INTENT HERE IS TO NOT SMOOTH ANY POINT IN THE C 4-POINT BOX ENCLOSING THE STATION. THIS SERVES TWO C PURPOSES: (1) LINEAR INTERPOLATION WILL NOT BE AFFECTED C BY THE SMOOTHING, SO MAX AND MIN VALUES ON THE GRID WILL C NOT BE SMOOTHED OUT, AND (2) THE "INTERPOLATION" USED IN C THE ANALYSIS IS THE VALUE AT THE GRIDPOINT WITH THE C CLOSEST ELEVATION TO THE STATION ELEVATION, WHICH COULD C BE NEARLY DIAGONALLY ACROSS THE BOX WITH A DISTANCE OF C 1.414 GRIDLENGTHS. C C THIS SECTION OF CODE FINDS THE DISTANCE OF EACH C GRIDPOINT TO THE CLOSEST STATION (UNLESS SOME STATIONS C HAVE BEEN SCREENED OUT BY NOPTN). C IF(DISTSQ.LT.DIST(IX,JY))THEN VALUE(IX,JY)=P(IXK,JYK) C THIS IS THE ANALYZED VALUE AT THE STATION. C IF(DISTSQ.LE.2.)THEN C THIS IS THE MAXIMUM DISTANCE SQUARED FROM A STATION C TO THE FARTHEST GRIDPOINT. C IF(ABS(IX-XP(K)).LE.1..AND.ABS(JY-YP(K)).LE.1.)THEN C THIS INSURES THE STATION IS WITHIN THE BOX. C DIST(IX,JY)=0. C THIS GRIDPOINT IS NOT SMOOTHED. ELSE DIST(IX,JY)=DISTSQ ENDIF C ELSE DIST(IX,JY)=DISTSQ C ENDIF C ENDIF C CCCC IF(CCALL(K).EQ.'KCOS ')THEN C CCCC IF(ABS(IX-XP(K)).LT.4..AND.ABS(JY-YP(K)).LT.4.)THEN CCCC WRITE(KFILDO,198)K,CCALL(K),XP(K),YP(K),IX,JY, CCCC 1 DIST(IX,JY),MDIST,ODIST CCCC198 FORMAT('K,CCALL(K),XP(K),YP(K),IX,JY,', CCCC 1 'DIST(IX,JY),MDIST,ODIST', CCCC 2 I6,1X,A8,2F8.2,2I6,F10.2,I9,F10.2) CCCC ENDIF C CCCC ENDIF C 199 CONTINUE 200 CONTINUE C 250 CONTINUE C C FIND DISTANCE FROM SQUARE OF DISTANCE FOR DIST( , ). C DO 255 JY=1,NY DO 254 IX=1,NX C IF(DIST(IX,JY).LT.99999998.9)THEN C THE ORIGINAL VALULE OF DIST( , ) WAS SET VERY LARGE. DIST(IX,JY)=SQRT(DIST(IX,JY)) ELSE DIST(IX,JY)=MDIST C THIS ASSURES A RADIUS IN SPARSE DATA REGIONS. ENDIF C 254 CONTINUE 255 CONTINUE C C THE GRID IN DIST( , ) NOW CONTAINS THE DISTANCE TO THE C CLOSEST STATION, AND VALUE( , ) IS THE ANALYZED VALUE C AT THAT STATION. C C COMPUTE GRID OF WEIGHTS. C DO 270 JY=1,NY DO 269 IX=1,NX C IF(DIST(IX,JY).GT.9998.)THEN WT(IX,JY)=0. GO TO 269 ENDIF C C THIS SECTION OF CODE COMPUTES THE WT( , ) FOR THE C CLOSEST STATION. C IF(DIST(IX,JY).LT.1.)THEN WT(IX,JY)=1. ELSEIF(DPOWERT.GT..001)THEN C DPOWERT HAS ALREADY BEEN FOUND TO BE EITHER 0 OR C GE 1. WT(IX,JY)=1./(DIST(IX,JY)**DPOWERT) C NOTE THAT IF DIST(IX,JY) COULD BE MISSING = 9999., C THE WT( , ) WOULD BE NEAR ZERO. ELSE WT(IX,JY)=1. C WHEN DPOWERT = 0, THE WEIGHT IS ALWAYS UNITY, C AND THE POWER COMPUTATION CAN BE BYPASSED. ENDIF C 269 CONTINUE 270 CONTINUE C D WRITE(KFILDO,271) D271 FORMAT(/' WEIGHTS COMPUTED.') C C SMOOTH THE POINTS. C 272 CONTINUE C CALL TIMPR(KFILDO,KFILDO,'SMOOTH THE POINTS ') C !$OMP PARALLEL DO !$OMP& DEFAULT(SHARED) PRIVATE(IX,JY,JY1,IX1,IOCEXT, !$OMP& SUM,COUNT,IXS,JYS,IXE,JYE,IOCSQ, !$OMP& DIFF,RA) !$OMP& FIRSTPRIVATE (RAYT,DIFFAT,IDIFFA) !$OMP& SCHEDULE(DYNAMIC) C DO 300 JY=1,NY DO 299 IX=1,NX C CCCC IF(IX.EQ.1400.AND.JY.EQ.1400)THEN CCCC WRITE(KFILDO,273)IX,JY,NDFD(IX,JY),P(IX,JY),LWMASK(IX,JY), CCCC 1 WT(IX,JY),DIST(IX,JY),NOCEAN CCCC 273 FORMAT(' AT 273--IX,JY,NDFD(IX,JY),P(IX,JY),LWMASK(IX,JY),', CCCC 1 'WT(IX,JY),DIST(IX,JY),NOCEAN'/6X,3I5,F8.3,I4,2F8.3,I2) CCCC ENDIF C IF(NCLIP.EQ.1.AND.NDFD(IX,JY).EQ.0)THEN C THIS KEEPS SMOOTHING TO WITHIN THE NDFD CLIP AREA, C BUT ONLY WHEN CLIPPING IS TO BE DONE. HOLD(IX,JY)=P(IX,JY) c ELSEIF(P(IX,JY).GT.9998..OR.DIST(IX,JY).GT.9998.)THEN C THE ABOVE CHECK ASSURES A GOOD DATUM AND DISTANCE. HOLD(IX,JY)=P(IX,JY) c ELSEIF(NOCEAN.EQ.2.AND.LWMASK(IX,JY).EQ.0)THEN C THE ABOVE CHECK ELIMINATES OCEAN POINTS WHEN NOCEAN = 2. C CHANGED FROM 'ELSEIF(NOCEAN.EQ.0.AND.LWMASK(IX,JY).LT.4)' C ON 7/18/11. HOLD(IX,JY)=P(IX,JY) c ELSEIF(LAKE.EQ.2.AND.LWMASK(IX,JY).EQ.3)THEN C THE ABOVE CHECK ELIMINATES LAKE POINTS WHEN LAKE = 2. HOLD(IX,JY)=P(IX,JY) C ADDED THE ABOVE TEST ON LAKE ON 7/18/11. c ELSEIF(WT(IX,JY).GT..9999)THEN HOLD(IX,JY)=P(IX,JY) C ADDED THE ABOVE TEST 10/25/16. THE WEIGHTS OF THE 4 POINTS C AROUND A STATION ARE 1.0 AND LESS EVERYWHERE ELSE. TEST C ASSURES THESE 4 POINTS REMAIN. OTHERWISE, AVERAGING OVER C 9 POINTS OCCURS, AND THE VALUES ARE NOT EXACTLY RETAINED. C C*********************************************** C INSERTED 12/2/18 TO ELIMINATE SMOOTHING OVER OCEAN AND C SIBERIA FOR ALASKA AREA. MATCHES AREA IN BOGUS2. C ELSEIF(NAREA.EQ.2.AND.(SEALND(IX,JY).EQ.0.OR. 1 (IX.LT.610.AND.JY.GT.756)))THEN HOLD(IX,JY)=P(IX,JY) C********************************************** ELSE C C THIS IS A POINT TO BE USED THAT IS NOT MISSING AND HAS A C DISTANCE. C IF(LWMASK(IX,JY).LT.9)THEN IOCEXT=MIN(DIST(IX,JY),RMAX*DISTX)*RAYT+1. ELSE IOCEXT=MIN(DIST(IX,JY),RMAX*MIN(DISTX,2.))*RAYT+1. ENDIF C C THIS ADDS ONE AND TRUNCATES. WITHOUT THE ONE, THE C GRIDPOINT CLOSEST TO THE STATION MIGHT NOT CONTRIBUTE. IOCSQ=IOCEXT*IOCEXT C IXS=MAX(1,IX-IOCEXT) IXE=MIN(NX,IX+IOCEXT) JYS=MAX(1,JY-IOCEXT) JYE=MIN(NY,JY+IOCEXT) SUM=0. COUNT=0. C CCCC IF(IX.EQ.1152.AND.JY.EQ.743)THEN CCCC WRITE(KFILDO,2735)IOCEXT,IXS,IXE,JYS,JYE, CCCC 1 LWMASK(IX,JY),DIST(IX,JY),WT(IX,JY) CCCC 2735 FORMAT(/' AT 2735--IOCEXT,IXS,IXE,JYS,JYE,', CCCC 1 'LWMASK(IX,JY),DIST(1152,743),WT(1152,743)', CCCC 2 6I6,2F10.2) CCCC ENDIF C DO 280 JY1=JYS,JYE DO 279 IX1=IXS,IXE C IF(NCLIP.EQ.1.AND.NDFD(IX1,JY1).EQ.0)GO TO 279 C THIS KEEPS SMOOTHING TO WITHIN THE NDFD CLIP AREA C BUT ONLY IF CLIPPING IS TO BE DONE. C NOTE THAT THIS NEVER USES POINTS OUTSIDE THE CLIP C AREA FOR SMOOTHING. THIS IS A BIG TIME SAVER. C HOWEVER BORDER AREAS MAY NOT BE AS PLEASING. C IF(LWMASK(IX,JY).EQ.9)THEN C THIS IS A LAND POINT BEING SMOOTHED. IF(LWMASK(IX1,JY1).EQ.0.AND.NOCEAN.NE.3)GO TO 279 C AN OCEAN POINT IS NOT USED TO SMOOTH A LAND POINT C UNLESS NOCEAN EQ 3) IF(LWMASK(IX1,JY1).EQ.3.AND.LAKE.NE.3)GO TO 279 C A LAKE POINT IS NOT USED TO SMOOTH A LAND POINT C UNLESS LAKE EQ 3) ELSEIF(LWMASK(IX,JY).EQ.0)THEN C THIS IS AN OCEAN POINT BEING SMOOTHED. IF(LWMASK(IX1,JY1).EQ.9.AND.(NOCEAN.LE.2.OR.NOCEAN.EQ.4)) 1 GO TO 279 C A LAND POINT IS NOT USED TO SMOOTH AN OCEAN POINT C UNLESS NOCEAN EQ 3 OR.5) C MODIFIED ABOVE JAN. 30, 2015. IF(LWMASK(IX1,JY1).EQ.0.AND.NOCEAN.LE.2)GO TO 279 C AN OCEAN POINT IS NOT USED TO SMOOTH AN OCEAN POINT C WHEN NOCEAN = 1 OR 2. IF(LWMASK(IX1,JY1).EQ.3)GO TO 279 C A LAKE POINT IS NEVER USED TO SMOOTH AN OCEAN POINT. ELSE C THIS IS A LAKE POINT BEING SMOOTHED. IF(LWMASK(IX1,JY1).EQ.9.AND.(LAKE.LE.2.OR.LAKE.EQ.4)) 1 GO TO 279 C A LAND POINT IS NOT USED TO SMOOTH A LAKE POINT C UNLESS LAKE EQ 3 OR 5. C MODIFIED ABOVE JAN. 30, 2015. IF(LWMASK(IX1,JY1).EQ.3.AND.LAKE.LE.2)GO TO 279 C A LAKE POINT IS NOT USED TO SMOOTH A LAKE POINT C WHEN LAKE = 1, OR 2. IF(LWMASK(IX1,JY1).EQ.0)GO TO 279 C AN OCEAN POINT IS NEVER USED TO SMOOTH A LAKE POINT. ENDIF C C ALL POINTS NOT USED IN SMOOTHING HAVE BEEN SCREENED C OUT ABOVE. C IF(LH.EQ.0)THEN C SWITCH ADDED 4/14/19 IF(ABS(ITELEV(IX,JY)-ITELEV(IX1,JY1)).LT.IDIFFA)THEN C IF(P(IX1,JY1).LT.9998.9)THEN C A MISSING POINT CANNOT ADD TO THE SMOOTHING. C THIS IS A SAFETY; P( , ) CANNOT REALLY BE MISSING. C MAKE THIS TEST AT THE LAST POSSIBLE TIME FOR C EFFICIENCY. C IF(((IX1-IX)**2+(JY1-JY)**2).LT.IOCSQ)THEN C THE ABOVE KEEPS THE SMOOTHING TO A CIRCLE. SUM=SUM+WT(IX1,JY1)*P(IX1,JY1) COUNT=COUNT+WT(IX1,JY1) ENDIF C ENDIF C ENDIF C ELSEIF(LH.EQ.1)THEN IF((ABS(ITELEV(IX,JY)-ITELEV(IX1,JY1)).LT.IDIFFA).OR. 1 (TELEV(IX,JY).GT.TELEV(IX1,JY1).AND. 2 P(IX1,JY1).GE.P(IX,JY)).OR. 3 (TELEV(IX,JY).LT.TELEV(IX1,JY1).AND. 4 P(IX1,JY1).LE.P(IX,JY)))THEN C IF(P(IX1,JY1).LT.9998.9)THEN C A MISSING POINT CANNOT ADD TO THE SMOOTHING. C THIS IS A SAFETY; P( , ) CANNOT REALLY BE MISSING. C MAKE THIS TEST AT THE LAST POSSIBLE TIME FOR C EFFICIENCY. C IF(((IX1-IX)**2+(JY1-JY)**2).LT.IOCSQ)THEN C THE ABOVE KEEPS THE SMOOTHING TO A CIRCLE. SUM=SUM+WT(IX1,JY1)*P(IX1,JY1) COUNT=COUNT+WT(IX1,JY1) ENDIF C ENDIF C ENDIF C ELSEIF(LH.EQ.2)THEN IF((ABS(ITELEV(IX,JY)-ITELEV(IX1,JY1)).LT.IDIFFA).OR. 1 (TELEV(IX,JY).GT.TELEV(IX1,JY1).AND. 2 P(IX1,JY1).LE.P(IX,JY)).OR. 3 (TELEV(IX,JY).LT.TELEV(IX1,JY1).AND. 4 P(IX1,JY1).GE.P(IX,JY)))THEN C IF(P(IX1,JY1).LT.9998.9)THEN C A MISSING POINT CANNOT ADD TO THE SMOOTHING. C THIS IS A SAFETY; P( , ) CANNOT REALLY BE MISSING. C MAKE THIS TEST AT THE LAST POSSIBLE TIME FOR C EFFICIENCY. C IF(((IX1-IX)**2+(JY1-JY)**2).LT.IOCSQ)THEN C THE ABOVE KEEPS THE SMOOTHING TO A CIRCLE. SUM=SUM+WT(IX1,JY1)*P(IX1,JY1) COUNT=COUNT+WT(IX1,JY1) ENDIF C ENDIF C ENDIF C ENDIF C CCCC IF(IX.GE.1511.AND.IX.LE.1514.AND.JY.GE.457.AND.JY.LE.460)THEN CCCC WRITE(KFILDO,274)IX,JY,IX1,JY1,SUM,COUNT CCCC 274 FORMAT('AT 274 IN SPOTRM--IX,JY,IX1,JY1,SUM,COUNT', CCCC 2 4I6,2F6.2) CCCC ENDIF C CCCC IF(IX.EQ.1160.AND.JY.EQ.1398)THEN CCCC WRITE(KFILDO,275)IX,JY,IX1,JY1,IOCEXT, CCCC 1 SUM,COUNT,P(IX,JY),P(IX1,JY1), CCCC 2 TELEV(IX,JY),TELEV(IX1,JY1), CCCC 3 DIST(IX1,JY1),WT(IX1,JY1) CCCC 275 FORMAT(' IX,JY,IX1,JY1,IOCEXT,', CCCC 1 'SUM,COUNT,P(IX,JY),P(IX1,JY1),', CCCC 2 'TELEV(IX,JY),TELEV(IX1,JY1),', CCCC 3 'DIST(IX1,JY1),WT(IX1,JY1)'/ CCCC 4 5I6,8F10.2) CCCC ENDIF C 279 CONTINUE 280 CONTINUE C IF(COUNT.EQ.0.)THEN HOLD(IX,JY)=P(IX,JY) ELSE HOLD(IX,JY)=SUM/COUNT ENDIF C ENDIF C 299 CONTINUE C 300 CONTINUE C !$OMP END PARALLEL DO C C TREAT IER = 555 AS FATAL. IT IS DONE HERE BECAUSE C OPEN MP DOES NOT ALLOW TRANSFER OUT OF LOOP. C IF(IER.EQ.555)THEN IER=777 GO TO 400 ENDIF C C REPLACE P( , ) WITH HOLD( , ). C DO 310 JY=1,NY DO 309 IX=1,NX P(IX,JY)=HOLD(IX,JY) 309 CONTINUE 310 CONTINUE C C SAVE THE DATE AND ID( ). C NDTSAV=NDATE C DO 312 J=1,4 IDSAVE(J)=ID(J) 312 CONTINUE C IF(IPRTEL.EQ.0.OR.KFILOG.EQ.0.OR.JFIRST.EQ.1)GO TO 400 C IPRTEL SET TO 1 FOR CHECKOUT, THEN CAN BE CHANGED TO ZERO. C C PREPARING TO WRITE THE DISTANCE GRID TO THE DISPOSABLE FILE. C C DEFINE THE ID FOR THE DISTANCE GRID, WHICH DEPENDS ON MESH C LENGTH. VARIABLE ID(1) IS USED IN WORD 2. THIS ALLOWS A DISTANCE C GRID TO BE IN THE RA FILE FOR DIFFERENT SETS OF STATIONS. C DO 319 J=1,7 C IF(MESHE.EQ.ITABLE(J,1))THEN LD(1)=408000000+NPROJ*100000+ITABLE(J,2)*10000 LD(2)=ID(1) C THIS MAKES THE GRID SPECIFIC TO A VARIABLE. THE ONLY C PART OF THE ID( ) THAT IS NOT HERE IS WORD 2, WHICH IS C HARDLY EVER USED FOR SURFACE VARIABLES. LD(3)=ID(3) LD(4)=ID(4) CCCCD WRITE(KFILDO,318)NDATE,(LD(JJJ),JJJ=1,4) CCCCD318 FORMAT(' AT 318 IN U155--NDATE,,(LD(JJJ),JJJ=1,4)',5I11) GO TO 330 ENDIF C 319 CONTINUE C WRITE(KFILDO,320) 320 FORMAT(' ****COULD NOT FIND MESH VALUE IN TABLE AT 320', 1 ' IN SPOTRM. SMOOTHING DONE, BUT THE GRID NOT', 2 ' WRITTEN TO THE DISPOSABLE FILE.') ISTOP=ISTOP+1 IER=777 GO TO 400 C C PACK AND WRITE TO THE DISPOSABLE FILE. C 330 ITAUM=0 NSEQ=0 NCHAR=32 C 32 CHARACTERS OF PLAIN LANGUAGE ARE PACKED. XMISSP=9999. XMISSS=0. C THE DISTANCE GRID IS ON A CLIPPED GRID, SO THERE C WILL BE MISSING VALUES. C CALL PAWGTS(KFILDO,KFILOG,'KFILOG',IP16,NDATE, 1 LD,IDPARS(12),ITAUM,MODNO,NSEQ,ISCALD, 2 NPROJ,ALATL,ALONL,ORIENT,MESH,XLAT,NX,NY, 3 DIST,DATA,IWORK,IPACK,NX*NY,MINPK, 4 IS0,IS1,IS2,IS4,ND7, 5 IPLANT,PLAINT,NCHAR, 6 XMISSP,XMISSS,LX,IOCTET, 7 JTOTBY,JTOTRC,L3264B,L3264W,IER) C PAWGTS WRITES DIAGNOSTIC TO IP16. JFIRST=1 C JFIRST KEEPS DUPLICATE DISTANCE GRIDS FROM BEING WRITTEN. IF(IER.NE.0)THEN IER=777 ISTOP=ISTOP+1 ENDIF C 400 CONTINUE C ************************************************************** C THIS DIAGNOSTIC TO PRINT A 5 BY 5 GRID AROUND PAGM. CCCC DO 420 JY=755,751,-1 CCCC WRITE(KFILDO,419)(P(IX,JY),IX=534,538) CCCC 419 FORMAT(/' AT 419 IN SPOTRM--(P(IX,JY),IX=534,538)',25X,5F10.3) CCCC 420 CONTINUE ************************************************************** C C****************************************************************** CCCC WRITE(KFILDO,460)LP,P(536,753),P(537,753),P(536,754),P(537,754), CCCC 1 TELEV(536,753),TELEV(537,753),TELEV(536,754), CCCC 2 TELEV(537,754), CCCC 3 SEALND(536,753),SEALND(537,753),SEALND(536,754), CCCC 2 SEALND(537,754) CCCC 460 FORMAT(' AT 460 IN SPOTRM--LP,P(536,753),P(537,753),P(536,754),', CCCC 1 'P(537,754),TELEV(536,753),TELEV(537,753),TELEV(536,754),', CCCC 2 'TELEV(537,754),SEALND(536,753),SEALND(537,753),', CCCC 3 'SEALND(536,754),SEALND(537,754)',/,I4,8F10.3,4F5.1) C****************************************************************** C CALL TIMPR(KFILDO,KFILDO,'END SPOTRM ') C RETURN END