SUBROUTINE CLOS2G(KFILDO,ID, 1 CCALL,XP,YP,LTAG,LNDSEA,ELEV,XLAPSE,XDATA,NSTA, 2 P,SVD2ND,NEARSV,SVD1ST,ERROR,NX,NY, 3 CPNDFD,SEALND,TELEV,NXE,NYE, 4 ITABLE,RTABLE,IDIM,JDIM,M, 5 ITERML,ITERMW,RMULT,ISTOP,IER) C C DECEMBER 2007 GLAHN MDL C JANUARY 2008 GLAHN SWITCHED DD4 AND DD5 IN EQUATION C EVALUATION; ADDED RWATO AND RWATI C FEBRUARY 2008 GLAHN ADDED ITERML,ITERMW,JTERML,JTERMW C FEBRUARY 2008 GLAHN STATEMENT 1614 ADDED; DIAGNOSTIC 1615; C GO TO 500 ON IER=777 C FEBRUARY 2008 GLAHN CHANGED JTERM TO ITERM, L AND W C FEBRUARY 2008 GLAHN ADDED SVD2ND( , ) TO CALL; ADDED C EVALUATION OF 1797 AND 1997 C FEBRUARY 2008 GLAHN ADDED EVALUATION OF 1897; ADDED P( , ) C AND XLAPSE( ) TO CALL C FEBRUARY 2009 GLAHN ADDED TO PURPOSE; REMOVED THE SKIP C FOR WATER POINTS C MARCH 2009 GLAHN CHANGED IF(LTAG(K).GT.0) TO C IF(LTAG(K).NE.0) IN TWO PLACES C MARCH 2009 GLAHN MODIFIED 2ND WORD ID STRUCTURE FROM C XXX97YY00 TO XXX97YYYY C MARCH 2009 GLAHN SUBSTITUTED RL AND RW FOR R AND C RLSQ AND RWSQ FOR RSQ C JUNE 2010 GLAHN ELIMINATED TWO GO TO 500 FOR OPEN MP; C RESULTING NECESSARY CHECK ON C NEARSV( , ) INSERTED IN FIVE PLACES; C TWO DIAGNOSTICS MODIFIED C JULY 2010 SCALLION/GLAHN OPEN MP STATEMENTS PUT IN IN C SEVERAL PLACES; SPELL CHECK C OCTOBER 2011 GLAHN/IM ADDED GO TO 500 AFTER OPEN MP C NOVEMBER 2011 IM/GLAHN ADDED JPRINT FOR WATER POINTS C NOVEMBER 2011 IM/GLAHN ADDED RMULT TO CALL; ADDED IC AND C FIRSTPRIVATE(IC); REMOVED IER=777 C FOR WATER POINTS; ADDED ERROR(IX,JY)= C 9999 IN DO LOOPS OF 209, 219, 229, C 239, AND 249 C C PURPOSE C TO ACCUMULATE THE ANALYSIS ERROR IN ERROR( , ) FOR C THE TERMS IN THE ERROR ESTIMATION EQUATIONS INVOLVING C THE CLOSEST OR NEXT CLOSEST STATION. IT DEALS WITH C BOTH WATER AND LAND EQUATIONS AND ALL TERMS IN EACH C EQUATION. ERROR( , ) IS ACCUMULATED FOR ALL TERMS C INVOLVING 0197, 0297, 1797, 1897, AND 1997 IN THE c 2ND WORD: C C 0197 = DISTANCE FROM THE GRIDPOINT TO CLOSEST STATION, C 0297 = DISTANCE FROM THE GRIDPOINT TO NEXT CLOSEST C STATION, C 1797 = ABSOLUTE DIFFERENCE IN ELEVATION BETWEEN C GRIDPOINT AND CLOSEST STATION, C 1897 = ABSOLUTE DIFFERENCE IN ELEVATION BETWEEN C GRIDPOINT AND CLOSEST STATION AFTER C LAPSE RATE AND THE DISTANCE BETWEEN THE C TWO STATIONS ARE CONSIDERED, AND C 1997 = PRODUCT OF 0197 AND 1797. C C ITERATION IS OVER ALL GRIDPOINTS FOR ANY TERM INVOLVING C CLOSEST STATIONS, BUT A GRIDPOINT IS DEALT WITH ONLY C WHEN IT MATCHES THE EQUATION TYPE (LAND OR WATER). C ITERATION OVER THE STATIONS IS DONE ONLY ONCE FOR ANY C GRIDPOINT. C C THE RADIUS OF SEARCH IS TAKEN FROM THE 2ND WORD OF THE C EQUATION. IT IS MULTIPLIED BY A FACTOR OF RWATO OR C RWATI WHEN THE GRIDPOINT IS OCEAN OR INLAND WATER, C RESPECTIVELY. WHEN THE SEARCH DOES NOT YIELD THE CLOSEST C (2ND CLOSEST) STATION, THE ONE(S) NOT FOUND ARE GIVEN THE C VALUE OF R. WHEN A CLOSEST STATION IS NOT FOUND, CLOS2G C ABORTS WITH AND ERROR. C C OPEN MP STOP,IER, AND IPRINT/JPRINT ARE NOT DECLARED PRIVATE C IN OPEN MP. C IER IS ONLY SET = 777 AND ANY OPEN MP LOOP SHOULD DO THAT. C A RETURN TO THE CALLING PROGRAM WILL BE NON-ZERO IF C ANY LOOP FINDS AN ERROR. 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 IPRINT/JPRINT COULD BE CONFLICTED, BUT WOULD ONLY MEAN C THE NUMBER OF DIAGNOSTICS PRINTED WOULD BE MORE THAN C THE COUNT. C C DATA SET USE C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) C C VARIABLES C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) C ID(J) = THE VARIABLE ID'S OF THE ANALYSIS (J=1,4). C (INPUT) C CCALL(K) = CALL LETTERS OF STATIONS (K=1,NSTA). USED C ONLY FOR DIAGNOSTICS. (CHARACTER*8) (INPUT) C XP(K) = X-POSITION OF STATION K ON GRID (K=1,NSTA). C (INPUT) C YP(K) = Y-POSITION OF STATION K ON GRID (K=1,NSTA). C (INPUT) C LTAG(K) = DON'T USE THIS STATION IF LTAG( ) NE 0 C (K=1,NSTA). STATIONS WITH DATA BUT TOSSED C HAVE LTAG( ) = -1. POSSIBILITY OF LTAG( ) C = -3 NOT IMPLEMENTED. (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 ELEV(K) = ELEVATION OF STATIONS (K=1,NSTA). (INPUT) C XLAPSE(K) = CALCULATED LAPSE RATE IN UNITS OF THE VARIABLE C BEING ANALYZED PER M. (K=1,KSTA). (INPUT) C NSTA = NUMBER OF STATIONS IN LIST. (INPUT) C XDATA(K) = THE DATA BEING ANALYZED (K=1,NSTA). (INPUT) C SVD2ND(IX,JY) = HOLDS THE DISTANCE TO THE 2ND NEAREST STATION C (IX=1,NX) (JY=1,NY). FD4( , ) IN CALLING C ROUTINE EREST. (INTERNAL) C NEARSV(IX,JY) = HOLDS THE LOCATION IN THE LIST OF THE NEAREST C STATION (IX=1,NX) (JY=1,NY). (INTERNAL) C SVD1ST(IX,JY) = HOLDS THE DISTANCE TO THE NEAREST STATION C (IX=1,NX) (JY=1,NY). FD5( , ) IN CALLING U405A. C (INTERNAL) C ERROR(IX,JY) = HOLDS THE ACCUMULATED ERROR (IX=1,NY) (JY=1,NY). C (INPUT/OUTPUT) C NX = THE SIZE OF THE ERROR( , ) IN THE X DIRECTION. C (INPUT) C NY = THE SIZE OF THE ERROR( , ) IN THE X DIRECTION. C (INPUT) C CPNDFD(IX,JY) = THE NDFD MASK FROM THE MOS-2000 EXTERNAL C RANDOM ACCESS FILE (IX=1,NY) (JY=1,NY) AT C NOMINAL MESHLENGTH MESHE. C 1 = WITHIN THE AREA; 0 = OUTSIDE. (INPUT) C SEALND(IX,JY) = THE SEA/LAND (IX=1,NX) (JY=1,NY) AT C NOMINAL MESHLENGTH MESHE. C 9 = LAND; VALUES BELOW WATER. (INPUT) C TELEV(IX,JY) = THE TERRAIN (IX=1,NX) (JY=1,NY) AT C NOMINAL MESHLENGTH MESHE. (INPUT) C NXE = X-EXTENT OF SEALND( ) AND CPNDFD( ) C AT MESH LENGTH MESHE. (INPUT) C NYE = Y-EXTENT OF SEALND( ) AND CPNDFD( ) C AT MESH LENGTH MESHE. (INPUT) C ITABLE(J,L,M) = HOLDS THE 2ND WORD IDS FOR UP TO JDIM C PREDICTORS (J=1,JDIM) FOR UP TO IDIM C EQUATIONS (M=1,IDIM) FOR LAND (L=1) AND C WATER (L=2). (INPUT) C RTABLE(J,L,M) = HOLDS THE JDIM COEFFICIENTS (J=1,JDIM) AND C THE CONSTANT (J=JDIM+1) FOR THE LAND (L=1) C AND WATER (L=2) EQUATION FOR IDIM EQUATIONS C (M=1,IDIM), EACH EQUATION PERTAINING TO A C DIFFERENT VARIABLE. (INPUT) C IDIM = THE MAXIMUM NUMBER OF PAIRS (LAND AND WATER) C EQUATIONS. (INPUT) C JDIM = THE MAXIMUM NUMBER OF TERMS IN THE EQUATIONS. C (INPUT) C M = THE NUMBER OF THE EQUATION. M WOULD VARY C WITH WEATHER ELEMENT. (INPUT) C ITERML = THE NUMBER OF TERMS IN THE LAND EQUATION C EVALUATED. (INPUT/OUTPUT) C ITERMW = THE NUMBER OF TERMS IN THE WATER EQUATION C EVALUATED. (INPUT/OUTPUT) C ISTOP = INCREMENTED BY 1 WHEN AN ERROR OCCURS. C (INPUT/OUTPUT) C IER = STATUS RETURN C 0 = GOOD. C 777 = CAN'T FIND TWO CLOSEST STATIONS WITHIN C DISTANCE R. C (OUTPUT) C DISTSQ = DISTANCE (IN GRID UNITS) SQUARED BETWEEN C A GRIDPOINT AND A STATION. (INTERNAL) C RL = THE THIRD PART OF THE ID WORD FOR LAND C EQUATIONS. THIS IS THE DISTANCE FROM THE LAND C GRIDPOINT TO DO THE SEARCH. (INTERNAL) C RW = THE THIRD PART OF THE ID WORD FOR WATER C EQUATIONS. THIS IS THE DISTANCE FROM THE WATER C GRIDPOINT TO DO THE SEARCH. (INTERNAL) C RLSQ = RL*RL+.01. (INTERNAL) C RWSQ = RW*RW+.01. (INTERNAL) C DD4 = DISTANCE TO THE CLOSEST CLOSEST. (INTERNAL) C DD5 = DISTANCE TO THE 2ND CLOSEST STATION. (INTERNAL) C IPRINT = COUNTS THE PRINTS OF #### PER CALL FOR LAND C POINTS. ONLY 5 ARE ALLOWED. (INTERNAL) C JPRINT = COUNTS THE PRINTS OF #### PER CALL FOR WATER C POINTS. ONLY 5 ARE ALLOWED. (INTERNAL) C RMULT = VALUE TO MUTIPLY BY THE RADIUS OF SEARCH FOR C SPARSE DATA REGION (INPUT) C IC = INDICATOR TO SHOW WHETHER THE RADIUS OF SEARCH C IS INCREASED C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES CALLED C NONE. C CHARACTER*8 CCALL(NSTA) C DIMENSION ID(4) DIMENSION XP(NSTA),YP(NSTA),LTAG(NSTA),LNDSEA(NSTA),ELEV(NSTA), 1 XLAPSE(NSTA),XDATA(NSTA) DIMENSION P(NX,NY),SVD2ND(NX,NY),NEARSV(NX,NY),SVD1ST(NX,NY), 1 ERROR(NX,NY) DIMENSION SEALND(NXE,NYE),TELEV(NXE,NYE),CPNDFD(NXE,NYE) DIMENSION ITABLE(JDIM,2,IDIM),RTABLE(JDIM+1,2,IDIM) C CALL TIMPR(KFILDO,KFILDO,'START CLOS2G ') C IER=0 IPRINT=0 JPRINT=0 IC=0 C IC INDICATES WHETHER RL/RW HAS BEEN INCREASED. C C THIS DEALS WITH BOTH WATER AND LAND EQUATIONS AND ALL TERMS C IN EACH EQUATION. ERROR( , ) IS ACCUMULATED FOR ALL TERMS C INVOLVING 0197, 0297, 1797, AND 1997 IN THE 2ND WORD. C D WRITE(KFILDO,100)(ID(JJ),JJ=1,4),JDIM,IDIM, D 1 ((ITABLE(J,L,M),J=1,JDIM),L=1,2) D100 FORMAT(/' AT 100 IN CLOS2G--ID,JDIM,IDIM,ITABLE',4I10,2I10,/, D 1 (10X,8I10)) C DO 110 J=1,JDIM C THERE ARE A MAXIMUM OF JDIM TERMS IN THE EQUATION. DO 109 L=1,2 C L=1 FOR LAND, 2 = WATER. C IF(ITABLE(J,L,M)/10000.EQ.0197.OR. 1 ITABLE(J,L,M)/10000.EQ.0297.OR. 2 ITABLE(J,L,M)/10000.EQ.1797.OR. 2 ITABLE(J,L,M)/10000.EQ.1897.OR. 3 ITABLE(J,L,M)/10000.EQ.1997)GO TO 115 C TRANSFER OUT IF THERE IS NO TERM FOR CLOS2G TO EVALUATE. 109 CONTINUE 110 CONTINUE C C DROP THROUGH HERE MEANS THERE IS NO VARIABLE TO EVALUATE C TO EVALUATE IN CLOS2G. GO TO 500 C C THERE IS AT LEAST ONE TERM TO EVALUATE. THIS ALWAYS C REQUIRES THE CLOSEST NEIGHBOR COMPUTATION. C C RETRIEVE THE MAXIMUM RL FROM THE EQUATION IDS FOR C LAND AND RW FOR WATER. C 115 IRL=0. IRW=0. C DO 117 J=1,JDIM IRL=MAX(IRL,ITABLE(J,1,M)-(ITABLE(J,1,M)/10000)*10000) IRW=MAX(IRW,ITABLE(J,2,M)-(ITABLE(J,2,M)/10000)*10000) 117 CONTINUE C RL=IRL RW=IRW RLSQ=RL*RL+.01 RWSQ=RW*RW+.01 C C ARE THE EXTENTS OF THE GRIDS COMPATIBLE? C IF(NXE.NE.NX.OR.NYE.NE.NY)THEN WRITE(KFILDO,120)NXE,NYE,NX,NY 120 FORMAT(/' ****NXE =',I5,' OR NYE =',I5, 1 ' DOES NOT MATCH NX =',I5,' OR NY =',I5, 2 ' AT 120 IN CLOS2G. FATAL ERROR.') ISTOP=ISTOP+1 IER=777 GO TO 500 ENDIF C !$OMP PARALLEL DO DEFAULT(SHARED) !$OMP& PRIVATE(IX,JY,K,SAV1,SAV2,LS1,LS2,DISTSQ,DD4,DD5) !$OMP& FIRSTPRIVATE(IC) C DO 200 JY=1,NY DO 199 IX=1,NX C IF(CPNDFD(IX,JY).LT..5)GO TO 199 C THIS IX,JY IS OUTSIDE THE CLIPPING AREA. SAV1=999999. SAV2=999999. C IF(SEALND(IX,JY).GT.8.5)THEN C C THIS SECTION EVALUATES LAND POINTS. C DO 162 K=1,NSTA IF(LNDSEA(K).LT.6)GO TO 162 C THIS IS A LAND GRIDPOINT, BUT A WATER STATION. C ALLOWS THE INLAND WATER/LAND MIX TO BE USED. IF(ABS(IX-XP(K)).GT.RL)GO TO 162 IF(ABS(JY-YP(K)).GT.RL)GO TO 162 C IN A LONG LIST OF STATIONS, THE ABOVE TWO TESTS SHOULD BE C MORE EFFICIENT THAN ALWAYS CALCULATING THE DISTANCE. C ALSO, THEY SHOULD RULE OUT MORE THAN THE TWO FOLLOWING C TESTS. IF(LTAG(K).NE.0)GO TO 162 C CHECKING LTAG(K) IS TANTAMOUNT TO CHECKING XDATA(K) C FOR MISSING, AND ACCOUNTS FOR ANY TOSSED STATIONS ON C THE LAST PASS. DISTSQ=(IX-XP(K))**2+(JY-YP(K))**2 C IF(DISTSQ.LT.RLSQ)THEN IF(SAV2.LE.DISTSQ)GO TO 162 IF(SAV1.GT.DISTSQ)GO TO 1611 SAV2=DISTSQ LS2=K GO TO 1613 C 1611 SAV2=SAV1 SAV1=DISTSQ LS2=LS1 LS1=K ENDIF C 1613 CONTINUE C THIS CONTINUE IS ONLY TO FURNISH A TRANSFER TO GET PRINT C BELOW. C D IF(IX.EQ.800.AND.JY.EQ.400)THEN D WRITE(KFILDO,1615)K,CCALL(K),IX,JY,DISTSQ,RLSQ,LS1,LS2, D 1 SAV1,SAV2 D1615 FORMAT(/,' AT 1615--K,CCALL(K),IX,JY,DISTSQ,RLSQ,LS1,LS2,', D 1 'SAV1,SAV2',I6,1X,A6,2I5,2F8.1,2I5,2F12.4) D ENDIF C 162 CONTINUE C C THIS SECTION SEARCHES ONE MORE TIME WITH A INCREASED RL C FOR SPARSE DATA REGIONS C IF(SAV1.GT.999998.9)THEN IC=1 C IC = 1 INDICATES RL HAS BEEN INCREASED. DO 163 K=1,NSTA IF(LNDSEA(K).LT.6)GO TO 163 C THIS IS A LAND GRIDPOINT, BUT A WATER STATION. C ALLOWS THE INLAND WATER/LAND MIX TO BE USED. IF(ABS(IX-XP(K)).GT.(RL*RMULT))GO TO 163 IF(ABS(JY-YP(K)).GT.(RL*RMULT))GO TO 163 C IN A LONG LIST OF STATIONS, THE ABOVE TWO TESTS SHOULD BE C MORE EFFICIENT THAN ALWAYS CALCULATING THE DISTANCE. C ALSO, THEY SHOULD RULE OUT MORE THAN THE TWO FOLLOWING C TESTS. IF(LTAG(K).NE.0)GO TO 163 C CHECKING LTAG(K) IS TANTAMOUNT TO CHECKING XDATA(K) C FOR MISSING, AND ACCOUNTS FOR ANY TOSSED STATIONS ON C THE LAST PASS. DISTSQ=(IX-XP(K))**2+(JY-YP(K))**2 C IF(DISTSQ.LT.((RLSQ-.01)*(RMULT)**2+.01))THEN IF(SAV2.LE.DISTSQ)GO TO 163 IF(SAV1.GT.DISTSQ)GO TO 1631 SAV2=DISTSQ LS2=K GO TO 163 C 1631 SAV2=SAV1 SAV1=DISTSQ LS2=LS1 LS1=K ENDIF C 163 CONTINUE ENDIF C IF(SAV1.GT.999998.9)THEN DD4=RL*RMULT DD5=RL*RMULT LS1=999999 IER=777 C COUNT MISSING CLOSEST STATION AS FATAL. ISTOP=ISTOP+1 WRITE(KFILDO,170)RL*RMULT,IX,JY 170 FORMAT(/,' ****CANNOT FIND CLOSEST LAND STATION IN', 1 ' CLOS2G WITHIN RADIUS R =',F6.1, 2 ' FOR GRIDPOINT IX,JY',2I6,'. FATAL ERROR.') ELSE DD4=SQRT(SAV1) C IF(SAV2.GT.999998.9)THEN C DO NOT COUNT MISSING 2ND CLOSEST STATION AS FATAL. IF(IC.EQ.0)THEN DD5=RL ELSE ISTOP=ISTOP+1 C IF(IPRINT.LE.5)THEN WRITE(KFILDO,171)RL*RMULT,IX,JY,(ID(JJ),JJ=1,4) 171 FORMAT(/,' ####CANNOT FIND 2ND CLOSEST LAND STATION', 1 ' IN CLOS2G WITHIN RADIUS R =',F6.1, 2 ' FOR GRIDPOINT IX,JY',2I6,'.',/, 3 ' DISTANCE USED AS R FOR 2ND CLOSEST', 4 ' STATION FOR VARIABLE', 5 3(1X,I9.9),1X,I10.3) ENDIF C IF(IPRINT.EQ.5)THEN WRITE(KFILDO,1712) 1712 FORMAT(' THIS IS THE LAST TIME THIS DIAGNOSTIC', 1 ' WILL PRINT FOR THIS CALL TO CLOS2G.') ENDIF C IPRINT=IPRINT+1 C DD5=RL*RMULT ENDIF C ELSE DD5=SQRT(SAV2) ENDIF C ENDIF C RESET IC IC=0 C ELSE C C THIS SECTION EVALUATES WATER POINTS. C SVD1ST(IX,JY)=RW SVD2ND(IX,JY)=RW NEARSV(IX,JY)=999999 C DO 172 K=1,NSTA IF(LNDSEA(K).GT.6)GO TO 172 C THIS IS A WATER GRIDPOINT, BUT A LAND STATION. C ALLOWS THE INLAND WATER/LAND MIX TO BE USED. IF(ABS(IX-XP(K)).GT.RW)GO TO 172 IF(ABS(JY-YP(K)).GT.RW)GO TO 172 C IN A LONG LIST OF STATIONS, THE ABOVE TWO TESTS SHOULD BE C MORE EFFICIENT THAN ALWAYS CALCULATING THE DISTANCE. C ALSO, THEY SHOULD RULE OUT MORE THAN THE TWO FOLLOWING C TESTS. IF(LTAG(K).NE.0)GO TO 172 DISTSQ=(IX-XP(K))**2+(JY-YP(K))**2 C IF(DISTSQ.LT.RWSQ)THEN IF(SAV2.LE.DISTSQ)GO TO 172 IF(SAV1.GT.DISTSQ)GO TO 1719 SAV2=DISTSQ LS2=K GO TO 172 C 1719 SAV2=SAV1 SAV1=DISTSQ LS2=LS1 LS1=K ENDIF C 172 CONTINUE C C THIS SECTION SEARCHES ONE MORE TIME WITH A INCREASED RW C FOR SPARSE DATA REGIONS C IF(SAV1.GT.999998.9)THEN IC=1 C IC = 1 INDICATES RW HAS BEEN INCREASED. DO 173 K=1,NSTA IF(LNDSEA(K).GT.6)GO TO 173 C THIS IS A WATER GRIDPOINT, BUT A LAND STATION. C ALLOWS THE INLAND WATER/LAND MIX TO BE USED. IF(ABS(IX-XP(K)).GT.(RW*RMULT))GO TO 173 IF(ABS(JY-YP(K)).GT.(RW*RMULT))GO TO 173 C IN A LONG LIST OF STATIONS, THE ABOVE TWO TESTS SHOULD BE C MORE EFFICIENT THAN ALWAYS CALCULATING THE DISTANCE. C ALSO, THEY SHOULD RULE OUT MORE THAN THE TWO FOLLOWING C TESTS. IF(LTAG(K).NE.0)GO TO 173 C CHECKING LTAG(K) IS TANTAMOUNT TO CHECKING XDATA(K) C FOR MISSING, AND ACCOUNTS FOR ANY TOSSED STATIONS ON C THE LAST PASS. DISTSQ=(IX-XP(K))**2+(JY-YP(K))**2 C IF(DISTSQ.LT.((RWSQ-.01)*(RMULT)**2+.01))THEN IF(SAV2.LE.DISTSQ)GO TO 173 IF(SAV1.GT.DISTSQ)GO TO 1731 SAV2=DISTSQ LS2=K GO TO 173 C 1731 SAV2=SAV1 SAV1=DISTSQ LS2=LS1 LS1=K ENDIF C 173 CONTINUE ENDIF C IF(SAV1.GT.999998.9)THEN DD4=RW*RMULT DD5=RW*RMULT LS1=999999 C DO NOT COUNT MISSING CLOSEST STATION AS FATAL OVER WATER. ISTOP=ISTOP+1 WRITE(KFILDO,180)RW*RMULT,IX,JY 180 FORMAT(/,' ****CANNOT FIND CLOSEST WATER STATION IN', 1 ' CLOS2G WITHIN RADIUS RW =',F6.1, 2 ' FOR GRIDPOINT IX,JY',2I6,'. SET TO 999999.') ELSE DD4=SQRT(SAV1) C IF(SAV2.GT.999998.9)THEN C DO NOT COUNT MISSING 2ND CLOSEST STATION AS FATAL. IF(IC.EQ.0)THEN DD5=RW ELSE ISTOP=ISTOP+1 C IF(JPRINT.LE.5)THEN WRITE(KFILDO,181)RW*RMULT,IX,JY,(ID(JJ),JJ=1,4) 181 FORMAT(/,' ####CANNOT FIND 2ND CLOSEST WATER STATION', 1 ' IN CLOS2G WITHIN RADIUS RW =',F6.1, 2 ' FOR GRIDPOINT IX,JY',2I6,'.',/, 3 ' DISTANCE USED AS R FOR 2ND CLOSEST', 4 ' STATION VARIABLE', 5 3(1X,I9.9),1X,I10.3) ENDIF C IF(JPRINT.EQ.5)THEN WRITE(KFILDO,1712) ENDIF C JPRINT=JPRINT+1 C DD5=RW*RMULT ENDIF C ELSE DD5=SQRT(SAV2) ENDIF C ENDIF C RESET IC IC=0 C ENDIF C C AT THIS POINT, DD4 HOLDS THE DISTANCE TO THE CLOSEST C STATION AND DD5 HOLDS THE DISTANCE TO THE 2ND CLOSEST C STATION FOR THE GRIDPOINT IX,JY, PROVIDED THE EQUATION BEING C EVALUATED MATCHES THE TYPE OF GRIDPOINT (LAND OR WATER). C SAVE DD4, DD5, AND THE LOCATION OF THE NEAREST STATION C IN SVD1ST( , ), SVD2ND( , ), AND NEARSV( , ), RESPECTIVELY. C A MISSING CLOSEST STATION HAS CAUSED AN ABORT WITH IER = 777. C THIS CANNOT BE TOLERATED, BECAUSE THE ELEVATION OF THE C CLOSEST STATION IS USED IN 1797 AND 1997. IF THE C 2ND CLOSEST STATION IS MISSING, THE DISTANCE TO IT HAS C BEEN SET TO THE RADIUS OF SEARCH. C SVD1ST(IX,JY)=DD4 SVD2ND(IX,JY)=DD5 NEARSV(IX,JY)=LS1 C 199 CONTINUE 200 CONTINUE C !$OMP END PARALLEL DO C IF(IER.EQ.777) GO TO 500 C THIS MAKES A RETURN WITH FATAL ERROR OF 777. C C EVALUATE VARIABLE 0197. C DO 400 J=1,JDIM C THERE ARE A MAXIMUM OF JDIM TERMS IN THE EQUATION. DO 399 L=1,2 C L=1 FOR LAND, 2 = WATER. MF=ITABLE(J,L,M)/10000 C MF IS THE VARIABLE BEING EVALUATED. C C NOW DO ACCUMULATIONS IN ERROR( , ) ACCORDING TO THE C VARIABLE IN MF. C IF(MF.EQ.0197)THEN C THIS IS THE CLOSEST NEIGHBOR DISTANCE. C IF(L.EQ.1)THEN ITERML=ITERML+1 ELSE ITERMW=ITERMW+1 ENDIF C !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(IX,JY) C DO 210 JY=1,NY DO 209 IX=1,NX IF(CPNDFD(IX,JY).LT..5)GO TO 209 C THIS IX,JY IS OUTSIDE THE CLIPPING AREA. IF(NEARSV(IX,JY).EQ.999999)THEN ERROR(IX,JY)=9999. GO TO 209 ENDIF C THE NEAREST STATION COULD NOT BE FOUND. C IF(L.EQ.1.AND.SEALND(IX,JY).GT.8.5.OR. 1 L.EQ.2.AND.SEALND(IX,JY).LT.8.5)THEN C ONLY APPLY THE LAND TERMS TO LAND AND WATER TERMS C TO WATER ERROR(IX,JY)=ERROR(IX,JY)+SVD1ST(IX,JY)*RTABLE(J,L,M) C D IF(IX.EQ.800.AND.JY.EQ.400)THEN D WRITE(KFILDO,205)J,L,M,IX,JY,SVD1ST(IX,JY),RTABLE(J,L,M), D 1 ERROR(IX,JY) D205 FORMAT(/,' AT 205 IN CLOS2G--J,L,M,IX,JY,SVD1ST(IX,JY),', D 1 'RTABLE(J,L,M),ERROR(IX,JY)',/, D 2 5I6,3F10.4) D ENDIF C ENDIF C 209 CONTINUE 210 CONTINUE C !$OMP END PARALLEL DO C D WRITE(KFILDO,211)(ERROR(800,JY),JY=1,NY) D211 FORMAT(/' AT 211 IN CLOS2G--(ERROR(800,JY),JY=1,NY)',/, D 1 (10F10.2)) ENDIF C C EVALUATE VARIABLE 0297. C IF(MF.EQ.0297)THEN C THIS IS THE 2ND CLOSEST NEIGHBOR DISTANCE. C IF(L.EQ.1)THEN ITERML=ITERML+1 ELSE ITERMW=ITERMW+1 ENDIF C !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(IX,JY) C DO 220 JY=1,NY DO 219 IX=1,NX IF(CPNDFD(IX,JY).LT..5)GO TO 219 C THIS IX,JY IS OUTSIDE THE CLIPPING AREA. IF(NEARSV(IX,JY).EQ.999999)THEN ERROR(IX,JY)=9999. GO TO 219 ENDIF C THE NEAREST STATION COULD NOT BE FOUND. C IF(L.EQ.1.AND.SEALND(IX,JY).GT.8.5.OR. 1 L.EQ.2.AND.SEALND(IX,JY).LT.8.5)THEN C ONLY APPLY THE LAND TERMS TO LAND AND WATER TERMS C TO WATER ERROR(IX,JY)=ERROR(IX,JY)+SVD2ND(IX,JY)*RTABLE(J,L,M) C D IF(IX.EQ.800.AND.JY.EQ.400)THEN D WRITE(KFILDO,215)J,L,M,IX,JY,SVD2ND(IX,JY),RTABLE(J,L,M), D 1 ERROR(IX,JY) D215 FORMAT(/,' AT 215 IN CLOS2G--J,L,M,IX,JY,SVD2ND(IX,JY),', D 1 'RTABLE(J,L,M),ERROR(IX,JY)',/, D 2 5I6,3F10.4) D ENDIF C ENDIF C 219 CONTINUE 220 CONTINUE C !$OMP END PARALLEL DO C D WRITE(KFILDO,221)(ERROR(800,JY),JY=1,NY) D221 FORMAT(/' AT 221 IN CLOS2G--(ERROR(800,JY),JY=1,NY)',/, D 1 (10F10.2)) C ENDIF C C EVALUATE VARIABLE 1797. C IF(MF.EQ.1797)THEN C THIS IS THE DIFFERENCE IN ELEVATION OF THE GRIDPOINT C AND THE CLOSEST STATION. C IF(L.EQ.1)THEN ITERML=ITERML+1 ELSE ITERMW=ITERMW+1 ENDIF C !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(IX,JY) C DO 230 JY=1,NY DO 229 IX=1,NX IF(CPNDFD(IX,JY).LT..5)GO TO 229 C THIS IX,JY IS OUTSIDE THE CLIPPING AREA. IF(NEARSV(IX,JY).EQ.999999)THEN ERROR(IX,JY)=9999. GO TO 229 ENDIF C THE NEAREST STATION COULD NOT BE FOUND. C IF(L.EQ.1.AND.SEALND(IX,JY).GT.8.5.OR. 1 L.EQ.2.AND.SEALND(IX,JY).LT.8.5)THEN C ONLY APPLY THE LAND TERMS TO LAND AND WATER TERMS C TO WATER ERROR(IX,JY)=ERROR(IX,JY)+ 1 ABS(TELEV(IX,JY)-ELEV(NEARSV(IX,JY)))*RTABLE(J,L,M) C D IF(IX.EQ.800.AND.JY.EQ.400)THEN D WRITE(KFILDO,225)J,L,M,IX,JY,TELEV(IX,JY), D 1 ELEV(NEARSV(IX,JY)), D 2 RTABLE(J,L,M),ERROR(IX,JY) D225 FORMAT(/,' AT 225 IN CLOS2G--J,L,M,IX,JY,TELEV(IX,JY),', D 1 'ELEV(NEARSV(IX,JY)),RTABLE(J,L,M),ERROR(IX,JY)',/, D 2 5I6,4F10.4) D ENDIF C ENDIF C 229 CONTINUE 230 CONTINUE C !$OMP END PARALLEL DO C D WRITE(KFILDO,231)(ERROR(800,JY),JY=1,NY) D231 FORMAT(/' AT 231 IN CLOS2G--(ERROR(800,JY),JY=1,NY)',/, D 1 (10F10.2)) C ENDIF C C EVALUATE VARIABLE 1997. C IF(MF.EQ.1997)THEN C THIS IS PRODUCT OF (THE DIFFERENCE IN ELEVATION OF THE C GRIDPOINT AND THE CLOSEST STATION) AND (THE DISTANCE TO C THE CLOSEST STATION). C IF(L.EQ.1)THEN ITERML=ITERML+1 ELSE ITERMW=ITERMW+1 ENDIF C !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(IX,JY) C DO 240 JY=1,NY DO 239 IX=1,NX IF(CPNDFD(IX,JY).LT..5)GO TO 239 C THIS IX,JY IS OUTSIDE THE CLIPPING AREA. IF(NEARSV(IX,JY).EQ.999999)THEN ERROR(IX,JY)=9999. GO TO 239 ENDIF C THE NEAREST STATION COULD NOT BE FOUND. C IF(L.EQ.1.AND.SEALND(IX,JY).GT.8.5.OR. 1 L.EQ.2.AND.SEALND(IX,JY).LT.8.5)THEN C ONLY APPLY THE LAND TERMS TO LAND AND WATER TERMS C TO WATER ERROR(IX,JY)=ERROR(IX,JY)+SVD1ST(IX,JY)* 1 ABS(TELEV(IX,JY)-ELEV(NEARSV(IX,JY)))*RTABLE(J,L,M) C D IF(IX.EQ.800.AND.JY.EQ.400)THEN D WRITE(KFILDO,235)J,L,M,IX,JY,TELEV(IX,JY), D 1 ELEV(NEARSV(IX,JY)), D 2 SVD1ST(IX,JY),RTABLE(J,L,M),ERROR(IX,JY) D235 FORMAT(/,' AT 235 IN CLOS2G--J,L,M,IX,JY,TELEV(IX,JY),', D 1 'ELEV(NEARSV(IX,JY)),SVD1ST(IX,JY),', D 2 'RTABLE(J,L,M),ERROR(IX,JY)',/, D 3 5I6,5F10.4) D ENDIF C ENDIF C 239 CONTINUE 240 CONTINUE C !$OMP END PARALLEL DO C D WRITE(KFILDO,241)(ERROR(800,JY),JY=1,NY) D241 FORMAT(/' AT 241 IN CLOS2G--(ERROR(800,JY),JY=1,NY)',/, D 1 (10F10.2)) C ENDIF C C EVALUATE VARIABLE 1897. C IF(MF.EQ.1897)THEN C THIS IS ABSOLUTE DIFFERENCE OF THE ANALYSIS POINT VALUE C AND THE VALUE FROM THE CLOSEST GRIDPOINT ADJUSTED FOR C ELEVATION DIFFERENCE AND LAPSE RATE. C IF(L.EQ.1)THEN ITERML=ITERML+1 ELSE ITERMW=ITERMW+1 ENDIF C !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(IX,JY,EST) C DO 250 JY=1,NY DO 249 IX=1,NX IF(CPNDFD(IX,JY).LT..5)GO TO 249 C THIS IX,JY IS OUTSIDE THE CLIPPING AREA. IF(NEARSV(IX,JY).EQ.999999)THEN ERROR(IX,JY)=9999. GO TO 249 ENDIF C THE NEAREST STATION COULD NOT BE FOUND. C IF(L.EQ.1.AND.SEALND(IX,JY).GT.8.5.OR. 1 L.EQ.2.AND.SEALND(IX,JY).LT.8.5)THEN C ONLY APPLY THE LAND TERMS TO LAND AND WATER TERMS C TO WATER EST=ABS(P(IX,JY)-(XDATA(NEARSV(IX,JY))+ 1 XLAPSE(NEARSV(IX,JY))*(TELEV(IX,JY)-ELEV(NEARSV(IX,JY))))) ERROR(IX,JY)=ERROR(IX,JY)+EST*RTABLE(J,L,M) C D IF(IX.EQ.800.AND.JY.EQ.400)THEN D WRITE(KFILDO,245)J,L,M,IX,JY, D 1 P(IX,JY),XDATA(NEARSV(IX,JY)), D 2 TELEV(IX,JY),ELEV(NEARSV(IX,JY)), D 3 XLAPSE(NEARSV(IX,JY)), D 4 RTABLE(J,L,M),ERROR(IX,JY) D245 FORMAT(/,' AT 245 IN CLOS2G--J,L,M,IX,JY,', D 1 'P(IX,JY),XDATA(NEARSV(IX,JY)),', D 2 'TELEV(IX,JY),ELEV(NEARSV(IX,JY)),', D 3 'XLAPSE(NEARSV(IX,JY)),', D 4 'RTABLE(J,L,M),ERROR(IX,JY)',/, D 5 5I6,7F10.4) D ENDIF C ENDIF C 249 CONTINUE 250 CONTINUE C !$OMP END PARALLEL DO C D WRITE(KFILDO,251)(ERROR(800,JY),JY=1,NY) D251 FORMAT(/' AT 251 IN CLOS2G--(ERROR(800,JY),JY=1,NY)',/, D 1 (10F10.2)) C ENDIF C 399 CONTINUE 400 CONTINUE C CALL TIMPR(KFILDO,KFILDO,'END CLOS2G ') C 500 RETURN END