diff --git a/documentation/docs/user_guide/constants/physical_constants.md b/documentation/docs/user_guide/constants/physical_constants.md index 73ae9abdf..270dde5e4 100644 --- a/documentation/docs/user_guide/constants/physical_constants.md +++ b/documentation/docs/user_guide/constants/physical_constants.md @@ -20,4 +20,4 @@ | cswat | 4.218E3 | \( J \cdot kg^{-1} \cdot K^{-1} \) | Specific heat for water at \( 0^{\circ}C \) | | density_liq | 1000.0 | \( kg \cdot m^{-3} \) | Density of liquid water | | density_ice | 921.0 | \( kg \cdot m^{-3} \) | Density of ice | -| c_molar_mass | 1.201E-5 | \( \mu g / mol \) | Molar mass of carbon | +| c_molar_mass | 1.201E-5 | \( g / \mu mol \) | Molar mass of carbon | diff --git a/src/offline/cable_define_types.F90 b/src/offline/cable_define_types.F90 index 0ae09c4c1..426d46171 100644 --- a/src/offline/cable_define_types.F90 +++ b/src/offline/cable_define_types.F90 @@ -261,6 +261,7 @@ MODULE cable_def_types_mod qssrf, & ! sublimation snage, & ! snow age snowd, & ! snow depth (liquid water) + totsdepth, & ! total snow depth (m) smelt, & ! snow melt ssdnn, & ! average snow density tss, & ! surface temperature (weighted soil, snow) @@ -450,12 +451,14 @@ MODULE cable_def_types_mod frpw, & ! plant respiration (woody component) (g C m-2 s-1) frpr, & ! plant respiration (root component) (g C m-2 s-1) frs, & ! soil respiration (g C m-2 s-1) + fra, & ! autotrophic respiration (g C m-2 s-1) fnee, & ! net carbon flux (g C m-2 s-1) frday, & ! daytime leaf resp fnv, & ! net rad. avail. to canopy (W/m2) fev, & ! latent hf from canopy (W/m2) epot, & ! total potential evaporation - fnpp, & ! npp flux + fnpp, & ! npp flux (g C m-2 s-1) + fgpp, & ! gpp flux (g C m-2 s-1) fevw_pot,& ! potential lat heat from canopy gswx_T, & ! ! stom cond for water cdtq, & ! drag coefficient for momentum @@ -471,6 +474,7 @@ MODULE cable_def_types_mod ghflux, & ! ground heat flux (W/m2) ??? precis, & ! throughfall to soil, after snow (mm) qscrn, & ! specific humudity at screen height (g/g) + qmom, & ! surface momentum flux (kg/m/s2) rnet, & ! net radiation absorbed by surface (W/m2) rniso, & !isothermal net radiation absorbed by surface (W/m2) segg, & ! latent heatfl from soil mm @@ -549,8 +553,11 @@ MODULE cable_def_types_mod latitude,& ! latitude lwabv, & ! long wave absorbed by vegetation qssabs, & ! absorbed short-wave radiation for soil + swnet, & ! net shortwave radiation absorbed by surface (W/m^2) + lwnet, & ! net longwave radiation absorbed by surface (W/m^2) + rnet, & ! net radiation absorbed by surface (W/m^2) transd, & ! frac SW diffuse transmitted through canopy - trad, & ! radiative temperature (soil and veg) + trad, & ! radiative temperature (soil and veg) (K) otrad ! radiative temperature on previous timestep (ACCESS) REAL, DIMENSION(:,:), POINTER :: & @@ -913,6 +920,7 @@ SUBROUTINE alloc_soil_snow_type(var, mp) ALLOCATE( var% smass(mp,msn) ) ALLOCATE( var% snage(mp) ) ALLOCATE( var% snowd(mp) ) + ALLOCATE( var% totsdepth(mp) ) ALLOCATE( var% smelt(mp) ) ALLOCATE( var% ssdn(mp,msn) ) ALLOCATE( var% ssdnn(mp) ) @@ -1118,6 +1126,7 @@ SUBROUTINE alloc_canopy_type(var, mp) ALLOCATE( var% frpw(mp) ) ALLOCATE( var% frpr(mp) ) ALLOCATE( var% frs(mp) ) + ALLOCATE( var% fra(mp) ) ALLOCATE( var% fnee(mp) ) ALLOCATE( var% frday(mp) ) ALLOCATE( var% fnv(mp) ) @@ -1131,6 +1140,7 @@ SUBROUTINE alloc_canopy_type(var, mp) ALLOCATE( var% ghflux(mp) ) ALLOCATE( var% precis(mp) ) ALLOCATE( var% qscrn(mp) ) + ALLOCATE( var% qmom(mp) ) ALLOCATE( var% rnet(mp) ) ALLOCATE( var% rniso(mp) ) ALLOCATE( var% segg(mp) ) @@ -1150,6 +1160,7 @@ SUBROUTINE alloc_canopy_type(var, mp) ALLOCATE( var% ga_cor(mp) ) !REV_CORR variable ALLOCATE( var% epot(mp) ) ALLOCATE( var% fnpp(mp) ) + ALLOCATE( var% fgpp(mp) ) ALLOCATE( var% fevw_pot(mp) ) ALLOCATE( var% gswx_T(mp) ) ALLOCATE( var% cdtq(mp) ) @@ -1199,6 +1210,9 @@ SUBROUTINE alloc_radiation_type(var, mp) ALLOCATE( var% lwabv(mp) ) ALLOCATE( var% qcan(mp,mf,nrb) ) ALLOCATE( var% qssabs(mp) ) + ALLOCATE( var% swnet(mp) ) + ALLOCATE( var% lwnet(mp) ) + ALLOCATE( var% rnet(mp) ) ALLOCATE( var% rhocdf(mp,nrb) ) ALLOCATE( var% rniso(mp,mf) ) ALLOCATE( var% scalex(mp,mf) ) @@ -1559,6 +1573,7 @@ SUBROUTINE dealloc_soil_snow_type(var) DEALLOCATE( var% smass ) DEALLOCATE( var% snage ) DEALLOCATE( var% snowd ) + DEALLOCATE( var% totsdepth ) DEALLOCATE( var% smelt ) DEALLOCATE( var% ssdn ) DEALLOCATE( var% ssdnn ) @@ -1750,6 +1765,7 @@ SUBROUTINE dealloc_canopy_type(var) DEALLOCATE( var% frpw ) DEALLOCATE( var% frpr ) DEALLOCATE( var% frs ) + DEALLOCATE( var% fra ) DEALLOCATE( var% fnee ) DEALLOCATE( var% frday ) DEALLOCATE( var% fnv ) @@ -1763,6 +1779,7 @@ SUBROUTINE dealloc_canopy_type(var) DEALLOCATE( var% ghflux ) DEALLOCATE( var% precis ) DEALLOCATE( var% qscrn ) + DEALLOCATE( var% qmom ) DEALLOCATE( var% rnet ) DEALLOCATE( var% rniso ) DEALLOCATE( var% segg ) @@ -1782,6 +1799,7 @@ SUBROUTINE dealloc_canopy_type(var) DEALLOCATE( var% ga_cor ) !REV_CORR variable DEALLOCATE( var% epot ) DEALLOCATE( var% fnpp ) + DEALLOCATE( var% fgpp ) DEALLOCATE( var% fevw_pot ) DEALLOCATE( var% gswx_T ) DEALLOCATE( var% cdtq ) @@ -1822,6 +1840,9 @@ SUBROUTINE dealloc_radiation_type(var) DEALLOCATE( var% lwabv ) DEALLOCATE( var% qcan ) DEALLOCATE( var% qssabs ) + DEALLOCATE( var% swnet ) + DEALLOCATE( var% lwnet ) + DEALLOCATE( var% rnet ) DEALLOCATE( var% rhocdf ) DEALLOCATE( var% rniso ) DEALLOCATE( var% scalex ) diff --git a/src/offline/cable_mpicommon.F90 b/src/offline/cable_mpicommon.F90 index e939eaa3a..05e0c1ba4 100644 --- a/src/offline/cable_mpicommon.F90 +++ b/src/offline/cable_mpicommon.F90 @@ -29,7 +29,7 @@ MODULE cable_mpicommon ! base number of input fields: must correspond to CALLS to ! MPI_address (field ) in *_mpimaster/ *_mpiworker - INTEGER, PARAMETER :: nparam = 340 + INTEGER, PARAMETER :: nparam = 347 ! MPI: extra params sent only if nsoilparmnew is true INTEGER, PARAMETER :: nsoilnew = 1 @@ -37,7 +37,7 @@ MODULE cable_mpicommon ! MPI: number of casa parameters sent to workers as ! start up parameters ! MPI: added casapool fields ratioNCsoilnew, ratioNCsoilmin and ratioNCsoilmax - INTEGER, PARAMETER :: ncasaparam = 213 ! YPW to account for 3 aditional woodproduct pools + INTEGER, PARAMETER :: ncasaparam = 219 ! MPI: base number of casa_init parameters sent to the workers INTEGER, PARAMETER :: ncinit = 18 @@ -94,12 +94,12 @@ MODULE cable_mpicommon ! vh sli nvec + 6 162 -> 168 ! INTEGER, PARAMETER :: nvec = 172! 168 ! INH REV_CORR +3 (SSEB +2 will be needed) - INTEGER, PARAMETER :: nvec = 175 + INTEGER, PARAMETER :: nvec = 183 ! MPI: number of final casa result matrices and vectors to receive ! by the master for casa_poolout and casa_fluxout INTEGER, PARAMETER :: ncasa_mat = 37 ! add three more wood product variables - INTEGER, PARAMETER :: ncasa_vec = 66 + INTEGER, PARAMETER :: ncasa_vec = 72 ! MPI: number of fields included in restart_t type for data ! that is returned only for creating a restart file at the end of the run ! MPI: gol124: canopy%rwater removed when Bernard ported to CABLE_r491 diff --git a/src/offline/cable_mpimaster.F90 b/src/offline/cable_mpimaster.F90 index 4346b0642..59526c447 100644 --- a/src/offline/cable_mpimaster.F90 +++ b/src/offline/cable_mpimaster.F90 @@ -1824,6 +1824,10 @@ SUBROUTINE master_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& CALL MPI_Get_address (ssnow%snowd(off), displs(bidx), ierr) blen(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (ssnow%totsdepth(off), displs(bidx), ierr) + blen(bidx) = r1len + bidx = bidx + 1 CALL MPI_Get_address (ssnow%smelt(off), displs(bidx), ierr) blen(bidx) = r1len @@ -2372,6 +2376,10 @@ SUBROUTINE master_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& CALL MPI_Get_address (canopy%frs(off), displs(bidx), ierr) blen(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (canopy%fra(off), displs(bidx), ierr) + blen(bidx) = r1len + bidx = bidx + 1 CALL MPI_Get_address (canopy%fnee(off), displs(bidx), ierr) blen(bidx) = r1len @@ -2470,6 +2478,10 @@ SUBROUTINE master_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& CALL MPI_Get_address (canopy%qscrn(off), displs(bidx), ierr) blen(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (canopy%qmom(off), displs(bidx), ierr) + blen(bidx) = r1len + bidx = bidx + 1 CALL MPI_Get_address (canopy%rnet(off), displs(bidx), ierr) blen(bidx) = r1len @@ -2533,6 +2545,10 @@ SUBROUTINE master_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& CALL MPI_Get_address (canopy%fnpp(off), displs(bidx), ierr) blen(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (canopy%fgpp(off), displs(bidx), ierr) + blen(bidx) = r1len + bidx = bidx + 1 CALL MPI_Get_address (canopy%fevw_pot(off), displs(bidx), ierr) blen(bidx) = r1len @@ -2710,6 +2726,18 @@ SUBROUTINE master_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& CALL MPI_Get_address (rad%qssabs(off), displs(bidx), ierr) blen(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (rad%swnet(off), displs(bidx), ierr) + blen(bidx) = r1len + + bidx = bidx + 1 + CALL MPI_Get_address (rad%lwnet(off), displs(bidx), ierr) + blen(bidx) = r1len + + bidx = bidx + 1 + CALL MPI_Get_address (rad%rnet(off), displs(bidx), ierr) + blen(bidx) = r1len + bidx = bidx + 1 CALL MPI_Get_address (rad%rhocdf(off,1), displs(bidx), ierr) CALL MPI_Type_create_hvector (nrb, r1len, r1stride, MPI_BYTE, & @@ -3530,7 +3558,21 @@ SUBROUTINE master_casa_params (comm,casabiome,casapool,casaflux,casamet,& CALL MPI_Get_address (casapool%dClabiledt(off), displs(bidx), ierr) blen(bidx) = r2len + bidx = bidx + 1 + CALL MPI_Get_address (casapool%dCdt(off), displs(bidx), ierr) + blen(bidx) = r2len + + bidx = bidx + 1 + CALL MPI_Get_address (casapool%Cplanttot(off), displs(bidx), ierr) + blen(bidx) = r2len + bidx = bidx + 1 + CALL MPI_Get_address (casapool%Clittertot(off), displs(bidx), ierr) + blen(bidx) = r2len + + bidx = bidx + 1 + CALL MPI_Get_address (casapool%Csoiltot(off), displs(bidx), ierr) + blen(bidx) = r2len bidx = bidx + 1 CALL MPI_Get_address (casapool%Cplant(off,1), displs(bidx), ierr) @@ -3803,6 +3845,10 @@ SUBROUTINE master_casa_params (comm,casabiome,casapool,casaflux,casamet,& CALL MPI_Get_address (casaflux%Cnpp(off), displs(bidx), ierr) blen(bidx) = r2len + bidx = bidx + 1 + CALL MPI_Get_address (casaflux%Cnbp(off), displs(bidx), ierr) + blen(bidx) = r2len + bidx = bidx + 1 CALL MPI_Get_address (casaflux%Crp(off), displs(bidx), ierr) blen(bidx) = r2len @@ -3990,6 +4036,10 @@ SUBROUTINE master_casa_params (comm,casabiome,casapool,casaflux,casamet,& CALL MPI_Get_address (casaflux%frac_sapwood(off), displs(bidx), ierr) blen(bidx) = r2len + bidx = bidx + 1 + CALL MPI_Get_address (casaflux%Cplant_turnover_tot(off), displs(bidx), ierr) + blen(bidx) = r2len + bidx = bidx + 1 CALL MPI_Get_address (casaflux%sapwood_area(off), displs(bidx), ierr) blen(bidx) = r2len @@ -5219,6 +5269,10 @@ SUBROUTINE master_outtypes (comm,met,canopy,ssnow,rad,bal,air,soil,veg) blen(vidx) = cnt * extr1 vidx = vidx + 1 ! REAL(r_1) + CALL MPI_Get_address (canopy%fra(off), vaddr(vidx), ierr) + blen(vidx) = cnt * extr1 + vidx = vidx + 1 + ! REAL(r_1) CALL MPI_Get_address (canopy%fnee(off), vaddr(vidx), ierr) ! 32 blen(vidx) = cnt * extr1 vidx = vidx + 1 @@ -5301,6 +5355,10 @@ SUBROUTINE master_outtypes (comm,met,canopy,ssnow,rad,bal,air,soil,veg) blen(vidx) = cnt * extr1 vidx = vidx + 1 ! REAL(r_1) + CALL MPI_Get_address (canopy%fgpp(off), vaddr(vidx), ierr) ! 44 + blen(vidx) = cnt * extr1 + vidx = vidx + 1 + ! REAL(r_1) CALL MPI_Get_address (canopy%fevw_pot(off), vaddr(vidx), ierr) ! 44 blen(vidx) = cnt * extr1 vidx = vidx + 1 @@ -5338,6 +5396,10 @@ SUBROUTINE master_outtypes (comm,met,canopy,ssnow,rad,bal,air,soil,veg) blen(vidx) = cnt * extr1 vidx = vidx + 1 ! REAL(r_1) + CALL MPI_Get_address (canopy%qmom(off), vaddr(vidx), ierr) ! 48 + blen(vidx) = cnt * extr1 + vidx = vidx + 1 + ! REAL(r_1) CALL MPI_Get_address (canopy%rnet(off), vaddr(vidx), ierr) ! 49 blen(vidx) = cnt * extr1 vidx = vidx + 1 @@ -5504,6 +5566,10 @@ SUBROUTINE master_outtypes (comm,met,canopy,ssnow,rad,bal,air,soil,veg) blen(vidx) = cnt * extr1 vidx = vidx + 1 ! REAL(r_1) + CALL MPI_Get_address (ssnow%totsdepth(off), vaddr(vidx), ierr) + blen(vidx) = cnt * extr1 + vidx = vidx + 1 + ! REAL(r_1) CALL MPI_Get_address (ssnow%smelt(off), vaddr(vidx), ierr) ! 76 blen(vidx) = cnt * extr1 ! MPI: 2D vars moved above @@ -5612,10 +5678,18 @@ SUBROUTINE master_outtypes (comm,met,canopy,ssnow,rad,bal,air,soil,veg) ! REAL(r_1) CALL MPI_Get_address (rad%qssabs(off), vaddr(vidx), ierr) !99 blen(vidx) = cnt * extr1 - ! MPI: 2D vars moved above - ! rhocdf - ! rniso - ! scalex + vidx = vidx + 1 + ! REAL(r_1) + CALL MPI_Get_address (rad%swnet(off), vaddr(vidx), ierr) + blen(vidx) = cnt * extr1 + vidx = vidx + 1 + ! REAL(r_1) + CALL MPI_Get_address (rad%lwnet(off), vaddr(vidx), ierr) + blen(vidx) = cnt * extr1 + vidx = vidx + 1 + ! REAL(r_1) + CALL MPI_Get_address (rad%rnet(off), vaddr(vidx), ierr) + blen(vidx) = cnt * extr1 vidx = vidx + 1 ! REAL(r_1) CALL MPI_Get_address (rad%transd(off), vaddr(vidx), ierr) ! 100 @@ -5630,6 +5704,11 @@ SUBROUTINE master_outtypes (comm,met,canopy,ssnow,rad,bal,air,soil,veg) CALL MPI_Get_address (rad%transb(off), vaddr(vidx), ierr) ! 101 blen(vidx) = cnt * extr1 + vidx = vidx + 1 + ! REAL(r_1) + CALL MPI_Get_address (rad%albedo_T(off), vaddr(vidx), ierr) + blen(vidx) = cnt * extr1 + ! MPI: 2D vars moved above ! reffdf ! reffbm @@ -6418,6 +6497,22 @@ SUBROUTINE master_casa_types (comm, casapool, casaflux, & CALL MPI_Get_address (casapool%clabile(off), displs(bidx), ierr) blocks(bidx) = r2len + bidx = bidx + 1 + CALL MPI_Get_address (casapool%dCdt(off), displs(bidx), ierr) + blocks(bidx) = r2len + + bidx = bidx + 1 + CALL MPI_Get_address (casapool%Cplanttot(off), displs(bidx), ierr) + blocks(bidx) = r2len + + bidx = bidx + 1 + CALL MPI_Get_address (casapool%Clittertot(off), displs(bidx), ierr) + blocks(bidx) = r2len + + bidx = bidx + 1 + CALL MPI_Get_address (casapool%Csoiltot(off), displs(bidx), ierr) + blocks(bidx) = r2len + bidx = bidx + 1 CALL MPI_Get_address (casapool%Ctot(off), displs(bidx), ierr) blocks(bidx) = r2len @@ -6552,6 +6647,10 @@ SUBROUTINE master_casa_types (comm, casapool, casaflux, & CALL MPI_Get_address (casaflux%Cnpp(off), displs(bidx), ierr) blocks(bidx) = r2len + bidx = bidx + 1 + CALL MPI_Get_address (casaflux%Cnbp(off), displs(bidx), ierr) + blocks(bidx) = r2len + bidx = bidx + 1 CALL MPI_Get_address (casaflux%Crp(off), displs(bidx), ierr) blocks(bidx) = r2len @@ -6625,6 +6724,10 @@ SUBROUTINE master_casa_types (comm, casapool, casaflux, & CALL MPI_Get_address (casaflux%frac_sapwood(off), displs(bidx), ierr) blocks(bidx) = r2len + bidx = bidx + 1 + CALL MPI_Get_address (casaflux%Cplant_turnover_tot(off), displs(bidx), ierr) + blocks(bidx) = r2len + bidx = bidx + 1 CALL MPI_Get_address (casaflux%sapwood_area(off), displs(bidx), ierr) blocks(bidx) = r2len diff --git a/src/offline/cable_mpiworker.F90 b/src/offline/cable_mpiworker.F90 index 7a9303a33..f62e3e2c3 100644 --- a/src/offline/cable_mpiworker.F90 +++ b/src/offline/cable_mpiworker.F90 @@ -1105,6 +1105,10 @@ SUBROUTINE worker_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& CALL MPI_Get_address (ssnow%snowd, displs(bidx), ierr) blen(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (ssnow%totsdepth, displs(bidx), ierr) + blen(bidx) = r1len + bidx = bidx + 1 CALL MPI_Get_address (ssnow%smelt, displs(bidx), ierr) blen(bidx) = r1len @@ -1588,6 +1592,10 @@ SUBROUTINE worker_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& CALL MPI_Get_address (canopy%frs, displs(bidx), ierr) blen(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (canopy%fra, displs(bidx), ierr) + blen(bidx) = r1len + bidx = bidx + 1 CALL MPI_Get_address (canopy%fnee, displs(bidx), ierr) blen(bidx) = r1len @@ -1686,6 +1694,10 @@ SUBROUTINE worker_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& CALL MPI_Get_address (canopy%qscrn, displs(bidx), ierr) blen(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (canopy%qmom, displs(bidx), ierr) + blen(bidx) = r1len + bidx = bidx + 1 CALL MPI_Get_address (canopy%rnet, displs(bidx), ierr) blen(bidx) = r1len @@ -1748,6 +1760,10 @@ SUBROUTINE worker_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& CALL MPI_Get_address (canopy%fnpp, displs(bidx), ierr) blen(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (canopy%fgpp, displs(bidx), ierr) + blen(bidx) = r1len + bidx = bidx + 1 CALL MPI_Get_address (canopy%fevw_pot, displs(bidx), ierr) blen(bidx) = r1len @@ -1908,6 +1924,18 @@ SUBROUTINE worker_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& CALL MPI_Get_address (rad%qssabs, displs(bidx), ierr) blen(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (rad%swnet, displs(bidx), ierr) + blen(bidx) = r1len + + bidx = bidx + 1 + CALL MPI_Get_address (rad%lwnet, displs(bidx), ierr) + blen(bidx) = r1len + + bidx = bidx + 1 + CALL MPI_Get_address (rad%rnet, displs(bidx), ierr) + blen(bidx) = r1len + bidx = bidx + 1 CALL MPI_Get_address (rad%rhocdf, displs(bidx), ierr) blen(bidx) = nrb * r1len @@ -2654,6 +2682,22 @@ SUBROUTINE worker_casa_params (comm,casabiome,casapool,casaflux,casamet,& CALL MPI_Get_address (casapool%dClabiledt, displs(bidx), ierr) blen(bidx) = r2len + bidx = bidx + 1 + CALL MPI_Get_address (casapool%dCdt, displs(bidx), ierr) + blen(bidx) = r2len + + bidx = bidx + 1 + CALL MPI_Get_address (casapool%Cplanttot, displs(bidx), ierr) + blen(bidx) = r2len + + bidx = bidx + 1 + CALL MPI_Get_address (casapool%Clittertot, displs(bidx), ierr) + blen(bidx) = r2len + + bidx = bidx + 1 + CALL MPI_Get_address (casapool%Csoiltot, displs(bidx), ierr) + blen(bidx) = r2len + bidx = bidx + 1 CALL MPI_Get_address (casapool%Cplant, displs(bidx), ierr) blen(bidx) = mplant * r2len @@ -2833,6 +2877,10 @@ SUBROUTINE worker_casa_params (comm,casabiome,casapool,casaflux,casamet,& CALL MPI_Get_address (casaflux%Cnpp, displs(bidx), ierr) blen(bidx) = r2len + bidx = bidx + 1 + CALL MPI_Get_address (casaflux%Cnbp, displs(bidx), ierr) + blen(bidx) = r2len + bidx = bidx + 1 CALL MPI_Get_address (casaflux%Crp, displs(bidx), ierr) blen(bidx) = r2len @@ -2998,6 +3046,10 @@ SUBROUTINE worker_casa_params (comm,casabiome,casapool,casaflux,casamet,& CALL MPI_Get_address (casaflux%frac_sapwood, displs(bidx), ierr) blen(bidx) = r2len + bidx = bidx + 1 + CALL MPI_Get_address (casaflux%Cplant_turnover_tot, displs(bidx), ierr) + blen(bidx) = r2len + bidx = bidx + 1 CALL MPI_Get_address (casaflux%sapwood_area, displs(bidx), ierr) blen(bidx) = r2len @@ -4261,6 +4313,10 @@ SUBROUTINE worker_outtype (comm,met,canopy,ssnow,rad,bal,air,soil,veg) CALL MPI_Get_address (canopy%frs(off), displs(bidx), ierr) blocks(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (canopy%fra(off), displs(bidx), ierr) + blocks(bidx) = r1len + !vidx = vidx + 1 ! REAL(r_1) !CALL MPI_Get_address (canopy%fnee(off), vaddr(vidx), ierr) ! 32 @@ -4391,6 +4447,10 @@ SUBROUTINE worker_outtype (comm,met,canopy,ssnow,rad,bal,air,soil,veg) CALL MPI_Get_address (canopy%fnpp(off), displs(bidx), ierr) blocks(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (canopy%fgpp(off), displs(bidx), ierr) + blocks(bidx) = r1len + bidx = bidx + 1 CALL MPI_Get_address (canopy%fevw_pot(off), displs(bidx), ierr) blocks(bidx) = r1len @@ -4443,6 +4503,10 @@ SUBROUTINE worker_outtype (comm,met,canopy,ssnow,rad,bal,air,soil,veg) CALL MPI_Get_address (canopy%qscrn(off), displs(bidx), ierr) blocks(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (canopy%qmom(off), displs(bidx), ierr) + blocks(bidx) = r1len + !vidx = vidx + 1 ! REAL(r_1) !CALL MPI_Get_address (canopy%rnet(off), vaddr(vidx), ierr) ! 49 @@ -4708,6 +4772,10 @@ SUBROUTINE worker_outtype (comm,met,canopy,ssnow,rad,bal,air,soil,veg) CALL MPI_Get_address (ssnow%snowd(off), displs(bidx), ierr) blocks(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (ssnow%totsdepth(off), displs(bidx), ierr) + blocks(bidx) = r1len + !vidx = vidx + 1 ! REAL(r_1) !CALL MPI_Get_address (ssnow%smelt(off), vaddr(vidx), ierr) ! 76 @@ -4870,6 +4938,18 @@ SUBROUTINE worker_outtype (comm,met,canopy,ssnow,rad,bal,air,soil,veg) CALL MPI_Get_address (rad%qssabs(off), displs(bidx), ierr) blocks(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (rad%swnet(off), displs(bidx), ierr) + blocks(bidx) = r1len + + bidx = bidx + 1 + CALL MPI_Get_address (rad%lwnet(off), displs(bidx), ierr) + blocks(bidx) = r1len + + bidx = bidx + 1 + CALL MPI_Get_address (rad%rnet(off), displs(bidx), ierr) + blocks(bidx) = r1len + ! MPI: 2D vars moved above ! rhocdf ! rniso @@ -4894,6 +4974,10 @@ SUBROUTINE worker_outtype (comm,met,canopy,ssnow,rad,bal,air,soil,veg) CALL MPI_Get_address (rad%transb(off), displs(bidx), ierr) blocks(bidx) = r1len + bidx = bidx + 1 + CALL MPI_Get_address (rad%albedo_T(off), displs(bidx), ierr) + blocks(bidx) = r1len + ! MPI: 2D vars moved above ! reffdf ! reffbm @@ -5815,6 +5899,22 @@ SUBROUTINE worker_casa_type (comm, casapool,casaflux, & CALL MPI_Get_address (casapool%clabile(off), displs(bidx), ierr) blocks(bidx) = r2len + bidx = bidx + 1 + CALL MPI_Get_address (casapool%dCdt(off), displs(bidx), ierr) + blocks(bidx) = r2len + + bidx = bidx + 1 + CALL MPI_Get_address (casapool%Cplanttot(off), displs(bidx), ierr) + blocks(bidx) = r2len + + bidx = bidx + 1 + CALL MPI_Get_address (casapool%Clittertot(off), displs(bidx), ierr) + blocks(bidx) = r2len + + bidx = bidx + 1 + CALL MPI_Get_address (casapool%Csoiltot(off), displs(bidx), ierr) + blocks(bidx) = r2len + bidx = bidx + 1 CALL MPI_Get_address (casapool%Ctot(off), displs(bidx), ierr) blocks(bidx) = r2len @@ -5947,6 +6047,10 @@ SUBROUTINE worker_casa_type (comm, casapool,casaflux, & CALL MPI_Get_address (casaflux%Cnpp(off), displs(bidx), ierr) blocks(bidx) = r2len + bidx = bidx + 1 + CALL MPI_Get_address (casaflux%Cnbp(off), displs(bidx), ierr) + blocks(bidx) = r2len + bidx = bidx + 1 CALL MPI_Get_address (casaflux%Crp(off), displs(bidx), ierr) blocks(bidx) = r2len @@ -6020,6 +6124,10 @@ SUBROUTINE worker_casa_type (comm, casapool,casaflux, & CALL MPI_Get_address (casaflux%frac_sapwood(off), displs(bidx), ierr) blocks(bidx) = r2len + bidx = bidx + 1 + CALL MPI_Get_address (casaflux%Cplant_turnover_tot(off), displs(bidx), ierr) + blocks(bidx) = r2len + bidx = bidx + 1 CALL MPI_Get_address (casaflux%sapwood_area(off), displs(bidx), ierr) blocks(bidx) = r2len diff --git a/src/offline/cable_output.F90 b/src/offline/cable_output.F90 index 30bf1e1c2..5fe4b5639 100644 --- a/src/offline/cable_output.F90 +++ b/src/offline/cable_output.F90 @@ -46,6 +46,7 @@ MODULE cable_output_module USE cable_common_module, ONLY: filename, calcsoilalbedo, CurYear,IS_LEAPYEAR, cable_user,& gw_params USE cable_phys_constants_mod, ONLY: c_molar_mass + USE cable_phys_constants_mod, ONLY: HL IMPLICIT NONE PRIVATE PUBLIC open_output_file, write_output, close_output_file, create_restart, check_and_write, output_par_settings_type @@ -1640,10 +1641,6 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, ssnow, & TYPE(output_var_settings_type) :: out_settings - ! Temporary accumulation variable to be passed (we expect implicit-type conversion on assignment) - ! Assumption: All variables have size mp, including CASA - REAL(4) :: temp_acc(mp) - out_settings = output_var_settings_type(met=met, writenow=.FALSE., dimswitch='default') ! IF asked to check mass/water balance: @@ -1786,7 +1783,7 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, ssnow, & out_settings%dimswitch = 'default' IF (output%SWdown) THEN ! SWdown: downward short-wave radiation [W/m^2] - CALL generate_out_write_acc(ovid%SWdown, 'SWdown', out%SWdown, REAL(met%fsd(:, 1) + met%fsd(:, 2)), ranges%SWdown, patchout%SWdown, out_settings) + CALL generate_out_write_acc(ovid%SWdown, 'SWdown', out%SWdown, REAL(met%ofsd), ranges%SWdown, patchout%SWdown, out_settings) END IF IF (output%LWdown) THEN ! LWdown: downward long-wave radiation [W/m^2] @@ -1827,7 +1824,7 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, ssnow, & out_settings%dimswitch = 'default' ! Qmom: momentum flux [kg/m/s2] INH IF (output%Qmom) THEN - CALL generate_out_write_acc(ovid%Qmom, 'Qmom', out%Qmom, REAL(air%rho, 4)*(REAL(canopy%us, 4)**2.), ranges%Qmom, patchout%Qmom, out_settings) + CALL generate_out_write_acc(ovid%Qmom, 'Qmom', out%Qmom, REAL(canopy%qmom, 4), ranges%Qmom, patchout%Qmom, out_settings) END IF IF (output%Qmom) THEN ! Qle: latent heat flux [W/m^2] @@ -1851,7 +1848,7 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, ssnow, & END IF IF (output%Evap) THEN ! Evap: total evapotranspiration [kg/m^2/s] - CALL generate_out_write_acc(ovid%Evap, 'Evap', out%Evap, REAL(canopy%fe/air%rlam, 4), ranges%Evap, patchout%Evap, out_settings) + CALL generate_out_write_acc(ovid%Evap, 'Evap', out%Evap, REAL(canopy%fe/HL, 4), ranges%Evap, patchout%Evap, out_settings) END IF IF (output%PotEvap) THEN ! PotEVap: potential evapotranspiration [kg/m^2/s] @@ -1859,21 +1856,16 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, ssnow, & END IF IF (output%ECanop) THEN ! ECanop: interception evaporation [kg/m^2/s] - CALL generate_out_write_acc(ovid%ECanop, 'ECanop', out%ECanop, REAL(canopy%fevw/air%rlam, 4), ranges%ECanop, patchout%ECanop, out_settings) + CALL generate_out_write_acc(ovid%ECanop, 'ECanop', out%ECanop, REAL(canopy%fevw/HL, 4), ranges%ECanop, patchout%ECanop, out_settings) END IF IF (output%TVeg) THEN ! TVeg: vegetation transpiration [kg/m^2/s] - CALL generate_out_write_acc(ovid%TVeg, 'TVeg', out%TVeg, REAL(canopy%fevc/air%rlam, 4), ranges%TVeg, patchout%TVeg, out_settings) + CALL generate_out_write_acc(ovid%TVeg, 'TVeg', out%TVeg, REAL(canopy%fevc/HL, 4), ranges%TVeg, patchout%TVeg, out_settings) END IF IF (output%Esoil) THEN ! ESoil: bare soil evaporation [kg/m^2/s] - IF (cable_user%SOIL_STRUC == 'sli') THEN - temp_acc = ssnow%evap/dels !vh! - ELSE - temp_acc = canopy%fes/air%rlam - END IF - CALL generate_out_write_acc(ovid%Esoil, 'Esoil', out%Esoil, temp_acc, ranges%Esoil, patchout%Esoil, out_settings) + CALL generate_out_write_acc(ovid%Esoil, 'Esoil', out%Esoil, REAL(canopy%fes/HL, 4), ranges%Esoil, patchout%Esoil, out_settings) END IF IF (output%HVeg) THEN @@ -1944,34 +1936,26 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, ssnow, & END IF IF (output%SnowDepth) THEN ! SnowDepth: actual depth of snow in [m] - CALL generate_out_write_acc(ovid%SnowDepth, 'SnowDepth', out%SnowDepth, REAL(SUM(ssnow%sdepth, 2), 4), ranges%SnowDepth, patchout%SnowDepth, out_settings) + CALL generate_out_write_acc(ovid%SnowDepth, 'SnowDepth', out%SnowDepth, REAL(ssnow%totsdepth, 4), ranges%SnowDepth, patchout%SnowDepth, out_settings) END IF !-------------------------WRITE RADIATION DATA------------------------------ IF (output%Swnet) THEN ! SWnet: net shortwave [W/m^2] - temp_acc = SUM(rad%qcan(:, :, 1), 2) + SUM(rad%qcan(:, :, 2), 2) + rad%qssabs - CALL generate_out_write_acc(ovid%Swnet, 'Swnet', out%Swnet, temp_acc, ranges%Swnet, patchout%Swnet, out_settings) + CALL generate_out_write_acc(ovid%Swnet, 'Swnet', out%Swnet, REAL(rad%swnet, 4), ranges%Swnet, patchout%Swnet, out_settings) END IF IF (output%Lwnet) THEN ! LWnet: net longwave [W/m^2] - temp_acc = met%fld - sboltz*emleaf*canopy%tv**4*(1 - rad%transd) - & - rad%flws*rad%transd - CALL generate_out_write_acc(ovid%Lwnet, 'Lwnet', out%Lwnet, temp_acc, ranges%Lwnet, patchout%Lwnet, out_settings) + CALL generate_out_write_acc(ovid%Lwnet, 'Lwnet', out%Lwnet, REAL(rad%lwnet, 4), ranges%Lwnet, patchout%Lwnet, out_settings) END IF IF (output%Rnet) THEN ! Rnet: net absorbed radiation [W/m^2] - temp_acc = met%fld - sboltz*emleaf*canopy%tv**4* & - (1 - rad%transd) - rad%flws*rad%transd + & - SUM(rad%qcan(:, :, 1), 2) + & - SUM(rad%qcan(:, :, 2), 2) + rad%qssabs - CALL generate_out_write_acc(ovid%Rnet, 'Rnet', out%Rnet, temp_acc, ranges%Rnet, patchout%Rnet, out_settings) + CALL generate_out_write_acc(ovid%Rnet, 'Rnet', out%Rnet, REAL(rad%rnet, 4), ranges%Rnet, patchout%Rnet, out_settings) END IF IF (output%Albedo) THEN ! Albedo: - CALL generate_out_write_acc(ovid%Albedo, 'Albedo', out%Albedo, REAL((rad%albedo(:, 1) + rad%albedo(:, 2)) & - *0.5, 4), ranges%Albedo, patchout%Albedo, out_settings) + CALL generate_out_write_acc(ovid%Albedo, 'Albedo', out%Albedo, REAL(rad%albedo_T, 4), ranges%Albedo, patchout%Albedo, out_settings) IF (calcsoilalbedo) THEN CALL generate_out_write_acc(ovid%visAlbedo, 'visAlbedo', out%visAlbedo, REAL(rad%albedo(:, 1), 4), ranges%visAlbedo, patchout%visAlbedo, out_settings) CALL generate_out_write_acc(ovid%nirAlbedo, 'nirAlbedo', out%nirAlbedo, REAL(rad%albedo(:, 2), 4), ranges%nirAlbedo, patchout%nirAlbedo, out_settings) @@ -1981,9 +1965,7 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, ssnow, & ! RadT: Radiative surface temperature [K] IF (output%RadT) THEN - temp_acc = (((1.0 - rad%transd)*emleaf*sboltz* & - canopy%tv**4 + rad%transd*emsoil*sboltz*(ssnow%tss)**4)/sboltz)**0.25 - CALL generate_out_write_acc(ovid%RadT, 'RadT', out%RadT, temp_acc, ranges%RadT, patchout%RadT, out_settings) + CALL generate_out_write_acc(ovid%RadT, 'RadT', out%RadT, REAL(rad%trad, 4), ranges%RadT, patchout%RadT, out_settings) END IF !------------------------WRITE VEGETATION DATA------------------------------ @@ -2088,48 +2070,18 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, ssnow, & !------------------------WRITE CARBON DATA---------------------------------- ! GPP: gross primary production C by veg [umol/m^2/s] ! added frday in the calculation of GPP (BP may08) - - ! temp_acc = REAL((-1.0 * canopy%fpn) / c_molar_mass, 4) IF (output%GPP) THEN - CALL generate_out_write_acc(ovid%GPP, 'GPP', out%GPP, REAL((-1.0*canopy%fpn + canopy%frday) & - /c_molar_mass, 4), ranges%GPP, patchout%GPP, out_settings) + CALL generate_out_write_acc(ovid%GPP, 'GPP', out%GPP, REAL(canopy%fgpp/c_molar_mass, 4), ranges%GPP, patchout%GPP, out_settings) END IF ! NPP: net primary production of C by veg [umol/m^2/s] IF (output%NPP) THEN - ! Add current timestep's value to total of temporary output variable: - !out%NPP = out%NPP + REAL((-1.0 * canopy%fpn - canopy%frp & - ! - casaflux%clabloss/86400.0) / c_molar_mass, 4) - ! vh ! expression below can be slightly different form that above in cases where - ! leaf maintenance respiration is reduced in CASA - ! (relative to its original value calculated in cable_canopy) - ! in order to avoid negative carbon stores. - IF (output%casa) THEN - temp_acc = casaflux%cnpp/86400.0/c_molar_mass - ELSE - temp_acc = (-1.0*canopy%fpn - canopy%frp)/c_molar_mass ! & - END IF - CALL generate_out_write_acc(ovid%NPP, 'NPP', out%NPP, temp_acc, ranges%NPP, patchout%NPP, out_settings) + CALL generate_out_write_acc(ovid%NPP, 'NPP', out%NPP, REAL(canopy%fnpp/c_molar_mass, 4), ranges%NPP, patchout%NPP, out_settings) END IF ! AutoResp: autotrophic respiration [umol/m^2/s] IF (output%AutoResp) THEN - ! Add current timestep's value to total of temporary output variable: - !out%AutoResp = out%AutoResp + REAL((canopy%frp + canopy%frday + casaflux%clabloss/86400.0) & - ! / c_molar_mass, 4) - ! vh ! expression below can be slightly different form that above in cases where - ! leaf maintenance respiration is reduced in CASA - ! (relative to its original value calculated in cable_canopy) - ! in order to avoid negative carbon stores. - - IF (output%casa) THEN - temp_acc = canopy%frday/c_molar_mass + & - (casaflux%crmplant(:, 2)/86400.0 + casaflux%crmplant(:, 3)/86400.0 + & - casaflux%crgplant/86400.0 + casaflux%clabloss/86400.)/c_molar_mass - ELSE - temp_acc = (canopy%frp + canopy%frday)/c_molar_mass - END IF - CALL generate_out_write_acc(ovid%AutoResp, 'AutoResp', out%AutoResp, temp_acc, ranges%AutoResp, patchout%AutoResp, out_settings) + CALL generate_out_write_acc(ovid%AutoResp, 'AutoResp', out%AutoResp, REAL(canopy%fra/c_molar_mass, 4), ranges%AutoResp, patchout%AutoResp, out_settings) IF (output%casa) THEN ! rootresp alt: REAL(0.3*casaflux%crmplant(:,2)/86400.0/ c_molar_mass, 4) CALL generate_out_write_acc(ovid%RootResp, 'RootResp', out%RootResp, & @@ -2159,25 +2111,13 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, ssnow, & ! NBP and turnover fluxes [umol/m^2/s] IF (output%NBP) THEN - IF (cable_user%POPLUC) THEN - temp_acc = -(casaflux%Crsoil - casaflux%cnpp & - - casapool%dClabiledt)/86400.0 & - /c_molar_mass !- & - !REAL((casaflux%FluxCtohwp + casaflux%FluxCtoclear )/86400.0 & - !/ c_molar_mass, 4) - ELSE - temp_acc = -(casaflux%Crsoil - casaflux%cnpp & - - casapool%dClabiledt)/86400.0 & - /c_molar_mass - END IF - CALL generate_out_write_acc(ovid%NBP, 'NBP', out%NBP, temp_acc, ranges%NEE, patchout%NBP, out_settings) + CALL generate_out_write_acc(ovid%NBP, 'NBP', out%NBP, REAL(casaflux%cnbp/86400.0/c_molar_mass, 4), ranges%NEE, patchout%NBP, out_settings) END IF !------------------------WRITE REMAINING CASA DATA---------------------------------- - CALL generate_out_write_acc(ovid%dCdt, 'dCdt', out%dCdt, & - REAL((casapool%ctot - casapool%ctot_0)/86400.0/c_molar_mass, 4), ranges%NEE, patchout%dCdt, out_settings) + CALL generate_out_write_acc(ovid%dCdt, 'dCdt', out%dCdt, REAL(casapool%dCdt/86400.0/c_molar_mass, 4), ranges%NEE, patchout%dCdt, out_settings) CALL generate_out_write_acc(ovid%PlantTurnover, 'PlantTurnover', out%PlantTurnover, & - REAL((SUM(casaflux%Cplant_turnover, 2))/86400.0/c_molar_mass, 4), ranges%NEE, patchout%PlantTurnover, out_settings) + REAL(casaflux%cplant_turnover_tot/86400.0/c_molar_mass, 4), ranges%NEE, patchout%PlantTurnover, out_settings) CALL generate_out_write_acc(ovid%PlantTurnoverLeaf, 'PlantTurnoverLeaf', out%PlantTurnoverLeaf, & REAL((casaflux%Cplant_turnover(:, 1))/86400.0/c_molar_mass, 4), ranges%NEE, patchout%PlantTurnoverLeaf, out_settings) CALL generate_out_write_acc(ovid%PlantTurnoverFineRoot, 'PlantTurnoverFineRoot', out%PlantTurnoverFineRoot, & @@ -2192,13 +2132,13 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, ssnow, & REAL((casaflux%Cplant_turnover_resource_limitation)/86400.0/c_molar_mass, 4), ranges%NEE, patchout%PlantTurnoverWoodResourceLim, out_settings) IF (cable_user%POPLUC) THEN CALL generate_out_write_acc(ovid%LandUseFlux, 'LandUseFlux', out%LandUseFlux, & - REAL((casaflux%FluxCtohwp + casaflux%FluxCtoclear)/86400.0/c_molar_mass, 4), ranges%NEE, patchout%LandUseFlux, out_settings) + REAL(casaflux%FluxCtoLUC/86400.0/c_molar_mass, 4), ranges%NEE, patchout%LandUseFlux, out_settings) END IF ! plant carbon [kg C m-2] - CALL generate_out_write_acc(ovid%TotSoilCarb, 'TotSoilCarb', out%TotSoilCarb, REAL((SUM(casapool%csoil, 2) + SUM(casapool%clitter, 2)) & - /1000.0, 4), ranges%TotSoilCarb, patchout%TotSoilCarb, out_settings) - CALL generate_out_write_acc(ovid%TotLittCarb, 'TotLittCarb', out%TotLittCarb, REAL(SUM(casapool%clitter, 2)/1000.0, 4), & + CALL generate_out_write_acc(ovid%TotSoilCarb, 'TotSoilCarb', out%TotSoilCarb, REAL(casapool%csoiltot/1000.0, 4), & + ranges%TotSoilCarb, patchout%TotSoilCarb, out_settings) + CALL generate_out_write_acc(ovid%TotLittCarb, 'TotLittCarb', out%TotLittCarb, REAL(casapool%clittertot/1000.0, 4), & ranges%TotLittCarb, patchout%TotLittCarb, out_settings) ! csoil @@ -2224,9 +2164,8 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, ssnow, & ranges%TotLittCarb, patchout%PlantCarbWood, out_settings) CALL generate_out_write_acc(ovid%PlantCarbFineRoot, 'PlantCarbFineRoot', out%PlantCarbFineRoot, REAL(casapool%cplant(:, 3)/1000.0, 4), & ranges%TotLittCarb, patchout%PlantCarbFineRoot, out_settings) - - CALL generate_out_write_acc(ovid%TotLivBiomass, 'TotLivBiomass', out%TotLivBiomass, REAL((SUM(casapool%cplant, 2)) & - /1000.0, 4), ranges%TotLivBiomass, patchout%TotLivBiomass, out_settings) + CALL generate_out_write_acc(ovid%TotLivBiomass, 'TotLivBiomass', out%TotLivBiomass, REAL(casapool%cplanttot/1000.0, 4), & + ranges%TotLivBiomass, patchout%TotLivBiomass, out_settings) END IF IF (cable_user%sync_nc_file) & diff --git a/src/offline/casa_cable.F90 b/src/offline/casa_cable.F90 index b85c0ea1c..7010e2ebf 100644 --- a/src/offline/casa_cable.F90 +++ b/src/offline/casa_cable.F90 @@ -515,6 +515,15 @@ SUBROUTINE sumcflux(ktau, kstart, kend, dels, bgc, canopy, & canopy%frs(:) = casaflux%Crsoil(:)/86400.0 canopy%frpw(:)= casaflux%crmplant(:,wood)/86400.0 canopy%frpr(:)= casaflux%crmplant(:,froot)/86400.0 + ! canopy%fnpp = -1.0 * canopy%fpn - canopy%frp - casaflux%clabloss/86400.0 + ! canopy%fra = canopy%frp + canopy%frday + casaflux%clabloss/86400.0 + ! vh ! expressions below can be slightly different from that above in cases + ! where leaf maintenance respiration is reduced in CASA (relative to its + ! original value calculated in cable_canopy) in order to avoid negative carbon + ! stores. + canopy%fnpp = casaflux%cnpp / 86400.0 + canopy%fgpp = casaflux%cgpp / 86400.0 + canopy%fra = canopy%frp + canopy%frday endif if(ktau == kstart) then sum_flux%sumpn = canopy%fpn*dels @@ -540,7 +549,6 @@ SUBROUTINE sumcflux(ktau, kstart, kend, dels, bgc, canopy, & sum_flux%sumrs = sum_flux%sumrs+canopy%frs*dels endif ! Set net ecosystem exchange after adjustments to frs: - canopy%fnpp = -1.0* canopy%fpn - canopy%frp IF (icycle <= 1) THEN canopy%fnee = canopy%fpn + canopy%frs + canopy%frp ELSE diff --git a/src/offline/cbl_model_driver_offline.F90 b/src/offline/cbl_model_driver_offline.F90 index 763e68075..cb7c9f8d7 100644 --- a/src/offline/cbl_model_driver_offline.F90 +++ b/src/offline/cbl_model_driver_offline.F90 @@ -180,6 +180,8 @@ SUBROUTINE cbm( ktau,dels, air, bgc, canopy, met, rad%reffbm, rad%reffdf & ) !EffSurfRefl_beam, EffSurfRefldif_ +rad%albedo_T = (rad%albedo(:, 1) + rad%albedo(:, 2)) * 0.5 + ssnow%otss_0 = ssnow%otss ! vh should be before call to canopy? ssnow%otss = ssnow%tss @@ -219,12 +221,13 @@ SUBROUTINE cbm( ktau,dels, air, bgc, canopy, met, CALL carbon_pl(dels, soil, ssnow, veg, canopy, bgc) - canopy%fnpp = -1.0* canopy%fpn - canopy%frp + canopy%fnpp = -1.0 * canopy%fpn - canopy%frp + canopy%fgpp = -1.0 * canopy%fpn + canopy%frday canopy%fnee = canopy%fpn + canopy%frs + canopy%frp + canopy%fra = canopy%frp + canopy%frday ENDIF - END SUBROUTINE cbm END MODULE cable_cbm_module diff --git a/src/params/cable_phys_constants_mod.F90 b/src/params/cable_phys_constants_mod.F90 index 99af05651..87f607fab 100644 --- a/src/params/cable_phys_constants_mod.F90 +++ b/src/params/cable_phys_constants_mod.F90 @@ -42,7 +42,7 @@ MODULE cable_phys_constants_mod REAL, PARAMETER :: cswat = 4.218e3 ! specific heat for water at 0°C (J/kg/K) REAL, PARAMETER :: density_liq = 1000.0 ! density of liquid water REAL, PARAMETER :: density_ice = 921.0 ! density of ice -REAL, PARAMETER :: c_molar_mass = 1.201e-5 ! molar mass of carbon (ug/mol) +REAL, PARAMETER :: c_molar_mass = 1.201e-5 ! molar mass of carbon (g/umol) ! Teten coefficients REAL, PARAMETER :: tetena = 6.106 ! Magnus Tetans (Murray 1967) diff --git a/src/science/canopy/cable_canopy.F90 b/src/science/canopy/cable_canopy.F90 index 96073e6dc..80c9e84b3 100644 --- a/src/science/canopy/cable_canopy.F90 +++ b/src/science/canopy/cable_canopy.F90 @@ -840,6 +840,8 @@ SUBROUTINE define_canopy(bal,rad,rough,air,met,dels,ssnow,soil,veg, canopy,clima qsurf(j) = 0.1*rsts(j)*ssnow%wetfac(j) + 0.9*met%qv(j) ENDIF + canopy%qmom(j) = air%rho(j) * canopy%us(j) ** 2.0 + canopy%qscrn(j) = met%qv(j) - qstar(j) * ftemp(j) IF( canopy%vlaiw(j) >CLAI_THRESH .AND. rough%hruff(j) > 0.01) THEN @@ -1031,6 +1033,10 @@ SUBROUTINE define_canopy(bal,rad,rough,air,met,dels,ssnow,soil,veg, canopy,clima + CCAPP*Crmair * (tlfy-met%tk) * sum_rad_gradis * & canopy%fwet ! YP nov2009 +rad%swnet = sum(rad%qcan(:, :, 1), 2) + sum(rad%qcan(:, :, 2), 2) + rad%qssabs +rad%lwnet = met%fld - CSboltz * Cemleaf * canopy%tv**4 * (1 - rad%transd) - rad%flws * rad%transd +rad%rnet = rad%swnet + rad%lwnet + DEALLOCATE(cansat,gbhu) DEALLOCATE(dsx, fwsoil, tlfx, tlfy) DEALLOCATE(ecy, hcy, rny) diff --git a/src/science/casa-cnp/biogeochem_casa.F90 b/src/science/casa-cnp/biogeochem_casa.F90 index ef4f860b6..c37eff096 100644 --- a/src/science/casa-cnp/biogeochem_casa.F90 +++ b/src/science/casa-cnp/biogeochem_casa.F90 @@ -171,6 +171,12 @@ SUBROUTINE biogeochem(ktau,dels,idoY,LALLOC,veg,soil,casabiome,casapool,casaflux casapool%Psoillab = max(casapool%Psoillab,0.1) ENDIF +casaflux%cnbp = casaflux%cnpp + casapool%dClabiledt - casaflux%Crsoil + +casaflux%cplant_turnover_tot = sum(casaflux%Cplant_turnover, dim=2) + +casapool%dCdt = casapool%ctot - casapool%ctot_0 + END SUBROUTINE biogeochem END MODULE biogeochem_mod diff --git a/src/science/casa-cnp/casa_cnp.F90 b/src/science/casa-cnp/casa_cnp.F90 index 981d291ca..7589fc198 100644 --- a/src/science/casa-cnp/casa_cnp.F90 +++ b/src/science/casa-cnp/casa_cnp.F90 @@ -2180,13 +2180,13 @@ SUBROUTINE casa_cnpbal(veg,casamet,casapool,casaflux,casabal) ENDIF ENDDO - - + casapool%cplanttot = sum(casapool%cplant, wood) + casapool%clittertot = sum(casapool%clitter, str) + casapool%csoiltot = sum(casapool%csoil, slow) + casapool%clittertot casapool%ctot_0 = SUM(casabal%cplantlast,2)+SUM(casabal%clitterlast,2) & + SUM(casabal%csoillast,2)+ casabal%clabilelast - casapool%ctot = SUM(casapool%cplant,2)+SUM(casapool%clitter,2) & - + SUM(casapool%csoil,2)+ casapool%clabile + casapool%ctot = casapool%cplanttot + casapool%csoiltot + casapool%clabile casabal%sumcbal = casabal%sumcbal + casabal%cbalance diff --git a/src/science/casa-cnp/casa_readbiome.F90 b/src/science/casa-cnp/casa_readbiome.F90 index fc9c88355..fdba821e2 100644 --- a/src/science/casa-cnp/casa_readbiome.F90 +++ b/src/science/casa-cnp/casa_readbiome.F90 @@ -408,6 +408,9 @@ SUBROUTINE casa_readbiome(veg,soil,casabiome,casapool,casaflux,casamet,phen) /(casaflux%kmlabp(:)+casapool%psoillab(:)) ENDIF + casapool%clittertot = sum(casapool%clitter, str) + casapool%cplanttot = sum(casapool%cplant, wood) + casapool%csoiltot = sum(casapool%csoil, slow) + casapool%clittertot END SUBROUTINE casa_readbiome diff --git a/src/science/casa-cnp/casa_sumcflux.F90 b/src/science/casa-cnp/casa_sumcflux.F90 index 6257c0794..f6566ea65 100644 --- a/src/science/casa-cnp/casa_sumcflux.F90 +++ b/src/science/casa-cnp/casa_sumcflux.F90 @@ -63,6 +63,15 @@ SUBROUTINE sumcflux(ktau, kstart, kend, dels, bgc, canopy, & canopy%frs(:) = casaflux%Crsoil(:)/86400.0 canopy%frpw(:)= casaflux%crmplant(:,wood)/86400.0 canopy%frpr(:)= casaflux%crmplant(:,froot)/86400.0 + ! canopy%fnpp = -1.0 * canopy%fpn - canopy%frp - casaflux%clabloss/86400.0 + ! canopy%fra = canopy%frp + canopy%frday + casaflux%clabloss/86400.0 + ! vh ! expressions below can be slightly different from that above in cases + ! where leaf maintenance respiration is reduced in CASA (relative to its + ! original value calculated in cable_canopy) in order to avoid negative carbon + ! stores. + canopy%fnpp = casaflux%cnpp / 86400.0 + canopy%fgpp = casaflux%cgpp / 86400.0 + canopy%fra = canopy%frp + canopy%frday endif if(ktau == kstart) then sum_flux%sumpn = canopy%fpn*dels @@ -88,7 +97,6 @@ SUBROUTINE sumcflux(ktau, kstart, kend, dels, bgc, canopy, & sum_flux%sumrs = sum_flux%sumrs+canopy%frs*dels endif ! Set net ecosystem exchange after adjustments to frs: - canopy%fnpp = -1.0* canopy%fpn - canopy%frp IF (icycle <= 1) THEN canopy%fnee = canopy%fpn + canopy%frs + canopy%frp ELSE diff --git a/src/science/casa-cnp/casa_variable.F90 b/src/science/casa-cnp/casa_variable.F90 index 2937f2f93..c1f4def45 100644 --- a/src/science/casa-cnp/casa_variable.F90 +++ b/src/science/casa-cnp/casa_variable.F90 @@ -84,6 +84,10 @@ MODULE casavariable TYPE casa_pool REAL(r_2), DIMENSION(:),POINTER :: Clabile, & dClabiledt, & + dCdt , & + Cplanttot, & + Clittertot, & + Csoiltot, & Ctot , & ! vh_js ! Ctot_0 REAL(r_2), DIMENSION(:,:),POINTER :: Cplant, & @@ -132,6 +136,7 @@ MODULE casavariable TYPE casa_flux REAL(r_2), DIMENSION(:),POINTER :: Cgpp, & Cnpp, & + Cnbp, & Crp, & Crgplant, & Nminfix, & @@ -142,6 +147,7 @@ MODULE casavariable ! vh_js ! the 3 variables below are needed for POP coupling to CASA stemnpp, & frac_sapwood, & + Cplant_turnover_tot, & sapwood_area REAL(r_2), DIMENSION(:,:),POINTER :: fracCalloc, & fracNalloc, & @@ -203,6 +209,7 @@ MODULE casavariable REAL(r_2), DIMENSION(:),POINTER :: FluxNtoclear REAL(r_2), DIMENSION(:),POINTER :: FluxPtoclear REAL(r_2), DIMENSION(:),POINTER :: CtransferLUC + REAL(r_2), DIMENSION(:),POINTER :: FluxCtoLUC REAL(r_2), DIMENSION(:),POINTER :: meangpp REAL(r_2), DIMENSION(:),POINTER :: meanrleaf END TYPE casa_flux @@ -364,6 +371,10 @@ SUBROUTINE alloc_casavariable(casabiome,casapool,casaflux, & ALLOCATE(casapool%Clabile(arraysize), & casapool%dClabiledt(arraysize), & + casapool%dCdt(arraysize), & + casapool%Cplanttot(arraysize), & + casapool%Clittertot(arraysize), & + casapool%Csoiltot(arraysize), & casapool%Cplant(arraysize,mplant), & casapool%Nplant(arraysize,mplant), & casapool%Pplant(arraysize,mplant), & @@ -412,6 +423,7 @@ SUBROUTINE alloc_casavariable(casabiome,casapool,casaflux, & ALLOCATE(casaflux%Cgpp(arraysize), & casaflux%Cnpp(arraysize), & + casaflux%Cnbp(arraysize), & casaflux%Crp(arraysize), & casaflux%Crgplant(arraysize), & casaflux%Nminfix(arraysize), & @@ -460,6 +472,7 @@ SUBROUTINE alloc_casavariable(casabiome,casapool,casaflux, & casaflux%fromStoCO2(arraysize,msoil), & casaflux%stemnpp(arraysize), & casaflux%frac_sapwood(arraysize), & + casaflux%Cplant_turnover_tot(arraysize), & casaflux%sapwood_area(arraysize), & casaflux%Cplant_turnover(arraysize,mplant) , & casaflux%Cplant_turnover_disturbance(arraysize) , & @@ -493,6 +506,7 @@ SUBROUTINE alloc_casavariable(casabiome,casapool,casaflux, & ) ALLOCATE(casaflux%CtransferLUC(arraysize), SOURCE=0.0_r_2) + ALLOCATE(casaflux%FluxCtoLUC(arraysize), SOURCE=0.0_r_2) ALLOCATE(casaflux%FluxCtoco2(arraysize), SOURCE=0.0_r_2) diff --git a/src/science/pop/POPLUC.F90 b/src/science/pop/POPLUC.F90 index a3977c89b..2384c5ba2 100644 --- a/src/science/pop/POPLUC.F90 +++ b/src/science/pop/POPLUC.F90 @@ -1037,6 +1037,8 @@ SUBROUTINE POP_LUC_CASA_transfer(POPLUC,POP,LUC_EXPT,casapool,casabal,casaflux,k 991 FORMAT(1166(e14.7,2x)) + casaflux%FluxCtoLUC = casaflux%FluxCtohwp + casaflux%FluxCtoclear + ! update total carbon pools and "last" pool values for use in carbon balance checks. casapool%ctot = SUM(casapool%cplant,2)+SUM(casapool%clitter,2)+ & SUM(casapool%csoil,2)+casapool%clabile diff --git a/src/science/soilsnow/cbl_soilsnow_main.F90 b/src/science/soilsnow/cbl_soilsnow_main.F90 index ddf3cd5e2..2cc4c19c9 100644 --- a/src/science/soilsnow/cbl_soilsnow_main.F90 +++ b/src/science/soilsnow/cbl_soilsnow_main.F90 @@ -193,6 +193,8 @@ SUBROUTINE soil_snow(dels, soil, ssnow, canopy, met, bal, veg) ssnow%wbliq = ssnow%wb - ssnow%wbice + ssnow%totsdepth = sum(ssnow%sdepth, dim=2) + ssnow%wbtot = 0.0 DO k = 1, ms ! tot moisture this timestep