SUBROUTINE VFRAC(glat1,glon1,SM,SICE,VEGFRC,im,jm,nm,idat)

        include 'const.h'
        integer::im,jm,nm
	real:: glat1(0:im+1,0:jm+1,nm), glon1(0:im+1,0:jm+1,nm)
	real:: glat (0:im+1,0:jm+1,nm), glon (0:im+1,0:jm+1,nm)
	real:: sm(0:im+1,0:jm+1,nm),sice(0:im+1,0:jm+1,nm),vegfrc(0:im+1,0:jm+1,nm)
	real*4 dum2(0:im+1,0:jm+1,nm),dum2b(0:im+1,0:jm+1,nm)
        integer*4 JULD,MON2,MON1,day1,day2,JULM(13),INDAY,IOUTNUM,IIOUT,IHRST
        real*4 wght1,wght2,rday,dtr

      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)


!    FOURTH, MONTHLY GREEN VEG FRACTION, INTERPOLATE TO DAY OF YEAR.
!    THE MONTHLY FIELDS ASSUMED VALID AT 15TH OF MONTH.
!    VALUES RANGE FROM 0.001 TO 1.0 OVER LAND, 0.0 OVER WATER.
!    INTERPOLATE IN SPACE.
!
!    READ FROM A FILE THAT HAS 13 RECORDS, ONE PER MONTH WITH
!    JANUARY OCCURRING BOTH AS RECORD 1 AND AGAIN AS RECORD 13,
!    THE LATTER TO SIMPLIFY TIME INTERPOLATION FOR DAYS
!    BETWEEN DEC 16 AND JAN 15. WE TREAT JAN 1 TO JAN 15
!    AS JULIAN DAYS 366 TO 380 BELOW, I.E WRAP AROUND YEAR.
! *** THE FOLLOWING PART WAS REVISED BY F. CHEN 7/96 TO REFLECT
!        A NEW NESDIS VEGETATION FRACTION PRODUCT (FIVE-YEAR
!        CLIMATOLOGY WITH 0.144 DEGREE RESOLUTION
!        FROM 89.928S, 180W TO 89.928N, 180E)
!
       glon=-glon1
       glat=glat1
       REWIND 38

     write(0,*) "In vfrac", IDAT(1),IDAT(2),IDAT(3)

!
! ****  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
! **** 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)
!
       CALL BAOPENR(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(0,*) 'AFTER GETGB FOR MONTH ', MON1,' IRET=', IERR
!
       JPDS = -1
       CALL GETGB(38,0,2500*1250,MON2-1,JPDS,JGDS,KF,KNUM,  &
          KPDS,KGDS,BITMAP,FPAR2,IERR)
       WRITE(0,*) 'AFTER GETGB FOR MONTH ', MON2,' IRET=', IERR
!
       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
!
! ** SPACE INTERPOLATION OF FPAR1 TO E GRID
!
       write(0,*) 'lat and lon for PUTVEG ', glat(im/2,jm/2,nm),glon(im/2,jm/2,nm)

       CALL PUTVEG(GLAT,GLON,FPAR1,SM,SICE,vegfrc,im,jm,nm)
!       write(0,*)'vegfrc=',vegfrc
!       print*,'vegfrc=',vegfrc
       RETURN
       END