SUBROUTINE ORVWSM(KFILDO,KFIL10,P,NX,NY,MESH, 1 SEALND,NXE,NYE,MESHE,NPROJ, 2 SHOREA,SHOREB,NOL,SETNEG, 3 CONSTA,CONSTB,IOCEXT,IOCINC, 4 LSTORE,ND9,LITEMS,NTIMES, 5 IS0,IS1,IS2,IS4,ND7, 5 IPACK,IWORK,DATA,ND5, 7 CORE,ND10,NBLOCK,NFETCH, 8 L3264B,ISTOP,IER) C C JUNE 2010 GLAHN MDL MOS-2000 C ADAPTED FROM ORSMTH AND SPOTSM C JANUARY 2015 GLAHN CORRECTED ALGORITHM C FEBRUARY 2015 GLAHN CHANGED THIA TO NOL IN CALL; C IMPLEMENTED NOL C FEBRUARY 2015 GLAHN CHANGED SETHIA TO SETNEG AND C IMPLEMENTED C SEPTEMBER 2016 GLAHN****************ALERT C THE GRID DISTANCES READ ARE C SUPPOSED TO BE IN KM. THEY HAVE C VALUES 0, 100,200, ETC., TO 1000. C STRANGE, AND SEEM TOO LARGE. WHY C A LOT SAME VALUES??????? C USED WITH CIG C C PURPOSE C TO SMOOTH WATER POINTS ON A GRID OVER A CIRCLE C BY TRACING A RAY IN 16 DIRECTIONS FROM THE CENTER. C ONCE A LAND POINT OR A MISSING VALUE IS ENCOUNTERED, C THE RAY STOPS. THE RAYS WILL BE OF LENGTH IOCEXT C GRID LENGTHS AT INCREMENTS OF IOCINC. THERE WILL BE C NO SMOOTHING INSIDE THE NEARSHORE POINT SHOREA, THERE C WILL BE FULL SMOOTHING OUTSIDE THE FARSHORE POINT SHOREB, C AND THERE WILL BE LINEAR WEIGHTING BETWEEN THOSE TWO C POINTS. C C SEALND(NXE,NYE) MUST COVER THE SAME AREA AND BE OF C THE SAME MESH LENGTH. THE GRID SIZES AND MESH LENGTHS C ARE CHECKED. A MISSING POINT IS KEPT AS MISSING. C C THE DIFFERENCE BETWEEN THIS ORVWSM (OCEAN RAY VARIABLE C WEIGHT SMOOTHER) AND ORSMTH IS THAT ORVWSM SMOOTHS C A POINT INVERSELY AS ITS DISTANCE TO THE CLOSEST C LAND POINT, THE DISTANCE CONTAINED IN A GRID IN C INTERNAL STORAGE. A GRIDPOINT CLOSE TO SHORE, C WILL NOT BE SMOOTHED MUCH, BUT ONE FAR FROM SHORE WILL. C (SEE SHOREA, SHOREB, CONSTA, AND CONSTB FOR MORE C DETAILS.) C C AFTER THE RAY SMOOTHING, A SIMPLE 9-POINT SMOOTHER C IS USED TWICE; WITHOUT IT, THERE IS CHATTER IN THE GRID. C C THE SMOOTHER CAN BE APPLIED OVER OCEAN, LAKE, OR BOTH., C ACCORDING TO NOL. C C OPEN MP STOP AND IER ARE NOT DECLARED PRIVATE IN OPEN MP. C THEY ARE NOT INVOLVED IN THE OPEN MP LOOPS. C C DATA SET USE C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) C KFIL10 - UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (INPUT) C C VARIABLES C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) C KFIL10 = UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (INPUT/OUTPUT) C P(IX,JY) = HOLDS A FIELD TO BE SMOOTHED C (IX=1,NX) (JY=1,NY), WHERE NX AND NY ARE THE C SIZE OF THE GRID. (INPUT/OUTPUT) C NX = SIZE OF P( , ) IN X DIRECTION. (INPUT) C NY = SIZE OF P( , ) IN Y DIRECTION. (INPUT) C MESH = NOMINAL MESH LENGTH OF GRID IN P( , ) . C (INPUT) C SEALND(IX,JY) = THE LAND/SEA MASK (IX=1,NX) (JY=1,NY). C 0 = OCEAN WATER GRIDPOINTS; C 3 = INLAND WATER GRIDPOINTS. C 9 = LAND GRIDPOINTS. C (INPUT) C NXE = SIZE OF SEALND( , ) IN X DIRECTION. (INPUT) C NYE = SIZE OF SEALND( , ) IN Y DIRECTION. (INPUT) C MESHE = NOMINAL MESH LENGTH OF GRID IN SEALND( , ). C (INPUT) C NPROJ = NUMBER OF MAP PROJECTION TO WHICH THIS GRID C APPLIES. C 3 = LAMBERT. C 5 = POLAR STEREOGRAPHIC. C 7 = MERCATOR. C (INPUT) C SHOREA = THE DISTANCE FROM SHORE IN GRIDLENGTHS WHERE C THE SMOOTHING BEGINS OUTWARD. THE GRIDPOINTS C LT SHOREA GRIDLENGTHS FROM THE SHORE ARE NOT C MODIFIED. (INPUT) C SHOREB = THE DISTANCE FROM SHORE IN GRIDLENGTHS WHERE C THE SMOOTHING IS WEIGHTED UNITY. GRIDPOINTS C BETWEEN SHOREA AND SHOREB ARE WEIGHTED C BY LINEARLY ACCORDING TO DISTANCE. C NOL = 9 = DO NOT SMOOTH. C 0 = SMOOTH OVER OCEAN AND LAKE. C 1 = SMOOTH OVER OCEAN ONLY. C 3 = SMOOTH OVER LAKE ONLY. C THESE VALUES WERE CHOSEN SO THAT EXISTING C U405A.CN FILES, WHICH WILL PROBABLY HAVE C THIS VARIABLE = 0 WILL WTILL WORK. C (INPUT) C SETNEG = 1 WHEN NEGATIVES ARE SET TO ZERO BEFORE C SMOOTHING. C 0 OTHERWISE. C (INPUT) C CONSTA = THE FACTOR TO MULTIPLE THE POINTS HIGHER C THAN CONSTB BY TO ELIMINATE UNWANTED ARCS. C DISABLED 1/23/15. (INPUT) C CONSTB = THE VALUE ABOVE WHICH THE VALUES IN P( , ) C ARE MULTIPLIED BY CONSTA. C ****INOPERATIVE WHEN CONSTA = 1. (INPUT) C IOCEXT = THE NUMBER OF GRIDPOINTS PLUS AND MINUS TO C SMOOTH. THIS IS ALSO THE NUMBER OF GRID C LENGTHS TO SMOOTH IN EACH DIRECTION. (INPUT) C IOCINC = THE INCREMENT TO USE IN SMOOTHING. IT MAY BE C NOT ALL POINTS ALONG THE RAY NEED BE USED TO C GET A GOOD RESULT. IF SO, THE COMPUTATION C SHOULD BE CONSIDERABLY FASTER. NOTE THAT C IOCEXT SHOULD BE EVENLY DIVISIBLE BY IOCINC. C (INPUT) C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA C STORED (L=1,12) (J=1,LITEMS). (INPUT/OUTPUT) C ND9 = MAXIMUM NUMBER OF FIELDS STORED IN LSTORE( , ). C SECOND DIMENSION OF LSTORE( , ). (INPUT) C LITEMS = THE NUMBER OF ITEMS J IN LSTORE( ,L). C (INPUT/OUTPUT) C NTIMES = THE NUMBER OF TIMES GFETCH HAS BEEN ACCESSED. C (INPUT/OUTPUT) C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,4). C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,21+). C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12). C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4). C ND7 = DIMENSION OF IS0( ), IS1( ), IS2( ), AND IS4( ). C (INPUT) C IPACK(J) = WORK ARRAY FOR GFETCH (J=1,ND5). (INTERNAL) C IWORK(J) = WORK ARRAY FOR GFETCH (J=1,ND5). (INTERNAL) C DATA(J) = WORK ARRAY FOR GFETCH (J=1,ND5) AND COMPUTATIONS. C ND5 GE NX*NY, SO IT CAN BE USED DOUBLE DIMENSION C HERE. (INTERNAL) C ND5 = DIMENSION OF IPACK( ), WORK( ), AND DATA( ). C (INPUT) C CORE(J) = SPACE ALLOCATED FOR SAVING PACKED GRIDPOINT C FIELDS (J=1,ND10). WHEN THIS SPACE IS C EXHAUSTED, SCRATCH DISK WILL BE USED. THIS IS C THE SPACE USED FOR THE MOS-2000 INTERNAL RANDOM C ACCESS SYSTEM. (INPUT) C ND10 = THE MEMORY IN WORDS ALLOCATED TO THE SAVING OF C DATA CORE( ). WHEN THIS SPACE IS EXHAUSTED, C SCRATCH DISK WILL BE USED. (INPUT) C NBLOCK = BLOCK SIZE IN WORDS OF INTERNAL MOS-2000 DISK C STORAGE. (INPUT) C NFETCH = INCREMENTED EACH TIME DATA ARE FETCHED BY C GFETCH. IT IS A RUNNING COUNT FROM THE C BEGINNING OF THE PROGRAM. THIS COUNT C IS MAINTAINED IN CASE THE USER NEEDS IT C (DIAGNOSTICS, ETC.). (OUTPUT) C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING C USED (EITHER 32 OR 64). (INPUT) C ISTOP(J) = ISTOP(1)--IS INCREMENTED BY 1 EACH TIME AN ERROR C OCCURS. C ISTOP(2)--IS INCREMENTED WHEN THERE ARE C FEW DATA FOR AN ANALYSIS. C ISTOP(3)--IS INCREMENTED WHEN A DATA RECORD C COULD NOT BE FOUND. C ISTOP(4)--IS INCREMENTED WHEN A LAPSE RATE COULD C NOT BE COMPUTED OR HAS TOO FEW CASES C TO BE USED. C ISTOP(5)--IS INCREMENTED WHEN NO NON-MISSING C GRIDPOINT AROUND THE DATA POINT IS C OF THE SAME TYPE. C ISTOP(6)--IS INCREMENTED WHEN THERE IS A PROBLEM C WITH MAKING BOGUS STATIONS. C (INPUT/OUTPUT) C IER = RETURN CODE. C 0 = GOOD RETURN. C 777 = MESHE NE MESH OR ARRAY SIZES NOT THE SAME. C (OUTPUT) C ITABLE(J,L) = CORRESPONDENCE BETWEEN NOMINAL MESH LENGTH C (L=1) AND VALUE FOR X IN 409CX0000 (L=2), C (J=1,7). C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C GFETCH C DIMENSION P(NX,NY) DIMENSION HOLD(NX,NY) C HOLD( , ) IS AN AUTOMATIC ARRAYS. DIMENSION SEALND(NXE,NYE) DIMENSION IPACK(ND5),IWORK(ND5),DATA(NX,NY) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10) DIMENSION ITABLE(7,2),LD(4),ISTOP(5) C DATA ITABLE/80, 40, 20, 10, 5, 3, 1, 1 0, 1, 2, 3, 4, 5, 6/ C CALL TIMPR(KFILDO,KFILDO,'START ORVWSM ') C IF(NOL.EQ.9)THEN WRITE(KFILDO,102) 102 FORMAT(/' RAY SMOOTHING IN ORVWSM IS NOT DONE; NOL = 9') GO TO 400 ENDIF C D WRITE(KFILDO,103)NX,NY,NXE,NYE,MESH,NOL,IOCEXT,IOCINC D103 FORMAT(/' IN ORVWSM--NX,NY,NXE,NYE,MESH,NOL,IOCEXT,IOCINC', D 1 8I8) D WRITE(KFILDO,104)SHOREA,SHOREB,THIA,SETNEG,CONSTA,CONSTB D104 FORMAT(' IN ORVWSM--SHOREA,SHOREB,THIA,SETNEG,CONSTA,CONSTB', D 1 6F8.2) C C CHECK THE SIZE OF P( , ) AND SEALND( , ). C IF(NX.NE.NXE.OR.NY.NE.NYE)THEN WRITE(KFILDO,105)NX,NY,NXE,NYE 105 FORMAT(/' ****THE GRID P( , ) OF SIZE',I6,' X ',I6, 1 ' IS NOT THE SAME SIZE AS SEALND',I6,' X ',I6, 2 '. OCEAN IS NOT SMOOTHED IN ORVWSM.') ISTOP=ISTOP+1 IER=777 GO TO 400 ENDIF C C CHECK THE MESH LENGTHS OF P( , ) AND SEALND( , ). C IF(MESH.NE.MESHE)THEN WRITE(KFILDO,107)MESH,MESHE 107 FORMAT(/' ****THE GRID P( , ) HAS A DIFFERENT NOMINAL', 1 ' MESH LENGTH =',I4,' THAN THAT OF SEALND( , ) =',I4, 2 '. OCEAN IS NOT SMOOTHED IN ORVWSM.') ISTOP=ISTOP+1 IER=777 GO TO 400 ENDIF C C CHECK WHETHER IOCEXT AND IOCINC ARE BOTH GE 0. C IF(IOCEXT.LE.0.OR.IOCINC.LE.0)THEN WRITE(KFILDO,108)IOCEXT,IOCINC 108 FORMAT(/' ****IOCEXT =',I4,' AND IOCINC =',I4, 1 ' ARE NOT BOTH GREATER THAN 0 IN ORVWSM.', 2 ' OCEAN IS NOT SMOOTHED.') ISTOP=ISTOP+1 IER=777 GO TO 400 ENDIF C C CHECK WHETHER IOCEXT IS EVENLY DIVISIBLE BY IOCINC. C IF(MOD(IOCEXT,IOCINC).NE.0.OR.IOCINC.GT.IOCEXT)THEN WRITE(KFILDO,109)IOCEXT,IOCINC 109 FORMAT(/' ****IOCEXT =',I4,' AND IOCINC =',I4, 1 ' ARE NOT COMPATIBLE.', 2 ' OCEAN IS NOT SMOOTHED IN ORVWSM.') ISTOP=ISTOP+1 IER=777 GO TO 400 ENDIF C DO 110 J=1,7 C IF(MESHE.EQ.ITABLE(J,1))THEN LD(1)=409003000+NPROJ*100000+ITABLE(J,2)*10000 LD(2)=0 LD(3)=0 LD(4)=0 GO TO 112 ENDIF C 110 CONTINUE C C FALL THROUGH HERE MEANS THE NOMINAL GRID LENGTH MESHE C IS NOT ONE OF THE VALUES HANDLED IN ITABLE( , ). C WRITE(KFILDO,111) 111 FORMAT(/' ****MESH LENGTH FOR CONSTANT GRID FROM GTHRES IS NOT', 1 ' HANDLED IN ITABLE( , ) IN ORVWSM.', 2 ' OCEAN IS NOT SMOOTHED.') ISTOP=ISTOP+1 IER=777 GO TO 400 C C READ THE DISTANCE TO SHORE GRID FROM THE INTERNAL RANDOM C ACCESS FILE INTO DATA( , ). (ALTHOUGH DATA( ) IS C DIMENSIONED ND5 IN THE CALLING PROGRAM U405A, IT IS C DIMENSIONED NX*NY HERE; NX*NY ASSURED TO BE LE ND5.) C 112 CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,DATA,NX*NY, 2 NWORDS,NPACK,NDATE,NTIMES,CORE,ND10, 3 NBLOCK,NFETCH,NSLAB,MISSP,MISSS,L3264B,1,IER) C IF(IER.NE.0)THEN ISTOP(3)=ISTOP(3)+1 WRITE(KFILDO,114)(LD(M1),M1=1,4) 114 FORMAT(/' ****COULD NOT FIND DISTANCE GRID', 1 3I10.9,I10,'. OCEAN IS NOT SMOOTHED IN ORVWSM.') IER=777 GO TO 400 ENDIF C C DATA ARE AVAILABLE AND PARAMETERS CHECK OK. SMOOTHING C WILL BE DONE. SET NEGATIVE VALUES TO ZERO BEFORE C SMOOTHING IF SETNEG = 1. C IF(SETNEG.GT..5)THEN WRITE(KFILDO,115) 115 FORMAT(' NEGATIVES BEING SET TO ZERO BEFORE SMOOTHING', 1 ' IN ORVWSM.') C DO 117 JY=1,NY DO 116 IX=1,NX C IF(P(IX,JY).LT.0.)THEN P(IX,JY)=0. ENDIF C 116 CONTINUE 117 CONTINUE C ENDIF C C GET THE EXACT MESHLENGTH. C CALL ACTUAL(KFILDO,MESH,XMESH,TRASH,NPROJ,IER) C XMESH IS THE ACTUAL MESH LENGTH IN KM. C C CALCULATE THE NEARSHORE AND FARSHORE VALUES IN KM C VICE THE GRIDLENGTHS INPUT BECAUSE DATA( , ) IS IN KM. C GRDKMA=XMESH*SHOREA GRDKMB=XMESH*SHOREB C C CALCULATE BMA, THE DIFFERENCE BETWEEN THE FARSHORE C AND NEARSHORE DISTANCES. C BMA=GRDKMB-GRDKMA C C WEIGHT THE POINTS GE CONSTB MORE HEAVILY AS NECESSARY. C HOWEVER, THE POINTS WITHIN SHOREA KM WILL NOT BE CHANGED. C CCC IF(CONSTA.NE.1.)THEN CCCC IF CONSTA IS 1., THEN THE VALUES ARE UNCHANGED. CCCC CCC DO 119 JY=1,NY CCC DO 118 IX=1,NX C CCC IF(SEALND(IX,JY).LE.3.5.AND.P(IX,JY).LT.9998.9)THEN CCCC THIS IS AN OCEAN AND INLAND WATER POINT THAT IS NOT CCCC MISSING. CHANGE 3.5 TO 1.5 TO EXCLUDE INLAND WATER. CCCC CCC IF(DATA(IX,JY).GT.GRDKMA)THEN CCCC ONLY THE GRIDPOINTS GREATER THAN GRDKMA KM FROM CCCC SHORE ARE CHANGED. THIS IS BECAUSE P( , ) REMAINS CCCC THE SAME WITHIN GRDKMA KM FROM SHORE. CCCC CCC IF(P(IX,JY).GE.CONSTB)THEN CCC P(IX,JY)=P(IX,JY)*CONSTA CCCC THIS MORE HEAVILY WEIGHTS THE POINTS GREATER THAN CCCC CONSTB SO THAT THE SPURIOUS EXTENSIONS OF ARCS ARE CCCC MINIMIZED. THIS CAN BE NEGATED BY SETTING CONSTA CCCC TO 1. CCC ENDIF CCCC CCC ENDIF CCCC CCC ENDIF CCCC CCC 118 CONTINUE CCC 119 CONTINUE CCCC CCC ENDIF C C SMOOTH THE POINTS. C CCC!$OMP PARALLEL DO DEFAULT(SHARED) CCC!$OMP& PRIVATE(IX,JY,SUM,NCOUNT,IXS,JYS,IS) C DO 300 JY=1,NY DO 299 IX=1,NX C CCCCD WRITE(KFILDO,1195)IX,JY,SEALND(IX,JY),P(IX,JY),DATA(IX,JY),GRDKMA CCCCD1195 FORMAT(' AT 1195-IX,JY,SEALND(IX,JY),P(IX,JY),DATA(IX,JY),GRDKMA', CCCCD 1 2I6,4F8.2) C IF(SEALND(IX,JY).GT.8.9)GO TO 299 C BYPASSES LAND GRIDPOINTS. C IF(P(IX,JY).GT.9998.9)GO TO 299 C BYPASSES MISSING DATA POINTS. IF(DATA(IX,JY).LT.GRDKMA)GO TO 299 C DO NOT SMOOTH POINTS INSIDE THE GRDKMA NEARSHORE BOUNDARY. C SUM=P(IX,JY) C P(IX,JY) IS THE CENTER POINT. IT IS COUNTED ONLY ONCE. NCOUNT=1 C C SUM VALUES ON X-AXIS TO THE RIGHT. C DO 124 IXS=IX+IOCINC,MIN(NX,IX+IOCEXT),+IOCINC IF(P(IXS,JY).GT.9998.9.OR.SEALND(IXS,JY).GT.3.5)GO TO 125 C A MISSING OR LAND STOPS THE RAY. SUM=SUM+P(IXS,JY) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,120)IX,JY,IXS,NCOUNT,P(IXS,JY),SUM D120 FORMAT(' AT 120--IX,JY,IXS,NCOUNT,P(IXS,JY),SUM',4I8,2F10.2) D ENDIF C 124 CONTINUE C C SUM VALUES ON X-AXIS TO THE LEFT. C 125 DO 134 IXS=IX-IOCINC,MAX(1,IX-IOCEXT),-IOCINC IF(P(IXS,JY).GT.9998.9.OR.SEALND(IXS,JY).GT.3.5)GO TO 135 C A MISSING OR LAND STOPS THE RAY. SUM=SUM+P(IXS,JY) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,130)IX,JY,IXS,NCOUNT,P(IXS,JY),SUM D130 FORMAT(' AT 130--IX,JY,IXS,NCOUNT,P(IXS,JY),SUM',4I8,2F10.2) D ENDIF C 134 CONTINUE C C SUM VALUES ON Y-AXIS UPWARD. C 135 DO 144 JYS=JY+IOCINC,MIN(NY,JY+IOCEXT),+IOCINC IF(P(IX,JYS).GT.9998.9.OR.SEALND(IX,JYS).GT.3.5)GO TO 145 C A MISSING OR LAND STOPS THE RAY. SUM=SUM+P(IX,JYS) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,140)IX,JY,JYS,NCOUNT,P(IX,JYS),SUM D140 FORMAT(' AT 140--IX,JY,JYS,NCOUNT,P(IX,JYS),SUM',4I8,2F10.2) D ENDIF C 144 CONTINUE C C SUM VALUES ON Y-AXIS DOWNWARD. C 145 DO 154 JYS=JY-IOCINC,MAX(1,JY-IOCEXT),-IOCINC IF(P(IX,JYS).GT.9998.9.OR.SEALND(IX,JYS).GT.3.5)GO TO 155 C A MISSING OR LAND STOPS THE RAY. SUM=SUM+P(IX,JYS) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,150)IX,JY,JYS,NCOUNT,P(IX,JYS),SUM D150 FORMAT(' AT 150--IX,JY,JYS,NCOUNT,P(IX,JYS),SUM',4I8,2F10.2) D ENDIF C 154 CONTINUE C C SUM VALUES DIAGONALLY IN THE PLUS X AND PLUS Y DIRECTION. C 155 DO 164 IS=IOCINC,IOCEXT,+IOCINC IF(IX+IS.GT.NX)GO TO 164 IF(JY+IS.GT.NY)GO TO 164 IF(P(IX+IS,JY+IS).GT.9998.9.OR.SEALND(IX+IS,JY+IS).GT.3.5) 1 GO TO 165 C A MISSING OR LAND STOPS THE RAY. IF(IS.GT..707*IOCEXT)GO TO 165 C THIS LIMITS THE SMOOTHING TO A CIRCLE. SUM=SUM+P(IX+IS,JY+IS) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,160)IX,JY,IS,NCOUNT,P(IX+IS,JY+IS),SUM D160 FORMAT(' AT 160--IX,JY,IS,NCOUNT,P(IX+IS,JY+IS),SUM', D 1 4I8,2F10.2) D ENDIF C 164 CONTINUE C C SUM VALUES DIAGONALLY IN THE PLUS X AND MINUS Y DIRECTION. C 165 DO 174 IS=IOCINC,IOCEXT,+IOCINC IF(IX+IS.GT.NX)GO TO 174 IF(JY-IS.LT.1)GO TO 174 IF(P(IX+IS,JY-IS).GT.9998.9.OR.SEALND(IX+IS,JY-IS).GT.3.5) 1 GO TO 175 C A MISSING OR LAND STOPS THE RAY. IF(IS.GT..707*IOCEXT)GO TO 175 C THIS LIMITS THE SMOOTHING TO A CIRCLE. SUM=SUM+P(IX+IS,JY-IS) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,170)IX,JY,IS,NCOUNT,P(IX+IS,JY-IS),SUM D170 FORMAT(' AT 170--IX,JY,IS,NCOUNT,P(IX+IS,JY-IS),SUM', D 1 4I8,2F10.2) D ENDIF C 174 CONTINUE C C SUM VALUES DIAGONALLY IN THE MINUS X AND PLUS Y DIRECTION. C 175 DO 184 IS=IOCINC,IOCEXT,+IOCINC IF(IX-IS.LT.1)GO TO 184 IF(JY+IS.GT.NY)GO TO 184 IF(P(IX-IS,JY+IS).GT.9998.9.OR.SEALND(IX-IS,JY+IS).GT.3.5) 1 GO TO 185 C A MISSING OR LAND STOPS THE RAY. IF(IS.GT..707*IOCEXT)GO TO 185 C THIS LIMITS THE SMOOTHING TO A CIRCLE. SUM=SUM+P(IX-IS,JY+IS) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,180)IX,JY,IS,NCOUNT,P(IX-IS,JY+IS),SUM D180 FORMAT(' AT 180--IX,JY,IS,NCOUNT,P(IX-IS,JY+IS),SUM', D 1 4I8,2F10.2) D ENDIF C 184 CONTINUE C C SUM VALUES DIAGONALLY IN THE MINUS X AND MINUS Y DIRECTION. C 185 DO 194 IS=IOCINC,IOCEXT,+IOCINC IF(IX-IS.LT.1)GO TO 194 IF(JY-IS.LT.1)GO TO 194 IF(P(IX-IS,JY-IS).GT.9998.9.OR.SEALND(IX-IS,JY-IS).GT.3.5) 1 GO TO 195 C A MISSING OR LAND STOPS THE RAY. IF(IS.GT..707*IOCEXT)GO TO 195 C THIS LIMITS THE SMOOTHING TO A CIRCLE. SUM=SUM+P(IX-IS,JY-IS) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,190)IX,JY,IS,NCOUNT,P(IX-IS,JY-IS),SUM D190 FORMAT(' AT 190--IX,JY,IS,NCOUNT,P(IX-IS,JY-IS),SUM', D 1 4I8,2F10.2) D ENDIF C 194 CONTINUE C C SUM VALUES DIAGONALLY IN THE +X+Y DIRECTION BETWEEN C THE 45 DEGREE LINE AND THE VERTICAL. C 195 DO 204 IS=IOCINC,IOCEXT,+IOCINC IF(IX+IS.GT.NX)GO TO 204 IF(JY+2*IS.GT.NY)GO TO 204 IF(P(IX+IS,JY+2*IS).GT.9998.9.OR.SEALND(IX+IS,JY+2*IS).GT.3.5) 1 GO TO 205 C A MISSING OR LAND STOPS THE RAY. IF(IS.GT..447*IOCEXT)GO TO 205 C THIS LIMITS THE SMOOTHING TO A CIRCLE. SUM=SUM+P(IX+IS,JY+2*IS) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,200)IX,JY,IS,NCOUNT,P(IX+IS,JY+2*IS),SUM D200 FORMAT(' AT 200--IX,JY,IS,NCOUNT,P(IX+IS,JY+2*IS),SUM', D 1 4I8,2F10.2) D ENDIF C 204 CONTINUE C C SUM VALUES DIAGONALLY IN THE +X+Y DIRECTION BETWEEN C THE 45 DEGREE LINE AND THE HORIZONTAL. C 205 DO 214 IS=IOCINC,IOCEXT,+IOCINC IF(IX+2*IS.GT.NX)GO TO 214 IF(JY+IS.GT.NY)GO TO 214 IF(P(IX+2*IS,JY+IS).GT.9998.9.OR.SEALND(IX+2*IS,JY+IS).GT.3.5) 1 GO TO 215 C A MISSING OR LAND STOPS THE RAY. IF(IS.GT..447*IOCEXT)GO TO 215 C THIS LIMITS THE SMOOTHING TO A CIRCLE. SUM=SUM+P(IX+2*IS,JY+IS) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,210)IX,JY,IS,NCOUNT,P(IX+2*IS,JY+IS),SUM D210 FORMAT(' AT 210--IX,JY,IS,NCOUNT,P(IX+2*IS,JY+IS),SUM', D 1 4I8,2F10.2) D ENDIF C 214 CONTINUE C C SUM VALUES DIAGONALLY IN THE +X-Y DIRECTION BETWEEN C THE 45 DEGREE LINE AND THE HORIZONTAL. C 215 DO 224 IS=IOCINC,IOCEXT,+IOCINC IF(IX+2*IS.GT.NX)GO TO 224 IF(JY-IS.LT.1)GO TO 224 IF(P(IX+2*IS,JY-IS).GT.9998.9.OR.SEALND(IX+2*IS,JY-IS).GT.3.5) 1 GO TO 225 C A MISSING OR LAND STOPS THE RAY. IF(IS.GT..447*IOCEXT)GO TO 225 C THIS LIMITS THE SMOOTHING TO A CIRCLE. SUM=SUM+P(IX+2*IS,JY-IS) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,220)IX,JY,IS,NCOUNT,P(IX+2*IS,JY-IS),SUM D220 FORMAT(' AT 220--IX,JY,IS,NCOUNT,P(IX+2*IS,JY-IS),SUM', D 1 4I8,2F10.2) D ENDIF C 224 CONTINUE C C SUM VALUES DIAGONALLY IN THE +X-Y DIRECTION BETWEEN C THE 45 DEGREE LINE AND THE VERTICAL. C 225 DO 234 IS=IOCINC,IOCEXT,+IOCINC IF(IX+IS.GT.NX)GO TO 234 IF(JY-2*IS.LT.1)GO TO 234 IF(P(IX+IS,JY-2*IS).GT.9998.9.OR.SEALND(IX+IS,JY-2*IS).GT.3.5) 1 GO TO 235 C A MISSING OR LAND STOPS THE RAY. IF(IS.GT..447*IOCEXT)GO TO 235 C THIS LIMITS THE SMOOTHING TO A CIRCLE. SUM=SUM+P(IX+IS,JY-2*IS) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,230)IX,JY,IS,NCOUNT,P(IX+IS,JY-2*IS),SUM D230 FORMAT(' AT 230--IX,JY,IS,NCOUNT,P(IX+IS,JY-2*IS),SUM', D 1 4I8,2F10.2) D ENDIF C 234 CONTINUE C C SUM VALUES DIAGONALLY IN THE -X-Y DIRECTION BETWEEN C THE 45 DEGREE LINE AND THE VERTICAL. C 235 DO 244 IS=IOCINC,IOCEXT,+IOCINC IF(IX-IS.LT.1)GO TO 244 IF(JY-2*IS.LT.1)GO TO 244 IF(P(IX-IS,JY-2*IS).GT.9998.9.OR.SEALND(IX-IS,JY-2*IS).GT.3.5) 1 GO TO 245 C A MISSING OR LAND STOPS THE RAY. IF(IS.GT..447*IOCEXT)GO TO 245 C THIS LIMITS THE SMOOTHING TO A CIRCLE. SUM=SUM+P(IX-IS,JY-2*IS) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,240)IX,JY,IS,NCOUNT,P(IX-IS,JY-2*IS),SUM D240 FORMAT(' AT 240--IX,JY,IS,NCOUNT,P(IX-IS,JY-2*IS),SUM', D 1 4I8,2F10.2) D ENDIF C 244 CONTINUE C C SUM VALUES DIAGONALLY IN THE -X-Y DIRECTION BETWEEN C THE 45 DEGREE LINE AND THE HORIZONTAL. C 245 DO 254 IS=IOCINC,IOCEXT,+IOCINC IF(IX-2*IS.LT.1)GO TO 254 IF(JY-IS.LT.1)GO TO 254 IF(P(IX-2*IS,JY-IS).GT.9998.9.OR.SEALND(IX-2*IS,JY-IS).GT.3.5) 1 GO TO 255 C A MISSING OR LAND STOPS THE RAY. IF(IS.GT..447*IOCEXT)GO TO 255 C THIS LIMITS THE SMOOTHING TO A CIRCLE. SUM=SUM+P(IX-2*IS,JY-IS) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,250)IX,JY,IS,NCOUNT,P(IX-2*IS,JY-IS),SUM D250 FORMAT(' AT 250--IX,JY,IS,NCOUNT,P(IX-2*IS,JY-IS),SUM', D 1 4I8,2F10.2) D ENDIF C 254 CONTINUE C C SUM VALUES DIAGONALLY IN THE -X+Y DIRECTION BETWEEN C THE 45 DEGREE LINE AND THE HORIZONTAL. C 255 DO 264 IS=IOCINC,IOCEXT,+IOCINC IF(IX-2*IS.LT.1)GO TO 264 IF(JY+IS.GT.NY)GO TO 264 IF(P(IX-2*IS,JY+IS).GT.9998.9.OR.SEALND(IX-2*IS,JY+IS).GT.3.5) 1 GO TO 265 C A MISSING OR LAND STOPS THE RAY. IF(IS.GT..447*IOCEXT)GO TO 265 C THIS LIMITS THE SMOOTHING TO A CIRCLE. SUM=SUM+P(IX-2*IS,JY+IS) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,260)IX,JY,IS,NCOUNT,P(IX-2*IS,JY+IS),SUM D260 FORMAT(' AT 260--IX,JY,IS,NCOUNT,P(IX-2*IS,JY+IS),SUM', D 1 4I8,2F10.2) D ENDIF C 264 CONTINUE C C SUM VALUES DIAGONALLY IN THE -X+Y DIRECTION BETWEEN C THE 45 DEGREE LINE AND THE VERTICAL. C 265 DO 274 IS=IOCINC,IOCEXT,+IOCINC IF(IX-IS.LT.1)GO TO 274 IF(JY+2*IS.GT.NY)GO TO 274 IF(P(IX-IS,JY+2*IS).GT.9998.9.OR.SEALND(IX-IS,JY+2*IS).GT.3.5) 1 GO TO 275 C A MISSING OR LAND STOPS THE RAY. IF(IS.GT..447*IOCEXT)GO TO 275 C THIS LIMITS THE SMOOTHING TO A CIRCLE. SUM=SUM+P(IX-IS,JY+2*IS) NCOUNT=NCOUNT+1 C D IF(IX.EQ.100.AND.JY.EQ.1100)THEN D WRITE(KFILDO,270)IX,JY,IS,NCOUNT,P(IX-IS,JY+2*IS),SUM D270 FORMAT(' AT 270--IX,JY,IS,NCOUNT,P(IX-IS,JY+2*IS),SUM', D 1 4I8,2F10.2) D ENDIF C 274 CONTINUE C 275 HOLD(IX,JY)=SUM/NCOUNT C CCCC WRITE(KFILDO,276)IX,JY,NCOUNT,SUM,P(IX,JY),HOLD(IX,JY) CCCC 276 FORMAT(' AT 276--IX,JY,NCOUNT,SUM,P(IX,JY),HOLD(IX,JY)', CCCC 1 3I6,3F10.3) C CCCC ENDIF C 299 CONTINUE C 300 CONTINUE C CCC!$OMP END PARALLEL DO C C PLACE HOLD( , ) INTO P( , ) AS NECESSARY. C DO 310 JY=1,NY DO 309 IX=1,NX C NSL=NINT(SEALND(IX,JY)) c IF(DATA(IX,JY).LE.9998.9.AND.P(IX,JY).LE.9998.9)THEN C THE DATA( , ) VALUE IS GOOD. WHEN P( , ) IS C MISSING, IT MUST BE RETAINED. C CCCC IF(JY.EQ.1100)THEN CCCC WRITE(KFILDO,303)IX,NSL,NOL,P(IX,JY),HOLD(IX,JY), CCCC 1 DATA(IX,JY),GRDKMA,GRDKMB CCCC 303 FORMAT(' AT 303--IX,NSL,NOL,P(IX,JY),HOLD(IX,JY),', CCCC 1 'DATA(IX,JY),GRDKMA,GRDKMB',3I4,5F10.2) CCCC ENDIF C IF(DATA(IX,JY).GE.GRDKMA)THEN C WHEN THE IX,JY POINT IS INSIDE NEARSHORE, C P(IX,JY) IS NOT MODIFIED. C IF(((NSL.EQ.0).AND.(NOL.EQ.0.OR.NOL.EQ.1)).OR. 1 ((NSL.EQ.3).AND.(NOL.EQ.0.OR.NOL.EQ.3)))THEN C MODIFY P( , ) ONLY WHEN NOL SO INDICATES. C CCCC IF(JY.EQ.1100)THEN CCCC WRITE(KFILDO,304)IX,NSL,NOL,P(IX,JY),HOLD(IX,JY), CCCC 1 DATA(IX,JY),GRDKMA,GRDKMB CCCC 304 FORMAT(' AT 304--IX,NSL,NOL,P(IX,JY),HOLD(IX,JY),', CCCC 1 'DATA(IX,JY),GRDKMA,GRDKMB',3I4,5F10.2) CCCC ENDIF C IF(DATA(IX,JY).GE.GRDKMB)THEN P(IX,JY)=HOLD(IX,JY) C THE IX,JY POINT IS OUTSIDE FARSHORE. C CCCC IF(JY.EQ.1100)THEN CCCC WRITE(KFILDO,305)IX,NSL,NOL,P(IX,JY),HOLD(IX,JY), CCCC 1 DATA(IX,JY),GRDKMA,GRDKMB CCCC 305 FORMAT(' AT 305--IX,NSL,NOL,P(IX,JY),HOLD(IX,JY),', CCCC 1 'DATA(IX,JY),GRDKMA,GRDKMB',3I4,5F10.2) CCCC ENDIF C ELSE C CCCC WRITE(KFILDO,308)GRDKMA,GRDKMB,BMA,DATA(IX,JY), CCCC 1 P(IX,JY),HOLD(IX,JY) CCCC 308 FORMAT(' AT 308--GRDKMA,GRDKMB,BMA,DATA(IX,JY),', CCCC 1 'P(IX,JY),HOLD(IX,JY)',6F10.3) C P(IX,JY)=((DATA(IX,JY)-GRDKMA)*HOLD(IX,JY)+ 1 (GRDKMB-DATA(IX,JY))*P(IX,JY))/BMA C CCCC IF(JY.EQ.1100)THEN CCCC WRITE(KFILDO,306)IX,NSL,NOL,P(IX,JY),HOLD(IX,JY), CCCC 1 DATA(IX,JY),GRDKMA,GRDKMB CCCC 306 FORMAT(' AT 306--IX,NSL,NOL,P(IX,JY),HOLD(IX,JY),', CCCC 1 'DATA(IX,JY),GRDKMA,GRDKMB',3I4,5F10.2) CCCC ENDIF C ENDIF C ENDIF C ENDIF C ENDIF C 309 CONTINUE 310 CONTINUE C C THE BELOW CAN BE INSERTED TO BYPASS 9-POINT SMOOTHING. CCCC WRITE(KFILDO,314) CCCC 314 FORMAT(' RAY SMOOTHED WITHOUT 9-PT SMOOTHING') CCCC GO TO 400 C C SMOOTH OVER 9 POINTS TWICE ACCORDING TO NOL. NOL = 9 HAS C ALREADY BYPASSED ORVWSM. ORVWSM CALLED WITH NOL = 9 GIVES C SAME RESULTS AS NOT CALLING ORVWSM. C IF(NOL.EQ.0)THEN WRITE(KFILDO,315) 315 FORMAT(/' WATER RAY SMOOTHED, FOLLOWED BY TWO 9-PT SMOOTHINGS', 1 ' OVER BOTH OCEAN AND LAKES.') ELSEIF(NOL.EQ.1)THEN WRITE(KFILDO,3150) 3150 FORMAT(/' WATER RAY SMOOTHED, FOLLOWED BY TWO 9-PT SMOOTHINGS', 1 ' OVER OCEAN BUT NOT LAKES.') ELSEIF(NOL.EQ.3)THEN WRITE(KFILDO,3151) 3151 FORMAT(/' WATER RAY SMOOTHED, FOLLOWED BY TWO 9-PT SMOOTHINGS', 1 ' OVER LAKES BUT NOT OCEAN.') ENDIF C C********************************* CCCCC GO TO 400 C DO 390 L=1,2 C CCC!$OMP PARALLEL DO DEFAULT(SHARED) CCC!$OMP& PRIVATE(IX,JY,SUM,NCOUNT,IXS,JYS) C DO 370 JY=1,NY DO 369 IX=1,NX C HOLD(IX,JY)=P(IX,JY) C IF(P(IX,JY).GT.9998.9)GO TO 369 C A MISSING DATA POINT IS NOT SMOOTHED. C IF(DATA(IX,JY).LT.GRDKMA)GO TO 369 C NO SMOOTHING IS DONE BETWEEN GRDKMA AND THE COASTLINE. C NSL=NINT(SEALND(IX,JY)) C IF(((NSL.EQ.0).AND.(NOL.EQ.0.OR.NOL.EQ.1)).OR. 1 ((NSL.EQ.3).AND.(NOL.EQ.0.OR.NOL.EQ.3)))THEN C MODIFY P( , ) ONLY WHEN NOL SO INDICATES. C C THIS IS AN OCEAN OR INLAND WATER POINT THAT IS NOT MISSING, C AND IS OUTSIDE THE THRESHOLD DISTANCE GRDKMA FOR SMOOTHING. C BECAUSE THIS IS WATER ONLY,DON'T WANT TO SMOOTH NEAR THE C SHORE BECAUSE LAND HAS NOT BEEN. C SUM=0. NCOUNT=0 C DO 360 JYS=MAX(1,JY-1),MIN(NY,JY+1) DO 359 IXS=MAX(1,IX-1),MIN(NX,IX+1) C CCCC DO 360 JYS=MAX(1,JY-4),MIN(NY,JY+4) CCCC DO 359 IXS=MAX(1,IX-4),MIN(NX,IX+4) C IF(P(IXS,JYS).GT.9998.9.OR.SEALND(IXS,JYS).GT.3.5)GO TO 359 C SUM=SUM+P(IXS,JYS) NCOUNT=NCOUNT+1 359 CONTINUE 360 CONTINUE C IF(NCOUNT.GT.1)THEN HOLD(IX,JY)=SUM/NCOUNT C CCCC IF(JY.EQ.1105)THEN CCCC WRITE(KFILDO,365)NSL,NOL,IX,JY,NCOUNT,SUM, CCCC 1 P(IX,JY),HOLD(IX,JY) CCCC 365 FORMAT(' AT 365--NSL,NOL,IX,JY,NCOUNT,SUM,', CCCC 1 'P(IX,JY),HOLD(IX,JY)',5I6,3F10.3) CCCC ENDIF C ELSE HOLD(IX,JY)=P(IX,JY) ENDIF C ENDIF C 369 CONTINUE 370 CONTINUE C CCC!$OMP END PARALLEL DO C C REPLACE P( , ) WITH HOLD( , ). C DO 380 JY=1,NY DO 379 IX=1,NX P(IX,JY)=HOLD(IX,JY) 379 CONTINUE 380 CONTINUE C 390 CONTINUE C CALL TIMPR(KFILDO,KFILDO,'END ORVWSM ') 400 RETURN END