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