      SUBROUTINE INTERP3(IBUF,RES,RE1,RE2,GC,GC1,GC2,IDD,MAXX,NF)
C 
C     * MAR 30/1989 M.LAZARE. - BASED ON INTERP2 EXCEPT GROUND COVER
C     *                         INFORMATION PASSED IN RESIDUAL FIELDS 
C     *                         AND USED TO HANDLE GROUND COVER 
C     *                         TRANSITION MONTHS "PROPERLY". 
C     * OCT 11,1984 T.CARRIERES 
C 
C     * OBTAINS RESIDUAL FIELDS FOR CURRENT DAY.
C 
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)

      REAL RES(LON,LY),RE1(LON,LY),RE2(LON,LY)
      REAL  GC(LON,LY),GC1(LON,LY),GC2(LON,LY)
      INTEGER MMD(12) 
      INTEGER IBUF(8) 
      LOGICAL OK
      COMMON/DIM/ LON,LX,LY 
      DATA MMD/16,46,75,106,136,167,197,228,259,289,320,350/
      DATA RESH,RENH/14.0, 1.0/ 
C---------------------------------------------------------------------
      ID=IDD
      ID=MOD(ID,365)
C 
C     * DETERMINE WHICH MONTHS TO INTERPOLATE BETWEEN.
C 
      DO 100 M=1,12 
  100 IF(ID.LE.MMD(M)) GO TO 150
C 
C     * ID IS AFTER DEC 16. 
C 
      M1=12 
      M2=1
      W1=FLOAT(MMD(1)-ID+365) 
      W2=FLOAT(ID-MMD(12))
      GO TO 200 
  150 M1=M-1
      IF(M1.LT.1) THEN
C 
C     * ID IS BEFORE JAN 16.
C 
         M1=12
         M2=1 
         W1=FLOAT(MMD(1)-ID)
         W2=FLOAT(ID-MMD(12)+365) 
      ELSE
C 
C     * ID IS BETWEEN JAN 16 AND DEC 16.
C 
         M2=M 
         W1=FLOAT(MMD(M2)-ID) 
         W2=FLOAT(ID-MMD(M1)) 
      ENDIF 
C 
C     * GET GC/RESIDUAL VALUES FOR MONTHS M1 AND M2.
C 
  200 CALL GETFLD2(-NF,RE1,NC4TO8("GRID"),M1,NC4TO8(" RES"),1,
     1                                           IBUF,MAXX,OK)
      WRITE(6,6000) IBUF
      IF(.NOT.OK) CALL XIT('INTERP3',-1)
C 
      CALL GETFLD2(-NF,RE2,NC4TO8("GRID"),M2,NC4TO8(" RES"),1,
     1                                           IBUF,MAXX,OK)
      WRITE(6,6000) IBUF
      IF(.NOT.OK) CALL XIT('INTERP3',-2)
C 
C     * DECOMPOSE INFORMATION IN FILES INTO ACTUAL GROUND COVER AND 
C     * RESIDUAL. 
C 
      DO 225 J=1,LY 
      DO 225 I=1,LX 
        IF(ABS(GC(I,J)).LT.0.5) GC(I,J)=0.0 
        IF(RE1(I,J).GT.10000.) THEN 
           GC1(I,J)=1.0 
           RE1(I,J)=RE1(I,J)-100000.
        ELSE IF(RE1(I,J).LT.-10000.) THEN 
           GC1(I,J)=-1.0
           RE1(I,J)=0.0 
        ELSE
           GC1(I,J)=0.0 
        ENDIF 
C 
        IF(RE2(I,J).GT.10000.) THEN 
           GC2(I,J)=1.0 
           RE2(I,J)=RE2(I,J)-100000.
        ELSE IF(RE2(I,J).LT.-10000.) THEN 
           GC2(I,J)=-1.0
           RE2(I,J)=0.0 
        ELSE
           GC2(I,J)=0.0 
        ENDIF 
  225 CONTINUE
C 
C     * PERFORM LINEAR INTERPOLATION BETWEEN MONTHS M1 AND M2 IF CURRENT
C     * GROUND COVER IS SAME AS CLIMATOLOGY FOR BOTH ADJACENT MONTHS. 
C 
C     * IF THE POINT WAS CHANGING GROUND COVER DURING THE BASE RUN
C     * THEN USE THE RESIDUAL VALUE FOR SAME GROUND COVER TYPE
C     * AS CURRENTLY EXISTS IN INTERACTIVE RUN. BOUND VALUE BY ZERO TO
C     * GIVE CORRECT TREND IN GROUND COVER BASED ON CLIMATOLOGY.
C 
C     * OTHERWISE, SET VALUE TO ZERO. 
C 
      LYO2=LY/2 
      DO 250 J=1,LY 
      DO 250 I=1,LX 
         IF(GC(I,J).EQ.GC1(I,J).AND.GC(I,J).EQ.GC2(I,J)) THEN 
            RES(I,J)=(W1*RE1(I,J)+W2*RE2(I,J))/(W1+W2)
         ELSE IF(GC(I,J).EQ.GC1(I,J)) THEN
            IF(GC1(I,J).EQ.1.0) THEN
               RES(I,J)=MAX(RE1(I,J),0.)
            ELSE IF(GC1(I,J).EQ.0.0) THEN 
               RES(I,J)=MIN(RE1(I,J),0.)
            ELSE
               CALL XIT('INTERP3',-3) 
            ENDIF 
         ELSE IF(GC(I,J).EQ.GC2(I,J)) THEN
            RES(I,J)=RE2(I,J) 
         ELSE 
          IF(GC(I,J).EQ.1.0) THEN 
             IF(J.LE.LYO2) THEN 
                RES(I,J)=RESH 
             ELSE 
                RES(I,J)=RENH 
             ENDIF
          ELSE
             RES(I,J)=0.0 
          ENDIF 
            WRITE(6,6020) I,J,GC(I,J),GC1(I,J),GC2(I,J),RES(I,J)
         ENDIF
         IF(ABS(RES(I,J)).GT.1000.) THEN
            WRITE(6,6040) I,J,GC(I,J),GC1(I,J),GC2(I,J),RES(I,J), 
     1                    RE1(I,J),RE2(I,J) 
            CALL XIT('INTERP3',-4)
         ENDIF
  250 CONTINUE
C---------------------------------------------------------------------
 6000 FORMAT(' ',A4,I10,2X,A4,5I6)
 6020 FORMAT(' AT (I,J)=(',I3,',',I3,'), GC,GC1,GC2= ',3(F6.2),' SO RES=
     1 ',F8.2)
 6040 FORMAT(' AT (I,J)=(',I3,',',I3,'), GC,GC1,GC2,RES,RE1,RE2=',3F6.2,
     1        3E12.4) 
      RETURN
      END 
