Skip to content

Commit

Permalink
Merge pull request #867 from mpaiao/mpaiao-pr-ctarget
Browse files Browse the repository at this point in the history 
Updates to target carbon sub-routine to improve readability
  • Loading branch information
@glemieux
glemieux authored Jun 2, 2022
2 parents cf00fd3 + 516956d commit d6b3f3d
Show file tree
Hide file tree
Showing 2 changed files with 211 additions and 173 deletions.
150 changes: 86 additions & 64 deletions parteh/PRTAllometricCNPMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2222,72 +2222,94 @@ end function AllomCNPGrowthDeriv

! ====================================================================================

subroutine TargetAllometryCheck(bleaf,bfroot,bsap,bstore,bdead, &
bt_leaf,bt_froot,bt_sap,bt_store,bt_dead, &
grow_leaf,grow_froot,grow_sapw,grow_store)

! Arguments
real(r8),intent(in) :: bleaf !actual
real(r8),intent(in) :: bfroot
real(r8),intent(in) :: bsap
real(r8),intent(in) :: bstore
real(r8),intent(in) :: bdead
real(r8),intent(in) :: bt_leaf !target
real(r8),intent(in) :: bt_froot
real(r8),intent(in) :: bt_sap
real(r8),intent(in) :: bt_store
real(r8),intent(in) :: bt_dead
logical,intent(out) :: grow_leaf !growth flag
logical,intent(out) :: grow_froot
logical,intent(out) :: grow_sapw
logical,intent(out) :: grow_store

if( (bt_leaf - bleaf)>calloc_abs_error) then
write(fates_log(),*) 'leaves are not on-allometry at the growth step'
write(fates_log(),*) 'exiting',bleaf,bt_leaf
call endrun(msg=errMsg(sourcefile, __LINE__))
elseif( (bleaf - bt_leaf)>calloc_abs_error) then
! leaf is above allometry, ignore
grow_leaf = .false.
else
grow_leaf = .true.
end if

if( (bt_froot - bfroot)>calloc_abs_error) then
write(fates_log(),*) 'fineroots are not on-allometry at the growth step'
write(fates_log(),*) 'exiting',bfroot, bt_froot
call endrun(msg=errMsg(sourcefile, __LINE__))
elseif( ( bfroot-bt_froot)>calloc_abs_error ) then
grow_froot = .false.
else
grow_froot = .true.
end if

if( (bt_sap - bsap)>calloc_abs_error) then
write(fates_log(),*) 'sapwood is not on-allometry at the growth step'
write(fates_log(),*) 'exiting',bsap, bt_sap
call endrun(msg=errMsg(sourcefile, __LINE__))
elseif( ( bsap-bt_sap)>calloc_abs_error ) then
grow_sapw = .false.
else
grow_sapw = .true.
end if
subroutine TargetAllometryCheck(b0_leaf,b0_fnrt,b0_sapw,b0_store,b0_struct, &
bleaf,bfnrt,bsapw,bstore,bstruct, &
bt_leaf,bt_fnrt,bt_sapw,bt_store,bt_struct, &
carbon_balance,ipft,leaf_status, &
grow_leaf,grow_fnrt,grow_sapw,grow_store,grow_struct)

if( (bt_store - bstore)>calloc_abs_error) then
write(fates_log(),*) 'storage is not on-allometry at the growth step'
write(fates_log(),*) 'exiting',bstore,bt_store
call endrun(msg=errMsg(sourcefile, __LINE__))
elseif( ( bstore-bt_store)>calloc_abs_error ) then
grow_store = .false.
else
grow_store = .true.
end if
! Arguments
real(r8),intent(in) :: b0_leaf !initial
real(r8),intent(in) :: b0_fnrt
real(r8),intent(in) :: b0_sapw
real(r8),intent(in) :: b0_store
real(r8),intent(in) :: b0_struct
real(r8),intent(in) :: bleaf !actual
real(r8),intent(in) :: bfnrt
real(r8),intent(in) :: bsapw
real(r8),intent(in) :: bstore
real(r8),intent(in) :: bstruct
real(r8),intent(in) :: bt_leaf !target
real(r8),intent(in) :: bt_fnrt
real(r8),intent(in) :: bt_sapw
real(r8),intent(in) :: bt_store
real(r8),intent(in) :: bt_struct
real(r8),intent(in) :: carbon_balance !remaining carbon balance
integer,intent(in) :: ipft !Plant functional type
integer,intent(in) :: leaf_status !Phenology status
logical,intent(out) :: grow_leaf !growth flag
logical,intent(out) :: grow_fnrt
logical,intent(out) :: grow_sapw
logical,intent(out) :: grow_store
logical,intent(out) :: grow_struct
! Local variables
logical :: fine_leaf
logical :: fine_fnrt
logical :: fine_sapw
logical :: fine_store
logical :: fine_struct
logical :: all_fine
! Local constants
character(len= 3), parameter :: fmth = '(a)'
character(len=27), parameter :: fmtb = '(a,3(1x,es12.5,1x,a),1x,l1)'
character(len=13), parameter :: fmte = '(a,1x,es12.5)'
character(len=10), parameter :: fmti = '(a,1x,i12)'


! First test whether or not each pool looks reasonable.
fine_leaf = (bt_leaf - bleaf ) <= calloc_abs_error
fine_fnrt = (bt_fnrt - bfnrt ) <= calloc_abs_error
fine_sapw = (bt_sapw - bsapw ) <= calloc_abs_error
fine_store = (bt_store - bstore ) <= calloc_abs_error
fine_struct = (bt_struct - bstruct) <= calloc_abs_error
all_fine = fine_leaf .and. fine_fnrt .and. fine_sapw .and. &
fine_store .and. fine_struct

! Decide whether or not to grow tissues (but only if all tissues look fine).
! We grow only when biomass is less than target biomass (with tolerance).
if (all_fine) then
grow_leaf = ( bleaf - bt_leaf ) <= calloc_abs_error
grow_fnrt = ( bfnrt - bt_fnrt ) <= calloc_abs_error
grow_sapw = ( bsapw - bt_sapw ) <= calloc_abs_error
grow_store = ( bstore - bt_store ) <= calloc_abs_error
grow_struct = ( bstruct - bt_struct ) <= calloc_abs_error
else
! If anything looks not fine, write a detailed report
write(fates_log(),fmt=fmth) '======'
write(fates_log(),fmt=fmth) ' At least one tissue is not on-allometry at the growth step'
write(fates_log(),fmt=fmth) '======'
write(fates_log(),fmt=fmth) ''
write(fates_log(),fmt=fmth) ' Biomass and on-allometry test (''F'' means problem)'
write(fates_log(),fmt=fmth) '------'
write(fates_log(),fmt=fmth) ' Tissue | Initial | Current | Target | On-allometry'
write(fates_log(),fmt=fmtb) ' Leaf |',b0_leaf ,'|',bleaf ,'|',bt_leaf ,'|',fine_leaf
write(fates_log(),fmt=fmtb) ' Fine root |',b0_fnrt ,'|',bfnrt ,'|',bt_fnrt ,'|',fine_fnrt
write(fates_log(),fmt=fmtb) ' Sap wood |',b0_sapw ,'|',bsapw ,'|',bt_sapw ,'|',fine_sapw
write(fates_log(),fmt=fmtb) ' Storage |',b0_store ,'|',bstore ,'|',bt_store ,'|',fine_store
write(fates_log(),fmt=fmtb) ' Structural |',b0_struct ,'|',bstruct ,'|',bt_struct ,'|',fine_struct
write(fates_log(),fmt=fmth) ''
write(fates_log(),fmt=fmth) ' Ancillary information'
write(fates_log(),fmt=fmth) '------'
write(fates_log(),fmt=fmti) ' PFT = ',ipft
write(fates_log(),fmt=fmti) ' leaf_status = ',leaf_status
write(fates_log(),fmt=fmte) ' carbon_balance = ',carbon_balance
write(fates_log(),fmt=fmte) ' calloc_abs_error = ',calloc_abs_error
write(fates_log(),fmt=fmth) ''
write(fates_log(),fmt=fmth) '======'
call endrun(msg=errMsg(sourcefile, __LINE__))
end if

if( (bt_dead - bdead)>calloc_abs_error) then
write(fates_log(),*) 'structure not on-allometry at the growth step'
write(fates_log(),*) 'exiting',bdead,bt_dead
call endrun(msg=errMsg(sourcefile, __LINE__))
end if
return
end subroutine TargetAllometryCheck


Expand Down
Loading

0 comments on commit d6b3f3d

Please sign in to comment.