SUBROUTINE VFRAC(im,jm,glat,glon,TLM0D,TPH0D,DLMD,DPHD,SM,
     +  SICE,VEGFRC)

	real*4 glat(IM,JM), glon(IM,JM)
	real*4 TLM0D,TPH0D,DLMD,DPHD
	real*4 sm(im,jm),sice(im,jm),vegfrc(im,jm)
	real*4 dum2(im,jm),dum2b(im,jm)
	integer*4 JULD,MON2,MON1,day1,day2,JULM(13)
        real*4 wght1,wght2,rday,dtr
	INTEGER IDAT(3)

      data JULM/0,31,59,90,120,151,181,212,243,273,304,334,365/

       INTEGER KPDS(200),KGDS(200),JPDS(200),JGDS(200),KF,KNUM
       REAL*4 FPAR1(2500,1250),FPAR2(2500,1250),FSVE
       LOGICAL BITMAP(2500,1250)

        common /mytime/idat

C    FOURTH, MONTHLY GREEN VEG FRACTION, INTERPOLATE TO DAY OF YEAR.
C    THE MONTHLY FIELDS ASSUMED VALID AT 15TH OF MONTH.
C    VALUES RANGE FROM 0.001 TO 1.0 OVER LAND, 0.0 OVER WATER.
C    INTERPOLATE IN SPACE.
C
C    READ FROM A FILE THAT HAS 13 RECORDS, ONE PER MONTH WITH
C    JANUARY OCCURRING BOTH AS RECORD 1 AND AGAIN AS RECORD 13,
C    THE LATTER TO SIMPLIFY TIME INTERPOLATION FOR DAYS
C    BETWEEN DEC 16 AND JAN 15. WE TREAT JAN 1 TO JAN 15
C    AS JULIAN DAYS 366 TO 380 BELOW, I.E WRAP AROUND YEAR.
C *** THE FOLLOWING PART WAS REVISED BY F. CHEN 7/96 TO REFLECT
C        A NEW NESDIS VEGETATION FRACTION PRODUCT (FIVE-YEAR
C        CLIMATOLOGY WITH 0.144 DEGREE RESOLUTION
C        FROM 89.928S, 180W TO 89.928N, 180E)
C
       REWIND 38
C
C ****  DO TIME INTERPOLATION ****
       JULD=JULM(IDAT(1))+IDAT(2)
       IF(JULD.LE.15) JULD=JULD+365
       MON2=IDAT(1)
       IF(IDAT(2).GT.15) MON2=MON2+1
       IF(MON2.EQ.1) MON2=13
       MON1=MON2-1
C **** ASSUME DATA VALID AT 15TH OF MONTH
       DAY2=JULM(MON2)+15
       DAY1=JULM(MON1)+15
       RDAY=JULD
       WGHT1=(DAY2-RDAY)/(DAY2-DAY1)
       WGHT2=(RDAY-DAY1)/(DAY2-DAY1)
C
        CALL BAOPEN(38,'veg.eta.grb',IERR)
       JPDS = -1
       CALL GETGB(38,0,2500*1250,MON1-1,JPDS,JGDS,KF,KNUM,
     &    KPDS,KGDS,BITMAP,FPAR1,IERR)
       WRITE(6,*) 'AFTER GETGB FOR MONTH ', MON1,' IRET=', IERR
C
       JPDS = -1
       CALL GETGB(38,0,2500*1250,MON2-1,JPDS,JGDS,KF,KNUM,
     &    KPDS,KGDS,BITMAP,FPAR2,IERR)
       WRITE(6,*) 'AFTER GETGB FOR MONTH ', MON2,' IRET=', IERR
C
       DO JJ=1,1250
        DO I=1,2500
         FSVE=WGHT1*FPAR1(I,JJ)+WGHT2*FPAR2(I,JJ)
         FPAR1(I,JJ)=FSVE
        END DO
       END DO
c
C ** SPACE INTERPOLATION OF FPAR1 TO E GRID

	dtr=acos(-1.)/180.
        glat=glat/dtr
        glon=glon/dtr
        write(6,*) 'lat and lon for PUTVEG ', glat(im/2,jm/2),
     +  glon(im/2,jm/2)
       CALL PUTVEG(TLM0D,TPH0D,DLMD,DPHD,GLAT,GLON,
     &             FPAR1,SM,SICE,vegfrc)
	write(6,*) 'veg fracs ', vegfrc(im/2,jm/2),vegfrc(im/2+5,jm/2+5)

	RETURN
	END