c file: dechrv.for subroutine dechrv ( & isr, cropname, standmass, flatmass, & bgmass, rootmass, hrvht, croppop) c + + + PURPOSE + + + c transferes of mass, stem numbers, dkrates and other information from one c pool to the next following crop harvest. c It can be called from management or decomp. c + + + Global Variables + + + *$noreference include 'p1werm.inc' include 's1layr.inc' include 'c1info.inc' include 'd1gen.inc' include 'd1glob.inc' include 'decomp/decomp.inc' *$reference c + + + ARGUMENT DECLARATIONS + + + character cropname*80 integer isr real standmass real flatmass real bgmass(mnsz) real rootmass(mnsz) real hrvht real croppop c + + + ARGUMENT DEFINITIONS + + + c cropname - name of crop harvested c standmass- mass of standing residue c flatmass - amount of residue on the surface c bgmass - mass belowground c rootmass - root mass c hrvht - harvest height height of standing residue c croppop - number of standing stems c + + + LOCAL VARIABLE DECLARATION + + + c character infile2*80 character resname*80 character dumchar*80 character dummy*80 character line*80 integer i,jj,ii,lchar c logical fexist c + + + LOCAL VARIABLE DEFINITIONS + + + c c dumchar- dummy character string holding partial contents of a line c dummy - dummy character string holding partial contents of a line c infile - decomposition initialization file name c line - holds the contents of each line as it is read c lchar - character holder c infile2- decomposition parameters c resname- name of harvested crop c + + + DATA INITIALIZATION + + + c infile2 = '../run/decomp.dat' c + + + END OF SPECIFICATIONS + + + c Move CUMM DDAYS to next age pool for s standing, f flat, and c g below ground pools cumdds(3,isr) = cumdds(2,isr) cumdds(2,isr) = cumdds(1,isr) cumdds(1,isr) = 0.0 cumddf(3,isr) = cumddf(2,isr) cumddf(2,isr) = cumddf(1,isr) cumddf(1,isr) = 0.0 do 10 isz = 1, nslay(isr) cumddg(3, isz,isr) = cumddg(3,isz,isr) cumddg(2, isz,isr) = cumddg(1,isz,isr) cumddg(1, isz,isr) = 0.0 10 continue c MOVE MASS to next pool for standing, flat, and belowground c and root residues. Initalize new residue mass. c NEED VARIABLE NAMES FOR CROP BIOMASS FOLLOWING HARVEST ?????? dmfbm(3,isr) = dmfbm(2,isr) + dmfbm(3,isr) + dmsbm(3,isr) dmfbm(2,isr) = dmfbm(1,isr) c ! variable name ?? c print *, 'dmfbm before dechrv.for', dmfbm(1,isr) dmfbm(1,isr) = flatmass c print *, 'dmfbm after dechrv.for', dmfbm(1,isr) c admf(1,isr)= dmfbm(1,isr) dmsbm(3,isr) = dmsbm(2,isr) dmsbm(2,isr) = dmsbm(1,isr) c variable name ??? dmsbm(1,isr) = standmass c admst(1,isr)= dmsbm(1,isr) do 20 isz = 1, nslay(isr) dmgbm(3,isz,isr) = dmgbm(3,isz,isr) + dmgbm(2,isz,isr) dmgbm(2,isz,isr) = dmgbm(1,isz,isr) dmgbm(1,isz,isr) = bgmass(isz) dmrbm(3,isz,isr) = dmrbm(3,isz,isr) + dmrbm(2,isz,isr) dmrbm(2,isz,isr) = dmrbm(1,isz,isr) dmrbm(1,isz,isr) = rootmass(isz) c Update the global variables after a killing operation has been c performed. These are updated for both pool and layers. do 21 iage = 1,mnbpls admbgz(isz,iage,isr) = dmgbm(iage,isz,isr) admrtz(isz,iage,isr) = dmrbm(iage,isz,isr) 21 continue 20 continue c Update the global variables after a killing operation has been c performed. These are updated for pool only. do 23 iage = 1, mnbpls admst(iage,isr)= dmsbm(iage,isr) admf(iage,isr)= dmfbm(iage,isr) 23 continue c c Initialize and move stem numbers, diameters and ht c stmno(3,isr) = stmno(2,isr) stmno(2,isr) = stmno(1,isr) stmno(1,isr) = croppop stmdiam(3,isr) = stmdiam(2,isr) stmdiam(2,isr) = stmdiam(1,isr) stmht(3,isr) = stmht(2,isr) stmht(2,isr) = stmht(1,isr) stmht(1,isr) = hrvht c Update the global variables after a killing operation has been c performed. These are updated for pool only. do 22 iage = 1, mnbpls addstm(iage,isr) = stmno(iage,isr) adzht(iage,isr) = stmht(iage,isr) 22 continue c move decomposition rate from pool 1 to 2 to 3 c dkrate (position, age) stand, flat, buried, roots, stem no 1-5 c position 1, 2 , 3, 4, 5 c max age 2, 3 , 2, 2, 2 c standing c c standing pool 3 is currently set to decompose at a constant rate ANH. dkrate(1,3,isr) = 0.0010 dkrate(1,2,isr) = dkrate(1,1,isr) c flat c pool 3 decomposes at a constant rate not related to crop type dkrate(2,3,isr) = 0.0010 dkrate(2,2,isr) = dkrate(2,1,isr) c buried c c buried pool 3 is currently set to decomose at a constant rate ANH. dkrate(3,3,isr) = 0.0010 dkrate(3,2,isr) = dkrate(3,1,isr) c roots c c roots pool 3 is currently set to decomose at a constant rate ANH. dkrate(4,3,isr) = 0.0010 dkrate(4,2,isr) = dkrate(4,1,isr) c stem numbers c c stem numbers pool 3 is currently set to decomose at a constant rate ANH. dkrate(5,3,isr) = 0.0010 dkrate(5,2,isr) = dkrate(5,1,isr) c Transfer coefficient for estimation of soil surface cover covfact(2,isr) = covfact(1,isr) covfact(3,isr) = covfact(1,isr) c Change crop residue id for initializing dkrates ad0nam(isr) = cropname ac0nam(isr) = ad0nam(isr) c The next section gets the paramters needed by the decomp model c for the new crop residue type. The data is retrieved from the c decomp.dat file. c inquire(file=infile2, exist=fexist) c if(.not.fexist) write(*,*) infile2, 'not found' c if(.not.fexist) goto 80 c open (unit = 54, file = infile2) 205 read (31,'(a)') line if (line(1:1) .eq. '#') go to 205 lchar = 0 jj=1 207 lchar=lchar+1 if (line(lchar:lchar) .eq. ' ') goto 207 do ii=lchar,71 read (line(lchar:lchar), '(a)') dumchar(jj:jj) if (line(lchar:lchar) .eq. ' ') then if (line(lchar+1:lchar+1) .eq. ' ') goto 210 endif lchar=lchar+1 jj=jj+1 end do 210 resname=dumchar do ii=1,jj dumchar(ii:ii) = ' ' enddo c if harvest before first plant use default values if (resname .eq. 'no_crop') then write(*,*) ' the selected crop - ',ad0nam(isr),' is not in the &database -- using winter wheat dk rates' go to 208 end if dummy = ad0nam(isr) do ii=1,jj-1 if(resname(ii:ii) .ne. dummy(ii:ii)) then do i = 1,6 read (31,'(a)') line end do goto 205 end if end do c skip crop parameters do 209 i=1,5 read (31,'(a)') line 209 continue 208 read (31,*,err=80) dkrate(1,1,isr), dkrate(2,1,isr), & dkrate(3,1,isr), dkrate(4,1,isr), dkrate(5,1,isr), & stmdiam(1,isr), ddsthrsh(1,isr), covfact(1,isr) c go back to top of file to be ready for next crop rewind(unit = 31) goto 900 80 write(*,*) 'error reading crop.db file decomp parameters' 900 continue return end