SUBROUTINE DDRAD2(KFILDO,CCALL,XP,YP,LTAG,LTAGPT,
1 LNDSEA,XDATA,NSTA,ND1,R,IQUAL,
2 NPASS,NPASRR,LAUGBO,VRAD,IER)
C
C FEBRUARY 2019 GLAHN MDL
C COPIED FROM DDRAD
C APRIL 2019 CHANGED NPASR TO NPASRR
C
C PURPOSE
C
C TO ADJUST THE LAST PASS RADIUS OF EACH STATION TO 1
C GRIDLENGTH LESS THAN THE DISTANCE TO THE CLOSEST STATION,
C BUT NOT LESS THAN 0.8 AND FOR WATER NOT MORE THAN THE
C ORIGINAL RADIUS.
C
C TWO CLOSEST STATIONS ARE FOUND IN CASE THE 2ND
C CLOSEST IS NEEDED FOR SOME PURPOSE.
C
C ADAPTED FROM DDRAD.
C
C THE SEARCH ALGORITHM IS PATTERNED AFTER CLOS2.
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 CCALL(K) = CALL LETTERS OF STATIONS (K=1,NSTA).
C (CHARACTER*8) (INPUT)
C XP(J) = X-POSITION OF STATION J ON GRID (J=1,NSTA).
C (INPUT)
C YP(J) = Y-POSITION OF STATION J ON GRID (J=1,NSTA).
C (INPUT)
C LTAG(J) = DON'T USE THIS STATION IF LTAG( ) GT 0
C (J=1,NSTA). (INPUT)
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 0 = EVERYTHING ELSE
C LNDSEA(K) = LAND/SEA INFLUENCE FLAG FOR EACH STATION
C (K=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 (INPUT)
C XDATA(J) = THE DATUM FOR EACH STATION (J=1,ND1). (INPUT)
C NSTA = NUMBER OF STATIONS IN LIST. THIS DOES NOT
C INCLUDE ANY TYPE 4 BOGUS. (INPUT)
C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT
C WITH. (INPUT)
C R(J) = (R(J) J=1,6)= RADIUS READ FROM U405A.CN FILE.
C THE DEFAULT RADIUS OF INFLUENCE. (INPUT)
C IQUAL(K,I) = THE QUALITY VALUES FROM THE STATION DICTIONARY
C FOR FIVE POSSIBLE DATA TYPES (K=1,ND1) (I=1,5).
C (INPUT)
C NPASS = NUMBER OF ANALYSIS PASSES. (INPUT)
C NPASRR = NUMBER OF THE PASS TO START MODIFICATION
C OF RADII. (INPUT)
C LAUGBO = INDICATOR OF WHICH DATA TO USE IN CALCULATING
C RADII. VALUES CORRESPOND TO LATGPT( ).
C 0 = USE ONLY BASE DATA
C 1 = USE 1ST PASS AUGMENTED DATA
C 2 = USE ALL AUGMENTED DATA
C 3 = USE ALL DATA, AUGMENTED AND BOGUS
C (INPUT)
C VRAD(K,J) = ((VRAD(K,J), J=1,6), K=1,NSTA) HOLDS THE
C VARIABLE RADII (INPUT) THEN MODIFIED.
C (INPUT/OUTPUT)
C IER = STATUS RETURN
C 0 = GOOD.
C SAV1 = DISTANCE SQUARED TO CLOSEST STATION. (INTERNAL)
C SAV2 = DISTANCE SQUARED TO 2ND CLOSEST STATION.
C (INTERNAL)
C DISTSQ = DISTANCE (IN GRID UNITS) SQUARED BETWEEN TWO
C STATIONS. (INTERNAL)
C CCSTA1(K) = CALL LETTERS OF CLOSEST STATION. (CHARACTER)
C (INTERNAL)
C CCSTA2(K) = CALL LETTERS OF 2ND CLOSEST STATION.
C (CHARACTER) (INTERNAL)
C NSTA1(K) = THE NUMBER IN THE LIST OF THE CLOSEST STATION.
C (INTERNAL)
C NSTA2(K) = THE NUMBER IN THE LIST OF THE 2ND CLOSEST
C STATION. (INTERNAL)
C 1 2 3 4 5 6 7 X
C
C NONSYSTEM SUBROUTINES CALLED
C NONE.
C
CHARACTER*8 CCALL(ND1),CCSTA1,CCSTA2
C
DIMENSION XP(ND1),YP(ND1),LTAG(ND1),LNDSEA(ND1),XDATA(ND1),
1 LTAGPT(ND1),IQUAL(ND1,5)
DIMENSION CCSTA1(ND1),CCSTA2(ND1)
C CCSTA1( ) AND CCSTA2( ) ARE AUTOMATIC ARRAYS.
DIMENSION NSTA1(ND1),NSTA2(ND1)
C NSTA1( ) AND NSTA2( ) ARE AUTOMATIC ARRAYS.
DIMENSION VRAD(ND1,6)
DIMENSION R(6)
C
CALL TIMPR(KFILDO,KFILDO,'START DDRAD2 ')
C
IER=0
C
CCCC WRITE(KFILDO,105)NSTA,NPASS,NPASRR,LAUGBO,(R(J),J=1,6)
CCCC 105 FORMAT(/' IN DDRAD2--NSTA,NPASS,NPASRR,LAUGBO,',
CCCC 1 '(R(J),J=1,6)',4I3,6F6.2)
C
CCCC DO 1051 K=1,NSTA
CCCC WRITE(KFILDO,1050)CCALL(K),(IQUAL(K,J),J=1,5)
CCCC 1050 FORMAT(' STATIONS AND QUALITY FLAGS',/,
CCCC 1 (5X,A8,5I4))
CCCC 1051 CONTINUE
C
DO 150 K=1,NSTA
106 NCOUNT=0
C NCOUNT COUNTS THE NUMBER OF SEARCHES PER STATION.
C UPDATED IF RADIUS HAS TO BE INCREASED.
IF(XDATA(K).GT.9998.5)GO TO 150
C DO NOT USE STATION WITH MISSING DATA.
IF(LTAG(K).GT.0)GO TO 150
C DO NOT USE STATION WHEN LTAG( ) > 0.
RR=R(1)
C RR = SEARCH RADIUS.
C TEMPORARY VALUE OF R(1) IN CASE IT NEEDS TO BE INCREASED.
RSQ=RR*RR+.01
C THE SMALL CONSTANT IS ADDED TO ASSURE A POINT IS NOT
C MISSED BECAUSE OF ROUNDOFF.
110 SAV1=999999.
SAV2=999999.
CCSTA1(K)=' '
CCSTA2(K)=' '
NSTA1(K)=1
NSTA2(K)=1
C NSTA1( ) AND NSTA2( ) ARE SET TO 1 FOR SAFETY, AS THEY
C ARE USED AS INDICES.
C
120 DO 140 L=1,NSTA
IF(XDATA(L).GT.9998.5)GO TO 140
C DO NOT USE STATION WITH MISSING DATA.
IF(LTAG(L).GT.0)GO TO 140
C DO NOT USE STATION WHEN LTAG( ) > 0.
IF(ABS(XP(K)-XP(L)).GT.RR)GO TO 140
IF(ABS(YP(K)-YP(L)).GT.RR)GO TO 140
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 OTHER TESTS.
IF(L.EQ.K)GO TO 140
C THIS STATEMENT WON'T SCREEN OUT BUT ONE.
C
IF(LNDSEA(K).EQ.9.AND.LNDSEA(L).LE.3)GO TO 140
C TYPE 9 USES TYPES 9 AND 6.
C
IF(LNDSEA(K).EQ.3.AND.LNDSEA(L).NE.3)GO TO 140
C ONLY TYPE 3 IS USED WITH ONLY TYPE 3, NOT TYPE 6.
C THIS CHANGE MADE NOON 10/28/13.
C (THIS STATEMENT HAD "C" AND WAS REMOVED 11/17/13. THIS WOULD
C HAVE HAD THE EFFECT OF USING ALL STATIONS FOR TYPE 3.)
C
IF(LNDSEA(K).EQ.6.AND.LNDSEA(L).EQ.0)GO TO 140
CCCC IF(LNDSEA(K).EQ.6.AND.(LNDSEA(L).EQ.0.OR.LNDSEA(L).EQ.9))GO TO 140
C THIS CHANGE MADE 11/19/13
C TYPE 6 STATION WILL ACCEPT TYPES 3,6 AND 9.
C
IF(LNDSEA(K).EQ.0.AND.LNDSEA(L).GT.0)GO TO 140
C TYPE 0 ONLY USES TYPE 0.
C
C MAKE SURE ONLY STATIONS DESIGNATED BY LAUGBO ARE USED FOR
C NEIGHBORS. EACH TYPE OF STATION IS TREATED THE SAME
C FOR GETTING A NEIGHBOR. IT IS THE POTENTIAL NEIGHBOR THAT
C LAUGBO PERTAINS TO.
C
IF(LAUGBO.EQ.0)THEN
IF(LTAGPT(L).GT.0)GO TO 140
ELSEIF(LAUGBO.EQ.1)THEN
IF(LTAGPT(L).GT.1)GO TO 140
ELSEIF(LAUGBO.EQ.2)THEN
IF(LTAGPT(L).GT.2)GO TO 140
ENDIF
C
DISTSQ=(XP(K)-XP(L))**2+(YP(K)-YP(L))**2
C
IF(DISTSQ.LT.RSQ)THEN
IF(SAV2.LE.DISTSQ)GO TO 140
IF(SAV1.GT.DISTSQ)GO TO 130
SAV2=DISTSQ
CCSTA2(K)=CCALL(L)
NSTA2(K)=L
GO TO 140
C
130 SAV2=SAV1
CCSTA2(K)=CCSTA1(K)
NSTA2(K)=NSTA1(K)
SAV1=DISTSQ
CCSTA1(K)=CCALL(L)
NSTA1(K)=L
ENDIF
C
140 CONTINUE
C
IF(SAV2.GT.999998.5)THEN
C
D WRITE(KFILDO,142)CCALL(K)
D142 FORMAT(/,' ###CANNOT FIND TWO CLOSEST STATIONS TO =',A8,
D 1 ' IN DDRAD2.')
NCOUNT=NCOUNT+1
C
IF(NCOUNT.LT.5)THEN
RR=RR*2
RSQ=RR*RR+.01
C
CCCC WRITE(KFILDO,143)RR
CCCC 143 FORMAT(' INCREASE RADIUS OF SEARCH TO ',F7.1,
CCCC 1 ' GRIDLENGTHS.')
C
GO TO 110
ELSE
WRITE(KFILDO,144)
144 FORMAT(' DO NOT CHANGE RADIUS FOR THIS STATION.')
GO TO 150
ENDIF
C
ELSE
DIST1=SQRT(SAV1)
DIST2=SQRT(SAV2)
ENDIF
C
M=NPASS
C
C THE VARIABLE RADIUS IS A FUNCTION OF THE DISTANCE TO
C THE CLOSEST STATION.
C THIS IS FOR THE LAST PASS. THE STATION WILL NOT AFFECT
C THE GRID AT ANY OTHER STATION THAN ITSELF.
C
IF(LNDSEA(K).EQ.9)THEN
VRAD(K,M)=MAX(DIST1-1.,0.8)
C BECAUSE 0.8 IS GT 0.707, THE CLOSEST GRIDPONT WILL
C ALWAYS BE ADJUSTED. THIS IS A LAND STATION.
ELSE
VRAD(K,M)=MIN(MAX(DIST1-1.,0.8),VRAD(K,M))
C THIS IS A WATER STATION AND THE RADIUS IS NOT REDUCED
C BELOW WHAT IT WAS ORIGINALLY.
ENDIF
C
CCCC IF(CCALL(K).EQ.'PAMO '.OR.CCALL(K).EQ.'PASM ')THEN
CCCC WRITE(KFILDO,1450)K,CCALL(K),CCSTA1(K),CCSTA2(K),LNDSEA(K),
CCCC 1 DIST1,DIST2,
CCCC 1 (VRAD(K,J),J=1,6),LTAGPT(K)
CCCC 1450 FORMAT(' AT 1450--K,CCALL(K),CCSTA1(K),CCSTA2(K),LNDSEA(K),',
CCCC 1 'DIST1,DIST2,',
CCCC 1 '(VRAD(K,J),J=1,6)',I6,2X,A8,2X,A8,2X,A8,I2,8F7.1,I2)
CCCC ENDIF
C
150 CONTINUE
C
CCC WRITE(KFILDO,159)(K,CCALL(K),XDATA(K),LTAG(K),LTAGPT(K),
CCC 1 (VRAD(K,M),M=1,6),K=1,NSTA)
CCC 159 FORMAT(/' AT 159 IN DDRAD2--K,CCALL(K),XDATA(K),LTAG(K),LTAGPT(K),'
CCC 1 ,'(VRAD(K,M),M=1,6)',/,(I6,2X,A8,F8.1,2I4,6F8.2))
C
CALL TIMPR(KFILDO,KFILDO,'END DDRAD2 ')
RETURN
END