w3ft02.f

Go to the documentation of this file.

C> @file
C> @brief Interpolate precipitation to specific point.
C> @author Robert Hirano @date 1979-08-05
 
C> Interpolate, using a fancy non-linear method,
C> gridded quantitative precipitation forecasts to a specific
C> interior point. One point (e.g. an observation station)
C> per call to w3ft02().
C>
C> ### Program History Log:
C> Date | Programmer | Comment
C> -----|------------|--------
C> 1979-08-05 | Robert Hirano | Initial.
C> 1996-06-23 | Farley | Converted to cray fortran 77
C>
C> @param[in] RAIN Real*4 grid field of (forecast) precipitation.
C> @param[in] IMAX Integer*4 i-dimension of rain field.
C> @param[in] JMAX Integer *4 j-dimension of rain field.
C> @param[in] PI Real*4 i-coordinate of interpolation point.
C> @param[in] PJ Real*4 j-coordinate of interpolation point.
C> @param[out] AMOUNT Real*4 amount of precip interpolated to pi,pj.
C>
C> @author Robert Hirano @date 1979-08-05
      SUBROUTINE w3ft02 (RAIN, IMAX, JMAX, PI, PJ, AMOUNT)
C
C        INTERPOLATE PRECIPITATION FROM RAIN FIELD
C        TO INTERNAL POINT (PI,PJ).  RESULT IN AMOUNT
C
         real RAIN(IMAX,JMAX)
C
C              CHECK FOR INTERPOLATION POINT OUTSIDE GRID
C
         amount = 0.
         IF(pi.LE.1.OR.pi.GE.imax)  GO TO 150
         IF(pj.LE.1.OR.pj.GE.jmax)  GO TO 150
C
C        SET UP RAIN AMMOUNTS AT CORNERS OF BOX SURROUNDING POINT (PI,PJ
C
C             R2          R4
C
C                 (PI,PJ)
C
C             R1          R3
C
         i=pi
         j=pj
         r1=rain(i  ,j  )
         r2=rain(i  ,j+1)
         r3=rain(i+1,j  )
         r4=rain(i+1,j+1)
C
C        CHECK FOR NO RAIN AT ALL
C
         IF(amax1(r1,r2,r3,r4).LE.0.)  GO TO 150
C
C        GOT SOME  --  FIND APPROPRIATE SECTOR AND SECTION
C        OF THE GRID BOX IN WHICH THE STATION IS LOCATED
C
         ai = pi-i
         aj=pj-j
         x = 0.5
C
C        MEANINOF IC FOR SECTORS (K=1) OR SECTIONS (K=2)
C
C             2    4
C
C             1    3
C
C        ALSO REFERENCED AS
C
C             TOP       DIAGONAL       /    T    D
C                                      /
C             NEAR      RIGHT          /    N    R
C
         DO   1  k=1,2
           IF(ai.GT.x)  GO TO 2
             IF(aj.GT.x)  GO TO 4
               ic = 1
               GO TO 10
    4        CONTINUE
               ic = 2
               GO TO 10
    2      CONTINUE
             IF(aj.GT.x)  GO TO 6
               ic = 3
               GO TO 10
    6        CONTINUE
               ic = 4
   10      CONTINUE
           IF(k.NE.1)  GO TO 16
C
C            SET UP SECTORS  THIS BUSINESS IN EFFECT ROTATES THE SECTORS
C            FOR CONVENIENCE IN LATER INTERPOLATIONS
C
             GO TO (11, 12, 13, 14), ic
   11        CONTINUE
               r = r1
               rt = r2
               rr = r3
               rd = r4
               GO TO 15
   12        CONTINUE
               r = r2
               rt = r1
               rr = r4
               rd = r3
               aj = 1. - aj
               GO TO 15
   13        CONTINUE
               r = r3
               rt = r4
               rr = r1
               rd = r2
               ai = 1. - ai
               GO TO 15
   14         CONTINUE
               r = r4
               rt = r3
               rr = r2
               rd = r1
               ai = 1. - ai
               aj = 1. - aj
   15        CONTINUE
C
C            IF NO RAIN IN CORNER SECTTOR  WHERE STATION IS - QUIT
C
             IF(r.LE.0.)  GO TO 150
             x = 0.5 * x
   16      CONTINUE
    1    CONTINUE
C
C        INTERPOLATE TO STATION IN EASY (NON-CORNER) SECTIONS
C
         GO TO (21, 22, 23, 24), ic
   21    CONTINUE
           amount = r
           GO TO 150
   22    CONTINUE
           rc = rt
           rx = aj
           GO TO 120
   23    CONTINUE
           rc = rr
           rx = ai
  120    CONTINUE
         IF(rc.GT. 0.)  GO TO 130
           amount = r - r*(rx-x)/x
           GO TO  150
  130    CONTINUE
           amount = r + (0.5*(r+rc)-r)*(rx-x)/x
           GO TO 150
   24    CONTINUE
C
C        CORNER (CENTER OF BOX) SECTION
C
           aa = amax1(rr, rt, rd)
           IF(aa.GT.0.)  GO TO 30
             rs = 0.
             ru = 0.
             rd = 0.
             GO TO 37
   30      CONTINUE
             IF(rr.GT.0.)  GO TO 32
               rs = 0.
               rrd = 0.
   33        CONTINUE
               IF(rt.GT.0.)  GO TO 34
                 ru = 0.
                 rtd = 0.
                 GO TO 35
   34          CONTINUE
                 ru = 0.5 * (r+rt)
                 IF(rd.GT.0.)  GO TO 36
                   rtd = 0.
                   GO TO 35
   36            CONTINUE
                   rtd = 0.5 * (rt + rd)
                   GO TO 35
   32        CONTINUE
               rs = 0.5 * (r+rr)
               IF(rd.GT.0.)  GO TO 38
                 rrd = 0.
                 GO TO 33
   38          CONTINUE
                 rrd = 0.5 * (rd + rr)
                 GO TO 33
   35        CONTINUE
               rd = 0.25 * (rs + ru + rtd + rrd)
               IF(rs.LE.0. .AND. rtd.LE.0.) rd = 0.
               IF(ru.LE.0..AND.rrd.LE.0.)  rd=0.
               ru = ru + (rd-ru) * (ai-x)/x
   37      CONTINUE
           r = r + (rs-r) * (ai-x)/x
           amount = r + (ru-r) * (aj-x)/x
  150    CONTINUE
         RETURN
C
         END