SUBROUTINE VARIG(KFILDO,ID,CCALL,XP,YP,LTAG,LNDSEA,XDATA,NSTA,
1 ERROR,NX,NY,CPNDFD,SEALND,NXE,NYE,
2 ITABLE,RTABLE,IDIM,JDIM,M,RELVAR,VARTAB,
3 ITERML,ITERMW,RMULT,ISTOP,IER)
C
C DECEMBER 2007 GLAHN MDL
C JANUARY 2008 GLAHN ADDED ITERML,ITERMW,JTERML,JTERMW
C JANUARY 2008 GLAHN REMOVED MF; MOVED VAR1=0
C JANUARY 2008 GLAHN DIAGNOSTIC ADDED
C FEBRUARY 2008 GLAHN CHANGED JTERM TO ITERM, L AND W
C MARCH 2008 COSGROVE ADDED COMMAS TO FORMAT 163 AND
C 173 FOR IBM COMPILE
C FEBRUARY 2009 GLAHN ADDED TO PURPOSE; CHANGED
C IF(LNDSEA(K).LT.6) TO GT AND
C INCREASED RSQW + .01 AT 170
C MARCH 2009 GLAHN ADDED VARI=0 ABOVE DO 182
C MARCH 2009 GLAHN CHANGED IF(LTAG(K).GT.0) TO
C IF(LTAG(K).NE.0) IN TWO PLACES
C MARCH 2009 GLAHN CHANGED 2ND WORD STRUCTURE AND
C OTHER STUFF
C APRIL 2009 GLAHN INSERT MISSING WHEN 2 POINTS NOT
C FOUND AND PROCEED; ADDED ICOUNT
C JULY 2010 SCALLION OPEN MP STATEMENTS PUT IN IN
C 2 PLACES; SPELL CHECK; COMMENTS;
C ELIMINATED "SAVE IFIRST"
C SEPTEMBER 2011 IM/GLAHN INSERTED GO TO 199 IN DO 1635
C AND 1735 LOOPS
C NOVEMBER 2011 IM/GLAHN ADDED RMULT TO CALL;
C MODIFIED COMMENTS; ADDED IB=2
C PROCEDURES
C
C PURPOSE
C TO ACCUMULATE THE ANALYSIS ERROR IN ERROR( , ) FOR
C THE TERMS IN THE ERROR ESTIMATION EQUATIONS INVOLVING
C THE DATA VARIABILITY. IT DEALS SEPARATELY WITH BOTH LAND
C AND WATER EQUATIONS AND GRIDPOINTS. THE ERROR( , )
C IS ACCUMULATED FOR ALL TERMS INVOLVING 0997XXXX, 1097XXXX,
C 1197XXXX, OR 1297XXXX, WHERE XXXX IS A RADIUS R:
C
C 09970055 = AVERAGE OF THE ABSOLUTE VALUES OF THE
C DIFFERENCES BETWEEN THE DATA VALUES AND THEIR
C MEAN WITHIN 55 GRIDLENGTHS OF THE GRIDPOINT;
C 10970045 = AVERAGE OF THE ABSOLUTE VALUES OF THE
C DIFFERENCES BETWEEN THE DATA VALUES AND THEIR
C MEAN WITHIN 45 GRIDLENGTHS OF THE GRIDPOINT;
C 11970035 = AVERAGE OF THE ABSOLUTE VALUES OF THE
C DIFFERENCES BETWEEN THE DATA VALUES AND THEIR
C MEAN WITHIN 35 GRIDLENGTHS OF THE GRIDPOINT;
C AND
C 12970027 = AVERAGE OF THE ABSOLUTE VALUES OF THE
C DIFFERENCES BETWEEN THE DATA VALUES AND THEIR
C MEAN WITHIN 27 GRIDLENGTHS OF THE GRIDPOINT.
C
C THE VALUES 55, 45, 35, AND 27 ARE EXAMPLES AND COULD BE
C DIFFERENT.
C
C THE VARIABILITY VARIABLE IS COMPUTED WITHIN RADIUS R OF
C EACH GRIDPOINT WITHIN THE NDFD CLIPPING AREA AS
C THE MEAN ABSOLUTE DIFFERENCE BETWEEN ALL STATION VALUES
C WITHIN THE RADIUS R AND THE AVERAGE OF THOSE SAME VALUES.
C THE STATION AND GRIDPOINT MUST BE OF THE SAME TYPE, EITHER
C 9 FOR LAND OR NOT (INLAND AND OCEAN ARE LUMPED TOGETHER).
C
C NOTE THAT WHEN THERE IS ONLY ONE STATION OR NONE WITHIN
C THE RADIUS, A BACKUP RADIUS IS USED FROM
C RELVAR(JJ)*VARTAB(L). ONLY WHEN THE LARGEST VALUE
C CANNOT YIELD TWO CLOSEST STATIONS DOES A POINT GET SET
C TO MISSING. THIS DOES NOT CAUSE AN ERROR RETURN.
C
C THE RADIUS OF SEARCH IS TAKEN FROM THE 2ND WORD OF THE
C EQUATION OR A BACKUP IS USED. THE LARGEST BACKUP VALUE
C SHOULD USUALLY BE LARGE ENOUGH UNLESS THERE ARE
C SIGNIFICANT MISSING DATA.
C
C OPEN MP ISTOP AND IER ARE NOT IN THE OPEN MP LOOP.
C IFIRST COULD BE CONFLICTED, BUT WOULD NOT HURT OPERATION.
C IT COULD CAUSE TWO OR MORE DIAGNOSTICS TO PRINT
C INSTEAD OF ONE.
C ICOUNT AND JCOUNT COULD BE CONFLICTED, BUT THEY ONLY
C CONTROL DIAGNOSTICS AT THE END AND IT IS NOT
C CRUCIAL THEY BE EXACT.
C
C DATA SET USE
C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT)
C
C VARIABLES
C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT)
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 (J=1,NSTA).
C (INPUT)
C YP(K) = Y-POSITION OF STATION K ON GRID (J=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 WATER (=0)
C GRIDPOINTS.
C 3 = WILL BE USED FOR ONLY WATER (=3)
C GRIDPOINTS.
C 6 = WILL BE USED FOR BOTH INLAND WATER (=3)
C AND LAND (=9) GRIDPOINTS. THESE ARE
C VERY RARE AND ARE LUMPED WITH WATER.
C 9 = WILL BE USED FOR ONLY LAND (=9) GRIDPOINTS.
C NOTE: ALL WATER STATIONS, INCLUDING
C LNDSEA( ) = 6, ARE GROUPED INTO ONE WATER
C CATEGORY.
C (INPUT)
C XDATA(K) = THE DATA FOR WHICH TO FIND THE VARIABILITY
C (K=1,NSTA). (INPUT)
C NSTA = NUMBER OF STATIONS IN LIST. (INPUT)
C ERROR(IX,JY) = HOLDS THE ACCUMULATED ERROR (IX=1,NY) (JY=1,NY).
C (INPUT/OUTPUT)
C NX = THE SIZE OF THE ERROR( , ) GRID IN THE X
C DIRECTION. (INPUT)
C NY = THE SIZE OF THE ERROR( , ) GRID IN THE Y
C DIRECTION. (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 NXE = X-EXTENT OF SEALND( ), AND CPNDFD( )
C AT MESH LENGTH MESHE. MUST = NX. (INPUT)
C NYE = Y-EXTENT OF SEALND( ), AND CPNDFD( )
C AT MESH LENGTH MESHE. MUST = NY. (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 RELVAR(J) = THE RADII OVER WHICH TO COMPUTE THE WEIGHTED
C VARIABILITY (J=1,4). (INPUT)
C VARTAB(J) = THE FACTOR TO INCREASE RELVAR( ) FOR LAND (J=1)
C AND WATER (J=2). (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 = EXTENT OF GRIDS DON'T MATCH.
C (OUTPUT)
C DISTSQ = DISTANCE (IN GRID UNITS) SQUARED BETWEEN
C A GRIDPOINT AND A STATION. (INTERNAL)
C R = THE THIRD PART OF THE ID WORD. THIS IS THE
C DISTANCE FROM THE GRIDPOINT TO DO THE SEARCH.
C (INTERNAL)
C VAR1 = THE VARIABILITY VARIABLE (SEE PURPOSE).
C (INTERNAL)
C JCOUNT = COUNTS THE NUMBER OF TIMES A RADIUS HAD TO BE
C INCREASED IN THIS FOR THIS VARIABLE. (INTERNAL)
C TEMP(J) = AN ARRAY TO HOLD STATION VALUES USED IN
C CREATING THE AVERAGE AND VARIATION. THIS
C KEEPS FROM MAKING A SECOND SEARCH (J=1,NSTA).
C (AUTOMATIC) (INTERNAL)
C ICOUNT = COUNTS THE NUMBER OF GRIDPOINTS SET TO MISSING.
C (INTERNAL)
C IFIRST = CONTROLS DIAGNOSTICS AT 163 AND 173 SO ONE OR
C THE OTHER WILL BE PRINTED ONLY ONCE. (INTERNAL)
C RMULT = VALUE TO MUTIPLY BY THE RADIUS OF SEARCH FOR
C SPARSE DATA REGION (INPUT)
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),XDATA(NSTA)
DIMENSION ERROR(NX,NY)
DIMENSION SEALND(NXE,NYE),CPNDFD(NXE,NYE)
DIMENSION ITABLE(JDIM,2,IDIM),RTABLE(JDIM+1,2,IDIM)
DIMENSION RELVAR(4),VARTAB(2)
DIMENSION TEMP(NSTA)
C TEMP( ) IS AN AUTOMATIC ARRAY LARGE ENOUGH TO HOLD THE MAXIMUM
C NUMBER OF POINTS.
C
CALL TIMPR(KFILDO,KFILDO,'START VARIG ')
C
IER=0
IFIRST=0
ICOUNT=0
C ICOUNT COUNTS THE NUMBER OF POINTS SET TO MISSING.
IB=0
C IB = 1: INDICATES WHETHER A BACKUP VALUE OF RELVAR( ) HAS BEEN
C USED.
C IB = 2: INDICATES WHETHER R HAS BEEN INCREASED TO R*RMULT.
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 0997, 1097, 1197, OR 1297 IN THE 2ND WORD.
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.
C
IF(ITABLE(J,L,M)/10000.NE.0997.AND.
1 ITABLE(J,L,M)/10000.NE.1097.AND.
2 ITABLE(J,L,M)/10000.NE.1197.AND.
3 ITABLE(J,L,M)/10000.NE.1297)GO TO 399
C TRANSFER OUT IF THIS TERM IS NOT A VARIABILITY
C PREDICTOR.
C
C THIS IS A TERM TO EVALUATE.
C
IF(L.EQ.1)THEN
ITERML=ITERML+1
ELSE
ITERMW=ITERMW+1
ENDIF
C
C RETRIEVE R FROM THE ID.
C
R=ITABLE(J,L,M)-(ITABLE(J,L,M)/10000)*10000
C R IS THE DISTANCE TO DO THE SEARCH, TAKEN FROM THE ID.
RSQ=R*R+.01
C THE SMALL CONSTANT IS ADDED TO ASSURE A POINT IS NOT
C ELIMINATED BECAUSE OF ROUNDOFF, AND TO BE CONSISTENT WITH
C CLOS2
JCOUNT=0
C JCOUNT COUNTS THE NUMBER OF TIMES A RADIUS HAD TO BE
C INCREASED FOR THIS VARIABLE.
C
IF(NXE.NE.NX.OR.NYE.NE.NY)THEN
WRITE(KFILDO,101)NXE,NYE,NX,NY
101 FORMAT(/' ****NXE =',I5,' OR NYE =',I5,
1 ' DOES NOT MATCH NX =',I5,' OR NY =',I5,
2 ' AT 101 IN VARIG. FATAL ERROR.')
ISTOP=ISTOP+1
IER=777
GO TO 500
ENDIF
C
!$OMP PARALLEL DO DEFAULT(SHARED)
!$OMP& PRIVATE(IX,JY,K,DISTSQ,TEMP,VAR,
!$OMP& NCOUNT,AVG,JJ,VAR1,ERR,IXY)
!$OMP& FIRSTPRIVATE(IB,R,RSQ)
C
DO 200 JY=1,NY
DO 199 IX=1,NX
C
IF(CPNDFD(IX,JY).LT..5)GO TO 199
C THIS GRIDPOINT IS OUTSIDE THE CLIPPING AREA.
C
C A POINT COULD HAVE BEEN SET TO MISSING.
C
IF(NINT(ERROR(IX,JY)).EQ.9999)GO TO 199
C
NCOUNT=0
VAR=0.
C
IF(L.EQ.1.AND.SEALND(IX,JY).GT.8.5)THEN
C
C THIS SECTION EVALUATES LAND POINTS.
C
120 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.
C
IF(ABS(IX-XP(K)).GT.R)GO TO 162
IF(ABS(JY-YP(K)).GT.R)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.RSQ)THEN
VAR=VAR+XDATA(K)
NCOUNT=NCOUNT+1
TEMP(NCOUNT)=XDATA(K)
C SAVE THE VALUES SO A SEARCH WON'T HAVE TO BE
C MADE AGAIN.
C
CD IF(IX.EQ.300.AND.JY.EQ.400)THEN
CD WRITE(KFILDO,160)K,CCALL(K),IX,JY,DISTSQ,RSQ,XDATA(K),
CD 1 VAR,NCOUNT
CD160 FORMAT(/,' AT 160--K,CCALL(K),IX,JY,DISTSQ,RSQ,',
CD 1 'XDATA(K),VAR,NCOUNT',
CD 2 I6,1X,A8,2I6,2F8.1,2F8.2,I3)
CD ENDIF
C
ENDIF
162 CONTINUE
C
IF(NCOUNT.GT.1)THEN
C WHEN NCOUNT = 1, THERE WOULD BE ZERO VARIABILITY.
C THIS WOULD NOT GIVE A GOOD PICTURE, SO USE A LARGER
C RADIUS UNLESS ALREADY AT A MAXIMUM.
AVG=VAR/NCOUNT
ELSE
C
IF(IFIRST.EQ.0)THEN
WRITE(KFILDO,163)R,IX,JY
163 FORMAT(/,' ####CANNOT FIND TWO STATIONS TO AVERAGE IN',
1 ' VARIG WITHIN RADIUS R =',F5.1,' FOR',
2 ' GRIDPOINT IX,JY',2I5,'. A LARGER RADIUS',
3 ' WILL BE TRIED IN LAND.',/,
4 ' THIS DIAGNOSTIC WILL NOT PRINT AGAIN.')
IFIRST=1
ENDIF
C
DO 1635 JJ=4,1,-1
C
IF(NINT(R).LE.NINT(RELVAR(JJ)*VARTAB(L)))THEN
C
IF(JJ.EQ.1)THEN
IB=2
C IB = 2 INDICATES R HAS BEEN INCREASED WITH RMULT.
R=R*RMULT
RSQ=R*R+.01
NCOUNT=0
VAR=0.
JCOUNT=JCOUNT+1
GO TO 120
ELSE
IB=1
C IB = 1 INDICATES R HAS BEEN INCREASED WITH RELVAR.
R=RELVAR(JJ-1)*VARTAB(L)
RSQ=R*R+.01
NCOUNT=0
VAR=0.
JCOUNT=JCOUNT+1
C
CD WRITE(KFILDO,1634)IX,JY,R,RSQ
CD1634 FORMAT(/,' AT 1634 IN VARIG--IX,JY,R,RSQ',2I5,2F10.2)
C
GO TO 120
ENDIF
C
ELSE
IF(IB.EQ.2)THEN
WRITE(KFILDO,1633)IX,JY
1633 FORMAT(' *****LAND POINT IX, JY =',2I6,' CANNOT BE',
1 ' EVALUATED AND SET TO MISSING IN VARIG.',
2 ' MAY MEAN MISSING DATA',
3 ' IN THE ANALYSIS.')
ERROR(IX,JY)=9999.
ICOUNT=ICOUNT+1
GO TO 199
ENDIF
ENDIF
C
1635 CONTINUE
C
ENDIF
C
IF(IB.NE.0)THEN
C A LARGER VALUE OF R HAS BEEN USED THAN THE ID SPECIFIES.
C THEREFORE, RESET R AND RSQ TO THE CORRECT VALUES.
R=ITABLE(J,L,M)-(ITABLE(J,L,M)/10000)*10000
C R IS THE DISTANCE TO DO THE SEARCH, TAKEN FROM THE ID.
RSQ=R*R+.01
C THE SMALL CONSTANT IS ADDED TO ASSURE A POINT IS NOT
C ELIMINATED BECAUSE OF ROUNDOFF, AND TO BE CONSISTENT WITH
C CLOS2
IB=0
C
CD WRITE(KFILDO,1636)IX,JY,R,RSQ
CD1636 FORMAT(' AT 1636 IN VARIG--IX,JY,R,RSQ',2I5,2F10.2)
C
ENDIF
C
VAR1=0.
C
DO 164 IXY=1,NCOUNT
VAR1=VAR1+ABS(TEMP(IXY)-AVG)
C
CD IF(IX.EQ.300.AND.JY.EQ.400)THEN
CD WRITE(KFILDO,1637)J,L,M,IX,JY,VAR1,XDATA(K),AVG
CD1637 FORMAT(/,' AT 1637 IN VARIG--J,L,M,IX,JY,VAR1,',
CD 1 'TEMP(IXY),AVG',/,5I6,3F10.4)
CD ENDIF
C
164 CONTINUE
C
ERR=VAR1/NCOUNT
C NCOUNT HAS BEEN PREVIOUSLY CHECKED FOR GT 1.
ERROR(IX,JY)=ERROR(IX,JY)+ERR*RTABLE(J,L,M)
C
CD IF(IX.EQ.300.AND.JY.EQ.400)THEN
CD WRITE(KFILDO,165)J,L,M,IX,JY,ERR,RTABLE(J,L,M),
CD 1 ERROR(IX,JY)
CD165 FORMAT(/,' AT 165 IN VARIG--J,L,M,IX,JY,ERR,',
CD 1 'RTABLE(J,L,M),ERROR(IX,JY)',/,
CD 2 5I6,3F10.4)
CD ENDIF
C
ELSEIF(L.EQ.2.AND.SEALND(IX,JY).LT.8.5)THEN
C
C THIS SECTION EVALUATES WATER POINTS.
C
170 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.
C
IF(ABS(IX-XP(K)).GT.R)GO TO 172
IF(ABS(JY-YP(K)).GT.R)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
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.RSQ)THEN
VAR=VAR+XDATA(K)
NCOUNT=NCOUNT+1
TEMP(NCOUNT)=XDATA(K)
C SAVE THE VALUES SO A SEARCH WON'T HAVE TO BE
C MADE AGAIN.
ENDIF
172 CONTINUE
C
IF(NCOUNT.GT.1)THEN
C WHEN NCOUNT = 1, THERE WOULD BE ZERO VARIABILITY.
C THIS WOULD NOT GIVE A GOOD PICTURE, SO USE A LARGER
C RADIUS UNLESS ALREADY AT A MAXIMUM.
AVG=VAR/NCOUNT
ELSE
C
IF(IFIRST.EQ.0)THEN
WRITE(KFILDO,173)R,IX,JY
173 FORMAT(/,' ####CANNOT FIND TWO STATIONS TO AVERAGE IN',
1 ' VARIG WITHIN RADIUS R =',F5.1,' FOR',
2 ' GRIDPOINT IX,JY',2I5,'. A LARGER RADIUS',
3 ' WILL BE TRIED IN WATER.',/,
4 ' THIS DIAGNOSTIC WILL NOT PRINT AGAIN.')
IFIRST=1
ENDIF
C
DO 1735 JJ=4,1,-1
C
IF(NINT(R).LE.NINT(RELVAR(JJ)*VARTAB(L)))THEN
C
IF(JJ.EQ.1)THEN
IB=2
C IB = 2 INDICATES R HAS BEEN INCREASED WITH RMULT.
R=R*RMULT
RSQ=R*R+.01
NCOUNT=0
VAR=0.
JCOUNT=JCOUNT+1
GO TO 170
ELSE
IB=1
C IB = 1 INDICATES R HAS BEEN INCREASED WITH RELVAR.
R=RELVAR(JJ-1)*VARTAB(L)
RSQ=R*R+.01
NCOUNT=0
VAR=0.
JCOUNT=JCOUNT+1
C
CD WRITE(KFILDO,1734)IX,JY,R,RSQ
CD1734 FORMAT(/,' AT 1734 IN VARIG--IX,JY,R,RSQ',2I5,2F10.2)
C
GO TO 170
ENDIF
C
ELSE
IF(IB.EQ.2)THEN
WRITE(KFILDO,1733)IX,JY
1733 FORMAT(' *****WATER POINT IX, JY =',2I6,' CANNOT BE',
1 ' EVALUATED AND SET TO MISSING IN VARIG.',
2 ' MAY MEAN MISSING DATA',
3 ' IN THE ANALYSIS.')
ERROR(IX,JY)=9999.
ICOUNT=ICOUNT+1
GO TO 199
ENDIF
ENDIF
C
1735 CONTINUE
C
ENDIF
C
IF(IB.NE.0)THEN
C A LARGER VALUE OF R HAS BEEN USED THAN THE ID SPECIFIES.
C THEREFORE, RESET R AND RSQ TO THE CORRECT VALUES.
R=ITABLE(J,L,M)-(ITABLE(J,L,M)/10000)*10000
C R IS THE DISTANCE TO DO THE SEARCH, TAKEN FROM THE ID.
RSQ=R*R+.01
C THE SMALL CONSTANT IS ADDED TO ASSURE A POINT IS NOT
C ELIMINATED BECAUSE OF ROUNDOFF, AND TO BE CONSISTENT WITH
C CLOS2
IB=0
C
CD WRITE(KFILDO,1737)IX,JY,R,RSQ
CD1737 FORMAT(' AT 1737 IN VARIG--IX,JY,R,RSQ',2I5,2F10.2)
C
ENDIF
C
VAR1=0.
C
DO 182 IXY=1,NCOUNT
VAR1=VAR1+ABS(TEMP(IXY)-AVG)
182 CONTINUE
C
ERR=VAR1/NCOUNT
C NCOUNT HAS BEEN PREVIOUSLY CHECKED FOR GT 1.
ERROR(IX,JY)=ERROR(IX,JY)+ERR*RTABLE(J,L,M)
C
CD IF(IX.EQ.300.AND.JY.EQ.400)THEN
CD WRITE(KFILDO,185)J,L,M,IX,JY,ERR,RTABLE(J,L,M),
CD 1 ERROR(IX,JY)
CD185 FORMAT(/,' AT 185 IN VARIG--J,L,M,IX,JY,ERR,',
CD 1 'RTABLE(J,L,M),ERROR(IX,JY)',/,
CD 2 5I6,3F10.4)
CD ENDIF
C
ENDIF
C
199 CONTINUE
200 CONTINUE
C
!$OMP END PARALLEL DO
C
C WRITE RESULTS OF RADII INCREASE. THE SPECIFIC LINE
C SPACING FOR EASY READING IS NOT REPEATED IN VARILG
C AND VARIWG. IT IS ASSUMED IF AUGMENTATION FOR RADII
C IS NEEDED THERE, IT IS NEEDED HERE. THE PRINT
C OCCURS IN ANY CASE, JUST THE DOUBLE SPACING MAY
C NOT BE AS PLEASING.
C
IF(L.EQ.1)THEN
MCOUNT=JCOUNT
C
IF(MCOUNT.NE.0)THEN
WRITE(KFILDO,205)
205 FORMAT(' ')
ENDIF
C
IF(JCOUNT.EQ.0)THEN
WRITE(KFILDO,250)ID(1),ITABLE(J,L,M)
250 FORMAT('THE RADIUS OF SEARCH DID NOT HAVE TO BE',
1 ' INCREASED IN VARIG FOR THIS VARIABLE ',2I10,
2 ' FOR LAND POINTS.')
ELSE
WRITE(KFILDO,251)JCOUNT,ID(1),ITABLE(J,L,M)
251 FORMAT('THE RADIUS OF SEARCH HAD TO BE INCREASED',
1 I8,' TIMES IN VARIG FOR THIS VARIABLE ',2I10,
2 ' FOR LAND POINTS.')
ENDIF
C
ELSE
C
IF(MCOUNT.EQ.0.AND.JCOUNT.NE.0)THEN
WRITE(KFILDO,205)
ENDIF
C
IF(JCOUNT.EQ.0)THEN
WRITE(KFILDO,260)ID(1),ITABLE(J,L,M)
260 FORMAT('THE RADIUS OF SEARCH DID NOT HAVE TO BE',
1 ' INCREASED IN VARIG FOR THIS VARIABLE ',2I10,
2 ' FOR WATER POINTS.')
ELSE
WRITE(KFILDO,261)JCOUNT,ID(1),ITABLE(J,L,M)
261 FORMAT('THE RADIUS OF SEARCH HAD TO BE INCREASED',
1 I8,' TIMES IN VARIG FOR THIS VARIABLE ',2I10,
2 ' FOR WATER POINTS.')
ENDIF
C
ENDIF
C
399 CONTINUE
400 CONTINUE
C
IF(ICOUNT.GT.0)THEN
WRITE(KFILDO,410)ICOUNT
410 FORMAT(/' ####NUMBER OF POINTS SET TO MISSING IN VARIG =',I9)
ENDIF
C
CALL TIMPR(KFILDO,KFILDO,'END VARIG ')
C
500 RETURN
END