       program writeveg
       REAL*4 FPAR1(2500,1250)
       REAL TPH0D,TLM0D,DLMD,DPHD,WBD,SBD,DT
       INTEGER KPDS(200),KGDS(200),JPDS(200),JGDS(200),KF,KNUM
       INTEGER i
       LOGICAL BITMAP(2500,1250)

	INCLUDE "parmeta"
       PARAMETER  (IMJM = IM*JM - JM/2, L0=2500*1250)
       
       REAL*4 VEGFRM(imjm)     ! monthly veg greeness
       DIMENSION SM(IMJM),SICE(IMJM)
Chou
Chou included undef and icethreshold to create sea-land-ice mask
                             P A R A M E T E R
     & (undef=-999.,  ziceth=270.2)
Chou 
                             P A R A M E T E R
     & (ITB=076,JTB=134,ITBQ=152,JTBQ=440)
                             P A R A M E T E R
     & (IM2=IM-2,JM1=JM-1,JM2=JM-2,JM3=JM-3,JM4=JM-4,JM5=JM-5
     &, JAM=6+2*(JM-10)
     &, KHN=IM-1,KHS=-IM
     &, KNE=IM    ,KNW=IM-1 ,KSW=-IM    ,KSE=-IM+1
     &, KHL00=1                    ,KHH00=IM*JM-JM/2 )  
C-----------------------------------------------------------------------
                             D I M E N S I O N
     & KHL0  (JM),KHH0  (JM),KVL0  (JM),KVH0  (JM)
     &,KHL1  (JM),KHH1  (JM),KVL1  (JM),KVH1  (JM)
     &,KHL3  (JM),KHH3  (JM),KVL3  (JM),KVH3  (JM)
     &,KHL4  (JM),KHH4  (JM),KVL4  (JM),KVH4  (JM)
     &,KHL5  (JM),KHH5  (JM),KVL5  (JM),KVH5  (JM)
     &,KHL6  (JM),KHH6  (JM),KVL6  (JM),KVH6  (JM)
     &,DXJ   (JM),WPDARJ(JM),CPGFUJ(JM),CURVJ (JM),FCPJ  (JM)
     &,FDIVJ (JM),EMJ   (JM),EMTJ  (JM),FADJ  (JM)
     &,DDMPUJ(JM),DDMPVJ(JM),HDACJ (JM)         

                             D I M E N S I O N
     & KHLA  (JAM),KHHA  (JAM),KVLA  (JAM),KVHA  (JAM)
     &,KHL2  (JM),KHH2  (JM),KVL2  (JM),KVH2  (JM)
     &,GLAT(IMJM), GLON(IMJM)
     
                                  D I M E N S I O N
     & RDETA (LM),F4Q2  (LM)
     &,EM    (JAM),EMT   (JAM)
     
c       TPH0D=-19.5
c       TLM0D=-54.5
c       DLMD=.2777777770000
c       DPHD=.2631578940000
c       WBD=-32.7777776860000
c       SBD=-32.6315788560000
c       DT=90.

       TLM0D=-60.0
       TPH0D=-16.0
       DLMD=.28846153850000000000
       DPHD=.26923076950000000000
       WBD=-65.19231
       SBD=-47.11539
       DT=90.

C--------------DERIVED GEOMETRICAL CONSTANTS----------------------------
      DTR=3.1415/180.
      TPH0=TPH0D*DTR
      WB=WBD*DTR
      SB=SBD*DTR
      DLM=DLMD*DTR
      DPH=DPHD*DTR
      TDLM=DLM+DLM
      TDPH=DPH+DPH
      RDLM=1./DLM
      RDPH=1./DPH
C
      WBI=WB+TDLM
      SBI=SB+TDPH
      EBI=WB+IM2*TDLM
      ANBI=SB+JM3*DPH
C
      STPH0=SIN(TPH0)
      CTPH0=COS(TPH0)
C---------------TIME STEPPING RELATED CONSTANTS-------------------------
      TSPH=3600./DT
      NDDAMP=TDDAMP*TSPH+.5
C
      DTAD=IDTAD
      DTCF=IDTCF
C--------------DERIVED HORIZONTAL GRID CONSTANTS------------------------
      DY=A*DPH
      CPGFV=-DT/(48.*DY)
      EN= DT/( 4.*DY)*DTAD
      ENT=DT/(16.*DY)*DTAD
C
      TPH=SB-DPH
              DO 140 J=1,JM
C
              KHL0(J)=IM*(J-1)-(J-1)/2+1
              KVL1(J)=IM*(J-1)-(J-1)/2+1
              KHL2(J)=IM*(J-1)-(J-1)/2+2
              KVL3(J)=IM*(J-1)-(J-1)/2+2
              KHL4(J)=IM*(J-1)-(J-1)/2+3
              KVL5(J)=IM*(J-1)-(J-1)/2+3
              KHL6(J)=IM*(J-1)-(J-1)/2+4
C
              KVL0(J)=IM*(J-1)-J/2+1
              KHL1(J)=IM*(J-1)-J/2+2
              KVL2(J)=IM*(J-1)-J/2+2
              KHL3(J)=IM*(J-1)-J/2+3
              KVL4(J)=IM*(J-1)-J/2+3
              KHL5(J)=IM*(J-1)-J/2+4
              KVL6(J)=IM*(J-1)-J/2+4
C
              KHH0(J)=IM*J-J/2
              KHH2(J)=IM*J-J/2-1
              KVH1(J)=IM*J-J/2-1
              KHH4(J)=IM*J-J/2-2
              KVH3(J)=IM*J-J/2-2
              KHH6(J)=IM*J-J/2-3
              KVH5(J)=IM*J-J/2-3
C
              KHH1(J)=IM*J-(J+1)/2
              KVH0(J)=IM*J-(J+1)/2
              KHH3(J)=IM*J-(J+1)/2-1
              KVH2(J)=IM*J-(J+1)/2-1
              KHH5(J)=IM*J-(J+1)/2-2
              KVH4(J)=IM*J-(J+1)/2-2
              KVH6(J)=IM*J-(J+1)/2-3
C
              TPH=TPH+DPH
              DXP=A*DLM*COS(TPH)
              DXJ(J)=DXP
CVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
C             WPDARJ(J)=-DT*W*100000./(32.*DXP*DY)
        WPDARJ(J)=-W*((A*DLM*AMIN1(COS(ANBI),COS(SBI)))**2+DY**2)
     2             /(DT*32.*DXP*DY)*.88
C    2             /(DT*32.*DXP*DY)
CAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
              CPGFUJ(J)=-DT/(48.*DXP)
              CURVJ(J)=.5*DT*TAN(TPH)/A
              FCPJ(J)=DT/(CP*192.*DXP*DY)
              FDIVJ(J)=1./(12.*DXP*DY)
              EMJ(J)= DT/( 4.*DXP)*DTAD
              EMTJ(J)=DT/(16.*DXP)*DTAD
              FADJ(J)=-DT/(48.*DXP*DY)*DTAD
CVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
C             ACDT=COAC*DT*DTCF
C             ACDT=COAC*DT
C    2            *SQRT((A*DLM*AMIN1(COS(ANBI),COS(SBI)))**2+DY**2)
              ACDT=DT
     2            *SQRT((A*DLM*AMIN1(COS(ANBI),COS(SBI)))**2+DY**2)
CAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
C             CDDAMP=CODAMP*ACDT
              CDDAMP=0.04*CODAMP*ACDT
C             HDACJ(J)=ACDT/(4.*DXP*DY)
              HDACJ(J)=COAC*ACDT/(4.*DXP*DY)
              DDMPUJ(J)=CDDAMP/DXP
              DDMPVJ(J)=CDDAMP/DY
 140  CONTINUE
C--------------SPREADING OF UPSTREAM HEIGHT-POINT ADVECTION FACTOR------
      JA=0
              DO 161 J=3,5
          JA=JA+1
          KHLA(JA)=KHL2(J)
          KHHA(JA)=KHH2(J)
 161      EMT(JA)=EMTJ(J)
              DO 162 J=JM4,JM2
          JA=JA+1
          KHLA(JA)=KHL2(J)
          KHHA(JA)=KHH2(J)
 162      EMT(JA)=EMTJ(J)
              DO 163 J=6,JM5
          JA=JA+1
          KHLA(JA)=KHL2(J)
          KHHA(JA)=KHL3(J)
 163      EMT(JA)=EMTJ(J)
              DO 164 J=6,JM5
          JA=JA+1
          KHLA(JA)=KHH3(J)
          KHHA(JA)=KHH2(J)
 164      EMT(JA)=EMTJ(J)
C--------------SPREADING OF UPSTREAM VELOCITY-POINT ADVECTION FACTOR----
      JA=0
              DO 171 J=3,5
          JA=JA+1
          KVLA(JA)=KVL2(J)
          KVHA(JA)=KVH2(J)
 171      EM(JA)=EMJ(J)
              DO 172 J=JM4,JM2
          JA=JA+1
          KVLA(JA)=KVL2(J)
          KVHA(JA)=KVH2(J)
 172      EM(JA)=EMJ(J)
              DO 173 J=6,JM5
          JA=JA+1
          KVLA(JA)=KVL2(J)
          KVHA(JA)=KVL3(J)
 173      EM(JA)=EMJ(J)
              DO 174 J=6,JM5
          JA=JA+1
          KVLA(JA)=KVH3(J)
          KVHA(JA)=KVH2(J)
 174      EM(JA)=EMJ(J)
C--------------CORIOLIS PARAMETER IN TLL SYSTEM & RELATED CONSTANTS-----
              TPH=SB-DPH
              DO 180 J=1,JM
              KVL=KVL0(J)
              KVH=KVH0(J)
C
              TLM=WB-TDLM+MOD(J,2)*DLM
              TPH=TPH+DPH
              STPH=SIN(TPH)
              CTPH=COS(TPH)
C
          DO 180 K=KVL,KVH
      TLM=TLM+TDLM
      FP=TWOM*(CTPH0*STPH+STPH0*CTPH*COS(TLM))
 180  continue
C--------------GEOGRAPHIC LAT AND LONG OF TLL GRID POINTS-----------
              TPH=SB-DPH
              DO 183 J=1,JM
              KHL=KHL0(J)
              KHH=KHH0(J)
C
              TLM=WB-TDLM+MOD(J+1,2)*DLM
              TPH=TPH+DPH
              STPH=SIN(TPH)
              CTPH=COS(TPH)
C
          DO 183 K=KHL,KHH
      TLM=TLM+TDLM
      SINPHI=CTPH0*STPH+STPH0*CTPH*COS(TLM)
      GLAT(K)=ASIN(SINPHI)
      COSLAM=CTPH*COS(TLM)/(COS(GLAT(K))*CTPH0)-TAN(GLAT(K))*
     1 TAN(TPH0)
      IF(COSLAM.GT.H1)COSLAM=H1
      IF(COSLAM.LT.-1.)COSLAM=-1.
      FACT=H1
      IF(TLM.GT.D00)FACT=HM1
      GLON(K)=-TLM0D*DTR+FACT*ACOS(COSLAM)
  183 CONTINUE
       
            
       CALL BAOPEN(38,'veg.eta.grb',IERR)
       JPDS = -1
       
       WRITE(6,*) KPDS
       
       OPEN(80,file='VEG_12.bin',form='unformatted',
     &        status='unknown')
       OPEN(83,file='VGREEN_greta_12mo.dat',form='unformatted',
     &        status='unknown')
     
       do i=1,12
       CALL GETGB(38,0,2500*1250,i-1,JPDS,JGDS,KF,KNUM,
     &    KPDS,KGDS,BITMAP,FPAR1,IERR)

       WRITE(13,*) i, KPDS, KGDS, JGDS, KF, KNUM
       WRITE(13,*) 'AFTER GETGB FOR MONTH ', i,' IRET=', IERR

       WRITE(80)  FPAR1
       
C      interpolate to Egrid.
       CALL PUTVEG(TLM0D,TPH0D,DLMD,DPHD,glat,glon,
     &             FPAR1,SM,SICE,vegfrm)
       write(83) vegfrm
       enddo
       
       END                     
