SUBROUTINE DDRAD2(KFILDO,CCALL,XP,YP,LTAG,LTAGPT,
1 LNDSEA,XDATA,NSTA,ND1,R,IQUAL,
2 NPASS,NPASRR,LAUGBO,MIXWL,MIXAB,VRAD,IER)
C
C FEBRUARY 2019 GLAHN MDL
C COPIED FROM DDRAD
C APRIL 2019 GLAHN CHANGED NPASR TO NPASRR
C DECEMBER 2019 GLAHN CHANGED CALCULATION FOR LAND,
C LIMITS RADIUS TO VRAD( ,NPASS)
C FEBRUARY 2020 GLAHN ADDED MIXWL AND MIXAB TO CALL;
C ELIMINATED DISTANCE CHECKS BASED
C ON R AND ON LTAG( )
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 1.8 AND NOT MORE THAN THE ORIGINAL
C LAST PASS RADIUS. THIS ALLOWS ALL 4 POINTS SURROUNDING
C A STATION TO BE CORRECTED. THIS IS NEEDED, BECAUSE
C ITRPSX DOES NOT NECESSARILY RETURN THE GRIDPOINT VALUE
C CLOSEST TO THE STATION BUT RATHER THE VALUE OF THE
C GRIDPOINT WITH THE CLOSEST ELEVATION TO THE STATION.
C
C TWO CLOSEST STATIONS ARE FOUND IN CASE THE 2ND
C CLOSEST IS NEEDED FOR SOME PURPOSE.
C
C DDRAD2 IS CALLED BEFORE BCD5, SO LTAG( ) IS NOT RELEVANT.
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). (THIS HAS NOT BEEN SET YET;
C DON'T USE IT. (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 MIXWL = GOVERNS HOW LAND WATER TYPES OF DATA ARE USED
C IN COMPUTING CLOSEST STATION:
C 1 = KEEP TYPES SEPARATE. THIS WOULD PROBABLY
C BE APPROPRIATE IF THERE WAS NO BLEEDING
C ACROSS TYPES IN THE ANALYSIS.
C 0 = USE ALL TYPES (0, 3, 6, AND 9) TOGETHER IN
C COMPUTING NEAREST STATION. THIS IS THE
C MOST SAFE AND SHOULD WORK EVEN IF THERE IS
C NO BLEEDING ACROSS WATER AND LAND TYPES.
C (INPUT)
C MIXAB = GOVERNS HOW THE DIFFERENT TYPES OF DATA
C (BASE, AUGMENTED, BOGUS) ARE USED:
C 1 = KEEP TYPES SEPARATE.
C 0 = USE BASE, AUGMENTED, BOGUS DATA TOGETHER
C WHEN FINDING CLOSEST STATION. THIS IS
C THE MOST SAFE.
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
D WRITE(KFILDO,105)NSTA,NPASS,NPASRR,LAUGBO,MIXWL,MIXAB,
D 1 (R(J),J=1,6)
D105 FORMAT(/' IN DDRAD2--NSTA,NPASS,NPASRR,LAUGBO,MIXWL,MIXAB,',
D 1 '(R(J),J=1,6)',6I6,6F6.2)
C
D DO 1051 K=1,NSTA
D WRITE(KFILDO,1050)CCALL(K),XP(K),YP(K),(IQUAL(K,J),J=1,5)
D1050 FORMAT(' STATIONS, POSITIONS, AND QUALITY FLAGS',/,
D 1 (5X,A8,2X,2F8.2,5I4))
D1051 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.
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(L.EQ.K)GO TO 140
C THIS STATEMENT WON'T SCREEN OUT BUT ONE.
C
IF(MIXWL.EQ.1)THEN
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
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.
ENDIF
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(MIXAB.EQ.1)THEN
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
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
D WRITE(KFILDO,143)RR
D143 FORMAT(' INCREASE RADIUS OF SEARCH TO ',F7.1,
D 1 ' GRIDLENGTHS.')
C
GO TO 110
ELSE
WRITE(KFILDO,144)
144 FORMAT(' CHANGE RADIUS TO 1.5 FOR THIS STATION.')
C THIS SHOULD NEVER HAPPEN.
DIST1=.8
DIST2=.8
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. A LAND/WATER DIFFERENCE IS
C ALLOWED FOR BELOW, BUT IS THE SAME FOR NOW.
C
IF(LNDSEA(K).EQ.9)THEN
VRADSV=VRAD(K,M)
VRAD(K,M)=MIN(MAX(DIST1-1.,1.5),VRAD(K,M))
ELSE
VRADSV=VRAD(K,M)
VRAD(K,M)=MIN(MAX(DIST1-1.,1.5),VRAD(K,M))
ENDIF
C
CCCCD IF(CCALL(K).EQ.'PAMO '.OR.CCALL(K).EQ.'PASM ')THEN
D WRITE(KFILDO,1450)K,CCALL(K),CCSTA1(K),CCSTA2(K),LNDSEA(K),
D 1 DIST1,DIST2,
D 1 (VRAD(K,J),J=1,6),VRADSV
D1450 FORMAT(' AT 1450--K,CCALL(K),CCSTA1(K),CCSTA2(K),LNDSEA(K),',
D 1 'DIST1,DIST2,',
D 1 '(VRAD(K,J),J=1,6),VRADSV',/,
D 2 I6,2X,A8,2X,A8,2X,A8,I2,9F7.1)
CCCCD ENDIF
C
150 CONTINUE
C
D WRITE(KFILDO,159)(K,CCALL(K),XDATA(K),LTAG(K),LTAGPT(K),
D 1 (VRAD(K,M),M=1,6),K=1,NSTA)
D159 FORMAT(/' AT 159 IN DDRAD2--K,CCALL(K),XDATA(K),LTAG(K),',
D 1 'LTAGPT(K),',
D 2 '(VRAD(K,M),M=1,6)',/,(I6,2X,A8,F8.1,2I4,6F8.2))
C
CALL TIMPR(KFILDO,KFILDO,'END DDRAD2 ')
RETURN
END