Skip to content

Commit

Permalink
Merge branch 'yangx/lnd/phos_nitrif_denitrif' (PR #370)
Browse files Browse the repository at this point in the history 
[BFB]
LG-40

* yangx/lnd/phos_nitrif_denitrif:
  undo the N bug fix - the N bug fix will come in as a seperate PR later
  code revision to ensure BYB with master
  P code implementation fo the case when use_nitrif_denitrif is on. This will allow explicit representation of NO3 and NH4 along with P cycling

Conflicts solved by Dali Wang/Gangsheng 11/23/2015
	components/clm/src/biogeochem/CNAllocationMod.F90
  • Loading branch information
@daliwang
daliwang committed Nov 23, 2015
2 parents 2f83186 + d8bbb89 commit e1b8119
Showing 1 changed file with 298 additions and 11 deletions.
309 changes: 298 additions & 11 deletions components/clm/src/biogeochem/CNAllocationMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -288,7 +288,6 @@ subroutine CNAllocation1_PlantNPDemand (bounds, num_soilc, filter_soilc, num_soi
! real(r8):: sum_pdemand_vr(bounds%begc:bounds%endc, 1:nlevdecomp) !total column P demand (gN/m3/s) at a given level
real(r8):: puptake_prof(bounds%begc:bounds%endc, 1:nlevdecomp)


!-----------------------------------------------------------------------

associate( &
Expand Down Expand Up @@ -1395,6 +1394,131 @@ subroutine CNAllocation2_ResolveNPLimit (bounds, num_soilc, filter_soilc , &
end do
end do



! add phosphorus

do j = 1, nlevdecomp
do fc=1,num_soilc
c = filter_soilc(fc)
sum_pdemand_vr(c,j) = col_plant_pdemand(c) * puptake_prof(c,j) + potential_immob_p_vr(c,j)
end do
end do

do j = 1, nlevdecomp
do fc=1,num_soilc
c = filter_soilc(fc)
l = col%landunit(c)
if (sum_pdemand_vr(c,j)*dt < solutionp_vr(c,j)) then

! P availability is not limiting immobilization or plant
! uptake, and both can proceed at their potential rates
plimit(c,j) = 0
fpi_p_vr(c,j) = 1.0_r8
actual_immob_p_vr(c,j) = potential_immob_p_vr(c,j)
sminp_to_plant_vr(c,j) = col_plant_pdemand(c) * puptake_prof(c,j)

else if ( cnallocate_carbon_only() .or. cnallocate_carbonnitrogen_only() ) then !.or. &

plimit(c,j) = 1
fpi_p_vr(c,j) = 1.0_r8
actual_immob_p_vr(c,j) = potential_immob_p_vr(c,j)
sminp_to_plant_vr(c,j) = col_plant_pdemand(c) * puptake_prof(c,j)
supplement_to_sminp_vr(c,j) = sum_pdemand_vr(c,j) - (solutionp_vr(c,j)/dt)

else
! P availability can not satisfy the sum of immobilization and
! plant growth demands, so these two demands compete for
! available soil mineral solution P resource.

plimit(c,j) = 1
if (sum_pdemand_vr(c,j) > 0.0_r8 .and. solutionp_vr(c,j) >0._r8) then
actual_immob_p_vr(c,j) = (solutionp_vr(c,j)/dt)*(potential_immob_p_vr(c,j) / sum_pdemand_vr(c,j))
else
actual_immob_p_vr(c,j) = 0.0_r8
end if

if (potential_immob_p_vr(c,j) > 0.0_r8) then
fpi_p_vr(c,j) = actual_immob_p_vr(c,j) / potential_immob_p_vr(c,j)
else
fpi_p_vr(c,j) = 0.0_r8
end if

sminp_to_plant_vr(c,j) = max( 0._r8,(solutionp_vr(c,j)/dt) - actual_immob_p_vr(c,j) )
end if
end do
end do

!!! resolving N limitation vs. P limitation for decomposition
!!! update (1) actual immobilization for N and P (2) sminn_to_plant and sminp_to_plant

do j = 1, nlevdecomp
do fc=1,num_soilc
c = filter_soilc(fc)
if (nlimit_nh4(c,j) == 0 .and. nlimit_no3(c,j) == 0) then
nlimit(c,j) = 0
else
nlimit(c,j) = 1
end if
end do
end do


if( .not.cnallocate_carbonphosphorus_only().and. .not.cnallocate_carbonnitrogen_only().and. .not.cnallocate_carbon_only() )then

do j = 1, nlevdecomp
do fc=1,num_soilc
c = filter_soilc(fc)

if (nlimit(c,j) == 1.and.plimit(c,j) == 0) then

actual_immob_p_vr(c,j) = potential_immob_p_vr(c,j) * fpi_vr(c,j)

elseif (nlimit(c,j) == 0.and.plimit(c,j) == 1) then

actual_immob_nh4_vr(c,j) = potential_immob_vr(c,j) * fpi_nh4_vr(c,j) * ( fpi_p_vr(c,j)/fpi_vr(c,j))
actual_immob_no3_vr(c,j) = potential_immob_vr(c,j) * fpi_no3_vr(c,j) * ( fpi_p_vr(c,j)/fpi_vr(c,j))

elseif (nlimit(c,j) == 1.and.plimit(c,j) == 1)then

if( fpi_vr(c,j) <=fpi_p_vr(c,j) )then

actual_immob_p_vr(c,j) = potential_immob_p_vr(c,j) *fpi_vr(c,j)

else

actual_immob_nh4_vr(c,j) = potential_immob_vr(c,j) * fpi_nh4_vr(c,j) * ( fpi_p_vr(c,j)/fpi_vr(c,j))
actual_immob_no3_vr(c,j) = potential_immob_vr(c,j) * fpi_no3_vr(c,j) * ( fpi_p_vr(c,j)/fpi_vr(c,j))

endif

endif
! sum up no3 and nh4 fluxes
actual_immob_vr(c,j) = actual_immob_no3_vr(c,j) + actual_immob_nh4_vr(c,j)

enddo
enddo

endif

if(cnallocate_carbonnitrogen_only())then
do j = 1, nlevdecomp
do fc=1,num_soilc
c = filter_soilc(fc)
actual_immob_p_vr(c,j) = potential_immob_p_vr(c,j) * fpi_vr(c,j)
end do
end do
end if

if(cnallocate_carbonphosphorus_only())then
do j = 1, nlevdecomp
do fc=1,num_soilc
c = filter_soilc(fc)
actual_immob_vr(c,j) = potential_immob_vr(c,j) * fpi_p_vr(c,j)
end do
end do
end if

do fc=1,num_soilc
c = filter_soilc(fc)
! sum up N fluxes to plant after initial competition
Expand Down Expand Up @@ -1503,6 +1627,78 @@ subroutine CNAllocation2_ResolveNPLimit (bounds, num_soilc, filter_soilc , &
end do


! summarize plant P uptake before providing second chance for plants to take up P
do fc=1,num_soilc
c = filter_soilc(fc)
sminp_to_plant(c) = 0._r8
end do

do j = 1, nlevdecomp
do fc=1,num_soilc
c = filter_soilc(fc)
sminp_to_plant(c) = sminp_to_plant(c) + sminp_to_plant_vr(c,j) * dzsoi_decomp(j)
end do
end do

! give plants a second pass to see if there is any mineral N left over with which to satisfy residual N demand.
do fc=1,num_soilc
c = filter_soilc(fc)
residual_sminp(c) = 0._r8
end do

! sum up total N left over after initial plant and immobilization fluxes
do fc=1,num_soilc
c = filter_soilc(fc)
residual_plant_pdemand(c) = col_plant_pdemand(c) - sminp_to_plant(c)
end do
do j = 1, nlevdecomp
do fc=1,num_soilc
c = filter_soilc(fc)
if (residual_plant_pdemand(c) > 0._r8 ) then
if (plimit(c,j) .eq. 0) then
residual_sminp_vr(c,j) = max(solutionp_vr(c,j) - (actual_immob_p_vr(c,j) + sminp_to_plant_vr(c,j) ) * dt, 0._r8)
residual_sminp(c) = residual_sminp(c) + residual_sminp_vr(c,j) * dzsoi_decomp(j)
else
residual_sminp_vr(c,j) = 0._r8
endif
endif
end do
end do

! distribute residual P to plants
do j = 1, nlevdecomp
do fc=1,num_soilc
c = filter_soilc(fc)
if ( residual_plant_pdemand(c) > 0._r8 .and. residual_sminp(c) > 0._r8 .and. plimit(c,j) .eq. 0) then
sminp_to_plant_vr(c,j) = sminp_to_plant_vr(c,j) + residual_sminp_vr(c,j) * &
min(( residual_plant_pdemand(c) * dt ) / residual_sminp(c), 1._r8) / dt
endif
end do
end do

! re-sum up P fluxes to plant
do fc=1,num_soilc
c = filter_soilc(fc)
sminp_to_plant(c) = 0._r8
end do
do j = 1, nlevdecomp
do fc=1,num_soilc
c = filter_soilc(fc)
sminp_to_plant(c) = sminp_to_plant(c) + sminp_to_plant_vr(c,j) * dzsoi_decomp(j)
sum_pdemand_vr(c,j) = potential_immob_p_vr(c,j) + sminp_to_plant_vr(c,j)
end do
end do

! sum up P fluxes to immobilization
do j = 1, nlevdecomp
do fc=1,num_soilc
c = filter_soilc(fc)
actual_immob_p(c) = actual_immob_p(c) + actual_immob_p_vr(c,j) * dzsoi_decomp(j)
potential_immob_p(c) = potential_immob_p(c) + potential_immob_p_vr(c,j) * dzsoi_decomp(j)
end do
end do


do fc=1,num_soilc
c = filter_soilc(fc)
! calculate the fraction of potential growth that can be
Expand All @@ -1521,6 +1717,24 @@ subroutine CNAllocation2_ResolveNPLimit (bounds, num_soilc, filter_soilc , &
end if
end do ! end of column loops

do fc=1,num_soilc
c = filter_soilc(fc)
! calculate the fraction of potential growth that can be
! acheived with the P available to plants
if (col_plant_pdemand(c) > 0.0_r8) then
fpg_p(c) = sminp_to_plant(c) / col_plant_pdemand(c)
else
fpg_p(c) = 1.0_r8
end if

! calculate the fraction of immobilization realized (for diagnostic purposes)
if (potential_immob(c) > 0.0_r8) then
fpi_p(c) = actual_immob_p(c) / potential_immob_p(c)
else
fpi_p(c) = 1.0_r8
end if
end do

end if !end of if_not_use_nitrif_denitrif

end associate
Expand Down Expand Up @@ -1587,6 +1801,8 @@ subroutine CNAllocation3_PlantCNPAlloc (bounds , &
real(r8):: cpl,cpfr,cplw,cpdw,cpg !C:N ratios for leaf, fine root, and wood
real(r8):: puptake_prof(bounds%begc:bounds%endc, 1:nlevdecomp)

real(r8):: temp_sminn_to_plant(bounds%begc:bounds%endc)
real(r8):: temp_sminp_to_plant(bounds%begc:bounds%endc)
!-----------------------------------------------------------------------

associate( &
Expand Down Expand Up @@ -1667,6 +1883,9 @@ subroutine CNAllocation3_PlantCNPAlloc (bounds , &
sminn_to_plant => nitrogenflux_vars%sminn_to_plant_col , & ! Output: [real(r8) (:) ]
sminn_to_plant_vr => nitrogenflux_vars%sminn_to_plant_vr_col , & ! Output: [real(r8) (:,:) ]

smin_no3_to_plant_vr => nitrogenflux_vars%smin_no3_to_plant_vr_col , & ! Output: [real(r8) (:,:) ]
smin_nh4_to_plant_vr => nitrogenflux_vars%smin_nh4_to_plant_vr_col , & ! Output: [real(r8) (:,:) ]

!!! add phosphorus variables - X. YANG
plant_pdemand => phosphorusflux_vars%plant_pdemand_patch , & ! Output: [real(r8) (:) ] P flux required to support initial GPP (gP/m2/s)
plant_palloc => phosphorusflux_vars%plant_palloc_patch , & ! Output: [real(r8) (:) ] total allocated P flux (gP/m2/s)
Expand Down Expand Up @@ -1953,17 +2172,85 @@ subroutine CNAllocation3_PlantCNPAlloc (bounds , &
end if

!! Phosphorus
call p2c(bounds,num_soilc,filter_soilc, &
sminp_to_ppool(bounds%begp:bounds%endp), &
sminp_to_plant(bounds%begc:bounds%endc))

call calc_puptake_prof(bounds, num_soilc, filter_soilc, cnstate_vars, phosphorusstate_vars, puptake_prof)
do j = 1, nlevdecomp
do fc=1,num_soilc
c = filter_soilc(fc)
sminp_to_plant_vr(c,j) = sminp_to_plant(c) * puptake_prof(c,j)
end do
end do
if( .not. use_nitrif_denitrif) then

call p2c(bounds,num_soilc,filter_soilc, &
sminp_to_ppool(bounds%begp:bounds%endp), &
sminp_to_plant(bounds%begc:bounds%endc))

call calc_puptake_prof(bounds, num_soilc, filter_soilc, cnstate_vars, phosphorusstate_vars, puptake_prof)
do j = 1, nlevdecomp
do fc=1,num_soilc
c = filter_soilc(fc)
sminp_to_plant_vr(c,j) = sminp_to_plant(c) * puptake_prof(c,j)
end do
end do

else ! use_nitrif_denitrif

if( .not.cnallocate_carbonphosphorus_only().and. .not.cnallocate_carbonnitrogen_only().and. .not.cnallocate_carbon_only() )then

temp_sminn_to_plant = sminn_to_plant
temp_sminp_to_plant = sminp_to_plant

call p2c(bounds,num_soilc,filter_soilc, &
sminn_to_npool(bounds%begp:bounds%endp), &
sminn_to_plant(bounds%begc:bounds%endc))

call p2c(bounds,num_soilc,filter_soilc, &
sminp_to_ppool(bounds%begp:bounds%endp), &
sminp_to_plant(bounds%begc:bounds%endc))


do j = 1, nlevdecomp
do fc=1,num_soilc
c = filter_soilc(fc)
if ( temp_sminn_to_plant(c) > 0._r8) then
sminn_to_plant_vr(c,j) = sminn_to_plant_vr(c,j) * ( sminn_to_plant(c)/temp_sminn_to_plant(c) )
smin_nh4_to_plant_vr(c,j) = smin_nh4_to_plant_vr(c,j) * ( sminn_to_plant(c)/temp_sminn_to_plant(c) )
smin_no3_to_plant_vr(c,j) = smin_no3_to_plant_vr(c,j) * ( sminn_to_plant(c)/temp_sminn_to_plant(c) )
else
sminn_to_plant_vr(c,j) = 0._r8
smin_nh4_to_plant_vr(c,j) = 0._r8
smin_no3_to_plant_vr(c,j) = 0._r8
endif

if ( temp_sminp_to_plant(c) > 0._r8) then
sminp_to_plant_vr(c,j) = sminp_to_plant_vr(c,j) * ( sminp_to_plant(c)/temp_sminp_to_plant(c) )
else
sminp_to_plant_vr(c,j) = 0._r8
endif
end do
end do

end if ! carbonnitrogenphosphorus

if( cnallocate_carbonnitrogen_only() )then

temp_sminp_to_plant = sminp_to_plant

call p2c(bounds,num_soilc,filter_soilc, &
sminp_to_ppool(bounds%begp:bounds%endp), &
sminp_to_plant(bounds%begc:bounds%endc))


do j = 1, nlevdecomp
do fc=1,num_soilc
c = filter_soilc(fc)

if ( temp_sminp_to_plant(c) > 0._r8) then
sminp_to_plant_vr(c,j) = sminp_to_plant_vr(c,j) * ( sminp_to_plant(c)/temp_sminp_to_plant(c) )
else
sminp_to_plant_vr(c,j) = 0._r8
endif
end do
end do
end if ! carbonnitrogen


end if !

!----------------------------------------------------------------

end associate
Expand Down

0 comments on commit e1b8119

Please sign in to comment.