c     file: cprnl.for

c     Author : Amare Retta
      subroutine cprnl (hmx,day,mo,yr)

c     + + + PURPOSE + + +
c     Performs mass balances whenever a perennial crop such as alfalfa is
c     cut(non-killing harvest). This routine is called if the harvest is
c     a killing or a non-killing harvest. 12/8/1995
c
c     + + + KEYWORDS + + +
c     perennial crops, harvest

c     + + + ARGUEMENT DECLARATIONS + + +
      integer   day, mo, yr
      real hmx
c     + + + ARGUEMENT DEFINITIONS + + +
c     slai - leaf area index
c     dmag - stress adjusted aboveground biommass (t/ha)
c     day - day of month
c     mo - month of year
c     yr - year

C     + + + LOCAL VARIABLE DECLARATIONS + + +
      real adj
c     + + + LOCAL VARIABLE DEFINITIONS + + +

c     adj - ratio of cut height to maximum height.
c
c     + + + SUBROUTINES CALLED + + +
c     none
c     + + + GLOBAL COMMON BLOCKS + + +
c*$noreference
       include 'm1flag.inc'
       include 'm1dbug.inc'

c     + + + COMMON BLOCKS + + +
       include 'crop/cgrow.inc'
       include 'crop/cenvr.inc'
       include 'manage/oper.inc'
*$reference

c     + + + VARIABLE DEFINITIONS + + +

c     cta - actual transpiration (mm)
c     ctab - periodic actual transpiration (mm)
c     ctay - periodic actual transpiration (mm)
c     ctas - seasonal actual transpiration (mm)
c     ceta - actual evapotranspiration (mm)
c     cetab - periodic actual evapotranspiration (mm)
c     cetay - periodic actual evapotranspiration (mm)
c     cetas - seasonal actual evapotranspiration (mm)
c     ctpb - periodic potential transpiration (mm)
c     ctpy - periodic potential transpiration (mm)
c     ctps - seasonal potential transpiration (mm)
c     clfwt - leaf mass (t/ha)
c     clfwtb - periodic leaf mass (t/ha)
c     clfwts - seasonal leaf mass (t/ha)
c     clfwty - periodic leaf mass (t/ha)
c     cstwt - stem mass (t/ha)
c     cstwtb - periodic stem mass (t/ha)
c     cstwts - seasonal stem mass (t/ha)
c     cstwty - periodic stem mass (t/ha)
c     crpwt - rprd (reproductive) mass (t/ha)
c     crpwtb - periodic rprd mass (t/ha)
c     crpwts - seasonal rprd mass (t/ha)
c     crpwty - periodic rprd mass (t/ha)
c     dmagb - periodic above-ground biomass (t/ha)
c     dmags - seaonal above-ground biomass (t/ha)
c     dmagy - periodic above-ground biomass (t/ha)
c     prcp - precpitation (mm)
c     prcb - periodic precipitation (mm)
c     prcpy - periodic prcepitation (previous value) (mm)
c     prcps - seasonal precipitation (mm)

c     + + + OUTPUT FORMATS + + +
 2012 format(1x,3(i4,1x),10(f6.1,1x))
 2013 format(1x,i4,1x,9(f6.1,1x))
c     + + + END OF SPECIFICATIONS + + +

c        write (*,*) am0hrvfl
c     calculate periodic and annual et
      if (am0hrvfl.gt.0.or.jd.eq.365) then
         ctab=cta-ctay
         cetab=ceta-cetay
         ctas=ctas+ctab
         cetas=cetas+cetab
         ctay=cta
         cetay=ceta
         prcpb=prcp-prcpy
         prcps=prcps+prcpb
         prcpy=prcp
         ctpb=ctp-ctpy
         ctps=ctps+ctpb
         ctpy=ctp
c        calculate periodic and annual masses
         clfwty=clfwt*cutht/hmx
         cstwty=cstwt*cutht/hmx
         crpwty=0.
         dmagy=clfwty+cstwty
         clfwtb=clfwt-clfwty
         cstwtb=cstwt-cstwty
         crpwtb=crpwt-crpwty
         dmagb=dmag-dmagy
         clfwts=clfwts+clfwtb
         cstwts=cstwts+cstwtb
         crpwts=crpwts+crpwtb
         dmags=dmags+dmagb
c        periodic print following a non-killing harvest
      if (am0cdb.eq.2) then
         if (am0hrvfl.eq.1) write (58,2012)day,mo,yr,cht,clfwtb,cstwtb,
     &   crpwtb,yld,dmagb,ctab,cetab,prcpb,ctpb
c        print end-of-season values of perennial crops and initialize
         if (am0hrvfl.eq.2.or.jd.eq.365) write (59,2013)yr,clfwts,
     &   cstwts,crpwts,yld,dmags,ctas,cetas,prcps,ctps
       endif
c        initialize following a cutting operation
         cta=0.
         ctay=0.
         ceta=0.
         cetay=0.
         prcp=0.
         prcpy=0.
         ctp=0.
         ctpy=0.
         adj=cutht/hmx
         slai=slai*adj
         ssai=ssai*adj
         if (slai.gt.0.1) slai=0.1
         if (slai.lt.0.05) slai=0.05
         if (ssai.gt.0.1) ssai=0.1
         if (ssai.lt.0.05) ssai=0.05
         clfwt=clfwt*adj
         cstwt=cstwt*adj
         crpwt=0.
         dmag=clfwt+cstwt
         pclfwt=pclfwt*adj
         pcstwt=pcstwt*adj
         pdmag=pclfwt+pcstwt
c        rw=acmrt(am0csr)
         pdm=pdmag+prw
         dm=dmag+rw
         clfarea=slai*parea
         cstarea=ssai*parea
         pclfarea=clfarea
         pcstarea=cstarea
         cht=cutht
         pcht=cutht
         shu=110.
      endif

 995  continue
c     initialize after end-of-season output
c     if (am0hrvfl.eq.2.or.hui.ge.1..or.jd.eq.365) then
      if (am0hrvfl.eq.2.or.jd.eq.365) then
         ctab=0.
         cetab=0.
         ctas=0.
         cetas=0.
         ctay=0.
         cetay=0.
         prcp=0.
         prcpb=0.
         prcps=0.
         prcpy=0.
         ctp=0.
         ctpb=0.
         ctps=0.
         ctpy=0.
         clfwtb=0.
         cstwtb=0.
         crpwtb=0.
         dmagb=0.
         clfwts=0.
         cstwts=0.
         crpwts=0.
         dmags=0.
         clfwty=0.
         cstwty=0.
         crpwty=0.
         dmagy=0.
         rw=0.
      endif

c999  continue

      am0hrvfl=0

c     write (58,2016)ctab,cta,ctay,cetab,ceta,cetay,ctas,clfwtb,clfwt,
c    & clfwty,cstwtb,cstwt,cstwty,cutht,cht,adj
c ------- start debug
        write (*,*)'out of cprnl, slai=',slai
c --------end debug        
      return
      end