SUBROUTINE VARI(KFILDO,CCALL,XP,YP,LTAG,LNDSEA,XDATA,NSTA,K, 1 R,VAR1,LIO,IER) C C NOVEMBER 2007 GLAHN MDL C NOVEMBER 2007 GLAHN 2ND EDITION C DECEMBER 2007 GLAHN MODIFIED FOR LIO AND DIFFERENT C DATA TYPES; MADE CHECK ON C XDATA( ).GT.999.5; EXCLUDED L=K; C VAR1 SET = 0 WHEN LTE 1 STATION C DECEMBER 2007 GLAHN SET VAR1=9999 WHEN LE 1 STATION C 12/20/07 6:00 A.M. C DECEMBER 2007 GLAHN MODIFIED TESTS FOR LIO ABOVE C DISTSQ= C JANUARY 2008 GLAHN USED TEMP( ) VICE IUSE( ) C FEBRUARY 2009 GLAHN ADDED TEST ON LNDSEA(L) BELOW D 162 C PULLED TEST ON LNDSEA(K) C C PURPOSE C TO COMPUTE A VARIABILITY VARIABLE AS THE MEAN ABSOLUTE C DIFFERENCE BETWEEN ALL STATION VALUES WITHIN A RADIUS R C OF A STATION AND THE AVERAGE OF THOSE SAME VALUES. IN C THE COMPUTATION, THE STATION ITSELF IS OMITTED. WHEN C THERE IS ONLY ONE STATION OR NONE WITHIN THE RADIUS, C THE RETURNED VALUE VAR1 = 9999. (THIS MAY BE C MODIFIED IN WTHOL2,). THIS IS CONSISTENT WITH C IMPLEMENTATION IN WHICH AT LEAST 2 STATIONS WITHIN R C OF A GRIDPOINT MUST BE FOUND. LIO CAN BE OF TYPE 0 OR 9. C FOR TYPE LIO = 0, USE STATION TYPES 0 AND 3; C = 9, USE STATION TYPES 6 AND 9. C C DATA SET USE C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) C C VARIABLES C INPUT C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. C CCALL(K) = CALL LETTERS OF STATIONS (K=1,NSTA). USED C ONLY FOR DIAGNOSTICS. (CHARACTER*8) (INPUT) C XP(J) = X-POSITION OF STATION J ON GRID (J=1,NSTA). C YP(J) = Y-POSITION OF STATION J ON GRID (J=1,NSTA). C LTAG(J) = DON'T USE THIS STATION IF LTAG( ) GT 0 C (J=1,NSTA). C LNDSEA(J) = LAND/SEA INFLUENCE FLAG FOR EACH STATION C (J=1,ND1). 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 XDATA(J) = THE DATA FOR WHICH TO FIND THE VARIABILITY C (J=1,ND1). C NSTA = NUMBER OF STATIONS IN LIST. C K = POSITION OF STATION IN LIST FOR WHICH THE C VARIABILITY IS DESIRED. C R = RADIUS OVER WHICH TO SEARCH. C LIO = THE VARIABLE TO SPECIFY WHETHER THIS RUN IS C FOR LAND (=9), INLAND WATER (=3), OR C OCEAN (=0) POINTS. C C OUTPUT C VAR1 = THE VARIABILITY VARIABLE (SEE PURPOSE). C IER = STATUS RETURN C 0 = GOOD. C C INTERNAL C DISTSQ = DISTANCE (IN GRID UNITS) SQUARED BETWEEN C TWO STATIONS. 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 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES CALLED C NONE. C CHARACTER*8 CCALL(NSTA) C DIMENSION XP(NSTA),YP(NSTA),LTAG(NSTA),LNDSEA(NSTA),XDATA(NSTA) DIMENSION TEMP(NSTA) C TEMP( ) IS AN AUTOMATIC ARRAY LARGE ENOUGH TO HOLD THE MAXIMUM C NUMBER OF POINTS. C D CALL TIMPR(KFILDO,KFILDO,'START VARI ') C IER=0 NCOUNT=0 VAR=0. RSQ=R*R+.01 C THE SMALL CONSTANT IS ADDED TO ASSURE A POINT IS NOT C ELIMINATED BECAUSE OF ROUNDOFF. VAR1=0. C DO 162 L=1,NSTA C D IF(CCALL(L).EQ.'KJBR ')THEN D WRITE(KFILDO,148)K,CCALL(K),L,CCALL(L), D 1 LTAG(L),LNDSEA(L),R,XDATA(L),LIO D148 FORMAT(/,' AT 148 IN VARI--K,CCALL(K),L,CCALL(L),', D 1 'LTAG(L),LNDSEA(L),R,XDATA(L),LIO', D 1 I6,2X,A8,I6,2X,A8,2I4,2F8.1,I3) D ENDIF C C DO CALCULATIONS ONLY FOR CORRECT TYPE OF STATION. C IF(LIO.EQ.9.AND.LNDSEA(L).LT.6)GO TO 162 IF(LIO.EQ.0.AND.LNDSEA(L).GT.3)GO TO 162 C IF(XDATA(L).GT.9998.5)GO TO 162 C DO NOT USE STATION WITH MISSING DATA. C IF(L.EQ.K)GO TO 162 C DO NOT USE STATION ITSELF. IN IMPLEMENTATION, THE C VARIABILITY AROUND A GRIDPOINT IS COMPUTED, AND A "STATION" C VALUE IS NOT AVAILABLE. C IF(ABS(XP(K)-XP(L)).GT.R)GO TO 162 IF(ABS(YP(K)-YP(L)).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 FOLLOWING TEST. IF(LTAG(L).GT.0)GO TO 162 C DISTSQ=(XP(K)-XP(L))**2+(YP(K)-YP(L))**2 C D IF(CCALL(L).EQ.'KJBR ')THEN D WRITE(KFILDO,149)K,CCALL(K),L,CCALL(L),DISTSQ,RSQ D149 FORMAT(/,' AT 149 IN VARI--K,CCALL(K),L,CCALL(L),DISTSQ,RSQ', D 1 I6,2X,A8,I6,2X,A8,2F8.1) D ENDIF C IF(DISTSQ.LT.RSQ)THEN VAR=VAR+XDATA(L) NCOUNT=NCOUNT+1 TEMP(NCOUNT)=XDATA(L) C D WRITE(KFILDO,150)K,CCALL(K),L,CCALL(L), D 1 XP(K),XP(L),YP(K),YP(L),VAR,NCOUNT D150 FORMAT(/,'AT 150 IN VARI--K,CCALL(K),L,CCALL(L),', D 1 'XP(K),XP(L),YP(K),YP(L),VAR,NCOUNT', D 2 I6,2X,A6,I6,1X,A6,5F7.1,I3) C ENDIF 162 CONTINUE C IF(NCOUNT.GT.1)THEN C WHEN NCOUNT = 1, THERE WILL BE ZERO VARIABILITY. C THIS DOES NOT GIVE A GOOD PICTURE, SO SET TO 9999. AVG=VAR/NCOUNT ELSE WRITE(KFILDO,170)R,CCALL(K) 170 FORMAT(/,' ####CANNOT FIND TWO STATIONS TO AVERAGE IN VARI ', 1 ' WITHIN RADIUS R =',F6.1,' FOR STATION ',A8, 2 'SET VAR1=9999. PROCEEDING.') VAR1=9999. GO TO 300 ENDIF C DO 262 L=1,NCOUNT C VAR1=VAR1+ABS(TEMP(L)-AVG) C D WRITE(KFILDO,260)TEMP(L),AVG,VAR1 D260 FORMAT(/' AT 260 IN VARI--TEMP(L),AVG,VAR1',3F8.1) C 262 CONTINUE C VAR1=VAR1/NCOUNT C D WRITE(KFILDO,265)VAR1,NCOUNT D265 FORMAT(/' AT 265 IN VARI--VAR1,NCOUNT',F8.2,I4) D CALL TIMPR(KFILDO,KFILDO,'END VARI ') C 300 RETURN END