Skip to content

Commit

Permalink
Merge pull request #369 from rgknox/rgknox-pgi-fixes
Browse files Browse the repository at this point in the history 
fixes for pgi (ornl) machines
  • Loading branch information
@ckoven
ckoven authored Apr 25, 2018
2 parents d5a02f8 + e697e81 commit e522527
Show file tree
Hide file tree
Showing 9 changed files with 84 additions and 87 deletions.
59 changes: 35 additions & 24 deletions biogeochem/EDCanopyStructureMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -104,6 +104,7 @@ subroutine canopy_structure( currentSite , bc_in )
type(ed_cohort_type), pointer :: currentCohort
integer :: i_lyr ! current layer index
integer :: z ! Current number of canopy layers. (1= canopy, 2 = understorey)
integer :: ipft
real(r8) :: arealayer(nclmax+2) ! Amount of plant area currently in each canopy layer
integer :: patch_area_counter ! count iterations used to solve canopy areas
logical :: area_not_balanced ! logical controlling if the patch layer areas
Expand Down Expand Up @@ -139,8 +140,8 @@ subroutine canopy_structure( currentSite , bc_in )
currentCohort => currentPatch%tallest
do while (associated(currentCohort))
if( currentCohort%canopy_layer < 1 .or. currentCohort%canopy_layer > nclmax+1 ) then
write(fates_log(),*) 'lat:',currentpatch%siteptr%lat
write(fates_log(),*) 'lon:',currentpatch%siteptr%lon
write(fates_log(),*) 'lat:',currentSite%lat
write(fates_log(),*) 'lon:',currentSite%lon
write(fates_log(),*) 'BOGUS CANOPY LAYER: ',currentCohort%canopy_layer
call endrun(msg=errMsg(sourcefile, __LINE__))
end if
Expand All @@ -162,7 +163,7 @@ subroutine canopy_structure( currentSite , bc_in )
! Calculate how many layers we have in this canopy
! This also checks the understory to see if its crown
! area is large enough to warrant a temporary sub-understory layer
z = NumPotentialCanopyLayers(currentPatch,include_substory=.true.)
z = NumPotentialCanopyLayers(currentPatch,currentSite%spread,include_substory=.true.)

do i_lyr = 1,z ! Loop around the currently occupied canopy layers.
call DemoteFromLayer(currentSite, currentPatch, i_lyr)
Expand All @@ -183,7 +184,7 @@ subroutine canopy_structure( currentSite , bc_in )
! ---------------------------------------------------------------------------------------

! Re-calculate Number of layers without the false substory
z = NumPotentialCanopyLayers(currentPatch,include_substory=.false.)
z = NumPotentialCanopyLayers(currentPatch,currentSite%spread,include_substory=.false.)

! We only promote if we have at least two layers
if (z>1) then
Expand All @@ -208,10 +209,10 @@ subroutine canopy_structure( currentSite , bc_in )
! that cohort fusion has nudged the areas a little bit.
! ---------------------------------------------------------------------------------------

z = NumPotentialCanopyLayers(currentPatch,include_substory=.false.)
z = NumPotentialCanopyLayers(currentPatch,currentSite%spread,include_substory=.false.)
area_not_balanced = .false.
do i_lyr = 1,z
call CanopyLayerArea(currentPatch,i_lyr,arealayer(i_lyr))
call CanopyLayerArea(currentPatch,currentSite%spread,i_lyr,arealayer(i_lyr))
if( (arealayer(i_lyr)-currentPatch%area) > area_check_precision )then
area_not_balanced = .true.
endif
Expand All @@ -225,15 +226,23 @@ subroutine canopy_structure( currentSite , bc_in )
if(patch_area_counter > max_patch_iterations) then
write(fates_log(),*) 'PATCH AREA CHECK NOT CLOSING'
write(fates_log(),*) 'patch area:',currentpatch%area
write(fates_log(),*) 'lat:',currentpatch%siteptr%lat
write(fates_log(),*) 'lon:',currentpatch%siteptr%lon
write(fates_log(),*) 'lat:',currentSite%lat
write(fates_log(),*) 'lon:',currentSite%lon
write(fates_log(),*) 'spread:',currentSite%spread
currentCohort => currentPatch%tallest
do while (associated(currentCohort))
write(fates_log(),*) 'coh ilayer:',currentCohort%canopy_layer
write(fates_log(),*) 'coh dbh:',currentCohort%dbh
write(fates_log(),*) 'coh pft:',currentCohort%pft
write(fates_log(),*) 'coh n:',currentCohort%n
write(fates_log(),*) 'coh carea:',currentCohort%c_area
ipft=currentCohort%pft
write(fates_log(),*) 'maxh:',EDPftvarcon_inst%allom_dbh_maxheight(ipft)
write(fates_log(),*) 'lmode: ',EDPftvarcon_inst%allom_lmode(ipft)
write(fates_log(),*) 'd2bl2: ',EDPftvarcon_inst%allom_d2bl2(ipft)
write(fates_log(),*) 'd2bl_ediff: ',EDPftvarcon_inst%allom_blca_expnt_diff(ipft)
write(fates_log(),*) 'd2ca_min: ',EDPftvarcon_inst%allom_d2ca_coefficient_min(ipft)
write(fates_log(),*) 'd2ca_max: ',EDPftvarcon_inst%allom_d2ca_coefficient_max(ipft)
currentCohort => currentCohort%shorter
enddo
call endrun(msg=errMsg(sourcefile, __LINE__))
Expand Down Expand Up @@ -304,7 +313,7 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr)

! First, determine how much total canopy area we have in this layer

call CanopyLayerArea(currentPatch,i_lyr,arealayer)
call CanopyLayerArea(currentPatch,currentSite%spread,i_lyr,arealayer)


layer_area_counter = 0
Expand Down Expand Up @@ -544,14 +553,14 @@ subroutine DemoteFromLayer(currentSite,currentPatch,i_lyr)
! And the layer below that may or may not had recieved
! Demotions

call CanopyLayerArea(currentPatch,i_lyr,arealayer)
call CanopyLayerArea(currentPatch,currentSite%spread,i_lyr,arealayer)

layer_area_counter=layer_area_counter+1
if(layer_area_counter > max_layer_iterations) then
write(fates_log(),*) 'Layer demotion area not closing,i_lyr: ',i_lyr
write(fates_log(),*) 'patch area:',currentpatch%area
write(fates_log(),*) 'lat:',currentpatch%siteptr%lat
write(fates_log(),*) 'lon:',currentpatch%siteptr%lon
write(fates_log(),*) 'lat:',currentSite%lat
write(fates_log(),*) 'lon:',currentSite%lon
write(fates_log(),*) 'arealayer:',arealayer
currentCohort => currentPatch%tallest
do while (associated(currentCohort))
Expand Down Expand Up @@ -610,8 +619,8 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr)



call CanopyLayerArea(currentPatch,i_lyr,arealayer_current)
call CanopyLayerArea(currentPatch,i_lyr+1,arealayer_below)
call CanopyLayerArea(currentPatch,currentSite%spread,i_lyr,arealayer_current)
call CanopyLayerArea(currentPatch,currentSite%spread,i_lyr+1,arealayer_below)


layer_area_counter = 0
Expand Down Expand Up @@ -640,7 +649,7 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr)
currentCohort => currentCohort%shorter
enddo
arealayer_below = 0.0_r8
call CanopyLayerArea(currentPatch,i_lyr,arealayer_current)
call CanopyLayerArea(currentPatch,currentSite%spread,i_lyr,arealayer_current)
endif

sumdiff = 0.0_r8
Expand Down Expand Up @@ -767,8 +776,8 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr)
currentCohort => currentCohort%shorter
enddo !currentCohort

call CanopyLayerArea(currentPatch,i_lyr,arealayer_current)
call CanopyLayerArea(currentPatch,i_lyr+1,arealayer_below)
call CanopyLayerArea(currentPatch,currentSite%spread,i_lyr,arealayer_current)
call CanopyLayerArea(currentPatch,currentSite%spread,i_lyr+1,arealayer_below)

! Only continue trying to promote if
! there is enough canopy area in the layer below
Expand All @@ -784,8 +793,8 @@ subroutine PromoteIntoLayer(currentSite,currentPatch,i_lyr)
if(layer_area_counter > max_layer_iterations) then
write(fates_log(),*) 'Layer promotion area not closing,i_lyr: ',i_lyr
write(fates_log(),*) 'patch area:',currentpatch%area
write(fates_log(),*) 'lat:',currentpatch%siteptr%lat
write(fates_log(),*) 'lon:',currentpatch%siteptr%lon
write(fates_log(),*) 'lat:',currentSite%lat
write(fates_log(),*) 'lon:',currentSite%lon
write(fates_log(),*) 'arealayer_current:',arealayer_current
write(fates_log(),*) 'arealayer_below:',arealayer_below
currentCohort => currentPatch%tallest
Expand Down Expand Up @@ -1652,7 +1661,7 @@ end function calc_areaindex

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

subroutine CanopyLayerArea(currentPatch,layer_index,layer_area)
subroutine CanopyLayerArea(currentPatch,site_spread,layer_index,layer_area)

! --------------------------------------------------------------------------------------------
! This function calculates the total crown area footprint for a desired layer of the canopy
Expand All @@ -1662,6 +1671,7 @@ subroutine CanopyLayerArea(currentPatch,layer_index,layer_area)

! Arguments
type(ed_patch_type),intent(inout), target :: currentPatch
real(r8),intent(in) :: site_spread
integer,intent(in) :: layer_index
real(r8),intent(inout) :: layer_area

Expand All @@ -1671,7 +1681,7 @@ subroutine CanopyLayerArea(currentPatch,layer_index,layer_area)
layer_area = 0.0_r8
currentCohort => currentPatch%tallest
do while (associated(currentCohort))
call carea_allom(currentCohort%dbh,currentCohort%n,currentPatch%siteptr%spread, &
call carea_allom(currentCohort%dbh,currentCohort%n,site_spread, &
currentCohort%pft,currentCohort%c_area)
if (currentCohort%canopy_layer .eq. layer_index) then
layer_area = layer_area + currentCohort%c_area
Expand All @@ -1683,7 +1693,7 @@ end subroutine CanopyLayerArea

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

function NumPotentialCanopyLayers(currentPatch,include_substory) result(z)
function NumPotentialCanopyLayers(currentPatch,site_spread,include_substory) result(z)

! --------------------------------------------------------------------------------------------
! Calculate the number of canopy layers in this patch.
Expand All @@ -1695,14 +1705,15 @@ function NumPotentialCanopyLayers(currentPatch,include_substory) result(z)
! --------------------------------------------------------------------------------------------

type(ed_patch_type),target :: currentPatch
real(r8),intent(in) :: site_spread
logical :: include_substory

type(ed_cohort_type),pointer :: currentCohort

integer :: z
real(r8) :: c_area
real(r8) :: arealayer

z = 1
currentCohort => currentPatch%tallest
do while (associated(currentCohort))
Expand All @@ -1715,7 +1726,7 @@ function NumPotentialCanopyLayers(currentPatch,include_substory) result(z)
currentCohort => currentPatch%tallest
do while (associated(currentCohort))
if(currentCohort%canopy_layer == z) then
call carea_allom(currentCohort%dbh,currentCohort%n,currentPatch%siteptr%spread,currentCohort%pft,c_area)
call carea_allom(currentCohort%dbh,currentCohort%n,site_spread,currentCohort%pft,c_area)
arealayer = arealayer + c_area
end if
currentCohort => currentCohort%shorter
Expand Down
25 changes: 8 additions & 17 deletions biogeochem/EDCohortDynamicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -64,8 +64,8 @@ module EDCohortDynamicsMod
contains

!-------------------------------------------------------------------------------------!
subroutine create_cohort(patchptr, pft, nn, hite, dbh, &
bleaf, bfineroot, bsap, bdead, bstore, laimemory, status, ctrim, clayer, bc_in)
subroutine create_cohort(patchptr, pft, nn, hite, dbh, bleaf, bfineroot, bsap, &
bdead, bstore, laimemory, status, ctrim, clayer, spread, bc_in)
!
! !DESCRIPTION:
! create new cohort
Expand All @@ -87,6 +87,7 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, &
real(r8), intent(in) :: bstore ! stored carbon: kGC per indiv
real(r8), intent(in) :: laimemory ! target leaf biomass- set from previous year: kGC per indiv
real(r8), intent(in) :: ctrim ! What is the fraction of the maximum leaf biomass that we are targeting? :-
real(r8), intent(in) :: spread ! The community assembly effects how spread crowns are in horizontal space
type(bc_in_type), intent(in) :: bc_in ! External boundary conditions
!
! !LOCAL VARIABLES:
Expand All @@ -107,8 +108,9 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, &

new_cohort%indexnumber = fates_unset_int ! Cohort indexing was not thread-safe, setting
! bogus value for the time being (RGK-012017)
new_cohort%siteptr => patchptr%siteptr

new_cohort%patchptr => patchptr

new_cohort%pft = pft
new_cohort%status_coh = status
new_cohort%n = nn
Expand All @@ -135,22 +137,14 @@ subroutine create_cohort(patchptr, pft, nn, hite, dbh, &
! However, in this part of the code, we will pass in nominal values for size, number and type

if (new_cohort%dbh <= 0.0_r8 .or. new_cohort%n == 0._r8 .or. new_cohort%pft == 0 ) then
write(fates_log(),*) 'ED: something is zero in create_cohort', &
write(fates_log(),*) 'ED: something is zero in create_cohort', &
new_cohort%dbh,new_cohort%n, &
new_cohort%pft
call endrun(msg=errMsg(sourcefile, __LINE__))
endif

if (new_cohort%siteptr%status==2 .and. EDPftvarcon_inst%season_decid(pft) == 1) then
new_cohort%laimemory = 0.0_r8
endif

if (new_cohort%siteptr%dstatus==2 .and. EDPftvarcon_inst%stress_decid(pft) == 1) then
new_cohort%laimemory = 0.0_r8
call endrun(msg=errMsg(sourcefile, __LINE__))
endif

! Assign canopy extent and depth
call carea_allom(new_cohort%dbh,new_cohort%n,new_cohort%siteptr%spread,new_cohort%pft,new_cohort%c_area)
call carea_allom(new_cohort%dbh,new_cohort%n,spread,new_cohort%pft,new_cohort%c_area)

new_cohort%treelai = tree_lai(new_cohort%bl, new_cohort%status_coh, new_cohort%pft, &
new_cohort%c_area, new_cohort%n)
Expand Down Expand Up @@ -221,12 +215,10 @@ subroutine nan_cohort(cc_p)
currentCohort%taller => null() ! pointer to next tallest cohort
currentCohort%shorter => null() ! pointer to next shorter cohort
currentCohort%patchptr => null() ! pointer to patch that cohort is in
currentCohort%siteptr => null() ! pointer to site that cohort is in

nullify(currentCohort%taller)
nullify(currentCohort%shorter)
nullify(currentCohort%patchptr)
nullify(currentCohort%siteptr)

! VEGETATION STRUCTURE
currentCohort%pft = fates_unset_int ! pft number
Expand Down Expand Up @@ -1194,7 +1186,6 @@ subroutine copy_cohort( currentCohort,copyc )
n%taller => NULL() ! pointer to next tallest cohort
n%shorter => NULL() ! pointer to next shorter cohort
n%patchptr => o%patchptr ! pointer to patch that cohort is in
n%siteptr => o%siteptr ! pointer to site that cohort is in

end subroutine copy_cohort

Expand Down
Loading

0 comments on commit e522527

Please sign in to comment.