From 2240d84d6fac85af9200f79d50c1831e472c0e15 Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Thu, 16 Jan 2025 15:55:42 +0800 Subject: [PATCH 01/43] Fill values for soil parameters of water body --- mksrfdata/Aggregation_SoilParameters.F90 | 228 ++++++++++++++++++----- mksrfdata/MKSRFDATA.F90 | 2 +- 2 files changed, 183 insertions(+), 47 deletions(-) diff --git a/mksrfdata/Aggregation_SoilParameters.F90 b/mksrfdata/Aggregation_SoilParameters.F90 index a576ab79..3cf1631b 100644 --- a/mksrfdata/Aggregation_SoilParameters.F90 +++ b/mksrfdata/Aggregation_SoilParameters.F90 @@ -170,6 +170,32 @@ SUBROUTINE Aggregation_SoilParameters ( & real(r8),allocatable :: fjacc(:,:),fvecc(:),fjacv(:,:),fvecv(:),fjacb(:,:),fvecb(:) integer isiter ! flags to tell whether the iteration is completed, 1=Yes, 0=No + ! Parameters to fill water body patches + real(r8), parameter :: vf_quartz_mineral_fill_water(8) = (/0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.4 /) + real(r8), parameter :: vf_gravels_fill_water(8) = (/0., 0., 0., 0., 0., 0.011, 0.010, 0.010/) + real(r8), parameter :: vf_sand_fill_water(8) = (/0.703, 0.703, 0.704, 0.705, 0.717, 0.722, 0.697, 0.512/) + real(r8), parameter :: vf_om_fill_water(8) = (/0.023, 0.022, 0.021, 0.019, 0.016, 0.011, 0.006, 0.003/) + real(r8), parameter :: wf_gravels_fill_water(8) = (/0., 0., 0., 0., 0., 0.011, 0.011, 0.010/) + real(r8), parameter :: wf_sand_fill_water(8) = (/0.72, 0.72, 0.72, 0.72, 0.73, 0.74, 0.71, 0.52 /) + real(r8), parameter :: theta_r_fill_water(8) = (/0.078, 0.078, 0.077, 0.074, 0.075, 0.074, 0.075, 0.091/) + real(r8), parameter :: alpha_vgm_fill_water(8) = (/0.051, 0.051, 0.050, 0.048, 0.047, 0.044, 0.040, 0.029/) + real(r8), parameter :: n_vgm_fill_water(8) = (/1.413, 1.412, 1.412, 1.414, 1.410, 1.422, 1.399, 1.188/) + real(r8), parameter :: theta_s_fill_water(8) = (/0.374, 0.371, 0.366, 0.358, 0.345, 0.323, 0.297, 0.281/) + real(r8), parameter :: k_s_fill_water(8) = (/96., 89., 79., 75., 79., 74., 55., 19. /) + real(r8), parameter :: L_vgm_fill_water(8) = (/0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5 /) + real(r8), parameter :: psi_s_fill_water(8) = (/-13.5, -13.7, -13.9, -14.8, -15.1, -16.0, -19.8, -45.6/) + real(r8), parameter :: lambda_fill_water(8) = (/0.275, 0.275, 0.275, 0.284, 0.287, 0.291, 0.286, 0.194/) + real(r8), parameter :: csol_fill_water(8) = (/1.3e6, 1.3e6, 1.3e6, 1.3e6, 1.4e6, 1.4e6, 1.5e6, 1.5e6/) + real(r8), parameter :: tksatu_fill_water(8) = (/1.985, 2.002, 2.026, 2.066, 2.133, 2.240, 2.388, 2.053/) + real(r8), parameter :: tksatf_fill_water(8) = (/3.343, 3.356, 3.373, 3.401, 3.448, 3.515, 3.613, 3.036/) + real(r8), parameter :: tkdry_fill_water(8) = (/0.260, 0.264, 0.269, 0.278, 0.293, 0.321, 0.359, 0.387/) + real(r8), parameter :: k_solids_fill_water(8) = (/2.450, 2.467, 2.490, 2.528, 2.590, 2.688, 2.823, 2.405/) + real(r8), parameter :: OM_density_fill_water(8) = (/19.18, 18.57, 17.74, 16.37, 14.18, 10.54, 6.088, 3.319/) + real(r8), parameter :: BD_all_fill_water(8) = (/1673., 1683., 1698., 1721., 1758., 1821., 1897., 1944./) + real(r8), parameter :: BA_alpha_fill_water(8) = (/0.38, 0.38, 0.38, 0.38, 0.38, 0.38, 0.38, 0.38 /) + real(r8), parameter :: BA_beta_fill_water (8) = (/35, 35, 35, 35, 35, 35, 35, 35 /) + + #ifdef SrfdataDiag integer :: typpatch(N_land_classification+1), ityp #endif @@ -287,8 +313,12 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(vf_quartz_mineral_s_patches(ipatch))) THEN - write(*,*) "NAN appears in vf_quartz_mineral_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + vf_quartz_mineral_s_patches(ipatch) = vf_quartz_mineral_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in vf_quartz_mineral_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF ENDDO @@ -397,18 +427,48 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(vf_gravels_s_patches(ipatch))) THEN - write(*,*) "NAN appears in vf_gravels_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + vf_gravels_s_patches(ipatch) = vf_gravels_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in vf_gravels_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF IF (isnan_ud(vf_sand_s_patches(ipatch))) THEN - write(*,*) "NAN appears in vf_sand_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + vf_sand_s_patches(ipatch) = vf_sand_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in vf_sand_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF IF (isnan_ud(vf_om_s_patches(ipatch))) THEN - write(*,*) "NAN appears in vf_om_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + vf_om_s_patches(ipatch) = vf_om_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in vf_om_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF + ENDIF + + IF (isnan_ud(BA_alpha_patches(ipatch))) THEN + IF (L == WATERBODY) THEN + BA_alpha_patches(ipatch) = BA_alpha_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in BA_alpha_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF + ENDIF + + IF (isnan_ud(BA_beta_patches(ipatch))) THEN + IF (L == WATERBODY) THEN + BA_beta_patches(ipatch) = BA_beta_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in BA_beta_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF ENDDO @@ -541,8 +601,12 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(wf_gravels_s_patches(ipatch))) THEN - write(*,*) "NAN appears in wf_gravels_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + wf_gravels_s_patches(ipatch) = wf_gravels_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in wf_gravels_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF ENDDO @@ -604,8 +668,12 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(wf_sand_s_patches(ipatch))) THEN - write(*,*) "NAN appears in wf_sand_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + wf_sand_s_patches(ipatch) = wf_sand_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in wf_sand_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF ENDDO @@ -771,33 +839,57 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(theta_r_patches(ipatch))) THEN - write(*,*) "NAN appears in theta_r_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + theta_r_patches(ipatch) = theta_r_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in theta_r_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF IF (isnan_ud(alpha_vgm_patches(ipatch))) THEN - write(*,*) "NAN appears in alpha_vgm_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + alpha_vgm_patches(ipatch) = alpha_vgm_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in alpha_vgm_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF IF (isnan_ud(n_vgm_patches(ipatch))) THEN - write(*,*) "NAN appears in n_vgm_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + n_vgm_patches(ipatch) = n_vgm_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in n_vgm_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF IF (isnan_ud(theta_s_patches(ipatch))) THEN - write(*,*) "NAN appears in theta_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + theta_s_patches(ipatch) = theta_s_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in theta_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF IF (isnan_ud(k_s_patches(ipatch))) THEN - write(*,*) "NAN appears in k_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + k_s_patches(ipatch) = k_s_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in k_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF IF (isnan_ud(L_vgm_patches(ipatch))) THEN - write(*,*) "NAN appears in L_vgm_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + L_vgm_patches(ipatch) = L_vgm_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in L_vgm_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF ENDDO @@ -1025,23 +1117,39 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(theta_s_patches(ipatch))) THEN - write(*,*) "NAN appears in theta_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + theta_s_patches(ipatch) = theta_s_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in theta_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF IF (isnan_ud(k_s_patches(ipatch))) THEN - write(*,*) "NAN appears in k_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + k_s_patches(ipatch) = k_s_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in k_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF IF (isnan_ud(psi_s_patches(ipatch))) THEN - write(*,*) "NAN appears in psi_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + psi_s_patches(ipatch) = psi_s_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in psi_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF IF (isnan_ud(lambda_patches(ipatch))) THEN - write(*,*) "NAN appears in lambda_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + lambda_patches(ipatch) = lambda_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in lambda_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF ENDDO @@ -1157,8 +1265,12 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(csol_patches(ipatch))) THEN - write(*,*) "NAN appears in csol_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + csol_patches(ipatch) = csol_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in csol_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF ENDDO @@ -1218,8 +1330,12 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(tksatu_patches(ipatch))) THEN - write(*,*) "NAN appears in tksatu_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + tksatu_patches(ipatch) = tksatu_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in tksatu_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF ENDDO @@ -1279,8 +1395,12 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(tksatf_patches(ipatch))) THEN - write(*,*) "NAN appears in tksatf_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + tksatf_patches(ipatch) = tksatf_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in tksatf_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF ENDDO @@ -1340,8 +1460,12 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(tkdry_patches(ipatch))) THEN - write(*,*) "NAN appears in tkdry_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + tkdry_patches(ipatch) = tkdry_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in tkdry_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF ENDDO @@ -1401,8 +1525,12 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(k_solids_patches(ipatch))) THEN - write(*,*) "NAN appears in k_solids_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + k_solids_patches(ipatch) = k_solids_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in k_solids_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF ENDDO @@ -1463,8 +1591,12 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(OM_density_s_patches(ipatch))) THEN - write(*,*) "NAN appears in OM_density_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + OM_density_s_patches(ipatch) = OM_density_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in OM_density_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF ENDDO @@ -1525,8 +1657,12 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(BD_all_s_patches(ipatch))) THEN - write(*,*) "NAN appears in BD_all_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + IF (L == WATERBODY) THEN + BD_all_s_patches(ipatch) = BD_all_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in BD_all_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF ENDIF ENDDO diff --git a/mksrfdata/MKSRFDATA.F90 b/mksrfdata/MKSRFDATA.F90 index 5a966f5d..f8a3d546 100644 --- a/mksrfdata/MKSRFDATA.F90 +++ b/mksrfdata/MKSRFDATA.F90 @@ -286,7 +286,7 @@ PROGRAM MKSRFDATA CALL mesh_build () CALL landelm_build -#ifndef CATCHMENT +#if (defined GRIDBASED || defined UNSTRUCTURED) IF (DEF_LANDONLY) THEN !TODO: distinguish USGS and IGBP land cover #ifndef LULC_USGS From 31d5b6ca7aa874d2040720ee6a9b629e9176b22f Mon Sep 17 00:00:00 2001 From: Oscar Zhang Date: Sat, 18 Jan 2025 12:54:18 +0800 Subject: [PATCH 02/43] Update CoLM.F90 Found a spelling issue --- main/CoLM.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/CoLM.F90 b/main/CoLM.F90 index 34afcab2..77a1ecd4 100644 --- a/main/CoLM.F90 +++ b/main/CoLM.F90 @@ -107,7 +107,7 @@ PROGRAM CoLM character(len=256) :: dir_restart character(len=256) :: fsrfdata - real(r8) :: deltim ! time step (senconds) + real(r8) :: deltim ! time step (seconds) integer :: sdate(3) ! calendar (year, julian day, seconds) integer :: idate(3) ! calendar (year, julian day, seconds) integer :: edate(3) ! calendar (year, julian day, seconds) From 009c94d0472156b370a4a592090fdfa38c59c520 Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Sat, 18 Jan 2025 17:11:22 +0800 Subject: [PATCH 03/43] Code optimizations. --- main/CoLMMAIN.F90 | 14 ++++---------- main/MOD_Eroot.F90 | 4 ++-- main/MOD_SoilSnowHydrology.F90 | 22 ++++++++++------------ main/URBAN/CoLMMAIN_Urban.F90 | 12 ++---------- main/URBAN/MOD_Urban_Hydrology.F90 | 8 +++----- share/MOD_CatchmentDataReadin.F90 | 7 ++++++- 6 files changed, 27 insertions(+), 40 deletions(-) diff --git a/main/CoLMMAIN.F90 b/main/CoLMMAIN.F90 index 2e19c527..b0cedb8d 100644 --- a/main/CoLMMAIN.F90 +++ b/main/CoLMMAIN.F90 @@ -523,8 +523,7 @@ SUBROUTINE CoLMMAIN ( & pg_rain ,&! rainfall onto ground including canopy runoff [kg/(m2 s)] pg_snow ,&! snowfall onto ground including canopy runoff [kg/(m2 s)] qintr_rain ,&! rainfall interception (mm h2o/s) - qintr_snow ,&! snowfall interception (mm h2o/s) - errw_rsub ! the possible subsurface runoff deficit after PHS is included + qintr_snow ! snowfall interception (mm h2o/s) integer snl ,&! number of snow layers imelt(maxsnl+1:nl_soil), &! flag for: melting=1, freezing=2, Nothing happended=0 @@ -646,8 +645,6 @@ SUBROUTINE CoLMMAIN ( & ENDIF ENDIF - errw_rsub = 0._r8 - fiold(:) = 0.0 IF (snl <0 ) THEN fiold(snl+1:0)=wice_soisno(snl+1:0)/(wliq_soisno(snl+1:0)+wice_soisno(snl+1:0)) @@ -769,7 +766,7 @@ SUBROUTINE CoLMMAIN ( & qsubl_snow ,qfros_snow ,fsno ,rsur ,& rnof ,qinfl ,pondmx ,& ssi ,wimp ,smpmin ,zwt ,& - wa ,qcharge ,errw_rsub ,& + wa ,qcharge ,& #if(defined CaMa_Flood) !add variables for flood depth [mm], flood fraction [0-1] and re-infiltration [mm/s] calculation. @@ -906,10 +903,10 @@ SUBROUTINE CoLMMAIN ( & #endif #ifndef CatchLateralFlow - errorw=(endwb-totwb)-(forc_prc+forc_prl-fevpa-rnof-errw_rsub)*deltim + errorw=(endwb-totwb)-(forc_prc+forc_prl-fevpa-rnof)*deltim #else ! for lateral flow, "rsur" is considered in HYDRO/MOD_Hydro_SurfaceFlow.F90 - errorw=(endwb-totwb)-(forc_prc+forc_prl-fevpa-errw_rsub)*deltim + errorw=(endwb-totwb)-(forc_prc+forc_prl-fevpa)*deltim #endif #ifdef CROP @@ -935,9 +932,6 @@ SUBROUTINE CoLMMAIN ( & ENDIF CALL CoLM_stop () ENDIF - IF(abs(errw_rsub*deltim)>1.e-3) THEN - write(6,*) 'Subsurface runoff deficit due to PHS', errw_rsub*deltim - ENDIF #endif !====================================================================== diff --git a/main/MOD_Eroot.F90 b/main/MOD_Eroot.F90 index 76d2ec96..4bda0acc 100644 --- a/main/MOD_Eroot.F90 +++ b/main/MOD_Eroot.F90 @@ -62,7 +62,7 @@ SUBROUTINE eroot (nl_soil,trsmx0,porsl, & real(r8), intent(in) :: sc_vgm (1:nl_soil) real(r8), intent(in) :: fc_vgm (1:nl_soil) #endif - real(r8), intent(in) :: psi0(1:nl_soil) ! saturated soil suction (cm) (NEGATIVE) + real(r8), intent(in) :: psi0(1:nl_soil) ! saturated soil suction (mm) (NEGATIVE) real(r8), intent(in) :: rootfr(1:nl_soil) ! fraction of roots in a layer, real(r8), intent(in) :: dz_soisno(1:nl_soil) ! layer thickness (m) real(r8), intent(in) :: t_soisno(1:nl_soil) ! soil/snow skin temperature (K) @@ -77,7 +77,7 @@ SUBROUTINE eroot (nl_soil,trsmx0,porsl, & real(r8) roota ! accumulates root resistance factors real(r8) rresis(1:nl_soil) ! soil water contribution to root resistance real(r8) s_node ! vol_liq/porosity - real(r8) smpmax ! wilting point potential in cm + real(r8) smpmax ! wilting point potential in mm real(r8) smp_node ! matrix potential integer i ! loop counter diff --git a/main/MOD_SoilSnowHydrology.F90 b/main/MOD_SoilSnowHydrology.F90 index 3b8fb331..c511da8d 100644 --- a/main/MOD_SoilSnowHydrology.F90 +++ b/main/MOD_SoilSnowHydrology.F90 @@ -51,7 +51,6 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& qseva_snow ,qsdew_snow ,qsubl_snow ,qfros_snow ,fsno ,& rsur ,rnof ,qinfl ,pondmx ,ssi ,& wimp ,smpmin ,zwt ,wa ,qcharge ,& - errw_rsub ,& #if(defined CaMa_Flood) flddepth ,fldfrc ,qinfl_fld ,& #endif @@ -155,8 +154,7 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& rsur ,&! surface runoff (mm h2o/s) rnof ,&! total runoff (mm h2o/s) qinfl ,&! infiltration rate (mm h2o/s) - qcharge ,&! groundwater recharge (positive to aquifer) [mm/s] - errw_rsub + qcharge ! groundwater recharge (positive to aquifer) [mm/s] ! SNICAR model variables ! Aerosol Fluxes (Jan. 07, 2023) @@ -402,7 +400,7 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& eff_porosity,icefrac,dz_soisno(1:),zi_soisno(0:),& wice_soisno(1:),wliq_soisno(1:),& porsl,psi0,bsw,zwt,wa,& - qcharge,rsubst,errw_rsub) + qcharge,rsubst) ! total runoff (mm/s) rnof = rsubst + rsur @@ -416,7 +414,7 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& ENDIF err_solver = (sum(wliq_soisno(1:))+sum(wice_soisno(1:))+wa) - w_sum & - - (gwat-etr-rnof-errw_rsub)*deltim + - (gwat-etr-rnof)*deltim IF(lb >= 1)THEN err_solver = err_solver-(qsdew+qfros-qsubl)*deltim @@ -427,7 +425,7 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& wice_soisno(1) = max(0., wice_soisno(1) + (qfros_soil-qsubl_soil) * deltim) err_solver = (sum(wliq_soisno(1:))+sum(wice_soisno(1:))+wa) - w_sum & - - (gwat-etr-rnof-errw_rsub)*deltim + - (gwat-etr-rnof)*deltim err_solver = err_solver-(qsdew_soil+qfros_soil-qsubl_soil)*deltim ENDIF @@ -479,7 +477,6 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& wa = 4800. zwt = 0. qcharge = 0. - errw_rsub = 0. ENDIF @@ -2065,7 +2062,7 @@ SUBROUTINE groundwater (nl_soil,deltim,pondmx,& eff_porosity,icefrac,& dz_soisno,zi_soisno,wice_soisno,wliq_soisno,& porsl,psi0,bsw,zwt,wa,& - qcharge,rsubst,errw_rsub) + qcharge,rsubst) ! ------------------------------------------------------------------------- @@ -2096,7 +2093,6 @@ SUBROUTINE groundwater (nl_soil,deltim,pondmx,& real(r8), intent(inout) :: wa ! water in the unconfined aquifer (mm) real(r8), intent(in) :: qcharge ! aquifer recharge rate (positive to aquifer) (mm/s) real(r8), intent(inout) :: rsubst ! subsurface runoff (positive = out of soil column) (mm H2O /s) - real(r8), intent(out) :: errw_rsub ! the possible subsurface runoff dificit after PHS is included ! ! LOCAL ARGUMENTS @@ -2316,9 +2312,11 @@ SUBROUTINE groundwater (nl_soil,deltim,pondmx,& ENDDO ! Sub-surface runoff and drainage - errw_rsub = min(0., rsubst + xs/deltim) - rsubst = max(0., rsubst + xs/deltim) - + rsubst = rsubst + xs/deltim + IF (rsubst < 0.) THEN + wa = wa + rsubst*deltim + rsubst = 0. + ENDIF ! DO j = 1, nl_soil-1 ! IF (wice_soisno(j)*wice_soisno(j+1) < 1.e-6)THEN diff --git a/main/URBAN/CoLMMAIN_Urban.F90 b/main/URBAN/CoLMMAIN_Urban.F90 index 5b0dd2e5..2fdceecf 100644 --- a/main/URBAN/CoLMMAIN_Urban.F90 +++ b/main/URBAN/CoLMMAIN_Urban.F90 @@ -665,9 +665,6 @@ SUBROUTINE CoLMMAIN_Urban ( & fveg_gper ,&! fraction of fveg/fgper fveg_gimp ! fraction of fveg/fgimp - real(r8) :: & - errw_rsub ! the possible subsurface runoff deficit after PHS is included - real(r8) :: & ei ,&! vapor pressure on leaf surface [pa] deidT ,&! derivative of "ei" on "tl" [pa/K] @@ -1085,8 +1082,7 @@ SUBROUTINE CoLMMAIN_Urban ( & ! output rsur ,rnof ,qinfl ,zwt ,& - wa ,qcharge ,smp ,hk ,& - errw_rsub ) + wa ,qcharge ,smp ,hk ) ! roof !============================================================ @@ -1241,7 +1237,7 @@ SUBROUTINE CoLMMAIN_Urban ( & endwb = sum(wice_soisno(1:) + wliq_soisno(1:)) endwb = endwb + scv + ldew*fveg + wa*(1-froof)*fgper - errorw = (endwb - totwb) - (forc_prc + forc_prl + urb_irrig - fevpa - rnof - errw_rsub)*deltim + errorw = (endwb - totwb) - (forc_prc + forc_prl + urb_irrig - fevpa - rnof)*deltim xerr = errorw/deltim #if(defined CoLMDEBUG) @@ -1249,10 +1245,6 @@ SUBROUTINE CoLMMAIN_Urban ( & write(6,*) 'Warning: water balance violation', errorw, ipatch, patchclass !STOP ENDIF - - IF(abs(errw_rsub*deltim)>1.e-3) THEN - write(6,*) 'Subsurface runoff deficit due to PHS', errw_rsub*deltim - ENDIF #endif !====================================================================== diff --git a/main/URBAN/MOD_Urban_Hydrology.F90 b/main/URBAN/MOD_Urban_Hydrology.F90 index 8dffc4c8..1d4262cb 100644 --- a/main/URBAN/MOD_Urban_Hydrology.F90 +++ b/main/URBAN/MOD_Urban_Hydrology.F90 @@ -75,8 +75,7 @@ SUBROUTINE UrbanHydrology ( & ! output rsur ,rnof ,qinfl ,zwt ,& - wa ,qcharge ,smp ,hk ,& - errw_rsub ) + wa ,qcharge ,smp ,hk ) !======================================================================= ! this is the main SUBROUTINE to execute the calculation of URBAN @@ -227,8 +226,7 @@ SUBROUTINE UrbanHydrology ( & real(r8), intent(out) :: & smp(1:nl_soil) ,&! soil matrix potential [mm] - hk (1:nl_soil) ,&! hydraulic conductivity [mm h2o/m] - errw_rsub ! the possible subsurface runoff deficit after PHS is included + hk (1:nl_soil) ! hydraulic conductivity [mm h2o/m] ! !-----------------------Local Variables------------------------------ ! @@ -273,7 +271,7 @@ SUBROUTINE UrbanHydrology ( & 0. ,& ! fsno, not active rsur_gper ,rnof_gper ,qinfl ,& pondmx ,ssi ,wimp ,smpmin ,& - zwt ,wa ,qcharge ,errw_rsub ,& + zwt ,wa ,qcharge ,& #if(defined CaMa_Flood) flddepth ,fldfrc ,qinfl_fld ,& #endif diff --git a/share/MOD_CatchmentDataReadin.F90 b/share/MOD_CatchmentDataReadin.F90 index b7442d50..89f82cc6 100644 --- a/share/MOD_CatchmentDataReadin.F90 +++ b/share/MOD_CatchmentDataReadin.F90 @@ -64,7 +64,12 @@ SUBROUTINE catchment_data_read (file_meshdata_in, dataname, grid, rdata, spv) ENDIF ENDIF - in_one_file = ncio_var_exist (file_meshdata_in, dataname) + IF (p_is_master) THEN + in_one_file = ncio_var_exist (file_meshdata_in, dataname) + ENDIF +#ifdef USEMPI + CALL mpi_bcast (in_one_file, 1, mpi_logical, p_address_master, p_comm_glb, p_err) +#endif IF (in_one_file) THEN From 2e14a7546475a7ef15703e7b8c63adefe643b29d Mon Sep 17 00:00:00 2001 From: weinan123 Date: Tue, 21 Jan 2025 17:25:33 +0800 Subject: [PATCH 04/43] fix a bug in snowwater_lake when dealing with snow melt above unfrozen top lake layer --- main/MOD_Lake.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/MOD_Lake.F90 b/main/MOD_Lake.F90 index af236cd3..3e2ef6e5 100644 --- a/main/MOD_Lake.F90 +++ b/main/MOD_Lake.F90 @@ -1799,7 +1799,7 @@ SUBROUTINE snowwater_lake ( USE_Dynamic_Lake, & ! all snow melt IF (c>=a+b)THEN t_lake(1) = (cpliq*(denh2o*dz_lake(1)*t_lake(1) + (sumsnowice+sumsnowliq)*tfrz) - a - b) / & - (cpliq*(denh2o*dz_lake(1) + sumsnowice+ sumsnowice)) + (cpliq*(denh2o*dz_lake(1) + sumsnowice + sumsnowliq)) sm = sm + scv/deltim qout_snowb = qout_snowb + scv/deltim scv = 0. From ba7e20ffbe9d8ae2dfd28d68877d808e7982d27a Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 21 Jan 2025 18:12:30 +0800 Subject: [PATCH 05/43] Modify snow optical properties for VEG SNOW. -mod(MOD_3DCanopyRadiation.F90): change snow rho and tau ratio. --- main/MOD_3DCanopyRadiation.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/MOD_3DCanopyRadiation.F90 b/main/MOD_3DCanopyRadiation.F90 index 3c685c72..ed49d9d3 100644 --- a/main/MOD_3DCanopyRadiation.F90 +++ b/main/MOD_3DCanopyRadiation.F90 @@ -100,8 +100,8 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) ! vegetation snow optical properties, 1:vis, 2:nir real(r8) :: rho_sno(2), tau_sno(2) - data rho_sno(1), rho_sno(2) /0.6, 0.3/ - data tau_sno(1), tau_sno(2) /0.2, 0.1/ + data rho_sno(1), rho_sno(2) /0.4, 0.2/ + data tau_sno(1), tau_sno(2) /0.4, 0.2/ ! get patch PFT index ps = patch_pft_s(ipatch) From 2f0b44ccd02d999b442ddd3309d8f1e639058386 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Thu, 23 Jan 2025 15:57:39 +0800 Subject: [PATCH 06/43] Adjust leaf snow optical properties for VEG_SNOW. -mod(MOD_3DCanopyRadiation.F90,MOD_Albedo.F90): change leaf snow scattering from 0.8 to 0.6 in VIS band. -mod(MOD_SnowFraction.F90): for shrub and grass, back to original burying calculation. --- main/MOD_3DCanopyRadiation.F90 | 4 ++-- main/MOD_Albedo.F90 | 4 ++-- main/MOD_SnowFraction.F90 | 12 ++---------- 3 files changed, 6 insertions(+), 14 deletions(-) diff --git a/main/MOD_3DCanopyRadiation.F90 b/main/MOD_3DCanopyRadiation.F90 index ed49d9d3..91538647 100644 --- a/main/MOD_3DCanopyRadiation.F90 +++ b/main/MOD_3DCanopyRadiation.F90 @@ -100,8 +100,8 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) ! vegetation snow optical properties, 1:vis, 2:nir real(r8) :: rho_sno(2), tau_sno(2) - data rho_sno(1), rho_sno(2) /0.4, 0.2/ - data tau_sno(1), tau_sno(2) /0.4, 0.2/ + data rho_sno(1), rho_sno(2) /0.3, 0.2/ + data tau_sno(1), tau_sno(2) /0.3, 0.2/ ! get patch PFT index ps = patch_pft_s(ipatch) diff --git a/main/MOD_Albedo.F90 b/main/MOD_Albedo.F90 index f8fd1316..db701c85 100644 --- a/main/MOD_Albedo.F90 +++ b/main/MOD_Albedo.F90 @@ -569,7 +569,7 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, fwet_snow, & real(r8) :: upscat_sno = 0.5 !upscat parameter for snow real(r8) :: beta0_sno = 0.5 !beta0 parameter for snow real(r8) :: scat_sno(2) !snow single scattering albedo - data scat_sno(1), scat_sno(2) /0.8, 0.4/ ! 1:vis, 2: nir + data scat_sno(1), scat_sno(2) /0.6, 0.4/ ! 1:vis, 2: nir integer iw ! band iterator @@ -902,7 +902,7 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, fwet_snow, & real(r8) :: upscat_sno = 0.5 !upscat parameter for snow real(r8) :: beta0_sno = 0.5 !beta0 parameter for snow real(r8) :: scat_sno(2) !snow single scattering albedo - data scat_sno(1), scat_sno(2) /0.8, 0.4/ ! 1:vis, 2: nir + data scat_sno(1), scat_sno(2) /0.6, 0.4/ ! 1:vis, 2: nir integer iw ! band loop index integer ic ! direct/diffuse loop index diff --git a/main/MOD_SnowFraction.F90 b/main/MOD_SnowFraction.F90 index 29a876d0..2d5e2d5c 100644 --- a/main/MOD_SnowFraction.F90 +++ b/main/MOD_SnowFraction.F90 @@ -141,23 +141,15 @@ SUBROUTINE snowfraction_pftwrap (ipatch,zlnd,scv,snowdp,wt,sigf,fsno) ENDIF ! snow on vegetation, USE snowdp to calculate buried fraction - ! distingush tree, shrub and grass IF ( DEF_VEG_SNOW .and. tlai_p(i)+tsai_p(i) > 1.e-6 ) THEN - ! for non-grass, use hbot, htop to determine how much lsai being buried. - IF (p.gt.0 .and. p.le.11) THEN + ! for trees, use hbot, htop to determine how much lsai being buried. + IF (p.gt.0 .and. p.le.8) THEN wt = max(0., (snowdp-hbot_p(i))) / (htop_p(i)-hbot_p(i)) wt = min(wt, 1.) sigf_p(i) = 1. - wt - ELSE - ! for grass, 0-0.2m? - wt = min(1., snowdp/0.2) - sigf_p(i) = 1. - wt ENDIF ENDIF - !IF(sigf_p(i) < 0.001) sigf_p(i) = 0. - !IF(sigf_p(i) > 0.999) sigf_p(i) = 1. - wt_tmp = wt_tmp + wt*pftfrac(i) ENDDO From 24648199d31cdf6153be876267ac0af2cf7b71cb Mon Sep 17 00:00:00 2001 From: chrislxj Date: Thu, 23 Jan 2025 21:37:51 +0800 Subject: [PATCH 07/43] update runscripts for tianhe; add DEF_PIO_groupsize=2 for mkinitial --- mkinidata/CoLMINI.F90 | 2 ++ run/scripts/batch.slurm-tianhexy.config | 1 - run/scripts/create_scripts | 2 +- run/scripts/machine-github.config | 24 ++++++++++++++++++++++++ run/scripts/machine.config | 25 +------------------------ 5 files changed, 28 insertions(+), 26 deletions(-) create mode 100644 run/scripts/machine-github.config mode change 100644 => 120000 run/scripts/machine.config diff --git a/mkinidata/CoLMINI.F90 b/mkinidata/CoLMINI.F90 index 39488288..47e6f0fb 100644 --- a/mkinidata/CoLMINI.F90 +++ b/mkinidata/CoLMINI.F90 @@ -81,6 +81,8 @@ PROGRAM CoLMINI CALL getarg (1, nlfile) CALL read_namelist (nlfile) + DEF_PIO_groupsize = 2 + casename = DEF_CASE_NAME dir_landdata = DEF_dir_landdata dir_restart = DEF_dir_restart diff --git a/run/scripts/batch.slurm-tianhexy.config b/run/scripts/batch.slurm-tianhexy.config index f272784f..7e2e66db 100644 --- a/run/scripts/batch.slurm-tianhexy.config +++ b/run/scripts/batch.slurm-tianhexy.config @@ -1,4 +1,3 @@ -#------------------------------tianhexy-------------------------------------------- #!/bin/bash #SBATCH -J diff --git a/run/scripts/create_scripts b/run/scripts/create_scripts index c19eda35..60a14fa3 100755 --- a/run/scripts/create_scripts +++ b/run/scripts/create_scripts @@ -245,7 +245,7 @@ CreateScripts() fi cat>>mksrf.submit< ../../logmksrfdata +${EXEC} $NP ./mksrfdata.x ../../input_${CASENAME}.nml > ../../logmksrfdata EOF diff --git a/run/scripts/machine-github.config b/run/scripts/machine-github.config new file mode 100644 index 00000000..02e3e282 --- /dev/null +++ b/run/scripts/machine-github.config @@ -0,0 +1,24 @@ +NProcesses_mksrf 672 +NNodes_mksrf 14 +NTasksPerNode_mksrf 48 +Memory_mksrf 150G +Walltime_mksrf 24:00:00 +Queue_mksrf normal +NProcesses_mkini 48 +NNodes_mkini 1 +NTasksPerNode_mkini 48 +Memory_mkini 150G +Walltime_mkini 24:00:00 +Queue_mkini normal +NProcesses_case 240 +NNodes_case 5 +NTasksPerNode_case 48 +Memory_case 150G +Walltime_case 24:00:00 +Queue_case normal +ROOT /share/home/dq010//CoLM202X-pre-release/ +RAWDATA /share/home/dq010/CoLM/data/rawdata/CROP-NITRIF/CLMrawdata_updating/ +RUNTIME /share/home/dq010/CoLM/data/rawdata/CROP-NITRIF/CoLMruntime// +MAKEOPTION Makeoptions.SYSU-BaiduBoat +FORCINGPATH /share/home/dq013/zhwei/colm/data/CoLM_Forcing/crujra_v2.5/ + diff --git a/run/scripts/machine.config b/run/scripts/machine.config deleted file mode 100644 index 02e3e282..00000000 --- a/run/scripts/machine.config +++ /dev/null @@ -1,24 +0,0 @@ -NProcesses_mksrf 672 -NNodes_mksrf 14 -NTasksPerNode_mksrf 48 -Memory_mksrf 150G -Walltime_mksrf 24:00:00 -Queue_mksrf normal -NProcesses_mkini 48 -NNodes_mkini 1 -NTasksPerNode_mkini 48 -Memory_mkini 150G -Walltime_mkini 24:00:00 -Queue_mkini normal -NProcesses_case 240 -NNodes_case 5 -NTasksPerNode_case 48 -Memory_case 150G -Walltime_case 24:00:00 -Queue_case normal -ROOT /share/home/dq010//CoLM202X-pre-release/ -RAWDATA /share/home/dq010/CoLM/data/rawdata/CROP-NITRIF/CLMrawdata_updating/ -RUNTIME /share/home/dq010/CoLM/data/rawdata/CROP-NITRIF/CoLMruntime// -MAKEOPTION Makeoptions.SYSU-BaiduBoat -FORCINGPATH /share/home/dq013/zhwei/colm/data/CoLM_Forcing/crujra_v2.5/ - diff --git a/run/scripts/machine.config b/run/scripts/machine.config new file mode 120000 index 00000000..cfa3f623 --- /dev/null +++ b/run/scripts/machine.config @@ -0,0 +1 @@ +machine-github.config \ No newline at end of file From 850cdd1587db8e160ffac5e2739ef77d4a888955 Mon Sep 17 00:00:00 2001 From: chrislxj Date: Thu, 23 Jan 2025 21:48:50 +0800 Subject: [PATCH 08/43] additional configuration files are added for scripts --- run/scripts/diffcasecode.bash | 188 +++++++++++++++++++++++++++ run/scripts/machine-baiduboat.config | 26 ++++ run/scripts/machine-github.config | 2 + run/scripts/machine-tianhexy.config | 26 ++++ 4 files changed, 242 insertions(+) create mode 100755 run/scripts/diffcasecode.bash create mode 100644 run/scripts/machine-baiduboat.config create mode 100644 run/scripts/machine-tianhexy.config diff --git a/run/scripts/diffcasecode.bash b/run/scripts/diffcasecode.bash new file mode 100755 index 00000000..0166bb23 --- /dev/null +++ b/run/scripts/diffcasecode.bash @@ -0,0 +1,188 @@ +ROOT=/share/home/dq010/CoLM202X-pre-release/ +if [ $# -eq 2 ];then + if [ "${1:0:1}" == '/' ];then + CASENAME1=`echo "${1##*/}"` + CASEPATH1=`echo "${1%/*}"` + echo $CASEPATH1 + echo $CASENAME1 + else + CASEPATHNAME1=$PWD/$1 + CASENAME1=`echo "${CASEPATHNAME1##*/}"` + CASEPATH1=`echo "${CASEPATHNAME1%/*}"` + echo $CASEPATH1 + echo $CASENAME1 + fi + if [ "${2:0:1}" == '/' ];then + CASENAME2=`echo "${2##*/}"` + CASEPATH2=`echo "${2%/*}"` + echo $CASEPATH2 + echo $CASENAME2 + else + CASEPATHNAME2=$PWD/$2 + CASENAME2=`echo "${CASEPATHNAME2##*/}"` + CASEPATH2=`echo "${CASEPATHNAME2%/*}"` + echo $CASEPATH2 + echo $CASENAME2 + fi + + echo diff between case $1 and $2 + cd $CASEPATH1/$CASENAME1/bld/main/ + for files in *F90 + do +# echo main/$files + tmp=`diff $files /$CASEPATH2/$CASENAME2/bld/main/` + if [ ! -z "$tmp" ];then + echo "file differs !!!!!!!!!!" main/$files + diff $files $CASEPATH2/$CASENAME2/bld/main/ + fi + done + + cd BGC + for files in *F90 + do +# echo main/BGC/$files + tmp=`diff $files $CASEPATH2/$CASENAME2/bld/main/BGC` + if [ ! -z "$tmp" ];then + echo "file differs !!!!!!!!!!" main/$files + diff $files $CASEPATH2/$CASENAME2/bld/main/BGC + fi + done + + cd ../HYDRO + for files in *F90 + do +# echo main/HYDRO/$files + tmp=`diff $files $CASEPATH2/$CASENAME2/bld/main/HYDRO` + if [ ! -z "$tmp" ];then + echo "file differs !!!!!!!!!!" main/$files + diff $files $CASEPATH2/$CASENAME2/bld/main/HYDRO + fi + done + + cd ../URBAN + for files in *F90 + do +# echo main/URBAN/$files + tmp=`diff $files $CASEPATH2/$CASENAME2/bld/main/URBAN` + if [ ! -z "$tmp" ];then + echo "file differs !!!!!!!!!!" main/$files + diff $files $CASEPATH2/$CASENAME2/bld/main/URBAN + fi + done + + cd ../../mksrfdata/ + for files in *F90 + do + tmp=`diff $files $CASEPATH2/$CASENAME2/bld/mksrfdata` + if [ ! -z "$tmp" ];then + echo "file differs !!!!!!!!!" mksrfdata/$files + diff $files $CASEPATH2/$CASENAME2/bld/mksrfdata + fi + done + + cd ../mkinidata/ + for files in *F90 + do + tmp=`diff $files $CASEPATH2/$CASENAME2/bld/mkinidata` + if [ ! -z "$tmp" ];then + echo "file differs !!!!!!!!" mkinidata/$files + diff $files $CASEPATH2/$CASENAME2/bld/mkinidata + fi + done + + cd ../share/ + for files in *F90 + do + tmp=`diff $files $CASEPATH2/$CASENAME2/bld/share` + if [ ! -z "$tmp" ];then + echo "file differs !!!!!!!!" share/$files + diff $files $CASEPATH2/$CASENAME2/bld/share + fi + done +fi + +if [ $# -eq 1 ];then + if [ "${1:0:1}" == '/' ];then + CASENAME1=`echo "${1##*/}"` + CASEPATH1=`echo "${1%/*}"` + echo $CASEPATH1 + echo $CASENAME1 + else + CASEPATHNAME1=$PWD/$1 + CASENAME1=`echo "${CASEPATHNAME1##*/}"` + CASEPATH1=`echo "${CASEPATHNAME1%/*}"` + echo $CASEPATH1 + echo $CASENAME1 + fi + + echo diff between case $1 and root + cd $CASEPATH1/$CASENAME1/bld/main + for files in *F90 + do + tmp=`diff $files $ROOT/main/` + if [ ! -z "$tmp" ];then + echo "file differs !!!!!!!!" main/$files + diff $files $ROOT/main/ + fi + done + + cd BGC + for files in *F90 + do + tmp=`diff $files $ROOT/main/BGC` + if [ ! -z "$tmp" ];then + echo "file differs !!!!!!!!" main/BGC/$files + diff $files $ROOT/main/BGC + fi + done + + cd ../HYDRO + for files in *F90 + do + tmp=`diff $files $ROOT/main/HYDRO` + if [ ! -z "$tmp" ];then + echo "file differs !!!!!!!!" main/HYDRO/$files + diff $files $ROOT/main/HYDRO + fi + done + + cd ../URBAN + for files in *F90 + do + tmp=`diff $files $ROOT/main/URBAN` + if [ ! -z "$tmp" ];then + echo "file differs !!!!!!!!" main/URBAN/$files + diff $files $ROOT/main/URBAN + fi + done + + cd ../../mksrfdata/ + for files in *F90 + do + tmp=`diff $files $ROOT/mksrfdata` + if [ ! -z "$tmp" ];then + echo "file differs !!!!!!!!" mksrfdata/$files + diff $files $ROOT/mksrfdata + fi + done + + cd ../mkinidata/ + for files in *F90 + do + tmp=`diff $files $ROOT/mkinidata` + if [ ! -z "$tmp" ];then + echo "file differs !!!!!!!!" mkinidata/$files + diff $files $ROOT/mkinidata + fi + done + + cd ../share/ + for files in *F90 + do + tmp=`diff $files $ROOT/share` + if [ ! -z "$tmp" ];then + echo "file differs !!!!!!!!" share/$files + diff $files $ROOT/share + fi + done +fi diff --git a/run/scripts/machine-baiduboat.config b/run/scripts/machine-baiduboat.config new file mode 100644 index 00000000..8e178e31 --- /dev/null +++ b/run/scripts/machine-baiduboat.config @@ -0,0 +1,26 @@ +NProcesses_mksrf 672 +NNodes_mksrf 14 +NTasksPerNode_mksrf 48 +Memory_mksrf 150G +Walltime_mksrf 24:00:00 +Queue_mksrf normal +NProcesses_mkini 48 +NNodes_mkini 1 +NTasksPerNode_mkini 48 +Memory_mkini 150G +Walltime_mkini 24:00:00 +Queue_mkini normal +NProcesses_case 240 +NNodes_case 5 +NTasksPerNode_case 48 +Memory_case 150G +Walltime_case 24:00:00 +Queue_case normal +Exe_command mpirun +Exe_opt -np +ROOT /share/home/dq010//CoLM202X-pre-release/ +RAWDATA /share/home/dq010/CoLM/data/rawdata/CROP-NITRIF/CLMrawdata_updating/ +RUNTIME /share/home/dq010/CoLM/data/rawdata/CROP-NITRIF/CoLMruntime// +MAKEOPTION Makeoptions.SYSU-BaiduBoat +FORCINGPATH /share/home/dq013/zhwei/colm/data/CoLM_Forcing/crujra_v2.5/ + diff --git a/run/scripts/machine-github.config b/run/scripts/machine-github.config index 02e3e282..8e178e31 100644 --- a/run/scripts/machine-github.config +++ b/run/scripts/machine-github.config @@ -16,6 +16,8 @@ NTasksPerNode_case 48 Memory_case 150G Walltime_case 24:00:00 Queue_case normal +Exe_command mpirun +Exe_opt -np ROOT /share/home/dq010//CoLM202X-pre-release/ RAWDATA /share/home/dq010/CoLM/data/rawdata/CROP-NITRIF/CLMrawdata_updating/ RUNTIME /share/home/dq010/CoLM/data/rawdata/CROP-NITRIF/CoLMruntime// diff --git a/run/scripts/machine-tianhexy.config b/run/scripts/machine-tianhexy.config new file mode 100644 index 00000000..8333d788 --- /dev/null +++ b/run/scripts/machine-tianhexy.config @@ -0,0 +1,26 @@ +NProcesses_mksrf 512 +NNodes_mksrf 8 +NTasksPerNode_mksrf 64 +Memory_mksrf 400G +Walltime_mksrf 24:00:00 +Queue_mksrf mars +NProcesses_mkini 64 +NNodes_mkini 1 +NTasksPerNode_mkini 64 +Memory_mkini 400G +Walltime_mkini 24:00:00 +Queue_mkini mars +NProcesses_case 384 +NNodes_case 6 +NTasksPerNode_case 64 +Memory_case 400G +Walltime_case 24:00:00 +Queue_case mars +Exe_command yhrun +Exe_opt -n +ROOT /XYFS01/HDD_POOL/sysu_yjdai2/sysu_yjdai2xy_5/CoLM2024-pre-release/ +RAWDATA /XYFS01/HDD_POOL/sysu_yjdai2/SHARE01/CoLMdata/CoLMrawdata/ +RUNTIME /XYFS01/HDD_POOL/sysu_yjdai2/SHARE01/CoLMdata/CoLMruntime/ +MAKEOPTION Makeoptions.Tianhe-XY +FORCINGPATH /XYFS01/HDD_POOL/sysu_yjdai2/SHARE01/CoLMdata/CoLM_Forcing/crujra_v2.5/ + From e217c92cf90934ab0ef81d4b1ced6bde9ad4daf7 Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Thu, 23 Jan 2025 22:56:39 +0800 Subject: [PATCH 09/43] Optimization for special cases of defining grid. --- share/MOD_Grid.F90 | 4 +-- share/MOD_Pixel.F90 | 72 +++++++++++++++++++-------------------------- 2 files changed, 33 insertions(+), 43 deletions(-) diff --git a/share/MOD_Grid.F90 b/share/MOD_Grid.F90 index e6ab4bc1..5f773c3a 100644 --- a/share/MOD_Grid.F90 +++ b/share/MOD_Grid.F90 @@ -864,7 +864,7 @@ SUBROUTINE set_grid_concat (this, grid) ilonloc = 0 DO WHILE (.true.) ilon = mod(ilon,grid%nlon) + 1 - IF (grid%xblk(ilon) /= iblk) THEN + IF ((grid%xblk(ilon) /= iblk) .or. (grid%xloc(ilon) == 1)) THEN this%nxseg = this%nxseg + 1 iblk = grid%xblk(ilon) ENDIF @@ -899,7 +899,7 @@ SUBROUTINE set_grid_concat (this, grid) DO WHILE (.true.) ilon = mod(ilon,grid%nlon) + 1 ilonloc = ilonloc + 1 - IF (grid%xblk(ilon) /= iblk) THEN + IF ((grid%xblk(ilon) /= iblk) .or. (grid%xloc(ilon) == 1)) THEN ixseg = ixseg + 1 iblk = grid%xblk(ilon) this%xsegs(ixseg)%blk = iblk diff --git a/share/MOD_Pixel.F90 b/share/MOD_Pixel.F90 index b9c3df2e..1ed67fe7 100644 --- a/share/MOD_Pixel.F90 +++ b/share/MOD_Pixel.F90 @@ -124,9 +124,9 @@ SUBROUTINE pixel_assimilate_latlon (this, & integer :: iy1, iy2, ys2, yn2 real(r8), allocatable :: ytmp(:) - integer :: nx - integer :: ix1, ix2, xw2, xe2 - real(r8), allocatable :: xtmp(:) + integer :: nx, nlonc + integer :: ix1, ix2, xw2 + real(r8), allocatable :: xtmp(:), loncirc(:) IF (lat_s(1) <= lat_s(nlat)) THEN yinc = 1 @@ -180,55 +180,45 @@ SUBROUTINE pixel_assimilate_latlon (this, & west = lon_w(1) east = lon_e(nlon) - allocate (xtmp (this%nlon+nlon+2)) + IF (west == east) THEN + nlonc = nlon + allocate (loncirc (nlonc)) + loncirc = lon_w + ELSE + nlonc = nlon + 1 + allocate (loncirc (nlonc)) + loncirc(1:nlon) = lon_w + loncirc(nlon+1) = east + ENDIF + allocate (xtmp (this%nlon+nlon+2)) nx = 0 DO ix1 = 1, this%nlon + nx = nx + 1 xtmp(nx) = this%lon_w(ix1) - IF ( lon_between_floor(this%lon_w(ix1), west, east) & - .or. lon_between_ceil (this%lon_e(ix1), west, east) & - .or. lon_between_floor(west, this%lon_w(ix1), this%lon_e(ix1)) & - .or. lon_between_ceil (east, this%lon_w(ix1), this%lon_e(ix1))) THEN - - xw2 = find_nearest_west (this%lon_w(ix1), nlon, lon_w) - xe2 = find_nearest_east (this%lon_e(ix1), nlon, lon_e) - - IF (.not. lon_between_floor(this%lon_w(ix1), lon_w(xw2), lon_e(xw2))) THEN - xw2 = mod(xw2,nlon) + 1 - ENDIF - - IF (.not. lon_between_ceil(this%lon_e(ix1), lon_w(xe2), lon_e(xe2))) THEN - xe2 = xe2 - 1 - IF (xe2 == 0) xe2 = nlon - ENDIF - - IF ((lon_between_floor(lon_w(xw2), this%lon_w(ix1), this%lon_e(ix1)) & - .and. (lon_w(xw2) /= this%lon_w(ix1)))) THEN - nx = nx + 1 - xtmp(nx) = lon_w(xw2) - ENDIF - - IF (xw2 /= xe2) THEN - ix2 = mod(xw2,nlon) + 1 - DO WHILE (.true.) + xw2 = find_nearest_west (this%lon_w(ix1), nlonc, loncirc) + ix2 = mod(xw2,nlonc) + 1 + DO WHILE (.true.) + IF (lon_between_floor(loncirc(ix2), this%lon_w(ix1), this%lon_e(ix1))) THEN + IF (loncirc(ix2) /= this%lon_w(ix1)) THEN nx = nx + 1 - xtmp(nx) = lon_w(ix2) + xtmp(nx) = loncirc(ix2) + ENDIF - IF (ix2 == xe2) EXIT - ix2 = mod(ix2,nlon) + 1 - ENDDO + IF (ix2 /= xw2) THEN + ix2 = mod(ix2,nlonc) + 1 + ELSE + EXIT + ENDIF + ELSE + EXIT ENDIF + ENDDO - IF ((lon_between_ceil(lon_e(xe2), this%lon_w(ix1), this%lon_e(ix1))) & - .and. (lon_e(xe2) /= this%lon_e(ix1))) THEN - nx = nx + 1 - xtmp(nx) = lon_e(xe2) - ENDIF - ENDIF ENDDO - + nx = nx + 1 xtmp(nx) = this%lon_e(this%nlon) From 18bd8aea966bcac81cf760623fedb4094959861a Mon Sep 17 00:00:00 2001 From: CoLM-SYSU <89968722+CoLM-SYSU@users.noreply.github.com> Date: Thu, 23 Jan 2025 23:08:47 +0800 Subject: [PATCH 10/43] Fix bug in create_scripts --- run/scripts/create_scripts | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/run/scripts/create_scripts b/run/scripts/create_scripts index 60a14fa3..c7c2addc 100755 --- a/run/scripts/create_scripts +++ b/run/scripts/create_scripts @@ -245,7 +245,7 @@ CreateScripts() fi cat>>mksrf.submit< ../../logmksrfdata +${EXEC} ${EXEO} $NP ./mksrfdata.x ../../input_${CASENAME}.nml > ../../logmksrfdata EOF From fb9be04f3053d8f730f693b8751d32f7b4b0589b Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Sat, 25 Jan 2025 10:37:11 +0800 Subject: [PATCH 11/43] Optimize send/recv in MOD_Mesh --- share/MOD_Mesh.F90 | 83 ++++++++++++++++++++++------------------------ 1 file changed, 39 insertions(+), 44 deletions(-) diff --git a/share/MOD_Mesh.F90 b/share/MOD_Mesh.F90 index d03b5aac..14c4f1ff 100644 --- a/share/MOD_Mesh.F90 +++ b/share/MOD_Mesh.F90 @@ -140,7 +140,7 @@ SUBROUTINE mesh_build () real(r8) :: dlatp, dlonp logical :: is_new integer :: nsend, nrecv, irecv - integer :: smesg(5), rmesg(5) + integer :: smesg(5), rmesg(5), blktag, elmtag integer, allocatable :: nelm_worker(:) type(pointer_int64_1d), allocatable :: elist_worker(:) @@ -429,6 +429,7 @@ SUBROUTINE mesh_build () allocate (sbuf64 (nxp*nyp)) + blktag = iblkme ipt2 = mod(elist2, p_np_worker) DO iproc = 0, p_np_worker-1 msk2 = (ipt2 == iproc) .and. (elist2 > 0) @@ -437,25 +438,25 @@ SUBROUTINE mesh_build () idest = p_address_worker(iproc) - smesg(1:2) = (/p_iam_glb, nsend/) + smesg(1:3) = (/p_iam_glb, nsend, blktag/) ! send(03) - CALL mpi_send (smesg(1:2), 2, MPI_INTEGER, & + CALL mpi_send (smesg(1:3), 3, MPI_INTEGER, & idest, mpi_tag_mesg, p_comm_glb, p_err) sbuf64(1:nsend) = pack(elist2, msk2) ! send(04) CALL mpi_send (sbuf64(1:nsend), nsend, MPI_INTEGER8, & - idest, mpi_tag_data, p_comm_glb, p_err) + idest, blktag, p_comm_glb, p_err) sbuf(1:nsend) = pack(xlist2, msk2) ! send(05) CALL mpi_send (sbuf(1:nsend), nsend, MPI_INTEGER, & - idest, mpi_tag_data, p_comm_glb, p_err) + idest, blktag, p_comm_glb, p_err) sbuf(1:nsend) = pack(ylist2, msk2) ! send(06) CALL mpi_send (sbuf(1:nsend), nsend, MPI_INTEGER, & - idest, mpi_tag_data, p_comm_glb, p_err) + idest, blktag, p_comm_glb, p_err) ENDIF ENDDO @@ -517,8 +518,8 @@ SUBROUTINE mesh_build () DO iworker = 0, p_np_worker-1 idest = p_address_worker(iworker) ! send(07) - rmesg(1:2) = (/p_iam_glb, 0/) - CALL mpi_send (rmesg(1:2), 2, MPI_INTEGER, & + smesg(1:3) = (/p_iam_glb, 0, 0/) + CALL mpi_send (smesg(1:3), 3, MPI_INTEGER, & idest, mpi_tag_mesg, p_comm_glb, p_err) ENDDO #endif @@ -532,27 +533,28 @@ SUBROUTINE mesh_build () work_done(:) = .false. DO WHILE (.not. all(work_done)) ! recv(03,07) - CALL mpi_recv (rmesg(1:2), 2, MPI_INTEGER, & + CALL mpi_recv (rmesg(1:3), 3, MPI_INTEGER, & MPI_ANY_SOURCE, mpi_tag_mesg, p_comm_glb, p_stat, p_err) - isrc = rmesg(1) - nrecv = rmesg(2) + isrc = rmesg(1) + nrecv = rmesg(2) + blktag = rmesg(3) IF (nrecv > 0) THEN allocate (elist_recv (nrecv)) ! recv(04) CALL mpi_recv (elist_recv, nrecv, MPI_INTEGER8, & - isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) + isrc, blktag, p_comm_glb, p_stat, p_err) allocate (xlist_recv (nrecv)) ! recv(05) CALL mpi_recv (xlist_recv, nrecv, MPI_INTEGER, & - isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) + isrc, blktag, p_comm_glb, p_stat, p_err) allocate (ylist_recv (nrecv)) ! recv(06) CALL mpi_recv (ylist_recv, nrecv, MPI_INTEGER, & - isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) + isrc, blktag, p_comm_glb, p_stat, p_err) allocate (msk(nrecv)) @@ -692,23 +694,19 @@ SUBROUTINE mesh_build () idest = gblock%pio (meshtmp(ie)%xblk, meshtmp(ie)%yblk) - ! send(09-1) - CALL mpi_send (p_iam_glb, 1, MPI_INTEGER, & - idest, mpi_tag_mesg, p_comm_glb, p_err) - ! send(09-2) - CALL mpi_send (meshtmp(ie)%indx, 1, MPI_INTEGER8, & - idest, mpi_tag_mesg, p_comm_glb, p_err) - ! send(09-3) - smesg(1:3) = (/meshtmp(ie)%xblk, meshtmp(ie)%yblk, meshtmp(ie)%npxl/) - CALL mpi_send (smesg(1:3), 3, MPI_INTEGER, & - idest, mpi_tag_mesg, p_comm_glb, p_err) + ! send(09) + elmtag = meshtmp(ie)%indx + smesg(1:5) = (/p_iam_glb, elmtag, meshtmp(ie)%xblk, meshtmp(ie)%yblk, meshtmp(ie)%npxl/) + CALL mpi_send (smesg(1:5), 5, MPI_INTEGER, idest, mpi_tag_mesg, p_comm_glb, p_err) + + CALL mpi_send (meshtmp(ie)%indx, 1, MPI_INTEGER8, idest, elmtag, p_comm_glb, p_err) ! send(10) CALL mpi_send (meshtmp(ie)%ilon, meshtmp(ie)%npxl, MPI_INTEGER, & - idest, mpi_tag_data, p_comm_glb, p_err) + idest, elmtag, p_comm_glb, p_err) ! send(11) CALL mpi_send (meshtmp(ie)%ilat, meshtmp(ie)%npxl, MPI_INTEGER, & - idest, mpi_tag_data, p_comm_glb, p_err) + idest, elmtag, p_comm_glb, p_err) ENDDO ENDIF @@ -724,36 +722,33 @@ SUBROUTINE mesh_build () blkcnt(:,:) = 0 DO ie = 1, numelm - ! recv(09-1) - CALL mpi_recv (isrc, 1, MPI_INTEGER, & - MPI_ANY_SOURCE, mpi_tag_mesg, p_comm_glb, p_stat, p_err) - ! recv(09-2) - CALL mpi_recv (elmid, 1, MPI_INTEGER8, & - isrc, mpi_tag_mesg, p_comm_glb, p_stat, p_err) - ! recv(09-3) - CALL mpi_recv (rmesg(1:3), 3, MPI_INTEGER, & - isrc, mpi_tag_mesg, p_comm_glb, p_stat, p_err) - - xblk = rmesg(1) - yblk = rmesg(2) + ! recv(09) + CALL mpi_recv (rmesg(1:5), 5, MPI_INTEGER, MPI_ANY_SOURCE, mpi_tag_mesg, p_comm_glb, p_stat, p_err) + isrc = rmesg(1) + elmtag = rmesg(2) + xblk = rmesg(3) + yblk = rmesg(4) + npxl = rmesg(5) + + CALL mpi_recv (elmid, 1, MPI_INTEGER8, isrc, elmtag, p_comm_glb, p_stat, p_err) blkcnt(xblk,yblk) = blkcnt(xblk,yblk) + 1 je = blkdsp(xblk,yblk) + blkcnt(xblk,yblk) mesh(je)%indx = elmid - mesh(je)%xblk = rmesg(1) - mesh(je)%yblk = rmesg(2) - mesh(je)%npxl = rmesg(3) + mesh(je)%xblk = xblk + mesh(je)%yblk = yblk + mesh(je)%npxl = npxl allocate (mesh(je)%ilon (mesh(je)%npxl)) allocate (mesh(je)%ilat (mesh(je)%npxl)) ! recv(10) CALL mpi_recv (mesh(je)%ilon, mesh(je)%npxl, MPI_INTEGER, & - isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) + isrc, elmtag, p_comm_glb, p_stat, p_err) ! recv(11) CALL mpi_recv (mesh(je)%ilat, mesh(je)%npxl, MPI_INTEGER, & - isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) + isrc, elmtag, p_comm_glb, p_stat, p_err) ENDDO @@ -790,7 +785,7 @@ SUBROUTINE mesh_build () IF (allocated (meshtmp)) THEN DO ie = 1, size(meshtmp) IF (allocated(meshtmp(ie)%ilon)) deallocate (meshtmp(ie)%ilon) - IF (allocated(meshtmp(ie)%ilon)) deallocate (meshtmp(ie)%ilat) + IF (allocated(meshtmp(ie)%ilat)) deallocate (meshtmp(ie)%ilat) ENDDO deallocate (meshtmp) ENDIF From 5b0abb0f0a16c5a414d798022ee7a7cf9b5a1413 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Sat, 25 Jan 2025 15:24:00 +0800 Subject: [PATCH 12/43] 1) Fix to be able run PFP/PC for non-soil-vegetated sites; 2) LAI read bus fix for DE-Bay site. -fix(CoLM.F90,MOD_Vars_TimeInvariants.F90,MOD_Vars_TimeVariables.F90,CoLMINI.F90): fix to run PFT/PC for wetland site and other land types for single point. -fix(MOD_LAIReadin.F90): fix for site LAI reading. --- main/CoLM.F90 | 7 +++++++ main/MOD_LAIReadin.F90 | 7 ++++++- main/MOD_Vars_TimeInvariants.F90 | 24 ++++++++++++++++-------- main/MOD_Vars_TimeVariables.F90 | 18 +++++++++++++++++- mkinidata/CoLMINI.F90 | 7 +++++++ mksrfdata/MOD_LandPFT.F90 | 8 ++++---- 6 files changed, 57 insertions(+), 14 deletions(-) diff --git a/main/CoLM.F90 b/main/CoLM.F90 index 77a1ecd4..6cd7c633 100644 --- a/main/CoLM.F90 +++ b/main/CoLM.F90 @@ -234,9 +234,16 @@ PROGRAM CoLM CALL pixelset_load_from_file (dir_landdata, 'landpatch', landpatch, numpatch, lc_year) #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) +#ifdef SinglePoint + IF (patchtypes(SITE_landtype) == 0) THEN + CALL pixelset_load_from_file (dir_landdata, 'landpft', landpft , numpft , lc_year) + CALL map_patch_to_pft + ENDIF +#else CALL pixelset_load_from_file (dir_landdata, 'landpft' , landpft , numpft , lc_year) CALL map_patch_to_pft #endif +#endif #ifdef URBAN_MODEL CALL pixelset_load_from_file (dir_landdata, 'landurban', landurban, numurban, lc_year) diff --git a/main/MOD_LAIReadin.F90 b/main/MOD_LAIReadin.F90 index 03fa1f72..7e394966 100644 --- a/main/MOD_LAIReadin.F90 +++ b/main/MOD_LAIReadin.F90 @@ -69,7 +69,12 @@ SUBROUTINE LAI_readin (year, time, dir_landdata) #ifdef SinglePoint #ifndef URBAN_MODEL - iyear = findloc_ud(SITE_LAI_year == min(DEF_LAI_END_YEAR, max(DEF_LAI_START_YEAR,year))) + IF (USE_SITE_LAI) THEN + iyear = findloc_ud(SITE_LAI_year == year) + ELSE + iyear = findloc_ud(SITE_LAI_year == min(DEF_LAI_END_YEAR, max(DEF_LAI_START_YEAR,year))) + ENDIF + IF (.not. DEF_LAI_MONTHLY) THEN itime = (time-1)/8 + 1 ENDIF diff --git a/main/MOD_Vars_TimeInvariants.F90 b/main/MOD_Vars_TimeInvariants.F90 index 2cce81a4..199d7bff 100644 --- a/main/MOD_Vars_TimeInvariants.F90 +++ b/main/MOD_Vars_TimeInvariants.F90 @@ -218,8 +218,8 @@ MODULE MOD_Vars_TimeInvariants integer, allocatable :: soiltext(:) ! USDA soil texture class - real(r8), allocatable :: fsatmax (:) ! maximum saturated area fraction [-] - real(r8), allocatable :: fsatdcf (:) ! decay factor in calucation of saturated area fraction [1/m] + real(r8), allocatable :: fsatmax (:) ! maximum saturated area fraction [-] + real(r8), allocatable :: fsatdcf (:) ! decay factor in calucation of saturated area fraction [1/m] real(r8), allocatable :: vic_b_infilt (:) real(r8), allocatable :: vic_Dsmax (:) @@ -248,7 +248,7 @@ MODULE MOD_Vars_TimeInvariants real(r8) :: zsno !roughness length for snow [m] real(r8) :: csoilc !drag coefficient for soil under canopy [-] real(r8) :: dewmx !maximum dew - ! 'wtfact' is updated to gridded 'fsatmax' data. + ! 'wtfact' is updated to gridded 'fsatmax' data. ! real(r8) :: wtfact !fraction of model area with high water table real(r8) :: capr !tuning factor to turn first layer T into surface T real(r8) :: cnfac !Crank Nicholson factor between 0 and 1 @@ -410,6 +410,7 @@ SUBROUTINE READ_TimeInvariants (lc_year, casename, dir_restart) #endif USE MOD_LandPatch USE MOD_Vars_Global + USE MOD_Const_LC, only: patchtypes IMPLICIT NONE @@ -519,16 +520,23 @@ SUBROUTINE READ_TimeInvariants (lc_year, casename, dir_restart) #else CALL ncio_read_vector (file_restart, 'sf_curve_patches' , num_azimuth , num_zenith_parameter, landpatch, sf_curve_patches) #endif - ENDIF + ENDIF #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) +#ifdef SinglePoint + IF (patchtypes(SITE_landtype) == 0) THEN + file_restart = trim(dir_restart) // '/const/' // trim(casename) //'_restart_pft_const' // '_lc' // trim(cyear) // '.nc' + CALL READ_PFTimeInvariants (file_restart) + ENDIF +#else file_restart = trim(dir_restart) // '/const/' // trim(casename) //'_restart_pft_const' // '_lc' // trim(cyear) // '.nc' CALL READ_PFTimeInvariants (file_restart) #endif +#endif #if (defined BGC) - file_restart = trim(dir_restart) // '/const/' // trim(casename) //'_restart_bgc_const' // '_lc' // trim(cyear) // '.nc' - CALL READ_BGCTimeInvariants (file_restart) + file_restart = trim(dir_restart) // '/const/' // trim(casename) //'_restart_bgc_const' // '_lc' // trim(cyear) // '.nc' + CALL READ_BGCTimeInvariants (file_restart) #endif #if (defined URBAN_MODEL) @@ -646,7 +654,7 @@ SUBROUTINE WRITE_TimeInvariants (lc_year, casename, dir_restart) CALL ncio_write_vector (file_restart, 'fsatmax', 'patch', landpatch, fsatmax) CALL ncio_write_vector (file_restart, 'fsatdcf', 'patch', landpatch, fsatdcf) - + CALL ncio_write_vector (file_restart, 'vic_b_infilt', 'patch', landpatch, vic_b_infilt) CALL ncio_write_vector (file_restart, 'vic_Dsmax' , 'patch', landpatch, vic_Dsmax ) CALL ncio_write_vector (file_restart, 'vic_Ds' , 'patch', landpatch, vic_Ds ) @@ -909,7 +917,7 @@ SUBROUTINE check_TimeInvariants () IF(DEF_USE_BEDROCK)THEN CALL check_vector_data ('dbedrock [m] ', dbedrock ) ! ENDIF - + CALL check_vector_data ('topoelv [m] ', topoelv ) ! CALL check_vector_data ('topostd [m] ', topostd ) ! CALL check_vector_data ('BVIC [-] ', BVIC ) ! diff --git a/main/MOD_Vars_TimeVariables.F90 b/main/MOD_Vars_TimeVariables.F90 index 8e3be03e..6365f234 100644 --- a/main/MOD_Vars_TimeVariables.F90 +++ b/main/MOD_Vars_TimeVariables.F90 @@ -900,11 +900,12 @@ SUBROUTINE WRITE_TimeVariables (idate, lc_year, site, dir_restart) USE MOD_SPMD_Task USE MOD_Namelist, only : DEF_REST_CompressLevel, DEF_USE_PLANTHYDRAULICS, DEF_USE_OZONESTRESS, & - DEF_USE_IRRIGATION, DEF_USE_Dynamic_Lake + DEF_USE_IRRIGATION, DEF_USE_Dynamic_Lake, SITE_landtype USE MOD_LandPatch USE MOD_NetCDFVector USE MOD_Vars_Global USE MOD_Vars_TimeInvariants, only : dz_lake + USE MOD_Const_LC, only: patchtypes IMPLICIT NONE integer, intent(in) :: idate(3) @@ -1058,9 +1059,16 @@ SUBROUTINE WRITE_TimeVariables (idate, lc_year, site, dir_restart) ENDIF #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) +#ifdef SinglePoint + IF (patchtypes(SITE_landtype) == 0) THEN + file_restart = trim(dir_restart)// '/'//trim(cdate)//'/' // trim(site) //'_restart_pft_'//trim(cdate)//'_lc'//trim(cyear)//'.nc' + CALL WRITE_PFTimeVariables (file_restart) + ENDIF +#else file_restart = trim(dir_restart)// '/'//trim(cdate)//'/' // trim(site) //'_restart_pft_'//trim(cdate)//'_lc'//trim(cyear)//'.nc' CALL WRITE_PFTimeVariables (file_restart) #endif +#endif #if (defined BGC) file_restart = trim(dir_restart)// '/'//trim(cdate)//'/' // trim(site) //'_restart_bgc_'//trim(cdate)//'_lc'//trim(cyear)//'.nc' @@ -1094,6 +1102,7 @@ SUBROUTINE READ_TimeVariables (idate, lc_year, site, dir_restart) USE MOD_LandPatch USE MOD_Vars_Global USE MOD_Vars_TimeInvariants, only : dz_lake + USE MOD_Const_LC, only: patchtypes IMPLICIT NONE @@ -1229,9 +1238,16 @@ SUBROUTINE READ_TimeVariables (idate, lc_year, site, dir_restart) ENDIF #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) +#ifdef SinglePoint + IF (patchtypes(SITE_landtype) == 0) THEN + file_restart = trim(dir_restart)// '/'//trim(cdate)//'/' // trim(site) //'_restart_pft_'//trim(cdate)//'_lc'//trim(cyear)//'.nc' + CALL READ_PFTimeVariables (file_restart) + ENDIF +#else file_restart = trim(dir_restart)// '/'//trim(cdate)//'/' // trim(site) //'_restart_pft_'//trim(cdate)//'_lc'//trim(cyear)//'.nc' CALL READ_PFTimeVariables (file_restart) #endif +#endif #if (defined BGC) file_restart = trim(dir_restart)// '/'//trim(cdate)//'/' // trim(site) //'_restart_bgc_'//trim(cdate)//'_lc'//trim(cyear)//'.nc' diff --git a/mkinidata/CoLMINI.F90 b/mkinidata/CoLMINI.F90 index 39488288..ef0d7140 100644 --- a/mkinidata/CoLMINI.F90 +++ b/mkinidata/CoLMINI.F90 @@ -126,9 +126,16 @@ PROGRAM CoLMINI CALL pixelset_load_from_file (dir_landdata, 'landpatch', landpatch, numpatch, lc_year) #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) +#ifdef SinglePoint + IF (patchtypes(SITE_landtype) == 0) THEN + CALL pixelset_load_from_file (dir_landdata, 'landpft', landpft, numpft, lc_year) + CALL map_patch_to_pft + ENDIF +#else CALL pixelset_load_from_file (dir_landdata, 'landpft', landpft, numpft, lc_year) CALL map_patch_to_pft #endif +#endif #ifdef URBAN_MODEL CALL pixelset_load_from_file (dir_landdata, 'landurban', landurban, numurban, lc_year) diff --git a/mksrfdata/MOD_LandPFT.F90 b/mksrfdata/MOD_LandPFT.F90 index bc267c19..740bd84f 100644 --- a/mksrfdata/MOD_LandPFT.F90 +++ b/mksrfdata/MOD_LandPFT.F90 @@ -131,8 +131,8 @@ SUBROUTINE landpft_build (lc_year) patch_pft_s (ipft) = ipft patch_pft_e (ipft) = ipft ENDDO - - landpft%pctshared = landpatch%pctshared + + landpft%pctshared = landpatch%pctshared #endif ENDIF ELSE @@ -151,7 +151,7 @@ SUBROUTINE landpft_build (lc_year) #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - + landpft%has_shared = .true. IF (p_is_io) THEN @@ -274,7 +274,7 @@ SUBROUTINE landpft_build (lc_year) landpft%ipxstt(npft) = landpatch%ipxstt(ipatch) landpft%ipxend(npft) = landpatch%ipxend(ipatch) landpft%settyp(npft) = cropclass(ipatch) - + landpft%pctshared(npft) = landpatch%pctshared(ipatch) pft2patch(npft) = npatch From 8707c51e4f01d221f788147baf5f2e0e184d0c8a Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Sat, 25 Jan 2025 15:58:40 +0800 Subject: [PATCH 13/43] Code format adjust. --- main/MOD_Vars_TimeInvariants.F90 | 4 ++-- main/MOD_Vars_TimeVariables.F90 | 40 ++++++++++++++++---------------- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/main/MOD_Vars_TimeInvariants.F90 b/main/MOD_Vars_TimeInvariants.F90 index 199d7bff..9164d8c9 100644 --- a/main/MOD_Vars_TimeInvariants.F90 +++ b/main/MOD_Vars_TimeInvariants.F90 @@ -535,8 +535,8 @@ SUBROUTINE READ_TimeInvariants (lc_year, casename, dir_restart) #endif #if (defined BGC) - file_restart = trim(dir_restart) // '/const/' // trim(casename) //'_restart_bgc_const' // '_lc' // trim(cyear) // '.nc' - CALL READ_BGCTimeInvariants (file_restart) + file_restart = trim(dir_restart) // '/const/' // trim(casename) //'_restart_bgc_const' // '_lc' // trim(cyear) // '.nc' + CALL READ_BGCTimeInvariants (file_restart) #endif #if (defined URBAN_MODEL) diff --git a/main/MOD_Vars_TimeVariables.F90 b/main/MOD_Vars_TimeVariables.F90 index 6365f234..3828d2bf 100644 --- a/main/MOD_Vars_TimeVariables.F90 +++ b/main/MOD_Vars_TimeVariables.F90 @@ -1035,27 +1035,27 @@ SUBROUTINE WRITE_TimeVariables (idate, lc_year, site, dir_restart) CALL ncio_write_vector (file_restart, 'fq ', 'patch', landpatch, fq , compress) ! integral of profile FUNCTION for moisture IF (DEF_USE_IRRIGATION) THEN - CALL Ncio_write_vector (file_restart, 'irrig_rate ' , 'patch',landpatch,irrig_rate , compress) - CALL Ncio_write_vector (file_restart, 'deficit_irrig ' , 'patch',landpatch,deficit_irrig , compress) - CALL Ncio_write_vector (file_restart, 'sum_irrig ' , 'patch',landpatch,sum_irrig , compress) - CALL Ncio_write_vector (file_restart, 'sum_irrig_count ' , 'patch',landpatch,sum_irrig_count , compress) - CALL Ncio_write_vector (file_restart, 'n_irrig_steps_left ' , 'patch',landpatch,n_irrig_steps_left , compress) - CALL Ncio_write_vector (file_restart, 'tairday ' , 'patch',landpatch,tairday , compress) - CALL Ncio_write_vector (file_restart, 'usday ' , 'patch',landpatch,usday , compress) - CALL Ncio_write_vector (file_restart, 'vsday ' , 'patch',landpatch,vsday , compress) - CALL Ncio_write_vector (file_restart, 'pairday ' , 'patch',landpatch,pairday , compress) - CALL Ncio_write_vector (file_restart, 'rnetday ' , 'patch',landpatch,rnetday , compress) - CALL Ncio_write_vector (file_restart, 'fgrndday ' , 'patch',landpatch,fgrndday , compress) - CALL Ncio_write_vector (file_restart, 'potential_evapotranspiration', 'patch',landpatch, & + CALL ncio_write_vector (file_restart, 'irrig_rate ' , 'patch',landpatch,irrig_rate , compress) + CALL ncio_write_vector (file_restart, 'deficit_irrig ' , 'patch',landpatch,deficit_irrig , compress) + CALL ncio_write_vector (file_restart, 'sum_irrig ' , 'patch',landpatch,sum_irrig , compress) + CALL ncio_write_vector (file_restart, 'sum_irrig_count ' , 'patch',landpatch,sum_irrig_count , compress) + CALL ncio_write_vector (file_restart, 'n_irrig_steps_left ' , 'patch',landpatch,n_irrig_steps_left , compress) + CALL ncio_write_vector (file_restart, 'tairday ' , 'patch',landpatch,tairday , compress) + CALL ncio_write_vector (file_restart, 'usday ' , 'patch',landpatch,usday , compress) + CALL ncio_write_vector (file_restart, 'vsday ' , 'patch',landpatch,vsday , compress) + CALL ncio_write_vector (file_restart, 'pairday ' , 'patch',landpatch,pairday , compress) + CALL ncio_write_vector (file_restart, 'rnetday ' , 'patch',landpatch,rnetday , compress) + CALL ncio_write_vector (file_restart, 'fgrndday ' , 'patch',landpatch,fgrndday , compress) + CALL ncio_write_vector (file_restart, 'potential_evapotranspiration', 'patch',landpatch, & potential_evapotranspiration, compress) - CALL Ncio_write_vector (file_restart, 'irrig_method_corn ' , 'patch',landpatch,irrig_method_corn , compress) - CALL Ncio_write_vector (file_restart, 'irrig_method_swheat ' , 'patch',landpatch,irrig_method_swheat , compress) - CALL Ncio_write_vector (file_restart, 'irrig_method_wwheat ' , 'patch',landpatch,irrig_method_wwheat , compress) - CALL Ncio_write_vector (file_restart, 'irrig_method_soybean ' , 'patch',landpatch,irrig_method_soybean , compress) - CALL Ncio_write_vector (file_restart, 'irrig_method_cotton ' , 'patch',landpatch,irrig_method_cotton , compress) - CALL Ncio_write_vector (file_restart, 'irrig_method_rice1 ' , 'patch',landpatch,irrig_method_rice1 , compress) - CALL Ncio_write_vector (file_restart, 'irrig_method_rice2 ' , 'patch',landpatch,irrig_method_rice2 , compress) - CALL Ncio_write_vector (file_restart, 'irrig_method_sugarcane' , 'patch',landpatch,irrig_method_sugarcane, compress) + CALL ncio_write_vector (file_restart, 'irrig_method_corn ' , 'patch',landpatch,irrig_method_corn , compress) + CALL ncio_write_vector (file_restart, 'irrig_method_swheat ' , 'patch',landpatch,irrig_method_swheat , compress) + CALL ncio_write_vector (file_restart, 'irrig_method_wwheat ' , 'patch',landpatch,irrig_method_wwheat , compress) + CALL ncio_write_vector (file_restart, 'irrig_method_soybean ' , 'patch',landpatch,irrig_method_soybean , compress) + CALL ncio_write_vector (file_restart, 'irrig_method_cotton ' , 'patch',landpatch,irrig_method_cotton , compress) + CALL ncio_write_vector (file_restart, 'irrig_method_rice1 ' , 'patch',landpatch,irrig_method_rice1 , compress) + CALL ncio_write_vector (file_restart, 'irrig_method_rice2 ' , 'patch',landpatch,irrig_method_rice2 , compress) + CALL ncio_write_vector (file_restart, 'irrig_method_sugarcane' , 'patch',landpatch,irrig_method_sugarcane, compress) ENDIF #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) From f5a881df8af6db9c50e1dd7e587de08c55083443 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 28 Jan 2025 23:52:25 +0800 Subject: [PATCH 14/43] Optimize for Single Point run. -opt(MOD_SingleSrfdata.F90): read the land cover type for single point run. --- mksrfdata/MOD_SingleSrfdata.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mksrfdata/MOD_SingleSrfdata.F90 b/mksrfdata/MOD_SingleSrfdata.F90 index a3a81c4d..ccfc37d8 100644 --- a/mksrfdata/MOD_SingleSrfdata.F90 +++ b/mksrfdata/MOD_SingleSrfdata.F90 @@ -167,7 +167,7 @@ SUBROUTINE read_surface_data_single (fsrfdata, mksrfdata) CALL normalize_longitude (SITE_lon_location) - IF (USE_SITE_landtype) THEN + IF (USE_SITE_landtype .or. .not.mksrfdata) THEN IF (trim(fsrfdata) /= 'null') THEN #ifdef LULC_USGS CALL ncio_read_serial (fsrfdata, 'USGS_classification', SITE_landtype) From 670ad40abc945dafc3d7501499c18d0802cf1f10 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 4 Feb 2025 17:52:00 +0800 Subject: [PATCH 15/43] Code tidy for Urban and related files, including the format of annotation and many type errors. --- main/CoLMMAIN.F90 | 2 +- main/MOD_GroundTemperature.F90 | 2 +- main/MOD_PhaseChange.F90 | 4 +- main/MOD_SoilSnowHydrology.F90 | 2 +- main/MOD_SoilSurfaceResistance.F90 | 2 +- main/MOD_Thermal.F90 | 2 +- main/MOD_Vars_TimeInvariants.F90 | 8 +-- main/URBAN/CoLMMAIN_Urban.F90 | 58 +++++++-------- main/URBAN/MOD_Urban_Albedo.F90 | 10 +-- main/URBAN/MOD_Urban_BEM.F90 | 18 ++--- main/URBAN/MOD_Urban_Const_LCZ.F90 | 11 +-- main/URBAN/MOD_Urban_Flux.F90 | 68 +++++++++--------- main/URBAN/MOD_Urban_GroundFlux.F90 | 8 +-- main/URBAN/MOD_Urban_Hydrology.F90 | 8 +-- .../URBAN/MOD_Urban_ImperviousTemperature.F90 | 28 ++++---- main/URBAN/MOD_Urban_LAIReadin.F90 | 2 +- main/URBAN/MOD_Urban_LUCY.F90 | 4 +- main/URBAN/MOD_Urban_Longwave.F90 | 32 ++++----- main/URBAN/MOD_Urban_NetSolar.F90 | 2 +- main/URBAN/MOD_Urban_PerviousTemperature.F90 | 34 ++++----- main/URBAN/MOD_Urban_RoofFlux.F90 | 14 ++-- main/URBAN/MOD_Urban_RoofTemperature.F90 | 31 ++++---- main/URBAN/MOD_Urban_Shortwave.F90 | 48 ++++++------- main/URBAN/MOD_Urban_Thermal.F90 | 70 +++++++++---------- main/URBAN/MOD_Urban_Vars_TimeVariables.F90 | 12 ++-- main/URBAN/MOD_Urban_WallTemperature.F90 | 28 ++++---- 26 files changed, 260 insertions(+), 248 deletions(-) diff --git a/main/CoLMMAIN.F90 b/main/CoLMMAIN.F90 index b0cedb8d..9016b121 100644 --- a/main/CoLMMAIN.F90 +++ b/main/CoLMMAIN.F90 @@ -215,7 +215,7 @@ SUBROUTINE CoLMMAIN ( & wf_sand (nl_soil) ,&! gravimetric fraction of sand porsl (nl_soil) ,&! fraction of soil that is voids [-] psi0 (nl_soil) ,&! minimum soil suction [mm] - bsw (nl_soil) ,&! clapp and hornbereger "b" parameter [-] + bsw (nl_soil) ,&! clapp and hornberger "b" parameter [-] theta_r (1:nl_soil) ,&! residual water content (cm3/cm3) fsatmax ,&! maximum saturated area fraction [-] fsatdcf ,&! decay factor in calucation of saturated area fraction [1/m] diff --git a/main/MOD_GroundTemperature.F90 b/main/MOD_GroundTemperature.F90 index be4ae8f4..074f7b80 100644 --- a/main/MOD_GroundTemperature.F90 +++ b/main/MOD_GroundTemperature.F90 @@ -93,7 +93,7 @@ SUBROUTINE GroundTemperature (patchtype,is_dry_lake,lb,nl_soil,deltim,& real(r8), intent(in) :: porsl(1:nl_soil) !soil porosity [-] real(r8), intent(in) :: psi0 (1:nl_soil) !soil water suction, negative potential [mm] #ifdef Campbell_SOIL_MODEL - real(r8), intent(in) :: bsw(1:nl_soil) !clapp and hornbereger "b" parameter [-] + real(r8), intent(in) :: bsw(1:nl_soil) !clapp and hornberger "b" parameter [-] #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL real(r8), intent(in) :: theta_r (1:nl_soil), & ! diff --git a/main/MOD_PhaseChange.F90 b/main/MOD_PhaseChange.F90 index 55bd80a7..2c6b59cf 100644 --- a/main/MOD_PhaseChange.F90 +++ b/main/MOD_PhaseChange.F90 @@ -77,7 +77,7 @@ SUBROUTINE meltf (patchtype,is_dry_lake,lb,nl_soil,deltim, & real(r8), intent(in) :: porsl(1:nl_soil) !soil porosity [-] real(r8), intent(in) :: psi0 (1:nl_soil) !soil water suction, negative potential [mm] #ifdef Campbell_SOIL_MODEL - real(r8), intent(in) :: bsw(1:nl_soil) !clapp and hornbereger "b" parameter [-] + real(r8), intent(in) :: bsw(1:nl_soil) !clapp and hornberger "b" parameter [-] #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL real(r8), intent(in) :: theta_r (1:nl_soil), & @@ -378,7 +378,7 @@ SUBROUTINE meltf_snicar (patchtype,is_dry_lake,lb,nl_soil,deltim, & real(r8), intent(in) :: porsl(1:nl_soil) !soil porosity [-] real(r8), intent(in) :: psi0 (1:nl_soil) !soil water suction, negative potential [mm] #ifdef Campbell_SOIL_MODEL - real(r8), intent(in) :: bsw(1:nl_soil) !clapp and hornbereger "b" parameter [-] + real(r8), intent(in) :: bsw(1:nl_soil) !clapp and hornberger "b" parameter [-] #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL real(r8), intent(in) :: theta_r (1:nl_soil), & diff --git a/main/MOD_SoilSnowHydrology.F90 b/main/MOD_SoilSnowHydrology.F90 index c511da8d..2138e6bc 100644 --- a/main/MOD_SoilSnowHydrology.F90 +++ b/main/MOD_SoilSnowHydrology.F90 @@ -556,7 +556,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& z_soisno (lb:nl_soil) , &! layer depth (m) dz_soisno(lb:nl_soil) , &! layer thickness (m) zi_soisno(lb-1:nl_soil) , &! interface level below a "z" level (m) - bsw (1:nl_soil), &! clapp and hornbereger "b" parameter [-] + bsw (1:nl_soil), &! clapp and hornberger "b" parameter [-] theta_r (1:nl_soil), & ! residual moisture content [-] fsatmax , & ! maximum saturated area fraction [-] fsatdcf , & ! decay factor in calucation of saturated area fraction [1/m] diff --git a/main/MOD_SoilSurfaceResistance.F90 b/main/MOD_SoilSurfaceResistance.F90 index 117dd1b2..43e8a239 100644 --- a/main/MOD_SoilSurfaceResistance.F90 +++ b/main/MOD_SoilSurfaceResistance.F90 @@ -76,7 +76,7 @@ SUBROUTINE SoilSurfaceResistance (nl_soil,forc_rhoair,hksati,porsl,psi0, & porsl (1:nl_soil), &! soil porosity [-] psi0 (1:nl_soil), &! saturated soil suction [mm] (NEGATIVE) #ifdef Campbell_SOIL_MODEL - bsw (1:nl_soil), &! clapp and hornbereger "b" parameter [-] + bsw (1:nl_soil), &! clapp and hornberger "b" parameter [-] #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL theta_r (1:nl_soil), &! residual moisture content [-] diff --git a/main/MOD_Thermal.F90 b/main/MOD_Thermal.F90 index c35d0744..17807968 100644 --- a/main/MOD_Thermal.F90 +++ b/main/MOD_Thermal.F90 @@ -164,7 +164,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , porsl (1:nl_soil), &! soil porosity [-] psi0 (1:nl_soil), &! soil water suction, negative potential [mm] #ifdef Campbell_SOIL_MODEL - bsw(1:nl_soil), &! clapp and hornbereger "b" parameter [-] + bsw(1:nl_soil), &! clapp and hornberger "b" parameter [-] #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL theta_r (1:nl_soil), &! residual moisture content [-] diff --git a/main/MOD_Vars_TimeInvariants.F90 b/main/MOD_Vars_TimeInvariants.F90 index 9164d8c9..6031a765 100644 --- a/main/MOD_Vars_TimeInvariants.F90 +++ b/main/MOD_Vars_TimeInvariants.F90 @@ -205,7 +205,7 @@ MODULE MOD_Vars_TimeInvariants real(r8), allocatable :: wfc (:,:) !field capacity real(r8), allocatable :: porsl (:,:) !fraction of soil that is voids [-] real(r8), allocatable :: psi0 (:,:) !minimum soil suction [mm] (NOTE: "-" valued) - real(r8), allocatable :: bsw (:,:) !clapp and hornbereger "b" parameter [-] + real(r8), allocatable :: bsw (:,:) !clapp and hornberger "b" parameter [-] real(r8), allocatable :: theta_r (:,:) !residual moisture content [-] real(r8), allocatable :: BVIC (:) !b parameter in Fraction of saturated soil in a grid calculated by VIC #ifdef vanGenuchten_Mualem_SOIL_MODEL @@ -450,7 +450,7 @@ SUBROUTINE READ_TimeInvariants (lc_year, casename, dir_restart) CALL ncio_read_vector (file_restart, 'wfc ', nl_soil, landpatch, wfc ) ! field capacity CALL ncio_read_vector (file_restart, 'porsl ' , nl_soil, landpatch, porsl ) ! fraction of soil that is voids [-] CALL ncio_read_vector (file_restart, 'psi0 ' , nl_soil, landpatch, psi0 ) ! minimum soil suction [mm] (NOTE: "-" valued) - CALL ncio_read_vector (file_restart, 'bsw ' , nl_soil, landpatch, bsw ) ! clapp and hornbereger "b" parameter [-] + CALL ncio_read_vector (file_restart, 'bsw ' , nl_soil, landpatch, bsw ) ! clapp and hornberger "b" parameter [-] CALL ncio_read_vector (file_restart, 'theta_r ' , nl_soil, landpatch, theta_r ) ! residual moisture content [-] CALL ncio_read_vector (file_restart, 'BVIC ' , landpatch, BVIC ) ! b parameter in Fraction of saturated soil in a grid calculated by VIC #ifdef vanGenuchten_Mualem_SOIL_MODEL @@ -638,7 +638,7 @@ SUBROUTINE WRITE_TimeInvariants (lc_year, casename, dir_restart) CALL ncio_write_vector (file_restart, 'wfc ', 'soil', nl_soil, 'patch', landpatch, wfc , compress) ! field capacity CALL ncio_write_vector (file_restart, 'porsl ', 'soil', nl_soil, 'patch', landpatch, porsl , compress) ! fraction of soil that is voids [-] CALL ncio_write_vector (file_restart, 'psi0 ', 'soil', nl_soil, 'patch', landpatch, psi0 , compress) ! minimum soil suction [mm] (NOTE: "-" valued) - CALL ncio_write_vector (file_restart, 'bsw ', 'soil', nl_soil, 'patch', landpatch, bsw , compress) ! clapp and hornbereger "b" parameter [-] + CALL ncio_write_vector (file_restart, 'bsw ', 'soil', nl_soil, 'patch', landpatch, bsw , compress) ! clapp and hornberger "b" parameter [-] CALL ncio_write_vector (file_restart, 'theta_r ' , 'soil', nl_soil, 'patch', landpatch, theta_r , compress) ! residual moisture content [-] CALL ncio_write_vector (file_restart, 'BVIC ' , 'patch', landpatch, BVIC, compress) ! b parameter in Fraction of saturated soil in a grid calculated by VIC @@ -891,7 +891,7 @@ SUBROUTINE check_TimeInvariants () CALL check_vector_data ('wfc [m3/m3] ', wfc ) ! field capacity CALL check_vector_data ('porsl [m3/m3] ', porsl ) ! fraction of soil that is voids [-] CALL check_vector_data ('psi0 [mm] ', psi0 ) ! minimum soil suction [mm] (NOTE: "-" valued) - CALL check_vector_data ('bsw [-] ', bsw ) ! clapp and hornbereger "b" parameter [-] + CALL check_vector_data ('bsw [-] ', bsw ) ! clapp and hornberger "b" parameter [-] #ifdef vanGenuchten_Mualem_SOIL_MODEL CALL check_vector_data ('theta_r [m3/m3] ', theta_r ) ! residual moisture content [-] CALL check_vector_data ('alpha_vgm [-] ', alpha_vgm ) ! a parameter corresponding approximately to the inverse of the air-entry value diff --git a/main/URBAN/CoLMMAIN_Urban.F90 b/main/URBAN/CoLMMAIN_Urban.F90 index 2fdceecf..34e60726 100644 --- a/main/URBAN/CoLMMAIN_Urban.F90 +++ b/main/URBAN/CoLMMAIN_Urban.F90 @@ -21,23 +21,24 @@ ! ! !DESCRIPTION: ! -! Unlike the traditional urban canyon model, the CoLM urban model is +! Unlike the traditional urban canyon models, the CoLM urban model is ! based on the assumption of a three-dimensional urban building ! community, including trees and water bodies. We have developed a new ! approach for shortwave and longwave radiation transfer, as well as ! turbulent exchange within the three-dimensional urban buildings. In ! the process of calculating radiation transfer and turbulent exchange, -! simulation of vegetation and water bodies has been added. The CoLM -! urban model uses comprehensive high-resolution data on urban cover, -! geometric structure, vegetation, water bodies, etc., and has -! developed a complete simulation of anthropogenic heat processes, -! including building energy consumption, traffic heat, and metabolic -! heat. +! we have integrated simulations of vegetation and water bodies. +! +! The CoLM urban model utilizes comprehensive high-resolution data on +! urban cover, geometric structure, vegetation, water bodies, etc. +! Furthermore, it has developed a complete simulation of anthropogenic +! heat processes, including building energy consumption, traffic heat, +! and metabolic heat. ! ! Created by Hua Yuan, 09/2021 ! ! -! !REVISIONS: +! !REVISIONS (major): ! ! 03/2022, Hua Yuan: complete the model with full coupling, and make ! it possible to run multiple scenario assumptions through @@ -51,7 +52,8 @@ ! 05/2023, Wenzong Dong, Hua Yuan, Shupeng Zhang: porting urban making ! surface data codes to MPI parallel version. ! -! 05/2023, Hua Yuan: Rename files and modules to current version. +! 05/2023, Hua Yuan: Rename files and modules align with current +! version. ! !----------------------------------------------------------------------- @@ -163,7 +165,7 @@ SUBROUTINE CoLMMAIN_Urban ( & solniln ,srvdln ,srviln ,srndln ,& srniln ,qcharge ,xerr ,zerr ,& - ! TUNABLE modle constants + ! TUNABLE model constants zlnd ,zsno ,csoilc ,dewmx ,& capr ,cnfac ,ssi ,& wimp ,pondmx ,smpmax ,smpmin ,& @@ -208,7 +210,7 @@ SUBROUTINE CoLMMAIN_Urban ( & real(r8),intent(in) :: & deltim ,&! seconds in a time step [second] - patchlonr ,&! logitude in radians + patchlonr ,&! longitude in radians patchlatr ! latitude in radians real(r8),intent(inout) :: & @@ -254,7 +256,7 @@ SUBROUTINE CoLMMAIN_Urban ( & wf_sand (nl_soil) ,&! gravimetric fraction of sand porsl (nl_soil) ,&! fraction of soil that is voids [-] psi0 (nl_soil) ,&! minimum soil suction [mm] - bsw (nl_soil) ,&! clapp and hornbereger "b" parameter [-] + bsw (nl_soil) ,&! clapp and hornberger "b" parameter [-] theta_r (nl_soil) ,&! residual water content (cm3/cm3) fsatmax ,&! maximum saturated area fraction [-] fsatdcf ,&! decay factor in calucation of saturated area fraction [1/m] @@ -312,7 +314,7 @@ SUBROUTINE CoLMMAIN_Urban ( & capr ,&! tuning factor to turn first layer T into surface T cnfac ,&! Crank Nicholson factor between 0 and 1 ssi ,&! irreducible water saturation of snow - wimp ,&! water impremeable IF porosity less than wimp + wimp ,&! water impermeable IF porosity less than wimp pondmx ,&! ponding depth (mm) smpmax ,&! wilting point potential in mm smpmin ,&! restriction for min of soil poten. (mm) @@ -345,8 +347,8 @@ SUBROUTINE CoLMMAIN_Urban ( & forc_rhoair ! density air [kg/m3] #if(defined CaMa_Flood) - real(r8), intent(in) :: fldfrc !inundation fraction--> allow re-evaporation and infiltrition![0-1] - real(r8), intent(inout) :: flddepth !inundation depth--> allow re-evaporation and infiltrition![mm] + real(r8), intent(in) :: fldfrc !inundation fraction--> allow re-evaporation and infiltration![0-1] + real(r8), intent(inout) :: flddepth !inundation depth--> allow re-evaporation and infiltration![mm] real(r8), intent(out) :: fevpg_fld !effective evaporation from inundation [mm/s] real(r8), intent(out) :: qinfl_fld !effective re-infiltration from inundation [mm/s] #endif @@ -464,7 +466,7 @@ SUBROUTINE CoLMMAIN_Urban ( & tafu ,&! temperature of outer building [K] Fhac ,&! sensible flux from heat or cool AC [W/m2] Fwst ,&! waste heat flux from heat or cool AC [W/m2] - Fach ,&! flux from inner and outter air exchange [W/m2] + Fach ,&! flux from inner and outer air exchange [W/m2] Fahe ,&! flux from metabolism and vehicle [W/m2] Fhah ,&! sensible heat flux from heating [W/m2] vehc ,&! flux from vehicle [W/m2] @@ -498,7 +500,7 @@ SUBROUTINE CoLMMAIN_Urban ( & fsena ,&! sensible heat from canopy height to atmosphere [W/m2] fevpa ,&! evapotranspiration from canopy height to atmosphere [mm/s] lfevpa ,&! latent heat flux from canopy height to atmosphere [W/2] - fsenl ,&! ensible heat from leaves [W/m2] + fsenl ,&! sensible heat from leaves [W/m2] fevpl ,&! evaporation+transpiration from leaves [mm/s] etr ,&! transpiration rate [mm/s] fseng ,&! sensible heat flux from ground [W/m2] @@ -506,7 +508,7 @@ SUBROUTINE CoLMMAIN_Urban ( & olrg ,&! outgoing long-wave radiation from ground+canopy fgrnd ,&! ground heat flux [W/m2] xerr ,&! water balance error at current time-step [mm/s] - zerr ,&! energy balnce errore at current time-step [W/m2] + zerr ,&! energy balance error at current time-step [W/m2] tref ,&! 2 m height air temperature [K] qref ,&! 2 m height air specific humidity @@ -514,7 +516,7 @@ SUBROUTINE CoLMMAIN_Urban ( & rsur ,&! surface runoff (mm h2o/s) rnof ,&! total runoff (mm h2o/s) qintr ,&! interception (mm h2o/s) - qinfl ,&! inflitration (mm h2o/s) + qinfl ,&! infiltration (mm h2o/s) qdrip ,&! throughfall (mm h2o/s) qcharge ,&! groundwater recharge [mm/s] @@ -576,8 +578,8 @@ SUBROUTINE CoLMMAIN_Urban ( & real(r8) :: & calday ,&! Julian cal day (1.xx to 365.xx) endwb ,&! water mass at the end of time step - errore ,&! energy balnce errore (Wm-2) - errorw ,&! water balnce errore (mm) + errore ,&! energy balance error (Wm-2) + errorw ,&! water balance error (mm) fioldr (maxsnl+1:nl_roof), &! fraction of ice relative to the total water fioldi (maxsnl+1:nl_soil), &! fraction of ice relative to the total water fioldp (maxsnl+1:nl_soil), &! fraction of ice relative to the total water @@ -676,10 +678,10 @@ SUBROUTINE CoLMMAIN_Urban ( & snli ,&! number of snow layers snlp ,&! number of snow layers snll ,&! number of snow layers - imeltr (maxsnl+1:nl_roof), &! flag for: melting=1, freezing=2, Nothing happended=0 - imelti (maxsnl+1:nl_soil), &! flag for: melting=1, freezing=2, Nothing happended=0 - imeltp (maxsnl+1:nl_soil), &! flag for: melting=1, freezing=2, Nothing happended=0 - imeltl (maxsnl+1:nl_soil), &! flag for: melting=1, freezing=2, Nothing happended=0 + imeltr (maxsnl+1:nl_roof), &! flag for: melting=1, freezing=2, Nothing happened=0 + imelti (maxsnl+1:nl_soil), &! flag for: melting=1, freezing=2, Nothing happened=0 + imeltp (maxsnl+1:nl_soil), &! flag for: melting=1, freezing=2, Nothing happened=0 + imeltl (maxsnl+1:nl_soil), &! flag for: melting=1, freezing=2, Nothing happened=0 lbr ,&! lower bound of arrays lbi ,&! lower bound of arrays lbp ,&! lower bound of arrays @@ -899,7 +901,7 @@ SUBROUTINE CoLMMAIN_Urban ( & ENDIF !---------------------------------------------------------------------- -! [3] Initilize new snow nodes for snowfall / sleet +! [3] Initialize new snow nodes for snowfall / sleet !---------------------------------------------------------------------- lbr = snlr + 1 !lower bound of array @@ -1249,7 +1251,7 @@ SUBROUTINE CoLMMAIN_Urban ( & !====================================================================== ! Preparation for the next time step -! 1) time-varying parameters for vegatation +! 1) time-varying parameters for vegetation ! 2) fraction of snow cover ! 3) solar zenith angle and ! 4) albedos @@ -1285,7 +1287,7 @@ SUBROUTINE CoLMMAIN_Urban ( & ! albedos ! we supposed call it every time-step, because - ! other vegeation related parameters are needed to create + ! other vegetation related parameters are needed to create CALL alburban (ipatch,froof,fgper,flake,hlr,hroof,& alb_roof,alb_wall,alb_gimp,alb_gper,& diff --git a/main/URBAN/MOD_Urban_Albedo.F90 b/main/URBAN/MOD_Urban_Albedo.F90 index 9f33f1a1..988a78ff 100644 --- a/main/URBAN/MOD_Urban_Albedo.F90 +++ b/main/URBAN/MOD_Urban_Albedo.F90 @@ -6,7 +6,7 @@ MODULE MOD_Urban_Albedo ! ! Calculate the total urban albedo. Prepare albedo values over water, ! roof, ground with snow cover. Then CALL 3D urban radiation transfer -! model. Finally calculate the total albedo weightd by the urban and +! model. Finally calculate the total albedo weighted by the urban and ! water fractional cover. ! ! Created by Hua Yuan, 09/2021 @@ -15,9 +15,11 @@ MODULE MOD_Urban_Albedo ! !REVISIONS: ! ! 07/2023, Hua Yuan: Fix low zenith angle problem for urban radiation -! calculation and urban display height problem when considering -! vegetations. modify limitation for conzen value (0.001->0.01) -! for urban. +! calculation and urban display height problem when +! considering vegetations. modify limitation for conzen value +! (0.001->0.01) for urban. +! +! 05/2024, Hua Yuan: Account for vegetation snow optical properties. ! !----------------------------------------------------------------------- USE MOD_Precision diff --git a/main/URBAN/MOD_Urban_BEM.F90 b/main/URBAN/MOD_Urban_BEM.F90 index 88195025..c55b7f16 100644 --- a/main/URBAN/MOD_Urban_BEM.F90 +++ b/main/URBAN/MOD_Urban_BEM.F90 @@ -51,7 +51,7 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & ! heat flux. ! ! o Solve the following energy balance equations -! o variables: troom, troof_inner, twsun_inner, twsha_innter +! o Variables: troom, troof_inner, twsun_inner, twsha_innter ! ! Hc_roof = Fn_roof .................................(1) ! Hc_wsun = Fn_wsun .................................(2) @@ -107,9 +107,9 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & ! local variables real(r8) :: & - ACH, &! air exchange coefficience - hcv_roof, &! convective exchange ceofficience for roof<->room - hcv_wall, &! convective exchange ceofficience for wall<->room + ACH, &! air exchange coefficient + hcv_roof, &! convective exchange coefficient for roof<->room + hcv_wall, &! convective exchange coefficient for wall<->room waste_coef, &! waste coefficient waste_cool, &! waste heat for AC cooling waste_heat ! waste heat for AC heating @@ -136,9 +136,9 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & ! Option for continuous AC logical, parameter :: Constant_AC = .true. - ACH = 0.3 !air exchange coefficience - hcv_roof = 4.040 !convective exchange ceofficience for roof<->room (W m-2 K-1) - hcv_wall = 3.076 !convective exchange ceofficience for wall<->room (W m-2 K-1) + ACH = 0.3 !air exchange coefficient + hcv_roof = 4.040 !convective exchange coefficient for roof<->room (W m-2 K-1) + hcv_wall = 3.076 !convective exchange coefficient for wall<->room (W m-2 K-1) waste_cool = 0.6 !waste heat for AC cooling waste_heat = 0.2 !waste heat for AC heating cooling = .false. !cooling case @@ -174,7 +174,7 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & ! Inverse of matrix A Ainv = MatrixInverse(A) - ! Matrix computing to revole multiple reflections + ! Matrix computing to resolve multiple reflections X = matmul(Ainv, B) troof_inner_bef = troof_inner @@ -200,7 +200,7 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & Fhac = H*rhoair*cpair*(troom-troom_min)/deltim troom = troom_min Fwst = abs(Fhac)*waste_heat - ! nagative value, set it to 0. + ! negative value, set it to 0. Fhac = 0. ENDIF diff --git a/main/URBAN/MOD_Urban_Const_LCZ.F90 b/main/URBAN/MOD_Urban_Const_LCZ.F90 index 4b14dfb2..2ae50740 100644 --- a/main/URBAN/MOD_Urban_Const_LCZ.F90 +++ b/main/URBAN/MOD_Urban_Const_LCZ.F90 @@ -4,7 +4,7 @@ MODULE MOD_Urban_Const_LCZ ! ----------------------------------------------------------------------- ! !DESCRIPTION: ! look-up-table for LCZ morphology and thermal parameters -! !NOTE!!!!!!!!!!!!!!! +! - NOTE - ! Each city may have different values for the parameters in this table. ! The default values may not suit any specific city. ! Users could adjust these values based on the city they are working with. @@ -16,6 +16,7 @@ MODULE MOD_Urban_Const_LCZ ! the 'local climate zone' scheme using temperature observations and model ! simulations. International Journal of Climatology, 34(4), 1062–1080. ! https://doi.org/10.1002/joc.3746 +! ! 2) The URBPARM_LCZ.TBL of WRF, https://github.com/wrf-model/WRF/ ! ! ----------------------------------------------------------------------- @@ -53,19 +54,19 @@ MODULE MOD_Urban_Const_LCZ real(r8), parameter, dimension(10) :: thickroad_lcz & = (/0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25/) - ! albeodo of roof [-] + ! albedo of roof [-] real(r8), parameter, dimension(10) :: albroof_lcz & = (/0.13, 0.18, 0.15, 0.13, 0.13, 0.13, 0.15, 0.18, 0.13, 0.1 /) - ! albeodo of wall [-] + ! albedo of wall [-] real(r8), parameter, dimension(10) :: albwall_lcz & = (/0.25, 0.2 , 0.2 , 0.25, 0.25, 0.25, 0.2 , 0.25, 0.25, 0.2 /) - ! albeodo of impervious road [-] + ! albedo of impervious road [-] real(r8), parameter, dimension(10) :: albimproad_lcz & = (/0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.18, 0.14, 0.14, 0.14/) - ! albeodo of pervious road [-] + ! albedo of pervious road [-] real(r8), parameter, dimension(10) :: albperroad_lcz & = (/0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25/) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 0079140a..f2976efb 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -188,12 +188,12 @@ SUBROUTINE UrbanOnlyFlux ( & taux, &! wind stress: E-W [kg/m/s**2] tauy, &! wind stress: N-S [kg/m/s**2] fsenroof, &! sensible heat flux from roof [W/m2] - fsenwsun, &! sensible heat flux from snulit wall [W/m2] + fsenwsun, &! sensible heat flux from sunlit wall [W/m2] fsenwsha, &! sensible heat flux from shaded wall [W/m2] fsengimp, &! sensible heat flux from impervious road [W/m2] fsengper, &! sensible heat flux from pervious ground [W/m2] - fevproof, &! evaperation heat flux from roof [W/m2] - fevpgimp, &! evaperation heat flux from impervious road [W/m2] + fevproof, &! evaporation heat flux from roof [W/m2] + fevpgimp, &! evaporation heat flux from impervious road [W/m2] fevpgper, &! evaporation heat flux from pervious ground [mm/s] croofs, &! deriv of roof sensible heat flux wrt soil temp [w/m**2/k] @@ -228,7 +228,7 @@ SUBROUTINE UrbanOnlyFlux ( & nmozsgn ! number of times moz changes sign real(r8) :: & - beta, &! coefficient of conective velocity [-] + beta, &! coefficient of convective velocity [-] dth, &! diff of virtual temp. between ref. height and surface dqh, &! diff of humidity between ref. height and surface dthv, &! diff of vir. poten. temp. between ref. height and surface @@ -241,20 +241,20 @@ SUBROUTINE UrbanOnlyFlux ( & fq2m, &! relation for specific humidity at 2m fm10m, &! integral of profile function for momentum at 10m thvstar, &! virtual potential temperature scaling parameter - um, &! wind speed including the stablity effect [m/s] + um, &! wind speed including the stability effect [m/s] ur, &! wind speed at reference height [m/s] wc, &! convective velocity [m/s] wc2, &! wc**2 zeta, &! dimensionless height used in Monin-Obukhov theory zii, &! convective boundary height [m] - zldis, &! reference height "minus" zero displacement heght [m] + zldis, &! reference height "minus" zero displacement height [m] z0mg, &! roughness length over ground, momentum [m] z0hg, &! roughness length over ground, sensible heat [m] z0qg ! roughness length over ground, latent heat [m] real(r8) evplwet, evplwet_dtl, elwmax, elwdif -!----------------------- defination for 3d run ------------------------- +!----------------------- definition for 3d run ------------------------- integer, parameter :: nlay = 3 ! potential layer number @@ -274,9 +274,9 @@ SUBROUTINE UrbanOnlyFlux ( & phih, &! phi(h), similarity function for sensible heat displa, &! displacement height for urban displau, &! displacement height for urban building - z0mu, &! roughless length for urban building only - z0h, &! roughless length for sensible heat - z0q, &! roughless length for latent heat + z0mu, &! roughness length for urban building only + z0h, &! roughness length for sensible heat + z0q, &! roughness length for latent heat tg, &! ground temperature qg ! ground specific humidity @@ -293,7 +293,7 @@ SUBROUTINE UrbanOnlyFlux ( & alpha ! exponential extinction factor for u/k decline within urban real(r8), dimension(0:nurb) :: & - tu, &! termperature array + tu, &! temperature array fc, &! fractional cover array canlev, &! urban canopy layer lookup table rb, &! leaf boundary layer resistance [s/m] @@ -492,7 +492,7 @@ SUBROUTINE UrbanOnlyFlux ( & !----------------------------------------------------------------------- ! first guess for taf and qaf for each layer -! a large differece from previous schemes +! a large difference from previous schemes !----------------------------------------------------------------------- IF (numlay .eq. 2) THEN @@ -516,19 +516,19 @@ SUBROUTINE UrbanOnlyFlux ( & IF (hu <= hroof+1) THEN hu_ = hroof + 1. - IF (taux == spval) & ! only print warning for the firt time-step + IF (taux == spval) & ! only print warning for the first time-step write(6,*) 'Warning: the obs height of u less than hroof+1, set it to hroof+1.' ENDIF IF (ht <= hroof+1) THEN ht_ = hroof + 1. - IF (taux == spval) & ! only print warning for the firt time-step + IF (taux == spval) & ! only print warning for the first time-step write(6,*) 'Warning: the obs height of t less than hroof+1, set it to hroof+1.' ENDIF IF (hq <= hroof+1) THEN hq_ = hroof + 1. - IF (taux == spval) & ! only print warning for the firt time-step + IF (taux == spval) & ! only print warning for the first time-step write(6,*) 'Warning: the obs height of q less than hroof+1, set it to hroof+1.' ENDIF @@ -938,7 +938,7 @@ SUBROUTINE UrbanVegFlux ( & frl, &! atmospheric infrared (longwave) radiation [W/m2] par, &! par absorbed per unit sunlit lai [w/m**2] sabv, &! solar radiation absorbed by vegetation [W/m2] - rstfac, &! factor of soil water stress to plant physiologocal processes + rstfac, &! factor of soil water stress to plant physiological processes po2m, &! atmospheric partial pressure o2 (pa) pco2m, &! atmospheric partial pressure co2 (pa) @@ -1039,9 +1039,9 @@ SUBROUTINE UrbanVegFlux ( & real(r8), intent(in) :: Ainv(5,5) !Inverse of Radiation transfer matrix real(r8), intent(in) :: SkyVF (5) !View factor to sky real(r8), intent(in) :: VegVF (5) !View factor to veg - real(r8), intent(inout) :: B (5) !Vectors of incident radition on each surface - real(r8), intent(inout) :: B1 (5) !Vectors of incident radition on each surface - real(r8), intent(inout) :: dBdT (5) !Vectors of incident radition on each surface + real(r8), intent(inout) :: B (5) !Vectors of incident radiation on each surface + real(r8), intent(inout) :: B1 (5) !Vectors of incident radiation on each surface + real(r8), intent(inout) :: dBdT (5) !Vectors of incident radiation on each surface real(r8), intent(out) :: & taux, &! wind stress: E-W [kg/m/s**2] @@ -1061,7 +1061,7 @@ SUBROUTINE UrbanVegFlux ( & cgrnds, &! deriv of ground latent heat flux wrt soil temp [w/m**2/k] croofl, &! deriv of roof latent heat flux wrt soil temp [w/m**2/k] cgimpl, &! deriv of impervious latent heat flux wrt soil temp [w/m**2/k] - cgperl, &! deriv of soil atent heat flux wrt soil temp [w/m**2/k] + cgperl, &! deriv of soil latent heat flux wrt soil temp [w/m**2/k] croof, &! deriv of roof total flux wrt soil temp [w/m**2/k] cgimp, &! deriv of impervious total heat flux wrt soil temp [w/m**2/k] cgper, &! deriv of soil total heat flux wrt soil temp [w/m**2/k] @@ -1111,21 +1111,21 @@ SUBROUTINE UrbanVegFlux ( & real(r8) dtl(0:itmax+1) !difference of tl between two iterative step real(r8) :: & - zldis, &! reference height "minus" zero displacement heght [m] + zldis, &! reference height "minus" zero displacement height [m] zii, &! convective boundary layer height [m] z0mv, &! roughness length of vegetation only, momentum [m] z0mu, &! roughness length of building only, momentum [m] z0h, &! roughness length, sensible heat [m] z0q, &! roughness length, latent heat [m] zeta, &! dimensionless height used in Monin-Obukhov theory - beta, &! coefficient of conective velocity [-] + beta, &! coefficient of convective velocity [-] wc, &! convective velocity [m/s] wc2, &! wc**2 dth, &! diff of virtual temp. between ref. height and surface dthv, &! diff of vir. poten. temp. between ref. height and surface dqh, &! diff of humidity between ref. height and surface obu, &! monin-obukhov length (m) - um, &! wind speed including the stablity effect [m/s] + um, &! wind speed including the stability effect [m/s] ur, &! wind speed at reference height [m/s] uaf, &! velocity of air within foliage [m/s] fh2m, &! relation for temperature at 2m @@ -1165,13 +1165,13 @@ SUBROUTINE UrbanVegFlux ( & real(r8) fevpl_bef, fevpl_noadj, dtl_noadj, erre real(r8) qevpl, qdewl, qsubl, qfrol, qmelt, qfrz -!----------------------- defination for 3d run ------------------------ ! +!----------------------- definition for 3d run ------------------------ integer, parameter :: nlay = 3 integer, parameter :: uvec(5) = (/0,0,0,0,1/) !unit vector integer :: & clev, &! current layer index - botlay, &! botom layer index + botlay, &! bottom layer index numlay ! available layer number real(r8) :: & @@ -1188,7 +1188,7 @@ SUBROUTINE UrbanVegFlux ( & displau, &! displacement height for urban building displav, &! displacement height for urban vegetation displav_lay, &! displacement height for urban vegetation layer - z0mv_lay, &! roughless length for vegetation + z0mv_lay, &! roughness length for vegetation ueff_veg, &! effective wind speed within canopy layer [m/s] tg, &! ground temperature qg ! ground specific humidity @@ -1217,7 +1217,7 @@ SUBROUTINE UrbanVegFlux ( & dlveg ! change of lw for the last time real(r8), dimension(0:nurb) :: & - tu, &! termperature array + tu, &! temperature array fc, &! fractional cover array canlev, &! urban canopy layer lookup table rb, &! leaf boundary layer resistance [s/m] @@ -1518,19 +1518,19 @@ SUBROUTINE UrbanVegFlux ( & IF (hu <= hroof+1) THEN hu_ = hroof + 1. - IF (taux == spval) & ! only print warning for the firt time-step + IF (taux == spval) & ! only print warning for the first time-step write(6,*) 'Warning: the obs height of u less than hroof+1, set it to hroof+1.' ENDIF IF (ht <= hroof+1) THEN ht_ = hroof + 1. - IF (taux == spval) & ! only print warning for the firt time-step + IF (taux == spval) & ! only print warning for the first time-step write(6,*) 'Warning: the obs height of t less than hroof+1, set it to hroof+1.' ENDIF IF (hq <= hroof+1) THEN hq_ = hroof + 1. - IF (taux == spval) & ! only print warning for the firt time-step + IF (taux == spval) & ! only print warning for the first time-step write(6,*) 'Warning: the obs height of q less than hroof+1, set it to hroof+1.' ENDIF @@ -1878,7 +1878,7 @@ SUBROUTINE UrbanVegFlux ( & ! IR radiation, sensible and latent heat fluxes and their derivatives !----------------------------------------------------------------------- ! the partial derivatives of areodynamical resistance are ignored -! which cannot be determined analtically +! which cannot be determined analytically !NOTE: ONLY for vegetation i = 3 @@ -2238,13 +2238,13 @@ SUBROUTINE UrbanVegFlux ( & etr_deficit = max(0., etr - etr_) ENDIF -! canopy fluxes and total assimilation amd respiration +! canopy fluxes and total assimilation and respiration fsenl = fsenl + fsenl_dtl*dtl(it-1) & - ! add the imbalanced energy below due to T adjustment to sensibel heat + ! add the imbalanced energy below due to T adjustment to sensible heat + (dtl_noadj-dtl(it-1)) * (clai/deltim - dirab_dtl & + fsenl_dtl + hvap*fevpl_dtl) & - ! add the imbalanced energy below due to q adjustment to sensibel heat + ! add the imbalanced energy below due to q adjustment to sensible heat + hvap*erre etr = etr + etr_dtl*dtl(it-1) diff --git a/main/URBAN/MOD_Urban_GroundFlux.F90 b/main/URBAN/MOD_Urban_GroundFlux.F90 index b4de06e9..19812528 100644 --- a/main/URBAN/MOD_Urban_GroundFlux.F90 +++ b/main/URBAN/MOD_Urban_GroundFlux.F90 @@ -88,7 +88,7 @@ SUBROUTINE UrbanGroundFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & nmozsgn ! number of times moz changes sign real(r8) :: & - beta, &! coefficient of conective velocity [-] + beta, &! coefficient of convective velocity [-] displax, &! zero-displacement height [m] tg, &! ground surface temperature [K] qg, &! ground specific humidity [kg/kg] @@ -104,12 +104,12 @@ SUBROUTINE UrbanGroundFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & fq2m, &! relation for specific humidity at 2m fm10m, &! integral of profile function for momentum at 10m thvstar, &! virtual potential temperature scaling parameter - um, &! wind speed including the stablity effect [m/s] + um, &! wind speed including the stability effect [m/s] wc, &! convective velocity [m/s] wc2, &! wc**2 zeta, &! dimensionless height used in Monin-Obukhov theory zii, &! convective boundary height [m] - zldis, &! reference height "minus" zero displacement heght [m] + zldis, &! reference height "minus" zero displacement height [m] z0mg, &! roughness length over ground, momentum [m] z0qg ! roughness length over ground, latent heat [m] @@ -127,7 +127,7 @@ SUBROUTINE UrbanGroundFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & z0hg = z0mg z0qg = z0mg -! potential temperatur at the reference height +! potential temperature at the reference height beta = 1. !- (in computing W_*) zii = 1000. !m (pbl height) z0m = z0mg diff --git a/main/URBAN/MOD_Urban_Hydrology.F90 b/main/URBAN/MOD_Urban_Hydrology.F90 index 1d4262cb..f3d8110b 100644 --- a/main/URBAN/MOD_Urban_Hydrology.F90 +++ b/main/URBAN/MOD_Urban_Hydrology.F90 @@ -113,12 +113,12 @@ SUBROUTINE UrbanHydrology ( & pg_rain_lake ,&! rainfall onto lake (mm h2o/s) pg_snow_lake ,&! snowfall onto lake (mm h2o/s) froof ,&! roof fractional cover [-] - fgper ,&! weith of impervious ground [-] + fgper ,&! weight of impervious ground [-] flake ,&! lake fractional cover [-] ! wtfact ,&! (updated to gridded 'fsatmax' data) fraction of model area with high water table pondmx ,&! ponding depth (mm) ssi ,&! irreducible water saturation of snow - wimp ,&! water impremeable IF porosity less than wimp + wimp ,&! water impermeable IF porosity less than wimp smpmin ,&! restriction for min of soil poten. (mm) topostd ,&! standard deviation of elevation [m] @@ -129,8 +129,8 @@ SUBROUTINE UrbanHydrology ( & psi0 (1:nl_soil) ,&! saturated soil suction (mm) (NEGATIVE) hksati(1:nl_soil) ,&! hydraulic conductivity at saturation (mm h2o/s) theta_r(1:nl_soil) ,&! residual moisture content [-] - fsatmax ,&! maximum saturated area fraction [-] - fsatdcf ,&! decay factor in calucation of saturated area fraction [1/m] + fsatmax ,&! maximum saturated area fraction [-] + fsatdcf ,&! decay factor in calculation of saturated area fraction [1/m] rootr (1:nl_soil) ,&! root resistance of a layer, all layers add to 1.0 etr ,&! vegetation transpiration diff --git a/main/URBAN/MOD_Urban_ImperviousTemperature.F90 b/main/URBAN/MOD_Urban_ImperviousTemperature.F90 index 61a23232..c83b0f2b 100644 --- a/main/URBAN/MOD_Urban_ImperviousTemperature.F90 +++ b/main/URBAN/MOD_Urban_ImperviousTemperature.F90 @@ -41,17 +41,19 @@ SUBROUTINE UrbanImperviousTem (patchtype,lb,deltim, & ! o The volumetric heat capacity is calculated as a linear combination ! in terms of the volumetric fraction of the constituent phases. ! o The thermal conductivity of road soil is computed from -! the algorithm of Johansen (as reported by Farouki 1981), impervious and perivious from -! LOOK-UP table and of snow is from the formulation used in SNTHERM (Jordan 1991). +! the algorithm of Johansen (as reported by Farouki 1981), impervious +! and pervious from LOOK-UP table and of snow is from the formulation +! used in SNTHERM (Jordan 1991). ! o Boundary conditions: ! F = Rnet - Hg - LEg (top), F = 0 (base of the soil column). ! o Soil / snow temperature is predicted from heat conduction -! in 10 soil layers and up to 5 snow layers. -! The thermal conductivities at the interfaces between two neighbor layers -! (j, j+1) are derived from an assumption that the flux across the interface -! is equal to that from the node j to the interface and the flux from the -! interface to the node j+1. The equation is solved using the Crank-Nicholson -! method and resulted in a tridiagonal system equation. +! in 10 soil layers and up to 5 snow layers. The thermal +! conductivities at the interfaces between two neighbor layers (j,j+1) +! are derived from an assumption that the flux across the interface is +! equal to that from the node j to the interface and the flux from the +! interface to the node j+1. The equation is solved using the +! Crank-Nicholson method and resulted in a tridiagonal system +! equation. ! ! Phase change (see MOD_PhaseChange.F90) ! @@ -96,7 +98,7 @@ SUBROUTINE UrbanImperviousTem (patchtype,lb,deltim, & real(r8), intent(in) :: cv_gimp (1:nl_soil) !heat capacity of urban impervious [J/m3/K] real(r8), intent(in) :: tk_gimp (1:nl_soil) !thermal conductivity of urban impervious [W/m/K] - real(r8), intent(in) :: dz_gimpsno(lb :nl_soil) !layer thickiness [m] + real(r8), intent(in) :: dz_gimpsno(lb :nl_soil) !layer thickness [m] real(r8), intent(in) :: z_gimpsno (lb :nl_soil) !node depth [m] real(r8), intent(in) :: zi_gimpsno(lb-1:nl_soil) !interface depth [m] @@ -125,7 +127,7 @@ SUBROUTINE UrbanImperviousTem (patchtype,lb,deltim, & real(r8) hcap(1:nl_soil) !J/(m3 K) real(r8) thk(lb:nl_soil) !W/(m K) - real(r8) rhosnow !partitial density of water (ice + liquid) + real(r8) rhosnow !partial density of water (ice + liquid) real(r8) at (lb:nl_soil) !"a" vector for tridiagonal matrix real(r8) bt (lb:nl_soil) !"b" vector for tridiagonal matrix @@ -140,7 +142,7 @@ SUBROUTINE UrbanImperviousTem (patchtype,lb,deltim, & real(r8) t_gimpsno_bef(lb:nl_soil) !soil/snow temperature before update real(r8) hs !net energy flux into the surface (w/m2) real(r8) dhsdt !d(hs)/dT - real(r8) brr(lb:nl_soil) !temporay set + real(r8) brr(lb:nl_soil) !temporary set real(r8) vf_water(1:nl_soil) !volumetric fraction liquid water within soil real(r8) vf_ice (1:nl_soil) !volumetric fraction ice len within soil @@ -197,10 +199,10 @@ SUBROUTINE UrbanImperviousTem (patchtype,lb,deltim, & ! the following consideration is try to avoid the snow conductivity ! to be dominant in the thermal conductivity of the interface. -! Because when the distance of bottom snow node to the interfacee +! Because when the distance of bottom snow node to the interface ! is larger than that of interface to top soil node, ! the snow thermal conductivity will be dominant, and the result is that -! lees heat tranfer between snow and soil +! lees heat transfer between snow and soil IF((i==0) .and. (z_gimpsno(i+1)-zi_gimpsno(i)0.) htvp_gimp = hsub IF (wliq_gpersno(lbp)<=0. .and. wice_gpersno(lbp)>0.) htvp_gper = hsub - ! potential temperatur at the reference height + ! potential temperature at the reference height thm = forc_t + 0.0098*forc_hgt_t !intermediate variable equivalent to !forc_t*(pgcm/forc_psrf)**(rgas/cpair) th = forc_t*(100000./forc_psrf)**(rgas/cpair) !potential T @@ -738,7 +738,7 @@ SUBROUTINE UrbanTHERMAL ( & !======================================================================= -! [3] caluclate longwave radiation +! [3] calculate longwave radiation !======================================================================= IF ( doveg ) THEN @@ -833,7 +833,7 @@ SUBROUTINE UrbanTHERMAL ( & fcover,tgimp,tgper,qgimp,qgper,tref,qref, & z0m_g,z0h_g,zol_g,ustar_g,qstar_g,tstar_g,fm_g,fh_g,fq_g) - ! SAVE variables for bareground case + ! SAVE variables for bare ground case obu_g = forc_hgt_u / zol_g @@ -843,7 +843,7 @@ SUBROUTINE UrbanTHERMAL ( & IF ( doveg ) THEN - ! soil water strees factor on stomatal resistance + ! soil water stress factor on stomatal resistance CALL eroot (nl_soil,trsmx0,porsl,& #ifdef Campbell_SOIL_MODEL bsw,& @@ -1013,7 +1013,7 @@ SUBROUTINE UrbanTHERMAL ( & tgper = t_gpersno(lbp) twall = (twsun*fwsun + twsha*fwsha)/(fwsun + fwsha) - ! calculate lake temperture and sensible/latent heat fluxes + ! calculate lake temperature and sensible/latent heat fluxes CALL laketem ( & ! "in" laketem arguments ! --------------------------- @@ -1064,7 +1064,7 @@ SUBROUTINE UrbanTHERMAL ( & dT(4) = tgper - tgper_bef IF ( doveg ) dT(5) = 0. - ! flux change due to temperture change + ! flux change due to temperature change fsenroof = fsenroof + dT(0)*croofs fsenwsun = fsenwsun + dT(1)*cwsuns fsenwsha = fsenwsha + dT(2)*cwshas @@ -1304,7 +1304,7 @@ SUBROUTINE UrbanTHERMAL ( & dlw = dlw*(1-flake) ! calculate out going longwave by added the before value - ! of lout and condsidered troof change + ! of lout and considered troof change lout = lout + dlout rout = (1-eroof)*forc_frl + eroof*stefnc*troof_bef**4 & + 4.*eroof*stefnc*troof_bef**3*dT(0) @@ -1409,7 +1409,7 @@ SUBROUTINE UrbanTHERMAL ( & ! convert BEM AHE to grid area values - ! NOTE: BEM AHE are assumed only affacting the urban area, + ! NOTE: BEM AHE are assumed only affecting the urban area, ! but vehc and meta area for the whole grid. Fhac = Fhac * (1-flake) Fwst = Fwst * (1-flake) diff --git a/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 b/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 index 7cb414c8..27b4b8b6 100644 --- a/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 +++ b/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 @@ -15,18 +15,18 @@ MODULE MOD_Urban_Vars_TimeVariables IMPLICIT NONE SAVE ! ----------------------------------------------------------------- -! Time-varying state variables which reaquired by restart run +! Time-varying state variables which required by restart run real(r8), allocatable :: fwsun (:) !sunlit fraction of walls [-] real(r8), allocatable :: dfwsun (:) !change of sunlit fraction of walls [-] ! shortwave absorption - real(r8), allocatable :: sroof (:,:,:) !roof aborption [-] + real(r8), allocatable :: sroof (:,:,:) !roof absorption [-] real(r8), allocatable :: swsun (:,:,:) !sunlit wall absorption [-] real(r8), allocatable :: swsha (:,:,:) !shaded wall absorption [-] - real(r8), allocatable :: sgimp (:,:,:) !impervious absorptioin [-] - real(r8), allocatable :: sgper (:,:,:) !pervious absorptioin [-] - real(r8), allocatable :: slake (:,:,:) !urban lake absorptioin [-] + real(r8), allocatable :: sgimp (:,:,:) !impervious absorption [-] + real(r8), allocatable :: sgper (:,:,:) !pervious absorption [-] + real(r8), allocatable :: slake (:,:,:) !urban lake absorption [-] ! net longwave radiation for last time temperature change real(r8), allocatable :: lwsun (:) !net longwave of sunlit wall [W/m2] @@ -88,7 +88,7 @@ MODULE MOD_Urban_Vars_TimeVariables !TODO: rename the below variables real(r8), allocatable :: Fhac (:) !sensible flux from heat or cool AC [W/m2] real(r8), allocatable :: Fwst (:) !waste heat flux from heat or cool AC [W/m2] - real(r8), allocatable :: Fach (:) !flux from inner and outter air exchange [W/m2] + real(r8), allocatable :: Fach (:) !flux from inner and outer air exchange [W/m2] real(r8), allocatable :: Fahe (:) !flux from metabolism and vehicle [W/m2] real(r8), allocatable :: Fhah (:) !sensible heat flux from heating [W/m2] real(r8), allocatable :: vehc (:) !flux from vehicle [W/m2] diff --git a/main/URBAN/MOD_Urban_WallTemperature.F90 b/main/URBAN/MOD_Urban_WallTemperature.F90 index 8de8fdeb..24b6f1d0 100644 --- a/main/URBAN/MOD_Urban_WallTemperature.F90 +++ b/main/URBAN/MOD_Urban_WallTemperature.F90 @@ -43,17 +43,19 @@ SUBROUTINE UrbanWallTem (deltim,capr,cnfac,& ! Wall temperatures ! o Boundary conditions: ! F = Rnet - Hg - LEg (top), -! For urban sunwall, shadewall, and wall columns, there is a non-zero heat flux across -! the bottom "building inner surface" layer and the equations are derived assuming -! a prescribed or adjusted internal building temperature. -! T = T_wall_inner (at the wall inner surface). -! o Wall temperature is predicted from heat conduction -! in N wall layers and up to 5 snow layers. -! The thermal conductivities at the interfaces between two neighbor layers -! (j, j+1) are derived from an assumption that the flux across the interface -! is equal to that from the node j to the interface and the flux from the -! interface to the node j+1. The equation is solved using the Crank-Nicholson -! method and resulted in a tridiagonal system equation. +! For urban sunwall, shadewall, and wall columns, there is a non-zero +! heat flux across the bottom "building inner surface" layer and the +! equations are derived assuming a prescribed or adjusted internal +! building temperature. T = T_wall_inner (at the wall inner surface). +! +! o Wall temperature is predicted from heat conduction in N wall layers +! and up to 5 snow layers. The thermal conductivities at the +! interfaces between two neighbor layers (j, j+1) are derived from an +! assumption that the flux across the interface is equal to that from +! the node j to the interface and the flux from the interface to the +! node j+1. The equation is solved using the Crank-Nicholson method +! and resulted in a tridiagonal system equation. +! ! o no Phase change ! ! Original author : Yongjiu Dai, 05/2020 @@ -73,7 +75,7 @@ SUBROUTINE UrbanWallTem (deltim,capr,cnfac,& real(r8), intent(in) :: cv_wall(1:nl_wall) !heat capacity of urban wall [J/m3/K] real(r8), intent(in) :: tk_wall(1:nl_wall) !thermal conductivity of urban wall [W/m/K] - real(r8), intent(in) :: dz_wall(1:nl_wall) !layer thickiness [m] + real(r8), intent(in) :: dz_wall(1:nl_wall) !layer thickness [m] real(r8), intent(in) :: z_wall (1:nl_wall) !node depth [m] real(r8), intent(in) :: zi_wall(0:nl_wall) !interface depth [m] @@ -89,7 +91,7 @@ SUBROUTINE UrbanWallTem (deltim,capr,cnfac,& !------------------------ local variables ------------------------------ real(r8) wice_wall(1:nl_wall) !ice lens [kg/m2] - real(r8) wliq_wall(1:nl_wall) !liqui water [kg/m2] + real(r8) wliq_wall(1:nl_wall) !liquid water [kg/m2] real(r8) cv (1:nl_wall) !heat capacity [J/(m2 K)] real(r8) thk(1:nl_wall) !thermal conductivity of layer From f565e9b5146cceb2710cf1669e0cacc0e1f2b0bf Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 4 Feb 2025 23:08:39 +0800 Subject: [PATCH 16/43] Correct many type errors for main/*.F90. --- main/CoLM.F90 | 10 +- main/CoLMDRIVER.F90 | 6 +- main/CoLMMAIN.F90 | 48 +++---- main/MOD_3DCanopyRadiation.F90 | 52 ++++---- main/MOD_Aerosol.F90 | 4 +- main/MOD_Albedo.F90 | 58 ++++----- main/MOD_AssimStomataConductance.F90 | 16 +-- main/MOD_Const_LC.F90 | 22 ++-- main/MOD_Const_PFT.F90 | 14 +-- main/MOD_FireData.F90 | 2 +- main/MOD_Forcing.F90 | 30 ++--- main/MOD_ForcingDownscaling.F90 | 98 +++++++-------- main/MOD_FrictionVelocity.F90 | 52 ++++---- main/MOD_Glacier.F90 | 60 ++++----- main/MOD_GroundFluxes.F90 | 12 +- main/MOD_GroundTemperature.F90 | 34 ++--- main/MOD_Hist.F90 | 88 ++++++------- main/MOD_HistWriteBack.F90 | 122 +++++++++--------- main/MOD_Lake.F90 | 58 ++++----- main/MOD_LeafInterception.F90 | 40 +++--- main/MOD_LeafTemperature.F90 | 40 +++--- main/MOD_LeafTemperaturePC.F90 | 86 ++++++------- main/MOD_LightningData.F90 | 2 +- main/MOD_MonthlyinSituCO2MaunaLoa.F90 | 4 +- main/MOD_NdepData.F90 | 4 +- main/MOD_NetSolar.F90 | 4 +- main/MOD_NitrifData.F90 | 2 +- main/MOD_Ozone.F90 | 4 +- main/MOD_PhaseChange.F90 | 30 ++--- main/MOD_PlantHydraulic.F90 | 8 +- main/MOD_RainSnowTemp.F90 | 38 +++--- main/MOD_Runoff.F90 | 22 ++-- main/MOD_SimpleOcean.F90 | 24 ++-- main/MOD_SnowFraction.F90 | 4 +- main/MOD_SnowLayersCombineDivide.F90 | 57 +++++---- main/MOD_SnowSnicar.F90 | 12 +- main/MOD_SoilSnowHydrology.F90 | 172 +++++++++++++------------- main/MOD_SoilSurfaceResistance.F90 | 2 +- main/MOD_SoilThermalParameters.F90 | 29 +++-- main/MOD_Thermal.F90 | 38 +++--- main/MOD_TurbulenceLEddy.F90 | 64 +++++----- main/MOD_Vars_1DAccFluxes.F90 | 6 +- main/MOD_Vars_1DFluxes.F90 | 22 ++-- main/MOD_Vars_1DForcing.F90 | 58 ++++----- main/MOD_Vars_TimeInvariants.F90 | 62 +++++----- main/MOD_Vars_TimeVariables.F90 | 26 ++-- share/MOD_Namelist.F90 | 4 +- 47 files changed, 831 insertions(+), 819 deletions(-) diff --git a/main/CoLM.F90 b/main/CoLM.F90 index 6cd7c633..c5384eca 100644 --- a/main/CoLM.F90 +++ b/main/CoLM.F90 @@ -5,7 +5,7 @@ PROGRAM CoLM ! Description: ! This is the main program for the Common Land Model (CoLM) ! -! @Copyright Yongjiu Dai Land Modeling Grop at the School of Atmospheric Sciences +! @Copyright Yongjiu Dai Land Modeling Group at the School of Atmospheric Sciences ! of the Sun Yat-sen University, Guangdong, CHINA. ! All rights reserved. ! @@ -116,7 +116,7 @@ PROGRAM CoLM logical :: greenwich ! greenwich time logical :: doalb ! true => start up the surface albedo calculation - logical :: dolai ! true => start up the time-varying vegetation paramter + logical :: dolai ! true => start up the time-varying vegetation parameter logical :: dosst ! true => update sst/ice/snow integer :: Julian_1day_p, Julian_1day @@ -497,8 +497,8 @@ PROGRAM CoLM ! Hua Yuan, 06/2023: change namelist DEF_LAI_CLIM to DEF_LAI_MONTHLY ! and add DEF_LAI_CHANGE_YEARLY for monthly LAI data ! - ! NOTES: Should be caution for setting DEF_LAI_CHANGE_YEARLY to ture in non-LULCC - ! case, that means the LAI changes without condisderation of land cover change. + ! NOTES: Should be caution for setting DEF_LAI_CHANGE_YEARLY to true in non-LULCC + ! case, that means the LAI changes without consideration of land cover change. IF (DEF_LAI_CHANGE_YEARLY) THEN lai_year = jdate(1) @@ -518,7 +518,7 @@ PROGRAM CoLM Julian_8day = int(calendarday(jdate)-1)/8*8 + 1 IF ((itstamp < etstamp) .and. (Julian_8day /= Julian_8day_p)) THEN CALL LAI_readin (jdate(1), Julian_8day, dir_landdata) - ! 06/2023, yuan: or depend on DEF_LAI_CHANGE_YEARLY nanemlist + ! 06/2023, yuan: or depend on DEF_LAI_CHANGE_YEARLY namelist !CALL LAI_readin (lai_year, Julian_8day, dir_landdata) ENDIF ENDIF diff --git a/main/CoLMDRIVER.F90 b/main/CoLMDRIVER.F90 index 2f21e305..0b01c2b4 100644 --- a/main/CoLMDRIVER.F90 +++ b/main/CoLMDRIVER.F90 @@ -37,7 +37,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) integer, intent(in) :: idate(3) ! model calendar for next time step (year, julian day, seconds) real(r8), intent(in) :: deltim ! seconds in a time-step - logical, intent(in) :: dolai ! true if time for time-varying vegetation paramter + logical, intent(in) :: dolai ! true if time for time-varying vegetation parameter logical, intent(in) :: doalb ! true if time for surface albedo calculation logical, intent(in) :: dosst ! true if time for update sst/ice/snow @@ -68,7 +68,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) m = patchclass(i) steps_in_one_deltim = 1 - ! deltim need to be within 1800s for waterbody with snow in order to avoid large + ! deltim need to be within 1800s for water body with snow in order to avoid large ! temperature fluctuations due to rapid snow heat conductance IF(m == WATERBODY .and. snowdp(i) > 0.0) steps_in_one_deltim = ceiling(deltim/1800.) deltim_phy = deltim/steps_in_one_deltim @@ -320,7 +320,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) solniln(i) ,srvdln(i) ,srviln(i) ,srndln(i) ,& srniln(i) ,qcharge(i) ,xerr(i) ,zerr(i) ,& - ! TUNABLE modle constants + ! TUNABLE model constants zlnd ,zsno ,csoilc ,dewmx ,& ! 'wtfact' is updated to gridded 'fsatmax' data. capr ,cnfac ,ssi ,& diff --git a/main/CoLMMAIN.F90 b/main/CoLMMAIN.F90 index 9016b121..dd7e648b 100644 --- a/main/CoLMMAIN.F90 +++ b/main/CoLMMAIN.F90 @@ -92,7 +92,7 @@ SUBROUTINE CoLMMAIN ( & srviln, srndln, srniln, qcharge, & xerr, zerr, & - ! TUNABLE modle constants + ! TUNABLE model constants zlnd, zsno, csoilc, dewmx, & ! 'wtfact' is updated to gridded 'fsatmax' data. capr, cnfac, ssi, & @@ -185,7 +185,7 @@ SUBROUTINE CoLMMAIN ( & ipatch ! patch index real(r8), intent(in) :: & - patchlonr ,&! logitude in radians + patchlonr ,&! longitude in radians patchlatr ! latitude in radians integer, intent(in) :: & @@ -218,7 +218,7 @@ SUBROUTINE CoLMMAIN ( & bsw (nl_soil) ,&! clapp and hornberger "b" parameter [-] theta_r (1:nl_soil) ,&! residual water content (cm3/cm3) fsatmax ,&! maximum saturated area fraction [-] - fsatdcf ,&! decay factor in calucation of saturated area fraction [1/m] + fsatdcf ,&! decay factor in calculation of saturated area fraction [1/m] #ifdef vanGenuchten_Mualem_SOIL_MODEL alpha_vgm(1:nl_soil) ,&! the parameter corresponding approximately to the inverse of the air-entry value n_vgm (1:nl_soil) ,&! a shape parameter @@ -242,10 +242,10 @@ SUBROUTINE CoLMMAIN ( & sqrtdi ,&! inverse sqrt of leaf dimension [m**-0.5] effcon ,&! quantum efficiency of RuBP regeneration (mol CO2/mol quanta) vmax25 ,&! maximum carboxylation rate at 25 C at canopy top - kmax_sun ,&! Plant Hydraulics Paramters - kmax_sha ,&! Plant Hydraulics Paramters - kmax_xyl ,&! Plant Hydraulics Paramters - kmax_root ,&! Plant Hydraulics Paramters + kmax_sun ,&! Plant Hydraulics Parameters + kmax_sha ,&! Plant Hydraulics Parameters + kmax_xyl ,&! Plant Hydraulics Parameters + kmax_root ,&! Plant Hydraulics Parameters psi50_sun ,&! water potential at 50% loss of sunlit leaf tissue conductance (mmH2O) psi50_sha ,&! water potential at 50% loss of shaded leaf tissue conductance (mmH2O) psi50_xyl ,&! water potential at 50% loss of xylem tissue conductance (mmH2O) @@ -276,7 +276,7 @@ SUBROUTINE CoLMMAIN ( & capr ,&! tuning factor to turn first layer T into surface T cnfac ,&! Crank Nicholson factor between 0 and 1 ssi ,&! irreducible water saturation of snow - wimp ,&! water impremeable if porosity less than wimp + wimp ,&! water impermeable if porosity less than wimp pondmx ,&! ponding depth (mm) smpmax ,&! wilting point potential in mm smpmin ,&! restriction for min of soil poten. (mm) @@ -309,8 +309,8 @@ SUBROUTINE CoLMMAIN ( & forc_aerdep(14)!atmospheric aerosol deposition data [kg/m/s] #if(defined CaMa_Flood) - real(r8), intent(in) :: fldfrc !inundation fraction--> allow re-evaporation and infiltrition![0-1] - real(r8), intent(inout) :: flddepth !inundation depth--> allow re-evaporation and infiltrition![mm] + real(r8), intent(in) :: fldfrc !inundation fraction--> allow re-evaporation and infiltration![0-1] + real(r8), intent(inout) :: flddepth !inundation depth--> allow re-evaporation and infiltration![mm] real(r8), intent(out) :: fevpg_fld !effective evaporation from inundation [mm/s] real(r8), intent(out) :: qinfl_fld !effective re-infiltration from inundation [mm/s] #endif @@ -398,7 +398,7 @@ SUBROUTINE CoLMMAIN ( & wat ,&! total water storage rss ,&! soil surface resistance [s/m] rootr(nl_soil) ,&! water exchange between soil and root. Positive: soil->root [?] - rootflux(nl_soil),&! water exchange between soil and root in different layers. Posiitive: soil->root [?] + rootflux(nl_soil),&! water exchange between soil and root in different layers. Positive: soil->root [?] h2osoi(nl_soil) ! volumetric soil water in layers [m3/m3] real(r8), intent(out) :: & @@ -414,7 +414,7 @@ SUBROUTINE CoLMMAIN ( & fsena ,&! sensible heat from canopy height to atmosphere [W/m2] fevpa ,&! evapotranspiration from canopy height to atmosphere [mm/s] lfevpa ,&! latent heat flux from canopy height to atmosphere [W/2] - fsenl ,&! ensible heat from leaves [W/m2] + fsenl ,&! sensible heat from leaves [W/m2] fevpl ,&! evaporation+transpiration from leaves [mm/s] etr ,&! transpiration rate [mm/s] fseng ,&! sensible heat flux from ground [W/m2] @@ -422,7 +422,7 @@ SUBROUTINE CoLMMAIN ( & olrg ,&! outgoing long-wave radiation from ground+canopy fgrnd ,&! ground heat flux [W/m2] xerr ,&! water balance error at current time-step [mm/s] - zerr ,&! energy balnce errore at current time-step [W/m2] + zerr ,&! energy balance error at current time-step [W/m2] tref ,&! 2 m height air temperature [K] qref ,&! 2 m height air specific humidity @@ -432,7 +432,7 @@ SUBROUTINE CoLMMAIN ( & rsur_ie ,&! infiltration excess surface runoff (mm h2o/s) rnof ,&! total runoff (mm h2o/s) qintr ,&! interception (mm h2o/s) - qinfl ,&! inflitration (mm h2o/s) + qinfl ,&! infiltration (mm h2o/s) qdrip ,&! throughfall (mm h2o/s) qcharge ,&! groundwater recharge [mm/s] @@ -481,8 +481,8 @@ SUBROUTINE CoLMMAIN ( & real(r8) :: & calday ,&! Julian cal day (1.xx to 365.xx) endwb ,&! water mass at the end of time step - errore ,&! energy balnce errore (Wm-2) - errorw ,&! water balnce errore (mm) + errore ,&! energy balance error (Wm-2) + errorw ,&! water balance error (mm) fiold(maxsnl+1:nl_soil), &! fraction of ice relative to the total water w_old ,&! liquid water mass of the column at the previous time step (mm) @@ -507,7 +507,7 @@ SUBROUTINE CoLMMAIN ( & ssw ,&! water volumetric content of soil surface layer [m3/m3] tssub(7) ,&! surface/sub-surface temperatures [K] tssea ,&! sea surface temperature [K] - totwb ,&! water mass at the begining of time step + totwb ,&! water mass at the beginning of time step wt ,&! fraction of vegetation buried (covered) by snow [-] z_soisno (maxsnl+1:nl_soil), &! layer depth (m) dz_soisno(maxsnl+1:nl_soil), &! layer thickness (m) @@ -526,7 +526,7 @@ SUBROUTINE CoLMMAIN ( & qintr_snow ! snowfall interception (mm h2o/s) integer snl ,&! number of snow layers - imelt(maxsnl+1:nl_soil), &! flag for: melting=1, freezing=2, Nothing happended=0 + imelt(maxsnl+1:nl_soil), &! flag for: melting=1, freezing=2, Nothing happened=0 lb ,lbsn ,&! lower bound of arrays j ! do looping index @@ -678,7 +678,7 @@ SUBROUTINE CoLMMAIN ( & qdrip = pg_rain + pg_snow !---------------------------------------------------------------------- -! [3] Initilize new snow nodes for snowfall / sleet +! [3] Initialize new snow nodes for snowfall / sleet !---------------------------------------------------------------------- snl_bef = snl @@ -993,7 +993,7 @@ SUBROUTINE CoLMMAIN ( & ENDIF !---------------------------------------------------------------- - ! Initilize new snow nodes for snowfall / sleet + ! Initialize new snow nodes for snowfall / sleet !---------------------------------------------------------------- snl_bef = snl @@ -1111,7 +1111,7 @@ SUBROUTINE CoLMMAIN ( & !====================================================================== - ELSE IF(patchtype == 4) THEN ! <=== is LAND WATER BODIES (lake, reservior and river) (patchtype = 4) + ELSE IF(patchtype == 4) THEN ! <=== is LAND WATER BODIES (lake, reservoir and river) (patchtype = 4) !====================================================================== @@ -1348,7 +1348,7 @@ SUBROUTINE CoLMMAIN ( & !====================================================================== ! Preparation for the next time step -! 1) time-varying parameters for vegatation +! 1) time-varying parameters for vegetation ! 2) fraction of snow cover ! 3) solar zenith angle and ! 4) albedos @@ -1423,7 +1423,7 @@ SUBROUTINE CoLMMAIN ( & ! ============================================================================ ! Snow aging routine based on Flanner and Zender (2006), Linking snowpack ! microphysics and albedo evolution, JGR, and Brun (1989), Investigation of -! wet-snow metamorphism in respect of liquid-water content, Ann. Glaciol. +! wet-snow metamorphism in respect of liquid-water content, Ann. Glacial. dz_soisno_(:1) = dz_soisno(:1) t_soisno_ (:1) = t_soisno (:1) @@ -1436,7 +1436,7 @@ SUBROUTINE CoLMMAIN ( & ! ============================================================================ ! albedos ! we supposed CALL it every time-step, because - ! other vegeation related parameters are needed to create + ! other vegetation related parameters are needed to create IF (doalb) THEN CALL albland (ipatch, patchtype,deltim,& soil_s_v_alb,soil_d_v_alb,soil_s_n_alb,soil_d_n_alb,& diff --git a/main/MOD_3DCanopyRadiation.F90 b/main/MOD_3DCanopyRadiation.F90 index 91538647..c19be318 100644 --- a/main/MOD_3DCanopyRadiation.F90 +++ b/main/MOD_3DCanopyRadiation.F90 @@ -85,7 +85,7 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) ! sunlit absorption fraction calculation mode ! .true. USE 3D model, otherwise USE 1D case ! NOTE: The 3D version will be activated in the new release, - ! accompained by a new set of canopy structure data. + ! accompanied by a new set of canopy structure data. logical, parameter :: fsun3D = .false. ! define allocatable variables @@ -274,7 +274,7 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & ! Created by Hua Yuan, 08/2019 ! ! !HISTORY: -! Before 2013: Robert E. Dickinson proposed the inital idea. Dickinson and +! Before 2013: Robert E. Dickinson proposed the initial idea. Dickinson and ! Muhammad J. Shake contributed to the code writing. ! ! !REFERENCE: @@ -295,7 +295,7 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & real(r8), intent(in) :: fcover(ps:pe) !fractional cover of pft within a patch real(r8), intent(in) :: csiz (ps:pe) !crown size of vegetation real(r8), intent(in) :: chgt (ps:pe) !central height of crown - ! NOTE: The 'cdcw' parameter will be activated in the new release, accompained by + ! NOTE: The 'cdcw' parameter will be activated in the new release, accompanied by ! a new set of canopy structure data. Currently we set cdcw = 1, i.e., sphere real(r8) :: cdcw (ps:pe) !crown depth to crown width real(r8), intent(in) :: chil (ps:pe) !leaf angle distribution parameter @@ -354,7 +354,7 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & real(r8) :: albd_col(numrad) !surface reflection (direct) for column real(r8) :: albi_col(numrad) !surface reflection (diffuse) for column - real(r8) :: hbot_lay(nlay) !avergae canopy bottom in layer + real(r8) :: hbot_lay(nlay) !average canopy bottom in layer real(r8) :: chgt_lay(nlay) !average canopy height in layer real(r8) :: csiz_lay(nlay) !average canopy size in layer real(r8) :: cdcw_lay(nlay) !crown depth to crown width for layers @@ -373,9 +373,9 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & real(r8) :: fabi_lay(nlay,numrad) !layer absorption for diffuse beam real(r8) :: fabs_lay(0:4,numrad) !layer absorption for all five layers real(r8) :: fabs_leq(0:4,numrad) !layer absorption for all five layers - real(r8) :: A(6,6) !three-layer radiation transfer eqation (EQ. 19, Yuan et al., 2014) - real(r8) :: B(6,2) !three-layer radiation transfer eqation (EQ. 19, Yuan et al., 2014) - real(r8) :: X(6,2) !three-layer radiation transfer eqation (EQ. 19, Yuan et al., 2014) + real(r8) :: A(6,6) !three-layer radiation transfer equation (EQ. 19, Yuan et al., 2014) + real(r8) :: B(6,2) !three-layer radiation transfer equation (EQ. 19, Yuan et al., 2014) + real(r8) :: X(6,2) !three-layer radiation transfer equation (EQ. 19, Yuan et al., 2014) real(r8) :: fabsm !pft absorption for multiple reflections real(r8) :: faid_lay(nlay) !layer diffused absorption for direct beam real(r8) :: faid_p !pft absorption direct beam @@ -388,7 +388,7 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & real(r8) :: ftdd_lay(nlay) !unscattered layer transmission for direct beam real(r8) :: ftdi_lay(nlay) !unscattered layer transmission for indirect beam real(r8) :: ftdd_lay_orig(nlay) !unscattered layer transmission for direct beam without lad/crown_shape calibration - real(r8) :: ftdi_lay_orig(nlay) !unscattered layer transmission for indirect beam without lad/crown_shape calibratioin + real(r8) :: ftdi_lay_orig(nlay) !unscattered layer transmission for indirect beam without lad/crown_shape calibration real(r8) :: psun_lay(nlay) !percent sunlit vegetation cover for layers real(r8) :: fsun_id_lay(nlay) !frac of dif rad abs. by sunlit leaves incident dir for layers real(r8) :: fsun_ii_lay(nlay) !frac of dif rad abs. by sunlit leaves incident dif for layers @@ -407,10 +407,10 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & real(r8) :: fcai(ps:pe) !calibration factor for LAD for diffuse radiation real(r8) :: fcad_lay(nlay) !calibration factor for LAD for direct radiation real(r8) :: fcai_lay(nlay) !calibration factor for LAD for diffuse radiation - real(r8) :: pad !probabilty function for absorption after two scat - real(r8) :: pai !probabilty of asborption for diffuse incident beam + real(r8) :: pad !probability function for absorption after two scat + real(r8) :: pai !probability of absorption for diffuse incident beam real(r8) :: pfc !contribution of current pft in layer - real(r8) :: probm !prob photon reflect diffusly from grnd reach canopy + real(r8) :: probm !prob photon reflect diffusely from ground reach canopy real(r8) :: ref(0:nlay+1,0:nlay+1) !radiation reflected between five layers real(r8) :: fadd_lay(nlay,numrad) !layer absorbed flux in direct mode per unit direct flux real(r8) :: shad_oa(nlay,nlay) !shadow overlaps (direct beam) @@ -438,10 +438,10 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & real(r8) :: shadow_sky(ps:pe) !sky shadow area real(r8) :: taud(ps:pe) !transmission to direct beam real(r8) :: taui(ps:pe) !transmission to diffuse beam - real(r8) :: omega(ps:pe,numrad) !leaf/stem transmitance weighted by frac veg - real(r8) :: ftdi(ps:pe,numrad) !leaf/stem transmitance weighted by frac veg - real(r8) :: ftdd_orig(ps:pe,numrad) !leaf/stem transmitance weighted by frac veg - real(r8) :: ftdi_orig(ps:pe,numrad) !leaf/stem transmitance weighted by frac veg + real(r8) :: omega(ps:pe,numrad) !leaf/stem transmittance weighted by frac veg + real(r8) :: ftdi(ps:pe,numrad) !leaf/stem transmittance weighted by frac veg + real(r8) :: ftdd_orig(ps:pe,numrad) !leaf/stem transmittance weighted by frac veg + real(r8) :: ftdi_orig(ps:pe,numrad) !leaf/stem transmittance weighted by frac veg real(r8) :: cosz(ps:pe) !0.001 <= coszen <= 1.000 real(r8) :: cosd(ps:pe) !0.001 <= coszen <= 1.000 logical :: soilveg(ps:pe) !true if pft over soil with veg and cosz > 0 @@ -871,7 +871,7 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & albd_col(ib) = fabs_lay(4,1) albi_col(ib) = fabs_lay(4,2) - ! calculation for sunlit fraction and sunlit absorptioin for each layer + ! calculation for sunlit fraction and sunlit absorption for each layer IF (ib == 1) THEN !visible band only psun_lay(:) = D0 @@ -927,7 +927,7 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & ENDIF !==================================================== - ! Calculate individule PFT absorption + ! Calculate individual PFT absorption !==================================================== sum_fabd = D0 @@ -1146,7 +1146,7 @@ SUBROUTINE CanopyRad(tau_d, tau_i, ftdd, ftdi, cosz, cosd, & real(r8) :: lsai !elai+esai ! output variables - real(r8) :: phi_dif_d !differnce of rad scattered forward-backward per direct beam + real(r8) :: phi_dif_d !difference of rad scattered forward-backward per direct beam real(r8) :: phi_dif_i !difference of rad scattered forward-backward per direct beam real(r8) :: phi_tot_d !total rad scattered in all direction per direct beam real(r8) :: phi_tot_i !total rad scattered in all direction per diffuse beam @@ -1267,17 +1267,17 @@ SUBROUTINE phi(runmode, tau, omg, tau_p, rho_p, phi_tot, phi_dif, pa2) ! input variables logical :: runmode real(r8) :: omg !frac of intercepted rad that is scattered - real(r8) :: rho_p !leaf/stem reflectance weighted by fract of LAI and SAI + real(r8) :: rho_p !leaf/stem reflectance weighted by frac of LAI and SAI real(r8) :: tau !radial optical depth for direct beam real(r8) :: tau_p !leaf/stem transmission weighted by frac of LAI & SAI ! output variables - real(r8) :: phi_dif !differnce of rad scattered forward-backward + real(r8) :: phi_dif !difference of rad scattered forward-backward real(r8) :: phi_tot !total rad scattered in all direction real(r8) :: pa2 !total rad scattered in all direction ! local variables - real(r8) :: pac !probablity of absorption after two scatterings + real(r8) :: pac !probability of absorption after two scatterings real(r8) :: phi_1b !backward single scattered radiation real(r8) :: phi_1f !forward single scattered radiation real(r8) :: phi_2a !average second-order scattered radiation @@ -1312,7 +1312,7 @@ SUBROUTINE phi(runmode, tau, omg, tau_p, rho_p, phi_tot, phi_dif, pa2) phi_1b = DDH*(DD1 - tee(DD2*tau)) !---------------------------------------------------------------------- -! sphere double scattering terms (RED 2008 Eq 19,20) +! sphere double scattering terms (RED 2008 Eqs. 19,20) !---------------------------------------------------------------------- IF (.not. runmode) THEN @@ -1338,15 +1338,15 @@ SUBROUTINE phi(runmode, tau, omg, tau_p, rho_p, phi_tot, phi_dif, pa2) DD1/(bb+DD1)/(bb+DD1)*tee(DD1*(bb+DD2)*tau) ) ENDIF - ! second order avaerage scattering + ! second order average scattering phi_2a = DDH*(phi_2b + phi_2f) !---------------------------------------------------------------------- -! probabilty of absorption after two scattering +! probability of absorption after two scattering !---------------------------------------------------------------------- - ! probabilty of absorption for diffuse beam - ! corrected probabilty of absorption for direct beam + ! probability of absorption for diffuse beam + ! corrected probability of absorption for direct beam pac = DD1-phi_2a / & (DD1 - tee(DD1*tau) - (rho_p*phi_1b + tau_p*phi_1f)/(tau_p+rho_p)) diff --git a/main/MOD_Aerosol.F90 b/main/MOD_Aerosol.F90 index 47cfa579..90f5cf40 100644 --- a/main/MOD_Aerosol.F90 +++ b/main/MOD_Aerosol.F90 @@ -102,7 +102,7 @@ SUBROUTINE AerosolMasses( dtime ,snl ,do_capsnow ,& IF (.not. use_extrasnowlayers) THEN ! Correct the top layer aerosol mass to account for snow capping. ! This approach conserves the aerosol mass concentration - ! (but not the aerosol amss) when snow-capping is invoked + ! (but not the aerosol mass) when snow-capping is invoked IF (j == snl+1) THEN IF (do_capsnow) THEN @@ -171,7 +171,7 @@ SUBROUTINE AerosolFluxes( dtime, snl, forc_aer, & mss_dst1 ,mss_dst2 ,mss_dst3 ,mss_dst4 ) ! ! !DESCRIPTION: - ! Compute aerosol fluxes through snowpack and aerosol deposition fluxes into top layere + ! Compute aerosol fluxes through snowpack and aerosol deposition fluxes into top layer ! IMPLICIT NONE ! diff --git a/main/MOD_Albedo.F90 b/main/MOD_Albedo.F90 index db701c85..cb0d4864 100644 --- a/main/MOD_Albedo.F90 +++ b/main/MOD_Albedo.F90 @@ -44,32 +44,34 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& ! soil color and moisture in the surface soil layer ! (2) snow albedos: as in BATS formulations, which are inferred from ! the calculations of Wiscombe and Warren (1980) and the snow model -! and data of Anderson(1976), and the function of snow age, grain size, -! solar zenith angle, pollution, the amount of the fresh snow +! and data of Anderson(1976), and the function of snow age, grain +! size, solar zenith angle, pollution, the amount of the fresh snow ! (3) canopy albedo: two-stream approximation model -! (4) glacier albedos: as in BATS, which are set to constants (0.8 for visible beam, -! 0.55 for near-infrared) -! (5) lake and wetland albedos: as in BATS, which depend on cosine solar zenith angle, -! based on data in Henderson-Sellers (1986). The frozen lake and wetland albedos -! are set to constants (0.6 for visible beam, 0.4 for near-infrared) -! (6) over the snow covered tile, the surface albedo is estimated by a linear -! combination of albedos for snow, canopy and bare soil (or lake, wetland, glacier). +! (4) glacier albedos: as in BATS, which are set to constants (0.8 for +! visible beam, 0.55 for near-infrared) +! (5) lake and wetland albedos: as in BATS, which depend on cosine solar +! zenith angle, based on data in Henderson-Sellers (1986). The +! frozen lake and wetland albedos are set to constants (0.6 for +! visible beam, 0.4 for near-infrared) +! (6) over the snow covered tile, the surface albedo is estimated by a +! linear combination of albedos for snow, canopy and bare soil (or +! lake, wetland, glacier). ! ! Original author : Yongjiu Dai, 09/15/1999; 08/30/2002, 03/2014 ! ! !REVISIONS: -! 12/2019, Hua Yuan: added a wrap FUNCTION for PFT calculation, details see -! twostream_wrap() added a wrap FUNCTION for PC (3D) calculation, -! details see ThreeDCanopy_wrap() +! 12/2019, Hua Yuan: added a wrap FUNCTION for PFT calculation, details +! see twostream_wrap() added a wrap FUNCTION for PC (3D) +! calculation, details see ThreeDCanopy_wrap() ! ! 03/2020, Hua Yuan: added an improved two-stream model, details see ! twostream_mod() ! -! 08/2020, Hua Yuan: account for stem optical property effects in twostream -! model +! 08/2020, Hua Yuan: account for stem optical property effects in +! twostream model ! -! 01/2023, Hua Yuan: CALL SNICAR model to calculate snow albedo&absorption, -! added SNICAR related variables +! 01/2023, Hua Yuan: CALL SNICAR model to calculate snow +! albedo&absorption, added SNICAR related variables ! ! 04/2024, Hua Yuan: add option to account for vegetation snow process ! @@ -165,7 +167,7 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& real(r8) :: &! age, &! factor to reduce visible snow alb due to snow age [-] - albg0, &! temporary varaiable [-] + albg0, &! temporary variable [-] albsoi(2,2), &! soil albedo [-] albsno(2,2), &! snow albedo [-] albsno_pur(2,2), &! snow albedo [-] @@ -283,7 +285,7 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& ! ---------------------------------------------------------------------- ! Snow aging routine based on Flanner and Zender (2006), Linking snowpack ! microphysics and albedo evolution, JGR, and Brun (1989), Investigation of -! wet-snow metamorphism in respect of liquid-water content, Ann. Glaciol. +! wet-snow metamorphism in respect of liquid-water content, Ann. Glacial. CALL SnowAge_grain( deltim ,snl ,dz_soisno(:1) ,& pg_snow ,snwcp_ice ,snofrz ,& @@ -574,7 +576,7 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, fwet_snow, & integer iw ! band iterator !----------------------------------------------------------------------- -! projected area of phytoelements in direction of mu and +! projected area of photo elements in direction of mu and ! average inverse diffuse optical depth per unit leaf area phi1 = 0.5 - 0.633 * chil - 0.33 * chil * chil @@ -595,7 +597,7 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, fwet_snow, & zmu2 = zmu * zmu #if(defined LULC_USGS) - ! yuan: to be consistance with CoLM2014, no stem considered + ! yuan: to be consistent with CoLM2014, no stem considered ! for twostream and leaf optical property calculations sai_ = 0. #else @@ -829,7 +831,7 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, fwet_snow, & ! environmental variables real(r8), intent(in) :: & - coszen, &! consine of solar zenith angle + coszen, &! cosine of solar zenith angle albg(2,2) ! albedos of ground ! output @@ -899,7 +901,7 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, fwet_snow, & edw ! (integral of i_down*exp(-kx) ) ! vegetation snow optical properties - real(r8) :: upscat_sno = 0.5 !upscat parameter for snow + real(r8) :: upscat_sno = 0.5 !upscatter parameter for snow real(r8) :: beta0_sno = 0.5 !beta0 parameter for snow real(r8) :: scat_sno(2) !snow single scattering albedo data scat_sno(1), scat_sno(2) /0.6, 0.4/ ! 1:vis, 2: nir @@ -913,7 +915,7 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, fwet_snow, & real(r8) :: s2d, extkbd, sall(2,2), q, ssun_rev !----------------------------------------------------------------------- -! projected area of phytoelements in direction of mu and +! projected area of photo elements in direction of mu and ! average inverse diffuse optical depth per unit leaf area phi1 = 0.5 - 0.633 * chil - 0.33 * chil * chil @@ -1202,7 +1204,7 @@ SUBROUTINE twostream_wrap ( ipatch, coszen, albg, & ! environmental variables real(r8), intent(in) :: & - coszen, &! consine of solar zenith angle + coszen, &! cosine of solar zenith angle albg(2,2) ! albedos of ground ! output @@ -1308,12 +1310,12 @@ SUBROUTINE snowage ( deltim,tg,scv,scvold,sag ) IF(scv <= 0.) THEN sag = 0. ! -! Over antarctica +! Over Antarctica ! ELSE IF (scv > 800.) THEN sag = 0. ! -! Away from antarctica +! Away from Antarctica ! ELSE age3 = 0.3 @@ -1377,7 +1379,7 @@ SUBROUTINE SnowAlbedo( use_snicar_frc,use_snicar_ad ,coszen_col ,& IMPLICIT NONE !------------------------------------------------------------------------- -! temporay setting +! temporary setting integer, parameter :: numrad = 2 ! number of solar radiation bands: vis, nir integer, parameter :: sno_nbr_aer = 8 ! number of aerosol species in snowpack @@ -1977,7 +1979,7 @@ SUBROUTINE albocean (oro, scv, coszrs, alb) ! Approximation for Solar Radiation in the NCAR Community Climate Model, ! Journal of Geophysical Research, Vol 97, D7, pp7603-7612). ! -! yongjiu dai and xin-zhong liang (08/01/2001) +! Yongjiu Dai and Xin-Zhong Liang (08/01/2001) !----------------------------------------------------------------------- USE MOD_Precision diff --git a/main/MOD_AssimStomataConductance.F90 b/main/MOD_AssimStomataConductance.F90 index 184f39f6..7c0bc751 100644 --- a/main/MOD_AssimStomataConductance.F90 +++ b/main/MOD_AssimStomataConductance.F90 @@ -114,7 +114,7 @@ SUBROUTINE stomata (vmax25,effcon,slti,hlti,shti, & !End WUE stomata model parameter rb, &! boundary resistance from canopy to cas (s m-1) - ra, &! aerodynamic resistance from cas to refence height (s m-1) + ra, &! aerodynamic resistance from cas to reference height (s m-1) rstfac ! canopy resistance stress factors to soil moisture real(r8),intent(in), dimension(3) :: & @@ -148,11 +148,11 @@ SUBROUTINE stomata (vmax25,effcon,slti,hlti,shti, & atheta, &! wc, we coupling parameter btheta, &! wc & we, ws coupling parameter - omss, &! intermediate calcuation for oms + omss, &! intermediate calculation for oms omc, &! rubisco limited assimilation (omega-c: mol m-2 s-1) ome, &! light limited assimilation (omega-e: mol m-2 s-1) oms, &! sink limited assimilation (omega-s: mol m-2 s-1) - omp, &! intermediate calcuation for omc, ome + omp, &! intermediate calculation for omc, ome co2m, &! co2 concentration in atmos (mol mol-1) co2a, &! co2 concentration at cas (mol mol-1) @@ -309,7 +309,7 @@ SUBROUTINE stomata (vmax25,effcon,slti,hlti,shti, & pco2in = pco2i ! No need to iteratively solve pco2i for WUE model. ! Let pco2in = pco2i to exit loop. IF(pco2i .gt. pco2a)THEN - write(*,*) 'warning: pco2i greater than pco2a, use bb model' + write(*,*) 'warning: pco2i greater than pco2a, use bb model' ENDIF ELSE IF(DEF_USE_MEDLYNST)THEN @@ -765,9 +765,9 @@ END SUBROUTINE update_photosyn SUBROUTINE WUE_solver(gammas, lambda, co2a, ei, ea, psrf, pco2i_c, pco2i_e) !------------------------------------------------------------------------------------------- -! Solve internal co2 concentration for Rubisco limit and RuBP regeneration limit. +! Solve internal co2 concentration for Rubisco limit and RuBP regeneration limit. ! -! When Rubisco is limit (omc < ome), solve following equation (Liang et al., 2023, S18a) +! When Rubisco is limit (omc < ome), solve following equation (Liang et al., 2023, S18a) ! for pco2i_c: ! {1-(1.6*D)/[lambda*(gammas+rrkk)]} * co2i_c^2 & ! - {2*co2a+[1.6*D*(rrkk-gammas)]/[lambda*(gammas+rrkk)]-(1.6*D)/lambda} * co2i_c & @@ -804,10 +804,10 @@ SUBROUTINE WUE_solver(gammas, lambda, co2a, ei, ea, psrf, pco2i_c, pco2i_e) co2i_c = co2a - sqrt(1.6*D*(amax1(co2a-gammas/psrf,0._r8))/lambda) co2i_e = co2a - co2a / ( 1 + 1.37 * sqrt(lambda * gammas/psrf / D)) - + pco2i_c = co2i_c * psrf pco2i_e = co2i_e * psrf - + END SUBROUTINE WUE_solver END MODULE MOD_AssimStomataConductance diff --git a/main/MOD_Const_LC.F90 b/main/MOD_Const_LC.F90 index f3919161..ca5b5ea5 100644 --- a/main/MOD_Const_LC.F90 +++ b/main/MOD_Const_LC.F90 @@ -11,7 +11,7 @@ MODULE MOD_Const_LC ! !REVISIONS: ! Hua Yuan, 08/2019: initial version adapted from IniTimeConst.F90 of CoLM2014 ! Hua Yuan, 08/2019: added constants values for IGBP land cover types -! Xingjie Lu, 05/2023: added Plant Hydraulics Paramters +! Xingjie Lu, 05/2023: added Plant Hydraulics Parameters ! ! !USES: USE MOD_Precision @@ -109,13 +109,13 @@ MODULE MOD_Const_LC 0.010, -0.300, 0.250, 0.010, 0.100, 0.010, 0.125, -0.300,& -0.300, 0.100, 0.010, -0.300, -0.300, -0.300, -0.300, -0.300/) - ! reflectance of green leaf in virsible band + ! reflectance of green leaf in visible band real(r8), parameter, dimension(N_land_classification) :: rhol_vis_usgs & = (/0.105, 0.105, 0.105, 0.105, 0.105, 0.105, 0.105, 0.100,& 0.100, 0.105, 0.100, 0.070, 0.100, 0.070, 0.070, 0.105,& 0.105, 0.100, 0.100, 0.105, 0.105, 0.105, 0.105, 0.105/) - ! reflectance of dead leaf in virsible band + ! reflectance of dead leaf in visible band real(r8), parameter, dimension(N_land_classification) :: rhos_vis_usgs & = (/0.360, 0.360, 0.360, 0.360, 0.360, 0.360, 0.360, 0.160,& 0.160, 0.360, 0.160, 0.160, 0.160, 0.160, 0.160, 0.360,& @@ -258,7 +258,7 @@ MODULE MOD_Const_LC 2.012, 1.964, 1.955, 1.953, 1.303, 2.175, 1.631, 2.608,& 2.608, 1.631, 8.992, 8.992, 8.992, 8.992, 0.978, 2.608/) -! Plant Hydraulics Paramters +! Plant Hydraulics Parameters real(r8), parameter, dimension(N_land_classification) :: kmax_sun0_usgs & = (/ 0., 2.e-008, 2.e-008, 2.e-008, 2.e-008, 2.e-008,& 2.e-008, 2.e-008, 2.e-008, 2.e-008, 2.e-008, 2.e-008,& @@ -402,13 +402,13 @@ MODULE MOD_Const_LC 0.010, -0.300, 0.100, -0.300, 0.010, -0.300, 0.010, 0.010,& 0.010 /) - ! reflectance of green leaf in virsible band + ! reflectance of green leaf in visible band real(r8), parameter, dimension(N_land_classification) :: rhol_vis_igbp & = (/0.070, 0.100, 0.070, 0.100, 0.070, 0.105, 0.105, 0.105,& 0.105, 0.105, 0.105, 0.105, 0.105, 0.105, 0.105, 0.105,& 0.105 /) - ! reflectance of dead leaf in virsible band + ! reflectance of dead leaf in visible band real(r8), parameter, dimension(N_land_classification) :: rhos_vis_igbp & = (/0.160, 0.160, 0.160, 0.160, 0.160, 0.160, 0.160, 0.160,& 0.160, 0.360, 0.160, 0.360, 0.160, 0.360, 0.160, 0.160,& @@ -548,7 +548,7 @@ MODULE MOD_Const_LC 1.627, 2.608, 2.608, 2.614, 2.614, 2.614, 2.608, 0.978,& 2.608 /) -! Plant Hydraulics Paramters +! Plant Hydraulics Parameters real(r8), parameter, dimension(N_land_classification) :: kmax_sun0_igbp & = (/2.e-008, 2.e-008, 2.e-008, 2.e-008, 2.e-008, 2.e-008, & 2.e-008, 2.e-008, 2.e-008, 2.e-008, 2.e-008, 2.e-008, & @@ -641,10 +641,10 @@ MODULE MOD_Const_LC ! Plant Hydraulic Parameters real(r8), dimension(N_land_classification) :: & - kmax_sun, &! Plant Hydraulics Paramters (TODO@Xingjie Lu, please give more details and below) - kmax_sha, &! Plant Hydraulics Paramters - kmax_xyl, &! Plant Hydraulics Paramters - kmax_root, &! Plant Hydraulics Paramters + kmax_sun, &! Plant Hydraulics Parameters (TODO@Xingjie Lu, please give more details and below) + kmax_sha, &! Plant Hydraulics Parameters + kmax_xyl, &! Plant Hydraulics Parameters + kmax_root, &! Plant Hydraulics Parameters psi50_sun, &! water potential at 50% loss of sunlit leaf tissue conductance (mmH2O) psi50_sha, &! water potential at 50% loss of shaded leaf tissue conductance (mmH2O) psi50_xyl, &! water potential at 50% loss of xylem tissue conductance (mmH2O) diff --git a/main/MOD_Const_PFT.F90 b/main/MOD_Const_PFT.F90 index cfe76f01..3197f517 100644 --- a/main/MOD_Const_PFT.F90 +++ b/main/MOD_Const_PFT.F90 @@ -155,7 +155,7 @@ MODULE MOD_Const_PFT #endif /) - ! defulat vegetation fractional cover + ! default vegetation fractional cover real(r8), parameter :: fveg0_p(0:N_PFT+N_CFT-1) & = 1.0 !(/.../) @@ -200,7 +200,7 @@ MODULE MOD_Const_PFT #endif /) - ! reflectance of green leaf in virsible band + ! reflectance of green leaf in visible band #if(defined LULC_IGBP_PC) ! Leaf optical properties adapted from measured data (Dong et al., 2021) real(r8), parameter :: rhol_vis_p(0:N_PFT+N_CFT-1) & @@ -223,7 +223,7 @@ MODULE MOD_Const_PFT #endif /) - ! reflectance of dead leaf in virsible band + ! reflectance of dead leaf in visible band real(r8), parameter :: rhos_vis_p(0:N_PFT+N_CFT-1) & = (/0.310, 0.160, 0.160, 0.160, 0.160, 0.160, 0.160, 0.160& , 0.160, 0.160, 0.160, 0.160, 0.310, 0.310, 0.310, 0.310& @@ -280,7 +280,7 @@ MODULE MOD_Const_PFT ! transmittance of green leaf in visible band #if(defined LULC_IGBP_PC) - ! Leaf optical properties adpated from measured data (Dong et al., 2021) + ! Leaf optical properties adapted from measured data (Dong et al., 2021) real(r8), parameter :: taul_vis_p(0:N_PFT+N_CFT-1) & = (/0.050, 0.050, 0.050, 0.050, 0.050, 0.060, 0.050, 0.060& , 0.050, 0.050, 0.050, 0.050, 0.050, 0.050, 0.050, 0.050& @@ -1478,7 +1478,7 @@ MODULE MOD_Const_PFT #endif ! end bgc variables -! Plant Hydraulics Paramters +! Plant Hydraulics Parameters real(r8), parameter :: kmax_sun_p(0:N_PFT+N_CFT-1) & = (/ 0.,1.e-007,1.e-007,1.e-007,1.e-007,1.e-007,1.e-007,1.e-007& ,1.e-007,1.e-007,1.e-007,1.e-007,1.e-007,1.e-007,1.e-007,1.e-007& @@ -1619,7 +1619,7 @@ MODULE MOD_Const_PFT /) !end plant hydraulic parameters - ! Temporarilly tune Vegetation parameter to match VGM model (soil too wet) + ! Temporally tune Vegetation parameter to match VGM model (soil too wet) #ifdef vanGenuchten_Mualem_SOIL_MODEL real(r8), parameter :: lambda_p(0:N_PFT+N_CFT-1) & = (/1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000.& @@ -1653,7 +1653,7 @@ MODULE MOD_Const_PFT #endif ! irrigation parameter for irrigated crop logical , parameter :: irrig_crop(0:N_PFT+N_CFT-1) & ! True => is tropical broadleaf evergreen tree - =(/.False., .False., .False., .False., .False., .False., .False., .False. & + =(/.False., .False., .False., .False., .False., .False., .False., .False. & , .False., .False., .False., .False., .False., .False., .False., .False. & #ifdef CROP , .True., .False., .True., .False., .True., .False., .True., .False. & diff --git a/main/MOD_FireData.F90 b/main/MOD_FireData.F90 index 74671fbc..69da8611 100644 --- a/main/MOD_FireData.F90 +++ b/main/MOD_FireData.F90 @@ -26,7 +26,7 @@ MODULE MOD_FireData SUBROUTINE init_fire_data (YY) !---------------------- - ! DESCTIPTION: + ! DESCRIPTION: ! open fire netcdf file from DEF_dir_runtime, read latitude and longitude info. ! Initialize fire data read in. diff --git a/main/MOD_Forcing.F90 b/main/MOD_Forcing.F90 index 53babd29..04f9e285 100644 --- a/main/MOD_Forcing.F90 +++ b/main/MOD_Forcing.F90 @@ -93,8 +93,8 @@ MODULE MOD_Forcing #endif type(block_data_real8_2d), allocatable :: forcn (:) ! forcing data - type(block_data_real8_2d), allocatable :: forcn_LB (:) ! forcing data at lower bondary - type(block_data_real8_2d), allocatable :: forcn_UB (:) ! forcing data at upper bondary + type(block_data_real8_2d), allocatable :: forcn_LB (:) ! forcing data at lower boundary + type(block_data_real8_2d), allocatable :: forcn_UB (:) ! forcing data at upper boundary PUBLIC :: forcing_init PUBLIC :: read_forcing @@ -446,7 +446,7 @@ SUBROUTINE read_forcing (idate, dir_forcing) write(6, *) "the data required is out of range! STOP!"; CALL CoLM_stop() ENDIF - ! calcualte distance to lower/upper boundary + ! calculate distance to lower/upper boundary dtLB = mtstamp - tstamp_LB(ivar) dtUB = tstamp_UB(ivar) - mtstamp @@ -487,8 +487,8 @@ SUBROUTINE read_forcing (idate, dir_forcing) calday = calendarday(mtstamp) cosz = orb_coszen(calday, gforc%rlon(ilon), gforc%rlat(ilat)) cosz = max(0.001, cosz) - ! 10/24/2024, yuan: deal with time log with backward or foreward - IF (trim(timelog(ivar)) == 'foreward') THEN + ! 10/24/2024, yuan: deal with time log with backward or forward + IF (trim(timelog(ivar)) == 'forward') THEN forcn(ivar)%blk(ib,jb)%val(i,j) = & cosz / avgcos%blk(ib,jb)%val(i,j) * forcn_LB(ivar)%blk(ib,jb)%val(i,j) ELSE @@ -1314,7 +1314,7 @@ SUBROUTINE setstampLB(mtstamp, var_i, year, month, mday, time_i) ! in the case of one year one file IF ( trim(groupby) == 'year' ) THEN - ! calculate the intitial second + ! calculate the initial second sec = 86400*(day-1) + sec time_i = floor( (sec-offset(var_i)) *1. / dtime(var_i) ) + 1 sec = (time_i-1)*dtime(var_i) + offset(var_i) - 86400*(day-1) @@ -1337,7 +1337,7 @@ SUBROUTINE setstampLB(mtstamp, var_i, year, month, mday, time_i) ! set record info (year, time_i) IF ( sec<0 .or. (sec==0 .and. offset(var_i).NE.0) ) THEN - ! IF the required dada just behind the first record + ! IF the required data just behind the first record ! -> set to the first record IF ( year==startyr .and. month==startmo .and. day==1 ) THEN sec = offset(var_i) @@ -1357,7 +1357,7 @@ SUBROUTINE setstampLB(mtstamp, var_i, year, month, mday, time_i) ENDIF ENDIF ! ENDIF (sec <= 0) - ! in case of leapyear with a non-leayyear calendar + ! in case of leapyear with a non-leapyear calendar ! USE the data 1 day before after FEB 28th (Julian day 59). IF ( .not. leapyear .and. isleapyear(year) .and. day>59 ) THEN day = day - 1 @@ -1427,7 +1427,7 @@ SUBROUTINE setstampLB(mtstamp, var_i, year, month, mday, time_i) ENDIF ENDIF - ! in case of leapyear with a non-leayyear calendar + ! in case of leapyear with a non-leapyear calendar ! USE the data 1 day before, i.e., FEB 28th. IF ( .not. leapyear .and. isleapyear(year) .and. month==2 .and. mday==29 ) THEN mday = 28 @@ -1472,7 +1472,7 @@ SUBROUTINE setstampLB(mtstamp, var_i, year, month, mday, time_i) ENDIF ENDIF - ! in case of leapyear with a non-leayyear calendar + ! in case of leapyear with a non-leapyear calendar ! USE the data 1 day before, i.e., FEB 28th. IF ( .not. leapyear .and. isleapyear(year) .and. month==2 .and. mday==29 ) THEN mday = 28 @@ -1533,7 +1533,7 @@ SUBROUTINE setstampUB(var_i, year, month, mday, time_i) tstamp_UB(var_i) = tstamp_UB(var_i) + dtime(var_i) ENDIF - ! calcualte initial year, day, and second values + ! calculate initial year, day, and second values year = tstamp_UB(var_i)%year day = tstamp_UB(var_i)%day sec = tstamp_UB(var_i)%sec @@ -1552,7 +1552,7 @@ SUBROUTINE setstampUB(var_i, year, month, mday, time_i) ENDIF ENDIF - ! in case of leapyear with a non-leayyear calendar + ! in case of leapyear with a non-leapyear calendar ! USE the data 1 day before after FEB 28th (Julian day 59). IF ( .not. leapyear .and. isleapyear(year) .and. day>59 ) THEN day = day - 1 @@ -1592,7 +1592,7 @@ SUBROUTINE setstampUB(var_i, year, month, mday, time_i) ENDIF ENDIF - ! in case of leapyear with a non-leayyear calendar + ! in case of leapyear with a non-leapyear calendar ! for day 29th Feb, USE the data 1 day before, i.e., 28th FEB. IF ( .not. leapyear .and. isleapyear(year) .and. month==2 .and. mday==29 ) THEN mday = 28 @@ -1632,7 +1632,7 @@ SUBROUTINE setstampUB(var_i, year, month, mday, time_i) ENDIF ENDIF - ! in case of leapyear with a non-leayyear calendar + ! in case of leapyear with a non-leapyear calendar ! for day 29th Feb, USE the data 1 day before, i.e., 28th FEB. IF ( .not. leapyear .and. isleapyear(year) .and. month==2 .and. mday==29 ) THEN mday = 28 @@ -1652,7 +1652,7 @@ END SUBROUTINE setstampUB ! ------------------------------------------------------------ ! !DESCRIPTION: -! calculate time average coszen value bwteeen [LB, UB] +! calculate time average coszen value between [LB, UB] ! ! REVISIONS: ! 04/2014, yuan: this method is adapted from CLM diff --git a/main/MOD_ForcingDownscaling.F90 b/main/MOD_ForcingDownscaling.F90 index 193a336c..3e5f3bb0 100644 --- a/main/MOD_ForcingDownscaling.F90 +++ b/main/MOD_ForcingDownscaling.F90 @@ -4,7 +4,7 @@ MODULE MOD_ForcingDownscaling !----------------------------------------------------------------------------- ! DESCRIPTION: -! Downscaling meteorological forcings +! Downscaling meteorological forcings ! ! INITIAL: ! The Community Land Model version 5.0 (CLM5.0) @@ -46,7 +46,7 @@ MODULE MOD_ForcingDownscaling SAVE ! PUBLIC MEMBER FUNCTIONS: - PUBLIC :: downscale_forcings ! Downscale atmospheric forcing + PUBLIC :: downscale_forcings ! Downscale atmospheric forcing ! PRIVATE MEMBER FUNCTIONS: PRIVATE :: rhos ! calculate atmospheric density @@ -58,20 +58,20 @@ MODULE MOD_ForcingDownscaling !----------------------------------------------------------------------------- PURE FUNCTION rhos(qbot, pbot, tbot) - + !----------------------------------------------------------------------------- ! DESCRIPTION: ! Compute atmospheric density (kg/m**3) !----------------------------------------------------------------------------- IMPLICIT NONE - + ! ARGUMENTS: real(r8) :: rhos ! function result: atmospheric density (kg/m**3) real(r8), intent(in) :: qbot ! atmospheric specific humidity (kg/kg) real(r8), intent(in) :: pbot ! atmospheric pressure (Pa) real(r8), intent(in) :: tbot ! atmospheric temperature (K) - + ! LOCAL VARIABLES: real(r8) :: egcm real(r8) :: wv_to_dair_weight_ratio ! ratio of molecular weight of water vapor to that of dry air [-] @@ -84,7 +84,7 @@ PURE FUNCTION rhos(qbot, pbot, tbot) END FUNCTION rhos !----------------------------------------------------------------------------- - + SUBROUTINE downscale_forcings (& glaciers, & @@ -94,7 +94,7 @@ SUBROUTINE downscale_forcings (& forc_hgt_g ,forc_swrad_g ,forc_us_g ,forc_vs_g , & ! topography-based factor on patch - slp_type_c, asp_type_c, area_type_c, svf_c, cur_c, & + slp_type_c, asp_type_c, area_type_c, svf_c, cur_c, & #ifdef SinglePoint sf_lut_c, & #else @@ -103,7 +103,7 @@ SUBROUTINE downscale_forcings (& ! other factors julian_day, coszen, cosazi, alb, & - + ! adjusted forcing forc_topo_c ,forc_t_c ,forc_th_c ,forc_q_c ,forc_pbot_c ,& forc_rho_c ,forc_prc_c ,forc_prl_c ,forc_lwrad_c, forc_swrad_c, & @@ -111,7 +111,7 @@ SUBROUTINE downscale_forcings (& !----------------------------------------------------------------------------- ! DESCRIPTION: -! Downscale atmospheric forcing fields. +! Downscale atmospheric forcing fields. ! ! Downscaling is done based on the difference between each land model column's elevation and ! the atmosphere's surface elevation (which is the elevation at which the atmospheric @@ -124,14 +124,14 @@ SUBROUTINE downscale_forcings (& IMPLICIT NONE - integer, parameter :: S = 1370 ! solar constant (W/m**2) + integer, parameter :: S = 1370 ! solar constant (W/m**2) real(r8), parameter :: thr = 85*PI/180 ! threshold of zenith angle ! ARGUMENTS: logical, intent(in) :: glaciers ! true: glacier column (itypwat = 3) real(r8), intent(in) :: julian_day ! day of year real(r8), intent(in) :: coszen ! cosine of sun zenith angle at an hour - real(r8), intent(in) :: cosazi ! cosine of sun azimuth angle at an hour + real(r8), intent(in) :: cosazi ! cosine of sun azimuth angle at an hour real(r8), intent(in) :: alb ! blue sky albedo ! topography-based factor @@ -176,7 +176,7 @@ SUBROUTINE downscale_forcings (& real(r8), intent(out) :: forc_us_c ! column eastward wind [m/s] real(r8), intent(out) :: forc_vs_c ! column northward wind [m/s] - ! Local variables for topo downscaling: + ! Local variables for topo downscaling: real(r8) :: hsurf_g, hsurf_c real(r8) :: Hbot, zbot real(r8) :: tbot_g, pbot_g, thbot_g, qbot_g, qs_g, es_g, rhos_g @@ -233,7 +233,7 @@ SUBROUTINE downscale_forcings (& ! save forc_t_c = tbot_c forc_th_c = thbot_c - forc_q_c = qbot_c + forc_q_c = qbot_c forc_pbot_c = pbot_c forc_rho_c = rhos_c @@ -319,8 +319,8 @@ SUBROUTINE downscale_wind(forc_us_g, forc_vs_g, & IMPLICIT NONE ! ARGUMENTS: - real(r8), intent(inout) :: forc_us_g ! eastward wind (m/s) - real(r8), intent(inout) :: forc_vs_g ! northward wind (m/s) + real(r8), intent(inout) :: forc_us_g ! eastward wind (m/s) + real(r8), intent(inout) :: forc_vs_g ! northward wind (m/s) real(r8), intent(in) :: cur_c ! curvature real(r8), intent(in) :: asp_type_c (1:num_slope_type) ! topographic aspect of each character of one patch @@ -353,7 +353,7 @@ SUBROUTINE downscale_wind(forc_us_g, forc_vs_g, & wind_dir_slp(i) = slp_type_c(i)*cos(wind_dir-asp_type_c(i)) ENDDO - ! compute wind speed ajustment + ! compute wind speed adjustment DO i = 1, num_slope_type scale_factor = (1+(0.58*wind_dir_slp(i))+0.42*cur_c) ! Limiting the scope of proportionality adjustments @@ -386,7 +386,7 @@ SUBROUTINE downscale_longwave (glaciers, & IMPLICIT NONE ! ARGUMENTS: - logical, intent(in) :: glaciers ! true: glacier column + logical, intent(in) :: glaciers ! true: glacier column real(r8), intent(in) :: forc_topo_g ! atmospheric surface height (m) real(r8), intent(in) :: forc_t_g ! atmospheric temperature [Kelvin] @@ -483,15 +483,15 @@ SUBROUTINE downscale_shortwave( & sf_curve_c, & #endif area_type_c) - + !----------------------------------------------------------------------------- ! DESCRIPTION: ! -! Rouf, T., Mei, Y., Maggioni, V., Houser, P., & Noonan, M. (2020). A Physically Based -! Atmospheric Variables Downscaling Technique. Journal of Hydrometeorology, +! Rouf, T., Mei, Y., Maggioni, V., Houser, P., & Noonan, M. (2020). A Physically Based +! Atmospheric Variables Downscaling Technique. Journal of Hydrometeorology, ! 21(1), 93–108. https://doi.org/10.1175/JHM-D-19-0109.1 -! -! Sisi Chen, Lu Li, Yongjiu Dai, et al. Exploring Topography Downscaling Methods for +! +! Sisi Chen, Lu Li, Yongjiu Dai, et al. Exploring Topography Downscaling Methods for ! Hyper-Resolution Land Surface Modeling. Authorea. April 25, 2024. ! DOI: 10.22541/au.171403656.68476353/v1 ! @@ -507,23 +507,23 @@ SUBROUTINE downscale_shortwave( & ! ARGUMENTS: real(r8), intent(in) :: julian_day ! day of year real(r8), intent(in) :: coszen ! zenith angle at an hour - real(r8), intent(in) :: cosazi ! azimuth angle at an hour + real(r8), intent(in) :: cosazi ! azimuth angle at an hour real(r8), intent(in) :: alb ! blue sky albedo - real(r8), intent(in) :: forc_topo_g ! atmospheric surface height (m) - real(r8), intent(in) :: forc_pbot_g ! atmospheric pressure [Pa] - real(r8), intent(in) :: forc_swrad_g ! downward shortwave (W/m**2) - - real(r8), intent(in) :: forc_topo_c ! column surface height (m) - real(r8), intent(in) :: forc_pbot_c ! atmospheric pressure [Pa] - real(r8), intent(out):: forc_swrad_c ! downward shortwave (W/m**2) + real(r8), intent(in) :: forc_topo_g ! atmospheric surface height (m) + real(r8), intent(in) :: forc_pbot_g ! atmospheric pressure [Pa] + real(r8), intent(in) :: forc_swrad_g ! downward shortwave (W/m**2) + + real(r8), intent(in) :: forc_topo_c ! column surface height (m) + real(r8), intent(in) :: forc_pbot_c ! atmospheric pressure [Pa] + real(r8), intent(out):: forc_swrad_c ! downward shortwave (W/m**2) real(r8), intent(in) :: svf_c ! sky view factor -#ifdef SinglePoint - real(r8), intent(in) :: sf_lut_c (1:num_azimuth,1:num_zenith) ! look up table of shadow mask of a patch -#else - real(r8), intent(in) :: sf_curve_c (1:num_azimuth,1:num_zenith_parameter) ! curve of shadow mask of a patch -#endif +# ifdef SinglePoint + real(r8), intent(in) :: sf_lut_c (1:num_azimuth,1:num_zenith) ! look up table of shadow mask of a patch +# else + real(r8), intent(in) :: sf_curve_c (1:num_azimuth,1:num_zenith_parameter) ! curve of shadow mask of a patch +# endif real(r8), intent(in) :: asp_type_c (1:num_slope_type) ! topographic aspect of each character of one patch (°) real(r8), intent(in) :: slp_type_c (1:num_slope_type) ! topographic slope of each character of one patch real(r8), intent(in) :: area_type_c(1:num_slope_type) ! area percentage of each character of one patch @@ -535,14 +535,14 @@ SUBROUTINE downscale_shortwave( & real(r8) :: rt_R ! The ratio of the current distance between the sun and the earth ! to the average distance between the sun and the earth real(r8) :: toa_swrad ! top of atmosphere shortwave radiation real(r8) :: clr_idx ! atmospheric transparency - real(r8) :: diff_wgt ! diffuse weight + real(r8) :: diff_wgt ! diffuse weight real(r8) :: k_c ! column broadband attenuation coefficient [Pa^-1] real(r8) :: opt_factor ! optical length factor real(r8) :: a_p real(r8) :: svf, balb real(r8) :: diff_swrad_g, beam_swrad_g ! diffuse and beam radiation - real(r8) :: diff_swrad_c, beam_swrad_c, refl_swrad_c! downscaled diffuse, beam radiation and reflect radiation + real(r8) :: diff_swrad_c, beam_swrad_c, refl_swrad_c! downscaled diffuse, beam radiation and reflect radiation real(r8) :: beam_swrad_type (1:num_slope_type) ! beam radiation of one characterized patch real(r8) :: refl_swrad_type (1:num_slope_type) ! reflect radiation of one characterized patch real(r8) :: tcf_type (1:num_slope_type) ! terrain configure factor @@ -553,8 +553,8 @@ SUBROUTINE downscale_shortwave( & integer :: i !----------------------------------------------------------------------------- - - ! calculate shadow factor according to sun zenith and azimuth angle + + ! calculate shadow factor according to sun zenith and azimuth angle zen_rad = acos(coszen) azi_rad = acos(cosazi) azi_deg = azi_rad*180.0/PI ! turn deg @@ -571,7 +571,7 @@ SUBROUTINE downscale_shortwave( & sf_c = sf_lut_c(idx_azi, idx_zen) #else - ! Constructing a shadow factor function from zenith angle parameters + ! Constructing a shadow factor function from zenith angle parameters ! shadow factor = exp(-1*exp(a1*zenith+a2)) zenith_segment = sf_curve_c(idx_azi, 1) ! Segmented function segmentation points (rad) a1 = sf_curve_c(idx_azi, 2) ! parameter of function @@ -581,7 +581,7 @@ SUBROUTINE downscale_shortwave( & sf_c = 1. ELSE IF (a1<=1e-10) THEN sf_c = 1. - ELSE + ELSE sf_c = exp(-1*exp(min(a1*zen_rad+a2,3.5))) ENDIF #endif @@ -592,7 +592,7 @@ SUBROUTINE downscale_shortwave( & ! calculate top-of-atmosphere incident shortwave radiation rt_R = 1-0.01672*cos(0.9856*(julian_day-4)) toa_swrad = S*(rt_R**2)*coszen - + ! calculate clearness index IF (toa_swrad.eq.0) THEN clr_idx = 0 @@ -602,9 +602,9 @@ SUBROUTINE downscale_shortwave( & IF (clr_idx>1) clr_idx = 1 ! calculate diffuse weight - ! Ruiz-Arias, J. A., Alsamamra, H., Tovar-Pescador, J., & Pozo-Vázquez, D. (2010). - ! Proposal of a regressive model for the hourly diffuse solar radiation under all sky - ! conditions. Energy Conversion and Management, 51(5), 881–893. + ! Ruiz-Arias, J. A., Alsamamra, H., Tovar-Pescador, J., & Pozo-Vázquez, D. (2010). + ! Proposal of a regressive model for the hourly diffuse solar radiation under all sky + ! conditions. Energy Conversion and Management, 51(5), 881–893. ! https://doi.org/10.1016/j.enconman.2009.11.024 diff_wgt = 0.952-1.041*exp(-1*exp(min(2.3-4.702*clr_idx,3.5))) IF (diff_wgt>1) diff_wgt = 1 @@ -614,7 +614,7 @@ SUBROUTINE downscale_shortwave( & diff_swrad_g = forc_swrad_g*diff_wgt beam_swrad_g = forc_swrad_g*(1-diff_wgt) - ! calcualte broadband attenuation coefficient [Pa^-1] + ! calculate broadband attenuation coefficient [Pa^-1] IF (clr_idx.le.0) THEN k_c = 0 ELSE @@ -631,8 +631,8 @@ SUBROUTINE downscale_shortwave( & ! loop for four defined types to downscale beam radiation DO i = 1, num_slope_type - ! calculate the cosine of solar illumination angle, cos(θ), - ! ranging between −1 and 1, indicates if the sun is below or + ! calculate the cosine of solar illumination angle, cos(θ), + ! ranging between −1 and 1, indicates if the sun is below or ! above the local horizon (note that values lower than 0 are set to 0 indicate self shadow) cosill_type(i) = cos(slp_type_c(i))+tan(zen_rad)*sin(slp_type_c(i))*cos(asp_type_c(i)) IF (cosill_type(i)>1) cosill_type(i) = 1 @@ -657,7 +657,7 @@ SUBROUTINE downscale_shortwave( & DO i = 1, num_slope_type tcf_type(i) = (1+cos(slp_type_c(i)))/2-svf IF (tcf_type(i)<0) tcf_type(i) = 0 - + IF (isnan_ud(alb)) THEN refl_swrad_type(i) = -1.0e36 ELSE diff --git a/main/MOD_FrictionVelocity.F90 b/main/MOD_FrictionVelocity.F90 index 07af961f..e54119ac 100644 --- a/main/MOD_FrictionVelocity.F90 +++ b/main/MOD_FrictionVelocity.F90 @@ -26,7 +26,7 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& ! ====================================================================== ! Original author : Yongjiu Dai, September 15, 1999 ! -! calculation of friction velocity, relation for potential temperatur +! calculation of friction velocity, relation for potential temperature ! and humidity profiles of surface boundary layer. ! the scheme is based on the work of Zeng et al. (1998): ! Intercomparison of bulk aerodynamic algorithms for the computation @@ -47,7 +47,7 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& real(r8), intent(in) :: z0h ! roughness length, sensible heat [m] real(r8), intent(in) :: z0q ! roughness length, latent heat [m] real(r8), intent(in) :: obu ! monin-obukhov length (m) - real(r8), intent(in) :: um ! wind speed including the stablity effect [m/s] + real(r8), intent(in) :: um ! wind speed including the stability effect [m/s] real(r8), intent(out) :: ustar ! friction velocity [m/s] real(r8), intent(out) :: fh2m ! relation for temperature at 2m @@ -59,7 +59,7 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& !------------------------ local variables ------------------------------ - real(r8) zldis ! reference height "minus" zero displacement heght [m] + real(r8) zldis ! reference height "minus" zero displacement height [m] real(r8) zetam ! transition point of flux-gradient relation (wind profile) real(r8) zetat ! transition point of flux-gradient relation (temp. profile) real(r8) zeta ! dimensionless height used in Monin-Obukhov theory @@ -79,7 +79,7 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fm = log(zldis/z0m) - psi(1,zeta) + psi(1,z0m/obu) ustar = vonkar*um / fm - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fm = log(zldis/z0m) + 5.*zeta - 5.*z0m/obu ustar = vonkar*um / fm ELSE ! 1 < zeta, phi=5+zeta @@ -96,7 +96,7 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& + psi(1,z0m/obu) + 1.14*((-zeta)**0.333-(zetam)**0.333) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fm10m = log(zldis/z0m) - psi(1,zeta) + psi(1,z0m/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fm10m = log(zldis/z0m) + 5.*zeta - 5.*z0m/obu ELSE ! 1 < zeta, phi=5+zeta fm10m = log(obu/z0m) + 5. - 5.*z0m/obu + (5.*log(zeta)+zeta-1.) @@ -111,7 +111,7 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fh = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fh = log(zldis/z0h) + 5.*zeta - 5.*z0h/obu ELSE ! 1 < zeta, phi=5+zeta fh = log(obu/z0h) + 5. - 5.*z0h/obu + (5.*log(zeta)+zeta-1.) @@ -126,7 +126,7 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fh2m = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fh2m = log(zldis/z0h) + 5.*zeta - 5.*z0h/obu ELSE ! 1 < zeta, phi=5+zeta fh2m = log(obu/z0h) + 5. - 5.*z0h/obu + (5.*log(zeta)+zeta-1.) @@ -141,7 +141,7 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& + psi(2,z0q/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fq = log(zldis/z0q) - psi(2,zeta) + psi(2,z0q/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fq = log(zldis/z0q) + 5.*zeta - 5.*z0q/obu ELSE ! 1 < zeta, phi=5+zeta fq = log(obu/z0q) + 5. - 5.*z0q/obu + (5.*log(zeta)+zeta-1.) @@ -175,7 +175,7 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& ! ! Original author : Yongjiu Dai, September 15, 1999 ! -! calculation of friction velocity, relation for potential temperatur +! calculation of friction velocity, relation for potential temperature ! and humidity profiles of surface boundary layer. ! the scheme is based on the work of Zeng et al. (1998): ! Intercomparison of bulk aerodynamic algorithms for the computation @@ -203,7 +203,7 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& real(r8), intent(in) :: z0mt ! roughness length of the top layer, latent heat [m] real(r8), intent(in) :: htop ! canopy top height of the top layer [m] real(r8), intent(in) :: obu ! monin-obukhov length (m) - real(r8), intent(in) :: um ! wind speed including the stablity effect [m/s] + real(r8), intent(in) :: um ! wind speed including the stability effect [m/s] real(r8), intent(out) :: ustar ! friction velocity [m/s] real(r8), intent(out) :: fh2m ! relation for temperature at 2m @@ -218,7 +218,7 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& !------------------------ local variables ------------------------------ - real(r8) zldis ! reference height "minus" zero displacement heght [m] + real(r8) zldis ! reference height "minus" zero displacement height [m] real(r8) zetam ! transition point of flux-gradient relation (wind profile) real(r8) zetat ! transition point of flux-gradient relation (temp. profile) real(r8) zeta ! dimensionless height used in Monin-Obukhov theory @@ -238,7 +238,7 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fm = log(zldis/z0m) - psi(1,zeta) + psi(1,z0m/obu) ustar = vonkar*um / fm - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fm = log(zldis/z0m) + 5.*zeta - 5.*z0m/obu ustar = vonkar*um / fm ELSE ! 1 < zeta, phi=5+zeta @@ -256,7 +256,7 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& + psi(1,z0m/obu) + 1.14*((-zeta)**0.333-(zetam)**0.333) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fmtop = log(zldis/z0m) - psi(1,zeta) + psi(1,z0m/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fmtop = log(zldis/z0m) + 5.*zeta - 5.*z0m/obu ELSE ! 1 < zeta, phi=5+zeta fmtop = log(obu/z0m) + 5. - 5.*z0m/obu + (5.*log(zeta)+zeta-1.) @@ -271,7 +271,7 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fh = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fh = log(zldis/z0h) + 5.*zeta - 5.*z0h/obu ELSE ! 1 < zeta, phi=5+zeta fh = log(obu/z0h) + 5. - 5.*z0h/obu + (5.*log(zeta)+zeta-1.) @@ -286,7 +286,7 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fh2m = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fh2m = log(zldis/z0h) + 5.*zeta - 5.*z0h/obu ELSE ! 1 < zeta, phi=5+zeta fh2m = log(obu/z0h) + 5. - 5.*z0h/obu + (5.*log(zeta)+zeta-1.) @@ -301,7 +301,7 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fht = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fht = log(zldis/z0h) + 5.*zeta - 5.*z0h/obu ELSE ! 1 < zeta, phi=5+zeta fht = log(obu/z0h) + 5. - 5.*z0h/obu + (5.*log(zeta)+zeta-1.) @@ -316,7 +316,7 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& phih = 0.9*vonkar**(1.333)*(-zeta)**(-0.333) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 phih = (1. - 16.*zeta)**(-0.5) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 phih = 1. + 5.*zeta ELSE ! 1 < zeta, phi=5+zeta phih = 5. + zeta @@ -331,7 +331,7 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& + psi(2,z0q/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fq = log(zldis/z0q) - psi(2,zeta) + psi(2,z0q/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fq = log(zldis/z0q) + 5.*zeta - 5.*z0q/obu ELSE ! 1 < zeta, phi=5+zeta fq = log(obu/z0q) + 5. - 5.*z0q/obu + (5.*log(zeta)+zeta-1.) @@ -390,7 +390,7 @@ real(r8) FUNCTION kmoninobuk(displa,obu,ustar,z) !------------------------ local variables ------------------------------ - real(r8) zldis ! reference height "minus" zero displacement heght [m] + real(r8) zldis ! reference height "minus" zero displacement height [m] real(r8) zetam ! transition point of flux-gradient relation (wind profile) real(r8) zetat ! transition point of flux-gradient relation (temp. profile) real(r8) zeta ! dimensionless height used in Monin-Obukhov theory @@ -409,7 +409,7 @@ real(r8) FUNCTION kmoninobuk(displa,obu,ustar,z) phih = 0.9*vonkar**(1.333)*(-zeta)**(-0.333) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 phih = (1. - 16.*zeta)**(-0.5) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 phih = 1. + 5.*zeta ELSE ! 1 < zeta, phi=5+zeta phih = 5. + zeta @@ -443,7 +443,7 @@ real(r8) FUNCTION kintmoninobuk(displa,z0h,obu,ustar,ztop,zbot) !------------------------ local variables ------------------------------ - real(r8) zldis ! reference height "minus" zero displacement heght [m] + real(r8) zldis ! reference height "minus" zero displacement height [m] real(r8) zetam ! transition point of flux-gradient relation (wind profile) real(r8) zetat ! transition point of flux-gradient relation (temp. profile) real(r8) zeta ! dimensionless height used in Monin-Obukhov theory @@ -458,7 +458,7 @@ real(r8) FUNCTION kintmoninobuk(displa,z0h,obu,ustar,ztop,zbot) + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fh_top = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fh_top = log(zldis/z0h) + 5.*zeta - 5.*z0h/obu ELSE ! 1 < zeta, phi=5+zeta fh_top = log(obu/z0h) + 5. - 5.*z0h/obu + (5.*log(zeta)+zeta-1.) @@ -472,7 +472,7 @@ real(r8) FUNCTION kintmoninobuk(displa,z0h,obu,ustar,ztop,zbot) + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fh_bot = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fh_bot = log(zldis/z0h) + 5.*zeta - 5.*z0h/obu ELSE ! 1 < zeta, phi=5+zeta fh_bot = log(obu/z0h) + 5. - 5.*z0h/obu + (5.*log(zeta)+zeta-1.) @@ -488,7 +488,7 @@ SUBROUTINE moninobukini(ur,th,thm,thv,dth,dqh,dthv,zldis,z0m,um,obu) ! ====================================================================== ! Original author : Yongjiu Dai, September 15, 1999 ! -! initialzation of Monin-Obukhov length, +! initialization of Monin-Obukhov length, ! the scheme is based on the work of Zeng et al. (1998): ! Intercomparison of bulk aerodynamic algorithms for the computation ! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, Vol. 11: 2628-2644 @@ -506,10 +506,10 @@ SUBROUTINE moninobukini(ur,th,thm,thv,dth,dqh,dthv,zldis,z0m,um,obu) real(r8), intent(in) :: dth ! diff of virtual temp. between ref. height and surface real(r8), intent(in) :: dthv ! diff of vir. poten. temp. between ref. height and surface real(r8), intent(in) :: dqh ! diff of humidity between ref. height and surface - real(r8), intent(in) :: zldis ! reference height "minus" zero displacement heght [m] + real(r8), intent(in) :: zldis ! reference height "minus" zero displacement height [m] real(r8), intent(in) :: z0m ! roughness length, momentum [m] - real(r8), intent(out) :: um ! wind speed including the stablity effect [m/s] + real(r8), intent(out) :: um ! wind speed including the stability effect [m/s] real(r8), intent(out) :: obu ! monin-obukhov length (m) ! Local diff --git a/main/MOD_Glacier.F90 b/main/MOD_Glacier.F90 index 3557997d..83426692 100644 --- a/main/MOD_Glacier.F90 +++ b/main/MOD_Glacier.F90 @@ -114,7 +114,7 @@ SUBROUTINE GLACIER_TEMP (patchtype, lb ,nl_ice ,deltim ,& ! State variable (1) fsno, &! fraction of ground covered by snow - dz_icesno(lb:nl_ice), &! layer thickiness [m] + dz_icesno(lb:nl_ice), &! layer thickness [m] z_icesno (lb:nl_ice), &! node depth [m] zi_icesno(lb-1:nl_ice) ! interface depth [m] @@ -125,7 +125,7 @@ SUBROUTINE GLACIER_TEMP (patchtype, lb ,nl_ice ,deltim ,& real(r8), intent(inout) :: & t_icesno(lb:nl_ice), &! snow/ice temperature [K] wice_icesno(lb:nl_ice),&! ice lens [kg/m2] - wliq_icesno(lb:nl_ice),&! liqui water [kg/m2] + wliq_icesno(lb:nl_ice),&! liquid water [kg/m2] scv, &! snow cover, water equivalent [mm, kg/m2] snowdp ! snow depth [m] @@ -181,7 +181,7 @@ SUBROUTINE GLACIER_TEMP (patchtype, lb ,nl_ice ,deltim ,& egsmax, &! max. evaporation which ice can provide at one time step egidif, &! the excess of evaporation over "egsmax" emg, &! ground emissivity (0.96) - errore, &! energy balnce error [w/m2] + errore, &! energy balance error [w/m2] fact(lb:nl_ice), &! used in computing tridiagonal matrix htvp, &! latent heat of vapor of water (or sublimation) [j/kg] qg, &! ground specific humidity [kg/kg] @@ -208,11 +208,11 @@ SUBROUTINE GLACIER_TEMP (patchtype, lb ,nl_ice ,deltim ,& ! emissivity emg = 0.97 - ! latent heat, assumed that the sublimation occured only as wliq_icesno=0 + ! latent heat, assumed that the sublimation occurs only as wliq_icesno=0 htvp = hvap IF(wliq_icesno(lb)<=0. .and. wice_icesno(lb)>0.) htvp = hsub - ! potential temperatur at the reference height + ! potential temperature at the reference height thm = forc_t + 0.0098*forc_hgt_t ! intermediate variable equivalent to ! forc_t*(pgcm/forc_psrf)**(rgas/cpair) th = forc_t*(100000./forc_psrf)**(rgas/cpair) ! potential T @@ -243,7 +243,7 @@ SUBROUTINE GLACIER_TEMP (patchtype, lb ,nl_ice ,deltim ,& z0m,zol,rib,ustar,qstar,tstar,fm,fh,fq) !======================================================================= -! [4] Gound temperature +! [4] Ground temperature !======================================================================= CALL groundtem_glacier (patchtype,lb,nl_ice,deltim,& @@ -274,7 +274,7 @@ SUBROUTINE GLACIER_TEMP (patchtype, lb ,nl_ice ,deltim ,& ! total fluxes to atmosphere fsena = fseng fevpa = fevpg - lfevpa= htvp*fevpg ! W/m^2 (accouting for sublimation) + lfevpa= htvp*fevpg ! W/m^2 (accounting for sublimation) qseva = 0. qsubl = 0. @@ -421,7 +421,7 @@ SUBROUTINE groundfluxes_glacier (zlnd,zsno,hu,ht,hq,& nmozsgn ! number of times moz changes sign real(r8) :: & - beta, &! coefficient of conective velocity [-] + beta, &! coefficient of convective velocity [-] displax, &! zero-displacement height [m] dth, &! diff of virtual temp. between ref. height and surface dqh, &! diff of humidity between ref. height and surface @@ -437,12 +437,12 @@ SUBROUTINE groundfluxes_glacier (zlnd,zsno,hu,ht,hq,& fq2m, &! relation for specific humidity at 2m fm10m, &! integral of profile FUNCTION for momentum at 10m thvstar, &! virtual potential temperature scaling parameter - um, &! wind speed including the stablity effect [m/s] + um, &! wind speed including the stability effect [m/s] wc, &! convective velocity [m/s] wc2, &! wc**2 zeta, &! dimensionless height used in Monin-Obukhov theory zii, &! convective boundary height [m] - zldis, &! reference height "minus" zero displacement heght [m] + zldis, &! reference height "minus" zero displacement height [m] z0mg, &! roughness length over ground, momentum [m] z0hg, &! roughness length over ground, sensible heat [m] z0qg ! roughness length over ground, latent heat [m] @@ -461,7 +461,7 @@ SUBROUTINE groundfluxes_glacier (zlnd,zsno,hu,ht,hq,& z0qg = z0mg ENDIF -! potential temperatur at the reference height +! potential temperature at the reference height beta = 1. ! - (in computing W_*) zii = 1000. ! m (pbl height) z0m = z0mg @@ -531,7 +531,7 @@ SUBROUTINE groundfluxes_glacier (zlnd,zsno,hu,ht,hq,& ENDDO ITERATION ! END stability iteration !---------------------------------------------------------------- -! Get derivative of fluxes with repect to ground temperature +! Get derivative of fluxes with respect to ground temperature ram = 1./(ustar*ustar/um) rah = 1./(vonkar/fh*ustar) raw = 1./(vonkar/fq*ustar) @@ -590,7 +590,7 @@ SUBROUTINE groundtem_glacier (patchtype,lb,nl_ice,deltim,& ! Original author : Yongjiu Dai, /05/2014/ ! ! REVISIONS: -! Hua Yuan, 01/2023: account for snow layer absorptioin (SNICAR) in ground heat +! Hua Yuan, 01/2023: account for snow layer absorption (SNICAR) in ground heat ! flux, temperature and melt calculation. !======================================================================= @@ -602,15 +602,15 @@ SUBROUTINE groundtem_glacier (patchtype,lb,nl_ice,deltim,& IMPLICIT NONE - integer, intent(in) :: patchtype ! land patch type (0=soil, 1=urban and built-up, - ! 2=wetland, 3=land ice, 4=land water bodies, 99 = ocean) + integer, intent(in) :: patchtype ! land patch type (0=soil, 1=urban and built-up, + ! 2=wetland, 3=land ice, 4=land water bodies, 99 = ocean) integer, intent(in) :: lb !lower bound of array integer, intent(in) :: nl_ice !upper bound of array real(r8), intent(in) :: deltim !seconds in a time step [second] real(r8), intent(in) :: capr !tuning factor to turn first layer T into surface T real(r8), intent(in) :: cnfac !Crank Nicholson factor between 0 and 1 - real(r8), intent(in) :: dz_icesno(lb:nl_ice) !layer thickiness [m] + real(r8), intent(in) :: dz_icesno(lb:nl_ice) !layer thickness [m] real(r8), intent(in) :: z_icesno (lb:nl_ice) !node depth [m] real(r8), intent(in) :: zi_icesno(lb-1:nl_ice) !interface depth [m] @@ -621,15 +621,15 @@ SUBROUTINE groundtem_glacier (patchtype,lb,nl_ice,deltim,& real(r8), intent(in) :: cgrnd !deriv. of ice energy flux wrt to ice temp [W/m2/k] real(r8), intent(in) :: htvp !latent heat of vapor of water (or sublimation) [J/kg] real(r8), intent(in) :: emg !ground emissivity (0.97 for snow, - real(r8), intent(in) :: t_precip ! snowfall/rainfall temperature [kelvin] - real(r8), intent(in) :: pg_rain ! rainfall [kg/(m2 s)] - real(r8), intent(in) :: pg_snow ! snowfall [kg/(m2 s)] + real(r8), intent(in) :: t_precip !snowfall/rainfall temperature [kelvin] + real(r8), intent(in) :: pg_rain !rainfall [kg/(m2 s)] + real(r8), intent(in) :: pg_snow !snowfall [kg/(m2 s)] real(r8), intent(in) :: sabg_snow_lyr (lb:1) !snow layer absorption [W/m-2] real(r8), intent(inout) :: t_icesno (lb:nl_ice) !snow and ice temperature [K] real(r8), intent(inout) :: wice_icesno(lb:nl_ice) !ice lens [kg/m2] - real(r8), intent(inout) :: wliq_icesno(lb:nl_ice) !liqui water [kg/m2] + real(r8), intent(inout) :: wliq_icesno(lb:nl_ice) !liquid water [kg/m2] real(r8), intent(inout) :: scv !snow cover, water equivalent [mm, kg/m2] real(r8), intent(inout) :: snowdp !snow depth [m] @@ -641,7 +641,7 @@ SUBROUTINE groundtem_glacier (patchtype,lb,nl_ice,deltim,& real(r8), intent(out) :: snofrz(lb:0) !snow freezing rate (lyr) [kg m-2 s-1] !------------------------ local variables ------------------------------ - real(r8) rhosnow ! partitial density of water (ice + liquid) + real(r8) rhosnow ! partial density of water (ice + liquid) real(r8) cv(lb:nl_ice) ! heat capacity [J/(m2 K)] real(r8) thk(lb:nl_ice) ! thermal conductivity of layer real(r8) tk(lb:nl_ice) ! thermal conductivity [W/(m K)] @@ -660,7 +660,7 @@ SUBROUTINE groundtem_glacier (patchtype,lb,nl_ice,deltim,& real(r8) wice_icesno_bef(lb:0) ! ice lens [kg/m2] real(r8) hs ! net energy flux into the surface (w/m2) real(r8) dhsdt ! d(hs)/dT - real(r8) brr(lb:nl_ice) ! temporay set + real(r8) brr(lb:nl_ice) ! temporary set integer i,j @@ -719,10 +719,10 @@ SUBROUTINE groundtem_glacier (patchtype,lb,nl_ice,deltim,& ! the following consideration is try to avoid the snow conductivity ! to be dominant in the thermal conductivity of the interface. -! Because when the distance of bottom snow node to the interfacee +! Because when the distance of bottom snow node to the interface ! is larger than that of interface to top ice node, ! the snow thermal conductivity will be dominant, and the result is that -! lees heat tranfer between snow and ice +! lees heat transfer between snow and ice IF((j==0) .and. (z_icesno(j+1)-zi_icesno(j) 0; urban and built-up => 1; wetland => 2; land ice => 3; ! land water bodies => 4; ocean => 99] ! -------------------------------------------------------------------- @@ -3857,7 +3857,7 @@ SUBROUTINE hist_out (idate, deltim, itstamp, etstamp, ptstamp, & CALL write_history_variable_ln ( DEF_hist_vars%srniln, & a_srniln, file_hist, 'f_srniln', itime_in_file, sumarea, filter, & 'reflected diffuse beam nir solar radiation at local noon(W/m2)','W/m2') - + IF ((p_is_worker) .and. (numpatch > 0)) THEN filter = (patchtype == 0) .and. patchmask diff --git a/main/MOD_HistWriteBack.F90 b/main/MOD_HistWriteBack.F90 index 921ad04b..4120a984 100644 --- a/main/MOD_HistWriteBack.F90 +++ b/main/MOD_HistWriteBack.F90 @@ -46,7 +46,7 @@ MODULE MOD_HistWriteBack ! dimension information logical :: SDimInited = .false. ! 1: grid-based; 2: catchment based; 3: unstructered - integer :: SDimType + integer :: SDimType ! 1: grid-based integer :: nGridData, nxGridSeg, nyGridSeg @@ -57,15 +57,15 @@ MODULE MOD_HistWriteBack real(r8), allocatable :: lat_c(:), lat_s(:), lat_n(:) real(r8), allocatable :: lon_c(:), lon_w(:), lon_e(:) - ! 2: catchment based; 3: unstructured - ! integer :: SDimLength + ! 2: catchment based; 3: unstructured + ! integer :: SDimLength ! integer*8, allocatable :: vindex1(:) ! integer, allocatable :: vindex2(:) ! Memory limits - integer*8, parameter :: MaxHistMemSize = 8589934592_8 ! 8*1024^3 - integer*8, parameter :: MaxHistMesgSize = 8388608_8 ! 8*1024^2 - + integer*8, parameter :: MaxHistMemSize = 8589934592_8 ! 8*1024^3 + integer*8, parameter :: MaxHistMesgSize = 8388608_8 ! 8*1024^2 + integer*8 :: TotalMemSize = 0 integer :: itime_in_file @@ -92,7 +92,7 @@ SUBROUTINE hist_writeback_daemon () integer :: recvint4 (5) character(len=256) :: recvchar (9) real(r8), allocatable :: datathis (:) - + character(len=256) :: filename, dataname, longname, units character(len=256) :: dim1name, dim2name, dim3name, dim4name, dim5name logical :: fexists @@ -110,21 +110,21 @@ SUBROUTINE hist_writeback_daemon () EXIT ELSEIF (dataid == 0) THEN - + CALL mpi_recv (filename, 256, MPI_CHARACTER, & MPI_ANY_SOURCE, tag_time, p_comm_glb_plus, p_stat, p_err) CALL mpi_recv (dataname, 256, MPI_CHARACTER, & MPI_ANY_SOURCE, tag_time, p_comm_glb_plus, p_stat, p_err) - + CALL mpi_recv (time, 3, MPI_INTEGER, & MPI_ANY_SOURCE, tag_time, p_comm_glb_plus, p_stat, p_err) IF (.not. SDimInited) THEN - + CALL mpi_recv (SDimType, 1, MPI_INTEGER, & MPI_ANY_SOURCE, tag_dims, p_comm_glb_plus, p_stat, p_err) - + IF (SDimType == 1) THEN CALL mpi_recv (nGridData, 1, MPI_INTEGER, & @@ -133,12 +133,12 @@ SUBROUTINE hist_writeback_daemon () MPI_ANY_SOURCE, tag_dims, p_comm_glb_plus, p_stat, p_err) CALL mpi_recv (nyGridSeg, 1, MPI_INTEGER, & MPI_ANY_SOURCE, tag_dims, p_comm_glb_plus, p_stat, p_err) - + allocate (xGridDsp (nxGridSeg)) allocate (xGridCnt (nxGridSeg)) allocate (yGridDsp (nyGridSeg)) allocate (yGridCnt (nyGridSeg)) - + CALL mpi_recv (xGridDsp, nxGridSeg, MPI_INTEGER, & MPI_ANY_SOURCE, tag_dims, p_comm_glb_plus, p_stat, p_err) CALL mpi_recv (xGridCnt, nxGridSeg, MPI_INTEGER, & @@ -168,7 +168,7 @@ SUBROUTINE hist_writeback_daemon () allocate(lon_c(nlon)) allocate(lon_w(nlon)) allocate(lon_e(nlon)) - + CALL mpi_recv (lon_c, nlon, MPI_REAL8, & MPI_ANY_SOURCE, tag_dims, p_comm_glb_plus, p_stat, p_err) CALL mpi_recv (lon_w, nlon, MPI_REAL8, & @@ -181,16 +181,16 @@ SUBROUTINE hist_writeback_daemon () SDimInited = .true. ENDIF - + inquire (file=filename, exist=fexists) IF (.not. fexists) THEN - + CALL ncio_create_file (trim(filename)) - + CALL ncio_define_dimension(filename, 'time', 0) - + IF (SDimType == 1) THEN - + CALL ncio_define_dimension(filename, 'lat', nlat) CALL ncio_define_dimension(filename, 'lon', nlon) @@ -211,13 +211,13 @@ SUBROUTINE hist_writeback_daemon () CALL ncio_write_colm_dimension (filename) ENDIF - + CALL ncio_write_time (filename, dataname, time, itime_in_file, DEF_HIST_FREQ) ELSE !-------------------------------- - ! reveive and write history data. + ! receive and write history data. !-------------------------------- ! (1) data header @@ -232,7 +232,7 @@ SUBROUTINE hist_writeback_daemon () MPI_ANY_SOURCE, tag, p_comm_glb_plus, p_stat, p_err) filename = recvchar(1) - dataname = recvchar(2) + dataname = recvchar(2) dim1name = recvchar(3) dim2name = recvchar(4) dim3name = recvchar(5) @@ -241,7 +241,7 @@ SUBROUTINE hist_writeback_daemon () longname = recvchar(8) units = recvchar(9) - ! (2) data + ! (2) data tag = dataid*10+1 IF (SDimType == 1) THEN @@ -256,8 +256,8 @@ SUBROUTINE hist_writeback_daemon () ndim1 = recvint4(4) ndim2 = recvint4(5) - xdsp = xGridDsp(ixseg) - ydsp = yGridDsp(iyseg) + xdsp = xGridDsp(ixseg) + ydsp = yGridDsp(iyseg) xcnt = xGridCnt(ixseg) ycnt = yGridCnt(iyseg) @@ -311,7 +311,7 @@ SUBROUTINE hist_writeback_daemon () deallocate (datathis) - ENDDO + ENDDO ENDIF @@ -366,7 +366,7 @@ SUBROUTINE hist_writeback_daemon () ' (time ', itime_in_file, '): ', trim(dataname) ENDIF - + ENDDO END SUBROUTINE hist_writeback_daemon @@ -377,7 +377,7 @@ SUBROUTINE hist_writeback_latlon_time (filename, timename, time, HistConcat) USE MOD_Namelist USE MOD_Grid IMPLICIT NONE - + character (len=*), intent(in) :: filename character (len=*), intent(in) :: timename integer, intent(in) :: time(3) @@ -393,7 +393,7 @@ SUBROUTINE hist_writeback_latlon_time (filename, timename, time, HistConcat) CALL mpi_isend (lasttime%filename, 256, MPI_CHARACTER, & p_address_writeback, tag_time, p_comm_glb_plus, lasttime%req(1), p_err) - + CALL mpi_isend (lasttime%timename, 256, MPI_CHARACTER, & p_address_writeback, tag_time, p_comm_glb_plus, lasttime%req(2), p_err) @@ -408,7 +408,7 @@ SUBROUTINE hist_writeback_latlon_time (filename, timename, time, HistConcat) nGridData = HistConcat%ndatablk nxGridSeg = HistConcat%nxseg - nyGridSeg = HistConcat%nyseg + nyGridSeg = HistConcat%nyseg allocate (xGridDsp (nxGridSeg)) allocate (xGridCnt (nxGridSeg)) @@ -428,7 +428,7 @@ SUBROUTINE hist_writeback_latlon_time (filename, timename, time, HistConcat) CALL mpi_send (nGridData, 1, MPI_INTEGER, p_address_writeback, tag_dims, p_comm_glb_plus, p_err) CALL mpi_send (nxGridSeg, 1, MPI_INTEGER, p_address_writeback, tag_dims, p_comm_glb_plus, p_err) CALL mpi_send (nyGridSeg, 1, MPI_INTEGER, p_address_writeback, tag_dims, p_comm_glb_plus, p_err) - + CALL mpi_send (xGridDsp, nxGridSeg, MPI_INTEGER, p_address_writeback, tag_dims, p_comm_glb_plus, p_err) CALL mpi_send (xGridCnt, nxGridSeg, MPI_INTEGER, p_address_writeback, tag_dims, p_comm_glb_plus, p_err) CALL mpi_send (yGridDsp, nyGridSeg, MPI_INTEGER, p_address_writeback, tag_dims, p_comm_glb_plus, p_err) @@ -482,23 +482,23 @@ SUBROUTINE hist_writeback_append_timenodes (filename, timename, time) lasttime%time = time lasttime%next => null() - END SUBROUTINE hist_writeback_append_timenodes + END SUBROUTINE hist_writeback_append_timenodes ! ----- SUBROUTINE hist_writeback_clean_timenodes IMPLICIT NONE - + ! Local Variables logical :: senddone integer :: stat(MPI_STATUS_SIZE,3) type(timenodetype), pointer :: tempnode - + DO WHILE (associated(timenodes%next)) CALL MPI_TestAll (3, timenodes%req, senddone, stat, p_err) - + IF (senddone) THEN tempnode => timenodes timenodes => timenodes%next @@ -514,7 +514,7 @@ END SUBROUTINE hist_writeback_clean_timenodes SUBROUTINE hist_writeback_var_header (dataid, filename, dataname, & ndims, dim1name, dim2name, dim3name, dim4name, dim5name, & compress, longname, units) - + IMPLICIT NONE integer, intent(in) :: dataid @@ -539,14 +539,14 @@ SUBROUTINE hist_writeback_var_header (dataid, filename, dataname, & ENDIF LastSendBuffer%next => null() - + ! clean sending buffer and free memory DO WHILE (associated(HistSendBuffer%next)) CALL MPI_Testall (3, HistSendBuffer%sendreqs, senddone, sendstat, p_err) - + IF (senddone) THEN - + TempSendBuffer => HistSendBuffer HistSendBuffer => HistSendBuffer%next @@ -561,7 +561,7 @@ SUBROUTINE hist_writeback_var_header (dataid, filename, dataname, & LastSendBuffer%dataid = dataid LastSendBuffer%datatag = dataid*10 - + LastSendBuffer%sendint4(1:2) = (/ndims, compress/) LastSendBuffer%sendchar(1) = filename @@ -573,10 +573,10 @@ SUBROUTINE hist_writeback_var_header (dataid, filename, dataname, & LastSendBuffer%sendchar(7) = dim5name LastSendBuffer%sendchar(8) = longname LastSendBuffer%sendchar(9) = units - + CALL mpi_isend (LastSendBuffer%dataid, 1, MPI_INTEGER, & p_address_writeback, tag_next, p_comm_glb_plus, LastSendBuffer%sendreqs(1), p_err) - + CALL mpi_isend (LastSendBuffer%sendint4(1:2), 2, MPI_INTEGER, & p_address_writeback, LastSendBuffer%datatag, p_comm_glb_plus, LastSendBuffer%sendreqs(2), p_err) @@ -588,7 +588,7 @@ END SUBROUTINE hist_writeback_var_header ! ----- SUBROUTINE hist_writeback_var ( dataid, ixseg, iyseg, & wdata1d, wdata2d, wdata3d, wdata4d) - + IMPLICIT NONE integer, intent(in) :: dataid, ixseg, iyseg @@ -611,14 +611,14 @@ SUBROUTINE hist_writeback_var ( dataid, ixseg, iyseg, & allocate (LastSendBuffer%next) LastSendBuffer => LastSendBuffer%next ENDIF - + LastSendBuffer%next => null() - + ! clean sending buffer and free memory DO WHILE ((TotalMemSize > MaxHistMemSize) .and. associated(HistSendBuffer%next)) CALL MPI_Waitall (2, HistSendBuffer%sendreqs(1:2), p_stat, p_err) - + TotalMemSize = TotalMemSize - size(HistSendBuffer%senddata) TempSendBuffer => HistSendBuffer @@ -634,13 +634,13 @@ SUBROUTINE hist_writeback_var ( dataid, ixseg, iyseg, & ndim2 = 0 IF (present(wdata1d)) THEN - + totalsize = size(wdata1d) allocate(LastSendBuffer%senddata(totalsize)) LastSendBuffer%senddata = wdata1d ELSEIF (present(wdata2d)) THEN - + totalsize = size(wdata2d) allocate(LastSendBuffer%senddata(totalsize)) LastSendBuffer%senddata = reshape(wdata2d, (/totalsize/)) @@ -651,7 +651,7 @@ SUBROUTINE hist_writeback_var ( dataid, ixseg, iyseg, & totalsize = size(wdata3d) allocate(LastSendBuffer%senddata(totalsize)) LastSendBuffer%senddata = reshape(wdata3d, (/totalsize/)) - + ELSEIF (present(wdata4d)) THEN ndim1 = size(wdata4d,1) @@ -659,9 +659,9 @@ SUBROUTINE hist_writeback_var ( dataid, ixseg, iyseg, & totalsize = size(wdata4d) allocate(LastSendBuffer%senddata(totalsize)) LastSendBuffer%senddata = reshape(wdata4d, (/totalsize/)) - + ENDIF - + TotalMemSize = TotalMemSize + totalsize LastSendBuffer%sendint4(1:5) = (/p_iam_glb_plus, ixseg, iyseg, ndim1, ndim2/) @@ -678,7 +678,7 @@ END SUBROUTINE hist_writeback_var SUBROUTINE hist_writeback_exit () IMPLICIT NONE - + ! Local Variables integer :: dataid, nreq type(timenodetype), pointer :: tempnode @@ -688,7 +688,7 @@ SUBROUTINE hist_writeback_exit () DO WHILE (associated(timenodes)) CALL MPI_WaitAll (3, timenodes%req, p_stat, p_err) - + tempnode => timenodes timenodes => timenodes%next deallocate(tempnode) @@ -696,18 +696,18 @@ SUBROUTINE hist_writeback_exit () LastSendBuffer => null() DO WHILE (associated(HistSendBuffer)) - + IF (allocated(HistSendBuffer%senddata)) THEN CALL MPI_Waitall (2, HistSendBuffer%sendreqs(1:2), p_stat, p_err) deallocate(HistSendBuffer%senddata) ELSE CALL MPI_Waitall (3, HistSendBuffer%sendreqs(1:3), p_stat, p_err) ENDIF - + TempSendBuffer => HistSendBuffer HistSendBuffer => HistSendBuffer%next deallocate (TempSendBuffer) - + ENDDO IF (allocated(xGridDsp)) deallocate(xGridDsp) @@ -720,8 +720,8 @@ SUBROUTINE hist_writeback_exit () IF (allocated(lon_c )) deallocate(lon_c ) IF (allocated(lon_w )) deallocate(lon_w ) IF (allocated(lon_e )) deallocate(lon_e ) - - + + IF (.not. p_is_writeback) THEN CALL mpi_barrier (p_comm_glb, p_err) ENDIF @@ -730,21 +730,21 @@ SUBROUTINE hist_writeback_exit () dataid = -1 CALL mpi_send (dataid, 1, MPI_INTEGER, p_address_writeback, tag_next, p_comm_glb_plus, p_err) ENDIF - + CALL mpi_barrier (p_comm_glb_plus, p_err) END SUBROUTINE hist_writeback_exit ! ---- character(len=256) FUNCTION basename (fullname) - + IMPLICIT NONE character(len=*), intent(in) :: fullname ! Local variables integer :: i, n - i = len_trim (fullname) + i = len_trim (fullname) DO WHILE (i > 0) IF (fullname(i:i) == '/') EXIT i = i - 1 diff --git a/main/MOD_Lake.F90 b/main/MOD_Lake.F90 index 3e2ef6e5..879f9460 100644 --- a/main/MOD_Lake.F90 +++ b/main/MOD_Lake.F90 @@ -224,14 +224,14 @@ SUBROUTINE newsnow_lake ( USE_Dynamic_Lake, & lake_icefrac(1) = 1.0 ENDIF ENDIF - + IF (USE_Dynamic_Lake .and. (snl == 0)) THEN - + wliq_lake(1) = dz_lake(1) * (1-lake_icefrac(1)) + pg_rain*deltim*1.e-3 - wice_lake(1) = dz_lake(1) * lake_icefrac(1) + wice_lake(1) = dz_lake(1) * lake_icefrac(1) dz_lake(1) = wliq_lake(1) + wice_lake(1) lake_icefrac(1) = wice_lake(1) / dz_lake(1) - + CALL adjust_lake_layer (nl_lake, dz_lake, t_lake, lake_icefrac) ENDIF @@ -487,7 +487,7 @@ SUBROUTINE laketem (& real(r8) dthv ! diff of vir. poten. temp. between ref. height and surface real(r8) dzsur ! 1/2 the top layer thickness (m) real(r8) tsur ! top layer temperature - real(r8) rhosnow ! partitial density of water (ice + liquid) + real(r8) rhosnow ! partial density of water (ice + liquid) real(r8) eg ! water vapor pressure at temperature T [pa] real(r8) emg ! ground emissivity (0.97 for snow, real(r8) errore ! lake temperature energy conservation error (w/m**2) @@ -512,14 +512,14 @@ SUBROUTINE laketem (& real(r8) thv ! virtual potential temperature (kelvin) real(r8) thvstar ! virtual potential temperature scaling parameter real(r8) tksur ! thermal conductivity of snow/soil (w/m/kelvin) - real(r8) um ! wind speed including the stablity effect [m/s] + real(r8) um ! wind speed including the stability effect [m/s] real(r8) ur ! wind speed at reference height [m/s] real(r8) visa ! kinematic viscosity of dry air [m2/s] real(r8) wc ! convective velocity [m/s] real(r8) wc2 ! wc*wc real(r8) zeta ! dimensionless height used in Monin-Obukhov theory real(r8) zii ! convective boundary height [m] - real(r8) zldis ! reference height "minus" zero displacement heght [m] + real(r8) zldis ! reference height "minus" zero displacement height [m] real(r8) z0mg ! roughness length over ground, momentum [m] real(r8) z0hg ! roughness length over ground, sensible heat [m] real(r8) z0qg ! roughness length over ground, latent heat [m] @@ -527,7 +527,7 @@ SUBROUTINE laketem (& real(r8) wliq_lake(nl_lake) ! lake liquid water (kg/m2) real(r8) wice_lake(nl_lake) ! lake ice lens (kg/m2) real(r8) vf_water(1:nl_soil) ! volumetric fraction liquid water within underlying soil - real(r8) vf_ice(1:nl_soil) ! volumetric fraction ice len within underlying soil + real(r8) vf_ice(1:nl_soil) ! volumetric fraction ice lens within underlying soil real(r8) fgrnd1 ! ground heat flux into the first snow/lake layer [W/m2] @@ -695,7 +695,7 @@ SUBROUTINE laketem (& ! ====================================================================== -!*[2] pre-processing for the calcilation of the surface temperature and fluxes +!*[2] pre-processing for the calculation of the surface temperature and fluxes ! ====================================================================== IF (.not. DEF_USE_SNICAR .or. present(urban_call)) THEN @@ -710,7 +710,7 @@ SUBROUTINE laketem (& betaprime = betaprime + (1.0-betaprime)*betavis ELSE ! or frozen but no snow layers or - ! currently ignor the transmission of solar in snow and ice layers + ! currently ignore the transmission of solar in snow and ice layers ! to be updated in the future version betaprime = 1.0 ENDIF @@ -727,14 +727,14 @@ SUBROUTINE laketem (& ENDIF CALL qsadv(t_grnd,forc_psrf,eg,degdT,qsatg,qsatgdT) -! potential temperatur at the reference height +! potential temperature at the reference height beta1=1. ! - (in computing W_*) zii = 1000. ! m (pbl height) thm = forc_t + 0.0098*forc_hgt_t ! intermediate variable equivalent to ! forc_t*(pgcm/forc_psrf)**(rgas/cpair) - th = forc_t*(100000./forc_psrf)**(rgas/cpair) ! potential T + th = forc_t*(100000./forc_psrf)**(rgas/cpair) ! potential T thv = th*(1.+0.61*forc_q) ! virtual potential T - ur = max(0.1,sqrt(forc_us*forc_us+forc_vs*forc_vs)) ! limit set to 0.1 + ur = max(0.1,sqrt(forc_us*forc_us+forc_vs*forc_vs)) ! limit set to 0.1 ! Initialization variables nmozsgn = 0 @@ -821,7 +821,7 @@ SUBROUTINE laketem (& ustar,fh2m,fq2m,fm10m,fm,fh,fq) ENDIF -! Get derivative of fluxes with repect to ground temperature +! Get derivative of fluxes with respect to ground temperature ram = 1./(ustar*ustar/um) rah = 1./(vonkar/fh*ustar) raw = 1./(vonkar/fq*ustar) @@ -996,10 +996,10 @@ SUBROUTINE laketem (& ! the following consideration is try to avoid the snow conductivity ! to be dominant in the thermal conductivity of the interface. -! Because when the distance of bottom snow node to the interfacee +! Because when the distance of bottom snow node to the interface ! is larger than that of interface to top soil node, ! the snow thermal conductivity will be dominant, and the result is that -! lees heat tranfer between snow and soil +! lees heat transfer between snow and soil ! modified by Nan Wei, 08/25/2014 IF (i /= 0) THEN @@ -1038,7 +1038,7 @@ SUBROUTINE laketem (& ! extinction coefficient from surface data (1/m), if no eta from surface data, ! set eta, the extinction coefficient, according to L Hakanson, Aquatic Sciences, 1995 ! (regression of secchi depth with lake depth for small glacial basin lakes), and the - ! Poole & Atkins expression for extinction coeffient of 1.7 / secchi Depth (m). + ! Poole & Atkins expression for extinction coefficient of 1.7 / secchi Depth (m). eta = 1.1925*max(lakedepth,1.)**(-0.424) zin = z_lake(j) - 0.5*dz_lake(j) @@ -1601,7 +1601,7 @@ SUBROUTINE snowwater_lake ( USE_Dynamic_Lake, & real(r8), intent(in) :: deltim ! seconds in a time step (sec) real(r8), intent(in) :: ssi ! irreducible water saturation of snow - real(r8), intent(in) :: wimp ! water impremeable if porosity less than wimp + real(r8), intent(in) :: wimp ! water impermeable if porosity less than wimp real(r8), intent(in) :: porsl(1:nl_soil) ! volumetric soil water at saturation (porosity) real(r8), intent(in) :: pg_rain ! rainfall incident on ground [mm/s] @@ -1835,7 +1835,7 @@ SUBROUTINE snowwater_lake ( USE_Dynamic_Lake, & DO j = 1, nl_soil dw_soil = dw_soil + wliq_soisno(j) + wice_soisno(j) - + a = wliq_soisno(j)/(dz_soisno(j)*denh2o) + wice_soisno(j)/(dz_soisno(j)*denice) IF (a < porsl(j)) THEN @@ -1850,7 +1850,7 @@ SUBROUTINE snowwater_lake ( USE_Dynamic_Lake, & wliq_soisno(j) = porsl(j)*denh2o*dz_soisno(j) wice_soisno(j) = 0.0 ENDIF - + dw_soil = dw_soil - wliq_soisno(j) - wice_soisno(j) ENDDO @@ -1886,7 +1886,7 @@ SUBROUTINE snowwater_lake ( USE_Dynamic_Lake, & dz_lake(j) = 0. j = j - 1 IF (j == 0) EXIT - ENDDO + ENDDO ENDIF CALL adjust_lake_layer (nl_lake, dz_lake, t_lake, lake_icefrac) @@ -1950,7 +1950,7 @@ SUBROUTINE roughness_lake (snl,t_grnd,t_lake,lake_icefrac,forc_psrf,& z0mg = 0.001 ! z0mg won't have changed z0hg = z0mg/exp(0.13 * (ustar*z0mg/1.5e-5)**0.45) z0qg = z0hg - ELSE ! use roughness over snow + ELSE ! use roughness over snow z0mg = 0.0024 ! z0mg won't have changed z0hg = z0mg/exp(0.13 * (ustar*z0mg/1.5e-5)**0.45) z0qg = z0hg @@ -2075,12 +2075,12 @@ SUBROUTINE adjust_lake_layer (nl_lake, dz_lake, t_lake, lake_icefrac) USE MOD_Const_Physical IMPLICIT NONE - + integer, intent(in) :: nl_lake real(r8), intent(inout) :: dz_lake (nl_lake) ! lake layer thickness (m) real(r8), intent(inout) :: t_lake (nl_lake) ! lake temperature (kelvin) real(r8), intent(inout) :: lake_icefrac(nl_lake) ! lake mass fraction of lake layer that is frozen - + ! Local Variables integer :: i, j real(r8) :: wdsrfm, depthratio, resi, resj @@ -2091,7 +2091,7 @@ SUBROUTINE adjust_lake_layer (nl_lake, dz_lake, t_lake, lake_icefrac) real(r8), parameter :: dzlak(10) = (/0.1, 1., 2., 3., 4., 5., 7., 7., 10.45, 10.45/) ! m wdsrfm = sum(dz_lake) - + IF(wdsrfm > 1. .and. wdsrfm < 2000.)THEN depthratio = wdsrfm / sum(dzlak(1:nl_lake)) dz_lake_new(1) = dzlak(1) @@ -2110,7 +2110,7 @@ SUBROUTINE adjust_lake_layer (nl_lake, dz_lake, t_lake, lake_icefrac) tliqsum = 0. wicesum = 0. wliqsum = 0. - + resi = dz_lake_new(i) DO WHILE (resi > 1.e-8) @@ -2122,9 +2122,9 @@ SUBROUTINE adjust_lake_layer (nl_lake, dz_lake, t_lake, lake_icefrac) resi = resi - olp resj = resj - olp - + IF (resj == 0.) THEN - IF (j == nl_lake) THEN + IF (j == nl_lake) THEN EXIT ELSE j = j + 1 @@ -2158,7 +2158,7 @@ SUBROUTINE adjust_lake_layer (nl_lake, dz_lake, t_lake, lake_icefrac) wicesum = wicesum + (b-a)/hfus t_lake_new(i) = tfrz ENDIF - + ELSEIF (wliqsum > 0.) THEN t_lake_new(i) = tliq ELSEIF (wicesum > 0.) THEN diff --git a/main/MOD_LeafInterception.F90 b/main/MOD_LeafInterception.F90 index 98825bd3..07454ae4 100644 --- a/main/MOD_LeafInterception.F90 +++ b/main/MOD_LeafInterception.F90 @@ -144,7 +144,7 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la real(r8), intent(in) :: forc_us !wind speed real(r8), intent(in) :: forc_vs !wind speed real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_rain !convective rainfall [mm/s] real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] @@ -288,7 +288,7 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la #endif ELSE - ! all intercepted by canopy leves for very small precipitation + ! all intercepted by canopy leaves for very small precipitation tti_rain = 0. tti_snow = 0. tex_rain = 0. @@ -321,13 +321,13 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la #if(defined CoLMDEBUG) w = w - ldew - (pg_rain+pg_snow)*deltim IF (abs(w) > 1.e-6) THEN - write(6,*) 'something wrong in interception code : ' + write(6,*) 'something wrong in interception code: ' write(6,*) w, ldew, (pg_rain+pg_snow)*deltim, satcap CALL abort ENDIF IF (DEF_VEG_SNOW .and. abs(ldew-ldew_rain-ldew_snow) > 1.e-6) THEN - write(6,*) 'something wrong in interception code when DEF_VEG_SNOW : ' + write(6,*) 'something wrong in interception code when DEF_VEG_SNOW: ' write(6,*) ldew, ldew_rain, ldew_snow CALL abort ENDIF @@ -395,7 +395,7 @@ SUBROUTINE LEAF_interception_CoLM202x (deltim,dewmx,forc_us,forc_vs,chil,sigf,la real(r8), intent(in) :: forc_us !wind speed real(r8), intent(in) :: forc_vs !wind speed real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_rain !convective rainfall [mm/s] real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] @@ -576,7 +576,7 @@ SUBROUTINE LEAF_interception_CLM4 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa real(r8), intent(in) :: forc_us !wind speed real(r8), intent(in) :: forc_vs !wind speed real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_rain !convective rainfall [mm/s] real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] @@ -641,7 +641,7 @@ SUBROUTINE LEAF_interception_CLM4 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa #endif ELSE - ! all intercepted by canopy leves for very small precipitation + ! all intercepted by canopy leaves for very small precipitation tti_rain = 0. tti_snow = 0. tex_rain = 0. @@ -741,7 +741,7 @@ SUBROUTINE LEAF_interception_CLM5 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa real(r8), intent(in) :: forc_us !wind speed real(r8), intent(in) :: forc_vs !wind speed real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_rain !convective rainfall [mm/s] real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] @@ -814,7 +814,7 @@ SUBROUTINE LEAF_interception_CLM5 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa ENDIF #endif ELSE - ! all intercepted by canopy leves for very small precipitation + ! all intercepted by canopy leaves for very small precipitation tti_rain = 0. tti_snow = 0. tex_rain = 0. @@ -913,7 +913,7 @@ SUBROUTINE LEAF_interception_NOAHMP(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,s real(r8), intent(in) :: forc_us !wind speed real(r8), intent(in) :: forc_vs !wind speed real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_rain !convective rainfall [mm/s] real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] @@ -1010,7 +1010,7 @@ SUBROUTINE LEAF_interception_NOAHMP(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,s ENDIF #endif ELSE - ! all intercepted by canopy leves for very small precipitation + ! all intercepted by canopy leaves for very small precipitation tti_rain = 0. tti_snow = 0. tex_rain = 0. @@ -1111,7 +1111,7 @@ SUBROUTINE LEAF_interception_MATSIRO (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai real(r8), intent(in) :: forc_us !wind speed real(r8), intent(in) :: forc_vs !wind speed real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_rain !convective rainfall [mm/s] real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] @@ -1139,7 +1139,7 @@ SUBROUTINE LEAF_interception_MATSIRO (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai !the canopy water capacity per leaf area index is set to 0.2mm dewmx_MATSIRO = 0.2 - !the fracrtion of the convective precipitation area is assumed to be uniform (0.1) + !the fraction of the convective precipitation area is assumed to be uniform (0.1) Ac = 0.1 IF (lai+sai > 1e-6) THEN @@ -1253,7 +1253,7 @@ SUBROUTINE LEAF_interception_MATSIRO (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai #endif ELSE - ! all intercepted by canopy leves for very small precipitation + ! all intercepted by canopy leaves for very small precipitation tti_rain = 0. tti_snow = 0. tex_rain = 0. @@ -1352,7 +1352,7 @@ SUBROUTINE LEAF_interception_VIC (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai real(r8), intent(in) :: forc_us !wind speed real(r8), intent(in) :: forc_vs !wind speed real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_rain !convective rainfall [mm/s] real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] @@ -1494,7 +1494,7 @@ SUBROUTINE LEAF_interception_VIC (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai #endif ELSE - ! all intercepted by canopy leves for very small precipitation + ! all intercepted by canopy leaves for very small precipitation tti_rain = 0. tti_snow = 0. tex_rain = 0. @@ -1585,7 +1585,7 @@ SUBROUTINE LEAF_interception_JULES(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa real(r8), intent(in) :: forc_us !wind speed real(r8), intent(in) :: forc_vs !wind speed real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_rain !convective rainfall [mm/s] real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] @@ -1621,7 +1621,7 @@ SUBROUTINE LEAF_interception_JULES(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa satcap_snow = 4.4 *lsai satcap_rain = 0.1 *lsai - ! Caution here: JULES is PFT based, fvegc is not exxisitng + ! Caution here: JULES is PFT based, fvegc is not existing fvegc = max(0.05,1.0-exp(-0.52*lsai)) p0 = (prc_rain + prc_snow + prl_rain + prl_snow+qflx_irrig_sprinkler)*deltim @@ -1689,7 +1689,7 @@ SUBROUTINE LEAF_interception_JULES(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa ENDIF #endif ELSE - ! all intercepted by canopy leves for very small precipitation + ! all intercepted by canopy leaves for very small precipitation tti_rain = 0. tti_snow = 0. tex_rain = 0. @@ -1769,7 +1769,7 @@ SUBROUTINE LEAF_interception_wrap(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai real(r8), intent(in) :: forc_us !wind speed real(r8), intent(in) :: forc_vs !wind speed real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_rain !convective rainfall [mm/s] real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] diff --git a/main/MOD_LeafTemperature.F90 b/main/MOD_LeafTemperature.F90 index 7965ec60..d4438612 100644 --- a/main/MOD_LeafTemperature.F90 +++ b/main/MOD_LeafTemperature.F90 @@ -53,7 +53,7 @@ SUBROUTINE LeafTemperature ( & !End ozone stress variables !WUE stomata model parameter lambda ,& -!End WUE stomata model parmaeter +!End WUE stomata model parameter hpbl ,& qintr_rain ,qintr_snow ,t_precip ,hprl ,dheatl ,smp ,& hk ,hksati ,rootflux ) @@ -82,9 +82,9 @@ SUBROUTINE LeafTemperature ( & ! land surface modeling. Agricultural and Forest Meteorology, ! 269–270, 119–135. https://doi.org/10.1016/j.agrformet.2019.02.006 ! -! 10/2019, Hua Yuan: change only the leaf tempertature from two-leaf -! to one-leaf (due to large differences may exist btween sunlit/shaded -! leaf temperature. +! 10/2019, Hua Yuan: change only the leaf temperature from two-leaf +! to one-leaf (due to large differences may exist between +! sunlit/shaded leaf temperature. ! ! 01/2021, Xingjie Lu and Nan Wei: added plant hydraulic process interface. ! @@ -150,10 +150,10 @@ SUBROUTINE LeafTemperature ( & !End WUE stomata model parameter extkn ! coefficient of leaf nitrogen allocation real(r8), intent(in) :: & ! for plant hydraulic scheme - kmax_sun, &! Plant Hydraulics Paramters - kmax_sha, &! Plant Hydraulics Paramters - kmax_xyl, &! Plant Hydraulics Paramters - kmax_root, &! Plant Hydraulics Paramters + kmax_sun, &! Plant Hydraulics Parameters + kmax_sha, &! Plant Hydraulics Parameters + kmax_xyl, &! Plant Hydraulics Parameters + kmax_root, &! Plant Hydraulics Parameters psi50_sun, &! water potential at 50% loss of sunlit leaf tissue conductance (mmH2O) psi50_sha, &! water potential at 50% loss of shaded leaf tissue conductance (mmH2O) psi50_xyl, &! water potential at 50% loss of xylem tissue conductance (mmH2O) @@ -218,7 +218,7 @@ SUBROUTINE LeafTemperature ( & smp (1:nl_soil), &! soil matrix potential rootfr (1:nl_soil), &! root fraction hksati (1:nl_soil), &! hydraulic conductivity at saturation [mm h2o/s] - hk (1:nl_soil) ! soil hydraulic conducatance + hk (1:nl_soil) ! soil hydraulic conductance real(r8), intent(in) :: & hpbl ! atmospheric boundary layer height [m] @@ -308,20 +308,20 @@ SUBROUTINE LeafTemperature ( & hu_, &! adjusted observational height of wind [m] ht_, &! adjusted observational height of temperature [m] hq_, &! adjusted observational height of humidity [m] - zldis, &! reference height "minus" zero displacement heght [m] + zldis, &! reference height "minus" zero displacement height [m] zii, &! convective boundary layer height [m] z0mv, &! roughness length, momentum [m] z0hv, &! roughness length, sensible heat [m] z0qv, &! roughness length, latent heat [m] zeta, &! dimensionless height used in Monin-Obukhov theory - beta, &! coefficient of conective velocity [-] + beta, &! coefficient of convective velocity [-] wc, &! convective velocity [m/s] wc2, &! wc**2 dth, &! diff of virtual temp. between ref. height and surface dthv, &! diff of vir. poten. temp. between ref. height and surface dqh, &! diff of humidity between ref. height and surface obu, &! monin-obukhov length (m) - um, &! wind speed including the stablity effect [m/s] + um, &! wind speed including the stability effect [m/s] ur, &! wind speed at reference height [m/s] uaf, &! velocity of air within foliage [m/s] fh2m, &! relation for temperature at 2m @@ -529,19 +529,19 @@ SUBROUTINE LeafTemperature ( & IF (hu <= htop+1) THEN hu_ = htop + 1. - IF (taux == spval) & ! only print warning for the firt time-step + IF (taux == spval) & ! only print warning for the first time-step write(6,*) 'Warning: the obs height of u less than htop+1, set it to htop+1.' ENDIF IF (ht <= htop+1) THEN ht_ = htop + 1. - IF (taux == spval) & ! only print warning for the firt time-step + IF (taux == spval) & ! only print warning for the first time-step write(6,*) 'Warning: the obs height of t less than htop+1, set it to htop+1.' ENDIF IF (hq <= htop+1) THEN hq_ = htop + 1. - IF (taux == spval) & ! only print warning for the firt time-step + IF (taux == spval) & ! only print warning for the first time-step write(6,*) 'Warning: the obs height of q less than htop+1, set it to htop+1.' ENDIF @@ -702,7 +702,7 @@ SUBROUTINE LeafTemperature ( & sai = amax1(sai,0.1) ! PHS update actual stomata conductance (resistance), assimilation rate ! and leaf respiration. above stomatal resistances are for the canopy, - ! the stomatal rsistances and the "rb" in the following calculations are + ! the stomatal resistances and the "rb" in the following calculations are ! the average for single leaf. thus, CALL PlantHydraulicStress_twoleaf ( nl_soil ,nvegwcs ,& z_soi ,dz_soi ,rootfr ,psrf ,qsatl ,& @@ -747,7 +747,7 @@ SUBROUTINE LeafTemperature ( & ENDIF ENDIF -! above stomatal resistances are for the canopy, the stomatal rsistances +! above stomatal resistances are for the canopy, the stomatal resistances ! and the "rb" in the following calculations are the average for single leaf. thus, rssun = rssun * laisun rssha = rssha * laisha @@ -792,7 +792,7 @@ SUBROUTINE LeafTemperature ( & ! IR radiation, sensible and latent heat fluxes and their derivatives !----------------------------------------------------------------------- ! the partial derivatives of areodynamical resistance are ignored -! which cannot be determined analtically +! which cannot be determined analytically fac = 1. - thermk ! longwave absorption and their derivatives @@ -1014,10 +1014,10 @@ SUBROUTINE LeafTemperature ( & ! canopy fluxes and total assimilation amd respiration fsenl = fsenl + fsenl_dtl*dtl(it-1) & - ! yuan: add the imbalanced energy below due to T adjustment to sensibel heat + ! yuan: add the imbalanced energy below due to T adjustment to sensible heat + (dtl_noadj-dtl(it-1)) * (clai/deltim - dirab_dtl + fsenl_dtl + hvap*fevpl_dtl & + cpliq * qintr_rain + cpice * qintr_snow) & - ! yuan: add the imbalanced energy below due to q adjustment to sensibel heat + ! yuan: add the imbalanced energy below due to q adjustment to sensible heat + hvap*erre etr0 = etr diff --git a/main/MOD_LeafTemperaturePC.F90 b/main/MOD_LeafTemperaturePC.F90 index 2914a20b..0564dd85 100644 --- a/main/MOD_LeafTemperaturePC.F90 +++ b/main/MOD_LeafTemperaturePC.F90 @@ -71,22 +71,24 @@ SUBROUTINE LeafTemperaturePC ( & !======================================================================= ! ! !DESCRIPTION: -! Leaf temperature resolved for Plant Community (3D) case -! Foliage energy conservation for each PFT is given by foliage energy budget equation +! Leaf temperature resolved for Plant Community (3D) case Foliage energy +! conservation for each PFT is given by foliage energy budget equation ! Rnet - Hf - LEf = 0 ! The equation is solved by Newton-Raphson iteration, in which this iteration -! includes the calculation of the photosynthesis and stomatal resistance, and the -! integration of turbulent flux profiles. The sensible and latent heat -! transfer between foliage and atmosphere and ground is linked by the equations: +! includes the calculation of the photosynthesis and stomatal resistance, and +! the integration of turbulent flux profiles. The sensible and latent heat +! transfer between foliage and atmosphere and ground is linked by the +! equations: ! Ha = Hf + Hg and Ea = Ef + Eg ! ! Original author : Hua Yuan and Yongjiu Dai, September, 2017 ! ! ! !REFERENCES: -! 1) Dai, Y., Yuan, H., Xin, Q., Wang, D., Shangguan, W., Zhang, S., et al. (2019). -! Different representations of canopy structure—A large source of uncertainty in -! global land surface modeling. Agricultural and Forest Meteorology, 269–270, 119–135. +! 1) Dai, Y., Yuan, H., Xin, Q., Wang, D., Shangguan, W., Zhang, S., et al. +! (2019). Different representations of canopy structure—A large source of +! uncertainty in global land surface modeling. Agricultural and Forest +! Meteorology, 269–270, 119–135. ! https://doi.org/10.1016/j.agrformet.2019.02.006 ! ! !REVISIONS: @@ -136,7 +138,7 @@ SUBROUTINE LeafTemperaturePC ( & pftclass ! PFT class real(r8), dimension(ps:pe), intent(in) :: & - fcover, &! PFT fractiona coverage [-] + fcover, &! PFT fractional coverage [-] htop, &! PFT crown top height [m] hbot, &! PFT crown bottom height [m] lai, &! adjusted leaf area index for seasonal variation [-] @@ -201,7 +203,7 @@ SUBROUTINE LeafTemperaturePC ( & qintr_snow(ps:pe), &! snowfall interception (mm h2o/s) smp (1:nl_soil), &! precipitation sensible heat from canopy hksati (1:nl_soil), &! hydraulic conductivity at saturation [mm h2o/s] - hk (1:nl_soil) ! soil hydraulic conducatance + hk (1:nl_soil) ! soil hydraulic conductance real(r8), intent(in) :: & hpbl ! atmospheric boundary layer height [m] @@ -313,10 +315,10 @@ SUBROUTINE LeafTemperaturePC ( & extkn ! coefficient of leaf nitrogen allocation real(r8), dimension(ps:pe) :: & - kmax_sun, &! Plant Hydraulics Paramters - kmax_sha, &! Plant Hydraulics Paramters - kmax_xyl, &! Plant Hydraulics Paramters - kmax_root, &! Plant Hydraulics Paramters + kmax_sun, &! Plant Hydraulics Parameters + kmax_sha, &! Plant Hydraulics Parameters + kmax_xyl, &! Plant Hydraulics Parameters + kmax_root, &! Plant Hydraulics Parameters psi50_sun, &! water potential at 50% loss of sunlit leaf tissue conductance (mmH2O) psi50_sha, &! water potential at 50% loss of shaded leaf tissue conductance (mmH2O) psi50_xyl, &! water potential at 50% loss of xylem tissue conductance (mmH2O) @@ -330,20 +332,20 @@ SUBROUTINE LeafTemperaturePC ( & hu_, &! adjusted observational height of wind [m] ht_, &! adjusted observational height of temperature [m] hq_, &! adjusted observational height of humidity [m] - zldis, &! reference height "minus" zero displacement heght [m] + zldis, &! reference height "minus" zero displacement height [m] zii, &! convective boundary layer height [m] z0mv, &! roughness length, momentum [m] z0hv, &! roughness length, sensible heat [m] z0qv, &! roughness length, latent heat [m] zeta, &! dimensionless height used in Monin-Obukhov theory - beta, &! coefficient of conective velocity [-] + beta, &! coefficient of convective velocity [-] wc, &! convective velocity [m/s] wc2, &! wc**2 dth, &! diff of virtual temp. between ref. height and surface dthv, &! diff of vir. poten. temp. between ref. height and surface dqh, &! diff of humidity between ref. height and surface obu, &! monin-obukhov length (m) - um, &! wind speed including the stablity effect [m/s] + um, &! wind speed including the stability effect [m/s] ur, &! wind speed at reference height [m/s] uaf, &! velocity of air within foliage [m/s] fh2m, &! relation for temperature at 2m @@ -417,7 +419,7 @@ SUBROUTINE LeafTemperaturePC ( & real(r8),dimension(nl_soil) :: k_ax_root ! axial root conductance ! ................................................................. - ! defination for 3d run + ! definition for 3d run ! ................................................................. integer , parameter :: nlay = 3 @@ -463,7 +465,7 @@ SUBROUTINE LeafTemperaturePC ( & ktop_lay, &! eddy coefficient at layer top kbot_lay, &! eddy coefficient at layer bottom z0m_lay, &! roughness length for the vegetation covered area - displa_lay, &! displacement height for the vegetaion covered area + displa_lay, &! displacement height for the vegetation covered area taf, &! air temperature within canopy space [K] qaf, &! humidity of canopy air [kg/kg] rd, &! aerodynamic resistance between layers [s/m] @@ -496,15 +498,15 @@ SUBROUTINE LeafTemperaturePC ( & real(r8) :: thermk_lay(nlay) !transmittance of longwave radiation for each layer real(r8) :: fshade_lay(nlay) !shadow of each layer real(r8) :: L(nlay) !longwave radiation emitted by canopy layer - real(r8) :: Ltd(nlay) !trasmitted downward longwave radiation from canopy layer - real(r8) :: Ltu(nlay) !trasmitted upward longwave radiation from canopy layer - real(r8) :: Lin(0:4) !incomming longwave radiation for each layer + real(r8) :: Ltd(nlay) !transmitted downward longwave radiation from canopy layer + real(r8) :: Ltu(nlay) !transmitted upward longwave radiation from canopy layer + real(r8) :: Lin(0:4) !incoming longwave radiation for each layer real(r8) :: Ld(0:4) !total downward longwave radiation for each layer real(r8) :: Lu(0:4) !total upward longwave radiation for each layer real(r8) :: Lg !emitted longwave radiation from ground - real(r8) :: Lv(ps:pe) !absorbed longwave raidation for each pft + real(r8) :: Lv(ps:pe) !absorbed longwave radiation for each pft real(r8) :: dLv(ps:pe) !LW change due to temperature change - real(r8) :: dLvpar(nlay) !temporal variable for calcualting dLv + real(r8) :: dLvpar(nlay) !temporal variable for calculating dLv !-----------------------End Variable List------------------------------- @@ -583,10 +585,10 @@ SUBROUTINE LeafTemperaturePC ( & ! scaling-up coefficients from leaf to canopy !----------------------------------------------------------------------- -! note: need to sperate to sunlit/shaded pars +! note: need to separate to sunlit/shaded pars !----------------------------------------------------------------------- -! partion visible canopy absorption to sunlit and shaded fractions +! partition visible canopy absorption to sunlit and shaded fractions ! to get average absorbed par for sunlit and shaded leaves fsha(:) = 1. - fsun(:) laisun(:) = lai(:)*fsun(:) @@ -630,7 +632,7 @@ SUBROUTINE LeafTemperaturePC ( & beta = 1. !- (in computing W_*) !----------------------------------------------------------------------- -! calculate layer average propeties: height (htop_lay, hbot_lay), lsai_lay, ... +! calculate layer average properties: height (htop_lay, hbot_lay), lsai_lay, ... ! !!NOTE: adjustment may needed for htop_lay/hbot_lay !----------------------------------------------------------------------- htop_lay(:) = 0 @@ -762,7 +764,7 @@ SUBROUTINE LeafTemperaturePC ( & ENDDO !----------------------------------------------------------------------- -! claculate layer info +! calculate layer info ! how may layers, top layer and bottom layer number !----------------------------------------------------------------------- @@ -860,7 +862,7 @@ SUBROUTINE LeafTemperaturePC ( & !----------------------------------------------------------------------- ! first guess for taf and qaf for each layer -! a large differece from previous schemes +! a large difference from previous schemes !----------------------------------------------------------------------- taf(:) = 0. qaf(:) = 0. @@ -913,19 +915,19 @@ SUBROUTINE LeafTemperaturePC ( & IF (hu <= htop_lay(toplay)+1) THEN hu_ = htop_lay(toplay) + 1. - IF (taux == spval) & ! only print warning for the firt time-step + IF (taux == spval) & ! only print warning for the first time-step write(6,*) 'Warning: the obs height of u less than htop+1, set it to htop+1.' ENDIF IF (ht <= htop_lay(toplay)+1) THEN ht_ = htop_lay(toplay) + 1. - IF (taux == spval) & ! only print warning for the firt time-step + IF (taux == spval) & ! only print warning for the first time-step write(6,*) 'Warning: the obs height of t less than htop+1, set it to htop+1.' ENDIF IF (hq <= htop_lay(toplay)+1) THEN hq_ = htop_lay(toplay) + 1. - IF (taux == spval) & ! only print warning for the firt time-step + IF (taux == spval) & ! only print warning for the first time-step write(6,*) 'Warning: the obs height of q less than htop+1, set it to htop+1.' ENDIF @@ -1204,7 +1206,7 @@ SUBROUTINE LeafTemperaturePC ( & effcon(i), vmax25(i), gradm(i), trop(i), slti(i), hlti(i), shti(i), hhti(i), & trda(i), trdm(i), cintsha(:,i), assimsha(i), respcsha(i)) - ! leaf scale stomata resisitence + ! leaf scale stomata resistance rssun(i) = tprcor / tl(i) * 1.e6 /gssun(i) rssha(i) = tprcor / tl(i) * 1.e6 /gssha(i) @@ -1220,7 +1222,7 @@ SUBROUTINE LeafTemperaturePC ( & ENDIF ENDDO -! above stomatal resistances are for the canopy, the stomatal rsistances +! above stomatal resistances are for the canopy, the stomatal resistances ! and the "rb" in the following calculations are the average for single leaf. thus, rssun = rssun * laisun rssha = rssha * laisha @@ -1283,7 +1285,7 @@ SUBROUTINE LeafTemperaturePC ( & ENDIF ENDDO - ! claculate wtshi, wtsqi + ! calculate wtshi, wtsqi wtshi(:) = cah(:) + cgh(:) wtsqi(:) = caw(:) + cgw(:) @@ -1373,7 +1375,7 @@ SUBROUTINE LeafTemperaturePC ( & ! IR radiation, sensible and latent heat fluxes and their derivatives !----------------------------------------------------------------------- ! the partial derivatives of areodynamical resistance are ignored -! which cannot be determined analtically +! which cannot be determined analytically ! calculate L for each canopy layer L(:) = 0. @@ -1400,7 +1402,7 @@ SUBROUTINE LeafTemperaturePC ( & ! calculate Lin = Ld * tdn Lin(:) = matmul(Ld(:), tdn(:,:)) -! calcilate Lg = (1-emg)*dlrad + emg*stefnc*tg**4 +! calculate Lg = (1-emg)*dlrad + emg*stefnc*tg**4 ! dlrad = Lin(0) IF (.not.DEF_SPLIT_SOILSNOW) THEN Lg = (1 - emg)*Lin(0) + emg*stefnc*tg**4 @@ -1459,7 +1461,7 @@ SUBROUTINE LeafTemperaturePC ( & ! sensible heat fluxes and their derivatives fsenl(i) = rhoair * cpair * cfh(i) * (tl(i) - taf(clev)) - ! 09/25/2017: re-written, check it clearfully + ! 09/25/2017: re-written, check it carefully ! When numlay<3, no matter how to calculate, /fact is consistent IF (numlay < 3 .or. clev == 2) THEN fsenl_dtl(i) = rhoair * cpair * cfh(i) * (1. - wlh(i)/fact) @@ -1737,7 +1739,7 @@ SUBROUTINE LeafTemperaturePC ( & zol = zeta rib = min(5.,zol*ustar**2/(vonkar**2/fh*um**2)) -! canopy fluxes and total assimilation amd respiration +! canopy fluxes and total assimilation and respiration DO i = ps, pe IF (fcover(i)>0 .and. lsai(i)>1.e-6) THEN @@ -1753,12 +1755,12 @@ SUBROUTINE LeafTemperaturePC ( & assim(i) = assimsun(i) + assimsha(i) respc(i) = respcsun(i) + respcsha(i) + rsoil -! canopy fluxes and total assimilation amd respiration +! canopy fluxes and total assimilation and respiration fsenl(i) = fsenl(i) + fsenl_dtl(i)*dtl(it-1,i) & - ! add the imbalanced energy below due to T adjustment to sensibel heat + ! add the imbalanced energy below due to T adjustment to sensible heat + (dtl_noadj(i)-dtl(it-1,i)) * (clai(i)/deltim - dirab_dtl(i) & + fsenl_dtl(i) + hvap*fevpl_dtl(i) + cpliq*qintr_rain(i) + cpice*qintr_snow(i)) & - ! add the imbalanced energy below due to q adjustment to sensibel heat + ! add the imbalanced energy below due to q adjustment to sensible heat + hvap*erre(i) etr0(i) = etr(i) diff --git a/main/MOD_LightningData.F90 b/main/MOD_LightningData.F90 index 332a2499..5509bfce 100644 --- a/main/MOD_LightningData.F90 +++ b/main/MOD_LightningData.F90 @@ -74,7 +74,7 @@ END SUBROUTINE init_lightning_data SUBROUTINE update_lightning_data (time, deltim) !---------------------- - ! DESCTIPTION: + ! DESCRIPTION: ! read lightning data during simulation USE MOD_TimeManager diff --git a/main/MOD_MonthlyinSituCO2MaunaLoa.F90 b/main/MOD_MonthlyinSituCO2MaunaLoa.F90 index d9e8ed0c..b8f8b464 100644 --- a/main/MOD_MonthlyinSituCO2MaunaLoa.F90 +++ b/main/MOD_MonthlyinSituCO2MaunaLoa.F90 @@ -74,7 +74,7 @@ MODULE MOD_MonthlyinSituCO2MaunaLoa SUBROUTINE init_monthly_co2_mlo !DESCRIPTION !=========== - !---This MODULE is used for initilize the CO2 concentration. + !---This MODULE is used for initialize the CO2 concentration. !ANCILLARY FUNCTIONS AND SUBROUTINES !------------------- @@ -278,7 +278,7 @@ SUBROUTINE init_monthly_co2_mlo !co2mlo( 2013 ,:) = (/ 395.31 , 395.31 , 395.31 , 395.31 , 395.31 , 395.31 , 395.31 , 395.31 , 395.31 , 395.31 , 395.31 , 395.31 /) !co2mlo( 2014 ,:) = (/ 397.12 , 397.12 , 397.12 , 397.12 , 397.12 , 397.12 , 397.12 , 397.12 , 397.12 , 397.12 , 397.12 , 397.12 /) - !NOTE: the below numbers can be manualy updated IF new records are available [Unit: ppm] + !NOTE: the below numbers can be manually updated IF new records are available [Unit: ppm] co2mlo(1958,:) = (/ 314.85, 314.85, 315.71, 317.45, 317.51, 317.25, 315.86, 314.93, 313.21, 312.43, 313.33, 314.67 /) co2mlo(1959,:) = (/ 315.58, 316.49, 316.65, 317.72, 318.29, 318.15, 316.54, 314.80, 313.84, 313.33, 314.81, 315.58 /) co2mlo(1960,:) = (/ 316.43, 316.98, 317.58, 319.03, 320.03, 319.58, 318.18, 315.90, 314.17, 313.83, 315.00, 316.19 /) diff --git a/main/MOD_NdepData.F90 b/main/MOD_NdepData.F90 index 342061e2..c03d6115 100644 --- a/main/MOD_NdepData.F90 +++ b/main/MOD_NdepData.F90 @@ -26,7 +26,7 @@ MODULE MOD_NdepData SUBROUTINE init_ndep_data_annually (YY) !---------------------- - ! DESCTIPTION: + ! DESCRIPTION: ! open ndep netcdf file from DEF_dir_runtime, read latitude and longitude info. ! Initialize ndep data read in. @@ -62,7 +62,7 @@ END SUBROUTINE init_ndep_data_annually SUBROUTINE init_ndep_data_monthly (YY,MM) !sf_add !---------------------- - ! DESCTIPTION: + ! DESCRIPTION: ! open ndep netcdf file from DEF_dir_runtime, read latitude and longitude info. ! Initialize ndep data read in. diff --git a/main/MOD_NetSolar.F90 b/main/MOD_NetSolar.F90 index ac8cb975..a71eab47 100644 --- a/main/MOD_NetSolar.F90 +++ b/main/MOD_NetSolar.F90 @@ -58,7 +58,7 @@ SUBROUTINE netsolar (ipatch,idate,deltim,dlon,patchtype,& integer, intent(in) :: idate(3) !model time integer, intent(in) :: patchtype !land patch type (99-sea) - real(r8), intent(in) :: dlon !logitude in radians + real(r8), intent(in) :: dlon !longitude in radians real(r8), intent(in) :: deltim !seconds in a time step [second] real(r8), intent(in) :: & @@ -257,7 +257,7 @@ SUBROUTINE netsolar (ipatch,idate,deltim,dlon,patchtype,& sabg_snow_lyr(:) = forc_sols*ssno_lyr(1,1,:) + forc_solsd*ssno_lyr(1,2,:) & + forc_soll*ssno_lyr(2,1,:) + forc_solld*ssno_lyr(2,2,:) - ! convert to the whole area producted by snow fractional cover + ! convert to the whole area multiplied by snow fractional cover sabg_snow_lyr(:) = sabg_snow_lyr(:)*fsno ! attribute the first layer absorption to soil absorption diff --git a/main/MOD_NitrifData.F90 b/main/MOD_NitrifData.F90 index 6ecf35f1..82db053a 100644 --- a/main/MOD_NitrifData.F90 +++ b/main/MOD_NitrifData.F90 @@ -23,7 +23,7 @@ MODULE MOD_NitrifData SUBROUTINE init_nitrif_data (idate) !---------------------- - ! DESCTIPTION: + ! DESCRIPTION: ! open nitrif netcdf file from DEF_dir_runtime, read latitude and longitude info. ! Initialize nitrif data read in. diff --git a/main/MOD_Ozone.F90 b/main/MOD_Ozone.F90 index de229426..eb675545 100644 --- a/main/MOD_Ozone.F90 +++ b/main/MOD_Ozone.F90 @@ -185,7 +185,7 @@ END SUBROUTINE CalcOzoneStress SUBROUTINE init_ozone_data (idate) !---------------------- - ! DESCTIPTION: + ! DESCRIPTION: ! open ozone netcdf file from DEF_dir_rawdata, read latitude and longitude info. ! Initialize Ozone data read in. @@ -237,7 +237,7 @@ END SUBROUTINE init_ozone_data SUBROUTINE update_ozone_data (time, deltim) !---------------------- - ! DESCTIPTION: + ! DESCRIPTION: ! read ozone data during simulation USE MOD_TimeManager diff --git a/main/MOD_PhaseChange.F90 b/main/MOD_PhaseChange.F90 index 2c6b59cf..e9a9cd30 100644 --- a/main/MOD_PhaseChange.F90 +++ b/main/MOD_PhaseChange.F90 @@ -47,7 +47,7 @@ SUBROUTINE meltf (patchtype,is_dry_lake,lb,nl_soil,deltim, & ! Original author: Yongjiu Dai, /09/1999/, /03/2014/ ! ! !REVISIONS: -! 08/2020, Hua Yuan: seperate soil/snow heat flux, exclude glacier (3) +! 08/2020, Hua Yuan: separate soil/snow heat flux, exclude glacier (3) ! 04/2023, Nan Wei: supercooled soil water is included IF supercool is defined. !----------------------------------------------------------------------- @@ -87,7 +87,7 @@ SUBROUTINE meltf (patchtype,is_dry_lake,lb,nl_soil,deltim, & sc_vgm (1:nl_soil), & fc_vgm (1:nl_soil) #endif - real(r8), intent(in) :: dz(1:nl_soil) !soil layer thickiness [m] + real(r8), intent(in) :: dz(1:nl_soil) !soil layer thickness [m] real(r8), intent(inout) :: t_soisno (lb:nl_soil) !temperature at current time step [K] real(r8), intent(inout) :: wice_soisno(lb:nl_soil) !ice lens [kg/m2] @@ -101,7 +101,7 @@ SUBROUTINE meltf (patchtype,is_dry_lake,lb,nl_soil,deltim, & ! Local real(r8) :: hm(lb:nl_soil) !energy residual [W/m2] - real(r8) :: xm(lb:nl_soil) !metling or freezing within a time step [kg/m2] + real(r8) :: xm(lb:nl_soil) !melting or freezing within a time step [kg/m2] real(r8) :: heatr !energy residual or loss after melting or freezing real(r8) :: temp1 !temporary variables [kg/m2] real(r8) :: temp2 !temporary variables [kg/m2] @@ -194,7 +194,7 @@ SUBROUTINE meltf (patchtype,is_dry_lake,lb,nl_soil,deltim, & IF(j > lb)THEN ! => not the top layer IF (j==1 .and. DEF_SPLIT_SOILSNOW .and. ((patchtype<3) .or. is_dry_lake)) THEN ! -> interface soil layer - ! 03/08/2020, yuan: seperate soil/snow heat flux, exclude glacier(3) + ! 03/08/2020, yuan: separate soil/snow heat flux, exclude glacier(3) hm(j) = hs_soil + (1.-fsno)*dhsdT*tinc + brr(j) - tinc/fact(j) ELSE ! -> internal layers other than the interface soil layer hm(j) = brr(j) - tinc/fact(j) @@ -204,7 +204,7 @@ SUBROUTINE meltf (patchtype,is_dry_lake,lb,nl_soil,deltim, & ! -> soil layer hm(j) = hs + dhsdT*tinc + brr(j) - tinc/fact(j) ELSE ! -> snow cover - ! 03/08/2020, yuan: seperate soil/snow heat flux, exclude glacier(3) + ! 03/08/2020, yuan: separate soil/snow heat flux, exclude glacier(3) hm(j) = hs_snow + fsno*dhsdT*tinc + brr(j) - tinc/fact(j) ENDIF ENDIF @@ -217,7 +217,7 @@ SUBROUTINE meltf (patchtype,is_dry_lake,lb,nl_soil,deltim, & hm(j) = 0. imelt(j) = 0 ENDIF -! this error was checked carefully, it results from the the computed error +! this error was checked carefully, it results from the computed error ! of "Tridiagonal-Matrix" in SUBROUTINE "thermal". IF(imelt(j) == 2 .and. hm(j) > 0.) THEN hm(j) = 0. @@ -346,7 +346,7 @@ SUBROUTINE meltf_snicar (patchtype,is_dry_lake,lb,nl_soil,deltim, & ! Original author: Yongjiu Dai, /09/1999/, /03/2014/ ! ! !REVISIONS: -! 08/2020, Hua Yuan: seperate soil/snow heat flux, exclude glacier (3) +! 08/2020, Hua Yuan: separate soil/snow heat flux, exclude glacier (3) ! 01/2023, Hua Yuan: added snow layer absorption in melting calculation ! 04/2023, Nan Wei: supercooled soil water is included IF supercool is defined. !----------------------------------------------------------------------- @@ -388,7 +388,7 @@ SUBROUTINE meltf_snicar (patchtype,is_dry_lake,lb,nl_soil,deltim, & sc_vgm (1:nl_soil), & fc_vgm (1:nl_soil) #endif - real(r8), intent(in) :: dz(1:nl_soil) !soil layer thickiness [m] + real(r8), intent(in) :: dz(1:nl_soil) !soil layer thickness [m] real(r8), intent(inout) :: t_soisno (lb:nl_soil) !temperature at current time step [K] real(r8), intent(inout) :: wice_soisno(lb:nl_soil) !ice lens [kg/m2] @@ -402,7 +402,7 @@ SUBROUTINE meltf_snicar (patchtype,is_dry_lake,lb,nl_soil,deltim, & ! Local real(r8) :: hm(lb:nl_soil) !energy residual [W/m2] - real(r8) :: xm(lb:nl_soil) !metling or freezing within a time step [kg/m2] + real(r8) :: xm(lb:nl_soil) !melting or freezing within a time step [kg/m2] real(r8) :: heatr !energy residual or loss after melting or freezing real(r8) :: temp1 !temporary variables [kg/m2] real(r8) :: temp2 !temporary variables [kg/m2] @@ -497,7 +497,7 @@ SUBROUTINE meltf_snicar (patchtype,is_dry_lake,lb,nl_soil,deltim, & IF(j > lb)THEN ! => not the top layer IF (j==1 .and. DEF_SPLIT_SOILSNOW .and. ((patchtype<3).or.is_dry_lake)) THEN ! -> interface soil layer - ! 03/08/2020, yuan: seperate soil/snow heat flux, exclude glacier(3) + ! 03/08/2020, yuan: separate soil/snow heat flux, exclude glacier(3) hm(j) = hs_soil + (1.-fsno)*dhsdT*tinc + brr(j) - tinc/fact(j) ELSE ! -> internal layers other than the interface soil layer IF (j<1 .or. (j==1 .and. patchtype==3)) THEN @@ -511,7 +511,7 @@ SUBROUTINE meltf_snicar (patchtype,is_dry_lake,lb,nl_soil,deltim, & ! -> soil layer hm(j) = hs + dhsdT*tinc + brr(j) - tinc/fact(j) ELSE ! -> snow cover - ! 03/08/2020, yuan: seperate soil/snow heat flux, exclude glacier(3) + ! 03/08/2020, yuan: separate soil/snow heat flux, exclude glacier(3) hm(j) = hs_snow + fsno*dhsdT*tinc + brr(j) - tinc/fact(j) ENDIF ENDIF @@ -524,7 +524,7 @@ SUBROUTINE meltf_snicar (patchtype,is_dry_lake,lb,nl_soil,deltim, & hm(j) = 0. imelt(j) = 0 ENDIF -! this error was checked carefully, it results from the the computed error +! this error was checked carefully, it results from the computed error ! of "Tridiagonal-Matrix" in SUBROUTINE "thermal". IF(imelt(j) == 2 .and. hm(j) > 0.) THEN hm(j) = 0. @@ -674,11 +674,11 @@ SUBROUTINE meltf_urban (lb,nl_soil,deltim, & real(r8), intent(out) :: sm !rate of snowmelt [mm/s, kg/(m2 s)] real(r8), intent(out) :: xmf !total latent heat of phase change - integer, intent(out) :: imelt(lb:nl_soil) !flag for melting or freezing [-] + integer, intent(out) :: imelt(lb:nl_soil) !flag for melting or freezing [-] ! Local real(r8) :: hm(lb:nl_soil) !energy residual [W/m2] - real(r8) :: xm(lb:nl_soil) !metling or freezing within a time step [kg/m2] + real(r8) :: xm(lb:nl_soil) !melting or freezing within a time step [kg/m2] real(r8) :: heatr !energy residual or loss after melting or freezing real(r8) :: temp1 !temporary variables [kg/m2] real(r8) :: temp2 !temporary variables [kg/m2] @@ -745,7 +745,7 @@ SUBROUTINE meltf_urban (lb,nl_soil,deltim, & hm(j) = 0. imelt(j) = 0 ENDIF -! this error was checked carefully, it results from the the computed error +! this error was checked carefully, it results from the computed error ! of "Tridiagonal-Matrix" in SUBROUTINE "thermal". IF(imelt(j) == 2 .and. hm(j) > 0.) THEN hm(j) = 0. diff --git a/main/MOD_PlantHydraulic.F90 b/main/MOD_PlantHydraulic.F90 index 420c7c79..8260a949 100644 --- a/main/MOD_PlantHydraulic.F90 +++ b/main/MOD_PlantHydraulic.F90 @@ -71,7 +71,7 @@ SUBROUTINE PlantHydraulicStress_twoleaf (nl_soil ,nvegwcs ,z_soi ,& rb, &! boundary resistance from canopy to cas (s m-1) rd, &! aerodynamical resistance between ground and canopy air - ra ! aerodynamic resistance from cas to refence height (s m-1) + ra ! aerodynamic resistance from cas to reference height (s m-1) real(r8),intent(inout) :: & rstfacsun, &! canopy resistance stress factors to soil moisture for sunlit leaf @@ -102,7 +102,7 @@ SUBROUTINE PlantHydraulicStress_twoleaf (nl_soil ,nvegwcs ,z_soi ,& smp, &! soil matrix potential rootfr, &! root fraction hksati, &! hydraulic conductivity at saturation [mm h2o/s] - hk ! soil hydraulic conducatance [mm h2o/s] + hk ! soil hydraulic conductance [mm h2o/s] real(r8),intent(out) :: &! ATTENTION : all for canopy not leaf @@ -214,7 +214,7 @@ SUBROUTINE PlantHydraulicStress_twoleaf (nl_soil ,nvegwcs ,z_soi ,& ! one side leaf boundary layer conductance for water vapor [=1/(2*rb)] ! ATTENTION: rb in CLM is for one side leaf, but for SiB2 rb for ! 2-side leaf, so the gbh2o shold be " 0.5/rb * tprcor/tl " - gb_mol = 1./rb * cf ! resistence to conductance (s/m -> umol/m**2/s) + gb_mol = 1./rb * cf ! resistance to conductance (s/m -> umol/m**2/s) x = vegwp(1:nvegwcs) @@ -446,7 +446,7 @@ SUBROUTINE spacAF_twoleaf(x,nvegwcs,dx,nl_soil,qflx_sun,qflx_sha,laisun,laisha,s grav1 = htop*1000._r8 - !compute conductance attentuation for each segment + !compute conductance attenuation for each segment fsto1 = plc(x(leafsun),psi50_sun,ck) fsto2 = plc(x(leafsha),psi50_sha,ck) fx = plc(x(xyl),psi50_xyl,ck) diff --git a/main/MOD_RainSnowTemp.F90 b/main/MOD_RainSnowTemp.F90 index 32016378..f7bc0775 100644 --- a/main/MOD_RainSnowTemp.F90 +++ b/main/MOD_RainSnowTemp.F90 @@ -214,27 +214,27 @@ SUBROUTINE hydromet_temp(ppa, pta, pqa, pti) ! DESCRIPTION ! =========== ! Computes the temperature of a falling hydrometeor based on Harder, P., Pomeroy, J. (2013). - + ! Original Author: ! ---------------- ! V. Vionnet (11/2020) - + ! References: ! ----------- ! Harder, P., Pomeroy, J. (2013). ! Estimating precipitation phase using a psychrometric energy balance method ! Hydrological Processes 27(13), 1901-1914. https://dx.doi.org/10.1002/hyp.9799 - + ! REVISION HISTORY ! ---------------- ! 2023.07.30 Aobo Tan & Zhongwang Wei @ SYSU - + real(r8), intent(in) :: ppa ! Air pressure (Pa) real(r8), intent(in) :: pta ! Air temperature (deg C) real(r8), intent(in) :: pqa ! Air specific humidity (kg/kg) real(r8), intent(out) :: pti ! Hydrometeor temperature in deg C - + real(r8) :: zd ! Diffusivity of water vapour in air [m^2 s^-1] real(r8) :: zlambda ! Thermal conductivity of air [J m^-1 s^-1 K^-1] real(r8) :: zl ! Latent heat of sublimation or vaporization [J kg^-1] @@ -244,13 +244,13 @@ SUBROUTINE hydromet_temp(ppa, pta, pqa, pti) real(r8) :: zt, ztint, zf, zfdiff, evsat integer :: JITER integer :: JJ, I, NN - + ! 1. Compute diffusivity of water vapour in air [m^2 s^-1] (Thorpe and Mason, 1966) zd = 2.063e-5 * ((pta + 273.15) / 273.15) ** 1.75 - + ! 2. Compute thermal conductivity of air [J m^-1 s^-1 K^-1] zlambda = 0.000063 * (pta + 273.15) + 0.00673 - + ! 3. Compute latent heat of sublimation or vaporization (depending on air temperature) IF (pta < 0.) THEN zl = 1000.0 * (2834.1 - 0.29 * pta - 0.004 * pta ** 2.) @@ -258,35 +258,35 @@ SUBROUTINE hydromet_temp(ppa, pta, pqa, pti) ELSE zl = 1000.0 * (2501.0 - (2.361 * pta)) END IF - + ! 4. Compute density of dry air [kg m^-3] zrhoda = ppa / (287.04 * (pta + 273.15)) - + ! 5. Compute saturated water vapour pressure [Pa] IF (pta > 0) THEN evsat = 611.0 * EXP(17.27 * pta / (pta + 237.3)) ELSE evsat = 611.0 * EXP(21.87 * pta / (pta + 265.5)) END IF - + ! 6. Solve iteratively to get Ti in Harder and Pomeroy (2013) using a Newton-Raphson approach ! Set the first guess to pta zt = pta - + ! Loop until convergence DO JITER = 1, 10 ztint = zt - + IF (zt > 0) THEN esat = 611.0 * EXP(17.27 * zt / (zt + 237.3)) ELSE esat = 611.0 * EXP(21.87 * zt / (zt + 265.5)) END IF - + rho_vast = esat / (461.5 * (zt + 273.15)) ! Saturated water vapour density - + zf = zt - pta - zd * zl / zlambda * (pqa * zrhoda - rho_vast) - + IF (zt > 0) THEN rho_vast_diff = 611.0 / (461.5 * (zt + 273.15)) * EXP(17.27 * zt / (zt + 237.3)) * & (-1 / (zt + 273.15) + 17.27 * 237.3 / ((zt + 237.3) ** 2.)) @@ -294,14 +294,14 @@ SUBROUTINE hydromet_temp(ppa, pta, pqa, pti) rho_vast_diff = 611.0 / (461.5 * (zt + 273.15)) * EXP(21.87 * zt / (zt + 265.5)) * & (-1 / (zt + 273.15) + 21.87 * 265.5 / ((zt + 265.5) ** 2.)) END IF - + zfdiff = 1 + zd * zl / zlambda * rho_vast_diff zt = ztint - zf / zfdiff IF (ABS(zt - ztint) .LT. 0.01) EXIT END DO - + pti = zt - + END SUBROUTINE hydromet_temp END MODULE MOD_RainSnowTemp diff --git a/main/MOD_Runoff.F90 b/main/MOD_Runoff.F90 index d753af82..eeff455f 100644 --- a/main/MOD_Runoff.F90 +++ b/main/MOD_Runoff.F90 @@ -40,12 +40,12 @@ SUBROUTINE SurfaceRunoff_SIMTOP (nl_soil,wimp,porsl,psi0,hksati,& integer, intent(in) :: nl_soil ! number of soil layers real(r8), intent(in) :: & ! wtfact, &! (updated to gridded 'fsatmax' data) fraction of model area with high water table - wimp, &! water impremeable if porosity less than wimp + wimp, &! water impermeable if porosity less than wimp porsl(1:nl_soil), &! saturated volumetric soil water content(porosity) psi0(1:nl_soil), &! saturated soil suction (mm) (NEGATIVE) hksati(1:nl_soil), &! hydraulic conductivity at saturation (mm h2o/s) - fsatmax, &! maximum fraction of saturation area [-] - fsatdcf, &! decay factor in calucation of fraction of saturation area [1/m] + fsatmax, &! maximum fraction of saturation area [-] + fsatdcf, &! decay factor in calculation of fraction of saturation area [1/m] z_soisno(1:nl_soil), &! layer depth (m) dz_soisno(1:nl_soil), &! layer thickness (m) zi_soisno(0:nl_soil), &! interface level below a "z" level (m) @@ -95,7 +95,7 @@ SUBROUTINE SubsurfaceRunoff_SIMTOP (nl_soil, icefrac, dz_soisno, zi_soisno, zwt, ! ARGUMENTS: IMPLICIT NONE - integer, intent(in) :: nl_soil ! + integer, intent(in) :: nl_soil ! real(r8), intent(in) :: icefrac(1:nl_soil) ! ice fraction (-) real(r8), intent(in) :: dz_soisno (1:nl_soil) ! layer depth (m) @@ -138,7 +138,7 @@ SUBROUTINE SubsurfaceRunoff_SIMTOP (nl_soil, icefrac, dz_soisno, zi_soisno, zwt, ! add ice impedance factor to baseflow fracice_rsub = max(0.,exp(-3.*(1.-(icefracsum/dzsum)))-exp(-3.))/(1.0-exp(-3.)) imped = max(0.,1.-fracice_rsub) - rsubst = imped * 5.5e-3 * exp(-2.5*zwt) + rsubst = imped * 5.5e-3 * exp(-2.5*zwt) END SUBROUTINE SubsurfaceRunoff_SIMTOP @@ -188,7 +188,7 @@ SUBROUTINE Runoff_XinAnJiang ( & infil = min(infil, watin) - rsur = (watin - infil) * 1000. / deltim + rsur = (watin - infil) * 1000. / deltim rsubst = 0. ENDIF @@ -221,7 +221,7 @@ SUBROUTINE Runoff_SimpleVIC ( & real(r8) :: btopo, watin, w_int, wsat_int, wtmp, infil real(r8) :: InfilExpFac, WaterDepthMax, WaterDepthInit, RunoffSurface, InfilVarTmp real(r8) :: SoilSaturateFrac - + watin = gwat * deltim / 1000. ! convert mm/s to m IF (watin <= 0.) THEN @@ -235,17 +235,17 @@ SUBROUTINE Runoff_SimpleVIC ( & SoilSaturateFrac = 1.0 - (max(0.0, (1.0-(w_int/wsat_int))))**InfilExpFac SoilSaturateFrac = max(0.0, SoilSaturateFrac) SoilSaturateFrac = min(1.0, SoilSaturateFrac) - + ! Infiltration for the previous time-step soil moisture based on SoilSaturateFrac WaterDepthMax = (1.0 + BVIC) * wsat_int WaterDepthInit = WaterDepthMax * (1.0 - (1.0 - SoilSaturateFrac)**(1.0/BVIC)) - + ! Solve for surface runoff if ( WaterDepthMax <= 0.0 ) then RunoffSurface = watin ELSEIF ( (WaterDepthInit + watin) > WaterDepthMax ) then !RunoffSurface = (WaterDepthInit + w_int) - WaterDepthMax - RunoffSurface = watin - wsat_int + w_int + RunoffSurface = watin - wsat_int + w_int ELSE InfilVarTmp = 1.0 - ((WaterDepthInit +watin ) / WaterDepthMax) RunoffSurface =watin - wsat_int + w_int + wsat_int * (InfilVarTmp**(1.0+BVIC)) @@ -253,7 +253,7 @@ SUBROUTINE Runoff_SimpleVIC ( & IF ( RunoffSurface < 0.0 ) RunoffSurface = 0.0 IF ( RunoffSurface > watin) RunoffSurface = watin - + infil = watin - RunoffSurface rsur= RunoffSurface * 1000. / deltim rsubst = 0. diff --git a/main/MOD_SimpleOcean.F90 b/main/MOD_SimpleOcean.F90 index 2f8ddb06..d162749d 100644 --- a/main/MOD_SimpleOcean.F90 +++ b/main/MOD_SimpleOcean.F90 @@ -32,7 +32,7 @@ SUBROUTINE socean (dosst,deltim,oro,hu,ht,hq,& ! 1. calculate sea surface fluxes, based on CLM ! 2. calculate sea surface albedos and seaice/snow temperatures ! as in NCAR CCM3.6.16 -! Original authors : yongjiu dai and xin-zhong liang (08/30/2001) +! Original authors : Yongjiu Dai and Xin-Zhong Liang (08/30/2001) !----------------------------------------------------------------------- USE MOD_Precision @@ -66,8 +66,8 @@ SUBROUTINE socean (dosst,deltim,oro,hu,ht,hq,& real(r8), intent(out) :: taux ! wind stress: E-W [kg/m/s**2] real(r8), intent(out) :: tauy ! wind stress: N-S [kg/m/s**2] real(r8), intent(out) :: fsena ! sensible heat from reference height to atmosphere [W/m2] - real(r8), intent(out) :: fevpa ! evaporation from refence height to atmosphere [mm/s] - real(r8), intent(out) :: lfevpa ! laten heat from reference height to atmosphere [W/m2] + real(r8), intent(out) :: fevpa ! evaporation from reference height to atmosphere [mm/s] + real(r8), intent(out) :: lfevpa ! latent heat from reference height to atmosphere [W/m2] real(r8), intent(out) :: fseng ! sensible heat flux from ground [W/m2] real(r8), intent(out) :: fevpg ! evaporation heat flux from ground [mm/s] @@ -133,7 +133,7 @@ SUBROUTINE socean (dosst,deltim,oro,hu,ht,hq,& tssea = tssub(1) -! compute surface fluxes, derviatives, and exchange coefficiants +! compute surface fluxes, derivatives, and exchange coefficients CALL seafluxes (oro,hu,ht,hq,& us,vs,tm,qm,rhoair,psrf,tssea,& taux,tauy,fsena,fevpa,fseng,fevpg,tref,qref,& @@ -246,7 +246,7 @@ SUBROUTINE seafluxes (oro,hu,ht,hq,& nmozsgn ! number of times moz changes sign real(r8) :: & - beta, &! coefficient of conective velocity [-] + beta, &! coefficient of convective velocity [-] displax, &! zero-displacement height [m] dth, &! diff of virtual temp. between ref. height and surface dqh, &! diff of humidity between ref. height and surface @@ -277,7 +277,7 @@ SUBROUTINE seafluxes (oro,hu,ht,hq,& xt, &! xq, &! zii, &! convective boundary height [m] - zldis, &! reference height "minus" zero displacement heght [m] + zldis, &! reference height "minus" zero displacement height [m] z0mg, &! roughness length over ground, momentum [m] z0hg, &! roughness length over ground, sensible heat [m] z0qg ! roughness length over ground, latent heat [m] @@ -285,7 +285,7 @@ SUBROUTINE seafluxes (oro,hu,ht,hq,& real, parameter :: zsice = 0.04 ! sea ice aerodynamic roughness length [m] !----------------------------------------------------------------------- -! potential temperatur at the reference height +! potential temperature at the reference height beta = 1. ! - (in computing W_*) zii = 1000. ! m (pbl height) @@ -299,7 +299,7 @@ SUBROUTINE seafluxes (oro,hu,ht,hq,& CALL qsadv(tssea,psrf,eg,degdT,qsatg,qsatgdT) -! potential temperatur at the reference height +! potential temperature at the reference height thm = tm + 0.0098*ht ! intermediate variable equivalent to ! tm*(pgcm/psrf)**(rgas/cpair) th = tm*(100000./psrf)**(rgas/cpair) ! potential T @@ -385,7 +385,7 @@ SUBROUTINE seafluxes (oro,hu,ht,hq,& ENDDO ITERATION ! END stability iteration !---------------------------------------------------------------- -! Get derivative of fluxes with repect to ground temperature +! Get derivative of fluxes with respect to ground temperature ram = 1./(ustar*ustar/um) rah = 1./(vonkar/fh*ustar) raw = 1./(vonkar/fq*ustar) @@ -489,7 +489,7 @@ SUBROUTINE srftsb(isrfty,deltim,fnt,dfntdt,snowh,tsbsf) real(r8) tkbot ! bottom layer top interf thermal conduct real(r8) tkmns ! layer bottom interface thermal conduct real(r8) tkpls ! layer top interface thermal conductivity - real(r8) tksnow ! snow thermal conducitivity + real(r8) tksnow ! snow thermal conductivity real(r8) tktop ! top layer bottom interface thermal conduct real(r8) tmp ! crt - dfntdt(i)*rztop real(r8) zbot ! bottom layer thickness @@ -555,7 +555,7 @@ SUBROUTINE srftsb(isrfty,deltim,fnt,dfntdt,snowh,tsbsf) ! define logical for snow covered surfaces: scvr = snowh.gt.0. -! define thermal properities for each sub/surface layer, starting +! define thermal properties for each sub/surface layer, starting ! with the top layer jndx = isrfty thck = thckly(jndx,1) @@ -571,7 +571,7 @@ SUBROUTINE srftsb(isrfty,deltim,fnt,dfntdt,snowh,tsbsf) tk(1) = tkty ! modify layer 1 fields for snow cover IF present -! snow equivlnt depth times snow liquid water depth gives the physical +! snow equivalent depth times snow liquid water depth gives the physical ! depth of snow for thermal conduction computation; snow is mixed ! uniformly by mass with the top surface layer IF(scvr) THEN diff --git a/main/MOD_SnowFraction.F90 b/main/MOD_SnowFraction.F90 index 2d5e2d5c..183f3a8e 100644 --- a/main/MOD_SnowFraction.F90 +++ b/main/MOD_SnowFraction.F90 @@ -49,7 +49,7 @@ SUBROUTINE snowfraction (lai,sai,z0m,zlnd,scv,snowdp,wt,sigf,fsno) real(r8), intent(out) :: sigf ! fraction of veg cover, excluding snow-covered veg [-] real(r8), intent(out) :: fsno ! fraction of soil covered by snow [-] - real(r8) :: fmelt ! dimensionless metling factor + real(r8) :: fmelt ! dimensionless melting factor real(r8), parameter :: m = 1.0 ! the value of m used in CLM4.5 is 1.0. ! WHILE the value of m given by Niu et al (2007) is 1.6 ! WHILE Niu (2012) suggested 3.0 @@ -111,7 +111,7 @@ SUBROUTINE snowfraction_pftwrap (ipatch,zlnd,scv,snowdp,wt,sigf,fsno) real(r8), intent(out) :: sigf ! fraction of veg cover, excluding snow-covered veg [-] real(r8), intent(out) :: fsno ! fraction of soil covered by snow [-] - real(r8) :: fmelt ! dimensionless metling factor + real(r8) :: fmelt ! dimensionless melting factor real(r8), parameter :: m = 1.0 ! the value of m used in CLM4.5 is 1.0. ! WHILE the value of m given by Niu et al (2007) is 1.6 ! WHILE Niu (2012) suggested 3.0 diff --git a/main/MOD_SnowLayersCombineDivide.F90 b/main/MOD_SnowLayersCombineDivide.F90 index e01a833c..fdf31b14 100644 --- a/main/MOD_SnowLayersCombineDivide.F90 +++ b/main/MOD_SnowLayersCombineDivide.F90 @@ -35,12 +35,13 @@ SUBROUTINE snowcompaction (lb,deltim,imelt,fiold,& ! Original author: Yongjiu Dai, September 15, 1999 ! Revision: Yongjiu Dai, /07/31/2023 ! -! Four of metamorphisms of changing snow characteristics are implemented, -! i.e., destructive, overburden, melt and wind drift. The treatments of the destructive compaction -! was from SNTHERM.89 and SNTHERM.99 (1991, 1999). The contribution due to -! melt metamorphism is simply taken as a ratio of snow ice fraction after -! the melting versus before the melting. The treatments of the overburden comaction and the drifing compaction -! were borrowed from CLM5.0 which based on Vionnet et al. (2012) and van Kampenhout et al (2017). +! Four of metamorphisms of changing snow characteristics are implemented, i.e., +! destructive, overburden, melt and wind drift. The treatments of the +! destructive compaction was from SNTHERM.89 and SNTHERM.99 (1991, 1999). The +! contribution due to melt metamorphism is simply taken as a ratio of snow ice +! fraction after the melting versus before the melting. The treatments of the +! overburden compaction and the drifting compaction were borrowed from CLM5.0 +! which based on Vionnet et al. (2012) and van Kampenhout et al (2017). ! !======================================================================= @@ -50,9 +51,9 @@ SUBROUTINE snowcompaction (lb,deltim,imelt,fiold,& !-------------------------- Dummy argument ----------------------------- - integer, intent(in) :: lb ! lower bound of array + integer, intent(in) :: lb ! lower bound of array real(r8), intent(in) :: deltim ! seconds i a time step [second] - integer, intent(in) :: imelt(lb:0) ! signifies IF node in melting (imelt = 1) + integer, intent(in) :: imelt(lb:0) ! signifies IF node in melting (imelt = 1) real(r8), intent(in) :: fiold(lb:0) ! fraction of ice relative to the total water content at the previous time step real(r8), intent(in) :: t_soisno(lb:0) ! nodal temperature [K] real(r8), intent(in) :: wice_soisno(lb:0) ! ice lens [kg/m2] @@ -166,17 +167,21 @@ END SUBROUTINE snowcompaction - !----------------------------------------------------------------------- SUBROUTINE winddriftcompaction(bi,forc_wind,dz,zpseudo,mobile,compaction_rate) -! Compute wind drift compaction for a single column and level. -! Also updates zpseudo and mobile for this column. However, zpseudo remains unchanged -! IF mobile is already false or becomes false within this SUBROUTINE. +!======================================================================= +! Original author: Yongjiu Dai, September 15, 1999 +! Revision: Yongjiu Dai, /07/31/2023 +! +! Compute wind drift compaction for a single column and level. Also updates +! zpseudo and mobile for this column. However, zpseudo remains unchanged IF +! mobile is already false or becomes false within this SUBROUTINE. ! -! The structure of the updates done here for zpseudo and mobile requires that this -! SUBROUTINE be called first for the top layer of snow, THEN for the 2nd layer down, -! etc. - and finally for the bottom layer. Before beginning the loops over layers, -! mobile should be initialized to .true. and zpseudo should be initialized to 0. +! The structure of the updates done here for zpseudo and mobile requires that +! this SUBROUTINE be called first for the top layer of snow, THEN for the 2nd +! layer down, etc. - and finally for the bottom layer. Before beginning the +! loops over layers, mobile should be initialized to .true. and zpseudo should +! be initialized to 0. ! ! !USES: USE MOD_Precision @@ -257,7 +262,7 @@ SUBROUTINE snowlayerscombine (lb,snl, & ! numbering from 1 (bottom) mss (surface) real(r8), intent(inout) :: wice_soisno(lb:1) ! ice lens [kg/m2] real(r8), intent(inout) :: wliq_soisno(lb:1) ! liquid water {kg/m2] - real(r8), intent(inout) :: t_soisno (lb:1) ! nodel temperature [K] + real(r8), intent(inout) :: t_soisno (lb:1) ! node temperature [K] real(r8), intent(inout) :: dz_soisno (lb:1) ! layer thickness [m] real(r8), intent(inout) :: z_soisno (lb:1) ! node depth [m] real(r8), intent(inout) :: zi_soisno (lb-1:1) ! depth of layer interface [m] @@ -391,7 +396,7 @@ SUBROUTINE snowlayerscombine (lb,snl, & IF(snl >= -1) EXIT -! The layer thickness great than the prescibed minimum value +! The layer thickness great than the prescribed minimum value ELSE mssi = mssi + 1 @@ -431,7 +436,7 @@ SUBROUTINE snowlayersdivide (lb,snl,z_soisno,dz_soisno,zi_soisno,wliq_soisno,wic integer, intent(inout) :: snl ! Number of snow real(r8), intent(inout) :: wice_soisno(lb:0) ! ice lens [kg/m2] real(r8), intent(inout) :: wliq_soisno(lb:0) ! liquid water [kg/m2] - real(r8), intent(inout) :: t_soisno (lb:0) ! Nodel temperature [K] + real(r8), intent(inout) :: t_soisno (lb:0) ! Node temperature [K] real(r8), intent(inout) :: dz_soisno (lb:0) ! Layer thickness [m] real(r8), intent(inout) :: z_soisno (lb:0) ! Node depth [m] real(r8), intent(inout) :: zi_soisno (lb-1:0) ! Depth of layer interface [m] @@ -524,7 +529,7 @@ SUBROUTINE snowlayersdivide (lb,snl,z_soisno,dz_soisno,zi_soisno,wliq_soisno,wic CALL combo(dzsno(3),swliq(3),swice(3),tsno(3), & drr, zwliq, zwice, tsno(2)) -! write(6,*)'Subdivided 50 mm from the subsface layer & +! write(6,*)'Subdivided 50 mm from the subsurface layer & ! &and combined into underlying neighbor' IF(msno <= 3 .and. dzsno(3) > 0.18)THEN @@ -641,7 +646,7 @@ SUBROUTINE combo ( dz_soisno, wliq_soisno, wice_soisno, t, & real(r8), intent(inout) :: dz_soisno ! nodal thickness of 1 elements being combined [m] real(r8), intent(inout) :: wliq_soisno ! liquid water of element 1 real(r8), intent(inout) :: wice_soisno ! ice of element 1 [kg/m2] - real(r8), intent(inout) :: t ! nodel temperature of elment 1 [K] + real(r8), intent(inout) :: t ! node temperature of elment 1 [K] !----------------------- Local variables ------------------------------ @@ -707,7 +712,7 @@ SUBROUTINE SnowLayersCombine_snicar (lb,snl, & ! numbering from 1 (bottom) mss (surface) real(r8), intent(inout) :: wice_soisno(lb:1) ! ice lens [kg/m2] real(r8), intent(inout) :: wliq_soisno(lb:1) ! liquid water {kg/m2] - real(r8), intent(inout) :: t_soisno (lb:1) ! nodel temperature [K] + real(r8), intent(inout) :: t_soisno (lb:1) ! node temperature [K] real(r8), intent(inout) :: dz_soisno (lb:1) ! layer thickness [m] real(r8), intent(inout) :: z_soisno (lb:1) ! node depth [m] real(r8), intent(inout) :: zi_soisno (lb-1:1) ! depth of layer interface [m] @@ -924,7 +929,7 @@ SUBROUTINE SnowLayersCombine_snicar (lb,snl, & IF(snl >= -1) EXIT -! The layer thickness great than the prescibed minimum value +! The layer thickness great than the prescribed minimum value ELSE mssi = mssi + 1 @@ -973,7 +978,7 @@ SUBROUTINE SnowLayersDivide_snicar (lb,snl,z_soisno,dz_soisno,zi_soisno,& integer, intent(inout) :: snl ! Number of snow real(r8), intent(inout) :: wice_soisno(lb:0) ! ice lens [kg/m2] real(r8), intent(inout) :: wliq_soisno(lb:0) ! liquid water [kg/m2] - real(r8), intent(inout) :: t_soisno (lb:0) ! Nodel temperature [K] + real(r8), intent(inout) :: t_soisno (lb:0) ! Node temperature [K] real(r8), intent(inout) :: dz_soisno (lb:0) ! Layer thickness [m] real(r8), intent(inout) :: z_soisno (lb:0) ! Node depth [m] real(r8), intent(inout) :: zi_soisno (lb-1:0) ! Depth of layer interface [m] @@ -997,7 +1002,7 @@ SUBROUTINE SnowLayersDivide_snicar (lb,snl,z_soisno,dz_soisno,zi_soisno,& real(r8) :: dzsno(5) ! Snow layer thickness [m] real(r8) :: swice(5) ! Partial volume of ice [m3/m3] real(r8) :: swliq(5) ! Partial volume of liquid water [m3/m3] - real(r8) :: tsno(5) ! Nodel temperature [K] + real(r8) :: tsno(5) ! Node temperature [K] integer k ! number of DO looping integer msno ! number of snow layer 1 (top) to msno (bottom) @@ -1132,7 +1137,7 @@ SUBROUTINE SnowLayersDivide_snicar (lb,snl,z_soisno,dz_soisno,zi_soisno,& mss_aerosol(3,:) = z_mss_aerosol(:) + mss_aerosol(3,:) !Aerosol Fluxes (January 07, 2023) -! write(6,*)'Subdivided 50 mm from the subsface layer & +! write(6,*)'Subdivided 50 mm from the subsurface layer & ! &and combined into underlying neighbor' IF(msno <= 3 .and. dzsno(3) > 0.18)THEN diff --git a/main/MOD_SnowSnicar.F90 b/main/MOD_SnowSnicar.F90 index 33f5f6e0..063a6c72 100644 --- a/main/MOD_SnowSnicar.F90 +++ b/main/MOD_SnowSnicar.F90 @@ -37,7 +37,7 @@ MODULE MOD_SnowSnicar !-------------------------------------------------------------------- ! DAI, Dec. 29, 2022 -! Temporay setting +! Temporary setting logical, parameter :: use_extrasnowlayers = .false. character(len=256), parameter :: snow_shape = 'sphere' ! (=1), 'spheroid'(=2), 'hexagonal_plate'(=3), 'koch_snowflake'(=4) @@ -56,7 +56,7 @@ MODULE MOD_SnowSnicar ! !PUBLIC MEMBER FUNCTIONS: PUBLIC :: SNICAR_RT ! Snow albedo and vertically-resolved solar absorption PUBLIC :: SNICAR_AD_RT ! Snow albedo and vertically-resolved solar absorption by adding-doubling solution - ! To USE this subtroutine, set use_snicar_ad = true + ! To USE this subroutine, set use_snicar_ad = true PUBLIC :: SnowAge_grain ! Snow effective grain size evolution PUBLIC :: SnowAge_init ! Initial read in of snow-aging file PUBLIC :: SnowOptics_init ! Initial read in of snow-optics file @@ -72,11 +72,11 @@ MODULE MOD_SnowSnicar integer, parameter :: nir_bnd_bgn = 2 ! first band index in near-IR spectrum [idx] integer, parameter :: nir_bnd_end = 5 ! ending near-IR band index [idx] integer, parameter :: idx_Mie_snw_mx = 1471 ! number of effective radius indices used in Mie lookup table [idx] - integer, parameter :: idx_T_max = 11 ! maxiumum temperature index used in aging lookup table [idx] + integer, parameter :: idx_T_max = 11 ! maximum temperature index used in aging lookup table [idx] integer, parameter :: idx_T_min = 1 ! minimum temperature index used in aging lookup table [idx] - integer, parameter :: idx_Tgrd_max = 31 ! maxiumum temperature gradient index used in aging lookup table [idx] + integer, parameter :: idx_Tgrd_max = 31 ! maximum temperature gradient index used in aging lookup table [idx] integer, parameter :: idx_Tgrd_min = 1 ! minimum temperature gradient index used in aging lookup table [idx] - integer, parameter :: idx_rhos_max = 8 ! maxiumum snow density index used in aging lookup table [idx] + integer, parameter :: idx_rhos_max = 8 ! maximum snow density index used in aging lookup table [idx] integer, parameter :: idx_rhos_min = 1 ! minimum snow density index used in aging lookup table [idx] #ifdef MODAL_AER @@ -93,7 +93,7 @@ MODULE MOD_SnowSnicar #endif integer, parameter :: snw_rds_max_tbl = 1500 ! maximum effective radius defined in Mie lookup table [microns] - integer, parameter :: snw_rds_min_tbl = 30 ! minimium effective radius defined in Mie lookup table [microns] + integer, parameter :: snw_rds_min_tbl = 30 ! minimum effective radius defined in Mie lookup table [microns] real(r8), parameter :: snw_rds_max = 1500._r8 ! maximum allowed snow effective radius [microns] real(r8), parameter :: snw_rds_min = 54.526_r8 ! minimum allowed snow effective radius (also "fresh snow" value) [microns real(r8), parameter :: snw_rds_refrz = 1000._r8 ! effective radius of re-frozen snow [microns] diff --git a/main/MOD_SoilSnowHydrology.F90 b/main/MOD_SoilSnowHydrology.F90 index 2138e6bc..420d1270 100644 --- a/main/MOD_SoilSnowHydrology.F90 +++ b/main/MOD_SoilSnowHydrology.F90 @@ -96,7 +96,7 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& ! wtfact ,&! (updated to gridded 'fsatmax' data) fraction of model area with high water table pondmx ,&! ponding depth (mm) ssi ,&! irreducible water saturation of snow - wimp ,&! water impremeable if porosity less than wimp + wimp ,&! water impermeable if porosity less than wimp smpmin ,&! restriction for min of soil poten. (mm) topostd ,&! standard deviation of elevation (m) BVIC ,&! @@ -110,9 +110,9 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& psi0(1:nl_soil) ,&! saturated soil suction (mm) (NEGATIVE) hksati(1:nl_soil) ,&! hydraulic conductivity at saturation (mm h2o/s) theta_r(1:nl_soil) ,&! residual moisture content [-] - fsatmax ,&! maximum saturated area fraction [-] - fsatdcf ,&! decay factor in calucation of saturated area fraction [1/m] - rootr(1:nl_soil) ,&! water uptake farction from different layers, all layers add to 1.0 + fsatmax ,&! maximum saturated area fraction [-] + fsatdcf ,&! decay factor in calculation of saturated area fraction [1/m] + rootr(1:nl_soil) ,&! water uptake fraction from different layers, all layers add to 1.0 rootflux(1:nl_soil) ,&! root uptake from different layer, all layers add to transpiration t_soisno(lb:nl_soil) ,&! soil/snow skin temperature (K) @@ -145,7 +145,7 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& real(r8), intent(out) :: & smp(1:nl_soil) ,&! soil matrix potential [mm] hk (1:nl_soil) ! hydraulic conductivity [mm h2o/m] - + real(r8), intent(inout) :: & zwt ,&! the depth from ground (soil) surface to water table [m] wa ! water storage in aquifer [mm] @@ -181,8 +181,8 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& dwat(1:nl_soil) ,&! change in soil water gwat ,&! net water input from top (mm/s) rsubst ,&! subsurface runoff (mm h2o/s) - vol_liq(1:nl_soil) ,&! partitial volume of liquid water in layer - vol_ice(1:nl_soil) ,&! partitial volume of ice lens in layer + vol_liq(1:nl_soil) ,&! partial volume of liquid water in layer + vol_ice(1:nl_soil) ,&! partial volume of ice lens in layer icefrac(1:nl_soil) ,&! ice fraction (-) zmm (1:nl_soil) ,&! layer depth (mm) dzmm(1:nl_soil) ,&! layer thickness (mm) @@ -195,7 +195,7 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& #ifdef CROP integer :: ps, pe - integer :: irrig_flag ! 1 IF sprinker, 2 IF others + integer :: irrig_flag ! 1 IF sprinkler, 2 IF others real(r8) :: qflx_irrig_drip real(r8) :: qflx_irrig_sprinkler real(r8) :: qflx_irrig_flood @@ -267,10 +267,10 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& IF(patchtype<=1)THEN ! soil ground only - ! For water balance check, the sum of water in soil column before the calcultion + ! For water balance check, the sum of water in soil column before the calculation w_sum = sum(wliq_soisno(1:)) + sum(wice_soisno(1:)) + wa - ! porosity of soil, partitial volume of ice and liquid + ! porosity of soil, partial volume of ice and liquid DO j = 1, nl_soil vol_ice(j) = min(porsl(j), wice_soisno(j)/(dz_soisno(j)*denice)) eff_porosity(j) = max(0.01, porsl(j)-vol_ice(j)) @@ -282,7 +282,7 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& ENDIF ENDDO - ! surface runoff including water table and surface staturated area + ! surface runoff including water table and surface saturated area rsur = 0. rsubst = 0. @@ -329,7 +329,7 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& #if(defined CaMa_Flood) IF (LWINFILT) THEN ! re-infiltration [mm/s] calculation. - ! IF surface runoff is ocurred (rsur != 0.), flood depth <1.e-6 and flood frction <0.05, + ! IF surface runoff is occurred (rsur != 0.), flood depth <1.e-6 and flood fraction <0.05, ! the re-infiltration will not be calculated. IF ((flddepth .gt. 1.e-6).and.(fldfrc .gt. 0.05) .and. (patchtype == 0) ) THEN gfld=flddepth/deltim ! [mm/s] @@ -337,7 +337,7 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& ! otherwise, the surface runoff will be double counted. ! only the re-infiltration is added to water balance calculation. IF (DEF_Runoff_SCHEME == 0) THEN - + CALL SurfaceRunoff_SIMTOP (nl_soil,wimp,porsl,psi0,hksati,1.0,fsatdcf,& z_soisno(1:),dz_soisno(1:),zi_soisno(0:),& eff_porosity,icefrac,zwt,gfld,rsur_fld) @@ -358,7 +358,7 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& BVIC, gfld, deltim, rsur_fld, rsubst) ENDIF ! infiltration into surface soil layer - qinfl_fld_subgrid = gfld - rsur_fld !assume the re-infiltration is occured in whole patch area. + qinfl_fld_subgrid = gfld - rsur_fld !assume the re-infiltration is occurred in whole patch area. ELSE qinfl_fld_subgrid=0.0d0 gfld=0.0d0 @@ -543,7 +543,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& integer, intent(in) :: & lb , &! lower bound of array - nl_soil ! upper bound of array + nl_soil ! upper bound of array real(r8), intent(in) :: & deltim , &! time step (s) @@ -552,14 +552,14 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& pondmx , &! ponding depth (mm) wimp , &! water impremeable IF porosity less than wimp topostd , &! standard deviation of elevation (m) - BVIC , &! + BVIC , &! z_soisno (lb:nl_soil) , &! layer depth (m) dz_soisno(lb:nl_soil) , &! layer thickness (m) zi_soisno(lb-1:nl_soil) , &! interface level below a "z" level (m) - bsw (1:nl_soil), &! clapp and hornberger "b" parameter [-] + bsw (1:nl_soil), & ! clapp and hornberger "b" parameter [-] theta_r (1:nl_soil), & ! residual moisture content [-] - fsatmax , & ! maximum saturated area fraction [-] - fsatdcf , & ! decay factor in calucation of saturated area fraction [1/m] + fsatmax , & ! maximum saturated area fraction [-] + fsatdcf , & ! decay factor in calculation of saturated area fraction [1/m] #ifdef vanGenuchten_Mualem_SOIL_MODEL alpha_vgm(1:nl_soil), & ! a parameter corresponding approximately to the inverse of the air-entry value n_vgm (1:nl_soil), & ! a shape parameter [dimensionless] @@ -570,7 +570,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& porsl(1:nl_soil) , &! saturated volumetric soil water content(porosity) psi0(1:nl_soil) , &! saturated soil suction (mm) (NEGATIVE) hksati(1:nl_soil), &! hydraulic conductivity at saturation (mm h2o/s) - rootr(1:nl_soil) , &! water uptake farction from different layers, all layers add to 1.0 + rootr(1:nl_soil) , &! water uptake fraction from different layers, all layers add to 1.0 rootflux(1:nl_soil),&! root uptake from different layer, all layers add to transpiration t_soisno(lb:nl_soil), &! soil/snow skin temperature (K) @@ -659,7 +659,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& #ifdef CROP integer :: ps, pe - integer :: irrig_flag ! 1 if sprinker, 2 if others + integer :: irrig_flag ! 1 if sprinkler, 2 if others real(r8) :: qflx_irrig_drip real(r8) :: qflx_irrig_sprinkler real(r8) :: qflx_irrig_flood @@ -746,7 +746,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& IF((patchtype<=1) .or. is_dry_lake)THEN ! soil ground only - ! For water balance check, the sum of water in soil column before the calcultion + ! For water balance check, the sum of water in soil column before the calculation w_sum = sum(wliq_soisno(1:nl_soil)) + sum(wice_soisno(1:nl_soil)) + wa + wdsrf ! Due to the increase in volume after freezing, the total volume of water and @@ -754,7 +754,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& ! stored in "wresi". After calculating the movement of soil water, "wresi" ! is added back to "wliq_soisno". wresi(1:nl_soil) = 0. - ! porosity of soil, partitial volume of ice and liquid + ! porosity of soil, partial volume of ice and liquid DO j = 1, nl_soil vol_ice(j) = min(porsl(j), wice_soisno(j)/(dz_soisno(j)*denice)) IF(porsl(j) < 1.e-6)THEN @@ -774,7 +774,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& ENDIF ENDDO - ! surface runoff including water table and surface staturated area + ! surface runoff including water table and surface saturated area rsur = 0. rsubst = 0. @@ -850,7 +850,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& #if(defined CaMa_Flood) IF (LWINFILT) THEN ! re-infiltration [mm/s] calculation. - ! IF surface runoff is ocurred (rsur != 0.), flood depth <1.e-6 and flood frction <0.05, + ! IF surface runoff is occurred (rsur != 0.), flood depth <1.e-6 and flood fraction <0.05, ! the re-infiltration will not be calculated. IF ((flddepth .gt. 1.e-6).and.(fldfrc .gt. 0.05) .and. (patchtype == 0) ) THEN gfld=flddepth/deltim ! [mm/s] @@ -858,7 +858,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& ! otherwise, the surface runoff will be double counted. ! only the re-infiltration is added to water balance calculation. IF (DEF_Runoff_SCHEME == 0) THEN - + CALL SurfaceRunoff_SIMTOP (nl_soil,wimp,porsl,psi0,hksati,1.0,fsatdcf,& z_soisno(1:),dz_soisno(1:),zi_soisno(0:),& eff_porosity,icefrac,zwt,gfld,rsur_fld) @@ -879,7 +879,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& BVIC, gfld, deltim, rsur_fld, rsubst) ENDIF ! infiltration into surface soil layer - qinfl_fld_subgrid = gfld - rsur_fld !assume the re-infiltration is occured in whole patch area. + qinfl_fld_subgrid = gfld - rsur_fld !assume the re-infiltration is occurred in whole patch area. ELSE qinfl_fld_subgrid=0.0d0 gfld=0.0d0 @@ -901,7 +901,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& sp_zc(1:nl_soil) = z_soisno (1:nl_soil) * 1000.0 ! from meter to mm sp_zi(0:nl_soil) = zi_soisno(0:nl_soil) * 1000.0 ! from meter to mm - ! check consistancy between water table location and liquid water content + ! check consistency between water table location and liquid water content DO j = 1, nl_soil IF ((vol_liq(j) < eff_porosity(j)-1.e-8) .and. (zwtmm <= sp_zi(j-1))) THEN zwtmm = sp_zi(j) @@ -1069,7 +1069,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& #if(defined CoLMDEBUG) IF(abs(err_solver) > 1.e-3)THEN - write(6,'(A,E20.5,A,I0)') 'Warning (WATER_VSF): water balance violation', err_solver, & + write(6,'(A,E20.5,A,I0)') 'Warning (WATER_VSF): water balance violation', err_solver, & ' in element ', landpatch%eindex(ipatch) ENDIF IF (any(wliq_soisno < -1.e-3)) THEN @@ -1145,12 +1145,13 @@ SUBROUTINE snowwater (lb,deltim,ssi,wimp, & !----------------------------------------------------------------------- ! Original author : Yongjiu Dai, /09/1999; /04/2014 ! -! Water flow wihtin snow is computed by an explicit and non-physical based scheme, -! which permits a part of liquid water over the holding capacity (a tentative value -! is used, i.e., equal to 0.033*porosity) to percolate into the underlying layer, -! except the case of that the porosity of one of the two neighboring layers is -! less than 0.05, the zero flow is assumed. The water flow out of the bottom -! snow pack will participate as the input of the soil water and runoff. +! Water flow within snow is computed by an explicit and non-physical based +! scheme, which permits a part of liquid water over the holding capacity (a +! tentative value is used, i.e., equal to 0.033*porosity) to percolate into the +! underlying layer, except the case of that the porosity of one of the two +! neighboring layers is less than 0.05, the zero flow is assumed. The water +! flow out of the bottom snow pack will participate as the input of the soil +! water and runoff. ! !----------------------------------------------------------------------- @@ -1165,7 +1166,7 @@ SUBROUTINE snowwater (lb,deltim,ssi,wimp, & real(r8), intent(in) :: & deltim, &! seconds in a time step (s) ssi, &! irreducible water saturation of snow - wimp, &! water impremeable if porosity less than wimp + wimp, &! water impermeable if porosity less than wimp dz_soisno(lb:0), &! layer thickness (m) pg_rain, &! rainfall after removal of interception (mm h2o/s) @@ -1182,20 +1183,20 @@ SUBROUTINE snowwater (lb,deltim,ssi,wimp, & qout_snowb ! rate of water out of snow bottom (mm/s) !----------------------- local variables -------------------------------- - integer j ! k do loop/array indices + integer j ! k do loop/array indices real(r8) :: & - qin, &! water flow into the elmement (mm/s) - qout, &! water flow out of the elmement (mm/s) + qin, &! water flow into the element (mm/s) + qout, &! water flow out of the element (mm/s) zwice, &! the sum of ice mass of snow cover (kg/m2) wgdif, &! ice mass after minus sublimation - vol_liq(lb:0), &! partitial volume of liquid water in layer - vol_ice(lb:0), &! partitial volume of ice lens in layer + vol_liq(lb:0), &! partial volume of liquid water in layer + vol_ice(lb:0), &! partial volume of ice lens in layer eff_porosity(lb:0) ! effective porosity = porosity - vol_ice !======================================================================= -! renew the mass of ice lens (wice_soisno) and liquid (wliq_soisno) in the surface snow layer, -! resulted by sublimation (frost) / evaporation (condense) +! renew the mass of ice lens (wice_soisno) and liquid (wliq_soisno) in the +! surface snow layer, resulted by sublimation (frost) / evaporation (condense) wgdif = wice_soisno(lb) + (qfros - qsubl)*deltim wice_soisno(lb) = wgdif @@ -1210,20 +1211,20 @@ SUBROUTINE snowwater (lb,deltim,ssi,wimp, & wliq_soisno(lb) = 0. ENDIF -! Porosity and partitial volume +! Porosity and partial volume DO j = lb, 0 vol_ice(j) = min(1., wice_soisno(j)/(dz_soisno(j)*denice)) eff_porosity(j) = max(0.01, 1. - vol_ice(j)) vol_liq(j) = min(eff_porosity(j), wliq_soisno(j)/(dz_soisno(j)*denh2o)) ENDDO -! Capillary force within snow could be two or more orders of magnitude -! less than those of gravity, this term may be ignored. -! Here we could keep the garavity term only. The genernal expression -! for water flow is "K * ss**3", however, no effective paramterization -! for "K". Thus, a very simple treatment (not physical based) is introduced: -! when the liquid water of layer exceeds the layer's holding -! capacity, the excess meltwater adds to the underlying neighbor layer. +! Capillary force within snow could be two or more orders of magnitude less +! than those of gravity, this term may be ignored. Here we could keep the +! gravity term only. The general expression for water flow is "K * ss**3", +! however, no effective parameterization for "K". Thus, a very simple treatment +! (not physical based) is introduced: when the liquid water of layer exceeds +! the layer's holding capacity, the excess meltwater adds to the underlying +! neighbor layer. qin = 0. DO j= lb, 0 @@ -1267,12 +1268,13 @@ SUBROUTINE SnowWater_snicar (lb,deltim,ssi,wimp, & !----------------------------------------------------------------------- ! Original author : Yongjiu Dai, /09/1999, /04/2014, /01/2023/ ! -! Water flow wihtin snow is computed by an explicit and non-physical based scheme, -! which permits a part of liquid water over the holding capacity (a tentative value -! is used, i.e., equal to 0.033*porosity) to percolate into the underlying layer, -! except the case of that the porosity of one of the two neighboring layers is -! less than 0.05, the zero flow is assumed. The water flow out of the bottom -! snow pack will participate as the input of the soil water and runoff. +! Water flow within snow is computed by an explicit and non-physical based +! scheme, which permits a part of liquid water over the holding capacity (a +! tentative value is used, i.e., equal to 0.033*porosity) to percolate into the +! underlying layer, except the case of that the porosity of one of the two +! neighboring layers is less than 0.05, the zero flow is assumed. The water +! flow out of the bottom snow pack will participate as the input of the soil +! water and runoff. ! ! REVISIONS: ! Yongjiu Dai, 01/2023: added Aerosol fluxes from SNICAR model @@ -1290,7 +1292,7 @@ SUBROUTINE SnowWater_snicar (lb,deltim,ssi,wimp, & real(r8), intent(in) :: & deltim, &! seconds in a time step (s) ssi, &! irreducible water saturation of snow - wimp, &! water impremeable if porosity less than wimp + wimp, &! water impermeable if porosity less than wimp dz_soisno(lb:0), &! layer thickness (m) pg_rain, &! rainfall after removal of interception (mm h2o/s) @@ -1324,12 +1326,12 @@ SUBROUTINE SnowWater_snicar (lb,deltim,ssi,wimp, & integer j ! do loop/array indices real(r8) :: & - qin, &! water flow into the elmement (mm/s) - qout, &! water flow out of the elmement (mm/s) + qin, &! water flow into the element (mm/s) + qout, &! water flow out of the element (mm/s) zwice, &! the sum of ice mass of snow cover (kg/m2) wgdif, &! ice mass after minus sublimation - vol_liq(lb:0), &! partitial volume of liquid water in layer - vol_ice(lb:0), &! partitial volume of ice lens in layer + vol_liq(lb:0), &! partial volume of liquid water in layer + vol_ice(lb:0), &! partial volume of ice lens in layer eff_porosity(lb:0) ! effective porosity = porosity - vol_ice ! Aerosol Fluxes (Jan. 07, 2023) @@ -1408,20 +1410,20 @@ SUBROUTINE SnowWater_snicar (lb,deltim,ssi,wimp, & wliq_soisno(lb) = wliq_soisno(lb) + (pg_rain + qsdew - qseva)*deltim wliq_soisno(lb) = max(0., wliq_soisno(lb)) -! Porosity and partitial volume +! Porosity and partial volume DO j = lb, 0 vol_ice(j) = min(1., wice_soisno(j)/(dz_soisno(j)*denice)) eff_porosity(j) = max(0.01, 1. - vol_ice(j)) vol_liq(j) = min(eff_porosity(j), wliq_soisno(j)/(dz_soisno(j)*denh2o)) ENDDO -! Capillary force within snow could be two or more orders of magnitude -! less than those of gravity, this term may be ignored. -! Here we could keep the garavity term only. The genernal expression -! for water flow is "K * ss**3", however, no effective paramterization -! for "K". Thus, a very simple treatment (not physical based) is introduced: -! when the liquid water of layer exceeds the layer's holding -! capacity, the excess meltwater adds to the underlying neighbor layer. +! Capillary force within snow could be two or more orders of magnitude less +! than those of gravity, this term may be ignored. Here we could keep the +! gravity term only. The general expression for water flow is "K * ss**3", +! however, no effective parameterization for "K". Thus, a very simple treatment +! (not physical based) is introduced: when the liquid water of layer exceeds +! the layer's holding capacity, the excess meltwater adds to the underlying +! neighbor layer. ! Aerosol Fluxes (Jan. 07, 2023) ! Also compute aerosol fluxes through snowpack in this loop: @@ -1775,7 +1777,7 @@ SUBROUTINE soilwater(patchtype,nl_soil,deltim,wimp,smpmin,& integer , intent(in) :: patchtype ! land patch type integer , intent(in) :: nl_soil ! number of soil layers real(r8), intent(in) :: deltim ! land model time step (sec) - real(r8), intent(in) :: wimp ! water impremeable if porosity less than wimp + real(r8), intent(in) :: wimp ! water impermeable if porosity less than wimp real(r8), intent(in) :: smpmin ! restriction for min of soil potential (mm) real(r8), intent(in) :: qinfl ! infiltration (mm H2O /s) @@ -2073,21 +2075,21 @@ SUBROUTINE groundwater (nl_soil,deltim,pondmx,& ! ARGUMENTS: IMPLICIT NONE - integer, intent(in) :: nl_soil ! + integer , intent(in) :: nl_soil ! real(r8), intent(in) :: deltim ! land model time step (sec) real(r8), intent(in) :: pondmx ! - real(r8), intent(in) :: eff_porosity(1:nl_soil) ! effective porosity = porosity - vol_ice - real(r8), intent(in) :: icefrac(1:nl_soil) ! ice fraction (-) + real(r8), intent(in) :: eff_porosity(1:nl_soil) ! effective porosity = porosity - vol_ice + real(r8), intent(in) :: icefrac(1:nl_soil) ! ice fraction (-) - real(r8), intent(in) :: dz_soisno (1:nl_soil) ! layer depth (m) - real(r8), intent(in) :: zi_soisno (0:nl_soil) ! interface level below a "z" level (m) - real(r8), intent(inout) :: wice_soisno(1:nl_soil) ! ice lens (kg/m2) - real(r8), intent(inout) :: wliq_soisno(1:nl_soil) ! liquid water (kg/m2) + real(r8), intent(in) :: dz_soisno (1:nl_soil) ! layer depth (m) + real(r8), intent(in) :: zi_soisno (0:nl_soil) ! interface level below a "z" level (m) + real(r8), intent(inout) :: wice_soisno(1:nl_soil) ! ice lens (kg/m2) + real(r8), intent(inout) :: wliq_soisno(1:nl_soil) ! liquid water (kg/m2) - real(r8), intent(in) :: porsl(1:nl_soil) ! volumetric soil water at saturation (porosity) - real(r8), intent(in) :: psi0(1:nl_soil) ! minimum soil suction (mm) [-] - real(r8), intent(in) :: bsw(1:nl_soil) ! Clapp and Hornberger "b" + real(r8), intent(in) :: porsl(1:nl_soil) ! volumetric soil water at saturation (porosity) + real(r8), intent(in) :: psi0(1:nl_soil) ! minimum soil suction (mm) [-] + real(r8), intent(in) :: bsw(1:nl_soil) ! Clapp and Hornberger "b" real(r8), intent(inout) :: zwt ! the depth from ground (soil) surface to water table [m] real(r8), intent(inout) :: wa ! water in the unconfined aquifer (mm) @@ -2124,8 +2126,8 @@ SUBROUTINE groundwater (nl_soil,deltim,pondmx,& real(r8) :: imped - real(r8), parameter :: watmin = 0.01 ! Limit irreduciable wrapping liquid water - ! a tunable constant + real(r8), parameter :: watmin = 0.01 ! Limit irreducible wrapping liquid water + ! a tunable constant real(r8), parameter :: rsbmx = 5.0 ! baseflow coefficient [mm/s] real(r8), parameter :: timean = 10.5 ! global mean topographic index @@ -2274,7 +2276,7 @@ SUBROUTINE groundwater (nl_soil,deltim,pondmx,& ! Correction [1] - ! NON-physically based corection on wliq_soisno + ! NON-physically based correction on wliq_soisno ! excessive water above saturation added to the above unsaturated layer like a bucket ! IF column over saturated, excess water goes to runoff @@ -2298,7 +2300,7 @@ SUBROUTINE groundwater (nl_soil,deltim,pondmx,& ! Correction [2] - ! NON-physically based corection on wliq_soisno + ! NON-physically based correction on wliq_soisno ! Limit wliq_soisno to be greater than or equal to watmin. ! Get water needed to bring wliq_soisno equal watmin from lower layer. ! If insufficient water in soil layers, get from aquifer water diff --git a/main/MOD_SoilSurfaceResistance.F90 b/main/MOD_SoilSurfaceResistance.F90 index 43e8a239..2fa6e3e9 100644 --- a/main/MOD_SoilSurfaceResistance.F90 +++ b/main/MOD_SoilSurfaceResistance.F90 @@ -99,7 +99,7 @@ SUBROUTINE SoilSurfaceResistance (nl_soil,forc_rhoair,hksati,porsl,psi0, & !-----------------------Local Variables------------------------------ REAL(r8) :: & - wx, &! patitial volume of ice and water of surface layer + wx, &! patial volume of ice and water of surface layer vol_liq, &! water content by volume [m3/m3] s_node, &! vol_liq/porosity smp_node, &! matrix potential [m] diff --git a/main/MOD_SoilThermalParameters.F90 b/main/MOD_SoilThermalParameters.F90 index aed0a992..71a4b3c1 100644 --- a/main/MOD_SoilThermalParameters.F90 +++ b/main/MOD_SoilThermalParameters.F90 @@ -53,8 +53,8 @@ SUBROUTINE hCapacity (patchtype,lb,nl_soil,csol,porsl,wice_soisno,wliq_soisno,sc real(r8), intent(in) :: csol(1:nl_soil) ! heat capacity of soil soilds [J/(m3 K)] real(r8), intent(in) :: porsl(1:nl_soil) ! soil porosity real(r8), intent(in) :: wice_soisno(lb:nl_soil) ! ice lens [kg/m2] - real(r8), intent(in) :: wliq_soisno(lb:nl_soil) ! liqui water [kg/m2] - real(r8), intent(in) :: dz_soisno(lb:nl_soil) ! layer thickiness [m] + real(r8), intent(in) :: wliq_soisno(lb:nl_soil) ! liquid water [kg/m2] + real(r8), intent(in) :: dz_soisno(lb:nl_soil) ! layer thickness [m] real(r8), intent(in) :: scv ! snow water equivalent [mm] real(r8), intent(out) :: cv(lb:nl_soil) ! heat capacity [J/(m2 K)] @@ -112,18 +112,18 @@ SUBROUTINE hConductivity (patchtype,lb,nl_soil,& real(r8), intent(in) :: dkdry(1:nl_soil) ! thermal conductivity for dry soil [W/m-K] real(r8), intent(in) :: dksatu(1:nl_soil) ! Thermal conductivity of saturated soil [W/m-K] real(r8), intent(in) :: porsl(1:nl_soil) ! fractional volume between soil grains=1.-dmvol - real(r8), intent(in) :: dz_soisno(lb:nl_soil) ! layer thickiness [m] + real(r8), intent(in) :: dz_soisno(lb:nl_soil) ! layer thickness [m] real(r8), intent(in) :: z_soisno(lb:nl_soil) ! node depth [m] real(r8), intent(in) :: zi_soisno(lb-1:nl_soil) ! interface depth [m] real(r8), intent(in) :: t_soisno(lb:nl_soil) ! Nodal temperature [K] real(r8), intent(in) :: wice_soisno(lb:nl_soil) ! ice lens [kg/m2] - real(r8), intent(in) :: wliq_soisno(lb:nl_soil) ! liqui water [kg/m2] + real(r8), intent(in) :: wliq_soisno(lb:nl_soil) ! liquid water [kg/m2] real(r8), intent(out) :: tk(lb:nl_soil) ! thermal conductivity [W/(m K)] real(r8), optional, intent(out) :: tktopsoil ! local - real(r8) rhosnow ! partitial density of water (ice + liquid) + real(r8) rhosnow ! partial density of water (ice + liquid) real(r8) dksat ! thermal conductivity for saturated soil (j/(k s m)) real(r8) dke ! kersten number real(r8) fl ! fraction of liquid or unfrozen water to total water @@ -197,12 +197,11 @@ SUBROUTINE hConductivity (patchtype,lb,nl_soil,& ! Thermal conductivity at the layer interface DO i = lb, nl_soil-1 -! the following consideration is try to avoid the snow conductivity -! to be dominant in the thermal conductivity of the interface. -! Because when the distance of bottom snow node to the interfacee -! is larger than that of interface to top soil node, -! the snow thermal conductivity will be dominant, and the result is that -! lees heat tranfer between snow and soil +! the following consideration is try to avoid the snow conductivity to be +! dominant in the thermal conductivity of the interface. Because when the +! distance of bottom snow node to the interface is larger than that of +! interface to top soil node, the snow thermal conductivity will be dominant, +! and the result is that lees heat transfer between snow and soil ! modified by Nan Wei, 08/25/2014 IF (patchtype<=3) THEN ! soil ground and wetland @@ -333,7 +332,7 @@ SUBROUTINE soil_hcap_cond(vf_gravels_s,vf_om_s,vf_sand_s,vf_pores_s,& ELSE ! Fine-grained ke = log10(max(sr,0.1)) + 1.0 ENDIF - ELSE ! Fozen or partially frozen soils + ELSE ! Frozen or partially frozen soils ke = sr ENDIF @@ -358,7 +357,7 @@ SUBROUTINE soil_hcap_cond(vf_gravels_s,vf_om_s,vf_sand_s,vf_pores_s,& kappa = 0.60 ENDIF - ELSE ! Fozen or partially frozen soils + ELSE ! Frozen or partially frozen soils ! kappa = Frozen ! /gravels and coarse sand /1.70/ ! /medium and fine sands /0.95/ @@ -389,7 +388,7 @@ SUBROUTINE soil_hcap_cond(vf_gravels_s,vf_om_s,vf_sand_s,vf_pores_s,& ke = sr**(0.5*(1.0+vf_om_s-BA_alpha*vf_sand_s-vf_gravels_s)) & * ((1.0/(1.0+exp(-BA_beta*sr)))**3-((1.0-sr)/2.0)**3)**(1.0-vf_om_s) - ELSE ! Fozen or partially frozen soils + ELSE ! Frozen or partially frozen soils ke = sr**(1.0+vf_om_s) ENDIF @@ -408,7 +407,7 @@ SUBROUTINE soil_hcap_cond(vf_gravels_s,vf_om_s,vf_sand_s,vf_pores_s,& IF(temperature > tfrz)THEN ! Unfrozen soils ke = exp(alpha*(1.0-sr**(alpha-beta))) - ELSE ! Fozen or partially frozen soils + ELSE ! Frozen or partially frozen soils ke = sr ENDIF END select diff --git a/main/MOD_Thermal.F90 b/main/MOD_Thermal.F90 index 17807968..ae93e3be 100644 --- a/main/MOD_Thermal.F90 +++ b/main/MOD_Thermal.F90 @@ -191,10 +191,10 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , effcon, &! quantum efficiency of RuBP regeneration (mol CO2/mol quanta) vmax25, &! maximum carboxylation rate at 25 C at canopy top - kmax_sun, &! Plant Hydraulics Paramters - kmax_sha, &! Plant Hydraulics Paramters - kmax_xyl, &! Plant Hydraulics Paramters - kmax_root, &! Plant Hydraulics Paramters + kmax_sun, &! Plant Hydraulics Parameters + kmax_sha, &! Plant Hydraulics Parameters + kmax_xyl, &! Plant Hydraulics Parameters + kmax_root, &! Plant Hydraulics Parameters psi50_sun, &! water potential at 50% loss of sunlit leaf tissue conductance (mmH2O) psi50_sha, &! water potential at 50% loss of shaded leaf tissue conductance (mmH2O) psi50_xyl, &! water potential at 50% loss of xylem tissue conductance (mmH2O) @@ -249,18 +249,18 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , ! state variable (1) fsno, &! fraction of ground covered by snow sigf, &! fraction of veg cover, excluding snow-covered veg [-] - dz_soisno(lb:nl_soil), &! layer thickiness [m] + dz_soisno(lb:nl_soil), &! layer thickness [m] z_soisno (lb:nl_soil), &! node depth [m] zi_soisno(lb-1:nl_soil) ! interface depth [m] real(r8), intent(in) :: & - sabg_snow_lyr(lb:1) ! snow layer aborption + sabg_snow_lyr(lb:1) ! snow layer absorption ! state variables (2) real(r8), intent(inout) :: & vegwp(1:nvegwcs), &! vegetation water potential gs0sun, &! working copy of sunlit stomata conductance - gs0sha, &! working copy of shalit stomata conductance + gs0sha, &! working copy of shaded stomata conductance !Ozone stress variables lai_old , &! lai in last time step o3uptakesun, &! Ozone does, sunlit leaf (mmol O3/m^2) @@ -275,7 +275,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , tleaf, &! shaded leaf temperature [K] t_soisno(lb:nl_soil), &! soil temperature [K] wice_soisno(lb:nl_soil), &! ice lens [kg/m2] - wliq_soisno(lb:nl_soil) ! liqui water [kg/m2] + wliq_soisno(lb:nl_soil) ! liquid water [kg/m2] real(r8), intent(in) :: & smp(1:nl_soil) , &! soil matrix potential [mm] @@ -316,14 +316,14 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , fsena, &! sensible heat from canopy height to atmosphere [W/m2] fevpa, &! evapotranspiration from canopy height to atmosphere [mm/s] lfevpa, &! latent heat flux from canopy height to atmosphere [W/m2] - fsenl, &! ensible heat from leaves [W/m2] + fsenl, &! sensible heat from leaves [W/m2] fevpl, &! evaporation+transpiration from leaves [mm/s] etr, &! transpiration rate [mm/s] fseng, &! sensible heat flux from ground [W/m2] fevpg, &! evaporation heat flux from ground [mm/s] olrg, &! outgoing long-wave radiation from ground+canopy fgrnd, &! ground heat flux [W/m2] - rootr(1:nl_soil), &! water uptake farction from different layers, all layers add to 1.0 + rootr(1:nl_soil), &! water uptake fraction from different layers, all layers add to 1.0 rootflux(1:nl_soil), &! root uptake from different layer, all layers add to transpiration qseva, &! ground surface evaporation rate (mm h2o/s) @@ -393,8 +393,8 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , psit, &! negative potential of soil qg, &! ground specific humidity [kg/kg] ! 03/07/2020, yuan: - q_soil, &! ground soil specific humudity [kg/kg] - q_snow, &! ground snow specific humudity [kg/kg] + q_soil, &! ground soil specific humidity [kg/kg] + q_snow, &! ground snow specific humidity [kg/kg] qsatg, &! saturated humidity [kg/kg] qsatgdT, &! d(qsatg)/dT qred, &! soil surface relative humidity @@ -413,7 +413,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , ulrad, &! upward longwave radiation above the canopy [W/m2] wice0(lb:nl_soil), &! ice mass from previous time-step wliq0(lb:nl_soil), &! liquid mass from previous time-step - wx, &! patitial volume of ice and water of surface layer + wx, &! patial volume of ice and water of surface layer xmf, &! total latent heat of phase change of ground water [W/m2] hprl, &! precipitation sensible heat from canopy [W/m2] dheatl ! vegetation heat change [W/m2] @@ -511,11 +511,11 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , wice0(lb:) = wice_soisno(lb:) wliq0(lb:) = wliq_soisno(lb:) - ! latent heat, assumed that the sublimation occured only as wliq_soisno=0 + ! latent heat, assumed that the sublimation occurred only as wliq_soisno=0 htvp = hvap IF (wliq_soisno(lb)<=0. .and. wice_soisno(lb)>0.) htvp = hsub - ! potential temperatur at the reference height + ! potential temperature at the reference height thm = forc_t + 0.0098*forc_hgt_t !intermediate variable equivalent to !forc_t*(pgcm/forc_psrf)**(rgas/cpair) th = forc_t*(100000./forc_psrf)**(rgas/cpair) !potential T @@ -932,7 +932,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , rootflux_p(:,:) ) ENDIF - ! aggregat PFTs to a patch + ! aggregate PFTs to a patch laisun = sum( laisun_p (ps:pe)*pftfrac(ps:pe) ) laisha = sum( laisha_p (ps:pe)*pftfrac(ps:pe) ) tleaf = sum( tleaf_p (ps:pe)*pftfrac(ps:pe) ) @@ -1042,7 +1042,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , !======================================================================= -! [5] Gound temperature +! [5] Ground temperature !======================================================================= CALL GroundTemperature (patchtype,is_dry_lake,lb,nl_soil,deltim,& @@ -1181,7 +1181,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , ! total fluxes to atmosphere fsena = fsenl + fseng fevpa = fevpl + fevpg - lfevpa = hvap*fevpl + htvp*fevpg ! W/m^2 (accouting for sublimation) + lfevpa = hvap*fevpl + htvp*fevpg ! W/m^2 (accounting for sublimation) ! ground heat flux IF (.not.DEF_SPLIT_SOILSNOW) THEN @@ -1221,7 +1221,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , trad = (olrg/stefnc)**0.25 -! additonal variables required by WRF and RSM model +! additional variables required by WRF and RSM model IF (lai+sai <= 1e-6) THEN ustar = ustar_g tstar = tstar_g diff --git a/main/MOD_TurbulenceLEddy.F90 b/main/MOD_TurbulenceLEddy.F90 index d79f88b9..8c9d1d7f 100644 --- a/main/MOD_TurbulenceLEddy.F90 +++ b/main/MOD_TurbulenceLEddy.F90 @@ -26,13 +26,13 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & ! ====================================================================== ! ! Implement the LZD2022 scheme (Liu et al., 2022), which accounts for large -! eddy effects by inlcuding the boundary layer height in the phim FUNCTION, +! eddy effects by including the boundary layer height in the phim FUNCTION, ! to compute friction velocity, relation for potential temperature and ! humidity profiles of surface boundary layer. ! ! References: ! [1] Zeng et al., 1998: Intercomparison of bulk aerodynamic algorithms -! for the computation of sea surface fluxes using TOGA CORE and TAO data. +! for the computation of sea surface fluxes using TOGA CORE and TAO data. ! J. Climate, 11: 2628-2644. ! [2] Liu et al., 2022: A surface flux estimation scheme accounting for ! large-eddy effects for land surface modeling. GRL, 49, e2022GL101754. @@ -55,7 +55,7 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & real(r8), intent(in) :: z0h ! roughness length, sensible heat [m] real(r8), intent(in) :: z0q ! roughness length, latent heat [m] real(r8), intent(in) :: obu ! monin-obukhov length (m) - real(r8), intent(in) :: um ! wind speed including the stablity effect [m/s] + real(r8), intent(in) :: um ! wind speed including the stability effect [m/s] real(r8), intent(in) :: hpbl ! atmospheric boundary layer height [m] real(r8), intent(out) :: ustar ! friction velocity [m/s] @@ -65,10 +65,10 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & real(r8), intent(out) :: fm ! integral of profile FUNCTION for momentum real(r8), intent(out) :: fh ! integral of profile FUNCTION for heat real(r8), intent(out) :: fq ! integral of profile FUNCTION for moisture - + !------------------------ local variables ------------------------------ - real(r8) zldis ! reference height "minus" zero displacement heght [m] + real(r8) zldis ! reference height "minus" zero displacement height [m] real(r8) zetam, & zetam2 ! transition point of flux-gradient relation (wind profile) real(r8) zetat ! transition point of flux-gradient relation (temp. profile) @@ -109,7 +109,7 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & ELSE IF(zeta < 0.)THEN ! zetam2 <= zeta < 0 fm = log(zldis/z0m) - psi(1,zeta) + psi(1,z0m/obu) ustar = vonkar*um / fm - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fm = log(zldis/z0m) + 5.*zeta - 5.*z0m/obu ustar = vonkar*um / fm ELSE ! 1 < zeta, phi=5+zeta @@ -131,7 +131,7 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & ! ELSE IF(zeta < 0.)THEN ! zetam2 <= zeta < 0 fm10m = log(zldis/z0m) - psi(1,zeta) + psi(1,z0m/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fm10m = log(zldis/z0m) + 5.*zeta - 5.*z0m/obu ELSE ! 1 < zeta, phi=5+zeta fm10m = log(obu/z0m) + 5. - 5.*z0m/obu + (5.*log(zeta)+zeta-1.) @@ -146,7 +146,7 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fh = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fh = log(zldis/z0h) + 5.*zeta - 5.*z0h/obu ELSE ! 1 < zeta, phi=5+zeta fh = log(obu/z0h) + 5. - 5.*z0h/obu + (5.*log(zeta)+zeta-1.) @@ -161,7 +161,7 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fh2m = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fh2m = log(zldis/z0h) + 5.*zeta - 5.*z0h/obu ELSE ! 1 < zeta, phi=5+zeta fh2m = log(obu/z0h) + 5. - 5.*z0h/obu + (5.*log(zeta)+zeta-1.) @@ -176,7 +176,7 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & + psi(2,z0q/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fq = log(zldis/z0q) - psi(2,zeta) + psi(2,z0q/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fq = log(zldis/z0q) + 5.*zeta - 5.*z0q/obu ELSE ! 1 < zeta, phi=5+zeta fq = log(obu/z0q) + 5. - 5.*z0q/obu + (5.*log(zeta)+zeta-1.) @@ -210,18 +210,18 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb ! ! Original author : Yongjiu Dai, September 15, 1999 ! -! calculation of friction velocity, relation for potential temperatur -! and humidity profiles of surface boundary layer. -! the scheme is based on the work of Zeng et al. (1998): -! Intercomparison of bulk aerodynamic algorithms for the computation -! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, Vol. 11: 2628-2644 +! calculation of friction velocity, relation for potential temperature and +! humidity profiles of surface boundary layer. the scheme is based on the work +! of Zeng et al. (1998): Intercomparison of bulk aerodynamic algorithms for the +! computation of sea surface fluxes using TOGA CORE and TAO data. J. Climate, +! Vol. 11: 2628-2644 ! ! REVISIONS: ! Hua Yuan, 09/2017: adapted from moninobuk FUNCTION to calculate canopy top ! fm, fq and phih for roughness sublayer u/k profile calculation -! Shaofeng Liu, 05/2023: implement the LZD2022 scheme (Liu et al., 2022), which -! accounts for large eddy effects by including the -! boundary leyer height in the phim FUNCTION. +! Shaofeng Liu, 05/2023: implement the LZD2022 scheme (Liu et al., 2022), which +! accounts for large eddy effects by including the +! boundary leyer height in the phim FUNCTION. ! ====================================================================== USE MOD_Precision @@ -241,9 +241,9 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb real(r8), intent(in) :: z0mt ! roughness length of the top layer, latent heat [m] real(r8), intent(in) :: htop ! canopy top height of the top layer [m] real(r8), intent(in) :: obu ! monin-obukhov length (m) - real(r8), intent(in) :: um ! wind speed including the stablity effect [m/s] + real(r8), intent(in) :: um ! wind speed including the stability effect [m/s] real(r8), intent(in) :: hpbl ! atmospheric boundary layer height [m] - + real(r8), intent(out) :: ustar ! friction velocity [m/s] real(r8), intent(out) :: fh2m ! relation for temperature at 2m real(r8), intent(out) :: fq2m ! relation for specific humidity at 2m @@ -257,7 +257,7 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb !------------------------ local variables ------------------------------ - real(r8) zldis ! reference height "minus" zero displacement heght [m] + real(r8) zldis ! reference height "minus" zero displacement height [m] real(r8) zetam, & zetam2 ! transition point of flux-gradient relation (wind profile) real(r8) zetat ! transition point of flux-gradient relation (temp. profile) @@ -283,7 +283,7 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb ELSE !unstable zetazi = max(-1.e4,min(zetazi,-1.e-5)) ENDIF - + Bm = 0.0047 * (-zetazi) + 0.1854 zetam = 0.5*Bm**4 * ( -16. - sqrt(256. + 4./Bm**4) ) Bm2 = max(Bm, 0.2722) @@ -299,7 +299,7 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb ELSE IF(zeta < 0.)THEN ! zetam2 <= zeta < 0 fm = log(zldis/z0m) - psi(1,zeta) + psi(1,z0m/obu) ustar = vonkar*um / fm - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fm = log(zldis/z0m) + 5.*zeta - 5.*z0m/obu ustar = vonkar*um / fm ELSE ! 1 < zeta, phi=5+zeta @@ -323,7 +323,7 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb ! ELSE IF(zeta < 0.)THEN ! zetam2 <= zeta < 0 fmtop = log(zldis/z0m) - psi(1,zeta) + psi(1,z0m/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fmtop = log(zldis/z0m) + 5.*zeta - 5.*z0m/obu ELSE ! 1 < zeta, phi=5+zeta fmtop = log(obu/z0m) + 5. - 5.*z0m/obu + (5.*log(zeta)+zeta-1.) @@ -338,7 +338,7 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fh = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fh = log(zldis/z0h) + 5.*zeta - 5.*z0h/obu ELSE ! 1 < zeta, phi=5+zeta fh = log(obu/z0h) + 5. - 5.*z0h/obu + (5.*log(zeta)+zeta-1.) @@ -353,7 +353,7 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fh2m = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fh2m = log(zldis/z0h) + 5.*zeta - 5.*z0h/obu ELSE ! 1 < zeta, phi=5+zeta fh2m = log(obu/z0h) + 5. - 5.*z0h/obu + (5.*log(zeta)+zeta-1.) @@ -368,7 +368,7 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fht = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fht = log(zldis/z0h) + 5.*zeta - 5.*z0h/obu ELSE ! 1 < zeta, phi=5+zeta fht = log(obu/z0h) + 5. - 5.*z0h/obu + (5.*log(zeta)+zeta-1.) @@ -383,7 +383,7 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb phih = 0.9*vonkar**(1.333)*(-zeta)**(-0.333) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 phih = (1. - 16.*zeta)**(-0.5) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 phih = 1. + 5.*zeta ELSE ! 1 < zeta, phi=5+zeta phih = 5. + zeta @@ -398,7 +398,7 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb + psi(2,z0q/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 fq = log(zldis/z0q) - psi(2,zeta) + psi(2,z0q/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= ztea <= 1 + ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 fq = log(zldis/z0q) + 5.*zeta - 5.*z0q/obu ELSE ! 1 < zeta, phi=5+zeta fq = log(obu/z0q) + 5. - 5.*z0q/obu + (5.*log(zeta)+zeta-1.) @@ -437,7 +437,7 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb END SUBROUTINE moninobukm_leddy - + real(r8) FUNCTION psi(k,zeta) !======================================================================= @@ -445,11 +445,11 @@ real(r8) FUNCTION psi(k,zeta) USE MOD_Precision IMPLICIT NONE - + integer k real(r8) zeta ! dimensionless height used in Monin-Obukhov theory real(r8) chik ! - + chik = (1.-16.*zeta)**0.25 IF(k == 1)THEN psi = 2.*log((1.+chik)*0.5)+log((1.+chik*chik)*0.5)-2.*atan(chik)+2.*atan(1.) diff --git a/main/MOD_Vars_1DAccFluxes.F90 b/main/MOD_Vars_1DAccFluxes.F90 index e676bcd9..06a4f53d 100644 --- a/main/MOD_Vars_1DAccFluxes.F90 +++ b/main/MOD_Vars_1DAccFluxes.F90 @@ -97,7 +97,7 @@ MODULE MOD_Vars_1DAccFluxes real(r8), allocatable :: a_tafu (:) !temperature of outer building [K] real(r8), allocatable :: a_fhac (:) !sensible flux from heat or cool AC [W/m2] real(r8), allocatable :: a_fwst (:) !waste heat flux from heat or cool AC [W/m2] - real(r8), allocatable :: a_fach (:) !flux from inner and outter air exchange [W/m2] + real(r8), allocatable :: a_fach (:) !flux from inner and outer air exchange [W/m2] real(r8), allocatable :: a_fahe (:) !flux from metabolic and vehicle [W/m2] real(r8), allocatable :: a_fhah (:) !sensible flux from heating [W/m2] real(r8), allocatable :: a_vehc (:) !flux from vehicle [W/m2] @@ -771,7 +771,7 @@ SUBROUTINE allocate_acc_fluxes allocate (a_srviln (numpatch)) allocate (a_srndln (numpatch)) allocate (a_srniln (numpatch)) - + allocate (a_sensors (nsensor,numpatch)) allocate (nac_ln (numpatch)) @@ -2346,7 +2346,7 @@ SUBROUTINE accumulate_fluxes CALL acc1d (srviln , a_srviln ) CALL acc1d (srndln , a_srndln ) CALL acc1d (srniln , a_srniln ) - + CALL acc2d (sensors, a_sensors) DO i = 1, numpatch diff --git a/main/MOD_Vars_1DFluxes.F90 b/main/MOD_Vars_1DFluxes.F90 index 2e66723a..a2ba5e26 100644 --- a/main/MOD_Vars_1DFluxes.F90 +++ b/main/MOD_Vars_1DFluxes.F90 @@ -57,7 +57,7 @@ MODULE MOD_Vars_1DFluxes real(r8), allocatable :: srniln (:) !reflected diffuse beam nir solar radiation at local noon (W/m2) real(r8), allocatable :: olrg (:) !outgoing long-wave radiation from ground+canopy [W/m2] real(r8), allocatable :: rnet (:) !net radiation by surface [W/m2] - real(r8), allocatable :: xerr (:) !the error of water banace [mm/s] + real(r8), allocatable :: xerr (:) !the error of water balance [mm/s] real(r8), allocatable :: zerr (:) !the error of energy balance [W/m2] real(r8), allocatable :: rsur (:) !surface runoff (mm h2o/s) real(r8), allocatable :: rsur_se(:) !saturation excess surface runoff (mm h2o/s) @@ -65,17 +65,17 @@ MODULE MOD_Vars_1DFluxes real(r8), allocatable :: rsub (:) !subsurface runoff (mm h2o/s) real(r8), allocatable :: rnof (:) !total runoff (mm h2o/s) real(r8), allocatable :: qintr (:) !interception (mm h2o/s) - real(r8), allocatable :: qinfl (:) !inflitration (mm h2o/s) + real(r8), allocatable :: qinfl (:) !infiltration (mm h2o/s) real(r8), allocatable :: qdrip (:) !throughfall (mm h2o/s) real(r8), allocatable :: assim (:) !canopy assimilation rate (mol m-2 s-1) real(r8), allocatable :: respc (:) !canopy respiration (mol m-2 s-1) real(r8), allocatable :: qcharge(:) !groundwater recharge [mm/s] - integer, allocatable :: oroflag(:) - + integer, allocatable :: oroflag(:) + integer, parameter :: nsensor = 1 - real(r8), allocatable :: sensors(:,:) + real(r8), allocatable :: sensors(:,:) ! PUBLIC MEMBER FUNCTIONS: PUBLIC :: allocate_1D_Fluxes @@ -136,7 +136,7 @@ SUBROUTINE allocate_1D_Fluxes allocate ( srniln (numpatch) ) ; srniln (:) = spval ! reflected diffuse beam nir solar radiation at local noon(W/m2) allocate ( olrg (numpatch) ) ; olrg (:) = spval ! outgoing long-wave radiation from ground+canopy [W/m2] allocate ( rnet (numpatch) ) ; rnet (:) = spval ! net radiation by surface [W/m2] - allocate ( xerr (numpatch) ) ; xerr (:) = spval ! the error of water banace [mm/s] + allocate ( xerr (numpatch) ) ; xerr (:) = spval ! the error of water balance [mm/s] allocate ( zerr (numpatch) ) ; zerr (:) = spval ! the error of energy balance [W/m2] allocate ( rsur (numpatch) ) ; rsur (:) = spval ! surface runoff (mm h2o/s) @@ -145,7 +145,7 @@ SUBROUTINE allocate_1D_Fluxes allocate ( rsub (numpatch) ) ; rsub (:) = spval ! subsurface runoff (mm h2o/s) allocate ( rnof (numpatch) ) ; rnof (:) = spval ! total runoff (mm h2o/s) allocate ( qintr (numpatch) ) ; qintr (:) = spval ! interception (mm h2o/s) - allocate ( qinfl (numpatch) ) ; qinfl (:) = spval ! inflitration (mm h2o/s) + allocate ( qinfl (numpatch) ) ; qinfl (:) = spval ! infiltration (mm h2o/s) allocate ( qdrip (numpatch) ) ; qdrip (:) = spval ! throughfall (mm h2o/s) allocate ( assim (numpatch) ) ; assim (:) = spval ! canopy assimilation rate (mol m-2 s-1) allocate ( respc (numpatch) ) ; respc (:) = spval ! canopy respiration (mol m-2 s-1) @@ -153,7 +153,7 @@ SUBROUTINE allocate_1D_Fluxes allocate ( qcharge(numpatch) ) ; qcharge(:) = spval ! groundwater recharge [mm/s] allocate ( oroflag(numpatch) ) ; oroflag(:) = spval_i4 ! - + allocate ( sensors(nsensor,numpatch) ); sensors(:,:) = spval ! ENDIF @@ -221,7 +221,7 @@ SUBROUTINE deallocate_1D_Fluxes () deallocate ( srniln ) ! reflected diffuse beam nir solar radiation at local noon(W/m2) deallocate ( olrg ) ! outgoing long-wave radiation from ground+canopy [W/m2] deallocate ( rnet ) ! net radiation by surface [W/m2] - deallocate ( xerr ) ! the error of water banace [mm/s] + deallocate ( xerr ) ! the error of water balance [mm/s] deallocate ( zerr ) ! the error of energy balance [W/m2] deallocate ( rsur ) ! surface runoff (mm h2o/s) deallocate ( rsur_se ) ! saturation excess surface runoff (mm h2o/s) @@ -229,7 +229,7 @@ SUBROUTINE deallocate_1D_Fluxes () deallocate ( rsub ) ! subsurface runoff (mm h2o/s) deallocate ( rnof ) ! total runoff (mm h2o/s) deallocate ( qintr ) ! interception (mm h2o/s) - deallocate ( qinfl ) ! inflitration (mm h2o/s) + deallocate ( qinfl ) ! infiltration (mm h2o/s) deallocate ( qdrip ) ! throughfall (mm h2o/s) deallocate ( assim ) ! canopy assimilation rate (mol m-2 s-1) deallocate ( respc ) ! canopy respiration (mol m-2 s-1) @@ -237,7 +237,7 @@ SUBROUTINE deallocate_1D_Fluxes () deallocate ( qcharge ) ! groundwater recharge [mm/s] deallocate ( oroflag ) ! - + deallocate ( sensors ) ! ENDIF diff --git a/main/MOD_Vars_1DForcing.F90 b/main/MOD_Vars_1DForcing.F90 index 277095e6..d185880a 100644 --- a/main/MOD_Vars_1DForcing.F90 +++ b/main/MOD_Vars_1DForcing.F90 @@ -2,7 +2,7 @@ MODULE MOD_Vars_1DForcing ! ------------------------------- -! Meteorogical Forcing +! Meteorological Forcing ! ! Created by Yongjiu Dai, 03/2014 ! ------------------------------- @@ -13,34 +13,34 @@ MODULE MOD_Vars_1DForcing SAVE ! ----------------------------------------------------------------- - real(r8), allocatable :: forc_pco2m (:) ! CO2 concentration in atmos. (pascals) - real(r8), allocatable :: forc_po2m (:) ! O2 concentration in atmos. (pascals) - real(r8), allocatable :: forc_us (:) ! wind in eastward direction [m/s] - real(r8), allocatable :: forc_vs (:) ! wind in northward direction [m/s] - real(r8), allocatable :: forc_t (:) ! temperature at reference height [kelvin] - real(r8), allocatable :: forc_q (:) ! specific humidity at reference height [kg/kg] - real(r8), allocatable :: forc_prc (:) ! convective precipitation [mm/s] - real(r8), allocatable :: forc_prl (:) ! large scale precipitation [mm/s] - real(r8), allocatable :: forc_rain (:) ! rain [mm/s] - real(r8), allocatable :: forc_snow (:) ! snow [mm/s] - real(r8), allocatable :: forc_psrf (:) ! atmospheric pressure at the surface [pa] - real(r8), allocatable :: forc_pbot (:) ! atm bottom level pressure (or reference height) (pa) - real(r8), allocatable :: forc_sols (:) ! atm vis direct beam solar rad onto srf [W/m2] - real(r8), allocatable :: forc_soll (:) ! atm nir direct beam solar rad onto srf [W/m2] - real(r8), allocatable :: forc_solsd (:) ! atm vis diffuse solar rad onto srf [W/m2] - real(r8), allocatable :: forc_solld (:) ! atm nir diffuse solar rad onto srf [W/m2] - real(r8), allocatable :: forc_frl (:) ! atmospheric infrared (longwave) radiation [W/m2] - real(r8), allocatable :: forc_swrad (:) ! atmospheric shortwave radiation [W/m2] - real(r8), allocatable :: forc_hgt_u (:) ! observational height of wind [m] - real(r8), allocatable :: forc_hgt_t (:) ! observational height of temperature [m] - real(r8), allocatable :: forc_hgt_q (:) ! observational height of humidity [m] - real(r8), allocatable :: forc_rhoair(:) ! air density [kg/m3] - real(r8), allocatable :: forc_ozone (:) ! air density [kg/m3] - - real(r8), allocatable :: forc_topo (:) ! topography [m] - - real(r8), allocatable :: forc_hpbl (:) ! atmospheric boundary layer height [m] - real(r8), allocatable :: forc_aerdep(:,:) ! atmospheric aerosol deposition data [kg/m/s] + real(r8), allocatable :: forc_pco2m (:) ! CO2 concentration in atmos. (pascals) + real(r8), allocatable :: forc_po2m (:) ! O2 concentration in atmos. (pascals) + real(r8), allocatable :: forc_us (:) ! wind in eastward direction [m/s] + real(r8), allocatable :: forc_vs (:) ! wind in northward direction [m/s] + real(r8), allocatable :: forc_t (:) ! temperature at reference height [kelvin] + real(r8), allocatable :: forc_q (:) ! specific humidity at reference height [kg/kg] + real(r8), allocatable :: forc_prc (:) ! convective precipitation [mm/s] + real(r8), allocatable :: forc_prl (:) ! large scale precipitation [mm/s] + real(r8), allocatable :: forc_rain (:) ! rain [mm/s] + real(r8), allocatable :: forc_snow (:) ! snow [mm/s] + real(r8), allocatable :: forc_psrf (:) ! atmospheric pressure at the surface [pa] + real(r8), allocatable :: forc_pbot (:) ! atm bottom level pressure (or reference height) (pa) + real(r8), allocatable :: forc_sols (:) ! atm vis direct beam solar rad onto srf [W/m2] + real(r8), allocatable :: forc_soll (:) ! atm nir direct beam solar rad onto srf [W/m2] + real(r8), allocatable :: forc_solsd (:) ! atm vis diffuse solar rad onto srf [W/m2] + real(r8), allocatable :: forc_solld (:) ! atm nir diffuse solar rad onto srf [W/m2] + real(r8), allocatable :: forc_frl (:) ! atmospheric infrared (longwave) radiation [W/m2] + real(r8), allocatable :: forc_swrad (:) ! atmospheric shortwave radiation [W/m2] + real(r8), allocatable :: forc_hgt_u (:) ! observational height of wind [m] + real(r8), allocatable :: forc_hgt_t (:) ! observational height of temperature [m] + real(r8), allocatable :: forc_hgt_q (:) ! observational height of humidity [m] + real(r8), allocatable :: forc_rhoair(:) ! air density [kg/m3] + real(r8), allocatable :: forc_ozone (:) ! air density [kg/m3] + + real(r8), allocatable :: forc_topo (:) ! topography [m] + + real(r8), allocatable :: forc_hpbl (:) ! atmospheric boundary layer height [m] + real(r8), allocatable :: forc_aerdep(:,:) ! atmospheric aerosol deposition data [kg/m/s] ! PUBLIC MEMBER FUNCTIONS: diff --git a/main/MOD_Vars_TimeInvariants.F90 b/main/MOD_Vars_TimeInvariants.F90 index 6031a765..9a450e6f 100644 --- a/main/MOD_Vars_TimeInvariants.F90 +++ b/main/MOD_Vars_TimeInvariants.F90 @@ -207,25 +207,25 @@ MODULE MOD_Vars_TimeInvariants real(r8), allocatable :: psi0 (:,:) !minimum soil suction [mm] (NOTE: "-" valued) real(r8), allocatable :: bsw (:,:) !clapp and hornberger "b" parameter [-] real(r8), allocatable :: theta_r (:,:) !residual moisture content [-] - real(r8), allocatable :: BVIC (:) !b parameter in Fraction of saturated soil in a grid calculated by VIC + real(r8), allocatable :: BVIC (:) !b parameter in Fraction of saturated soil in a grid calculated by VIC #ifdef vanGenuchten_Mualem_SOIL_MODEL - real(r8), allocatable :: alpha_vgm (:,:) !a parameter corresponding approximately to the inverse of the air-entry value - real(r8), allocatable :: L_vgm (:,:) !pore-connectivity parameter [dimensionless] - real(r8), allocatable :: n_vgm (:,:) !a shape parameter [dimensionless] - real(r8), allocatable :: sc_vgm (:,:) !saturation at the air entry value in the classical vanGenuchten model [-] - real(r8), allocatable :: fc_vgm (:,:) !a scaling factor by using air entry value in the Mualem model [-] + real(r8), allocatable :: alpha_vgm (:,:) ! a parameter corresponding approximately to the inverse of the air-entry value + real(r8), allocatable :: L_vgm (:,:) ! pore-connectivity parameter [dimensionless] + real(r8), allocatable :: n_vgm (:,:) ! a shape parameter [dimensionless] + real(r8), allocatable :: sc_vgm (:,:) ! saturation at the air entry value in the classical vanGenuchten model [-] + real(r8), allocatable :: fc_vgm (:,:) ! a scaling factor by using air entry value in the Mualem model [-] #endif - integer, allocatable :: soiltext(:) ! USDA soil texture class + integer, allocatable :: soiltext (:) ! USDA soil texture class - real(r8), allocatable :: fsatmax (:) ! maximum saturated area fraction [-] - real(r8), allocatable :: fsatdcf (:) ! decay factor in calucation of saturated area fraction [1/m] + real(r8), allocatable :: fsatmax (:) ! maximum saturated area fraction [-] + real(r8), allocatable :: fsatdcf (:) ! decay factor in calculation of saturated area fraction [1/m] - real(r8), allocatable :: vic_b_infilt (:) - real(r8), allocatable :: vic_Dsmax (:) - real(r8), allocatable :: vic_Ds (:) - real(r8), allocatable :: vic_Ws (:) - real(r8), allocatable :: vic_c (:) + real(r8), allocatable :: vic_b_infilt (:) + real(r8), allocatable :: vic_Dsmax (:) + real(r8), allocatable :: vic_Ds (:) + real(r8), allocatable :: vic_Ws (:) + real(r8), allocatable :: vic_c (:) real(r8), allocatable :: hksati (:,:) !hydraulic conductivity at saturation [mm h2o/s] real(r8), allocatable :: csol (:,:) !heat capacity of soil solids [J/(m3 K)] @@ -241,8 +241,8 @@ MODULE MOD_Vars_TimeInvariants real(r8), allocatable :: dbedrock (:) !depth to bedrock integer , allocatable :: ibedrock (:) !bedrock level - real(r8), allocatable :: topoelv (:) !elevation above sea level [m] - real(r8), allocatable :: topostd (:) !standard deviation of elevation [m] + real(r8), allocatable :: topoelv (:) !elevation above sea level [m] + real(r8), allocatable :: topostd (:) !standard deviation of elevation [m] real(r8) :: zlnd !roughness length for soil [m] real(r8) :: zsno !roughness length for snow [m] @@ -253,7 +253,7 @@ MODULE MOD_Vars_TimeInvariants real(r8) :: capr !tuning factor to turn first layer T into surface T real(r8) :: cnfac !Crank Nicholson factor between 0 and 1 real(r8) :: ssi !irreducible water saturation of snow - real(r8) :: wimp !water impremeable IF porosity less than wimp + real(r8) :: wimp !water impermeable IF porosity less than wimp real(r8) :: pondmx !ponding depth (mm) real(r8) :: smpmax !wilting point potential in mm real(r8) :: smpmin !restriction for min of soil poten. (mm) @@ -329,7 +329,7 @@ SUBROUTINE allocate_TimeInvariants () allocate (psi0 (nl_soil,numpatch)) allocate (bsw (nl_soil,numpatch)) allocate (theta_r (nl_soil,numpatch)) - allocate (BVIC (numpatch)) + allocate (BVIC (numpatch)) #ifdef vanGenuchten_Mualem_SOIL_MODEL allocate (alpha_vgm (nl_soil,numpatch)) @@ -338,16 +338,16 @@ SUBROUTINE allocate_TimeInvariants () allocate (sc_vgm (nl_soil,numpatch)) allocate (fc_vgm (nl_soil,numpatch)) #endif - allocate (soiltext(numpatch)) + allocate (soiltext (numpatch)) - allocate (fsatmax (numpatch)) - allocate (fsatdcf (numpatch)) + allocate (fsatmax (numpatch)) + allocate (fsatdcf (numpatch)) - allocate (vic_b_infilt (numpatch)) - allocate (vic_Dsmax (numpatch)) - allocate (vic_Ds (numpatch)) - allocate (vic_Ws (numpatch)) - allocate (vic_c (numpatch)) + allocate (vic_b_infilt (numpatch)) + allocate (vic_Dsmax (numpatch)) + allocate (vic_Ds (numpatch)) + allocate (vic_Ws (numpatch)) + allocate (vic_c (numpatch)) allocate (hksati (nl_soil,numpatch)) allocate (csol (nl_soil,numpatch)) @@ -499,7 +499,7 @@ SUBROUTINE READ_TimeInvariants (lc_year, casename, dir_restart) CALL ncio_read_bcast_serial (file_restart, 'capr ', capr ) ! tuning factor to turn first layer T into surface T CALL ncio_read_bcast_serial (file_restart, 'cnfac ', cnfac ) ! Crank Nicholson factor between 0 and 1 CALL ncio_read_bcast_serial (file_restart, 'ssi ', ssi ) ! irreducible water saturation of snow - CALL ncio_read_bcast_serial (file_restart, 'wimp ', wimp ) ! water impremeable IF porosity less than wimp + CALL ncio_read_bcast_serial (file_restart, 'wimp ', wimp ) ! water impermeable IF porosity less than wimp CALL ncio_read_bcast_serial (file_restart, 'pondmx', pondmx) ! ponding depth (mm) CALL ncio_read_bcast_serial (file_restart, 'smpmax', smpmax) ! wilting point potential in mm CALL ncio_read_bcast_serial (file_restart, 'smpmin', smpmin) ! restriction for min of soil poten. (mm) @@ -712,7 +712,7 @@ SUBROUTINE WRITE_TimeInvariants (lc_year, casename, dir_restart) CALL ncio_write_serial (file_restart, 'capr ', capr ) ! tuning factor to turn first layer T into surface T CALL ncio_write_serial (file_restart, 'cnfac ', cnfac ) ! Crank Nicholson factor between 0 and 1 CALL ncio_write_serial (file_restart, 'ssi ', ssi ) ! irreducible water saturation of snow - CALL ncio_write_serial (file_restart, 'wimp ', wimp ) ! water impremeable if porosity less than wimp + CALL ncio_write_serial (file_restart, 'wimp ', wimp ) ! water impermeable if porosity less than wimp CALL ncio_write_serial (file_restart, 'pondmx', pondmx) ! ponding depth (mm) CALL ncio_write_serial (file_restart, 'smpmax', smpmax) ! wilting point potential in mm CALL ncio_write_serial (file_restart, 'smpmin', smpmin) ! restriction for min of soil poten. (mm) @@ -909,13 +909,13 @@ SUBROUTINE check_TimeInvariants () CALL check_vector_data ('BA_alpha [-] ', BA_alpha ) ! alpha in Balland and Arp(2005) thermal conductivity scheme CALL check_vector_data ('BA_beta [-] ', BA_beta ) ! beta in Balland and Arp(2005) thermal conductivity scheme - CALL check_vector_data ('soiltexture [-] ', soiltext , -1) ! + CALL check_vector_data ('soiltexture [-] ', soiltext, -1) ! CALL check_vector_data ('htop [m] ', htop ) CALL check_vector_data ('hbot [m] ', hbot ) IF(DEF_USE_BEDROCK)THEN - CALL check_vector_data ('dbedrock [m] ', dbedrock ) ! + CALL check_vector_data ('dbedrock [m] ', dbedrock ) ! ENDIF CALL check_vector_data ('topoelv [m] ', topoelv ) ! @@ -951,7 +951,7 @@ SUBROUTINE check_TimeInvariants () write(*,'(A,E20.10)') 'capr [-] ', capr ! tuning factor to turn first layer T into surface T write(*,'(A,E20.10)') 'cnfac [-] ', cnfac ! Crank Nicholson factor between 0 and 1 write(*,'(A,E20.10)') 'ssi [-] ', ssi ! irreducible water saturation of snow - write(*,'(A,E20.10)') 'wimp [m3/m3]', wimp ! water impremeable IF porosity less than wimp + write(*,'(A,E20.10)') 'wimp [m3/m3]', wimp ! water impermeable IF porosity less than wimp write(*,'(A,E20.10)') 'pondmx [mm] ', pondmx ! ponding depth (mm) write(*,'(A,E20.10)') 'smpmax [mm] ', smpmax ! wilting point potential in mm write(*,'(A,E20.10)') 'smpmin [mm] ', smpmin ! restriction for min of soil poten. (mm) diff --git a/main/MOD_Vars_TimeVariables.F90 b/main/MOD_Vars_TimeVariables.F90 index 3828d2bf..f5f63afe 100644 --- a/main/MOD_Vars_TimeVariables.F90 +++ b/main/MOD_Vars_TimeVariables.F90 @@ -22,7 +22,7 @@ MODULE MOD_Vars_PFTimeVariables IMPLICIT NONE SAVE ! ----------------------------------------------------------------- -! Time-varying state variables which reaquired by restart run +! Time-varying state variables which required by restart run ! for LULC_IGBP_PFT or LULC_IGBP_PC real(r8), allocatable :: tleaf_p (:) !shaded leaf temperature [K] @@ -51,7 +51,7 @@ MODULE MOD_Vars_PFTimeVariables ! Plant Hydraulic variables real(r8), allocatable :: vegwp_p (:,:) !vegetation water potential [mm] real(r8), allocatable :: gs0sun_p (:) !working copy of sunlit stomata conductance - real(r8), allocatable :: gs0sha_p (:) !working copy of shalit stomata conductance + real(r8), allocatable :: gs0sha_p (:) !working copy of shaded stomata conductance ! END plant hydraulic variables ! Ozone Stress Variables real(r8), allocatable :: o3coefv_sun_p(:) !Ozone stress factor for photosynthesis on sunlit leaf @@ -117,7 +117,7 @@ SUBROUTINE allocate_PFTimeVariables () allocate (qref_p (numpft)) ; qref_p (:) = spval !2 m height air specific humidity allocate (rst_p (numpft)) ; rst_p (:) = spval !canopy stomatal resistance (s/m) allocate (z0m_p (numpft)) ; z0m_p (:) = spval !effective roughness [m] -! Plant Hydraulic variables; draulic variables +! Plant Hydraulic variables allocate (vegwp_p(1:nvegwcs,numpft)); vegwp_p (:,:) = spval allocate (gs0sun_p (numpft)); gs0sun_p (:) = spval allocate (gs0sha_p (numpft)); gs0sha_p (:) = spval @@ -296,7 +296,7 @@ SUBROUTINE deallocate_PFTimeVariables ! Plant Hydraulic variables deallocate (vegwp_p ) ! vegetation water potential [mm] deallocate (gs0sun_p ) ! working copy of sunlit stomata conductance - deallocate (gs0sha_p ) ! working copy of shalit stomata conductance + deallocate (gs0sha_p ) ! working copy of shaded stomata conductance ! END plant hydraulic variables ! Ozone Stress variables deallocate (o3coefv_sun_p ) ! Ozone stress factor for photosynthesis on sunlit leaf @@ -399,7 +399,7 @@ MODULE MOD_Vars_TimeVariables IMPLICIT NONE SAVE ! ----------------------------------------------------------------- -! Time-varying state variables which reaquired by restart run +! Time-varying state variables which required by restart run real(r8), allocatable :: z_sno (:,:) ! node depth [m] real(r8), allocatable :: dz_sno (:,:) ! interface depth [m] real(r8), allocatable :: t_soisno (:,:) ! soil temperature [K] @@ -413,7 +413,7 @@ MODULE MOD_Vars_TimeVariables !Plant Hydraulic variables real(r8), allocatable :: vegwp (:,:) ! vegetation water potential [mm] real(r8), allocatable :: gs0sun (:) ! working copy of sunlit stomata conductance - real(r8), allocatable :: gs0sha (:) ! working copy of shalit stomata conductance + real(r8), allocatable :: gs0sha (:) ! working copy of shaded stomata conductance !END plant hydraulic variables !Ozone stress variables real(r8), allocatable :: o3coefv_sun (:) ! Ozone stress factor for photosynthesis on sunlit leaf @@ -469,7 +469,7 @@ MODULE MOD_Vars_TimeVariables real(r8), allocatable :: wdsrf (:) ! depth of surface water [mm] real(r8), allocatable :: rss (:) ! soil surface resistance [s/m] - real(r8), allocatable :: t_lake (:,:) ! lake layer teperature [K] + real(r8), allocatable :: t_lake (:,:) ! lake layer temperature [K] real(r8), allocatable :: lake_icefrac(:,:) ! lake mass fraction of lake layer that is frozen real(r8), allocatable :: savedtke1 (:) ! top level eddy conductivity (W/m K) @@ -951,7 +951,7 @@ SUBROUTINE WRITE_TimeVariables (idate, lc_year, site, dir_restart) CALL ncio_define_dimension_vector (file_restart, landpatch, 'band', 2) CALL ncio_define_dimension_vector (file_restart, landpatch, 'rtyp', 2) - ! Time-varying state variables which reaquired by restart run + ! Time-varying state variables which required by restart run CALL ncio_write_vector (file_restart, 'z_sno ' , 'snow', -maxsnl, 'patch', landpatch, z_sno , compress) ! node depth [m] CALL ncio_write_vector (file_restart, 'dz_sno ' , 'snow', -maxsnl, 'patch', landpatch, dz_sno, compress) ! interface depth [m] CALL ncio_write_vector (file_restart, 't_soisno' , 'soilsnow', nl_soil-maxsnl, 'patch', landpatch, t_soisno , compress) ! soil temperature [K] @@ -1018,7 +1018,7 @@ SUBROUTINE WRITE_TimeVariables (idate, lc_year, site, dir_restart) CALL ncio_write_vector (file_restart, 'mss_dst4 ', 'snow', -maxsnl, 'patch', landpatch, mss_dst4 , compress) CALL ncio_write_vector (file_restart, 'ssno_lyr', 'band', 2, 'rtyp', 2, 'snowp1', -maxsnl+1, 'patch', landpatch, ssno_lyr, compress) - ! Additional va_vectorriables required by reginal model (such as WRF ) RSM) + ! Additional va_vectorriables required by regional model (such as WRF ) RSM) CALL ncio_write_vector (file_restart, 'trad ', 'patch', landpatch, trad , compress) ! radiative temperature of surface [K] CALL ncio_write_vector (file_restart, 'tref ', 'patch', landpatch, tref , compress) ! 2 m height air temperature [kelvin] CALL ncio_write_vector (file_restart, 'qref ', 'patch', landpatch, qref , compress) ! 2 m height air specific humidity @@ -1129,7 +1129,7 @@ SUBROUTINE READ_TimeVariables (idate, lc_year, site, dir_restart) write(cdate,'(i4.4,"-",i3.3,"-",i5.5)') idate(1), idate(2), idate(3) file_restart = trim(dir_restart)// '/'//trim(cdate)//'/' // trim(site) //'_restart_'//trim(cdate)//'_lc'//trim(cyear)//'.nc' - ! Time-varying state variables which reaquired by restart run + ! Time-varying state variables which required by restart run CALL ncio_read_vector (file_restart, 'z_sno ' , -maxsnl, landpatch, z_sno ) ! node depth [m] CALL ncio_read_vector (file_restart, 'dz_sno ' , -maxsnl, landpatch, dz_sno) ! interface depth [m] CALL ncio_read_vector (file_restart, 't_soisno' , nl_soil-maxsnl, landpatch, t_soisno ) ! soil temperature [K] @@ -1140,7 +1140,7 @@ SUBROUTINE READ_TimeVariables (idate, lc_year, site, dir_restart) IF(DEF_USE_PLANTHYDRAULICS)THEN CALL ncio_read_vector (file_restart, 'vegwp', nvegwcs, landpatch, vegwp ) ! vegetation water potential [mm] CALL ncio_read_vector (file_restart, 'gs0sun ', landpatch, gs0sun ) ! working copy of sunlit stomata conductance - CALL ncio_read_vector (file_restart, 'gs0sha ', landpatch, gs0sha ) ! working copy of shalit stomata conductance + CALL ncio_read_vector (file_restart, 'gs0sha ', landpatch, gs0sha ) ! working copy of shaded stomata conductance ENDIF IF(DEF_USE_OZONESTRESS)THEN CALL ncio_read_vector (file_restart, 'lai_old ', landpatch, lai_old ) @@ -1197,7 +1197,7 @@ SUBROUTINE READ_TimeVariables (idate, lc_year, site, dir_restart) CALL ncio_read_vector (file_restart, 'mss_dst4 ', -maxsnl, landpatch, mss_dst4 ) CALL ncio_read_vector (file_restart, 'ssno_lyr', 2,2, -maxsnl+1, landpatch, ssno_lyr) - ! Additional variables required by reginal model (such as WRF ) RSM) + ! Additional variables required by regional model (such as WRF ) RSM) CALL ncio_read_vector (file_restart, 'trad ', landpatch, trad ) ! radiative temperature of surface [K] CALL ncio_read_vector (file_restart, 'tref ', landpatch, tref ) ! 2 m height air temperature [kelvin] CALL ncio_read_vector (file_restart, 'qref ', landpatch, qref ) ! 2 m height air specific humidity @@ -1340,7 +1340,7 @@ SUBROUTINE check_TimeVariables () IF(DEF_USE_PLANTHYDRAULICS)THEN CALL check_vector_data ('vegwp [m] ', vegwp ) ! vegetation water potential [mm] CALL check_vector_data ('gs0sun [] ', gs0sun ) ! working copy of sunlit stomata conductance - CALL check_vector_data ('gs0sha [] ', gs0sha ) ! working copy of shalit stomata conductance + CALL check_vector_data ('gs0sha [] ', gs0sha ) ! working copy of shaded stomata conductance ENDIF IF(DEF_USE_OZONESTRESS)THEN CALL check_vector_data ('o3coefv_sun ', o3coefv_sun) diff --git a/share/MOD_Namelist.F90 b/share/MOD_Namelist.F90 index 415be2bf..1e42c7da 100644 --- a/share/MOD_Namelist.F90 +++ b/share/MOD_Namelist.F90 @@ -408,8 +408,8 @@ MODULE MOD_Namelist 'TBOT ','QBOT ','PSRF ','PRECTmms', & 'NULL ','WIND ','FSDS ','FLDS ' /) character(len=256) :: timelog(8) = (/ & - 'instant ','instant ','instant ','foreward', & - 'NULL ','instant ','forward ','foreward' /) + 'instant ','instant ','instant ','forward ', & + 'NULL ','instant ','forward ','forward ' /) character(len=256) :: tintalgo(8) = (/ & 'linear ','linear ','linear ','nearest', & 'NULL ','linear ','coszen ','linear ' /) From 987e22ad8523466c482272bb1b537d049fb3c092 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 4 Feb 2025 23:10:05 +0800 Subject: [PATCH 17/43] Change foreward to forward for forcing namelist files. --- run/forcing/CLDAS.nml | 2 +- run/forcing/CMFD.nml | 2 +- run/forcing/CRA40.nml | 2 +- run/forcing/CRUJRA.nml | 2 +- run/forcing/CRUNCEPV4.nml | 2 +- run/forcing/CRUNCEPV7.nml | 2 +- run/forcing/ERA5LAND.nml | 2 +- run/forcing/ERA5_LEddy.nml | 2 +- run/forcing/GDAS.nml | 2 +- run/forcing/GSWP3.nml | 2 +- run/forcing/JRA3Q.nml | 2 +- run/forcing/JRA55.nml | 2 +- run/forcing/MPI-ESM1-2-HR_ssp585.nml | 2 +- run/forcing/MSWX.nml | 2 +- run/forcing/POINT.nml | 2 +- run/forcing/PRINCETON.nml | 2 +- run/forcing/QIAN.nml | 2 +- run/forcing/TPMFD.nml | 2 +- run/forcing/WFDE5.nml | 2 +- run/forcing/WFDEI.nml | 2 +- 20 files changed, 20 insertions(+), 20 deletions(-) diff --git a/run/forcing/CLDAS.nml b/run/forcing/CLDAS.nml index 2a62897f..2646cee6 100644 --- a/run/forcing/CLDAS.nml +++ b/run/forcing/CLDAS.nml @@ -44,7 +44,7 @@ DEF_forcing%vname = 'TAIR' 'QAIR' 'PAIR' 'PRCP' 'NULL' 'WIND' 'SWDN' 'tstr' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'NULL' 'linear' 'coszen' 'linear' / diff --git a/run/forcing/CMFD.nml b/run/forcing/CMFD.nml index a697f100..8963774c 100644 --- a/run/forcing/CMFD.nml +++ b/run/forcing/CMFD.nml @@ -45,7 +45,7 @@ DEF_forcing%vname = 'temp' 'shum' 'pres' 'prec' 'NULL' 'wind' 'srad' 'lrad' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'NULL' 'linear' 'coszen' 'linear' / diff --git a/run/forcing/CRA40.nml b/run/forcing/CRA40.nml index 01e58ee5..7d058b33 100755 --- a/run/forcing/CRA40.nml +++ b/run/forcing/CRA40.nml @@ -43,7 +43,7 @@ DEF_forcing%vname = 'TMP_GDS0_HTGL' 'SPF_H_GDS0_HTGL' 'PRES_P0_L1_GLL0' 'PRATE_P8_L1_GLL0_avg' 'U_GRD_GDS0_HTGL' 'V_GRD_GDS0_HTGL' 'DSWRF_P8_L1_GLL0_avg' 'DLWRF_P8_L1_GLL0_avg' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'NULL' 'linear' 'coszen' 'linear' diff --git a/run/forcing/CRUJRA.nml b/run/forcing/CRUJRA.nml index 999c2f4f..90ed744a 100644 --- a/run/forcing/CRUJRA.nml +++ b/run/forcing/CRUJRA.nml @@ -42,7 +42,7 @@ DEF_forcing%vname = 'tmp' 'spfh' 'pres' 'pre' 'ugrd' 'vgrd' 'dswrf' 'dlwrf' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'linear' 'linear' 'coszen' 'linear' / diff --git a/run/forcing/CRUNCEPV4.nml b/run/forcing/CRUNCEPV4.nml index f2456c0c..7cddcd5a 100644 --- a/run/forcing/CRUNCEPV4.nml +++ b/run/forcing/CRUNCEPV4.nml @@ -39,7 +39,7 @@ DEF_forcing%vname = 'TBOT' 'QBOT' 'PSRF' 'PRECTmms' 'NULL' 'WIND' 'FSDS' 'FLDS' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'NULL' 'linear' 'coszen' 'linear' / diff --git a/run/forcing/CRUNCEPV7.nml b/run/forcing/CRUNCEPV7.nml index 2f821452..c669c1f4 100644 --- a/run/forcing/CRUNCEPV7.nml +++ b/run/forcing/CRUNCEPV7.nml @@ -39,7 +39,7 @@ DEF_forcing%vname = 'TBOT' 'QBOT' 'PSRF' 'PRECTmms' 'NULL' 'WIND' 'FSDS' 'FLDS' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'NULL' 'linear' 'coszen' 'linear' / diff --git a/run/forcing/ERA5LAND.nml b/run/forcing/ERA5LAND.nml index 290b664d..04f3491f 100644 --- a/run/forcing/ERA5LAND.nml +++ b/run/forcing/ERA5LAND.nml @@ -44,7 +44,7 @@ DEF_forcing%fprefix(8) = 'surface_thermal_radiation_downwards_w_m2/ERA5LAND' DEF_forcing%vname = 't2m' 'Q' 'sp' 'tp' 'u10' 'v10' 'ssrd' 'strd' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'linear' 'linear' 'coszen' 'linear' / diff --git a/run/forcing/ERA5_LEddy.nml b/run/forcing/ERA5_LEddy.nml index 2269c776..78007a10 100644 --- a/run/forcing/ERA5_LEddy.nml +++ b/run/forcing/ERA5_LEddy.nml @@ -39,7 +39,7 @@ DEF_forcing%vname = 't2m' 'q' 'sp' 'mtpr' 'u10' 'v10' 'msdwswrf' 'msdwlwrf' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'linear' 'linear' 'coszen' 'linear' DEF_forcing%CBL_fprefix = 'boundary_layer_height/ERA5' diff --git a/run/forcing/GDAS.nml b/run/forcing/GDAS.nml index 730dbd10..6c40df84 100644 --- a/run/forcing/GDAS.nml +++ b/run/forcing/GDAS.nml @@ -45,7 +45,7 @@ DEF_forcing%vname = 'Tair_f_inst' 'Qair_f_inst' 'Psurf_f_inst' 'Rainf_f_tavg' 'NULL' 'Wind_f_inst' 'SWdown_f_tavg' 'LWdown_f_tavg' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'NULL' 'linear' 'coszen' 'linear' / diff --git a/run/forcing/GSWP3.nml b/run/forcing/GSWP3.nml index a063eb56..b53345f6 100644 --- a/run/forcing/GSWP3.nml +++ b/run/forcing/GSWP3.nml @@ -38,7 +38,7 @@ DEF_forcing%fprefix(8) = 'TPHWL/clmforc.GSWP3.c2011.0.5x0.5.TPQWL.' DEF_forcing%vname = 'TBOT' 'QBOT' 'PSRF' 'PRECTmms' 'NULL' 'WIND' 'FSDS' 'FLDS' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'NULL' 'linear' 'coszen' 'linear' / diff --git a/run/forcing/JRA3Q.nml b/run/forcing/JRA3Q.nml index b503299d..139fca6f 100755 --- a/run/forcing/JRA3Q.nml +++ b/run/forcing/JRA3Q.nml @@ -40,7 +40,7 @@ DEF_forcing%vname = 'tmp2m-hgt-fc-gauss' 'spfh2m-hgt-fc-gauss' 'pres-sfc-fc-gauss' 'tprate1have-sfc-fc-gauss' 'ugrd10m-hgt-fc-gauss' 'vgrd10m-hgt-fc-gauss' 'dswrf1have-sfc-fc-gauss' 'dlwrf1have-sfc-fc-gauss' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'linear' 'linear' 'linear' 'coszen' 'linear' diff --git a/run/forcing/JRA55.nml b/run/forcing/JRA55.nml index 6c12d8c4..48dbe1bf 100644 --- a/run/forcing/JRA55.nml +++ b/run/forcing/JRA55.nml @@ -39,7 +39,7 @@ DEF_forcing%vname = 'var11' 'var51' 'var1' 'var61' 'var33' 'var34' 'var204' 'var205' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'linear' 'linear' 'coszen' 'linear' diff --git a/run/forcing/MPI-ESM1-2-HR_ssp585.nml b/run/forcing/MPI-ESM1-2-HR_ssp585.nml index f2842461..c99da16b 100644 --- a/run/forcing/MPI-ESM1-2-HR_ssp585.nml +++ b/run/forcing/MPI-ESM1-2-HR_ssp585.nml @@ -39,7 +39,7 @@ DEF_forcing%vname = 'tas' 'huss' 'ps' 'pr' 'uas' 'vas' 'rsds' 'rlds' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'linear' 'linear' 'coszen' 'linear' / diff --git a/run/forcing/MSWX.nml b/run/forcing/MSWX.nml index dc207199..e6635dcf 100644 --- a/run/forcing/MSWX.nml +++ b/run/forcing/MSWX.nml @@ -39,7 +39,7 @@ DEF_forcing%vname = 'air_temperature' 'specific_humidity' 'surface_pressure' 'precipitation' 'NULL' 'wind_speed' 'downward_shortwave_radiation' 'downward_longwave_radiation' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'NULL' 'linear' 'coszen' 'linear' / diff --git a/run/forcing/POINT.nml b/run/forcing/POINT.nml index c139ef64..4e4a7735 100644 --- a/run/forcing/POINT.nml +++ b/run/forcing/POINT.nml @@ -25,7 +25,7 @@ DEF_forcing%fprefix(8) = 'CN-Dan_2004-2005_FLUXNET2015_Met.nc' DEF_forcing%vname = 'Tair' 'Qair' 'Psurf' 'Precip' 'NULL' 'Wind' 'SWdown' 'LWdown' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'NULL' 'linear' 'coszen' 'linear' / diff --git a/run/forcing/PRINCETON.nml b/run/forcing/PRINCETON.nml index 2f296946..8c965f6a 100644 --- a/run/forcing/PRINCETON.nml +++ b/run/forcing/PRINCETON.nml @@ -39,7 +39,7 @@ DEF_forcing%vname = 'tas' 'shum' 'pres' 'prcp' 'NULL' 'wind' 'dswrf' 'dlwrf' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'NULL' 'linear' 'coszen' 'linear' / diff --git a/run/forcing/QIAN.nml b/run/forcing/QIAN.nml index 46f1021c..ab97240b 100644 --- a/run/forcing/QIAN.nml +++ b/run/forcing/QIAN.nml @@ -39,7 +39,7 @@ DEF_forcing%vname = 'TBOT' 'QBOT' 'PSRF' 'PRECTmms' 'NULL' 'WIND' 'FSDS' 'NULL' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'NULL' 'linear' 'coszen' 'NULL' / diff --git a/run/forcing/TPMFD.nml b/run/forcing/TPMFD.nml index 24dd06b1..0ff75008 100644 --- a/run/forcing/TPMFD.nml +++ b/run/forcing/TPMFD.nml @@ -44,7 +44,7 @@ DEF_forcing%vname = 'temp' 'shum' 'pres' 'prcp' 'NULL' 'wind' 'srad' 'lrad' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'NULL' 'linear' 'coszen' 'linear' / diff --git a/run/forcing/WFDE5.nml b/run/forcing/WFDE5.nml index d0b8ea05..c94765ee 100644 --- a/run/forcing/WFDE5.nml +++ b/run/forcing/WFDE5.nml @@ -42,7 +42,7 @@ DEF_forcing%vname = 'Tair' 'Qair' 'PSurf' 'precipitation' 'NULL' 'Wind' 'SWdown' 'LWdown' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'NULL' 'linear' 'coszen' 'linear' / diff --git a/run/forcing/WFDEI.nml b/run/forcing/WFDEI.nml index 8a6d217c..7c44a9cb 100644 --- a/run/forcing/WFDEI.nml +++ b/run/forcing/WFDEI.nml @@ -43,7 +43,7 @@ DEF_forcing%vname = 'TBOT' 'QBOT' 'PSRF' 'PRECTmms' 'NULL' 'WIND' 'FSDS' 'FLDS' - DEF_forcing%timelog = 'instant' 'instant' 'instant' 'foreward' 'instant' 'instant' 'foreward' 'foreward' + DEF_forcing%timelog = 'instant' 'instant' 'instant' 'forward' 'instant' 'instant' 'forward' 'forward' DEF_forcing%tintalgo = 'linear' 'linear' 'linear' 'nearest' 'NULL' 'linear' 'coszen' 'linear' / From 517b3a4826a4154b174c3448f3e0b8be37673596 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 4 Feb 2025 23:30:21 +0800 Subject: [PATCH 18/43] Correct for type errors and annotation indent for LULCC. --- main/LULCC/MOD_Lulcc_Driver.F90 | 65 +++++++++++++-------- main/LULCC/MOD_Lulcc_Initialize.F90 | 4 +- main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 | 10 ++-- main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 | 26 ++++----- 4 files changed, 61 insertions(+), 44 deletions(-) diff --git a/main/LULCC/MOD_Lulcc_Driver.F90 b/main/LULCC/MOD_Lulcc_Driver.F90 index 268c8e4a..c7aeda24 100644 --- a/main/LULCC/MOD_Lulcc_Driver.F90 +++ b/main/LULCC/MOD_Lulcc_Driver.F90 @@ -27,37 +27,54 @@ SUBROUTINE LulccDriver (casename,dir_landdata,dir_restart,& ! 07/2023, Wenzong Dong: porting to MPI version. ! 08/2023, Wanyi Lin: add interface for Mass&Energy conserved scheme. ! +!----------------------------------------------------------------------- ! Extra processes when adding a new variable and #define LULCC: ! -! 1. Save a copy of new variable (if called "var", save it to "var_") with 2 steps: -! 1.1 main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90's subroutine "allocate_LulccTimeVariables": -! allocate (var_(dimension)) -! 1.2 main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90's subroutine "SAVE_LulccTimeVariables": -! var_ = var +! 1. Save a copy of new variable (if called "var", save it to "var_") +! with 2 steps: +! +! 1.1 main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90's subroutine +! "allocate_LulccTimeVariables": +! allocate (var_(dimension)) +! +! 1.2 main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90's subroutine +! "SAVE_LulccTimeVariables": +! var_ = var +! +! 2. Reassignment for the next year +! +! 2.1 if used Same Type Assignment (SAT) scheme for variable recovery +! main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90's subroutine +! "REST_LulccTimeVariables" +! var(np) = var_(np_) ! -! 2. Reassignment for the next year -! 2.1 if used Same Type Assignment (SAT) scheme for variable recovery -! main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90's subroutine "REST_LulccTimeVariables" -! var(np) = var_(np_) +! 2.2 if using Mass and Energy conservation (MEC) scheme for variable +! recovery ! -! 2.2 if using Mass and Energy conservation (MEC) scheme for variable recovery -! 2.2.1 main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90's subroutine "REST_LulccTimeVariables": -! var(np) = var_(np_) +! 2.2.1 main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90's subroutine +! "REST_LulccTimeVariables": +! var(np) = var_(np_) ! -! 2.2.2 [No need for PFT/PC scheme] Mass and Energy conserve adjustment, add after line 519 -! of MOD_Lulcc_MassEnergyConserve.F90. +! 2.2.2 [No need for PFT/PC scheme] Mass and Energy conserve +! adjustment, add after line 519 of MOD_Lulcc_MassEnergyConserve.F90. ! -! o if variable should be mass conserved: -! var(:,np) = var(:,np) + var(:,frnp_(k))*lccpct_np(patchclass_(frnp_(k)))/sum_lccpct_np +! o if variable should be mass conserved: +! var(:,np) = var(:,np) + & +! var(:,frnp_(k))*lccpct_np(patchclass_(frnp_(k)))/sum_lccpct_np ! -! o if variable should be energy conserved, take soil temperature "t_soisno" as an example: [May neeed extra calculation] -! t_soisno (1:nl_soil,np) = t_soisno (1:nl_soil,np) + & -! t_soisno_(1:nl_soil,frnp_(k))*cvsoil_(1:nl_soil,k)*lccpct_np(patchclass_(frnp_(k)))/wgt(1:nl_soil) -! where cvsoil_ is the heat capacity, wgt is the sum of cvsoil_(1:nl_soil,k)*lccpct_np(patchclass_(frnp_(k))), -! which need to be calculated in advance. +! o if variable should be energy conserved, take soil temperature +! "t_soisno" as an example: [May neeed extra calculation] +! t_soisno (1:nl_soil,np) = t_soisno (1:nl_soil,np) + & +! t_soisno_(1:nl_soil,frnp_(k))*cvsoil_(1:nl_soil,k)* & +! lccpct_np(patchclass_(frnp_(k)))/wgt(1:nl_soil) +! where cvsoil_ is the heat capacity, wgt is the sum of +! cvsoil_(1:nl_soil,k)*lccpct_np(patchclass_(frnp_(k))), which need to +! be calculated in advance. ! -! 3. Deallocate the copy of new variable in MOD_Lulcc_Vars_TimeVariables.F90's subroutine "deallocate_LulccTimeVariables": -! deallocate (var_) +! 3. Deallocate the copy of new variable in +! MOD_Lulcc_Vars_TimeVariables.F90's subroutine +! "deallocate_LulccTimeVariables": +! deallocate (var_) ! !----------------------------------------------------------------------- @@ -113,7 +130,7 @@ SUBROUTINE LulccDriver (casename,dir_landdata,dir_restart,& ! ============================================================= - ! 2. Mass and Energy conservation (MEC) scheme for variable revocery + ! 2. Mass and Energy conservation (MEC) scheme for variable recovery ! ============================================================= IF (DEF_LULCC_SCHEME == 2) THEN diff --git a/main/LULCC/MOD_Lulcc_Initialize.F90 b/main/LULCC/MOD_Lulcc_Initialize.F90 index 98b924b1..d58f4049 100644 --- a/main/LULCC/MOD_Lulcc_Initialize.F90 +++ b/main/LULCC/MOD_Lulcc_Initialize.F90 @@ -22,8 +22,8 @@ SUBROUTINE LulccInitialize (casename,dir_landdata,dir_restart,& ! Created by Hua Yuan, 04/08/2022 ! ! !REVISIONS: -! 08/2023, Wenzong Dong: Porting to MPI version and share the same code with -! MOD_Initialize:initialize() +! 08/2023, Wenzong Dong: Porting to MPI version and share the same code +! with MOD_Initialize:initialize() ! !----------------------------------------------------------------------- diff --git a/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 b/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 index d4477c0a..96adb87e 100644 --- a/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 +++ b/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 @@ -93,16 +93,16 @@ SUBROUTINE LulccMassEnergyConserve real(r8):: sum_lccpct_np, wgt(maxsnl+1:nl_soil), hc(maxsnl+1:0) real(r8):: zi_sno(maxsnl+1:0) !local variable for snow node and depth calculation real(r8):: vf_water !volumetric fraction liquid water within soil - real(r8):: vf_ice !volumetric fraction ice len within soil + real(r8):: vf_ice !volumetric fraction ice lens within soil real(r8):: hcap !J/(m3 K) real(r8):: c_water !Specific heat of water * density of liquid water real(r8):: c_ice !Specific heat of ice * density of ice real(r8):: denice_np(maxsnl+1:0), denh2o_np(maxsnl+1:0), rhosnow_np(maxsnl+1:0) real(r8):: wbef,wpre !water before and water present for water calculation heck - ! real(r8):: fmelt !dimensionless metling factor + ! real(r8):: fmelt !dimensionless melting factor real(r8):: wt !fraction of vegetation covered with snow [-] real(r8), parameter :: m = 1.0 !the value of m used in CLM4.5 is 1.0. - ! real(r8) :: deltim = 1800. !time step (senconds) TODO: be intent in + ! real(r8) :: deltim = 1800. !time step (seconds) TODO: be intent in logical :: FROM_SOIL IF (p_is_worker) THEN @@ -234,7 +234,7 @@ SUBROUTINE LulccMassEnergyConserve IF(DEF_USE_PLANTHYDRAULICS)THEN vegwp (:,np) = 0 !vegetation water potential [mm] gs0sun (np) = 0 !working copy of sunlit stomata conductance - gs0sha (np) = 0 !working copy of shalit stomata conductance + gs0sha (np) = 0 !working copy of shaded stomata conductance ENDIF IF(DEF_USE_OZONESTRESS)THEN @@ -322,7 +322,7 @@ SUBROUTINE LulccMassEnergyConserve nsl_max = count(wgt(:0) .gt. 0) ! denh2o_np(maxsnl+1:0) = 0 ! denice_np(maxsnl+1:0) = 0 - rhosnow_np(maxsnl+1:0) = 0 ! partitial density of water/snow (ice + liquid) + rhosnow_np(maxsnl+1:0) = 0 ! partial density of water/snow (ice + liquid) IF (nsl > 0) THEN ! move wgt above nsl to nsl diff --git a/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 b/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 index e04c5dc4..7765c747 100644 --- a/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 +++ b/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 @@ -11,8 +11,8 @@ MODULE MOD_Lulcc_Vars_TimeVariables ! ! 07/2023, Wenzong Dong: porting to MPI version ! 08/2023, Hua Yuan: unified PFT and PC process -! 10/2023, Wanyi Lin: check with MOD_Vars_TimeVariables.F90, add variables, -! and remove unnecessary variables +! 10/2023, Wanyi Lin: check with MOD_Vars_TimeVariables.F90, add +! variables, and remove unnecessary variables ! !----------------------------------------------------------------------- @@ -21,7 +21,7 @@ MODULE MOD_Lulcc_Vars_TimeVariables IMPLICIT NONE SAVE ! ---------------------------------------------------------------------- -! Time-varying state variables which reaquired by restart run +! Time-varying state variables which required by restart run !TODO: need to check with MOD_Vars_TimeVariables.F90 whether ! there are any variables missing. - DONE real(r8), allocatable :: z_sno_ (:,:) !node depth [m] @@ -48,14 +48,14 @@ MODULE MOD_Lulcc_Vars_TimeVariables real(r8), allocatable :: wdsrf_ (:) !depth of surface water [mm] real(r8), allocatable :: rss_ (:) !soil surface resistance [s/m] - real(r8), allocatable :: t_lake_ (:,:) !lake layer teperature [K] + real(r8), allocatable :: t_lake_ (:,:) !lake layer temperature [K] real(r8), allocatable :: lake_icefrac_ (:,:) !lake mass fraction of lake layer that is frozen real(r8), allocatable :: savedtke1_ (:) !top level eddy conductivity (W/m K) !Plant Hydraulic variables real(r8), allocatable :: vegwp_ (:,:) !vegetation water potential [mm] real(r8), allocatable :: gs0sun_ (:) !working copy of sunlit stomata conductance - real(r8), allocatable :: gs0sha_ (:) !working copy of shalit stomata conductance + real(r8), allocatable :: gs0sha_ (:) !working copy of shaded stomata conductance !END plant hydraulic variables !Ozone stress variables @@ -75,7 +75,7 @@ MODULE MOD_Lulcc_Vars_TimeVariables real(r8), allocatable :: mss_dst4_ (:,:) !mass of dust species 4 in snow (col,lyr) [kg] real(r8), allocatable :: ssno_lyr_ (:,:,:,:) !snow layer absorption [-] - ! Additional variables required by reginal model (such as WRF ) RSM) + ! Additional variables required by regional model (such as WRF ) RSM) real(r8), allocatable :: trad_ (:) !radiative temperature of surface [K] real(r8), allocatable :: tref_ (:) !2 m height air temperature [kelvin] real(r8), allocatable :: qref_ (:) !2 m height air specific humidity @@ -112,7 +112,7 @@ MODULE MOD_Lulcc_Vars_TimeVariables ! Plant Hydraulic variables real(r8), allocatable :: vegwp_p_ (:,:) !vegetation water potential [mm] real(r8), allocatable :: gs0sun_p_ (:) !working copy of sunlit stomata conductance - real(r8), allocatable :: gs0sha_p_ (:) !working copy of shalit stomata conductance + real(r8), allocatable :: gs0sha_p_ (:) !working copy of shaded stomata conductance ! end plant hydraulic variables ! Ozone Stress Variables @@ -126,12 +126,12 @@ MODULE MOD_Lulcc_Vars_TimeVariables real(r8), allocatable :: dfwsun_ (:) !change of sunlit fraction of walls [-] ! shortwave absorption - real(r8), allocatable :: sroof_ (:,:,:) !roof aborption [-] + real(r8), allocatable :: sroof_ (:,:,:) !roof absorption [-] real(r8), allocatable :: swsun_ (:,:,:) !sunlit wall absorption [-] real(r8), allocatable :: swsha_ (:,:,:) !shaded wall absorption [-] - real(r8), allocatable :: sgimp_ (:,:,:) !impervious absorptioin [-] - real(r8), allocatable :: sgper_ (:,:,:) !pervious absorptioin [-] - real(r8), allocatable :: slake_ (:,:,:) !urban lake absorptioin [-] + real(r8), allocatable :: sgimp_ (:,:,:) !impervious absorption [-] + real(r8), allocatable :: sgper_ (:,:,:) !pervious absorption [-] + real(r8), allocatable :: slake_ (:,:,:) !urban lake absorption [-] ! net longwave radiation for last time temperature change real(r8), allocatable :: lwsun_ (:) !net longwave of sunlit wall [W/m2] @@ -190,10 +190,10 @@ MODULE MOD_Lulcc_Vars_TimeVariables real(r8), allocatable :: snowdp_gper_ (:) !pervious ground snow depth [m] real(r8), allocatable :: snowdp_lake_ (:) !urban lake snow depth [m] - !TODO: condsider renaming the below variables + !TODO: consider renaming the below variables real(r8), allocatable :: Fhac_ (:) !sensible flux from heat or cool AC [W/m2] real(r8), allocatable :: Fwst_ (:) !waste heat flux from heat or cool AC [W/m2] - real(r8), allocatable :: Fach_ (:) !flux from inner and outter air exchange [W/m2] + real(r8), allocatable :: Fach_ (:) !flux from inner and outer air exchange [W/m2] real(r8), allocatable :: Fahe_ (:) !flux from metabolism and vehicle [W/m2] real(r8), allocatable :: Fhah_ (:) !sensible heat flux from heating [W/m2] real(r8), allocatable :: vehc_ (:) !flux from vehicle [W/m2] From d1f369a7e74fc198e10d6fc7590c613ebe1f16b7 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 4 Feb 2025 23:41:57 +0800 Subject: [PATCH 19/43] Correct type errors for mksrfdata/*.F90. --- mksrfdata/Aggregation_LakeDepth.F90 | 5 +- mksrfdata/Aggregation_TopographyFactors.F90 | 18 +++---- mksrfdata/Aggregation_Urban.F90 | 14 +++--- mksrfdata/MKSRFDATA.F90 | 6 +-- mksrfdata/MOD_ElmVector.F90 | 40 +++++++-------- mksrfdata/MOD_HRUVector.F90 | 42 ++++++++-------- mksrfdata/MOD_LandUrban.F90 | 4 +- mksrfdata/MOD_MeshFilter.F90 | 54 ++++++++++----------- mksrfdata/MOD_SrfdataRestart.F90 | 10 ++-- 9 files changed, 97 insertions(+), 96 deletions(-) diff --git a/mksrfdata/Aggregation_LakeDepth.F90 b/mksrfdata/Aggregation_LakeDepth.F90 index e83a6c8f..7065a023 100644 --- a/mksrfdata/Aggregation_LakeDepth.F90 +++ b/mksrfdata/Aggregation_LakeDepth.F90 @@ -19,8 +19,9 @@ SUBROUTINE Aggregation_LakeDepth ( & ! 4 this is the river pixel according to our map, set the default value of 3 m ! ! REFERENCE: -! Kourzeneva, E., H. Asensio, E. Martin, and S. Faroux, 2012: Global gridded dataset of lake coverage and lake depth -! for USE in numerical weather prediction and climate modelling. Tellus A, 64, 15640. +! Kourzeneva, E., H. Asensio, E. Martin, and S. Faroux, 2012: Global gridded +! dataset of lake coverage and lake depth for USE in numerical weather +! prediction and climate modelling. Tellus A, 64, 15640. ! ! Created by Yongjiu Dai, 02/2014 ! diff --git a/mksrfdata/Aggregation_TopographyFactors.F90 b/mksrfdata/Aggregation_TopographyFactors.F90 index 7e3f2fb1..99fbfb73 100644 --- a/mksrfdata/Aggregation_TopographyFactors.F90 +++ b/mksrfdata/Aggregation_TopographyFactors.F90 @@ -36,7 +36,7 @@ SUBROUTINE Aggregation_TopographyFactors ( & ! local variables: ! --------------------------------------------------------------- - CHARACTER(len=256) :: landdir, lndname, cyear + CHARACTER(len=256) :: landdir, lndname, cyear CHARACTER(len=3) :: sdir, sdir1 TYPE (block_data_real8_2d) :: slp_grid ! slope @@ -97,7 +97,7 @@ SUBROUTINE Aggregation_TopographyFactors ( & REAL(r8), allocatable :: y_train_transform(:) ! The transform function of y_train ! local variables - INTEGER :: ipatch, i, ps, pe, type, a, z, count_pixels, num_pixels, j, index, n + INTEGER :: ipatch, i, ps, pe, type, a, z, count_pixels, num_pixels, j, index, n #ifdef SrfdataDiag INTEGER :: typpatch(N_land_classification+1), ityp ! number of land classification @@ -231,7 +231,7 @@ SUBROUTINE Aggregation_TopographyFactors ( & DO z = 1, num_zenith ! terrain elevation angle at each azimuth tea_f_one(:) = tea_f_azi_one(a,:) - tea_b_one(:) = tea_b_azi_one(a,:) + tea_b_one(:) = tea_b_azi_one(a,:) ! count the pixels which are not missing value count_pixels = 0 @@ -300,13 +300,13 @@ SUBROUTINE Aggregation_TopographyFactors ( & DO i = 1, num_pixels ! Define the south slope, north slope, abrupt slope and gentle lope of target pixel IF ((asp_one(i).ge.0 .and. asp_one(i).le.90*pi/180) .or. (asp_one(i).ge.270*pi/180 .and. asp_one(i).le.360*pi/180).and.(slp_one(i).ge.15*pi/180)) THEN ! north abrupt slope - type = 1 + type = 1 ELSE IF ((asp_one(i).ge.0 .and. asp_one(i).le.90*pi/180) .or. (asp_one(i).ge.270*pi/180 .and. asp_one(i).le.360*pi/180).and.(slp_one(i)<15*pi/180)) THEN ! north gentle slope type = 2 ELSE IF ((asp_one(i).gt.90*pi/180) .and. (asp_one(i).lt.270*pi/180) .and. (slp_one(i).ge.15*pi/180)) THEN ! south abrupt slope - type = 3 + type = 3 ELSE IF ((asp_one(i).gt.90*pi/180) .and. (asp_one(i).lt.270*pi/180) .and. (slp_one(i).lt.15*pi/180)) THEN ! south gentle slope - type = 4 + type = 4 ELSE ! missing value=-9999 cycle END IF @@ -390,7 +390,7 @@ SUBROUTINE Aggregation_TopographyFactors ( & x_train(:) = x(index:) ! Transform y_train to enable linear regression fitting - DO i = 1, n + DO i = 1, n IF (y_train(i) <= 0.) y_train(i) = 0.001 IF (y_train(i) >= 1.) y_train(i) = 0.999 ENDDO @@ -484,7 +484,7 @@ SUBROUTINE Aggregation_TopographyFactors ( & lndname = trim(dir_model_landdata) // '/diag/topo_factor_svf_' // trim(cyear) // '.nc' CALL srfdata_map_and_write (svf_patches, landpatch%settyp, typpatch, m_patch2diag, & -1.0e36_r8, lndname, 'svf', compress = 1, write_mode = 'one') - + lndname = trim(dir_model_landdata) // '/diag/topo_factor_cur_' // trim(cyear) // '.nc' CALL srfdata_map_and_write (cur_patches, landpatch%settyp, typpatch, m_patch2diag, & -1.0e36_r8, lndname, 'cur', compress = 1, write_mode = 'one') @@ -492,7 +492,7 @@ SUBROUTINE Aggregation_TopographyFactors ( & lndname = trim(dir_model_landdata) // '/diag/topo_factor_sf_lut_' // trim(cyear) // '.nc' DO j = 1, num_azimuth - DO i = 1, num_zenith + DO i = 1, num_zenith write(sdir,'(I0)') j write(sdir1,'(I0)') i CALL srfdata_map_and_write (sf_lut_patches(j,i,:), landpatch%settyp, typpatch, m_patch2diag, & diff --git a/mksrfdata/Aggregation_Urban.F90 b/mksrfdata/Aggregation_Urban.F90 index 59545cb7..76e41656 100644 --- a/mksrfdata/Aggregation_Urban.F90 +++ b/mksrfdata/Aggregation_Urban.F90 @@ -4,8 +4,8 @@ ! ! !DESCRIPTION: ! -! Aggreate/screen high-resolution urban dataset to a lower -! resolutioin/subset data, suitable for running regional or point +! Aggregate/screen high-resolution urban dataset to a lower +! resolution/subset data, suitable for running regional or point ! cases. ! ! Original authors: Hua Yuan and Wenzong Dong, 2021, OpenMP version. @@ -205,12 +205,12 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & LUCY_rid (:) = 0 ! loop for each urban patch to get the LUCY id of all fine grid - ! of iurban patch, then assign the most frequence id to this urban patch + ! of iurban patch, then assign the most frequency id to this urban patch DO iurban = 1, numurban CALL aggregation_request_data (landurban, iurban, grid_urban_5km, zip = USE_zip_for_aggregation, & data_i4_2d_in1 = LUCY_reg, data_i4_2d_out1 = LUCY_reg_one) - ! the most frequence id to this urban patch + ! the most frequency id to this urban patch LUCY_rid(iurban) = num_max_frequency (LUCY_reg_one) ENDDO #ifdef USEMPI @@ -254,7 +254,7 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & landdir = TRIM(dir_rawdata)//'/urban/' suffix = 'URBSRF'//trim(c5year) - ! populaiton data is year by year, + ! population data is year by year, ! so pop_i is calculated to determine the dimension of POP data reads IF (mod(lc_year,5) == 0) THEN pop_i = 1 @@ -449,7 +449,7 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & WHERE (gl30_wt_one < 0) area_one = 0 END WHERE - ! only caculate when urban patch have water cover + ! only calculate when urban patch have water cover IF (sum(area_one) > 0) THEN pct_urbwt(iurban) = sum(gl30_wt_one * area_one) / sum(area_one) ENDIF @@ -498,7 +498,7 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & CALL ncio_read_bcast_serial (landname, "HT_ROOF" , ncar_ht ) ENDIF - ! allocate and read grided building hegight and cover raw data + ! allocate and read grided building height and cover raw data IF (p_is_io) THEN CALL allocate_block_data (grid_urban_500m, reg_typid) CALL allocate_block_data (grid_urban_500m, wtrf) diff --git a/mksrfdata/MKSRFDATA.F90 b/mksrfdata/MKSRFDATA.F90 index f8a3d546..abb71114 100644 --- a/mksrfdata/MKSRFDATA.F90 +++ b/mksrfdata/MKSRFDATA.F90 @@ -26,7 +26,7 @@ PROGRAM MKSRFDATA ! 6. Global Soil Characteristics (...) ! 7. Global Cultural Characteristics (ON-GONG PROJECT) ! -! Land charateristics at the model grid resolution (CREATED): +! Land characteristics at the model grid resolution (CREATED): ! 1. Model grid (longitude, latitude) ! 2. Fraction (area) of patches of grid (0-1) ! 2.1 Fraction of land water bodies (lake, reservoir, river) @@ -383,11 +383,11 @@ PROGRAM MKSRFDATA CALL Aggregation_Topography (gtopo , dir_rawdata, dir_landdata, lc_year) - IF (DEF_USE_Forcing_Downscaling) THEN + IF (DEF_USE_Forcing_Downscaling) THEN CALL Aggregation_TopographyFactors (grid_topo_factor, & trim(DEF_DS_HiresTopographyDataDir), dir_landdata, lc_year) ENDIF - + #ifdef URBAN_MODEL CALL Aggregation_urban (dir_rawdata, dir_landdata, lc_year, & grid_urban_5km, grid_urban_500m) diff --git a/mksrfdata/MOD_ElmVector.F90 b/mksrfdata/MOD_ElmVector.F90 index 7fdbe331..a67d70c7 100644 --- a/mksrfdata/MOD_ElmVector.F90 +++ b/mksrfdata/MOD_ElmVector.F90 @@ -1,11 +1,11 @@ #include -#if (defined UNSTRUCTURED || defined CATCHMENT) +#if (defined UNSTRUCTURED || defined CATCHMENT) MODULE MOD_ElmVector !------------------------------------------------------------------------------------ ! DESCRIPTION: -! +! ! Address of Data associated with land element. ! ! To output a vector, Data is gathered from worker processes directly to master. @@ -18,16 +18,16 @@ MODULE MOD_ElmVector USE MOD_Precision USE MOD_DataType IMPLICIT NONE - + integer :: totalnumelm type(pointer_int32_1d), allocatable :: elm_data_address (:) integer*8, allocatable :: eindex_glb (:) - + CONTAINS - + ! -------- - SUBROUTINE elm_vector_init + SUBROUTINE elm_vector_init USE MOD_SPMD_Task USE MOD_Utils @@ -48,10 +48,10 @@ SUBROUTINE elm_vector_init integer :: i, idsp integer, allocatable :: vec_worker_dsp (:) - + integer*8, allocatable :: indexelm (:) integer, allocatable :: order (:) - + IF (p_is_worker) THEN CALL elm_patch%build (landelm, landpatch, use_frac = .true.) ENDIF @@ -60,27 +60,27 @@ SUBROUTINE elm_vector_init #ifdef USEMPI IF (numelm > 0) THEN allocate (indexelm (numelm)) - indexelm = landelm%eindex + indexelm = landelm%eindex ENDIF - + IF (p_iam_worker == p_root) allocate (numelm_worker (0:p_np_worker-1)) CALL mpi_gather (numelm, 1, MPI_INTEGER, & numelm_worker, 1, MPI_INTEGER, p_root, p_comm_worker, p_err) IF (p_iam_worker == p_root) THEN CALL mpi_send (numelm_worker, p_np_worker, MPI_INTEGER, & - p_address_master, mpi_tag_size, p_comm_glb, p_err) + p_address_master, mpi_tag_size, p_comm_glb, p_err) ENDIF mesg = (/p_iam_glb, numelm/) - CALL mpi_send (mesg, 2, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) + CALL mpi_send (mesg, 2, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) IF (numelm > 0) THEN - CALL mpi_send (indexelm, numelm, MPI_INTEGER8, p_address_master, mpi_tag_data, p_comm_glb, p_err) + CALL mpi_send (indexelm, numelm, MPI_INTEGER8, p_address_master, mpi_tag_data, p_comm_glb, p_err) ENDIF #else IF (numelm > 0) THEN allocate (eindex_glb (numelm)) - eindex_glb = landelm%eindex + eindex_glb = landelm%eindex ENDIF #endif ENDIF @@ -98,7 +98,7 @@ SUBROUTINE elm_vector_init ENDDO totalnumelm = sum(numelm_worker) - + allocate (eindex_glb (totalnumelm)) allocate (elm_data_address(0:p_np_worker-1)) @@ -107,7 +107,7 @@ SUBROUTINE elm_vector_init allocate (elm_data_address(iwork)%val (numelm_worker(iwork))) ENDIF ENDDO - + DO iwork = 0, p_np_worker-1 CALL mpi_recv (mesg, 2, MPI_INTEGER, MPI_ANY_SOURCE, & mpi_tag_mesg, p_comm_glb, p_stat, p_err) @@ -125,8 +125,8 @@ SUBROUTINE elm_vector_init allocate (elm_data_address(0:0)) allocate (elm_data_address(0)%val (totalnumelm)) #endif - ENDIF - + ENDIF + #ifdef USEMPI CALL mpi_bcast (totalnumelm, 1, MPI_INTEGER, p_address_master, p_comm_glb, p_err) #endif @@ -152,7 +152,7 @@ SUBROUTINE elm_vector_init IF (allocated(indexelm)) deallocate(indexelm) IF (allocated(order)) deallocate(order) - END SUBROUTINE elm_vector_init + END SUBROUTINE elm_vector_init ! ---------- SUBROUTINE elm_vector_final () @@ -161,7 +161,7 @@ SUBROUTINE elm_vector_final () IF (allocated(elm_data_address)) deallocate (elm_data_address) IF (allocated(eindex_glb)) deallocate (eindex_glb) - + END SUBROUTINE elm_vector_final END MODULE MOD_ElmVector diff --git a/mksrfdata/MOD_HRUVector.F90 b/mksrfdata/MOD_HRUVector.F90 index 2f0fb675..1c46370d 100644 --- a/mksrfdata/MOD_HRUVector.F90 +++ b/mksrfdata/MOD_HRUVector.F90 @@ -1,11 +1,11 @@ #include -#if (defined CATCHMENT) +#if (defined CATCHMENT) MODULE MOD_HRUVector !------------------------------------------------------------------------------------ ! DESCRIPTION: -! +! ! Address of Data associated with HRU. ! ! To output a vector, Data is gathered from worker processes directly to master. @@ -18,17 +18,17 @@ MODULE MOD_HRUVector USE MOD_Precision USE MOD_DataType IMPLICIT NONE - + integer :: totalnumhru type(pointer_int32_1d), allocatable :: hru_data_address (:) integer*8, allocatable :: eindx_hru (:) integer, allocatable :: htype_hru (:) - + CONTAINS - + ! -------- - SUBROUTINE hru_vector_init + SUBROUTINE hru_vector_init USE MOD_SPMD_Task USE MOD_Utils @@ -53,9 +53,9 @@ SUBROUTINE hru_vector_init integer :: ielm, i, ielm_glb integer :: nhru, nelm, hru_dsp_loc - + IF (p_is_worker) THEN - + CALL basin_hru%build (landelm, landhru, use_frac = .true.) CALL hru_patch%build (landhru, landpatch, use_frac = .true.) @@ -67,9 +67,9 @@ SUBROUTINE hru_vector_init #ifdef USEMPI mesg = (/p_iam_glb, numelm/) - CALL mpi_send (mesg, 2, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) + CALL mpi_send (mesg, 2, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) IF (numelm > 0) THEN - CALL mpi_send (nhru_bsn, numelm, MPI_INTEGER, p_address_master, mpi_tag_data, p_comm_glb, p_err) + CALL mpi_send (nhru_bsn, numelm, MPI_INTEGER, p_address_master, mpi_tag_data, p_comm_glb, p_err) ENDIF #endif ENDIF @@ -94,7 +94,7 @@ SUBROUTINE hru_vector_init mpi_tag_data, p_comm_glb, p_stat, p_err) nhru_bsn_glb(elm_data_address(p_itis_worker(isrc))%val) = rbuff - + IF (sum(rbuff) > 0) THEN allocate(hru_data_address(p_itis_worker(isrc))%val (sum(rbuff))) ENDIF @@ -117,7 +117,7 @@ SUBROUTINE hru_vector_init IF (p_is_master) THEN totalnumhru = sum(nhru_bsn_glb) - + allocate (hru_dsp_glb (totalnumelm)) hru_dsp_glb(1) = 0 DO ielm = 2, totalnumelm @@ -137,19 +137,19 @@ SUBROUTINE hru_vector_init hru_dsp_loc = hru_dsp_loc + nhru ENDIF ENDDO - ENDIF + ENDIF ENDDO ENDIF #ifdef USEMPI CALL mpi_bcast (totalnumhru, 1, MPI_INTEGER, p_address_master, p_comm_glb, p_err) #endif - + #ifdef USEMPI IF (p_is_worker) THEN mesg = (/p_iam_glb, numhru/) - CALL mpi_send (mesg, 2, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) + CALL mpi_send (mesg, 2, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) IF (numhru > 0) THEN - CALL mpi_send (landhru%settyp, numhru, MPI_INTEGER, p_address_master, mpi_tag_data, p_comm_glb, p_err) + CALL mpi_send (landhru%settyp, numhru, MPI_INTEGER, p_address_master, mpi_tag_data, p_comm_glb, p_err) ENDIF ENDIF #endif @@ -178,7 +178,7 @@ SUBROUTINE hru_vector_init CALL mpi_recv (rbuff, ndata, MPI_INTEGER, isrc, & mpi_tag_data, p_comm_glb, p_stat, p_err) htype_hru(hru_data_address(p_itis_worker(isrc))%val) = rbuff - + deallocate(rbuff) ENDIF ENDDO @@ -186,8 +186,8 @@ SUBROUTINE hru_vector_init htype_hru(hru_data_address(0)%val) = landhru%settyp #endif - ! To distinguish between lake HRUs and hillslopes, the program sets the - ! type of lake HRUs as a negative number. + ! To distinguish between lake HRUs and hillslopes, the program sets the + ! type of lake HRUs as a negative number. ! Set it as a positive number for output. htype_hru = abs(htype_hru) @@ -197,7 +197,7 @@ SUBROUTINE hru_vector_init CALL mpi_bcast (totalnumhru, 1, MPI_INTEGER, p_address_master, p_comm_glb, p_err) #endif - END SUBROUTINE hru_vector_init + END SUBROUTINE hru_vector_init ! ---------- SUBROUTINE hru_vector_final () @@ -207,7 +207,7 @@ SUBROUTINE hru_vector_final () IF (allocated(hru_data_address)) deallocate (hru_data_address) IF (allocated(eindx_hru)) deallocate (eindx_hru) IF (allocated(htype_hru)) deallocate (htype_hru) - + END SUBROUTINE hru_vector_final END MODULE MOD_HRUVector diff --git a/mksrfdata/MOD_LandUrban.F90 b/mksrfdata/MOD_LandUrban.F90 index 385e5710..3778d58e 100644 --- a/mksrfdata/MOD_LandUrban.F90 +++ b/mksrfdata/MOD_LandUrban.F90 @@ -158,11 +158,11 @@ SUBROUTINE landurban_build (lc_year) data_i4_2d_in1 = data_urb_class, data_i4_2d_out1 = ibuff) ! when there is missing urban types - !NOTE@tungwz: need duoble check below and add appropriate annotations + !NOTE@tungwz: need double check below and add appropriate annotations ! check if there is urban pixel without URBAN ID imiss = count(ibuff<1 .or. ibuff>N_URB) IF (imiss > 0) THEN - ! Calculate the relative ratio of each urban types by excluding urban pixels withoht URBAN ID + ! Calculate the relative ratio of each urban types by excluding urban pixels without URBAN ID WHERE (ibuff<1 .or. ibuff>N_URB) area_one = 0 END WHERE diff --git a/mksrfdata/MOD_MeshFilter.F90 b/mksrfdata/MOD_MeshFilter.F90 index 692cbd44..9a8e1ae1 100644 --- a/mksrfdata/MOD_MeshFilter.F90 +++ b/mksrfdata/MOD_MeshFilter.F90 @@ -5,7 +5,7 @@ MODULE MOD_MeshFilter !------------------------------------------------------------------------------------ ! DESCRIPTION: ! -! Mesh filter. +! Mesh filter. ! Mesh filter can be used to mask part of region or globe as needed. ! ! Created by Shupeng Zhang, May 2023 @@ -25,9 +25,9 @@ logical FUNCTION inquire_mesh_filter () USE MOD_Namelist IMPLICIT NONE logical :: fexists - + IF (p_is_master) THEN - + inquire (file=trim(DEF_file_mesh_filter), exist=fexists) IF (.not. fexists) THEN @@ -36,7 +36,7 @@ logical FUNCTION inquire_mesh_filter () write(*,'(/, 2A)') 'Note: Mesh Filter from file ', trim(DEF_file_mesh_filter) ENDIF ENDIF - + #ifdef USEMPI CALL mpi_bcast (fexists, 1, MPI_LOGICAL, p_address_master, p_comm_glb, p_err) #endif @@ -47,7 +47,7 @@ END FUNCTION inquire_mesh_filter ! ------------- SUBROUTINE mesh_filter (gridf, ffilter, fvname) - + USE MOD_Precision USE MOD_Namelist USE MOD_SPMD_Task @@ -62,7 +62,7 @@ SUBROUTINE mesh_filter (gridf, ffilter, fvname) type(grid_type), intent(in) :: gridf character(len=*), intent(in) :: ffilter character(len=*), intent(in) :: fvname - + ! local variables: ! --------------------------------------------------------------- type (block_data_int32_2d) :: datafilter @@ -76,38 +76,38 @@ SUBROUTINE mesh_filter (gridf, ffilter, fvname) IF (p_is_master) THEN write(*,'(/, A)') 'Filtering pixels ...' ENDIF - + IF (p_is_io) THEN CALL allocate_block_data (gridf, datafilter) CALL ncio_read_block (trim(ffilter), trim(fvname), gridf, datafilter) - + #ifdef USEMPI CALL aggregation_data_daemon (gridf, data_i4_2d_in1 = datafilter) #endif ENDIF - + IF (p_is_worker) THEN - + jelm = 0 DO ielm = 1, numelm CALL aggregation_request_data (landelm, ielm, gridf, zip = .false., & data_i4_2d_in1 = datafilter, data_i4_2d_out1 = ifilter, & filledvalue_i4 = -1) - + allocate (filter (mesh(ielm)%npxl)) filter = ifilter > 0 - + IF (any(filter)) THEN jelm = jelm + 1 IF (.not. all(filter)) THEN - + npxl = count(filter) - + allocate (xtemp(npxl)) allocate (ytemp(npxl)) xtemp = pack(mesh(ielm)%ilon, filter) ytemp = pack(mesh(ielm)%ilat, filter) - + deallocate(mesh(ielm)%ilon) deallocate(mesh(ielm)%ilat) @@ -116,23 +116,23 @@ SUBROUTINE mesh_filter (gridf, ffilter, fvname) allocate(mesh(ielm)%ilon(npxl)) allocate(mesh(ielm)%ilat(npxl)) mesh(ielm)%ilon = xtemp - mesh(ielm)%ilat = ytemp - + mesh(ielm)%ilat = ytemp + deallocate (xtemp) deallocate (ytemp) ENDIF - + IF (jelm /= ielm) THEN CALL copy_elm (mesh(ielm), mesh(jelm)) ENDIF - + ENDIF - + deallocate (filter) ENDDO - + numelm = jelm - + #ifdef USEMPI CALL aggregation_worker_done () #endif @@ -147,7 +147,7 @@ SUBROUTINE mesh_filter (gridf, ffilter, fvname) ENDIF CALL landelm_build () - + #ifdef USEMPI IF (p_is_worker) THEN CALL mpi_reduce (numelm, nelm_glb, 1, MPI_INTEGER, MPI_SUM, p_root, p_comm_worker, p_err) @@ -158,15 +158,15 @@ SUBROUTINE mesh_filter (gridf, ffilter, fvname) #else write(*,'(A,I12,A)') 'Total: ', numelm, ' elements after mesh filtering.' #endif - + ! Update nelm_blk nelm_blk(:,:) = 0 - IF (p_is_worker) THEN + IF (p_is_worker) THEN DO ielm = 1, numelm nelm_blk(mesh(ielm)%xblk,mesh(ielm)%yblk) = & nelm_blk(mesh(ielm)%xblk,mesh(ielm)%yblk) + 1 ENDDO - ENDIF + ENDIF #ifdef USEMPI CALL mpi_allreduce (MPI_IN_PLACE, nelm_blk, gblock%nxblk*gblock%nyblk, & MPI_INTEGER, MPI_SUM, p_comm_glb, p_err) @@ -175,7 +175,7 @@ SUBROUTINE mesh_filter (gridf, ffilter, fvname) #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - + END SUBROUTINE mesh_filter END MODULE MOD_MeshFilter diff --git a/mksrfdata/MOD_SrfdataRestart.F90 b/mksrfdata/MOD_SrfdataRestart.F90 index ac17da1b..6ae8b3c6 100644 --- a/mksrfdata/MOD_SrfdataRestart.F90 +++ b/mksrfdata/MOD_SrfdataRestart.F90 @@ -5,7 +5,7 @@ MODULE MOD_SrfdataRestart ! DESCRIPTION: ! ! This module includes subroutines to read/write data of mesh and pixelsets. -! +! ! Created by Shupeng Zhang, May 2023 !------------------------------------------------------------------------------------ @@ -41,7 +41,7 @@ SUBROUTINE mesh_save_to_file (dir_landdata, lc_year) integer, allocatable :: npxlall(:) integer, allocatable :: elmpixels(:,:) real(r8), allocatable :: lon(:), lat(:) - + integer :: nsend, nrecv, ndone, ndsp ! add parameter input for time year @@ -117,7 +117,7 @@ SUBROUTINE mesh_save_to_file (dir_landdata, lc_year) CALL mpi_send (elmpixels(:,ndone+1:ndone+nsend), 2*nsend, & MPI_INTEGER, p_root, mpi_tag_data, p_comm_group, p_err) ndone = ndone + nsend - ENDDO + ENDDO ENDIF ENDIF #endif @@ -159,7 +159,7 @@ SUBROUTINE mesh_save_to_file (dir_landdata, lc_year) tothis = ndone + sum(npxlall(ndsp+1:ndsp+nelm_worker(iworker))) DO WHILE (ndone < tothis) - + CALL mpi_recv (nrecv, 1, & MPI_INTEGER, iworker, mpi_tag_size, p_comm_group, p_stat, p_err) CALL mpi_recv (elmpixels(:,ndone+1:ndone+nrecv), 2*nrecv, & @@ -615,7 +615,7 @@ SUBROUTINE pixelset_load_from_file (dir_landdata, psetname, pixelset, numset, lc ENDIF numset = pixelset%nset - + pixelset%has_shared = .false. IF (p_is_worker) THEN DO iset = 1, pixelset%nset-1 From f2f5cb24426db42d58bab0520af09bf0d50da940 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 4 Feb 2025 23:51:26 +0800 Subject: [PATCH 20/43] Correct type errors for mkinidata/*.F90. --- mkinidata/MOD_IniTimeVariable.F90 | 10 ++++----- mkinidata/MOD_Initialize.F90 | 30 +++++++++++++------------- mkinidata/MOD_SoilParametersReadin.F90 | 6 +++--- mkinidata/MOD_UrbanReadin.F90 | 2 +- 4 files changed, 24 insertions(+), 24 deletions(-) diff --git a/mkinidata/MOD_IniTimeVariable.F90 b/mkinidata/MOD_IniTimeVariable.F90 index 40a4877a..10745e69 100644 --- a/mkinidata/MOD_IniTimeVariable.F90 +++ b/mkinidata/MOD_IniTimeVariable.F90 @@ -101,7 +101,7 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& soil_d_n_alb, &! albedo of near infrared of the dry soil zlnd, &! aerodynamic roughness length over soil surface [m] z0mr, &! ratio to calculate roughness length z0m - htop, &! Caonpy top height [m] + htop, &! canopy top height [m] chil, &! leaf angle distribution factor rho(2,2), &! leaf reflectance (iw=iband, il=life and dead) tau(2,2), &! leaf transmittance (iw=iband, il=life and dead) @@ -146,7 +146,7 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& !Plant Hydraulic parameters vegwp(1:nvegwcs), &! vegetation water potential gs0sun, &! working copy of sunlit stomata conductance - gs0sha, &! working copy of shalit stomata conductance + gs0sha, &! working copy of shaded stomata conductance !end plant hydraulic parameters t_grnd, &! ground surface temperature [K] tleaf, &! sunlit leaf temperature [K] @@ -188,7 +188,7 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& mss_dst4 ( maxsnl+1:0 ), &! mass concentration of dust aerosol species 4 (col,lyr) [kg/kg] ssno_lyr (2,2,maxsnl+1:1 ), &! snow layer absorption [-] - ! Additional variables required by reginal model (WRF & RSM) + ! Additional variables required by regional model (WRF & RSM) ! --------------------------------------------------------- trad, &! radiative temperature of surface [K] tref, &! 2 m height air temperature [kelvin] @@ -421,7 +421,7 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& wliq_soisno(j) = dz_soisno(j)*porsl(j)*denh2o wice_soisno(j) = 0. ENDIF - ENDDO + ENDDO IF (patchtype <= 1) THEN CALL get_water_equilibrium_state (zwtmm, nl_soil, wliq_soisno(1:nl_soil), smp, hk, wa, & @@ -1173,7 +1173,7 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& extkd = 0.0 ENDIF - ! Additional variables required by reginal model (WRF & RSM) + ! Additional variables required by regional model (WRF & RSM) ! totally arbitrarily assigned here trad = t_grnd tref = t_grnd diff --git a/mkinidata/MOD_Initialize.F90 b/mkinidata/MOD_Initialize.F90 index 5acba746..483470df 100644 --- a/mkinidata/MOD_Initialize.F90 +++ b/mkinidata/MOD_Initialize.F90 @@ -201,7 +201,7 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & real(r8) :: wdsrfm, depthratio real(r8), dimension(10) :: dzlak = (/0.1, 1., 2., 3., 4., 5., 7., 7., 10.45, 10.45/) ! m - ! CoLM soil layer thickiness and depths + ! CoLM soil layer thickness and depths real(r8), allocatable :: z_soisno (:,:) real(r8), allocatable :: dz_soisno(:,:) @@ -240,16 +240,16 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & logical :: use_soiltext ! for USDA soil texture class: ! 0: undefined - ! 1: clay; 2: silty clay; 3: sandy clay; 4: clay loam; 5: silty clay loam; 6: sandy clay loam; & + ! 1: clay; 2: silty clay; 3: sandy clay; 4: clay loam; 5: silty clay loam; 6: sandy clay loam; & ! 7: loam; 8: silty loam; 9: sandy loam; 10: silt; 11: loamy sand; 12: sand ! original VIC soil texture class in noahmp: ! 1: SAND 2: LOAMY SAND 3: SANDY LOAM 4: SILT LOAM 5: SILT 6: LOAM 7: SANDY CLAY LOAM 8: SILTY CLAY LOAM 9: CLAY LOAM 10: SANDY CLAY 11: SILTY CLAY 12: CLAY 13: ORGANIC MATERIAL 14: WATER 15: BEDROCK 16: OTHER(land-ice) 17: PLAYA 18: LAVA 19: WHITE SAND - ! 9: CLAY LOAM 10: SANDY CLAY 11: SILTY CLAY 12: CLAY - !soil type 0 1 2 3 4 5 6 7 8 9 10 11 12 + ! 9: CLAY LOAM 10: SANDY CLAY 11: SILTY CLAY 12: CLAY + !soil type 0 1 2 3 4 5 6 7 8 9 10 11 12 !BVIC = 1.0 0.050, 0.080, 0.090, 0.250, 0.150, 0.180, 0.200, 0.220, 0.230, 0.250, 0.280, 0.300 !re-arranged BVIC for USDA soil texture class: - real(r8), parameter :: BVIC_USDA(0:12) = (/ 1., 0.300, 0.280, 0.250, 0.230, 0.220, 0.200, 0.180, 0.100, 0.090, 0.150, 0.080, 0.050/) + real(r8), parameter :: BVIC_USDA(0:12) = (/ 1., 0.300, 0.280, 0.250, 0.230, 0.220, 0.200, 0.180, 0.100, 0.090, 0.150, 0.080, 0.050/) ! -------------------------------------------------------------------- ! Allocates memory for CoLM 1d [numpatch] variables @@ -1075,10 +1075,10 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & ! for SOIL Water INIT by using water table depth use_wtd = (.not. use_soilini) .and. DEF_USE_WaterTableInit - + IF (use_wtd) THEN - fwtd = DEF_file_WaterTable + fwtd = DEF_file_WaterTable IF (p_is_master) THEN inquire (file=trim(fwtd), exist=use_wtd) @@ -1113,7 +1113,7 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & ! 2.4 LEAF area index ! ................... #if(defined DYN_PHENOLOGY) - ! CREAT fraction of vegetation cover, greenness, leaf area index, stem index + ! CREATE fraction of vegetation cover, greenness, leaf area index, stem index IF (p_is_worker) THEN DO i = 1, numpatch @@ -1321,10 +1321,10 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & wice_gimpsno(:,u) = 0. !ice lens [kg/m2] wice_gpersno(:,u) = 0. !ice lens [kg/m2] wice_lakesno(:,u) = 0. !ice lens [kg/m2] - wliq_roofsno(:,u) = 0. !liqui water [kg/m2] - wliq_gimpsno(:,u) = 0. !liqui water [kg/m2] - wliq_gpersno(:,u) = wliq_soisno(:,i) !liqui water [kg/m2] - wliq_lakesno(:,u) = wliq_soisno(:,i) !liqui water [kg/m2] + wliq_roofsno(:,u) = 0. !liquid water [kg/m2] + wliq_gimpsno(:,u) = 0. !liquid water [kg/m2] + wliq_gpersno(:,u) = wliq_soisno(:,i) !liquid water [kg/m2] + wliq_lakesno(:,u) = wliq_soisno(:,i) !liquid water [kg/m2] wliq_soisno(: ,i) = 0. wliq_soisno(:1,i) = wliq_roofsno(:1,u)*froof(u) @@ -1352,7 +1352,7 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & twsha_inner (u) = 283. !temperature of inner shaded wall [K] Fhac (u) = 0. !sensible flux from heat or cool AC [W/m2] Fwst (u) = 0. !waste heat flux from heat or cool AC [W/m2] - Fach (u) = 0. !flux from inner and outter air exchange [W/m2] + Fach (u) = 0. !flux from inner and outer air exchange [W/m2] meta (u) = 0. !flux from metabolic [W/m2] vehc (u) = 0. !flux from vehicle [W/m2] @@ -1460,7 +1460,7 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & #endif IF ( .not. present(lulcc_call) ) THEN - ! only be called in runing MKINI, LULCC will be executed later + ! only be called in running MKINI, LULCC will be executed later CALL WRITE_TimeVariables (idate, lc_year, casename, dir_restart) ENDIF @@ -1475,7 +1475,7 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & ! Deallocates memory for CoLM 1d [numpatch] variables ! -------------------------------------------------- IF ( .not. present(lulcc_call) ) THEN - ! only be called in runing MKINI, LULCC will be executed later + ! only be called in running MKINI, LULCC will be executed later CALL deallocate_TimeInvariants CALL deallocate_TimeVariables ENDIF diff --git a/mkinidata/MOD_SoilParametersReadin.F90 b/mkinidata/MOD_SoilParametersReadin.F90 index e225e929..41a3daec 100644 --- a/mkinidata/MOD_SoilParametersReadin.F90 +++ b/mkinidata/MOD_SoilParametersReadin.F90 @@ -65,8 +65,8 @@ SUBROUTINE soil_parameters_readin (dir_landdata, lc_year) real(r8), allocatable :: soil_k_s_l (:) ! saturated hydraulic conductivity (cm/day) real(r8), allocatable :: soil_csol_l (:) ! heat capacity of soil solids [J/(m3 K)] real(r8), allocatable :: soil_k_solids_l(:) ! thermal conductivity of minerals soil [W/m-K] - real(r8), allocatable :: soil_tksatu_l (:) ! thermal conductivity of saturated unforzen soil [W/m-K] - real(r8), allocatable :: soil_tksatf_l (:) ! thermal conductivity of saturated forzen soil [W/m-K] + real(r8), allocatable :: soil_tksatu_l (:) ! thermal conductivity of saturated unfrozen soil [W/m-K] + real(r8), allocatable :: soil_tksatf_l (:) ! thermal conductivity of saturated frozen soil [W/m-K] real(r8), allocatable :: soil_tkdry_l (:) ! thermal conductivity for dry soil [W/(m-K)] real(r8), allocatable :: soil_BA_alpha_l(:) ! alpha in Balland and Arp(2005) thermal conductivity scheme real(r8), allocatable :: soil_BA_beta_l (:) ! beta in Balland and Arp(2005) thermal conductivity scheme @@ -419,7 +419,7 @@ SUBROUTINE soil_parameters_readin (dir_landdata, lc_year) ENDIF ENDIF - ! Soil reflectance of broadband of visible(_v) and near-infrared(_n) of the sarurated(_s) and dry(_d) soil + ! Soil reflectance of broadband of visible(_v) and near-infrared(_n) of the saturated(_s) and dry(_d) soil ! SCHEME 1: Guessed soil color type according to land cover classes IF (DEF_SOIL_REFL_SCHEME .eq. 1) THEN IF (p_is_worker) THEN diff --git a/mkinidata/MOD_UrbanReadin.F90 b/mkinidata/MOD_UrbanReadin.F90 index 2743dde6..c070312d 100644 --- a/mkinidata/MOD_UrbanReadin.F90 +++ b/mkinidata/MOD_UrbanReadin.F90 @@ -239,7 +239,7 @@ SUBROUTINE Urban_readin (dir_landdata, lc_year) ENDDO em_roof(u) = emroof_lcz (landurban%settyp(u)) !emissivity of roof - em_wall(u) = emwall_lcz (landurban%settyp(u)) !emissiviry of wall + em_wall(u) = emwall_lcz (landurban%settyp(u)) !emissivity of wall em_gimp(u) = emimproad_lcz (landurban%settyp(u)) !emissivity of impervious em_gper(u) = emperroad_lcz (landurban%settyp(u)) !emissivity of pervious From d3ed5c78b4d593dc4d25d7d9aab5b2c38f1d5d8f Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 5 Feb 2025 10:07:21 +0800 Subject: [PATCH 21/43] Correct type errors of annotations for other directories. --- main/BGC/MOD_BGC_CNCStateUpdate1.F90 | 64 +-- main/BGC/MOD_BGC_CNCStateUpdate2.F90 | 42 +- main/BGC/MOD_BGC_CNCStateUpdate3.F90 | 34 +- main/BGC/MOD_BGC_CNNStateUpdate1.F90 | 94 ++--- main/BGC/MOD_BGC_CNNStateUpdate2.F90 | 26 +- main/BGC/MOD_BGC_CNNStateUpdate3.F90 | 46 +-- main/BGC/MOD_BGC_Daylength.F90 | 22 +- .../MOD_BGC_Soil_BiogeochemCompetition.F90 | 154 ++++---- main/BGC/MOD_BGC_Soil_BiogeochemDecomp.F90 | 30 +- ...OD_BGC_Soil_BiogeochemDecompCascadeBGC.F90 | 38 +- .../MOD_BGC_Soil_BiogeochemLittVertTransp.F90 | 44 +-- .../MOD_BGC_Soil_BiogeochemNStateUpdate1.F90 | 74 ++-- main/BGC/MOD_BGC_Soil_BiogeochemPotential.F90 | 54 +-- ...MOD_BGC_Soil_BiogeochemVerticalProfile.F90 | 32 +- main/BGC/MOD_BGC_Vars_1DFluxes.F90 | 28 +- main/BGC/MOD_BGC_Vars_1DPFTFluxes.F90 | 352 ++++++++--------- main/BGC/MOD_BGC_Vars_PFTimeVariables.F90 | 6 +- main/BGC/MOD_BGC_Vars_TimeInvariants.F90 | 4 +- main/BGC/MOD_BGC_Vars_TimeVariables.F90 | 2 +- main/BGC/MOD_BGC_Veg_CNFireBase.F90 | 102 ++--- main/BGC/MOD_BGC_Veg_CNFireLi2016.F90 | 52 +-- main/BGC/MOD_BGC_Veg_CNGResp.F90 | 66 ++-- main/BGC/MOD_BGC_Veg_CNGapMortality.F90 | 74 ++-- main/BGC/MOD_BGC_Veg_CNMResp.F90 | 24 +- main/BGC/MOD_BGC_Veg_CNNDynamics.F90 | 66 ++-- main/BGC/MOD_BGC_Veg_CNPhenology.F90 | 364 +++++++++--------- main/BGC/MOD_BGC_Veg_CNVegStructUpdate.F90 | 36 +- main/BGC/MOD_BGC_Veg_NutrientCompetition.F90 | 112 +++--- main/HYDRO/MOD_Catch_RiverLakeFlow.F90 | 106 ++--- main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 | 138 +++---- main/HYDRO/MOD_Hydro_SoilWater.F90 | 54 +-- main/HYDRO/MOD_Hydro_VIC_Variables.F90 | 2 +- main/HYDRO/MOD_Hydro_Vars_1DFluxes.F90 | 18 +- preprocess/aggregation_landtypes.F90 | 2 +- .../rawdata_soil_hydraulic_parameters.F90 | 22 +- preprocess/rawdata_soil_solids_fractions.F90 | 14 +- .../rawdata_soil_thermal_parameters.F90 | 2 +- preprocess/rd_land_types.F90 | 160 ++++---- preprocess/rd_soil_properties.F90 | 16 +- share/MOD_DataType.F90 | 94 ++--- share/MOD_Namelist.F90 | 10 +- share/MOD_NetCDFVectorBlk.F90 | 122 +++--- 42 files changed, 1401 insertions(+), 1401 deletions(-) diff --git a/main/BGC/MOD_BGC_CNCStateUpdate1.F90 b/main/BGC/MOD_BGC_CNCStateUpdate1.F90 index 23f10b8e..5434dc90 100644 --- a/main/BGC/MOD_BGC_CNCStateUpdate1.F90 +++ b/main/BGC/MOD_BGC_CNCStateUpdate1.F90 @@ -2,10 +2,10 @@ #ifdef BGC MODULE MOD_BGC_CNCStateUpdate1 - -!------------------------------------------------------------------------------------------------- + +!------------------------------------------------------------------------------------------------- ! !DESCRIPTION: -! First updates in vegetation and soil carbon. Thre major updates are included in bgc_CNCStateUpdate1Mod +! First updates in vegetation and soil carbon. The major updates are included in bgc_CNCStateUpdate1Mod ! 1. Update phenology-associated veg and soil C pool size changes, including plant growth ! 2. Update decomposition-associated soil C pool size changes ! 3. Record the accumulated C transfers associated to phenology and decomposition for semi-analytic spinup @@ -14,7 +14,7 @@ MODULE MOD_BGC_CNCStateUpdate1 ! The Community Land Model version 5.0 (CLM5.0) ! ! REVISION: -! Xingjie Lu, 2022, 1) modify original CLM5 to be compatible with CoLM code structure. +! Xingjie Lu, 2022, 1) modify original CLM5 to be compatible with CoLM code structure. ! 2) Record the accumulated phenology-associated C transfer for veg and soil C semi-analytic spinup ! 3) Record the accumulated decomposition-associated C transfer for soil C semi-analytic spinup @@ -32,10 +32,10 @@ MODULE MOD_BGC_CNCStateUpdate1 AKX_cwd_to_cel_c_vr_acc , AKX_cwd_to_lig_c_vr_acc , AKX_soil1_to_soil3_c_vr_acc, AKX_soil2_to_soil1_c_vr_acc, & AKX_soil2_to_soil3_c_vr_acc, AKX_soil3_to_soil1_c_vr_acc, & AKX_met_exit_c_vr_acc , AKX_cel_exit_c_vr_acc , AKX_lig_exit_c_vr_acc , AKX_cwd_exit_c_vr_acc , & - AKX_soil1_exit_c_vr_acc , AKX_soil2_exit_c_vr_acc , AKX_soil3_exit_c_vr_acc - + AKX_soil1_exit_c_vr_acc , AKX_soil2_exit_c_vr_acc , AKX_soil3_exit_c_vr_acc + USE MOD_BGC_Vars_1DFluxes, only: & -! decomposition pools flux varables (in) +! decomposition pools flux variables (in) decomp_cpools_sourcesink, decomp_ctransfer_vr, decomp_hr_vr , & phenology_to_met_c , phenology_to_cel_c , phenology_to_lig_c @@ -54,32 +54,32 @@ MODULE MOD_BGC_CNCStateUpdate1 ! crop variables (in) harvdate_p , cropprod1c_p , & -! SASU variables +! SASU variables I_leafc_p_acc , I_leafc_st_p_acc , I_frootc_p_acc , I_frootc_st_p_acc , & I_livestemc_p_acc , I_livestemc_st_p_acc , I_deadstemc_p_acc , I_deadstemc_st_p_acc , & I_livecrootc_p_acc, I_livecrootc_st_p_acc, I_deadcrootc_p_acc, I_deadcrootc_st_p_acc, & I_grainc_p_acc , I_grainc_st_p_acc , & - + AKX_leafc_xf_to_leafc_p_acc , AKX_frootc_xf_to_frootc_p_acc , AKX_livestemc_xf_to_livestemc_p_acc , & AKX_deadstemc_xf_to_deadstemc_p_acc , AKX_livecrootc_xf_to_livecrootc_p_acc , AKX_deadcrootc_xf_to_deadcrootc_p_acc , & AKX_grainc_xf_to_grainc_p_acc , AKX_livestemc_to_deadstemc_p_acc , AKX_livecrootc_to_deadcrootc_p_acc , & - + AKX_leafc_st_to_leafc_xf_p_acc , AKX_frootc_st_to_frootc_xf_p_acc , AKX_livestemc_st_to_livestemc_xf_p_acc , & AKX_deadstemc_st_to_deadstemc_xf_p_acc, AKX_livecrootc_st_to_livecrootc_xf_p_acc, AKX_deadcrootc_st_to_deadcrootc_xf_p_acc, & AKX_livestemc_st_to_livestemc_xf_p_acc, AKX_grainc_st_to_grainc_xf_p_acc , & - + AKX_leafc_exit_p_acc , AKX_frootc_exit_p_acc , AKX_livestemc_exit_p_acc , & AKX_deadstemc_exit_p_acc , AKX_livecrootc_exit_p_acc , AKX_deadcrootc_exit_p_acc , & AKX_grainc_exit_p_acc , & - + AKX_leafc_st_exit_p_acc , AKX_frootc_st_exit_p_acc , AKX_livestemc_st_exit_p_acc , & AKX_deadstemc_st_exit_p_acc , AKX_livecrootc_st_exit_p_acc , AKX_deadcrootc_st_exit_p_acc , & AKX_grainc_st_exit_p_acc , & - + AKX_leafc_xf_exit_p_acc , AKX_frootc_xf_exit_p_acc , AKX_livestemc_xf_exit_p_acc , & AKX_deadstemc_xf_exit_p_acc , AKX_livecrootc_xf_exit_p_acc , AKX_deadcrootc_xf_exit_p_acc , & AKX_grainc_xf_exit_p_acc - + USE MOD_BGC_Vars_1DPFTFluxes, only: & ! vegetation carbon flux variables (in) @@ -124,7 +124,7 @@ MODULE MOD_BGC_CNCStateUpdate1 cpool_leaf_storage_gr_p , cpool_froot_storage_gr_p , & cpool_livestem_storage_gr_p , cpool_deadstem_storage_gr_p , & cpool_livecroot_storage_gr_p, cpool_deadcroot_storage_gr_p , & - + cpool_grain_gr_p , cpool_grain_storage_gr_p , & ! maintenance respiration fluxes (in) @@ -135,11 +135,11 @@ MODULE MOD_BGC_CNCStateUpdate1 transfer_leaf_gr_p , transfer_froot_gr_p , & transfer_livestem_gr_p , transfer_deadstem_gr_p , & transfer_livecroot_gr_p, transfer_deadcroot_gr_p, & - transfer_grain_gr_p , xsmrpool_to_atm_p + transfer_grain_gr_p , xsmrpool_to_atm_p IMPLICIT NONE - + PUBLIC :: CStateUpdate1 CONTAINS @@ -167,7 +167,7 @@ SUBROUTINE CStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro decomp_cpools_sourcesink(j,i_lig_lit,i) = phenology_to_lig_c(j,i) *deltim decomp_cpools_sourcesink(j,i_cwd ,i) = 0._r8 ENDDO - + IF(DEF_USE_SASU .or. DEF_USE_DiagMatrix)THEN DO j=1,nl_soil I_met_c_vr_acc(j,i) = I_met_c_vr_acc(j,i) + phenology_to_met_c(j,i) *deltim @@ -175,15 +175,15 @@ SUBROUTINE CStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro I_lig_c_vr_acc(j,i) = I_lig_c_vr_acc(j,i) + phenology_to_lig_c(j,i) *deltim ENDDO ENDIF - + DO k = 1, ndecomp_transitions DO j = 1,nl_soil decomp_cpools_sourcesink(j,donor_pool(k),i) = & decomp_cpools_sourcesink(j,donor_pool(k),i) & - (decomp_hr_vr(j,k,i) + decomp_ctransfer_vr(j,k,i)) * deltim ENDDO - ENDDO - + ENDDO + DO k = 1,ndecomp_transitions IF ( receiver_pool(k) /= 0 ) THEN ! skip terminal transitions DO j = 1,nl_soil @@ -193,7 +193,7 @@ SUBROUTINE CStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro ENDDO ENDIF ENDDO - + IF(DEF_USE_SASU .or. DEF_USE_DiagMatrix)THEN DO j = 1, nl_soil AKX_met_to_soil1_c_vr_acc (j,i) = AKX_met_to_soil1_c_vr_acc (j,i) + decomp_ctransfer_vr(j, 1,i) * deltim @@ -206,7 +206,7 @@ SUBROUTINE CStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro AKX_soil2_to_soil1_c_vr_acc(j,i) = AKX_soil2_to_soil1_c_vr_acc(j,i) + decomp_ctransfer_vr(j, 8,i) * deltim AKX_soil2_to_soil3_c_vr_acc(j,i) = AKX_soil2_to_soil3_c_vr_acc(j,i) + decomp_ctransfer_vr(j, 9,i) * deltim AKX_soil3_to_soil1_c_vr_acc(j,i) = AKX_soil3_to_soil1_c_vr_acc(j,i) + decomp_ctransfer_vr(j,10,i) * deltim - + AKX_met_exit_c_vr_acc (j,i) = AKX_met_exit_c_vr_acc (j,i) + (decomp_hr_vr(j, 1,i) + decomp_ctransfer_vr(j, 1,i)) * deltim AKX_cel_exit_c_vr_acc (j,i) = AKX_cel_exit_c_vr_acc (j,i) + (decomp_hr_vr(j, 2,i) + decomp_ctransfer_vr(j, 2,i)) * deltim AKX_lig_exit_c_vr_acc (j,i) = AKX_lig_exit_c_vr_acc (j,i) + (decomp_hr_vr(j, 3,i) + decomp_ctransfer_vr(j, 3,i)) * deltim @@ -219,7 +219,7 @@ SUBROUTINE CStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro AKX_soil3_exit_c_vr_acc (j,i) = AKX_soil3_exit_c_vr_acc (j,i) + (decomp_hr_vr(j,10,i) + decomp_ctransfer_vr(j,10,i)) * deltim ENDDO ENDIF - + DO m = ps , pe ivt = pftclass(m) leafc_p (m) = leafc_p (m) + leafc_xfer_to_leafc_p (m) * deltim @@ -243,7 +243,7 @@ SUBROUTINE CStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro grainc_p (m) = grainc_p (m) + grainc_xfer_to_grainc_p (m) * deltim grainc_xfer_p (m) = grainc_xfer_p (m) - grainc_xfer_to_grainc_p (m) * deltim ENDIF - + IF(DEF_USE_SASU .or. DEF_USE_DiagMatrix)THEN AKX_leafc_xf_to_leafc_p_acc (m) = AKX_leafc_xf_to_leafc_p_acc (m) + leafc_xfer_to_leafc_p (m) * deltim AKX_frootc_xf_to_frootc_p_acc(m) = AKX_frootc_xf_to_frootc_p_acc(m) + frootc_xfer_to_frootc_p(m) * deltim @@ -266,11 +266,11 @@ SUBROUTINE CStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro AKX_grainc_xf_exit_p_acc (m) = AKX_grainc_xf_exit_p_acc (m) + grainc_xfer_to_grainc_p (m) * deltim ENDIF ENDIF - + ! phenology: litterfall fluxes leafc_p (m) = leafc_p (m) - leafc_to_litter_p (m) * deltim frootc_p(m) = frootc_p(m) - frootc_to_litter_p(m) * deltim - + ! livewood turnover fluxes IF (woody(ivt) == 1) THEN livestemc_p (m) = livestemc_p (m) - livestemc_to_deadstemc_p (m) * deltim @@ -283,7 +283,7 @@ SUBROUTINE CStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro grainc_p (m) = grainc_p (m) - (grainc_to_food_p(m) + grainc_to_seed_p(m)) * deltim cropseedc_deficit_p(m) = cropseedc_deficit_p(m) - crop_seedc_to_leaf_p(m) * deltim + grainc_to_seed_p(m) * deltim ENDIF - + IF(DEF_USE_SASU .or. DEF_USE_DiagMatrix)THEN AKX_leafc_exit_p_acc (m) = AKX_leafc_exit_p_acc (m) + leafc_to_litter_p (m) * deltim AKX_frootc_exit_p_acc(m) = AKX_frootc_exit_p_acc(m) + frootc_to_litter_p(m) * deltim @@ -391,7 +391,7 @@ SUBROUTINE CStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro cpool_p (m) = cpool_p (m) - cpool_livestem_gr_p (m) * deltim cpool_p (m) = cpool_p (m) - cpool_grain_gr_p (m) * deltim ENDIF - + gresp_xfer_p(m) = gresp_xfer_p(m) - transfer_leaf_gr_p (m) * deltim gresp_xfer_p(m) = gresp_xfer_p(m) - transfer_froot_gr_p(m) * deltim IF (woody(ivt) == 1) THEN @@ -417,11 +417,11 @@ SUBROUTINE CStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro cpool_p (m) = cpool_p (m) - cpool_livestem_storage_gr_p (m) * deltim cpool_p (m) = cpool_p (m) - cpool_grain_storage_gr_p (m) * deltim ENDIF - + ! growth respiration stored for release during transfer growth cpool_p (m) = cpool_p (m) - cpool_to_gresp_storage_p(m) * deltim gresp_storage_p(m) = gresp_storage_p(m) + cpool_to_gresp_storage_p(m) * deltim - + ! move storage pools into transfer pools leafc_storage_p (m) = leafc_storage_p (m) - leafc_storage_to_xfer_p (m) * deltim leafc_xfer_p (m) = leafc_xfer_p (m) + leafc_storage_to_xfer_p (m) * deltim @@ -430,7 +430,7 @@ SUBROUTINE CStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro IF (woody(ivt) == 1) THEN gresp_storage_p (m) = gresp_storage_p (m) - gresp_storage_to_xfer_p(m) * deltim gresp_xfer_p (m) = gresp_xfer_p (m) + gresp_storage_to_xfer_p(m) * deltim - + livestemc_storage_p (m) = livestemc_storage_p (m) - livestemc_storage_to_xfer_p (m) * deltim livestemc_xfer_p (m) = livestemc_xfer_p (m) + livestemc_storage_to_xfer_p (m) * deltim deadstemc_storage_p (m) = deadstemc_storage_p (m) - deadstemc_storage_to_xfer_p (m) * deltim diff --git a/main/BGC/MOD_BGC_CNCStateUpdate2.F90 b/main/BGC/MOD_BGC_CNCStateUpdate2.F90 index f6ec6feb..7ba10fd6 100644 --- a/main/BGC/MOD_BGC_CNCStateUpdate2.F90 +++ b/main/BGC/MOD_BGC_CNCStateUpdate2.F90 @@ -5,30 +5,30 @@ MODULE MOD_BGC_CNCStateUpdate2 !--------------------------------------------------------------------------------------------------------- ! !DESCRIPTION -! First updates in vegetation and soil carbon. Thre major updates are included in bgc_CNCStateUpdate1Mod +! First updates in vegetation and soil carbon. The major updates are included in bgc_CNCStateUpdate1Mod ! 1. Update gap-mortality-associated veg and soil C pool size changes -! 2. Record the accumulated C transfers associated to gap-mortality for semi-analytic spinup +! 2. Record the accumulated C transfers associated to gap-mortality for semi-analytic spinup ! !ORIGINAL: ! The Community Land Model version 5.0 (CLM5.0) ! REVISION: -! Xingjie Lu, 2022, 1) modify original CLM5 to be compatible with CoLM code structure. +! Xingjie Lu, 2022, 1) modify original CLM5 to be compatible with CoLM code structure. ! 2) Record the accumulated gap-mortality-associated C transfers for veg and soil C semi-analytic spinup USE MOD_Precision USE MOD_Namelist, only : DEF_USE_SASU, DEF_USE_DiagMatrix USE MOD_Vars_TimeInvariants, only: & - i_met_lit,i_cel_lit,i_lig_lit ,i_cwd + i_met_lit,i_cel_lit,i_lig_lit ,i_cwd USE MOD_Vars_TimeVariables, only: & ! decomposition pools & fluxes variables (inout) decomp_cpools_vr, & I_met_c_vr_acc, I_cel_c_vr_acc, I_lig_c_vr_acc, I_cwd_c_vr_acc - + USE MOD_BGC_Vars_1DFluxes, only: & gap_mortality_to_met_c, gap_mortality_to_cel_c , & - gap_mortality_to_lig_c, gap_mortality_to_cwdc - + gap_mortality_to_lig_c, gap_mortality_to_cwdc + USE MOD_BGC_Vars_PFTimeVariables, only: & ! vegetation carbon state variables (inout) leafc_p , leafc_storage_p , leafc_xfer_p , & @@ -38,7 +38,7 @@ MODULE MOD_BGC_CNCStateUpdate2 livecrootc_p , livecrootc_storage_p, livecrootc_xfer_p, & deadcrootc_p , deadcrootc_storage_p, deadcrootc_xfer_p, & gresp_storage_p , gresp_xfer_p , & - + ! SASU variables AKX_leafc_exit_p_acc , AKX_leafc_st_exit_p_acc , AKX_leafc_xf_exit_p_acc , & AKX_frootc_exit_p_acc , AKX_frootc_st_exit_p_acc , AKX_frootc_xf_exit_p_acc , & @@ -46,7 +46,7 @@ MODULE MOD_BGC_CNCStateUpdate2 AKX_deadstemc_exit_p_acc , AKX_deadstemc_st_exit_p_acc , AKX_deadstemc_xf_exit_p_acc , & AKX_livecrootc_exit_p_acc, AKX_livecrootc_st_exit_p_acc, AKX_livecrootc_xf_exit_p_acc, & AKX_deadcrootc_exit_p_acc, AKX_deadcrootc_st_exit_p_acc, AKX_deadcrootc_xf_exit_p_acc - + USE MOD_BGC_Vars_1DPFTFluxes, only: & ! vegetation carbon flux variables m_leafc_to_litter_p , m_leafc_storage_to_litter_p , m_leafc_xfer_to_litter_p , & @@ -56,21 +56,21 @@ MODULE MOD_BGC_CNCStateUpdate2 m_livecrootc_to_litter_p , m_livecrootc_storage_to_litter_p, m_livecrootc_xfer_to_litter_p, & m_deadcrootc_to_litter_p , m_deadcrootc_storage_to_litter_p, m_deadcrootc_xfer_to_litter_p, & m_gresp_storage_to_litter_p, m_gresp_xfer_to_litter_p - + IMPLICIT NONE - + PUBLIC CStateUpdate2 CONTAINS SUBROUTINE CStateUpdate2 (i, ps, pe, deltim, nl_soil) - + integer ,intent(in) :: i ! patch index integer ,intent(in) :: ps ! start pft index integer ,intent(in) :: pe ! END pft index real(r8),intent(in) :: deltim ! time step in second integer ,intent(in) :: nl_soil ! number of total soil layers - + integer j integer m @@ -86,7 +86,7 @@ SUBROUTINE CStateUpdate2 (i, ps, pe, deltim, nl_soil) decomp_cpools_vr(j,i_cwd,i) = & decomp_cpools_vr(j,i_cwd,i) + gap_mortality_to_cwdc(j,i) * deltim ENDDO - + IF(DEF_USE_SASU .or. DEF_USE_DiagMatrix)THEN DO j = 1,nl_soil I_met_c_vr_acc(j,i) = I_met_c_vr_acc(j,i) + gap_mortality_to_met_c(j,i) * deltim @@ -95,9 +95,9 @@ SUBROUTINE CStateUpdate2 (i, ps, pe, deltim, nl_soil) I_cwd_c_vr_acc(j,i) = I_cwd_c_vr_acc(j,i) + gap_mortality_to_cwdc (j,i) * deltim ENDDO ENDIF - + ! patch loop - + DO m = ps, pe gresp_xfer_p (m) = gresp_xfer_p(m) & - m_gresp_xfer_to_litter_p (m) * deltim @@ -117,7 +117,7 @@ SUBROUTINE CStateUpdate2 (i, ps, pe, deltim, nl_soil) - m_livecrootc_to_litter_p (m) * deltim deadcrootc_p (m) = deadcrootc_p (m) & - m_deadcrootc_to_litter_p (m) * deltim - + ! storage pools leafc_storage_p (m) = leafc_storage_p (m) & - m_leafc_storage_to_litter_p (m) * deltim @@ -131,7 +131,7 @@ SUBROUTINE CStateUpdate2 (i, ps, pe, deltim, nl_soil) - m_livecrootc_storage_to_litter_p(m) * deltim deadcrootc_storage_p(m) = deadcrootc_storage_p(m) & - m_deadcrootc_storage_to_litter_p(m) * deltim - + ! transfer pools leafc_xfer_p (m) = leafc_xfer_p (m) & - m_leafc_xfer_to_litter_p (m) * deltim @@ -145,7 +145,7 @@ SUBROUTINE CStateUpdate2 (i, ps, pe, deltim, nl_soil) - m_livecrootc_xfer_to_litter_p (m) * deltim deadcrootc_xfer_p (m) = deadcrootc_xfer_p (m) & - m_deadcrootc_xfer_to_litter_p (m) * deltim - + IF(DEF_USE_SASU .or. DEF_USE_DiagMatrix)THEN AKX_leafc_exit_p_acc (m) = AKX_leafc_exit_p_acc (m) + m_leafc_to_litter_p (m) * deltim AKX_frootc_exit_p_acc (m) = AKX_frootc_exit_p_acc (m) + m_frootc_to_litter_p (m) * deltim @@ -153,14 +153,14 @@ SUBROUTINE CStateUpdate2 (i, ps, pe, deltim, nl_soil) AKX_deadstemc_exit_p_acc (m) = AKX_deadstemc_exit_p_acc (m) + m_deadstemc_to_litter_p (m) * deltim AKX_livecrootc_exit_p_acc (m) = AKX_livecrootc_exit_p_acc (m) + m_livecrootc_to_litter_p (m) * deltim AKX_deadcrootc_exit_p_acc (m) = AKX_deadcrootc_exit_p_acc (m) + m_deadcrootc_to_litter_p (m) * deltim - + AKX_leafc_st_exit_p_acc (m) = AKX_leafc_st_exit_p_acc (m) + m_leafc_storage_to_litter_p (m) * deltim AKX_frootc_st_exit_p_acc (m) = AKX_frootc_st_exit_p_acc (m) + m_frootc_storage_to_litter_p (m) * deltim AKX_livestemc_st_exit_p_acc (m) = AKX_livestemc_st_exit_p_acc (m) + m_livestemc_storage_to_litter_p (m) * deltim AKX_deadstemc_st_exit_p_acc (m) = AKX_deadstemc_st_exit_p_acc (m) + m_deadstemc_storage_to_litter_p (m) * deltim AKX_livecrootc_st_exit_p_acc(m) = AKX_livecrootc_st_exit_p_acc(m) + m_livecrootc_storage_to_litter_p(m) * deltim AKX_deadcrootc_st_exit_p_acc(m) = AKX_deadcrootc_st_exit_p_acc(m) + m_deadcrootc_storage_to_litter_p(m) * deltim - + AKX_leafc_xf_exit_p_acc (m) = AKX_leafc_xf_exit_p_acc (m) + m_leafc_xfer_to_litter_p (m) * deltim AKX_frootc_xf_exit_p_acc (m) = AKX_frootc_xf_exit_p_acc (m) + m_frootc_xfer_to_litter_p (m) * deltim AKX_livestemc_xf_exit_p_acc (m) = AKX_livestemc_xf_exit_p_acc (m) + m_livestemc_xfer_to_litter_p (m) * deltim diff --git a/main/BGC/MOD_BGC_CNCStateUpdate3.F90 b/main/BGC/MOD_BGC_CNCStateUpdate3.F90 index 4876c6e9..afb640fd 100644 --- a/main/BGC/MOD_BGC_CNCStateUpdate3.F90 +++ b/main/BGC/MOD_BGC_CNCStateUpdate3.F90 @@ -4,7 +4,7 @@ MODULE MOD_BGC_CNCStateUpdate3 !------------------------------------------------------------------------------------------------------- ! !DESCRIPTION -! First updates in vegetation and soil carbon. Thre major updates are included in bgc_CNCStateUpdate1Mod +! First updates in vegetation and soil carbon. The major updates are included in bgc_CNCStateUpdate1Mod ! 1. Update fire-associated veg and soil(litter) C pool size changes ! 2. Record the accumulated C transfers associated to fire for semi-analytic spinup @@ -12,21 +12,21 @@ MODULE MOD_BGC_CNCStateUpdate3 ! The Community Land Model version 5.0 (CLM5.0) ! !REVISION: -! Xingjie Lu, 2022, 1) modify original CLM5 to be compatible with CoLM code structure. +! Xingjie Lu, 2022, 1) modify original CLM5 to be compatible with CoLM code structure. ! 2) Record accumulated fire-associated C transfers for veg and soil C semi-analytic spinup USE MOD_Precision USE MOD_BGC_Vars_TimeInvariants, only: & - i_met_lit,i_cel_lit,i_lig_lit ,i_cwd + i_met_lit,i_cel_lit,i_lig_lit ,i_cwd USE MOD_BGC_Vars_TimeVariables, only: & ! decomposition pools & fluxes variables (inout) - decomp_cpools_vr - + decomp_cpools_vr + USE MOD_BGC_Vars_1DFluxes, only: & m_decomp_cpools_to_fire_vr, & fire_mortality_to_met_c, fire_mortality_to_cel_c, & fire_mortality_to_lig_c, fire_mortality_to_cwdc - + USE MOD_BGC_Vars_PFTimeVariables, only: & ! vegetation carbon state variables (inout) leafc_p , leafc_storage_p , leafc_xfer_p , & @@ -35,8 +35,8 @@ MODULE MOD_BGC_CNCStateUpdate3 deadstemc_p , deadstemc_storage_p , deadstemc_xfer_p , & livecrootc_p , livecrootc_storage_p, livecrootc_xfer_p, & deadcrootc_p , deadcrootc_storage_p, deadcrootc_xfer_p, & - gresp_storage_p , gresp_xfer_p - + gresp_storage_p , gresp_xfer_p + USE MOD_BGC_Vars_1DPFTFluxes, only: & ! vegetation carbon flux variables m_leafc_to_fire_p , m_leafc_storage_to_fire_p , m_leafc_xfer_to_fire_p , & @@ -47,17 +47,17 @@ MODULE MOD_BGC_CNCStateUpdate3 m_deadcrootc_to_fire_p , m_deadcrootc_storage_to_fire_p, m_deadcrootc_xfer_to_fire_p, & m_livestemc_to_deadstemc_fire_p , m_livecrootc_to_deadcrootc_fire_p , & m_gresp_storage_to_fire_p , m_gresp_xfer_to_fire_p , & - + m_leafc_to_litter_fire_p , m_leafc_storage_to_litter_fire_p , m_leafc_xfer_to_litter_fire_p , & m_frootc_to_litter_fire_p , m_frootc_storage_to_litter_fire_p , m_frootc_xfer_to_litter_fire_p , & m_livestemc_to_litter_fire_p , m_livestemc_storage_to_litter_fire_p , m_livestemc_xfer_to_litter_fire_p , & m_deadstemc_to_litter_fire_p , m_deadstemc_storage_to_litter_fire_p , m_deadstemc_xfer_to_litter_fire_p , & m_livecrootc_to_litter_fire_p , m_livecrootc_storage_to_litter_fire_p, m_livecrootc_xfer_to_litter_fire_p, & m_deadcrootc_to_litter_fire_p , m_deadcrootc_storage_to_litter_fire_p, m_deadcrootc_xfer_to_litter_fire_p, & - m_gresp_storage_to_litter_fire_p, m_gresp_xfer_to_litter_fire_p - + m_gresp_storage_to_litter_fire_p, m_gresp_xfer_to_litter_fire_p + IMPLICIT NONE - + PUBLIC CStateUpdate3 CONTAINS @@ -77,7 +77,7 @@ SUBROUTINE CStateUpdate3(i, ps, pe, deltim, nl_soil, ndecomp_pools) ! patch-level wood to column-level CWD (uncombusted wood) decomp_cpools_vr(j,i_cwd,i) = decomp_cpools_vr(j,i_cwd,i) & + fire_mortality_to_cwdc (j,i) * deltim - + ! patch-level wood to column-level litter (uncombusted wood) decomp_cpools_vr(j,i_met_lit,i) = decomp_cpools_vr(j,i_met_lit,i) & + fire_mortality_to_met_c(j,i) * deltim @@ -86,7 +86,7 @@ SUBROUTINE CStateUpdate3(i, ps, pe, deltim, nl_soil, ndecomp_pools) decomp_cpools_vr(j,i_lig_lit,i) = decomp_cpools_vr(j,i_lig_lit,i) & + fire_mortality_to_lig_c(j,i) * deltim ENDDO - + ! litter and CWD losses to fire DO l = 1, ndecomp_pools DO j = 1, nl_soil @@ -94,7 +94,7 @@ SUBROUTINE CStateUpdate3(i, ps, pe, deltim, nl_soil, ndecomp_pools) - m_decomp_cpools_to_fire_vr(j,l,i) * deltim ENDDO ENDDO - + ! patch-level carbon fluxes from fire DO m = ps , pe gresp_storage_p (m) = gresp_storage_p (m) & @@ -134,7 +134,7 @@ SUBROUTINE CStateUpdate3(i, ps, pe, deltim, nl_soil, ndecomp_pools) deadcrootc_p (m) = deadcrootc_p (m) & - m_deadcrootc_to_litter_fire_p (m) * deltim & + m_livecrootc_to_deadcrootc_fire_p (m) * deltim - + ! storage pools leafc_storage_p (m) = leafc_storage_p (m) & - m_leafc_storage_to_fire_p (m) * deltim @@ -160,7 +160,7 @@ SUBROUTINE CStateUpdate3(i, ps, pe, deltim, nl_soil, ndecomp_pools) - m_deadcrootc_storage_to_fire_p (m) * deltim deadcrootc_storage_p(m) = deadcrootc_storage_p(m) & - m_deadcrootc_storage_to_litter_fire_p(m) * deltim - + ! transfer pools leafc_xfer_p (m) = leafc_xfer_p (m) & - m_leafc_xfer_to_fire_p (m) * deltim diff --git a/main/BGC/MOD_BGC_CNNStateUpdate1.F90 b/main/BGC/MOD_BGC_CNNStateUpdate1.F90 index 0e20c86d..989a982e 100644 --- a/main/BGC/MOD_BGC_CNNStateUpdate1.F90 +++ b/main/BGC/MOD_BGC_CNNStateUpdate1.F90 @@ -2,9 +2,9 @@ #ifdef BGC MODULE MOD_BGC_CNNStateUpdate1 -!------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- ! !DESCRIPTION: -! First updates in vegetation and soil nitrogen. Thre major updates are included in bgc_CNNStateUpdate1Mod +! First updates in vegetation and soil nitrogen. The major updates are included in bgc_CNNStateUpdate1Mod ! 1. Update phenology-associated veg and soil N pool size changes, including plant growth ! 2. Update decomposition-associated soil N pool size changes ! 3. Record the accumulated N transfers associated to phenology and decomposition for semi-analytic spinup @@ -13,7 +13,7 @@ MODULE MOD_BGC_CNNStateUpdate1 ! The Community Land Model version 5.0 (CLM5.0) ! ! REVISION: -! Xingjie Lu, 2022, 1) modify original CLM5 to be compatible with CoLM code structure. +! Xingjie Lu, 2022, 1) modify original CLM5 to be compatible with CoLM code structure. ! 2) Record the accumulated phenology-associated N transfer for veg and soil N semi-analytic spinup ! 3) Record the accumulated decomposition-associated N transfer for soil N semi-analytic spinup @@ -24,15 +24,15 @@ MODULE MOD_BGC_CNNStateUpdate1 USE MOD_BGC_Vars_TimeInvariants, only: & ! bgc constants donor_pool, receiver_pool, i_met_lit, i_cel_lit, i_lig_lit, i_cwd, i_soil1, i_soil2, i_soil3 - + USE MOD_BGC_Vars_TimeVariables, only: & I_met_n_vr_acc, I_cel_n_vr_acc, I_lig_n_vr_acc - + USE MOD_BGC_Vars_1DFluxes, only: & ! decomposition pools flux varables (in) decomp_npools_sourcesink, & phenology_to_met_n , phenology_to_cel_n, phenology_to_lig_n - + USE MOD_BGC_Vars_PFTimeVariables, only: & ! vegetation nitrogen state variables (inout) leafn_p , leafn_storage_p , leafn_xfer_p , & @@ -43,44 +43,44 @@ MODULE MOD_BGC_CNNStateUpdate1 deadcrootn_p , deadcrootn_storage_p, deadcrootn_xfer_p, & grainn_p , grainn_storage_p , grainn_xfer_p , & cropseedn_deficit_p, retransn_p , npool_p , & - + ! SASU variables I_leafn_p_acc , I_leafn_st_p_acc , I_frootn_p_acc , I_frootn_st_p_acc , & I_livestemn_p_acc , I_livestemn_st_p_acc , I_deadstemn_p_acc , I_deadstemn_st_p_acc , & I_livecrootn_p_acc, I_livecrootn_st_p_acc, I_deadcrootn_p_acc, I_deadcrootn_st_p_acc, & I_grainn_p_acc , I_grainn_st_p_acc , & - + AKX_leafn_xf_to_leafn_p_acc , AKX_frootn_xf_to_frootn_p_acc , AKX_livestemn_xf_to_livestemn_p_acc , & AKX_deadstemn_xf_to_deadstemn_p_acc , AKX_livecrootn_xf_to_livecrootn_p_acc , AKX_deadcrootn_xf_to_deadcrootn_p_acc , & AKX_grainn_xf_to_grainn_p_acc , AKX_livestemn_to_deadstemn_p_acc , AKX_livecrootn_to_deadcrootn_p_acc , & - + AKX_leafn_st_to_leafn_xf_p_acc , AKX_frootn_st_to_frootn_xf_p_acc , AKX_livestemn_st_to_livestemn_xf_p_acc , & AKX_deadstemn_st_to_deadstemn_xf_p_acc, AKX_livecrootn_st_to_livecrootn_xf_p_acc, AKX_deadcrootn_st_to_deadcrootn_xf_p_acc, & AKX_livestemn_st_to_livestemn_xf_p_acc, AKX_grainn_st_to_grainn_xf_p_acc , & - + AKX_leafn_to_retransn_p_acc , AKX_frootn_to_retransn_p_acc , AKX_livestemn_to_retransn_p_acc , & AKX_livecrootn_to_retransn_p_acc , & - + AKX_retransn_to_leafn_p_acc , AKX_retransn_to_frootn_p_acc , AKX_retransn_to_livestemn_p_acc , & AKX_retransn_to_deadstemn_p_acc , AKX_retransn_to_livecrootn_p_acc , AKX_retransn_to_deadcrootn_p_acc , & AKX_retransn_to_grainn_p_acc , & - + AKX_retransn_to_leafn_st_p_acc , AKX_retransn_to_frootn_st_p_acc , AKX_retransn_to_livestemn_st_p_acc , & AKX_retransn_to_deadstemn_st_p_acc , AKX_retransn_to_livecrootn_st_p_acc , AKX_retransn_to_deadcrootn_st_p_acc , & AKX_retransn_to_grainn_st_p_acc , & - + AKX_leafn_exit_p_acc , AKX_frootn_exit_p_acc , AKX_livestemn_exit_p_acc , & AKX_deadstemn_exit_p_acc , AKX_livecrootn_exit_p_acc , AKX_deadcrootn_exit_p_acc , & AKX_grainn_exit_p_acc , AKX_retransn_exit_p_acc , & - + AKX_leafn_st_exit_p_acc , AKX_frootn_st_exit_p_acc , AKX_livestemn_st_exit_p_acc , & AKX_deadstemn_st_exit_p_acc , AKX_livecrootn_st_exit_p_acc , AKX_deadcrootn_st_exit_p_acc , & - AKX_grainn_st_exit_p_acc , & - + AKX_grainn_st_exit_p_acc , & + AKX_leafn_xf_exit_p_acc , AKX_frootn_xf_exit_p_acc , AKX_livestemn_xf_exit_p_acc , & AKX_deadstemn_xf_exit_p_acc , AKX_livecrootn_xf_exit_p_acc , AKX_deadcrootn_xf_exit_p_acc , & - AKX_grainn_xf_exit_p_acc - + AKX_grainn_xf_exit_p_acc + USE MOD_BGC_Vars_1DPFTFluxes, only: & ! vegetation nitrogen flux variables (in) ! xfer to display @@ -88,24 +88,24 @@ MODULE MOD_BGC_CNNStateUpdate1 livestemn_xfer_to_livestemn_p , deadstemn_xfer_to_deadstemn_p , & livecrootn_xfer_to_livecrootn_p, deadcrootn_xfer_to_deadcrootn_p, & grainn_xfer_to_grainn_p , & - + ! storage to xfer (in) leafn_storage_to_xfer_p , frootn_storage_to_xfer_p , & livestemn_storage_to_xfer_p , deadstemn_storage_to_xfer_p , & livecrootn_storage_to_xfer_p, deadcrootn_storage_to_xfer_p, & grainn_storage_to_xfer_p , & - + ! display to litter & live to dead (in) leafn_to_litter_p , frootn_to_litter_p , & grainn_to_food_p , grainn_to_seed_p , & crop_seedn_to_leaf_p , livestemn_to_litter_p , & livestemn_to_deadstemn_p, livecrootn_to_deadcrootn_p, & - + ! display to retransn / retransn to npool (in) leafn_to_retransn_p , frootn_to_retransn_p , & livestemn_to_retransn_p , livecrootn_to_retransn_p , & retransn_to_npool_p , free_retransn_to_npool_p , & - + ! npool to display/storage (in) npool_to_leafn_p , npool_to_leafn_storage_p , & npool_to_frootn_p , npool_to_frootn_storage_p , & @@ -113,11 +113,11 @@ MODULE MOD_BGC_CNNStateUpdate1 npool_to_deadstemn_p , npool_to_deadstemn_storage_p , & npool_to_livecrootn_p, npool_to_livecrootn_storage_p, & npool_to_deadcrootn_p, npool_to_deadcrootn_storage_p, & - npool_to_grainn_p , npool_to_grainn_storage_p , plant_nalloc_p - + npool_to_grainn_p , npool_to_grainn_storage_p , plant_nalloc_p + USE MOD_Vars_PFTimeInvariants, only: pftfrac IMPLICIT NONE - + PUBLIC NStateUpdate1 CONTAINS @@ -129,7 +129,7 @@ SUBROUTINE NStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro integer ,intent(in) :: pe ! END pft index real(r8),intent(in) :: deltim ! time step in seconds integer ,intent(in) :: nl_soil ! number of total soil layers - integer ,intent(in) :: ndecomp_transitions ! number of total transitions among different litter & soil bgc pools + integer ,intent(in) :: ndecomp_transitions ! number of total transitions among different litter & soil bgc pools integer ,intent(in) :: npcropmin ! index of first crop pft real(r8),intent(in) :: dz_soi(1:nl_soil) ! thicknesses of each soil layer @@ -141,15 +141,15 @@ SUBROUTINE NStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro ! plant to litter fluxes - phenology and dynamic landcover fluxes DO j = 1, nl_soil decomp_npools_sourcesink(j,i_met_lit,i) = phenology_to_met_n(j,i) * deltim - + decomp_npools_sourcesink(j,i_cel_lit,i) = phenology_to_cel_n(j,i) * deltim - + decomp_npools_sourcesink(j,i_lig_lit,i) = phenology_to_lig_n(j,i) * deltim - + decomp_npools_sourcesink(j,i_cwd,i) = 0._r8 - + ENDDO - + IF(DEF_USE_SASU)THEN DO j=1,nl_soil I_met_n_vr_acc(j,i) = I_met_n_vr_acc(j,i) + phenology_to_met_n(j,i) * deltim @@ -157,7 +157,7 @@ SUBROUTINE NStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro I_lig_n_vr_acc(j,i) = I_lig_n_vr_acc(j,i) + phenology_to_lig_n(j,i) * deltim ENDDO ENDIF - + DO m = ps , pe ivt = pftclass(m) ! phenology: transfer growth fluxes @@ -165,7 +165,7 @@ SUBROUTINE NStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro leafn_xfer_p(m) = leafn_xfer_p(m) - leafn_xfer_to_leafn_p(m)*deltim frootn_p(m) = frootn_p(m) + frootn_xfer_to_frootn_p(m)*deltim frootn_xfer_p(m) = frootn_xfer_p(m) - frootn_xfer_to_frootn_p(m)*deltim - + IF (woody(ivt) == 1) THEN livestemn_p(m) = livestemn_p(m) + livestemn_xfer_to_livestemn_p(m)*deltim livestemn_xfer_p(m) = livestemn_xfer_p(m) - livestemn_xfer_to_livestemn_p(m)*deltim @@ -176,7 +176,7 @@ SUBROUTINE NStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro deadcrootn_p(m) = deadcrootn_p(m) + deadcrootn_xfer_to_deadcrootn_p(m)*deltim deadcrootn_xfer_p(m) = deadcrootn_xfer_p(m) - deadcrootn_xfer_to_deadcrootn_p(m)*deltim ENDIF - + IF (ivt >= npcropmin) THEN ! skip 2 generic crops ! lines here for consistency; the transfer terms are zero livestemn_p(m) = livestemn_p(m) + livestemn_xfer_to_livestemn_p(m)*deltim @@ -206,26 +206,26 @@ SUBROUTINE NStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro AKX_grainn_xf_exit_p_acc (m) = AKX_grainn_xf_exit_p_acc (m) + grainn_xfer_to_grainn_p (m) * deltim ENDIF ENDIF - + ! phenology: litterfall and retranslocation fluxes leafn_p(m) = leafn_p(m) - leafn_to_litter_p(m)*deltim frootn_p(m) = frootn_p(m) - frootn_to_litter_p(m)*deltim leafn_p(m) = leafn_p(m) - leafn_to_retransn_p(m)*deltim retransn_p(m) = retransn_p(m) + leafn_to_retransn_p(m)*deltim - + ! live wood turnover and retranslocation fluxes IF (woody(ivt) == 1) THEN livestemn_p(m) = livestemn_p(m) - livestemn_to_deadstemn_p(m)*deltim deadstemn_p(m) = deadstemn_p(m) + livestemn_to_deadstemn_p(m)*deltim livecrootn_p(m) = livecrootn_p(m) - livecrootn_to_deadcrootn_p(m)*deltim deadcrootn_p(m) = deadcrootn_p(m) + livecrootn_to_deadcrootn_p(m)*deltim - + livestemn_p(m) = livestemn_p(m) - livestemn_to_retransn_p(m)*deltim retransn_p(m) = retransn_p(m) + livestemn_to_retransn_p(m)*deltim livecrootn_p(m) = livecrootn_p(m) - livecrootn_to_retransn_p(m)*deltim retransn_p(m) = retransn_p(m) + livecrootn_to_retransn_p(m)*deltim - ENDIF - IF (ivt >= npcropmin) THEN + ENDIF + IF (ivt >= npcropmin) THEN frootn_p(m) = frootn_p(m) - frootn_to_retransn_p(m)*deltim retransn_p(m) = retransn_p(m) + frootn_to_retransn_p(m)*deltim livestemn_p(m) = livestemn_p(m) - livestemn_to_litter_p(m)*deltim @@ -247,7 +247,7 @@ SUBROUTINE NStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro AKX_livestemn_exit_p_acc (m) = AKX_livestemn_exit_p_acc (m) + livestemn_to_deadstemn_p (m) * deltim AKX_livecrootn_to_deadcrootn_p_acc(m) = AKX_livecrootn_to_deadcrootn_p_acc(m) + livecrootn_to_deadcrootn_p(m) * deltim AKX_livecrootn_exit_p_acc (m) = AKX_livecrootn_exit_p_acc (m) + livecrootn_to_deadcrootn_p(m) * deltim - + AKX_livestemn_to_retransn_p_acc (m) = AKX_livestemn_to_retransn_p_acc (m) + livestemn_to_retransn_p (m) * deltim AKX_livestemn_exit_p_acc (m) = AKX_livestemn_exit_p_acc (m) + livestemn_to_retransn_p (m) * deltim AKX_livecrootn_to_retransn_p_acc (m) = AKX_livecrootn_to_retransn_p_acc (m) + livecrootn_to_retransn_p (m) * deltim @@ -262,15 +262,15 @@ SUBROUTINE NStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro AKX_grainn_exit_p_acc (m) = AKX_grainn_exit_p_acc (m) + (grainn_to_food_p(m) + grainn_to_seed_p(m)) * deltim ENDIF ENDIF - + ! allocation fluxes retransn_p(m) = retransn_p(m) - retransn_to_npool_p(m)*deltim - retransn_p(m) = retransn_p(m) - free_retransn_to_npool_p(m)*deltim + retransn_p(m) = retransn_p(m) - free_retransn_to_npool_p(m)*deltim leafn_p(m) = leafn_p(m) + npool_to_leafn_p(m)*deltim leafn_storage_p(m) = leafn_storage_p(m) + npool_to_leafn_storage_p(m)*deltim frootn_p(m) = frootn_p(m) + npool_to_frootn_p(m)*deltim frootn_storage_p(m) = frootn_storage_p(m) + npool_to_frootn_storage_p(m)*deltim - + IF (woody(ivt) == 1) THEN livestemn_p(m) = livestemn_p(m) + npool_to_livestemn_p(m)*deltim livestemn_storage_p(m) = livestemn_storage_p(m) + npool_to_livestemn_storage_p(m)*deltim @@ -281,7 +281,7 @@ SUBROUTINE NStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro deadcrootn_p(m) = deadcrootn_p(m) + npool_to_deadcrootn_p(m)*deltim deadcrootn_storage_p(m) = deadcrootn_storage_p(m) + npool_to_deadcrootn_storage_p(m)*deltim ENDIF - + IF (ivt >= npcropmin) THEN ! skip 2 generic crops livestemn_p(m) = livestemn_p(m) + npool_to_livestemn_p(m)*deltim livestemn_storage_p(m) = livestemn_storage_p(m) + npool_to_livestemn_storage_p(m)*deltim @@ -360,7 +360,7 @@ SUBROUTINE NStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro leafn_xfer_p(m) = leafn_xfer_p(m) + leafn_storage_to_xfer_p(m)*deltim frootn_storage_p(m) = frootn_storage_p(m) - frootn_storage_to_xfer_p(m)*deltim frootn_xfer_p(m) = frootn_xfer_p(m) + frootn_storage_to_xfer_p(m)*deltim - + IF (woody(ivt) == 1) THEN livestemn_storage_p(m) = livestemn_storage_p(m) - livestemn_storage_to_xfer_p(m)*deltim livestemn_xfer_p(m) = livestemn_xfer_p(m) + livestemn_storage_to_xfer_p(m)*deltim @@ -371,7 +371,7 @@ SUBROUTINE NStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro deadcrootn_storage_p(m) = deadcrootn_storage_p(m) - deadcrootn_storage_to_xfer_p(m)*deltim deadcrootn_xfer_p(m) = deadcrootn_xfer_p(m) + deadcrootn_storage_to_xfer_p(m)*deltim ENDIF - + IF (ivt >= npcropmin) THEN ! skip 2 generic crops ! lines here for consistency; the transfer terms are zero livestemn_storage_p(m) = livestemn_storage_p(m) - livestemn_storage_to_xfer_p(m)*deltim @@ -379,7 +379,7 @@ SUBROUTINE NStateUpdate1 (i, ps, pe, deltim, nl_soil, ndecomp_transitions, npcro grainn_storage_p(m) = grainn_storage_p(m) - grainn_storage_to_xfer_p(m)*deltim grainn_xfer_p(m) = grainn_xfer_p(m) + grainn_storage_to_xfer_p(m)*deltim ENDIF - + IF(DEF_USE_SASU)THEN AKX_leafn_st_to_leafn_xf_p_acc (m) = AKX_leafn_st_to_leafn_xf_p_acc (m) + leafn_storage_to_xfer_p (m) * deltim AKX_leafn_st_exit_p_acc (m) = AKX_leafn_st_exit_p_acc (m) + leafn_storage_to_xfer_p (m) * deltim diff --git a/main/BGC/MOD_BGC_CNNStateUpdate2.F90 b/main/BGC/MOD_BGC_CNNStateUpdate2.F90 index eaba7433..f8876112 100644 --- a/main/BGC/MOD_BGC_CNNStateUpdate2.F90 +++ b/main/BGC/MOD_BGC_CNNStateUpdate2.F90 @@ -4,15 +4,15 @@ MODULE MOD_BGC_CNNStateUpdate2 !--------------------------------------------------------------------------------------------------------- ! !DESCRIPTION -! First updates in vegetation and soil nitrogen. Thre major updates are included in bgc_CNNStateUpdate1Mod +! First updates in vegetation and soil nitrogen. The major updates are included in bgc_CNNStateUpdate1Mod ! 1. Update gap-mortality-associated veg and soil N pool size changes -! 2. Record the accumulated N transfers associated to gap-mortality for semi-analytic spinup +! 2. Record the accumulated N transfers associated to gap-mortality for semi-analytic spinup ! !ORIGINAL: ! The Community Land Model version 5.0 (CLM5.0) ! REVISION: -! Xingjie Lu, 2022, 1) modify original CLM5 to be compatible with CoLM code structure. +! Xingjie Lu, 2022, 1) modify original CLM5 to be compatible with CoLM code structure. ! 2) Record the accumulated gap-mortality-associated N transfers for veg and soil N semi-analytic spinup USE MOD_Precision @@ -22,12 +22,12 @@ MODULE MOD_BGC_CNNStateUpdate2 USE MOD_BGC_Vars_TimeVariables, only: & ! decompositionn nitrogen pools & fluxes variables (inout) decomp_npools_vr, & - I_met_n_vr_acc , I_cel_n_vr_acc , I_lig_n_vr_acc , I_cwd_n_vr_acc - + I_met_n_vr_acc , I_cel_n_vr_acc , I_lig_n_vr_acc , I_cwd_n_vr_acc + USE MOD_BGC_Vars_1DFluxes, only: & gap_mortality_to_met_n, gap_mortality_to_cel_n , & - gap_mortality_to_lig_n, gap_mortality_to_cwdn - + gap_mortality_to_lig_n, gap_mortality_to_cwdn + USE MOD_BGC_Vars_PFTimeVariables, only: & ! vegetation nitrogen state variables (inout) leafn_p , leafn_storage_p , leafn_xfer_p , & @@ -37,7 +37,7 @@ MODULE MOD_BGC_CNNStateUpdate2 livecrootn_p , livecrootn_storage_p, livecrootn_xfer_p, & deadcrootn_p , deadcrootn_storage_p, deadcrootn_xfer_p, & retransn_p , npool_p, grainn_p, grainn_storage_p, grainn_xfer_p, cropseedn_deficit_p, & - + ! SASU variables AKX_leafn_exit_p_acc , AKX_leafn_st_exit_p_acc , AKX_leafn_xf_exit_p_acc , & AKX_frootn_exit_p_acc , AKX_frootn_st_exit_p_acc , AKX_frootn_xf_exit_p_acc , & @@ -46,7 +46,7 @@ MODULE MOD_BGC_CNNStateUpdate2 AKX_livecrootn_exit_p_acc, AKX_livecrootn_st_exit_p_acc, AKX_livecrootn_xf_exit_p_acc, & AKX_deadcrootn_exit_p_acc, AKX_deadcrootn_st_exit_p_acc, AKX_deadcrootn_xf_exit_p_acc, & AKX_retransn_exit_p_acc - + USE MOD_BGC_Vars_1DPFTFluxes, only: & ! vegetation nitrogen flux variables m_leafn_to_litter_p , m_leafn_storage_to_litter_p , m_leafn_xfer_to_litter_p , & @@ -56,10 +56,10 @@ MODULE MOD_BGC_CNNStateUpdate2 m_livecrootn_to_litter_p , m_livecrootn_storage_to_litter_p, m_livecrootn_xfer_to_litter_p, & m_deadcrootn_to_litter_p , m_deadcrootn_storage_to_litter_p, m_deadcrootn_xfer_to_litter_p, & m_retransn_to_litter_p - + USE MOD_Vars_PFTimeInvariants, only: pftfrac IMPLICIT NONE - + PUBLIC NStateUpdate2 CONTAINS @@ -112,7 +112,7 @@ SUBROUTINE NStateUpdate2(i, ps, pe, deltim, nl_soil, dz_soi) - m_deadcrootn_to_litter_p (m) * deltim retransn_p (m) = retransn_p (m) & - m_retransn_to_litter_p (m) * deltim - + ! storage pools leafn_storage_p (m) = leafn_storage_p (m) & - m_leafn_storage_to_litter_p (m) * deltim @@ -126,7 +126,7 @@ SUBROUTINE NStateUpdate2(i, ps, pe, deltim, nl_soil, dz_soi) - m_livecrootn_storage_to_litter_p(m) * deltim deadcrootn_storage_p(m) = deadcrootn_storage_p(m) & - m_deadcrootn_storage_to_litter_p(m) * deltim - + ! transfer pools leafn_xfer_p (m) = leafn_xfer_p (m) & - m_leafn_xfer_to_litter_p (m) * deltim diff --git a/main/BGC/MOD_BGC_CNNStateUpdate3.F90 b/main/BGC/MOD_BGC_CNNStateUpdate3.F90 index 18f6d873..df531571 100644 --- a/main/BGC/MOD_BGC_CNNStateUpdate3.F90 +++ b/main/BGC/MOD_BGC_CNNStateUpdate3.F90 @@ -5,7 +5,7 @@ MODULE MOD_BGC_CNNStateUpdate3 !------------------------------------------------------------------------------------------------------- ! !DESCRIPTION -! First updates in vegetation and soil nitrogen. Thre major updates are included in bgc_CNNStateUpdate1Mod +! First updates in vegetation and soil nitrogen. The major updates are included in bgc_CNNStateUpdate1Mod ! 1. Update fire-associated veg and soil(litter) N pool size changes ! 2. Record the accumulated N transfers associated to fire for semi-analytic spinup @@ -13,7 +13,7 @@ MODULE MOD_BGC_CNNStateUpdate3 ! The Community Land Model version 5.0 (CLM5.0) ! !REVISION: -! Xingjie Lu, 2022, 1) modify original CLM5 to be compatible with CoLM code structure. +! Xingjie Lu, 2022, 1) modify original CLM5 to be compatible with CoLM code structure. ! 2) Record accumulated fire-associated N transfers for veg and soil N semi-analytic spinup USE MOD_Precision @@ -23,15 +23,15 @@ MODULE MOD_BGC_CNNStateUpdate3 USE MOD_BGC_Vars_TimeVariables, only: & ! decomposition pools & fluxes variables (inout) decomp_npools_vr, sminn_vr, smin_no3_vr, smin_nh4_vr - + USE MOD_BGC_Vars_1DFluxes, only: & m_decomp_npools_to_fire_vr, & fire_mortality_to_met_n, fire_mortality_to_cel_n, & fire_mortality_to_lig_n, fire_mortality_to_cwdn , & - + ! mineral nitrogen pools & fluxes variables (inout) sminn_leached_vr, smin_no3_leached_vr, smin_no3_runoff_vr - + USE MOD_BGC_Vars_PFTimeVariables, only: & ! vegetation nitrogen state variables (inout) leafn_p , leafn_storage_p , leafn_xfer_p , & @@ -41,7 +41,7 @@ MODULE MOD_BGC_CNNStateUpdate3 livecrootn_p , livecrootn_storage_p, livecrootn_xfer_p, & deadcrootn_p , deadcrootn_storage_p, deadcrootn_xfer_p, & retransn_p - + USE MOD_BGC_Vars_1DPFTFluxes, only: & ! vegetation nitrogen flux variables m_leafn_to_fire_p , m_leafn_storage_to_fire_p , m_leafn_xfer_to_fire_p , & @@ -52,7 +52,7 @@ MODULE MOD_BGC_CNNStateUpdate3 m_deadcrootn_to_fire_p , m_deadcrootn_storage_to_fire_p, m_deadcrootn_xfer_to_fire_p, & m_livestemn_to_deadstemn_fire_p , m_livecrootn_to_deadcrootn_fire_p , & m_retransn_to_fire_p, & - + m_leafn_to_litter_fire_p , m_leafn_storage_to_litter_fire_p , m_leafn_xfer_to_litter_fire_p , & m_frootn_to_litter_fire_p , m_frootn_storage_to_litter_fire_p , m_frootn_xfer_to_litter_fire_p , & m_livestemn_to_litter_fire_p , m_livestemn_storage_to_litter_fire_p , m_livestemn_xfer_to_litter_fire_p , & @@ -60,10 +60,10 @@ MODULE MOD_BGC_CNNStateUpdate3 m_livecrootn_to_litter_fire_p , m_livecrootn_storage_to_litter_fire_p, m_livecrootn_xfer_to_litter_fire_p, & m_deadcrootn_to_litter_fire_p , m_deadcrootn_storage_to_litter_fire_p, m_deadcrootn_xfer_to_litter_fire_p, & m_retransn_to_litter_fire_p - - + + IMPLICIT NONE - + PUBLIC NStateUpdate3 CONTAINS @@ -92,18 +92,18 @@ SUBROUTINE NStateUpdate3(i, ps, pe, deltim, nl_soil, ndecomp_pools, dz_soi) ! mineral N loss due to leaching and runoff smin_no3_vr(j,i) = max( smin_no3_vr(j,i) & - ( smin_no3_leached_vr(j,i) + smin_no3_runoff_vr(j,i) ) * deltim, 0._r8) - + sminn_vr(j,i) = smin_no3_vr(j,i) + smin_nh4_vr(j,i) ENDDO ENDIF - + ! column level nitrogen fluxes from fire ! patch-level wood to column-level CWD (uncombusted wood) IF(DEF_USE_FIRE)THEN DO j = 1, nl_soil decomp_npools_vr(j,i_cwd,i) = decomp_npools_vr(j,i_cwd,i) & + fire_mortality_to_cwdn(j,i) * deltim - + ! patch-level wood to column-level litter (uncombusted wood) decomp_npools_vr(j,i_met_lit,i) = decomp_npools_vr(j,i_met_lit,i) & + fire_mortality_to_met_n(j,i)* deltim @@ -112,7 +112,7 @@ SUBROUTINE NStateUpdate3(i, ps, pe, deltim, nl_soil, ndecomp_pools, dz_soi) decomp_npools_vr(j,i_lig_lit,i) = decomp_npools_vr(j,i_lig_lit,i) & + fire_mortality_to_lig_n(j,i)* deltim ENDDO - + ! litter and CWD losses to fire DO l = 1, ndecomp_pools DO j = 1, nl_soil @@ -120,7 +120,7 @@ SUBROUTINE NStateUpdate3(i, ps, pe, deltim, nl_soil, ndecomp_pools, dz_soi) - m_decomp_npools_to_fire_vr(j,l,i) * deltim ENDDO ENDDO - + DO m = ps , pe !from fire displayed pools leafn_p (m) = leafn_p (m) & @@ -135,7 +135,7 @@ SUBROUTINE NStateUpdate3(i, ps, pe, deltim, nl_soil, ndecomp_pools, dz_soi) - m_livecrootn_to_fire_p (m) * deltim deadcrootn_p (m) = deadcrootn_p (m) & - m_deadcrootn_to_fire_p (m) * deltim - + leafn_p (m) = leafn_p (m) & - m_leafn_to_litter_fire_p (m) * deltim frootn_p (m) = frootn_p (m) & @@ -151,8 +151,8 @@ SUBROUTINE NStateUpdate3(i, ps, pe, deltim, nl_soil, ndecomp_pools, dz_soi) - m_livecrootn_to_deadcrootn_fire_p(m) * deltim deadcrootn_p (m) = deadcrootn_p (m) & - m_deadcrootn_to_litter_fire_p (m) * deltim & - + m_livecrootn_to_deadcrootn_fire_p(m) * deltim - + + m_livecrootn_to_deadcrootn_fire_p(m) * deltim + ! storage pools leafn_storage_p (m) = leafn_storage_p (m) & - m_leafn_storage_to_fire_p (m) * deltim @@ -166,7 +166,7 @@ SUBROUTINE NStateUpdate3(i, ps, pe, deltim, nl_soil, ndecomp_pools, dz_soi) - m_livecrootn_storage_to_fire_p (m) * deltim deadcrootn_storage_p(m) = deadcrootn_storage_p(m) & - m_deadcrootn_storage_to_fire_p (m) * deltim - + leafn_storage_p (m) = leafn_storage_p (m) & - m_leafn_storage_to_litter_fire_p (m) * deltim frootn_storage_p (m) = frootn_storage_p (m) & @@ -179,8 +179,8 @@ SUBROUTINE NStateUpdate3(i, ps, pe, deltim, nl_soil, ndecomp_pools, dz_soi) - m_livecrootn_storage_to_litter_fire_p(m) * deltim deadcrootn_storage_p(m) = deadcrootn_storage_p(m) & - m_deadcrootn_storage_to_litter_fire_p(m) * deltim - - + + ! transfer pools leafn_xfer_p (m) = leafn_xfer_p (m) & - m_leafn_xfer_to_fire_p (m) * deltim @@ -194,7 +194,7 @@ SUBROUTINE NStateUpdate3(i, ps, pe, deltim, nl_soil, ndecomp_pools, dz_soi) - m_livecrootn_xfer_to_fire_p (m) * deltim deadcrootn_xfer_p (m) = deadcrootn_xfer_p (m) & - m_deadcrootn_xfer_to_fire_p (m) * deltim - + leafn_xfer_p (m) = leafn_xfer_p (m) & - m_leafn_xfer_to_litter_fire_p (m) * deltim frootn_xfer_p (m) = frootn_xfer_p (m) & @@ -207,7 +207,7 @@ SUBROUTINE NStateUpdate3(i, ps, pe, deltim, nl_soil, ndecomp_pools, dz_soi) - m_livecrootn_xfer_to_litter_fire_p (m) * deltim deadcrootn_xfer_p (m) = deadcrootn_xfer_p (m) & - m_deadcrootn_xfer_to_litter_fire_p (m) * deltim - + ! retranslocated N pool retransn_p (m) = retransn_p (m) & - m_retransn_to_fire_p (m) * deltim diff --git a/main/BGC/MOD_BGC_Daylength.F90 b/main/BGC/MOD_BGC_Daylength.F90 index e3892c21..e37fcd38 100644 --- a/main/BGC/MOD_BGC_Daylength.F90 +++ b/main/BGC/MOD_BGC_Daylength.F90 @@ -4,8 +4,8 @@ MODULE MOD_BGC_Daylength !----------------------------------------------------------------------- ! !DESCRIPTION: -! Computes day length and solar decliation angle based on given latitude and date. -! +! Computes day length and solar declination angle based on given latitude and date. +! ! ! ORIGINAL: ! The Community Land Model version 5.0 (CLM5.0) @@ -16,7 +16,7 @@ MODULE MOD_BGC_Daylength IMPLICIT NONE SAVE PRIVATE - + PUBLIC :: daylength ! function to compute daylength PRIVATE :: declin_angle ! function to compute solar decliation angle ! @@ -54,37 +54,37 @@ real(r8) FUNCTION daylength(dlat, idate2) !----------------------------------------------------------------------- decl=declin_angle(idate2) - + ! lat must be less than pi/2 within a small tolerance IF (abs(dlat/180*PI) >= (pole + lat_epsilon)) THEN daylength = -9999 write(*,*)"error in latitude",dlat - + ! decl must be strictly less than pi/2 ELSE IF (abs(decl) >= pole) THEN daylength = -9999 write(*,*)"error in idate:",idate2 - + ! normal case - ELSE + ELSE ! Ensure that latitude isn't too close to pole, to avoid problems with cos(lat) being negative my_lat = min(offset_pole, max(-1._r8 * offset_pole, dlat/180*PI)) - + temp = -(sin(my_lat)*sin(decl))/(cos(my_lat) * cos(decl)) temp = min(1._r8,max(-1._r8,temp)) - daylength = 2.0_r8 * secs_per_radian * acos(temp) + daylength = 2.0_r8 * secs_per_radian * acos(temp) ENDIF END FUNCTION daylength real(r8) FUNCTION declin_angle(idate2) - + integer ,intent(in) :: idate2 ! day of the year real(r8),parameter :: PI = 4.*atan(1.) ! circular constant declin_angle=-23.44_r8/180._r8*PI*cos(2*PI/365*(idate2+10)) END FUNCTION declin_angle - + END MODULE MOD_BGC_Daylength #endif diff --git a/main/BGC/MOD_BGC_Soil_BiogeochemCompetition.F90 b/main/BGC/MOD_BGC_Soil_BiogeochemCompetition.F90 index 02a14155..294bd468 100644 --- a/main/BGC/MOD_BGC_Soil_BiogeochemCompetition.F90 +++ b/main/BGC/MOD_BGC_Soil_BiogeochemCompetition.F90 @@ -3,15 +3,15 @@ MODULE MOD_BGC_Soil_BiogeochemCompetition !--------------------------------------------------------------------------------------------------- -! !DESCRIPTION: -! Calculate the soil mineral nitrogen competition between soil microbial (immobalisation) and plant (N uptake). +! !DESCRIPTION: +! Calculate the soil mineral nitrogen competition between soil microbial (immobilisation) and plant (N uptake). ! Note that there is no non-linear microbial model in CoLM-BGC. ! ! !ORIGINAL: ! The Community Land Model version 5.0 (CLM5.0) ! ! !REVISION: -! Xingjie Lu, 2022, modify original CLM5 to be compatible with CoLM code structure. +! Xingjie Lu, 2022, modify original CLM5 to be compatible with CoLM code structure. USE MOD_Precision USE MOD_Namelist, only : DEF_USE_NITRIF @@ -25,9 +25,9 @@ MODULE MOD_BGC_Soil_BiogeochemCompetition USE MOD_BGC_Vars_TimeInvariants,only: & bdnr, compet_plant_no3, compet_plant_nh4, compet_decomp_no3, compet_decomp_nh4, compet_denit, compet_nit, & nitrif_n2o_loss_frac - + IMPLICIT NONE - + PUBLIC SoilBiogeochemCompetition CONTAINS @@ -66,16 +66,16 @@ SUBROUTINE SoilBiogeochemCompetition(i,deltim,nl_soil,dz_soi) !----------------------------------------------------------------------- sminn_to_plant_new = 0._r8 - + IF(.not. DEF_USE_NITRIF)THEN - + ! init sminn_tot sminn_tot = 0. - + DO j = 1, nl_soil sminn_tot = sminn_tot + sminn_vr(j,i) * dz_soi(j) ENDDO - + DO j = 1, nl_soil IF (sminn_tot > 0.) THEN nuptake_prof(j) = sminn_vr(j,i) / sminn_tot @@ -83,14 +83,14 @@ SUBROUTINE SoilBiogeochemCompetition(i,deltim,nl_soil,dz_soi) nuptake_prof(j) = nfixation_prof(j,i) ENDIF ENDDO - + DO j = 1, nl_soil sum_ndemand_vr(j) = plant_ndemand(i) * nuptake_prof(j) + potential_immob_vr(j,i) ENDDO - + DO j = 1, nl_soil IF (sum_ndemand_vr(j)*deltim < sminn_vr(j,i)) THEN - + ! N availability is not limiting immobilization or plant ! uptake, and both can proceed at their potential rates nlimit(j) = 0 @@ -101,35 +101,35 @@ SUBROUTINE SoilBiogeochemCompetition(i,deltim,nl_soil,dz_soi) ! N availability can not satisfy the sum of immobilization and ! plant growth demands, so these two demands compete for available ! soil mineral N resource. - + nlimit(j) = 1 IF (sum_ndemand_vr(j) > 0.0_r8) THEN actual_immob_vr(j,i) = (sminn_vr(j,i)/deltim)*(potential_immob_vr(j,i) / sum_ndemand_vr(j)) ELSE actual_immob_vr(j,i) = 0.0_r8 ENDIF - + IF (potential_immob_vr(j,i) > 0.0_r8) THEN fpi_vr(j,i) = actual_immob_vr(j,i) / potential_immob_vr(j,i) ELSE fpi_vr(j,i) = 0.0_r8 ENDIF - + sminn_to_plant_vr(j,i) = (sminn_vr(j,i)/deltim) - actual_immob_vr(j,i) ENDIF ENDDO - + ! sum up N fluxes to plant DO j = 1, nl_soil sminn_to_plant(i) = sminn_to_plant(i) + sminn_to_plant_vr(j,i) * dz_soi(j) ENDDO - + ! give plants a second pass to see IF there is any mineral N left over with which to satisfy residual N demand. residual_sminn = 0._r8 - + ! sum up total N left over after initial plant and immobilization fluxes residual_plant_ndemand = plant_ndemand(i) - sminn_to_plant(i) - + DO j = 1, nl_soil IF (residual_plant_ndemand > 0._r8 ) THEN IF (nlimit(j) .eq. 0) THEN @@ -140,7 +140,7 @@ SUBROUTINE SoilBiogeochemCompetition(i,deltim,nl_soil,dz_soi) ENDIF ENDIF ENDDO - + ! distribute residual N to plants DO j = 1, nl_soil IF ( residual_plant_ndemand > 0._r8 .and. residual_sminn > 0._r8 .and. nlimit(j) .eq. 0) THEN @@ -148,14 +148,14 @@ SUBROUTINE SoilBiogeochemCompetition(i,deltim,nl_soil,dz_soi) min(( residual_plant_ndemand * deltim ) / residual_sminn, 1._r8) / deltim ENDIF ENDDO - + ! re-sum up N fluxes to plant sminn_to_plant(i) = 0._r8 DO j = 1, nl_soil sminn_to_plant(i) = sminn_to_plant(i) + sminn_to_plant_vr(j,i) * dz_soi(j) sum_ndemand_vr(j) = potential_immob_vr(j,i) + sminn_to_plant_vr(j,i) ENDDO - + ! under conditions of excess N, some proportion is assumed to ! be lost to denitrification, in addition to the constant ! proportion lost in the decomposition pathways @@ -166,37 +166,37 @@ SUBROUTINE SoilBiogeochemCompetition(i,deltim,nl_soil,dz_soi) sminn_to_denit_excess_vr(j,i) = 0._r8 ENDIF ENDDO - + ! sum up N fluxes to immobilization DO j = 1, nl_soil actual_immob = actual_immob + actual_immob_vr(j,i) * dz_soi(j) potential_immob = potential_immob + potential_immob_vr(j,i) * dz_soi(j) ENDDO - + ! calculate the fraction of potential growth that can be - ! acheived with the N available to plants + ! achieved with the N available to plants IF (plant_ndemand(i) > 0.0_r8) THEN fpg(i) = sminn_to_plant(i) / plant_ndemand(i) ELSE fpg(i) = 1.0_r8 ENDIF - + ! calculate the fraction of immobilization realized (for diagnostic purposes) IF (potential_immob > 0.0_r8) THEN fpi(i) = actual_immob / potential_immob ELSE fpi(i) = 1.0_r8 ENDIF - + ELSE ! init total mineral N pools sminn_tot = 0. - + ! sum up total mineral N pools DO j = 1, nl_soil sminn_tot = sminn_tot + (smin_no3_vr(j,i) + smin_nh4_vr(j,i)) * dz_soi(j) ENDDO - + ! define N uptake profile for initial vertical distribution of plant N uptake, assuming plant seeks N from WHERE it is most abundant DO j = 1, nl_soil IF (sminn_tot > 0.) THEN @@ -205,165 +205,165 @@ SUBROUTINE SoilBiogeochemCompetition(i,deltim,nl_soil,dz_soi) nuptake_prof(j) = nfixation_prof(j,i) ENDIF ENDDO - + ! main column/vertical loop - DO j = 1, nl_soil + DO j = 1, nl_soil ! first compete for nh4 sum_nh4_demand(j) = plant_ndemand(i) * nuptake_prof(j) + potential_immob_vr(j,i) + pot_f_nit_vr(j,i) sum_nh4_demand_scaled(j) = plant_ndemand(i)* nuptake_prof(j) * compet_plant_nh4 + & potential_immob_vr(j,i)*compet_decomp_nh4 + pot_f_nit_vr(j,i)*compet_nit - + IF (sum_nh4_demand(j)*deltim < smin_nh4_vr(j,i)) THEN - + ! NH4 availability is not limiting immobilization or plant ! uptake, and all can proceed at their potential rates nlimit_nh4(j) = 0 fpi_nh4_vr(j) = 1.0_r8 actual_immob_nh4_vr(j,i) = potential_immob_vr(j,i) - !RF added new term. - + !RF added new term. + f_nit_vr(j,i) = pot_f_nit_vr(j,i) - + smin_nh4_to_plant_vr(j,i) = plant_ndemand(i) * nuptake_prof(j) - + ELSE - + ! NH4 availability can not satisfy the sum of immobilization, nitrification, and ! plant growth demands, so these three demands compete for available ! soil mineral NH4 resource. nlimit_nh4(j) = 1 IF (sum_nh4_demand(j) > 0.0_r8) THEN - ! RF microbes compete based on the hypothesised plant demand. + ! RF microbes compete based on the hypothesised plant demand. actual_immob_nh4_vr(j,i) = min((smin_nh4_vr(j,i)/deltim)*(potential_immob_vr(j,i)* & compet_decomp_nh4 / sum_nh4_demand_scaled(j)), potential_immob_vr(j,i)) - + f_nit_vr(j,i) = min((smin_nh4_vr(j,i)/deltim)*(pot_f_nit_vr(j,i)*compet_nit / & sum_nh4_demand_scaled(j)), pot_f_nit_vr(j,i)) - + smin_nh4_to_plant_vr(j,i) = min((smin_nh4_vr(j,i)/deltim)*(plant_ndemand(i)* & nuptake_prof(j)*compet_plant_nh4 / sum_nh4_demand_scaled(j)), plant_ndemand(i)*nuptake_prof(j)) - + ELSE actual_immob_nh4_vr(j,i) = 0.0_r8 smin_nh4_to_plant_vr(j,i) = 0.0_r8 f_nit_vr(j,i) = 0.0_r8 ENDIF - + IF (potential_immob_vr(j,i) > 0.0_r8) THEN fpi_nh4_vr(j) = actual_immob_nh4_vr(j,i) / potential_immob_vr(j,i) ELSE fpi_nh4_vr(j) = 0.0_r8 ENDIF - + ENDIF sum_no3_demand(j) = (plant_ndemand(i)*nuptake_prof(j)-smin_nh4_to_plant_vr(j,i)) & + (potential_immob_vr(j,i)-actual_immob_nh4_vr(j,i)) + pot_f_denit_vr(j,i) sum_no3_demand_scaled(j) = (plant_ndemand(i)*nuptake_prof(j) & - smin_nh4_to_plant_vr(j,i))*compet_plant_no3 & + (potential_immob_vr(j,i)-actual_immob_nh4_vr(j,i))*compet_decomp_no3 + pot_f_denit_vr(j,i)*compet_denit - + IF (sum_no3_demand(j)*deltim < smin_no3_vr(j,i)) THEN - + ! NO3 availability is not limiting immobilization or plant ! uptake, and all can proceed at their potential rates nlimit_no3(j) = 0 fpi_no3_vr(j) = 1.0_r8 - fpi_nh4_vr(j) actual_immob_no3_vr(j,i) = (potential_immob_vr(j,i)-actual_immob_nh4_vr(j,i)) - + f_denit_vr(j,i) = pot_f_denit_vr(j,i) - + smin_no3_to_plant_vr(j,i) = (plant_ndemand(i)*nuptake_prof(j)-smin_nh4_to_plant_vr(j,i)) - ELSE - + ELSE + ! NO3 availability can not satisfy the sum of immobilization, denitrification, and ! plant growth demands, so these three demands compete for available ! soil mineral NO3 resource. nlimit_no3(j) = 1 - + IF (sum_no3_demand(j) > 0.0_r8) THEN actual_immob_no3_vr(j,i) = min((smin_no3_vr(j,i)/deltim)*((potential_immob_vr(j,i) & - actual_immob_nh4_vr(j,i))*compet_decomp_no3 / sum_no3_demand_scaled(j)), & potential_immob_vr(j,i)-actual_immob_nh4_vr(j,i)) - + smin_no3_to_plant_vr(j,i) = min((smin_no3_vr(j,i)/deltim)*((plant_ndemand(i) & * nuptake_prof(j)-smin_nh4_to_plant_vr(j,i))*compet_plant_no3 / sum_no3_demand_scaled(j)), & plant_ndemand(i)*nuptake_prof(j)-smin_nh4_to_plant_vr(j,i)) - + f_denit_vr(j,i) = min((smin_no3_vr(j,i)/deltim)*(pot_f_denit_vr(j,i)*compet_denit / & sum_no3_demand_scaled(j)), pot_f_denit_vr(j,i)) - + ELSE ! no no3 demand. no uptake fluxes. actual_immob_no3_vr(j,i) = 0.0_r8 smin_no3_to_plant_vr(j,i) = 0.0_r8 f_denit_vr(j,i) = 0.0_r8 - + ENDIF !any no3 demand? - + IF (potential_immob_vr(j,i) > 0.0_r8) THEN fpi_no3_vr(j) = actual_immob_no3_vr(j,i) / potential_immob_vr(j,i) ELSE fpi_no3_vr(j) = 0.0_r8 ENDIF - + ENDIF - + ! n2o emissions: n2o from nitr is const fraction, n2o from denitr is calculated in nitrif_denitrif f_n2o_nit_vr(j,i) = f_nit_vr(j,i) * nitrif_n2o_loss_frac f_n2o_denit_vr(j,i) = f_denit_vr(j,i) / (1._r8 + n2_n2o_ratio_denit_vr(j,i)) - - + + ! this code block controls the addition of N to sminn pool ! to eliminate any N limitation, when Carbon_Only is set. This lets the ! model behave essentially as a carbon-only model, but with the ! benefit of keeping track of the N additions needed to ! eliminate N limitations, so there is still a diagnostic quantity ! that describes the degree of N limitation at steady-state. - + ! sum up no3 and nh4 fluxes fpi_vr(j,i) = fpi_no3_vr(j) + fpi_nh4_vr(j) sminn_to_plant_vr(j,i) = smin_no3_to_plant_vr(j,i) + smin_nh4_to_plant_vr(j,i) actual_immob_vr(j,i) = actual_immob_no3_vr(j,i) + actual_immob_nh4_vr(j,i) ENDDO - + ! sum up N fluxes to plant after initial competition sminn_to_plant(i) = 0._r8 - DO j = 1, nl_soil + DO j = 1, nl_soil sminn_to_plant(i) = sminn_to_plant(i) + sminn_to_plant_vr(j,i) * dz_soi(j) ENDDO ! give plants a second pass to see IF there is any mineral N left over with which to satisfy residual N demand. ! first take frm nh4 pool; THEN take from no3 pool residual_plant_ndemand = plant_ndemand(i) - sminn_to_plant(i) residual_smin_nh4 = 0._r8 - DO j = 1, nl_soil + DO j = 1, nl_soil IF (residual_plant_ndemand > 0._r8 ) THEN IF (nlimit_nh4(j) .eq. 0) THEN residual_smin_nh4_vr(j) = max(smin_nh4_vr(j,i) - (actual_immob_nh4_vr(j,i) + & smin_nh4_to_plant_vr(j,i) + f_nit_vr(j,i) ) * deltim, 0._r8) - + residual_smin_nh4 = residual_smin_nh4 + residual_smin_nh4_vr(j) * dz_soi(j) ELSE residual_smin_nh4_vr(j) = 0._r8 ENDIF - + IF ( residual_smin_nh4 > 0._r8 .and. nlimit_nh4(j) .eq. 0 ) THEN smin_nh4_to_plant_vr(j,i) = smin_nh4_to_plant_vr(j,i) + residual_smin_nh4_vr(j) * & min(( residual_plant_ndemand * deltim ) / residual_smin_nh4, 1._r8) / deltim ENDIF ENDIF ENDDO - + ! re-sum up N fluxes to plant after second pass for nh4 sminn_to_plant(i) = 0._r8 DO j = 1, nl_soil sminn_to_plant_vr(j,i) = smin_nh4_to_plant_vr(j,i) + smin_no3_to_plant_vr(j,i) sminn_to_plant(i) = sminn_to_plant(i) + (sminn_to_plant_vr(j,i)) * dz_soi(j) ENDDO - + ! ! and now DO second pass for no3 residual_plant_ndemand = plant_ndemand(i) - sminn_to_plant(i) residual_smin_no3 = 0._r8 - + DO j = 1, nl_soil IF (residual_plant_ndemand > 0._r8 ) THEN IF (nlimit_no3(j) .eq. 0) THEN @@ -373,39 +373,39 @@ SUBROUTINE SoilBiogeochemCompetition(i,deltim,nl_soil,dz_soi) ELSE residual_smin_no3_vr(j) = 0._r8 ENDIF - + IF ( residual_smin_no3 > 0._r8 .and. nlimit_no3(j) .eq. 0) THEN smin_no3_to_plant_vr(j,i) = smin_no3_to_plant_vr(j,i) + residual_smin_no3_vr(j) * & min(( residual_plant_ndemand * deltim ) / residual_smin_no3, 1._r8) / deltim ENDIF ENDIF ENDDO - + ! re-sum up N fluxes to plant after second passes of both no3 and nh4 sminn_to_plant(i) = 0._r8 DO j = 1, nl_soil sminn_to_plant_vr(j,i) = smin_nh4_to_plant_vr(j,i) + smin_no3_to_plant_vr(j,i) sminn_to_plant(i) = sminn_to_plant(i) + (sminn_to_plant_vr(j,i)) * dz_soi(j) ENDDO - + ! sum up N fluxes to immobilization actual_immob = 0._r8 potential_immob = 0._r8 - DO j = 1, nl_soil + DO j = 1, nl_soil actual_immob = actual_immob + actual_immob_vr(j,i) * dz_soi(j) potential_immob = potential_immob + potential_immob_vr(j,i) * dz_soi(j) ENDDO - + ! calculate the fraction of potential growth that can be - ! acheived with the N available to plants + ! achieved with the N available to plants ! calculate the fraction of immobilization realized (for diagnostic purposes) - + IF (plant_ndemand(i) > 0.0_r8) THEN fpg(i) = sminn_to_plant(i) / plant_ndemand(i) ELSE fpg(i) = 1._r8 ENDIF - + IF (potential_immob > 0.0_r8) THEN fpi(i) = actual_immob / potential_immob ELSE diff --git a/main/BGC/MOD_BGC_Soil_BiogeochemDecomp.F90 b/main/BGC/MOD_BGC_Soil_BiogeochemDecomp.F90 index 4387f12b..1f6438b5 100644 --- a/main/BGC/MOD_BGC_Soil_BiogeochemDecomp.F90 +++ b/main/BGC/MOD_BGC_Soil_BiogeochemDecomp.F90 @@ -4,10 +4,10 @@ MODULE MOD_BGC_Soil_BiogeochemDecomp !----------------------------------------------------------------------------------------------------------- ! !DESCRIPTION: -! This MODULE caluclates the CN transfer fluxes between different soil and litter pools, +! This MODULE calculates the CN transfer fluxes between different soil and litter pools, ! which includes CN transfer fluxes (decomp_ctransfer or decomp_ntransfer), heterotrophic respiration (decomp_hr), -! net mineralisation and gross mineralisation. Denitrification flux will be also calculated when nitrification model -! is activated. +! net mineralisation and gross mineralisation. Denitrification flux will be also calculated when nitrification model +! is activated. ! ! !ORIGINAL: ! The Community Land Model version 5.0 (CLM5.0) @@ -18,24 +18,24 @@ MODULE MOD_BGC_Soil_BiogeochemDecomp USE MOD_Precision USE MOD_Namelist, only : DEF_USE_NITRIF USE MOD_BGC_Vars_TimeInvariants, only: & - floating_cn_ratio, initial_cn_ratio, dnp, rf_decomp, receiver_pool, donor_pool, i_atm - + floating_cn_ratio, initial_cn_ratio, dnp, rf_decomp, receiver_pool, donor_pool, i_atm + USE MOD_BGC_Vars_TimeVariables, only: & ! decomposition carbon & nitrogen pools decomp_cpools_vr, decomp_npools_vr, & - + ! other variables cn_decomp_pools, fpi_vr - + USE MOD_BGC_Vars_1DFluxes, only: & ! decomposition fluxes variables decomp_sminn_flux_vr, decomp_hr_vr, decomp_ctransfer_vr, decomp_ntransfer_vr, & pmnf_decomp, p_decomp_cpool_loss, sminn_to_denit_decomp_vr, & net_nmin_vr, gross_nmin_vr, net_nmin, gross_nmin - - + + IMPLICIT NONE - + PUBLIC SoilBiogeochemDecomp CONTAINS @@ -63,16 +63,16 @@ SUBROUTINE SoilBiogeochemDecomp(i,nl_soil,ndecomp_pools,ndecomp_transitions, dz_ ENDDO ENDIF ENDDO - + ! column loop to calculate actual immobilization and decomp rates, following ! resolution of plant/heterotroph competition for mineral N - + ! upon RETURN from SoilBiogeochemCompetition, the fraction of potential immobilization ! has been set (soilbiogeochem_state_inst%fpi_vr_col). now finish the decomp calculations. ! only the immobilization steps are limited by fpi_vr (pmnf > 0) ! Also calculate denitrification losses as a simple proportion ! of mineralization flux. - + DO k = 1, ndecomp_transitions DO j = 1,nl_soil IF (decomp_cpools_vr(j,donor_pool(k),i) > 0._r8) THEN @@ -107,10 +107,10 @@ SUBROUTINE SoilBiogeochemDecomp(i,nl_soil,ndecomp_pools,ndecomp_transitions, dz_ ENDIF decomp_sminn_flux_vr(j,k,i) = 0._r8 ENDIF - + ENDDO ENDDO - + DO j = 1,nl_soil net_nmin(i) = net_nmin(i) + net_nmin_vr(j,i) * dz_soi(j) gross_nmin(i) = gross_nmin(i) + gross_nmin_vr(j,i) * dz_soi(j) diff --git a/main/BGC/MOD_BGC_Soil_BiogeochemDecompCascadeBGC.F90 b/main/BGC/MOD_BGC_Soil_BiogeochemDecompCascadeBGC.F90 index 590e88c2..bfef9dde 100644 --- a/main/BGC/MOD_BGC_Soil_BiogeochemDecompCascadeBGC.F90 +++ b/main/BGC/MOD_BGC_Soil_BiogeochemDecompCascadeBGC.F90 @@ -1,25 +1,25 @@ #include #ifdef BGC MODULE MOD_BGC_Soil_BiogeochemDecompCascadeBGC - + !--------------------------------------------------------------------------------------------------- ! !DESCRIPTION: ! Calculate the soil decomposition rate according to soil temperature, soil matric potential, and depth ! ! !REFERENCE: -! Koven, C.D., Riley, W.J., Subin, Z.M., Tang, J.Y., Torn, M.S., Collins, W.D., Bonan, G.B., Lawrence, -! D.M. and Swenson, S.C., 2013. The effect of vertically resolved soil biogeochemistry and alternate +! Koven, C.D., Riley, W.J., Subin, Z.M., Tang, J.Y., Torn, M.S., Collins, W.D., Bonan, G.B., Lawrence, +! D.M. and Swenson, S.C., 2013. The effect of vertically resolved soil biogeochemistry and alternate ! soil C and N models on C dynamics of CLM4. Biogeosciences, 10(11), 7109-7131. -! Thornton, P.E., Law, B.E., Gholz, H.L., Clark, K.L., Falge, E., Ellsworth, D.S., Goldstein, A.H., Monson, -! R.K., Hollinger, D., Falk, M. and Chen, J., 2002. Modeling and measuring the effects of disturbance -! history and climate on carbon and water budgets in evergreen needleleaf forests. +! Thornton, P.E., Law, B.E., Gholz, H.L., Clark, K.L., Falge, E., Ellsworth, D.S., Goldstein, A.H., Monson, +! R.K., Hollinger, D., Falk, M. and Chen, J., 2002. Modeling and measuring the effects of disturbance +! history and climate on carbon and water budgets in evergreen needleleaf forests. ! Agricultural and forest meteorology, 113(1-4), 185-222. ! ! !ORIGINAL: ! The Community Land Model version 5.0 (CLM5) ! ! !REVISION: -! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code sturcture. +! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code structure. USE MOD_Precision USE MOD_Vars_TimeInvariants, only: & @@ -28,9 +28,9 @@ MODULE MOD_BGC_Soil_BiogeochemDecompCascadeBGC USE MOD_Vars_TimeVariables, only: & smp, t_soisno, t_scalar, w_scalar, o_scalar, depth_scalar, decomp_k USE MOD_Vars_Global, only: PI - + IMPLICIT NONE - + PUBLIC decomp_rate_constants_bgc CONTAINS @@ -51,7 +51,7 @@ SUBROUTINE decomp_rate_constants_bgc(i,nl_soil,z_soi) real(r8) t1 catanf(t1) = 11.75_r8 +(29.7_r8 / PI) * atan( PI * 0.031_r8 * ( t1 - 15.4_r8 )) - + ! translate to per-second time constant k_l1 = 1._r8 / (86400._r8 * 365._r8 * tau_l1) k_l2_l3 = 1._r8 / (86400._r8 * 365._r8 * tau_l2_l3) @@ -59,10 +59,10 @@ SUBROUTINE decomp_rate_constants_bgc(i,nl_soil,z_soi) k_s2 = 1._r8 / (86400._r8 * 365._r8 * tau_s2) k_s3 = 1._r8 / (86400._r8 * 365._r8 * tau_s3) k_frag = 1._r8 / (86400._r8 * 365._r8 * tau_cwd) - + ! calc ref rate catanf_30 = catanf(30._r8) - + DO j = 1, nl_soil IF (t_soisno(j,i) >= 273.15_r8) THEN t_scalar(j,i)= (Q10**((t_soisno(j,i)-(273.15_r8+25._r8))/10._r8)) @@ -70,7 +70,7 @@ SUBROUTINE decomp_rate_constants_bgc(i,nl_soil,z_soi) t_scalar(j,i)= (Q10**(-25._r8/10._r8))*(froz_q10**((t_soisno(j,i)-273.15_r8)/10._r8)) ENDIF ENDDO - + ! calculate the rate constant scalar for soil water content. ! Uses the log relationship with water potential given in ! Andren, O., and K. Paustian, 1987. Barley straw decomposition in the field: @@ -78,7 +78,7 @@ SUBROUTINE decomp_rate_constants_bgc(i,nl_soil,z_soi) ! and supported by data in ! Orchard, V.A., and F.J. Cook, 1983. Relationship between soil respiration ! and soil moisture. Soil Biol. Biochem., 15(4):447-453. - + DO j = 1,nl_soil psi = min(smp(j,i),smpmax) ! decomp only IF soilpsi is higher than minpsi @@ -88,19 +88,19 @@ SUBROUTINE decomp_rate_constants_bgc(i,nl_soil,z_soi) w_scalar(j,i) = 0._r8 ENDIF ENDDO - + o_scalar(1:nl_soil,i) = 1._r8 - + ! scale all decomposition rates by a constant to compensate for offset between original CENTURY temp func and Q10 normalization_factor = (catanf(15._r8)/catanf_30) / (Q10**((15._r8-25._r8)/10._r8)) DO j = 1, nl_soil t_scalar(j,i) = t_scalar(j,i) * normalization_factor ENDDO - + DO j = 1, nl_soil depth_scalar(j,i) = exp(-z_soi(j)/decomp_depth_efolding) ENDDO - + DO j = 1, nl_soil decomp_k(j,i_met_lit,i) = k_l1 * t_scalar(j,i) * w_scalar(j,i) * depth_scalar(j,i) * o_scalar(j,i) !& decomp_k(j,i_cel_lit,i) = k_l2_l3 * t_scalar(j,i) * w_scalar(j,i) * depth_scalar(j,i) * o_scalar(j,i) !& @@ -109,7 +109,7 @@ SUBROUTINE decomp_rate_constants_bgc(i,nl_soil,z_soi) decomp_k(j,i_soil2 ,i) = k_s2 * t_scalar(j,i) * w_scalar(j,i) * depth_scalar(j,i) * o_scalar(j,i) !& decomp_k(j,i_soil3 ,i) = k_s3 * t_scalar(j,i) * w_scalar(j,i) * depth_scalar(j,i) * o_scalar(j,i) !& ENDDO - + DO j = 1,nl_soil decomp_k(j,i_cwd,i) = k_frag * t_scalar(j,i) * w_scalar(j,i) * depth_scalar(j,i) * & o_scalar(j,i) diff --git a/main/BGC/MOD_BGC_Soil_BiogeochemLittVertTransp.F90 b/main/BGC/MOD_BGC_Soil_BiogeochemLittVertTransp.F90 index 2e4d54a7..1491c460 100644 --- a/main/BGC/MOD_BGC_Soil_BiogeochemLittVertTransp.F90 +++ b/main/BGC/MOD_BGC_Soil_BiogeochemLittVertTransp.F90 @@ -4,7 +4,7 @@ MODULE MOD_BGC_Soil_BiogeochemLittVertTransp !---------------------------------------------------------------------------------------------------- ! !DESCRIPTION: -! Simulate the soil and litter CN veritical mixing (diffusion and advection) processes. Solve the dynamics +! Simulate the soil and litter CN vertical mixing (diffusion and advection) processes. Solve the dynamics ! of soil and litter vertical profile with a tridiagonal matrix. ! ! !REFERENCE: @@ -20,7 +20,7 @@ MODULE MOD_BGC_Soil_BiogeochemLittVertTransp ! The Community Land Model version 5.0 (CLM5) ! ! !REVISION: -! Xingjie Lu, 2021, 1) Revised the CLM5 code to be compatible with CoLM code sturcture. +! Xingjie Lu, 2021, 1) Revised the CLM5 code to be compatible with CoLM code structure. ! 2) Record accumulated organic CN vertical transfer rates for semi-analytic spin-up. USE MOD_Precision @@ -36,9 +36,9 @@ MODULE MOD_BGC_Soil_BiogeochemLittVertTransp decomp_cpools_sourcesink, decomp_npools_sourcesink, & decomp_cpools_transport_tendency, decomp_npools_transport_tendency USE MOD_Utils, only: tridia - + IMPLICIT NONE - + PUBLIC SoilBiogeochemLittVertTransp CONTAINS @@ -83,10 +83,10 @@ SUBROUTINE SoilBiogeochemLittVertTransp(i,deltim,nl_soil,nl_soil_full,ndecomp_po real(r8) :: epsilon ! small number aaa (pe) = max (0._r8, (1._r8 - 0.1_r8 * abs(pe))**5) ! A function from Patankar, Table 5.2, pg 95 - + epsilon = 1.e-30 spinup_term = 1._r8 - + IF (( max(altmax(i), altmax_lastyear(i)) <= max_altdepth_cryoturbation ) .and. & ( max(altmax(i), altmax_lastyear(i)) > 0._r8) ) THEN ! use mixing profile modified slightly from Koven et al. (2009): constant through active layer, linear decrease from base of active layer to zero at a fixed depth @@ -124,13 +124,13 @@ SUBROUTINE SoilBiogeochemLittVertTransp(i,deltim,nl_soil,nl_soil_full,ndecomp_po som_diffus_coef(j,i) = 0._r8 ENDDO ENDIF - + ! Set the distance between the node and the one ABOVE it dz_node(1) = z_soi(1) DO j = 2, nl_soil+1 dz_node(j)= z_soi(j) - z_soi(j-1) ENDDO - + DO s = 1, ndecomp_pools IF ( .not. is_cwd(s) ) THEN DO j = 1,nl_soil+1 @@ -147,20 +147,20 @@ SUBROUTINE SoilBiogeochemLittVertTransp(i,deltim,nl_soil,nl_soil_full,ndecomp_po ENDIF ! ENDDO - + ! Set Pe (Peclet #) and D/dz throughout column conc_trcr_c(0) = 0._r8 conc_trcr_n(0) = 0._r8 conc_trcr_c(nbedrock+1:nl_soil+1) = 0._r8 conc_trcr_n(nbedrock+1:nl_soil+1) = 0._r8 - + DO j = 1,nl_soil+1 conc_trcr_c(j) = decomp_cpools_vr(j,s,i) conc_trcr_n(j) = decomp_npools_vr(j,s,i) - + ! dz_tracer below is the difference between gridcell edges (dz_soi) ! dz_node_tracer is difference between cell centers - + ! Calculate the D and F terms in the Patankar algorithm IF (j == 1) THEN d_m1_zm1(j) = 0._r8 @@ -211,14 +211,14 @@ SUBROUTINE SoilBiogeochemLittVertTransp(i,deltim,nl_soil,nl_soil_full,ndecomp_po pe_p1(j) = f_p1(j) / d_p1_zp1(j) ! Peclet # ENDIF ENDDO ! j; nl_soil - + ! Calculate the tridiagonal coefficients DO j = 0,nl_soil +1 - + IF (j > 0 .and. j < nl_soil+1) THEN a_p_0 = dz_soi(j) / deltim ENDIF - + IF (j == 0) THEN ! top layer (atmosphere) a_tri(j) = 0._r8 b_tri(j) = 1._r8 @@ -238,13 +238,13 @@ SUBROUTINE SoilBiogeochemLittVertTransp(i,deltim,nl_soil,nl_soil_full,ndecomp_po diagVX_n_vr_acc (j,s,i) = diagVX_n_vr_acc (j,s,i) + (b_tri(j) - a_p_0) / dz_soi(j) * deltim * conc_trcr_n(j)! EXIT flux ENDIF ELSEIF (j < nl_soil+1) THEN - + a_tri(j) = -(d_m1_zm1(j) * aaa(pe_m1(j)) + max( f_m1(j), 0._r8)) ! Eqn 5.47 Patankar c_tri(j) = -(d_p1_zp1(j) * aaa(pe_p1(j)) + max(-f_p1(j), 0._r8)) b_tri(j) = - a_tri(j) - c_tri(j) + a_p_0 r_tri_c(j) = decomp_cpools_sourcesink(j,s,i) * dz_soi(j) /deltim + a_p_0 * conc_trcr_c(j) r_tri_n(j) = decomp_npools_sourcesink(j,s,i) * dz_soi(j) /deltim + a_p_0 * conc_trcr_n(j) - + IF(DEF_USE_SASU .or. DEF_USE_DiagMatrix)THEN IF(j .le. nbedrock)THEN lowerVX_c_vr_acc(j,s,i) = lowerVX_c_vr_acc(j,s,i) - a_tri(j) / dz_soi(j) * deltim * conc_trcr_c(j-1) @@ -270,18 +270,18 @@ SUBROUTINE SoilBiogeochemLittVertTransp(i,deltim,nl_soil,nl_soil_full,ndecomp_po r_tri_n(j) = 0._r8 ENDIF ENDDO ! j; nl_soil - + jtop = 0 - + ! subtract initial concentration and source terms for tendency calculation DO j = 1, nl_soil decomp_cpools_transport_tendency(j,s,i) = 0.-(conc_trcr_c(j) + decomp_cpools_sourcesink(j,s,i)) decomp_npools_transport_tendency(j,s,i) = 0.-(conc_trcr_n(j) + decomp_npools_sourcesink(j,s,i)) ENDDO - + CALL tridia(nl_soil+2, a_tri (:), b_tri(:), c_tri(:), r_tri_c(:), conc_trcr_c(0:nl_soil+1)) CALL tridia(nl_soil+2, a_tri (:), b_tri(:), c_tri(:), r_tri_n(:), conc_trcr_n(0:nl_soil+1)) - + ! add post-transport concentration to calculate tendency term DO j = 1, nl_soil decomp_cpools_transport_tendency(j,s,i) = decomp_cpools_transport_tendency(j,s,i) + conc_trcr_c(j) @@ -308,7 +308,7 @@ SUBROUTINE SoilBiogeochemLittVertTransp(i,deltim,nl_soil,nl_soil_full,ndecomp_po ENDIF ENDDO ENDIF ! not CWD - + DO j = 1,nl_soil decomp_cpools_vr(j,s,i) = conc_trcr_c(j) decomp_npools_vr(j,s,i) = conc_trcr_n(j) diff --git a/main/BGC/MOD_BGC_Soil_BiogeochemNStateUpdate1.F90 b/main/BGC/MOD_BGC_Soil_BiogeochemNStateUpdate1.F90 index b51edef2..5161f5e0 100644 --- a/main/BGC/MOD_BGC_Soil_BiogeochemNStateUpdate1.F90 +++ b/main/BGC/MOD_BGC_Soil_BiogeochemNStateUpdate1.F90 @@ -5,17 +5,17 @@ MODULE MOD_BGC_Soil_BiogeochemNStateUpdate1 !--------------------------------------------------------------------------------------------- ! !DESCRIPTION: -! Updates soil mineral nitrogen pool sizes. The dynamics of soil mineral nitrogen pool is +! Updates soil mineral nitrogen pool sizes. The dynamics of soil mineral nitrogen pool is ! simulated according to fertilisation, nitrogen deposition, biological fixation, plant uptake, -! mineralisation and immobalisation in this module. IF nitrification is activated, nitrate nitrogen -! has a separated pool against ammonium nitrogen pool. Accumulated nitrogen transfer +! mineralisation and immobilisation in this module. IF nitrification is activated, nitrate nitrogen +! has a separated pool against ammonium nitrogen pool. Accumulated nitrogen transfer ! network is also recorded for semi-analytic spinup. ! ! !ORIGINAL: ! The Community Land Model version 5.0 (CLM5.0) ! ! !REVISION: -! Xingjie Lu, 2022, 1) modify original CLM5 to be compatible with CoLM code structure. +! Xingjie Lu, 2022, 1) modify original CLM5 to be compatible with CoLM code structure. ! 2) Record accumulated nitrogen transfer network for semi-analytic spinup USE MOD_Precision @@ -25,7 +25,7 @@ MODULE MOD_BGC_Soil_BiogeochemNStateUpdate1 i_met_lit, i_cel_lit, i_lig_lit, i_cwd, i_soil1, i_soil2, i_soil3 USE MOD_BGC_Vars_TimeInvariants, only: & receiver_pool, donor_pool, nitrif_n2o_loss_frac - + USE MOD_BGC_Vars_TimeVariables, only: & ! Mineral nitrogen pools (inout) sminn_vr , smin_nh4_vr , smin_no3_vr , & @@ -34,8 +34,8 @@ MODULE MOD_BGC_Soil_BiogeochemNStateUpdate1 AKX_cwd_to_cel_n_vr_acc , AKX_cwd_to_lig_n_vr_acc , AKX_soil1_to_soil3_n_vr_acc, AKX_soil2_to_soil1_n_vr_acc, & AKX_soil2_to_soil3_n_vr_acc, AKX_soil3_to_soil1_n_vr_acc, & AKX_met_exit_n_vr_acc , AKX_cel_exit_n_vr_acc , AKX_lig_exit_n_vr_acc , AKX_cwd_exit_n_vr_acc , & - AKX_soil1_exit_n_vr_acc , AKX_soil2_exit_n_vr_acc , AKX_soil3_exit_n_vr_acc - + AKX_soil1_exit_n_vr_acc , AKX_soil2_exit_n_vr_acc , AKX_soil3_exit_n_vr_acc + USE MOD_BGC_Vars_1DFluxes, only: & ! Decomposition fluxes variables (inout) decomp_npools_sourcesink, decomp_ntransfer_vr , decomp_sminn_flux_vr , sminn_to_denit_decomp_vr, & @@ -45,9 +45,9 @@ MODULE MOD_BGC_Soil_BiogeochemNStateUpdate1 sminn_to_denit_excess_vr, f_nit_vr , f_denit_vr , soyfixn_to_sminn, & ndep_to_sminn , ffix_to_sminn , nfix_to_sminn , fert_to_sminn USE MOD_SPMD_Task - + IMPLICIT NONE - + PUBLIC SoilBiogeochemNStateUpdate1 CONTAINS @@ -115,8 +115,8 @@ SUBROUTINE SoilBiogeochemNStateUpdate1(i,deltim,nl_soil,ndecomp_transitions,dz_s decomp_ntransfer_vr(j,k,i) * deltim ENDDO ENDDO - - + + DO k = 1, ndecomp_transitions IF ( receiver_pool(k) /= 0 ) THEN ! skip terminal transitions DO j = 1, nl_soil @@ -133,7 +133,7 @@ SUBROUTINE SoilBiogeochemNStateUpdate1(i,deltim,nl_soil,ndecomp_transitions,dz_s ENDDO ENDIF ENDDO - + IF(DEF_USE_SASU .or. DEF_USE_DiagMatrix)THEN DO j = 1, nl_soil AKX_met_to_soil1_n_vr_acc (j,i) = AKX_met_to_soil1_n_vr_acc (j,i) + (decomp_ntransfer_vr(j, 1,i) + decomp_sminn_flux_vr(j, 1,i)) * deltim @@ -146,7 +146,7 @@ SUBROUTINE SoilBiogeochemNStateUpdate1(i,deltim,nl_soil,ndecomp_transitions,dz_s AKX_soil2_to_soil1_n_vr_acc(j,i) = AKX_soil2_to_soil1_n_vr_acc(j,i) + (decomp_ntransfer_vr(j, 8,i) + decomp_sminn_flux_vr(j, 8,i)) * deltim AKX_soil2_to_soil3_n_vr_acc(j,i) = AKX_soil2_to_soil3_n_vr_acc(j,i) + (decomp_ntransfer_vr(j, 9,i) + decomp_sminn_flux_vr(j, 9,i)) * deltim AKX_soil3_to_soil1_n_vr_acc(j,i) = AKX_soil3_to_soil1_n_vr_acc(j,i) + (decomp_ntransfer_vr(j,10,i) + decomp_sminn_flux_vr(j,10,i)) * deltim - + AKX_met_exit_n_vr_acc (j,i) = AKX_met_exit_n_vr_acc (j,i) + decomp_ntransfer_vr(j, 1,i) * deltim AKX_cel_exit_n_vr_acc (j,i) = AKX_cel_exit_n_vr_acc (j,i) + decomp_ntransfer_vr(j, 2,i) * deltim AKX_lig_exit_n_vr_acc (j,i) = AKX_lig_exit_n_vr_acc (j,i) + decomp_ntransfer_vr(j, 3,i) * deltim @@ -159,13 +159,13 @@ SUBROUTINE SoilBiogeochemNStateUpdate1(i,deltim,nl_soil,ndecomp_transitions,dz_s AKX_soil3_exit_n_vr_acc (j,i) = AKX_soil3_exit_n_vr_acc (j,i) + decomp_ntransfer_vr(j,10,i) * deltim ENDDO ENDIF - + IF(.not. DEF_USE_NITRIF)THEN - + !-------------------------------------------------------- !------------- NITRIF_DENITRIF OFF ------------------- !-------------------------------------------------------- - + ! immobilization/mineralization in litter-to-SOM and SOM-to-SOM fluxes and denitrification fluxes DO k = 1, ndecomp_transitions IF ( receiver_pool(k) /= 0 ) THEN ! skip terminal transitions @@ -178,64 +178,64 @@ SUBROUTINE SoilBiogeochemNStateUpdate1(i,deltim,nl_soil,ndecomp_transitions,dz_s DO j = 1, nl_soil sminn_vr(j,i) = sminn_vr(j,i) - & sminn_to_denit_decomp_vr(j,k,i)* deltim - + sminn_vr(j,i) = sminn_vr(j,i) + & decomp_sminn_flux_vr(j,k,i)* deltim - + ENDDO ENDIF ENDDO - - + + DO j = 1, nl_soil ! "bulk denitrification" sminn_vr(j,i) = sminn_vr(j,i) - sminn_to_denit_excess_vr(j,i) * deltim - + ! total plant uptake from mineral N sminn_vr(j,i) = sminn_vr(j,i) - sminn_to_plant_vr(j,i)*deltim ! flux that prevents N limitation (when Carbon_only is set) sminn_vr(j,i) = sminn_vr(j,i) + supplement_to_sminn_vr(j,i)*deltim ENDDO - + ELSE - + !-------------------------------------------------------- !------------- NITRIF_DENITRIF ON -------------------- !-------------------------------------------------------- - + DO j = 1, nl_soil - + ! mineralization fluxes (divert a fraction of this stream to nitrification flux, add the rest to NH4 pool) smin_nh4_vr(j,i) = smin_nh4_vr(j,i) + gross_nmin_vr(j,i)*deltim - + ! immobilization fluxes smin_nh4_vr(j,i) = smin_nh4_vr(j,i) - actual_immob_nh4_vr(j,i)*deltim - + smin_no3_vr(j,i) = smin_no3_vr(j,i) - actual_immob_no3_vr(j,i)*deltim - + ! plant uptake fluxes smin_nh4_vr(j,i) = smin_nh4_vr(j,i) - smin_nh4_to_plant_vr(j,i)*deltim - + smin_no3_vr(j,i) = smin_no3_vr(j,i) - smin_no3_to_plant_vr(j,i)*deltim - - + + ! Account for nitrification fluxes smin_nh4_vr(j,i) = smin_nh4_vr(j,i) - f_nit_vr(j,i) * deltim - + smin_no3_vr(j,i) = smin_no3_vr(j,i) + f_nit_vr(j,i) * deltim & * (1._r8 - nitrif_n2o_loss_frac) - + ! Account for denitrification fluxes smin_no3_vr(j,i) = smin_no3_vr(j,i) - f_denit_vr(j,i) * deltim - + ! flux that prevents N limitation (when Carbon_only is set; put all into NH4) smin_nh4_vr(j,i) = smin_nh4_vr(j,i) + supplement_to_sminn_vr(j,i)*deltim - + ! update diagnostic total sminn_vr(j,i) = smin_nh4_vr(j,i) + smin_no3_vr(j,i) - + ENDDO - + ENDIF END SUBROUTINE SoilBiogeochemNStateUpdate1 diff --git a/main/BGC/MOD_BGC_Soil_BiogeochemPotential.F90 b/main/BGC/MOD_BGC_Soil_BiogeochemPotential.F90 index c2a93f16..9865e363 100644 --- a/main/BGC/MOD_BGC_Soil_BiogeochemPotential.F90 +++ b/main/BGC/MOD_BGC_Soil_BiogeochemPotential.F90 @@ -4,17 +4,17 @@ MODULE MOD_BGC_Soil_BiogeochemPotential !--------------------------------------------------------------------------------------------------------------------------------- ! !DESCRIPTION: -! This module calculates the potential C exit flux and the potential N immoblisation and mineralisation flux. The potential C exit flux -! (p_decomp_cpool_loss) equals the product of donor C pool size (decomp_cpools_vr) and transfer pathway fraction (pathfrac_decomp). -! The potential N immoblisation and mineralisation flux (pmnf_decomp) equals: +! This module calculates the potential C exit flux and the potential N immobilisation and mineralisation flux. The potential C exit flux +! (p_decomp_cpool_loss) equals the product of donor C pool size (decomp_cpools_vr) and transfer pathway fraction (pathfrac_decomp). +! The potential N immobilisation and mineralisation flux (pmnf_decomp) equals: ! the receiver's N demand to immobalize new carbon (p_decomp_cpool_loss * (1 - rf_decomp)/cn_decomp_pools(receiver)) minus actual N ! transfer (p_decomp_cpool_loss * cn_decomp_pools(donor)) ! p_decomp_cpool_loss and pmnf_decomp are THEN used in bgc_soil_SoilBiogeochemDecompMod.F90 ! ! !REFERENCE: -! Thornton, P.E., Law, B.E., Gholz, H.L., Clark, K.L., Falge, E., Ellsworth, D.S., Goldstein, A.H., Monson, -! R.K., Hollinger, D., Falk, M. and Chen, J., 2002. Modeling and measuring the effects of disturbance -! history and climate on carbon and water budgets in evergreen needleleaf forests. +! Thornton, P.E., Law, B.E., Gholz, H.L., Clark, K.L., Falge, E., Ellsworth, D.S., Goldstein, A.H., Monson, +! R.K., Hollinger, D., Falk, M. and Chen, J., 2002. Modeling and measuring the effects of disturbance +! history and climate on carbon and water budgets in evergreen needleleaf forests. ! Agricultural and forest meteorology, 113(1-4), 185-222. ! ! !ORIGINAL: @@ -26,24 +26,24 @@ MODULE MOD_BGC_Soil_BiogeochemPotential USE MOD_Precision USE MOD_BGC_Vars_TimeInvariants, only: & floating_cn_ratio, initial_cn_ratio, rf_decomp, receiver_pool, donor_pool, i_atm, pathfrac_decomp - + USE MOD_BGC_Vars_TimeVariables, only: & ! decomposition carbon & nitrogen pools decomp_cpools_vr, decomp_npools_vr, decomp_k, & - + ! other variables cn_decomp_pools - + USE MOD_BGC_Vars_1DFluxes, only: & ! decomposition fluxes variables pmnf_decomp, p_decomp_cpool_loss, gross_nmin_vr, & - + ! mineral N fluxes potential_immob_vr, phr_vr - - + + IMPLICIT NONE - + PUBLIC SoilBiogeochemPotential CONTAINS @@ -61,9 +61,9 @@ SUBROUTINE SoilBiogeochemPotential(i,nl_soil,ndecomp_pools,ndecomp_transitions) p_decomp_cpool_loss(:, :, i) = 0._r8 pmnf_decomp(:, :, i) = 0._r8 - + ! column loop to calculate potential decomp rates and total immobilization demand - + !! calculate c:n ratios of applicable pools DO l = 1, ndecomp_pools IF ( floating_cn_ratio(l) ) THEN @@ -78,43 +78,43 @@ SUBROUTINE SoilBiogeochemPotential(i,nl_soil,ndecomp_pools,ndecomp_transitions) ENDDO ENDIF ENDDO - + ! calculate the non-nitrogen-limited fluxes ! these fluxes include the "/ dt" term to put them on a ! per second basis, since the rate constants have been ! calculated on a per timestep basis. - + DO k = 1, ndecomp_transitions DO j = 1,nl_soil - + IF (decomp_cpools_vr(j,donor_pool(k),i) > 0._r8 .and. & decomp_k(j,donor_pool(k),i) > 0._r8 ) THEN p_decomp_cpool_loss(j,k,i) = decomp_cpools_vr(j,donor_pool(k),i) & * decomp_k(j,donor_pool(k),i) * pathfrac_decomp(j,k,i) IF ( .not. floating_cn_ratio(receiver_pool(k)) ) THEN !! not transition of cwd to litter - + IF (receiver_pool(k) /= i_atm ) THEN ! not 100% respiration ratio = 0._r8 - + IF (decomp_npools_vr(j,donor_pool(k),i) > 0._r8) THEN ratio = cn_decomp_pools(j,receiver_pool(k),i)/cn_decomp_pools(j,donor_pool(k),i) ENDIF - + pmnf_decomp(j,k,i) = (p_decomp_cpool_loss(j,k,i) * (1.0_r8 - rf_decomp(j,k,i) - ratio) & / cn_decomp_pools(j,receiver_pool(k),i) ) - + ELSE ! 100% respiration pmnf_decomp(j,k,i) = - p_decomp_cpool_loss(j,k,i) / cn_decomp_pools(j,donor_pool(k),i) ENDIF - + ELSE ! CWD -> litter pmnf_decomp(j,k,i) = 0._r8 ENDIF ENDIF - + ENDDO ENDDO - + ! Sum up all the potential immobilization fluxes (positive pmnf flux) ! and all the mineralization fluxes (negative pmnf flux) DO j = 1,nl_soil @@ -129,11 +129,11 @@ SUBROUTINE SoilBiogeochemPotential(i,nl_soil,ndecomp_pools,ndecomp_transitions) ENDIF ENDDO ENDDO - + DO j = 1,nl_soil potential_immob_vr(j,i) = immob(j) ENDDO - + ! Add up potential hr for methane calculations DO j = 1,nl_soil phr_vr(j,i) = 0._r8 diff --git a/main/BGC/MOD_BGC_Soil_BiogeochemVerticalProfile.F90 b/main/BGC/MOD_BGC_Soil_BiogeochemVerticalProfile.F90 index 86ae4342..b99f9dcf 100644 --- a/main/BGC/MOD_BGC_Soil_BiogeochemVerticalProfile.F90 +++ b/main/BGC/MOD_BGC_Soil_BiogeochemVerticalProfile.F90 @@ -5,14 +5,14 @@ MODULE MOD_BGC_Soil_BiogeochemVerticalProfile !------------------------------------------------------------------------------------ ! !DESCRIPTION: ! This MODULE calculate soil vertical profile of different C and N inputs, including: -! nitrogen fixation, nitrogen deposition, fine root litter, coarse root litter, +! nitrogen fixation, nitrogen deposition, fine root litter, coarse root litter, ! leaf litter and stem litter. ! ! !ORIGINAL: ! The Community Land Model version 5.0 (CLM5) ! ! !REVISION: -! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code sturcture. +! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code structure. USE MOD_Precision @@ -24,9 +24,9 @@ MODULE MOD_BGC_Soil_BiogeochemVerticalProfile USE MOD_Vars_PFTimeInvariants, only: & pftclass, pftfrac IMPLICIT NONE - + PUBLIC SoilBiogeochemVerticalProfile - + real(r8), PUBLIC :: surfprof_exp = 10. ! how steep profile is for surface components (1/ e_folding depth) (1/m) CONTAINS @@ -49,7 +49,7 @@ SUBROUTINE SoilBiogeochemVerticalProfile(i,ps,pe,nl_soil,nl_soil_full,nbedrock,z real(r8) :: rootfr_tot real(r8) :: col_cinput_rootfr(1:nl_soil_full) integer :: ivt, m - integer :: j + integer :: j ! debugging temp variables real(r8) :: froot_prof_sum real(r8) :: croot_prof_sum @@ -66,7 +66,7 @@ SUBROUTINE SoilBiogeochemVerticalProfile(i,ps,pe,nl_soil,nl_soil_full,nbedrock,z surface_prof(j) = 0._r8 ENDIF ENDDO - + ! initialize profiles to zero col_cinput_rootfr(:) = 0._r8 nfixation_prof (:,i) = 0._r8 @@ -77,19 +77,19 @@ SUBROUTINE SoilBiogeochemVerticalProfile(i,ps,pe,nl_soil,nl_soil_full,nbedrock,z froot_prof_p(:,m) = 0._r8 croot_prof_p(:,m) = 0._r8 stem_prof_p (:,m) = 0._r8 - + cinput_rootfr_p(:,m) = 0._r8 - + IF (ivt /= 0) THEN DO j = 1, nl_soil cinput_rootfr_p(j,m) = rootfr_p(j,ivt) / dz_soi(j) ENDDO - + ELSE cinput_rootfr_p(1,m) = 0. ENDIF ENDDO - + DO m = ps , pe ! integrate rootfr over active layer of soil column rootfr_tot = 0._r8 @@ -104,7 +104,7 @@ SUBROUTINE SoilBiogeochemVerticalProfile(i,ps,pe,nl_soil,nl_soil_full,nbedrock,z DO j = 1, min(max(altmax_lastyear_indx(i), 1), nl_soil) froot_prof_p(j,m) = cinput_rootfr_p(j,m) / rootfr_tot croot_prof_p(j,m) = cinput_rootfr_p(j,m) / rootfr_tot - + IF (j > nbedrock .and. cinput_rootfr_p(j,m) > 0._r8) THEN write(*,*) 'ERROR: cinput_rootfr_p > 0 in bedrock' ENDIF @@ -120,15 +120,15 @@ SUBROUTINE SoilBiogeochemVerticalProfile(i,ps,pe,nl_soil,nl_soil_full,nbedrock,z stem_prof_p(1,m) = 1./dz_soi(1) ENDIF ENDDO - - + + !! aggregate root profile to column DO m = ps , pe DO j = 1,nl_soil col_cinput_rootfr(j) = col_cinput_rootfr(j) + cinput_rootfr_p(j,m) * pftfrac(m) ENDDO ENDDO - + ! repeat for column-native profiles: Ndep and Nfix rootfr_tot = 0._r8 surface_prof_tot = 0._r8 @@ -146,7 +146,7 @@ SUBROUTINE SoilBiogeochemVerticalProfile(i,ps,pe,nl_soil,nl_soil_full,nbedrock,z nfixation_prof(1,i) = 1./dz_soi(1) ndep_prof(1,i) = 1./dz_soi(1) ENDIF - + ! check to make sure integral of all profiles = 1. ndep_prof_sum = 0. nfixation_prof_sum = 0. @@ -168,7 +168,7 @@ SUBROUTINE SoilBiogeochemVerticalProfile(i,ps,pe,nl_soil,nl_soil_full,nbedrock,z write(*,*) 'ERROR: _prof_sum-1>delta' CALL abort() ENDIF - + DO m = ps , pe froot_prof_sum = 0. croot_prof_sum = 0. diff --git a/main/BGC/MOD_BGC_Vars_1DFluxes.F90 b/main/BGC/MOD_BGC_Vars_1DFluxes.F90 index ab9c12a5..2cf0e81e 100644 --- a/main/BGC/MOD_BGC_Vars_1DFluxes.F90 +++ b/main/BGC/MOD_BGC_Vars_1DFluxes.F90 @@ -4,7 +4,7 @@ MODULE MOD_BGC_Vars_1DFluxes #ifdef BGC !--------------------------------------------------------------------------------------------------------- ! !DESCRIPTION -! Define, allocate, and deallocate biogeochmeical flux variables at patch level +! Define, allocate, and deallocate biogeochemical flux variables at patch level ! !ORIGINAL: ! Xingjie Lu, 2022, created the original version @@ -59,7 +59,7 @@ MODULE MOD_BGC_Vars_1DFluxes real(r8), allocatable :: grainc_to_seed (:) ! grain to crop seed carbon (gC m-2 s-1) real(r8), allocatable :: grainn_to_cropprodn (:) ! grain to crop production nitrogen (gN m-2 s-1) real(r8), allocatable :: cropprod1c_loss (:) ! loss rate of 1-yr crop production carbon (gC m-2 s-1) - + ! decomposition carbon fluxes real(r8), allocatable :: decomp_cpools_sourcesink (:,:,:) ! vertical resolved: the input of litter & soil carbon pools (donor or receiver) from phenology-associated litterfall and decomposition (gC m-3 timestep-1) real(r8), allocatable :: decomp_ctransfer_vr (:,:,:) ! vertical resolved: the non-respiratory portion of potential carbon transfer from one litter & soil carbon pool to another (gC m-3 s-1) @@ -69,7 +69,7 @@ MODULE MOD_BGC_Vars_1DFluxes real(r8), allocatable :: m_decomp_cpools_to_fire_vr (:,:,:) ! vertical resolved: the carbon from decomposition pools to fire emissions (gC m-3 s-1) real(r8), allocatable :: decomp_cpools_transport_tendency(:,:,:) ! vertical resolved: the carbon tendency due to vertical transport in decomposition carbon pools (gC m-3 s-1) real(r8), allocatable :: som_c_leached (:) ! total soil organic matter C loss from vertical transport (gC m-2 s-1) - + ! vegetation to decomposition carbon fluxes real(r8), allocatable :: phenology_to_met_c (:,:) ! phenology-associated plant C loss to metabolic litter C (gC m-3 s-1) real(r8), allocatable :: phenology_to_cel_c (:,:) ! phenology-associated plant C loss to cellulosic litter C (gC m-3 s-1) @@ -82,7 +82,7 @@ MODULE MOD_BGC_Vars_1DFluxes real(r8), allocatable :: fire_mortality_to_cel_c (:,:) ! fire mortality-associated plant C loss to cellulosic litter C (gC m-3 s-1) real(r8), allocatable :: fire_mortality_to_lig_c (:,:) ! fire mortality-associated plant C loss to lignin litter C (gC m-3 s-1) real(r8), allocatable :: fire_mortality_to_cwdc (:,:) ! fire mortality-associated plant C loss to coarse woody debris C (gC m-3 s-1) - + ! decomposition nitrogen fluxes real(r8), allocatable :: decomp_npools_sourcesink (:,:,:) ! vertical resolved: the the input of litter & soil nitrogen pools (donor or receiver) (gN m-3 timestep) real(r8), allocatable :: decomp_ntransfer_vr (:,:,:) ! vertical resolved: the nitrogen flux transfer from one litter & soil nitrogen pool to another (gN m-3 s-1) @@ -91,7 +91,7 @@ MODULE MOD_BGC_Vars_1DFluxes real(r8), allocatable :: m_decomp_npools_to_fire_vr (:,:,:) ! vertical resolved: the litter & soil nitrogen loss associated to the fire (gN m-3 s-1) real(r8), allocatable :: decomp_npools_transport_tendency(:,:,:) ! vertical resolved: the nitrogen tendency due to vertical transport in decomposition nitrogen pools (gN m-3 s-1) real(r8), allocatable :: som_n_leached (:) ! total soil organic matter N loss from vertical transport (gN m-2 s-1) - + ! vegetation to decomposition nitrogen fluxes real(r8), allocatable :: phenology_to_met_n (:,:) ! phenology-associated plant N loss to metabolic litter N (gN m-3 s-1) real(r8), allocatable :: phenology_to_cel_n (:,:) ! phenology-associated plant N loss to cellulosic litter N (gN m-3 s-1) @@ -104,7 +104,7 @@ MODULE MOD_BGC_Vars_1DFluxes real(r8), allocatable :: fire_mortality_to_cel_n (:,:) ! fire mortality-associated plant N loss to cellulosic litter N (gN m-3 s-1) real(r8), allocatable :: fire_mortality_to_lig_n (:,:) ! fire mortality-associated plant N loss to lignin litter N (gN m-3 s-1) real(r8), allocatable :: fire_mortality_to_cwdn (:,:) ! fire mortality-associated plant N loss to coarse woody debris N (gN m-3 s-1) - + real(r8), allocatable :: sminn_leached_vr (:,:) ! vertical resolved: soil mineral N loss due to leaching (gN m-3 s-1) real(r8), allocatable :: smin_no3_leached_vr (:,:) ! vertical resolved: soil mineral NO3 loss due to leaching (gN m-3 s-1) real(r8), allocatable :: smin_no3_runoff_vr (:,:) ! vertical resolved: soil mineral NO3 loss due to runoff (gN m-3 s-1) @@ -148,7 +148,7 @@ MODULE MOD_BGC_Vars_1DFluxes real(r8), allocatable :: smin_no3_leached (:) ! soil mineral NO3 loss due to leaching (gN m-2 s-1) real(r8), allocatable :: smin_no3_runoff (:) ! soil mineral NO3 loss due to runoff (gN m-2 s-1) !----------------- end BGC variables ----------------------------------- - + ! PUBLIC MEMBER FUNCTIONS: PUBLIC :: allocate_1D_BGCFluxes PUBLIC :: deallocate_1D_BGCFluxes @@ -325,7 +325,7 @@ SUBROUTINE deallocate_1D_BGCFluxes () USE MOD_LandPatch IF (p_is_worker) THEN - + IF (numpatch > 0) THEN ! bgc variables @@ -373,8 +373,8 @@ SUBROUTINE deallocate_1D_BGCFluxes () deallocate (grainc_to_seed ) deallocate (grainn_to_cropprodn ) deallocate (cropprod1c_loss ) - - + + ! decomposition carbon fluxes deallocate (decomp_cpools_sourcesink ) deallocate (decomp_ctransfer_vr ) @@ -384,7 +384,7 @@ SUBROUTINE deallocate_1D_BGCFluxes () deallocate (m_decomp_cpools_to_fire_vr ) deallocate (decomp_cpools_transport_tendency) deallocate (som_c_leached ) - + ! vegetation to decomposition carbon fluxes deallocate (phenology_to_met_c ) deallocate (phenology_to_cel_c ) @@ -397,7 +397,7 @@ SUBROUTINE deallocate_1D_BGCFluxes () deallocate (fire_mortality_to_cel_c ) deallocate (fire_mortality_to_lig_c ) deallocate (fire_mortality_to_cwdc ) - + ! decomposition nitrogen fluxes deallocate (decomp_npools_sourcesink ) deallocate (decomp_ntransfer_vr ) @@ -406,7 +406,7 @@ SUBROUTINE deallocate_1D_BGCFluxes () deallocate (m_decomp_npools_to_fire_vr ) deallocate (decomp_npools_transport_tendency) deallocate (som_n_leached ) - + ! vegetation to decomposition nitrogen fluxes deallocate (phenology_to_met_n ) deallocate (phenology_to_cel_n ) @@ -419,7 +419,7 @@ SUBROUTINE deallocate_1D_BGCFluxes () deallocate (fire_mortality_to_cel_n ) deallocate (fire_mortality_to_lig_n ) deallocate (fire_mortality_to_cwdn ) - + deallocate (sminn_leached_vr ) deallocate (smin_no3_leached_vr ) deallocate (smin_no3_runoff_vr ) diff --git a/main/BGC/MOD_BGC_Vars_1DPFTFluxes.F90 b/main/BGC/MOD_BGC_Vars_1DPFTFluxes.F90 index 7c4a9afb..2cfbe3ed 100644 --- a/main/BGC/MOD_BGC_Vars_1DPFTFluxes.F90 +++ b/main/BGC/MOD_BGC_Vars_1DPFTFluxes.F90 @@ -6,7 +6,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes #ifdef BGC !--------------------------------------------------------------------------------------------------------- ! !DESCRIPTION -! Define, allocate, and deallocate biogeochmeical flux variables at pft level +! Define, allocate, and deallocate biogeochemical flux variables at pft level ! !ORIGINAL: ! Xingjie Lu, 2022, created the original version @@ -14,7 +14,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes USE MOD_Precision IMPLICIT NONE SAVE - + ! bgc variables real(r8), allocatable :: leafc_xfer_to_leafc_p (:) ! pft level: phenology-associated flux: leaf transfer C to display C (gC m-2 s-1) real(r8), allocatable :: frootc_xfer_to_frootc_p (:) ! pft level: phenology-associated flux: fine root transfer C to display C (gC m-2 s-1) @@ -23,7 +23,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: livecrootc_xfer_to_livecrootc_p (:) ! pft level: phenology-associated flux: live coarse root transfer C to display C (gC m-2 s-1) real(r8), allocatable :: deadcrootc_xfer_to_deadcrootc_p (:) ! pft level: phenology-associated flux: dead coarse root transfer C to display C (gC m-2 s-1) real(r8), allocatable :: grainc_xfer_to_grainc_p (:) ! pft level: phenology-associated flux: grain transfer C to display C (gC m-2 s-1) - + real(r8), allocatable :: leafc_storage_to_xfer_p (:) ! pft level: phenology-associated flux: leaf storage C to transfer C (gC m-2 s-1) real(r8), allocatable :: frootc_storage_to_xfer_p (:) ! pft level: phenology-associated flux: fine root storage C to transfer C (gC m-2 s-1) real(r8), allocatable :: livestemc_storage_to_xfer_p (:) ! pft level: phenology-associated flux: live stem storage C to transfer C (gC m-2 s-1) @@ -32,7 +32,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: deadcrootc_storage_to_xfer_p (:) ! pft level: phenology-associated flux: dead coarse root storage C to transfer C (gC m-2 s-1) real(r8), allocatable :: grainc_storage_to_xfer_p (:) ! pft level: phenology-associated flux: grain storage C to transfer C (gC m-2 s-1) real(r8), allocatable :: gresp_storage_to_xfer_p (:) ! pft level: phenology-associated flux: growth respiration storage C to transfer C (gC m-2 s-1) - + real(r8), allocatable :: leafc_to_litter_p (:) ! pft level: phenology-associated flux: leaf display C to litter C (gC m-2 s-1) real(r8), allocatable :: frootc_to_litter_p (:) ! pft level: phenology-associated flux: fine root display C to litter C (gC m-2 s-1) real(r8), allocatable :: grainc_to_food_p (:) ! pft level: phenology-associated flux: grain display C to product C (gC m-2 s-1) @@ -41,14 +41,14 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: livestemc_to_litter_p (:) ! pft level: phenology-associated flux: live stem display C to litter C (gC m-2 s-1) real(r8), allocatable :: livestemc_to_deadstemc_p (:) ! pft level: phenology-associated flux: live stem display C to dead stem display C (gC m-2 s-1) real(r8), allocatable :: livecrootc_to_deadcrootc_p (:) ! pft level: phenology-associated flux: live coarse root display C to dead coarse root display C (gC m-2 s-1) - + real(r8), allocatable :: m_leafc_to_litter_p (:) ! pft level: gap mortality-associated flux: leaf display C to litter C (gC m-2 s-1) real(r8), allocatable :: m_frootc_to_litter_p (:) ! pft level: gap mortality-associated flux: fine root display C to litter C (gC m-2 s-1) real(r8), allocatable :: m_livestemc_to_litter_p (:) ! pft level: gap mortality-associated flux: live stem display C to litter C (gC m-2 s-1) real(r8), allocatable :: m_deadstemc_to_litter_p (:) ! pft level: gap mortality-associated flux: dead stem display C to litter C (gC m-2 s-1) real(r8), allocatable :: m_livecrootc_to_litter_p (:) ! pft level: gap mortality-associated flux: live coarse root display C to litter C (gC m-2 s-1) real(r8), allocatable :: m_deadcrootc_to_litter_p (:) ! pft level: gap mortality-associated flux: dead coarse root display C to litter C (gC m-2 s-1) - + real(r8), allocatable :: m_leafc_storage_to_litter_p (:) ! pft level: gap mortality-associated flux: leaf storage C to litter C (gC m-2 s-1) real(r8), allocatable :: m_frootc_storage_to_litter_p (:) ! pft level: gap mortality-associated flux: fine root storage C to litter C (gC m-2 s-1) real(r8), allocatable :: m_livestemc_storage_to_litter_p (:) ! pft level: gap mortality-associated flux: live stem storage C to litter C (gC m-2 s-1) @@ -56,7 +56,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: m_livecrootc_storage_to_litter_p (:) ! pft level: gap mortality-associated flux: live coarse root storage C to litter C (gC m-2 s-1) real(r8), allocatable :: m_deadcrootc_storage_to_litter_p (:) ! pft level: gap mortality-associated flux: dead coarse root storage C to litter C (gC m-2 s-1) real(r8), allocatable :: m_gresp_storage_to_litter_p (:) ! pft level: gap mortality-associated flux: growth respiration storage C to litter C (gC m-2 s-1) - + real(r8), allocatable :: m_leafc_xfer_to_litter_p (:) ! pft level: gap mortality-associated flux: leaf transfer C to litter C (gC m-2 s-1) real(r8), allocatable :: m_frootc_xfer_to_litter_p (:) ! pft level: gap mortality-associated flux: fine root transfer C to litter C (gC m-2 s-1) real(r8), allocatable :: m_livestemc_xfer_to_litter_p (:) ! pft level: gap mortality-associated flux: live stem transfer C to litter C (gC m-2 s-1) @@ -64,14 +64,14 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: m_livecrootc_xfer_to_litter_p (:) ! pft level: gap mortality-associated flux: live coarse root transfer C to litter C (gC m-2 s-1) real(r8), allocatable :: m_deadcrootc_xfer_to_litter_p (:) ! pft level: gap mortality-associated flux: dead coarse root transfer C to litter C (gC m-2 s-1) real(r8), allocatable :: m_gresp_xfer_to_litter_p (:) ! pft level: gap mortality-associated flux: growth respiration transfer C to litter C (gC m-2 s-1) - + real(r8), allocatable :: m_leafc_to_fire_p (:) ! pft level: fire mortality-associated flux: leaf display C to fire emissions (gC m-2 s-1) real(r8), allocatable :: m_frootc_to_fire_p (:) ! pft level: fire mortality-associated flux: fine root display C to fire emissions (gC m-2 s-1) real(r8), allocatable :: m_livestemc_to_fire_p (:) ! pft level: fire mortality-associated flux: live stem display C to fire emissions (gC m-2 s-1) real(r8), allocatable :: m_deadstemc_to_fire_p (:) ! pft level: fire mortality-associated flux: dead stem display C to fire emissions (gC m-2 s-1) real(r8), allocatable :: m_livecrootc_to_fire_p (:) ! pft level: fire mortality-associated flux: live coarse root display C to fire emissions (gC m-2 s-1) real(r8), allocatable :: m_deadcrootc_to_fire_p (:) ! pft level: fire mortality-associated flux: dead coarse root display C to fire emissions (gC m-2 s-1) - + real(r8), allocatable :: m_leafc_storage_to_fire_p (:) ! pft level: fire mortality-associated flux: leaf storage C to fire emissions (gC m-2 s-1) real(r8), allocatable :: m_frootc_storage_to_fire_p (:) ! pft level: fire mortality-associated flux: fine root storage C to fire emissions (gC m-2 s-1) real(r8), allocatable :: m_livestemc_storage_to_fire_p (:) ! pft level: fire mortality-associated flux: live stem storage C to fire emissions (gC m-2 s-1) @@ -79,7 +79,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: m_livecrootc_storage_to_fire_p (:) ! pft level: fire mortality-associated flux: live coarse root storage C to fire emissions (gC m-2 s-1) real(r8), allocatable :: m_deadcrootc_storage_to_fire_p (:) ! pft level: fire mortality-associated flux: dead coarse root storage C to fire emissions (gC m-2 s-1) real(r8), allocatable :: m_gresp_storage_to_fire_p (:) ! pft level: fire mortality-associated flux: growth respiration storage C to fire emissions (gC m-2 s-1) - + real(r8), allocatable :: m_leafc_xfer_to_fire_p (:) ! pft level: fire mortality-associated flux: leaf transfer C to fire emissions (gC m-2 s-1) real(r8), allocatable :: m_frootc_xfer_to_fire_p (:) ! pft level: fire mortality-associated flux: fine root transfer C to fire emissions (gC m-2 s-1) real(r8), allocatable :: m_livestemc_xfer_to_fire_p (:) ! pft level: fire mortality-associated flux: live stem transfer C to fire emissions (gC m-2 s-1) @@ -87,17 +87,17 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: m_livecrootc_xfer_to_fire_p (:) ! pft level: fire mortality-associated flux: live coarse root transfer C to fire emissions (gC m-2 s-1) real(r8), allocatable :: m_deadcrootc_xfer_to_fire_p (:) ! pft level: fire mortality-associated flux: dead coarse root transfer C to fire emissions (gC m-2 s-1) real(r8), allocatable :: m_gresp_xfer_to_fire_p (:) ! pft level: fire mortality-associated flux: growth respiration transfer C to fire emissions (gC m-2 s-1) - + real(r8), allocatable :: m_livestemc_to_deadstemc_fire_p (:) ! pft level: fire mortality-associated flux: live stem display C to dead stem display C due to fire (gC m-2 s-1) real(r8), allocatable :: m_livecrootc_to_deadcrootc_fire_p (:) ! pft level: fire mortality-associated flux: live coarse root display C to dead coarse root display C due to fire (gC m-2 s-1) - + real(r8), allocatable :: m_leafc_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: leaf display C to litter C due to fire (gC m-2 s-1) real(r8), allocatable :: m_frootc_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: fine root display C to litter C due to fire (gC m-2 s-1) real(r8), allocatable :: m_livestemc_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: live stem display C to litter C due to fire (gC m-2 s-1) real(r8), allocatable :: m_deadstemc_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: dead stem display C to litter C due to fire (gC m-2 s-1) real(r8), allocatable :: m_livecrootc_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: live coarse root display C to litter C due to fire (gC m-2 s-1) real(r8), allocatable :: m_deadcrootc_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: dead coarse root display C to litter C due to fire (gC m-2 s-1) - + real(r8), allocatable :: m_leafc_storage_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: leaf storage C to litter C due to fire (gC m-2 s-1) real(r8), allocatable :: m_frootc_storage_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: fine root storage C to litter C due to fire (gC m-2 s-1) real(r8), allocatable :: m_livestemc_storage_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: live stem storage C to litter C due to fire (gC m-2 s-1) @@ -105,7 +105,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: m_livecrootc_storage_to_litter_fire_p(:) ! pft level: fire mortality-associated flux: live coarse root storage C to litter C due to fire (gC m-2 s-1) real(r8), allocatable :: m_deadcrootc_storage_to_litter_fire_p(:) ! pft level: fire mortality-associated flux: dead coarse root storage C to litter C due to fire (gC m-2 s-1) real(r8), allocatable :: m_gresp_storage_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: growth respiration storage C to litter C due to fire (gC m-2 s-1) - + real(r8), allocatable :: m_leafc_xfer_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: leaf transfer C to litter C due to fire (gC m-2 s-1) real(r8), allocatable :: m_frootc_xfer_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: fine root transfer C to litter C due to fire (gC m-2 s-1) real(r8), allocatable :: m_livestemc_xfer_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: live stem transfer C to litter C due to fire (gC m-2 s-1) @@ -113,7 +113,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: m_livecrootc_xfer_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: live coarse root transfer C to litter C due to fire (gC m-2 s-1) real(r8), allocatable :: m_deadcrootc_xfer_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: dead coarse root transfer C to litter C due to fire (gC m-2 s-1) real(r8), allocatable :: m_gresp_xfer_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: growth respiration transfer C to litter C due to fire (gC m-2 s-1) - + real(r8), allocatable :: cpool_to_xsmrpool_p (:) ! pft level: allocation-associated flux: available C allocated to maintenance respiration storage C (gC m-2 s-1) real(r8), allocatable :: cpool_to_gresp_storage_p (:) ! pft level: allocation-associated flux: available C allocated to growth respiration storage C (gC m-2 s-1) real(r8), allocatable :: cpool_to_leafc_p (:) ! pft level: allocation-associated flux: available C allocated to leaf display C (gC m-2 s-1) @@ -130,13 +130,13 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: cpool_to_deadcrootc_storage_p(:) ! pft level: allocation-associated flux: available C allocated to dead coarse root storage C (gC m-2 s-1) real(r8), allocatable :: cpool_to_grainc_p (:) ! pft level: allocation-associated flux: available C allocated to grain display C (gC m-2 s-1) real(r8), allocatable :: cpool_to_grainc_storage_p (:) ! pft level: allocation-associated flux: available C allocated to grain storage C (gC m-2 s-1) - + real(r8), allocatable :: leaf_xsmr_p (:) ! pft level: leaf maintenance respiration storage C due to available C deficit (gC m-2 s-1) real(r8), allocatable :: froot_xsmr_p (:) ! pft level: fine root maintenance respiration storage C due to available C deficit (gC m-2 s-1) real(r8), allocatable :: livestem_xsmr_p (:) ! pft level: live stem maintenance respiration storage C due to available C deficit (gC m-2 s-1) real(r8), allocatable :: livecroot_xsmr_p (:) ! pft level: live coarse root maintenance respiration storage C due to available C deficit (gC m-2 s-1) real(r8), allocatable :: grain_xsmr_p (:) ! pft level: grain maintenance respiration storage C due to available C deficit (gC m-2 s-1) - + real(r8), allocatable :: cpool_leaf_gr_p (:) ! pft level: allocation-associated flux: available C allocated to leaf display growth respiration (gC m-2 s-1) real(r8), allocatable :: cpool_froot_gr_p (:) ! pft level: allocation-associated flux: available C allocated to fine root display growth respiration (gC m-2 s-1) real(r8), allocatable :: cpool_livestem_gr_p (:) ! pft level: allocation-associated flux: available C allocated to live stem display growth respiration (gC m-2 s-1) @@ -144,7 +144,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: cpool_livecroot_gr_p (:) ! pft level: allocation-associated flux: available C allocated to live coarse display growth respiration (gC m-2 s-1) real(r8), allocatable :: cpool_deadcroot_gr_p (:) ! pft level: allocation-associated flux: available C allocated to dead coarse display growth respiration (gC m-2 s-1) real(r8), allocatable :: cpool_grain_gr_p (:) ! pft level: allocation-associated flux: available C allocated to grain display growth respiration (gC m-2 s-1) - + real(r8), allocatable :: cpool_leaf_storage_gr_p (:) ! pft level: allocation-associated flux: available C allocated to leaf storage growth respiration (gC m-2 s-1) real(r8), allocatable :: cpool_froot_storage_gr_p (:) ! pft level: allocation-associated flux: available C allocated to fine root storage growth respiration (gC m-2 s-1) real(r8), allocatable :: cpool_livestem_storage_gr_p (:) ! pft level: allocation-associated flux: available C allocated to live stem storage growth respiration (gC m-2 s-1) @@ -152,7 +152,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: cpool_livecroot_storage_gr_p (:) ! pft level: allocation-associated flux: available C allocated to live coarse storage growth respiration (gC m-2 s-1) real(r8), allocatable :: cpool_deadcroot_storage_gr_p (:) ! pft level: allocation-associated flux: available C allocated to dead coarse storage growth respiration (gC m-2 s-1) real(r8), allocatable :: cpool_grain_storage_gr_p (:) ! pft level: allocation-associated flux: available C allocated to grain storage growth respiration (gC m-2 s-1) - + real(r8), allocatable :: transfer_leaf_gr_p (:) ! pft level: allocation-associated flux: available C allocated to leaf transfer growth respiration (gC m-2 s-1) real(r8), allocatable :: transfer_froot_gr_p (:) ! pft level: allocation-associated flux: available C allocated to fine root transfer growth respiration (gC m-2 s-1) real(r8), allocatable :: transfer_livestem_gr_p (:) ! pft level: allocation-associated flux: available C allocated to live stem transfer growth respiration (gC m-2 s-1) @@ -160,13 +160,13 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: transfer_livecroot_gr_p (:) ! pft level: allocation-associated flux: available C allocated to live coarse transfer growth respiration (gC m-2 s-1) real(r8), allocatable :: transfer_deadcroot_gr_p (:) ! pft level: allocation-associated flux: available C allocated to dead coarse transfer growth respiration (gC m-2 s-1) real(r8), allocatable :: transfer_grain_gr_p (:) ! pft level: allocation-associated flux: available C allocated to grain transfer growth respiration (gC m-2 s-1) - + real(r8), allocatable :: xsmrpool_to_atm_p (:) ! pft level: maintenance respiration storage C to atmosphere due to harvest (gC m-2 s-1) - + real(r8), allocatable :: cropprod1c_loss_p (:) ! pft level: product loss (gC m-2 s-1) - + real(r8), allocatable :: plant_ndemand_p (:) ! pft level: plant potential demand N (gN m-2 s-1) - + real(r8), allocatable :: leafn_xfer_to_leafn_p (:) ! pft level: phenology-associated flux: leaf transfer N to display N (gN m-2 s-1) real(r8), allocatable :: frootn_xfer_to_frootn_p (:) ! pft level: phenology-associated flux: fine root transfer N to display N (gN m-2 s-1) real(r8), allocatable :: livestemn_xfer_to_livestemn_p (:) ! pft level: phenology-associated flux: live stem transfer N to display N (gN m-2 s-1) @@ -174,7 +174,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: livecrootn_xfer_to_livecrootn_p (:) ! pft level: phenology-associated flux: live coarse root transfer N to display N (gN m-2 s-1) real(r8), allocatable :: deadcrootn_xfer_to_deadcrootn_p (:) ! pft level: phenology-associated flux: dead coarse root transfer N to display N (gN m-2 s-1) real(r8), allocatable :: grainn_xfer_to_grainn_p (:) ! pft level: phenology-associated flux: grain transfer N to display N (gN m-2 s-1) - + real(r8), allocatable :: leafn_storage_to_xfer_p (:) ! pft level: phenology-associated flux: leaf storage N to transfer N (gN m-2 s-1) real(r8), allocatable :: frootn_storage_to_xfer_p (:) ! pft level: phenology-associated flux: fine root storage N to transfer N (gN m-2 s-1) real(r8), allocatable :: livestemn_storage_to_xfer_p (:) ! pft level: phenology-associated flux: live stem storage N to transfer N (gN m-2 s-1) @@ -182,7 +182,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: livecrootn_storage_to_xfer_p (:) ! pft level: phenology-associated flux: live coarse root storage N to transfer N (gN m-2 s-1) real(r8), allocatable :: deadcrootn_storage_to_xfer_p (:) ! pft level: phenology-associated flux: dead coarse root storage N to transfer N (gN m-2 s-1) real(r8), allocatable :: grainn_storage_to_xfer_p (:) ! pft level: phenology-associated flux: grain storage N to transfer N (gN m-2 s-1) - + real(r8), allocatable :: leafn_to_litter_p (:) ! pft level: phenology-associated flux: leaf display N to litter N (gN m-2 s-1) real(r8), allocatable :: frootn_to_litter_p (:) ! pft level: phenology-associated flux: fine root display N to litter N (gN m-2 s-1) real(r8), allocatable :: grainn_to_food_p (:) ! pft level: phenology-associated flux: grain display N to product N (gN m-2 s-1) @@ -191,14 +191,14 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: livestemn_to_litter_p (:) ! pft level: phenology-associated flux: live stem display N to litter N (gN m-2 s-1) real(r8), allocatable :: livestemn_to_deadstemn_p (:) ! pft level: phenology-associated flux: live stem display N to dead stem display N (gN m-2 s-1) real(r8), allocatable :: livecrootn_to_deadcrootn_p (:) ! pft level: phenology-associated flux: live coarse root display N to dead coarse root display N (gN m-2 s-1) - + real(r8), allocatable :: leafn_to_retransn_p (:) ! pft level: phenology-associated flux: leaf display N to retranslocated N (gN m-2 s-1) real(r8), allocatable :: frootn_to_retransn_p (:) ! pft level: phenology-associated flux: fine root display N to retranslocated N (gN m-2 s-1) real(r8), allocatable :: livestemn_to_retransn_p (:) ! pft level: phenology-associated flux: live stem display N to retranslocated N (gN m-2 s-1) real(r8), allocatable :: livecrootn_to_retransn_p (:) ! pft level: phenology-associated flux: live coarse root display N to retranslocated N (gN m-2 s-1) real(r8), allocatable :: retransn_to_npool_p (:) ! pft level: phenology-associated flux: retranslocated N to available N (gN m-2 s-1) real(r8), allocatable :: free_retransn_to_npool_p (:) ! pft level: phenology-associated flux: retranslocated N to available N (gN m-2 s-1) - + real(r8), allocatable :: m_leafn_to_litter_p (:) ! pft level: gap mortality-associated flux: leaf display N to litter N (gN m-2 s-1) real(r8), allocatable :: m_frootn_to_litter_p (:) ! pft level: gap mortality-associated flux: fine root display N to litter N (gN m-2 s-1) real(r8), allocatable :: m_livestemn_to_litter_p (:) ! pft level: gap mortality-associated flux: live stem display N to litter N (gN m-2 s-1) @@ -206,70 +206,70 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: m_livecrootn_to_litter_p (:) ! pft level: gap mortality-associated flux: live coarse root display N to litter N (gN m-2 s-1) real(r8), allocatable :: m_deadcrootn_to_litter_p (:) ! pft level: gap mortality-associated flux: dead coarse root display N to litter N (gN m-2 s-1) real(r8), allocatable :: m_retransn_to_litter_p (:) ! pft level: gap mortality-associated flux: retranslocated N to litter N (gN m-2 s-1) - + real(r8), allocatable :: m_leafn_storage_to_litter_p (:) ! pft level: gap mortality-associated flux: leaf storage N to litter N (gN m-2 s-1) real(r8), allocatable :: m_frootn_storage_to_litter_p (:) ! pft level: gap mortality-associated flux: fine root storage N to litter N (gN m-2 s-1) real(r8), allocatable :: m_livestemn_storage_to_litter_p (:) ! pft level: gap mortality-associated flux: live stem storage N to litter N (gN m-2 s-1) real(r8), allocatable :: m_deadstemn_storage_to_litter_p (:) ! pft level: gap mortality-associated flux: dead stem storage N to litter N (gN m-2 s-1) real(r8), allocatable :: m_livecrootn_storage_to_litter_p (:) ! pft level: gap mortality-associated flux: live coarse root storage N to litter N (gN m-2 s-1) real(r8), allocatable :: m_deadcrootn_storage_to_litter_p (:) ! pft level: gap mortality-associated flux: dead coarse root storage N to litter N (gN m-2 s-1) - + real(r8), allocatable :: m_leafn_xfer_to_litter_p (:) ! pft level: gap mortality-associated flux: leaf transfer N to litter N (gN m-2 s-1) real(r8), allocatable :: m_frootn_xfer_to_litter_p (:) ! pft level: gap mortality-associated flux: fine root transfer N to litter N (gN m-2 s-1) real(r8), allocatable :: m_livestemn_xfer_to_litter_p (:) ! pft level: gap mortality-associated flux: live stem transfer N to litter N (gN m-2 s-1) real(r8), allocatable :: m_deadstemn_xfer_to_litter_p (:) ! pft level: gap mortality-associated flux: dead stem transfer N to litter N (gN m-2 s-1) real(r8), allocatable :: m_livecrootn_xfer_to_litter_p (:) ! pft level: gap mortality-associated flux: live coarse root transfer N to litter N (gN m-2 s-1) real(r8), allocatable :: m_deadcrootn_xfer_to_litter_p (:) ! pft level: gap mortality-associated flux: dead coarse root transfer N to litter N (gN m-2 s-1) - + real(r8), allocatable :: m_leafn_to_fire_p (:) ! pft level: fire mortality-associated flux: leaf display N to fire emissions (gN m-2 s-1) real(r8), allocatable :: m_frootn_to_fire_p (:) ! pft level: fire mortality-associated flux: fine root display N to fire emissions (gN m-2 s-1) real(r8), allocatable :: m_livestemn_to_fire_p (:) ! pft level: fire mortality-associated flux: live stem display N to fire emissions (gN m-2 s-1) real(r8), allocatable :: m_deadstemn_to_fire_p (:) ! pft level: fire mortality-associated flux: dead stem display N to fire emissions (gN m-2 s-1) real(r8), allocatable :: m_livecrootn_to_fire_p (:) ! pft level: fire mortality-associated flux: live coarse root display N to fire emissions (gN m-2 s-1) real(r8), allocatable :: m_deadcrootn_to_fire_p (:) ! pft level: fire mortality-associated flux: dead coarse root display N to fire emissions (gN m-2 s-1) - + real(r8), allocatable :: m_leafn_storage_to_fire_p (:) ! pft level: fire mortality-associated flux: leaf storage N to fire emissions (gN m-2 s-1) real(r8), allocatable :: m_frootn_storage_to_fire_p (:) ! pft level: fire mortality-associated flux: fine root storage N to fire emissions (gN m-2 s-1) real(r8), allocatable :: m_livestemn_storage_to_fire_p (:) ! pft level: fire mortality-associated flux: live stem storage N to fire emissions (gN m-2 s-1) real(r8), allocatable :: m_deadstemn_storage_to_fire_p (:) ! pft level: fire mortality-associated flux: dead stem storage N to fire emissions (gN m-2 s-1) real(r8), allocatable :: m_livecrootn_storage_to_fire_p (:) ! pft level: fire mortality-associated flux: live coarse root storage N to fire emissions (gN m-2 s-1) real(r8), allocatable :: m_deadcrootn_storage_to_fire_p (:) ! pft level: fire mortality-associated flux: dead coarse root storage N to fire emissions (gN m-2 s-1) - + real(r8), allocatable :: m_leafn_xfer_to_fire_p (:) ! pft level: fire mortality-associated flux: leaf transfer N to fire emissions (gN m-2 s-1) real(r8), allocatable :: m_frootn_xfer_to_fire_p (:) ! pft level: fire mortality-associated flux: fine root transfer N to fire emissions (gN m-2 s-1) real(r8), allocatable :: m_livestemn_xfer_to_fire_p (:) ! pft level: fire mortality-associated flux: live stem transfer N to fire emissions (gN m-2 s-1) real(r8), allocatable :: m_deadstemn_xfer_to_fire_p (:) ! pft level: fire mortality-associated flux: dead stem transfer N to fire emissions (gN m-2 s-1) real(r8), allocatable :: m_livecrootn_xfer_to_fire_p (:) ! pft level: fire mortality-associated flux: live coarse root transfer N to fire emissions (gN m-2 s-1) real(r8), allocatable :: m_deadcrootn_xfer_to_fire_p (:) ! pft level: fire mortality-associated flux: dead coarse root transfer N to fire emissions (gN m-2 s-1) - + real(r8), allocatable :: m_livestemn_to_deadstemn_fire_p (:) ! pft level: fire mortality-associated flux: live stem display N to dead stem display N due to fire (gN m-2 s-1) real(r8), allocatable :: m_livecrootn_to_deadcrootn_fire_p (:) ! pft level: fire mortality-associated flux: live coarse root display N to dead coarse root display N due to fire (gN m-2 s-1) - + real(r8), allocatable :: m_retransn_to_fire_p (:) ! pft level: fire mortality-associated flux: retranslocated N to fire emissions (gN m-2 s-1) - + real(r8), allocatable :: m_leafn_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: leaf display N to litter N due to fire (gN m-2 s-1) real(r8), allocatable :: m_frootn_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: fine root display N to litter N due to fire (gN m-2 s-1) real(r8), allocatable :: m_livestemn_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: live stem display N to litter N due to fire (gN m-2 s-1) real(r8), allocatable :: m_deadstemn_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: dead stem display N to litter N due to fire (gN m-2 s-1) real(r8), allocatable :: m_livecrootn_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: live coarse root display N to litter N due to fire (gN m-2 s-1) real(r8), allocatable :: m_deadcrootn_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: dead coarse root display N to litter N due to fire (gN m-2 s-1) - + real(r8), allocatable :: m_leafn_storage_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: leaf storage N to litter N due to fire (gN m-2 s-1) real(r8), allocatable :: m_frootn_storage_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: fine root storage N to litter N due to fire (gN m-2 s-1) real(r8), allocatable :: m_livestemn_storage_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: live stem storage N to litter N due to fire (gN m-2 s-1) real(r8), allocatable :: m_deadstemn_storage_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: dead stem storage N to litter N due to fire (gN m-2 s-1) real(r8), allocatable :: m_livecrootn_storage_to_litter_fire_p(:) ! pft level: fire mortality-associated flux: live coarse root storage N to litter N due to fire (gN m-2 s-1) real(r8), allocatable :: m_deadcrootn_storage_to_litter_fire_p(:) ! pft level: fire mortality-associated flux: dead coarse root storage N to litter N due to fire (gN m-2 s-1) - + real(r8), allocatable :: m_leafn_xfer_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: leaf transfer N to litter N due to fire (gN m-2 s-1) real(r8), allocatable :: m_frootn_xfer_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: fine root transfer N to litter N due to fire (gN m-2 s-1) real(r8), allocatable :: m_livestemn_xfer_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: live stem transfer N to litter N due to fire (gN m-2 s-1) real(r8), allocatable :: m_deadstemn_xfer_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: dead stem transfer N to litter N due to fire (gN m-2 s-1) real(r8), allocatable :: m_livecrootn_xfer_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: live coarse root transfer N to litter N due to fire (gN m-2 s-1) real(r8), allocatable :: m_deadcrootn_xfer_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: dead coarse root transfer N to litter N due to fire (gN m-2 s-1) - + real(r8), allocatable :: m_retransn_to_litter_fire_p (:) ! pft level: fire mortality-associated flux: retranslocated N to litter N due to fire (gN m-2 s-1) - + real(r8), allocatable :: npool_to_leafn_p (:) ! pft level: allocation-associated flux: available N allocated to leaf display N (gN m-2 s-1) real(r8), allocatable :: npool_to_leafn_storage_p (:) ! pft level: allocation-associated flux: available N allocated to leaf storage N (gN m-2 s-1) real(r8), allocatable :: npool_to_frootn_p (:) ! pft level: allocation-associated flux: available N allocated to fine root display N (gN m-2 s-1) @@ -284,7 +284,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: npool_to_deadcrootn_storage_p (:) ! pft level: allocation-associated flux: available N allocated to dead coarse root storage N (gN m-2 s-1) real(r8), allocatable :: npool_to_grainn_p (:) ! pft level: allocation-associated flux: available N allocated to grain display N (gN m-2 s-1) real(r8), allocatable :: npool_to_grainn_storage_p (:) ! pft level: allocation-associated flux: available N allocated to grain storage N (gN m-2 s-1) - + real(r8), allocatable :: respcsun_p (:) ! pft level: sunlit leaf respiration (gC m-2 s-1) real(r8), allocatable :: respcsha_p (:) ! pft level: shaded leaf respiration (gC m-2 s-1) real(r8), allocatable :: leaf_mr_p (:) ! pft level: leaf maintenance respiration (gC m-2 s-1) @@ -292,9 +292,9 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: livestem_mr_p (:) ! pft level: live stem maintenance respiration (gC m-2 s-1) real(r8), allocatable :: livecroot_mr_p (:) ! pft level: live coarse root maintenance respiration (gC m-2 s-1) real(r8), allocatable :: grain_mr_p (:) ! pft level: grain maintenance respiration (gC m-2 s-1) - + real(r8), allocatable :: soil_change_p (:) ! pft level: soil carbon used by FUN (gC m-2 s-1) - + real(r8), allocatable :: psn_to_cpool_p (:) ! pft level: photosynthesis rate (gC m-2 s-1) real(r8), allocatable :: gpp_p (:) ! pft level: gross primary production (gC m-2 s-1) real(r8), allocatable :: availc_p (:) ! pft level: available C (gC m-2 s-1) @@ -302,7 +302,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: xsmrpool_recover_p (:) ! pft level: available C to maintenance respiration storage C to recover previous excess mainte real(r8), allocatable :: excess_cflux_p (:) ! pft level: excess C due to N limitation (gC m-2 s-1) real(r8), allocatable :: sminn_to_npool_p (:) ! pft level: soil mineral N uptake for plant growth (gN m-2 s-1) - + real(r8), allocatable :: plant_calloc_p (:) ! pft level: actual available C for plant grwoth (gC m-2 s-1) real(r8), allocatable :: plant_nalloc_p (:) ! pft level: actual available N for plant growth (gN m-2 s-1) real(r8), allocatable :: leaf_curmr_p (:) ! pft level: leaf maintenance respiration from current available C (gC m-2 s-1) @@ -310,7 +310,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: livestem_curmr_p (:) ! pft level: live stem maintenance respiration from current available C (gC m-2 s-1) real(r8), allocatable :: livecroot_curmr_p (:) ! pft level: live coarse root maintenance respiration from current available C (gC m-2 s-1) real(r8), allocatable :: grain_curmr_p (:) ! pft level: grain maintenance respiration from current available C (gC m-2 s-1) - + real(r8), allocatable :: fire_closs_p (:) ! pft level: total C emissions due to fire (gC m-2 s-1) real(r8), allocatable :: fire_nloss_p (:) ! pft level: total N emissions due to fire (gN m-2 s-1) real(r8), allocatable :: wood_harvestc_p (:) ! pft level: harvested wood C (gC m-2 s-1) @@ -319,7 +319,7 @@ MODULE MOD_BGC_Vars_1DPFTFluxes real(r8), allocatable :: grainn_to_cropprodn_p (:) ! pft level: harvested grain N (gN m-2 s-1) real(r8), allocatable :: hrv_xsmrpool_to_atm_p (:) ! pft level: maintenance respiration storage C to atmosphere due to harvest (gC m-2 s-1) real(r8), allocatable :: soyfixn_p (:) ! pft level: soybean fixed nitrogen rate (gN m-2 s-1) - + ! PUBLIC MEMBER FUNCTIONS: PUBLIC :: allocate_1D_BGCPFTFluxes PUBLIC :: deallocate_1D_BGCPFTFluxes @@ -345,7 +345,7 @@ SUBROUTINE allocate_1D_BGCPFTFluxes IF (p_is_worker) THEN IF (numpft > 0) THEN - + ! bgc variables allocate (leafc_xfer_to_leafc_p (numpft)) ; leafc_xfer_to_leafc_p (:) = spval allocate (frootc_xfer_to_frootc_p (numpft)) ; frootc_xfer_to_frootc_p (:) = spval @@ -354,7 +354,7 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (livecrootc_xfer_to_livecrootc_p (numpft)) ; livecrootc_xfer_to_livecrootc_p (:) = spval allocate (deadcrootc_xfer_to_deadcrootc_p (numpft)) ; deadcrootc_xfer_to_deadcrootc_p (:) = spval allocate (grainc_xfer_to_grainc_p (numpft)) ; grainc_xfer_to_grainc_p (:) = spval - + allocate (leafc_storage_to_xfer_p (numpft)) ; leafc_storage_to_xfer_p (:) = spval allocate (frootc_storage_to_xfer_p (numpft)) ; frootc_storage_to_xfer_p (:) = spval allocate (livestemc_storage_to_xfer_p (numpft)) ; livestemc_storage_to_xfer_p (:) = spval @@ -363,7 +363,7 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (deadcrootc_storage_to_xfer_p (numpft)) ; deadcrootc_storage_to_xfer_p (:) = spval allocate (grainc_storage_to_xfer_p (numpft)) ; grainc_storage_to_xfer_p (:) = spval allocate (gresp_storage_to_xfer_p (numpft)) ; gresp_storage_to_xfer_p (:) = spval - + allocate (leafc_to_litter_p (numpft)) ; leafc_to_litter_p (:) = spval allocate (frootc_to_litter_p (numpft)) ; frootc_to_litter_p (:) = spval allocate (grainc_to_food_p (numpft)) ; grainc_to_food_p (:) = spval @@ -372,14 +372,14 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (livestemc_to_litter_p (numpft)) ; livestemc_to_litter_p (:) = spval allocate (livestemc_to_deadstemc_p (numpft)) ; livestemc_to_deadstemc_p (:) = spval allocate (livecrootc_to_deadcrootc_p (numpft)) ; livecrootc_to_deadcrootc_p (:) = spval - + allocate (m_leafc_to_litter_p (numpft)) ; m_leafc_to_litter_p (:) = spval allocate (m_frootc_to_litter_p (numpft)) ; m_frootc_to_litter_p (:) = spval allocate (m_livestemc_to_litter_p (numpft)) ; m_livestemc_to_litter_p (:) = spval allocate (m_deadstemc_to_litter_p (numpft)) ; m_deadstemc_to_litter_p (:) = spval allocate (m_livecrootc_to_litter_p (numpft)) ; m_livecrootc_to_litter_p (:) = spval allocate (m_deadcrootc_to_litter_p (numpft)) ; m_deadcrootc_to_litter_p (:) = spval - + allocate (m_leafc_storage_to_litter_p (numpft)) ; m_leafc_storage_to_litter_p (:) = spval allocate (m_frootc_storage_to_litter_p (numpft)) ; m_frootc_storage_to_litter_p (:) = spval allocate (m_livestemc_storage_to_litter_p (numpft)) ; m_livestemc_storage_to_litter_p (:) = spval @@ -387,7 +387,7 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (m_livecrootc_storage_to_litter_p (numpft)) ; m_livecrootc_storage_to_litter_p (:) = spval allocate (m_deadcrootc_storage_to_litter_p (numpft)) ; m_deadcrootc_storage_to_litter_p (:) = spval allocate (m_gresp_storage_to_litter_p (numpft)) ; m_gresp_storage_to_litter_p (:) = spval - + allocate (m_leafc_xfer_to_litter_p (numpft)) ; m_leafc_xfer_to_litter_p (:) = spval allocate (m_frootc_xfer_to_litter_p (numpft)) ; m_frootc_xfer_to_litter_p (:) = spval allocate (m_livestemc_xfer_to_litter_p (numpft)) ; m_livestemc_xfer_to_litter_p (:) = spval @@ -395,14 +395,14 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (m_livecrootc_xfer_to_litter_p (numpft)) ; m_livecrootc_xfer_to_litter_p (:) = spval allocate (m_deadcrootc_xfer_to_litter_p (numpft)) ; m_deadcrootc_xfer_to_litter_p (:) = spval allocate (m_gresp_xfer_to_litter_p (numpft)) ; m_gresp_xfer_to_litter_p (:) = spval - + allocate (m_leafc_to_fire_p (numpft)) ; m_leafc_to_fire_p (:) = spval allocate (m_frootc_to_fire_p (numpft)) ; m_frootc_to_fire_p (:) = spval allocate (m_livestemc_to_fire_p (numpft)) ; m_livestemc_to_fire_p (:) = spval allocate (m_deadstemc_to_fire_p (numpft)) ; m_deadstemc_to_fire_p (:) = spval allocate (m_livecrootc_to_fire_p (numpft)) ; m_livecrootc_to_fire_p (:) = spval allocate (m_deadcrootc_to_fire_p (numpft)) ; m_deadcrootc_to_fire_p (:) = spval - + allocate (m_leafc_storage_to_fire_p (numpft)) ; m_leafc_storage_to_fire_p (:) = spval allocate (m_frootc_storage_to_fire_p (numpft)) ; m_frootc_storage_to_fire_p (:) = spval allocate (m_livestemc_storage_to_fire_p (numpft)) ; m_livestemc_storage_to_fire_p (:) = spval @@ -410,7 +410,7 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (m_livecrootc_storage_to_fire_p (numpft)) ; m_livecrootc_storage_to_fire_p (:) = spval allocate (m_deadcrootc_storage_to_fire_p (numpft)) ; m_deadcrootc_storage_to_fire_p (:) = spval allocate (m_gresp_storage_to_fire_p (numpft)) ; m_gresp_storage_to_fire_p (:) = spval - + allocate (m_leafc_xfer_to_fire_p (numpft)) ; m_leafc_xfer_to_fire_p (:) = spval allocate (m_frootc_xfer_to_fire_p (numpft)) ; m_frootc_xfer_to_fire_p (:) = spval allocate (m_livestemc_xfer_to_fire_p (numpft)) ; m_livestemc_xfer_to_fire_p (:) = spval @@ -418,17 +418,17 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (m_livecrootc_xfer_to_fire_p (numpft)) ; m_livecrootc_xfer_to_fire_p (:) = spval allocate (m_deadcrootc_xfer_to_fire_p (numpft)) ; m_deadcrootc_xfer_to_fire_p (:) = spval allocate (m_gresp_xfer_to_fire_p (numpft)) ; m_gresp_xfer_to_fire_p (:) = spval - + allocate (m_livestemc_to_deadstemc_fire_p (numpft)) ; m_livestemc_to_deadstemc_fire_p (:) = spval allocate (m_livecrootc_to_deadcrootc_fire_p (numpft)) ; m_livecrootc_to_deadcrootc_fire_p (:) = spval - + allocate (m_leafc_to_litter_fire_p (numpft)) ; m_leafc_to_litter_fire_p (:) = spval allocate (m_frootc_to_litter_fire_p (numpft)) ; m_frootc_to_litter_fire_p (:) = spval allocate (m_livestemc_to_litter_fire_p (numpft)) ; m_livestemc_to_litter_fire_p (:) = spval allocate (m_deadstemc_to_litter_fire_p (numpft)) ; m_deadstemc_to_litter_fire_p (:) = spval allocate (m_livecrootc_to_litter_fire_p (numpft)) ; m_livecrootc_to_litter_fire_p (:) = spval allocate (m_deadcrootc_to_litter_fire_p (numpft)) ; m_deadcrootc_to_litter_fire_p (:) = spval - + allocate (m_leafc_storage_to_litter_fire_p (numpft)) ; m_leafc_storage_to_litter_fire_p (:) = spval allocate (m_frootc_storage_to_litter_fire_p (numpft)) ; m_frootc_storage_to_litter_fire_p (:) = spval allocate (m_livestemc_storage_to_litter_fire_p (numpft)) ; m_livestemc_storage_to_litter_fire_p (:) = spval @@ -436,7 +436,7 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (m_livecrootc_storage_to_litter_fire_p(numpft)) ; m_livecrootc_storage_to_litter_fire_p(:) = spval allocate (m_deadcrootc_storage_to_litter_fire_p(numpft)) ; m_deadcrootc_storage_to_litter_fire_p(:) = spval allocate (m_gresp_storage_to_litter_fire_p (numpft)) ; m_gresp_storage_to_litter_fire_p (:) = spval - + allocate (m_leafc_xfer_to_litter_fire_p (numpft)) ; m_leafc_xfer_to_litter_fire_p (:) = spval allocate (m_frootc_xfer_to_litter_fire_p (numpft)) ; m_frootc_xfer_to_litter_fire_p (:) = spval allocate (m_livestemc_xfer_to_litter_fire_p (numpft)) ; m_livestemc_xfer_to_litter_fire_p (:) = spval @@ -444,7 +444,7 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (m_livecrootc_xfer_to_litter_fire_p (numpft)) ; m_livecrootc_xfer_to_litter_fire_p (:) = spval allocate (m_deadcrootc_xfer_to_litter_fire_p (numpft)) ; m_deadcrootc_xfer_to_litter_fire_p (:) = spval allocate (m_gresp_xfer_to_litter_fire_p (numpft)) ; m_gresp_xfer_to_litter_fire_p (:) = spval - + allocate (cpool_to_xsmrpool_p (numpft)) ; cpool_to_xsmrpool_p (:) = spval allocate (cpool_to_gresp_storage_p (numpft)) ; cpool_to_gresp_storage_p (:) = spval allocate (cpool_to_leafc_p (numpft)) ; cpool_to_leafc_p (:) = spval @@ -461,13 +461,13 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (cpool_to_deadcrootc_storage_p(numpft)) ; cpool_to_deadcrootc_storage_p(:) = spval allocate (cpool_to_grainc_p (numpft)) ; cpool_to_grainc_p (:) = spval allocate (cpool_to_grainc_storage_p (numpft)) ; cpool_to_grainc_storage_p (:) = spval - + allocate (leaf_xsmr_p (numpft)) ; leaf_xsmr_p (:) = spval allocate (froot_xsmr_p (numpft)) ; froot_xsmr_p (:) = spval allocate (livestem_xsmr_p (numpft)) ; livestem_xsmr_p (:) = spval allocate (livecroot_xsmr_p (numpft)) ; livecroot_xsmr_p (:) = spval allocate (grain_xsmr_p (numpft)) ; grain_xsmr_p (:) = spval - + allocate (cpool_leaf_gr_p (numpft)) ; cpool_leaf_gr_p (:) = spval allocate (cpool_froot_gr_p (numpft)) ; cpool_froot_gr_p (:) = spval allocate (cpool_livestem_gr_p (numpft)) ; cpool_livestem_gr_p (:) = spval @@ -475,7 +475,7 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (cpool_livecroot_gr_p (numpft)) ; cpool_livecroot_gr_p (:) = spval allocate (cpool_deadcroot_gr_p (numpft)) ; cpool_deadcroot_gr_p (:) = spval allocate (cpool_grain_gr_p (numpft)) ; cpool_grain_gr_p (:) = spval - + allocate (cpool_leaf_storage_gr_p (numpft)) ; cpool_leaf_storage_gr_p (:) = spval allocate (cpool_froot_storage_gr_p (numpft)) ; cpool_froot_storage_gr_p (:) = spval allocate (cpool_livestem_storage_gr_p (numpft)) ; cpool_livestem_storage_gr_p (:) = spval @@ -483,7 +483,7 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (cpool_livecroot_storage_gr_p (numpft)) ; cpool_livecroot_storage_gr_p (:) = spval allocate (cpool_deadcroot_storage_gr_p (numpft)) ; cpool_deadcroot_storage_gr_p (:) = spval allocate (cpool_grain_storage_gr_p (numpft)) ; cpool_grain_storage_gr_p (:) = spval - + allocate (transfer_leaf_gr_p (numpft)) ; transfer_leaf_gr_p (:) = spval allocate (transfer_froot_gr_p (numpft)) ; transfer_froot_gr_p (:) = spval allocate (transfer_livestem_gr_p (numpft)) ; transfer_livestem_gr_p (:) = spval @@ -491,13 +491,13 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (transfer_livecroot_gr_p (numpft)) ; transfer_livecroot_gr_p (:) = spval allocate (transfer_deadcroot_gr_p (numpft)) ; transfer_deadcroot_gr_p (:) = spval allocate (transfer_grain_gr_p (numpft)) ; transfer_grain_gr_p (:) = spval - + allocate (xsmrpool_to_atm_p (numpft)) ; xsmrpool_to_atm_p (:) = spval - + allocate (cropprod1c_loss_p (numpft)) ; cropprod1c_loss_p (:) = spval - + allocate (plant_ndemand_p (numpft)) ; plant_ndemand_p (:) = spval - + allocate (leafn_xfer_to_leafn_p (numpft)) ; leafn_xfer_to_leafn_p (:) = spval allocate (frootn_xfer_to_frootn_p (numpft)) ; frootn_xfer_to_frootn_p (:) = spval allocate (livestemn_xfer_to_livestemn_p (numpft)) ; livestemn_xfer_to_livestemn_p (:) = spval @@ -505,7 +505,7 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (livecrootn_xfer_to_livecrootn_p (numpft)) ; livecrootn_xfer_to_livecrootn_p (:) = spval allocate (deadcrootn_xfer_to_deadcrootn_p (numpft)) ; deadcrootn_xfer_to_deadcrootn_p (:) = spval allocate (grainn_xfer_to_grainn_p (numpft)) ; grainn_xfer_to_grainn_p (:) = spval - + allocate (leafn_storage_to_xfer_p (numpft)) ; leafn_storage_to_xfer_p (:) = spval allocate (frootn_storage_to_xfer_p (numpft)) ; frootn_storage_to_xfer_p (:) = spval allocate (livestemn_storage_to_xfer_p (numpft)) ; livestemn_storage_to_xfer_p (:) = spval @@ -513,7 +513,7 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (livecrootn_storage_to_xfer_p (numpft)) ; livecrootn_storage_to_xfer_p (:) = spval allocate (deadcrootn_storage_to_xfer_p (numpft)) ; deadcrootn_storage_to_xfer_p (:) = spval allocate (grainn_storage_to_xfer_p (numpft)) ; grainn_storage_to_xfer_p (:) = spval - + allocate (leafn_to_litter_p (numpft)) ; leafn_to_litter_p (:) = spval allocate (frootn_to_litter_p (numpft)) ; frootn_to_litter_p (:) = spval allocate (grainn_to_food_p (numpft)) ; grainn_to_food_p (:) = spval @@ -522,14 +522,14 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (livestemn_to_litter_p (numpft)) ; livestemn_to_litter_p (:) = spval allocate (livestemn_to_deadstemn_p (numpft)) ; livestemn_to_deadstemn_p (:) = spval allocate (livecrootn_to_deadcrootn_p (numpft)) ; livecrootn_to_deadcrootn_p (:) = spval - + allocate (leafn_to_retransn_p (numpft)) ; leafn_to_retransn_p (:) = spval allocate (frootn_to_retransn_p (numpft)) ; frootn_to_retransn_p (:) = spval allocate (livestemn_to_retransn_p (numpft)) ; livestemn_to_retransn_p (:) = spval allocate (livecrootn_to_retransn_p (numpft)) ; livecrootn_to_retransn_p (:) = spval allocate (retransn_to_npool_p (numpft)) ; retransn_to_npool_p (:) = spval allocate (free_retransn_to_npool_p (numpft)) ; free_retransn_to_npool_p (:) = spval - + allocate (m_leafn_to_litter_p (numpft)) ; m_leafn_to_litter_p (:) = spval allocate (m_frootn_to_litter_p (numpft)) ; m_frootn_to_litter_p (:) = spval allocate (m_livestemn_to_litter_p (numpft)) ; m_livestemn_to_litter_p (:) = spval @@ -537,70 +537,70 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (m_livecrootn_to_litter_p (numpft)) ; m_livecrootn_to_litter_p (:) = spval allocate (m_deadcrootn_to_litter_p (numpft)) ; m_deadcrootn_to_litter_p (:) = spval allocate (m_retransn_to_litter_p (numpft)) ; m_retransn_to_litter_p (:) = spval - + allocate (m_leafn_storage_to_litter_p (numpft)) ; m_leafn_storage_to_litter_p (:) = spval allocate (m_frootn_storage_to_litter_p (numpft)) ; m_frootn_storage_to_litter_p (:) = spval allocate (m_livestemn_storage_to_litter_p (numpft)) ; m_livestemn_storage_to_litter_p (:) = spval allocate (m_deadstemn_storage_to_litter_p (numpft)) ; m_deadstemn_storage_to_litter_p (:) = spval allocate (m_livecrootn_storage_to_litter_p (numpft)) ; m_livecrootn_storage_to_litter_p (:) = spval allocate (m_deadcrootn_storage_to_litter_p (numpft)) ; m_deadcrootn_storage_to_litter_p (:) = spval - + allocate (m_leafn_xfer_to_litter_p (numpft)) ; m_leafn_xfer_to_litter_p (:) = spval allocate (m_frootn_xfer_to_litter_p (numpft)) ; m_frootn_xfer_to_litter_p (:) = spval allocate (m_livestemn_xfer_to_litter_p (numpft)) ; m_livestemn_xfer_to_litter_p (:) = spval allocate (m_deadstemn_xfer_to_litter_p (numpft)) ; m_deadstemn_xfer_to_litter_p (:) = spval allocate (m_livecrootn_xfer_to_litter_p (numpft)) ; m_livecrootn_xfer_to_litter_p (:) = spval allocate (m_deadcrootn_xfer_to_litter_p (numpft)) ; m_deadcrootn_xfer_to_litter_p (:) = spval - + allocate (m_leafn_to_fire_p (numpft)) ; m_leafn_to_fire_p (:) = spval allocate (m_frootn_to_fire_p (numpft)) ; m_frootn_to_fire_p (:) = spval allocate (m_livestemn_to_fire_p (numpft)) ; m_livestemn_to_fire_p (:) = spval allocate (m_deadstemn_to_fire_p (numpft)) ; m_deadstemn_to_fire_p (:) = spval allocate (m_livecrootn_to_fire_p (numpft)) ; m_livecrootn_to_fire_p (:) = spval allocate (m_deadcrootn_to_fire_p (numpft)) ; m_deadcrootn_to_fire_p (:) = spval - + allocate (m_leafn_storage_to_fire_p (numpft)) ; m_leafn_storage_to_fire_p (:) = spval allocate (m_frootn_storage_to_fire_p (numpft)) ; m_frootn_storage_to_fire_p (:) = spval allocate (m_livestemn_storage_to_fire_p (numpft)) ; m_livestemn_storage_to_fire_p (:) = spval allocate (m_deadstemn_storage_to_fire_p (numpft)) ; m_deadstemn_storage_to_fire_p (:) = spval allocate (m_livecrootn_storage_to_fire_p (numpft)) ; m_livecrootn_storage_to_fire_p (:) = spval allocate (m_deadcrootn_storage_to_fire_p (numpft)) ; m_deadcrootn_storage_to_fire_p (:) = spval - + allocate (m_leafn_xfer_to_fire_p (numpft)) ; m_leafn_xfer_to_fire_p (:) = spval allocate (m_frootn_xfer_to_fire_p (numpft)) ; m_frootn_xfer_to_fire_p (:) = spval allocate (m_livestemn_xfer_to_fire_p (numpft)) ; m_livestemn_xfer_to_fire_p (:) = spval allocate (m_deadstemn_xfer_to_fire_p (numpft)) ; m_deadstemn_xfer_to_fire_p (:) = spval allocate (m_livecrootn_xfer_to_fire_p (numpft)) ; m_livecrootn_xfer_to_fire_p (:) = spval allocate (m_deadcrootn_xfer_to_fire_p (numpft)) ; m_deadcrootn_xfer_to_fire_p (:) = spval - + allocate (m_livestemn_to_deadstemn_fire_p (numpft)) ; m_livestemn_to_deadstemn_fire_p (:) = spval allocate (m_livecrootn_to_deadcrootn_fire_p (numpft)) ; m_livecrootn_to_deadcrootn_fire_p (:) = spval - + allocate (m_retransn_to_fire_p (numpft)) ; m_retransn_to_fire_p (:) = spval - + allocate (m_leafn_to_litter_fire_p (numpft)) ; m_leafn_to_litter_fire_p (:) = spval allocate (m_frootn_to_litter_fire_p (numpft)) ; m_frootn_to_litter_fire_p (:) = spval allocate (m_livestemn_to_litter_fire_p (numpft)) ; m_livestemn_to_litter_fire_p (:) = spval allocate (m_deadstemn_to_litter_fire_p (numpft)) ; m_deadstemn_to_litter_fire_p (:) = spval allocate (m_livecrootn_to_litter_fire_p (numpft)) ; m_livecrootn_to_litter_fire_p (:) = spval allocate (m_deadcrootn_to_litter_fire_p (numpft)) ; m_deadcrootn_to_litter_fire_p (:) = spval - + allocate (m_leafn_storage_to_litter_fire_p (numpft)) ; m_leafn_storage_to_litter_fire_p (:) = spval allocate (m_frootn_storage_to_litter_fire_p (numpft)) ; m_frootn_storage_to_litter_fire_p (:) = spval allocate (m_livestemn_storage_to_litter_fire_p (numpft)) ; m_livestemn_storage_to_litter_fire_p (:) = spval allocate (m_deadstemn_storage_to_litter_fire_p (numpft)) ; m_deadstemn_storage_to_litter_fire_p (:) = spval allocate (m_livecrootn_storage_to_litter_fire_p(numpft)) ; m_livecrootn_storage_to_litter_fire_p(:) = spval allocate (m_deadcrootn_storage_to_litter_fire_p(numpft)) ; m_deadcrootn_storage_to_litter_fire_p(:) = spval - + allocate (m_leafn_xfer_to_litter_fire_p (numpft)) ; m_leafn_xfer_to_litter_fire_p (:) = spval allocate (m_frootn_xfer_to_litter_fire_p (numpft)) ; m_frootn_xfer_to_litter_fire_p (:) = spval allocate (m_livestemn_xfer_to_litter_fire_p (numpft)) ; m_livestemn_xfer_to_litter_fire_p (:) = spval allocate (m_deadstemn_xfer_to_litter_fire_p (numpft)) ; m_deadstemn_xfer_to_litter_fire_p (:) = spval allocate (m_livecrootn_xfer_to_litter_fire_p (numpft)) ; m_livecrootn_xfer_to_litter_fire_p (:) = spval allocate (m_deadcrootn_xfer_to_litter_fire_p (numpft)) ; m_deadcrootn_xfer_to_litter_fire_p (:) = spval - + allocate (m_retransn_to_litter_fire_p (numpft)) ; m_retransn_to_litter_fire_p (:) = spval - + allocate (npool_to_leafn_p (numpft)) ; npool_to_leafn_p (:) = spval allocate (npool_to_leafn_storage_p (numpft)) ; npool_to_leafn_storage_p (:) = spval allocate (npool_to_frootn_p (numpft)) ; npool_to_frootn_p (:) = spval @@ -615,7 +615,7 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (npool_to_deadcrootn_storage_p (numpft)) ; npool_to_deadcrootn_storage_p (:) = spval allocate (npool_to_grainn_p (numpft)) ; npool_to_grainn_p (:) = spval allocate (npool_to_grainn_storage_p (numpft)) ; npool_to_grainn_storage_p (:) = spval - + allocate (respcsun_p (numpft)) ; respcsun_p (:) = spval allocate (respcsha_p (numpft)) ; respcsha_p (:) = spval allocate (leaf_mr_p (numpft)) ; leaf_mr_p (:) = spval @@ -623,9 +623,9 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (livestem_mr_p (numpft)) ; livestem_mr_p (:) = spval allocate (livecroot_mr_p (numpft)) ; livecroot_mr_p (:) = spval allocate (grain_mr_p (numpft)) ; grain_mr_p (:) = spval - + allocate (soil_change_p (numpft)) ; soil_change_p (:) = spval - + allocate (psn_to_cpool_p (numpft)) ; psn_to_cpool_p (:) = spval allocate (gpp_p (numpft)) ; gpp_p (:) = spval allocate (availc_p (numpft)) ; availc_p (:) = spval @@ -633,7 +633,7 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (xsmrpool_recover_p (numpft)) ; xsmrpool_recover_p (:) = spval allocate (excess_cflux_p (numpft)) ; excess_cflux_p (:) = spval allocate (sminn_to_npool_p (numpft)) ; sminn_to_npool_p (:) = spval - + allocate (plant_calloc_p (numpft)) ; plant_calloc_p (:) = spval allocate (plant_nalloc_p (numpft)) ; plant_nalloc_p (:) = spval allocate (leaf_curmr_p (numpft)) ; leaf_curmr_p (:) = spval @@ -641,7 +641,7 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (livestem_curmr_p (numpft)) ; livestem_curmr_p (:) = spval allocate (livecroot_curmr_p (numpft)) ; livecroot_curmr_p (:) = spval allocate (grain_curmr_p (numpft)) ; grain_curmr_p (:) = spval - + allocate (fire_closs_p (numpft)) ; fire_closs_p (:) = spval allocate (fire_nloss_p (numpft)) ; fire_nloss_p (:) = spval allocate (wood_harvestc_p (numpft)) ; wood_harvestc_p (:) = spval @@ -650,7 +650,7 @@ SUBROUTINE allocate_1D_BGCPFTFluxes allocate (grainn_to_cropprodn_p (numpft)) ; grainn_to_cropprodn_p (:) = spval allocate (hrv_xsmrpool_to_atm_p (numpft)) ; hrv_xsmrpool_to_atm_p (:) = spval allocate (soyfixn_p (numpft)) ; soyfixn_p (:) = spval - + ENDIF ENDIF @@ -676,7 +676,7 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (livecrootc_xfer_to_livecrootc_p ) deallocate (deadcrootc_xfer_to_deadcrootc_p ) deallocate (grainc_xfer_to_grainc_p ) - + deallocate (leafc_storage_to_xfer_p ) deallocate (frootc_storage_to_xfer_p ) deallocate (livestemc_storage_to_xfer_p ) @@ -685,7 +685,7 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (deadcrootc_storage_to_xfer_p ) deallocate (grainc_storage_to_xfer_p ) deallocate (gresp_storage_to_xfer_p ) - + deallocate (leafc_to_litter_p ) deallocate (frootc_to_litter_p ) deallocate (grainc_to_food_p ) @@ -694,14 +694,14 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (livestemc_to_litter_p ) deallocate (livestemc_to_deadstemc_p ) deallocate (livecrootc_to_deadcrootc_p ) - + deallocate (m_leafc_to_litter_p ) deallocate (m_frootc_to_litter_p ) deallocate (m_livestemc_to_litter_p ) deallocate (m_deadstemc_to_litter_p ) deallocate (m_livecrootc_to_litter_p ) deallocate (m_deadcrootc_to_litter_p ) - + deallocate (m_leafc_storage_to_litter_p ) deallocate (m_frootc_storage_to_litter_p ) deallocate (m_livestemc_storage_to_litter_p ) @@ -709,7 +709,7 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (m_livecrootc_storage_to_litter_p ) deallocate (m_deadcrootc_storage_to_litter_p ) deallocate (m_gresp_storage_to_litter_p ) - + deallocate (m_leafc_xfer_to_litter_p ) deallocate (m_frootc_xfer_to_litter_p ) deallocate (m_livestemc_xfer_to_litter_p ) @@ -717,14 +717,14 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (m_livecrootc_xfer_to_litter_p ) deallocate (m_deadcrootc_xfer_to_litter_p ) deallocate (m_gresp_xfer_to_litter_p ) - + deallocate (m_leafc_to_fire_p ) deallocate (m_frootc_to_fire_p ) deallocate (m_livestemc_to_fire_p ) deallocate (m_deadstemc_to_fire_p ) deallocate (m_livecrootc_to_fire_p ) deallocate (m_deadcrootc_to_fire_p ) - + deallocate (m_leafc_storage_to_fire_p ) deallocate (m_frootc_storage_to_fire_p ) deallocate (m_livestemc_storage_to_fire_p ) @@ -732,7 +732,7 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (m_livecrootc_storage_to_fire_p ) deallocate (m_deadcrootc_storage_to_fire_p ) deallocate (m_gresp_storage_to_fire_p ) - + deallocate (m_leafc_xfer_to_fire_p ) deallocate (m_frootc_xfer_to_fire_p ) deallocate (m_livestemc_xfer_to_fire_p ) @@ -740,17 +740,17 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (m_livecrootc_xfer_to_fire_p ) deallocate (m_deadcrootc_xfer_to_fire_p ) deallocate (m_gresp_xfer_to_fire_p ) - + deallocate (m_livestemc_to_deadstemc_fire_p ) deallocate (m_livecrootc_to_deadcrootc_fire_p ) - + deallocate (m_leafc_to_litter_fire_p ) deallocate (m_frootc_to_litter_fire_p ) deallocate (m_livestemc_to_litter_fire_p ) deallocate (m_deadstemc_to_litter_fire_p ) deallocate (m_livecrootc_to_litter_fire_p ) deallocate (m_deadcrootc_to_litter_fire_p ) - + deallocate (m_leafc_storage_to_litter_fire_p ) deallocate (m_frootc_storage_to_litter_fire_p ) deallocate (m_livestemc_storage_to_litter_fire_p ) @@ -758,7 +758,7 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (m_livecrootc_storage_to_litter_fire_p) deallocate (m_deadcrootc_storage_to_litter_fire_p) deallocate (m_gresp_storage_to_litter_fire_p ) - + deallocate (m_leafc_xfer_to_litter_fire_p ) deallocate (m_frootc_xfer_to_litter_fire_p ) deallocate (m_livestemc_xfer_to_litter_fire_p ) @@ -766,7 +766,7 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (m_livecrootc_xfer_to_litter_fire_p ) deallocate (m_deadcrootc_xfer_to_litter_fire_p ) deallocate (m_gresp_xfer_to_litter_fire_p ) - + deallocate (cpool_to_xsmrpool_p ) deallocate (cpool_to_gresp_storage_p ) deallocate (cpool_to_leafc_p ) @@ -783,13 +783,13 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (cpool_to_deadcrootc_storage_p) deallocate (cpool_to_grainc_p ) deallocate (cpool_to_grainc_storage_p ) - + deallocate (leaf_xsmr_p ) deallocate (froot_xsmr_p ) deallocate (livestem_xsmr_p ) deallocate (livecroot_xsmr_p ) deallocate (grain_xsmr_p ) - + deallocate (cpool_leaf_gr_p ) deallocate (cpool_froot_gr_p ) deallocate (cpool_livestem_gr_p ) @@ -797,7 +797,7 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (cpool_livecroot_gr_p ) deallocate (cpool_deadcroot_gr_p ) deallocate (cpool_grain_gr_p ) - + deallocate (cpool_leaf_storage_gr_p ) deallocate (cpool_froot_storage_gr_p ) deallocate (cpool_livestem_storage_gr_p ) @@ -805,7 +805,7 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (cpool_livecroot_storage_gr_p ) deallocate (cpool_deadcroot_storage_gr_p ) deallocate (cpool_grain_storage_gr_p ) - + deallocate (transfer_leaf_gr_p ) deallocate (transfer_froot_gr_p ) deallocate (transfer_livestem_gr_p ) @@ -813,13 +813,13 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (transfer_livecroot_gr_p ) deallocate (transfer_deadcroot_gr_p ) deallocate (transfer_grain_gr_p ) - + deallocate (xsmrpool_to_atm_p ) - + deallocate (cropprod1c_loss_p ) - + deallocate (plant_ndemand_p ) - + deallocate (leafn_xfer_to_leafn_p ) deallocate (frootn_xfer_to_frootn_p ) deallocate (livestemn_xfer_to_livestemn_p ) @@ -827,7 +827,7 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (livecrootn_xfer_to_livecrootn_p ) deallocate (deadcrootn_xfer_to_deadcrootn_p ) deallocate (grainn_xfer_to_grainn_p ) - + deallocate (leafn_storage_to_xfer_p ) deallocate (frootn_storage_to_xfer_p ) deallocate (livestemn_storage_to_xfer_p ) @@ -835,7 +835,7 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (livecrootn_storage_to_xfer_p ) deallocate (deadcrootn_storage_to_xfer_p ) deallocate (grainn_storage_to_xfer_p ) - + deallocate (leafn_to_litter_p ) deallocate (frootn_to_litter_p ) deallocate (grainn_to_food_p ) @@ -844,14 +844,14 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (livestemn_to_litter_p ) deallocate (livestemn_to_deadstemn_p ) deallocate (livecrootn_to_deadcrootn_p ) - + deallocate (leafn_to_retransn_p ) deallocate (frootn_to_retransn_p ) deallocate (livestemn_to_retransn_p ) deallocate (livecrootn_to_retransn_p ) deallocate (retransn_to_npool_p ) deallocate (free_retransn_to_npool_p ) - + deallocate (m_leafn_to_litter_p ) deallocate (m_frootn_to_litter_p ) deallocate (m_livestemn_to_litter_p ) @@ -859,70 +859,70 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (m_livecrootn_to_litter_p ) deallocate (m_deadcrootn_to_litter_p ) deallocate (m_retransn_to_litter_p ) - + deallocate (m_leafn_storage_to_litter_p ) deallocate (m_frootn_storage_to_litter_p ) deallocate (m_livestemn_storage_to_litter_p ) deallocate (m_deadstemn_storage_to_litter_p ) deallocate (m_livecrootn_storage_to_litter_p ) deallocate (m_deadcrootn_storage_to_litter_p ) - + deallocate (m_leafn_xfer_to_litter_p ) deallocate (m_frootn_xfer_to_litter_p ) deallocate (m_livestemn_xfer_to_litter_p ) deallocate (m_deadstemn_xfer_to_litter_p ) deallocate (m_livecrootn_xfer_to_litter_p ) deallocate (m_deadcrootn_xfer_to_litter_p ) - + deallocate (m_leafn_to_fire_p ) deallocate (m_frootn_to_fire_p ) deallocate (m_livestemn_to_fire_p ) deallocate (m_deadstemn_to_fire_p ) deallocate (m_livecrootn_to_fire_p ) deallocate (m_deadcrootn_to_fire_p ) - + deallocate (m_leafn_storage_to_fire_p ) deallocate (m_frootn_storage_to_fire_p ) deallocate (m_livestemn_storage_to_fire_p ) deallocate (m_deadstemn_storage_to_fire_p ) deallocate (m_livecrootn_storage_to_fire_p ) deallocate (m_deadcrootn_storage_to_fire_p ) - + deallocate (m_leafn_xfer_to_fire_p ) deallocate (m_frootn_xfer_to_fire_p ) deallocate (m_livestemn_xfer_to_fire_p ) deallocate (m_deadstemn_xfer_to_fire_p ) deallocate (m_livecrootn_xfer_to_fire_p ) deallocate (m_deadcrootn_xfer_to_fire_p ) - + deallocate (m_livestemn_to_deadstemn_fire_p ) deallocate (m_livecrootn_to_deadcrootn_fire_p ) - + deallocate (m_retransn_to_fire_p ) - + deallocate (m_leafn_to_litter_fire_p ) deallocate (m_frootn_to_litter_fire_p ) deallocate (m_livestemn_to_litter_fire_p ) deallocate (m_deadstemn_to_litter_fire_p ) deallocate (m_livecrootn_to_litter_fire_p ) deallocate (m_deadcrootn_to_litter_fire_p ) - + deallocate (m_leafn_storage_to_litter_fire_p ) deallocate (m_frootn_storage_to_litter_fire_p ) deallocate (m_livestemn_storage_to_litter_fire_p ) deallocate (m_deadstemn_storage_to_litter_fire_p ) deallocate (m_livecrootn_storage_to_litter_fire_p) deallocate (m_deadcrootn_storage_to_litter_fire_p) - + deallocate (m_leafn_xfer_to_litter_fire_p ) deallocate (m_frootn_xfer_to_litter_fire_p ) deallocate (m_livestemn_xfer_to_litter_fire_p ) deallocate (m_deadstemn_xfer_to_litter_fire_p ) deallocate (m_livecrootn_xfer_to_litter_fire_p ) deallocate (m_deadcrootn_xfer_to_litter_fire_p ) - + deallocate (m_retransn_to_litter_fire_p ) - + deallocate (npool_to_leafn_p ) deallocate (npool_to_leafn_storage_p ) deallocate (npool_to_frootn_p ) @@ -937,7 +937,7 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (npool_to_deadcrootn_storage_p ) deallocate (npool_to_grainn_p ) deallocate (npool_to_grainn_storage_p ) - + deallocate (respcsun_p ) deallocate (respcsha_p ) deallocate (leaf_mr_p ) @@ -945,9 +945,9 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (livestem_mr_p ) deallocate (livecroot_mr_p ) deallocate (grain_mr_p ) - + deallocate (soil_change_p ) - + deallocate (psn_to_cpool_p ) deallocate (gpp_p ) deallocate (availc_p ) @@ -955,7 +955,7 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (xsmrpool_recover_p ) deallocate (excess_cflux_p ) deallocate (sminn_to_npool_p ) - + deallocate (plant_calloc_p ) deallocate (plant_nalloc_p ) deallocate (leaf_curmr_p ) @@ -963,7 +963,7 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (livestem_curmr_p ) deallocate (livecroot_curmr_p ) deallocate (grain_curmr_p ) - + deallocate (fire_closs_p ) deallocate (fire_nloss_p ) deallocate (wood_harvestc_p ) @@ -972,7 +972,7 @@ SUBROUTINE deallocate_1D_BGCPFTFluxes deallocate (grainn_to_cropprodn_p ) deallocate (hrv_xsmrpool_to_atm_p ) deallocate (soyfixn_p ) - + ENDIF ENDIF @@ -993,7 +993,7 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) IF (p_is_worker) THEN IF (numpft > 0) THEN - + ! bgc variables leafc_xfer_to_leafc_p (:) = Values frootc_xfer_to_frootc_p (:) = Values @@ -1002,7 +1002,7 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) livecrootc_xfer_to_livecrootc_p (:) = Values deadcrootc_xfer_to_deadcrootc_p (:) = Values grainc_xfer_to_grainc_p (:) = Values - + leafc_storage_to_xfer_p (:) = Values frootc_storage_to_xfer_p (:) = Values livestemc_storage_to_xfer_p (:) = Values @@ -1011,7 +1011,7 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) deadcrootc_storage_to_xfer_p (:) = Values grainc_storage_to_xfer_p (:) = Values gresp_storage_to_xfer_p (:) = Values - + leafc_to_litter_p (:) = Values frootc_to_litter_p (:) = Values grainc_to_food_p (:) = Values @@ -1020,14 +1020,14 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) livestemc_to_litter_p (:) = Values livestemc_to_deadstemc_p (:) = Values livecrootc_to_deadcrootc_p (:) = Values - + m_leafc_to_litter_p (:) = Values m_frootc_to_litter_p (:) = Values m_livestemc_to_litter_p (:) = Values m_deadstemc_to_litter_p (:) = Values m_livecrootc_to_litter_p (:) = Values m_deadcrootc_to_litter_p (:) = Values - + m_leafc_storage_to_litter_p (:) = Values m_frootc_storage_to_litter_p (:) = Values m_livestemc_storage_to_litter_p (:) = Values @@ -1035,7 +1035,7 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) m_livecrootc_storage_to_litter_p (:) = Values m_deadcrootc_storage_to_litter_p (:) = Values m_gresp_storage_to_litter_p (:) = Values - + m_leafc_xfer_to_litter_p (:) = Values m_frootc_xfer_to_litter_p (:) = Values m_livestemc_xfer_to_litter_p (:) = Values @@ -1043,14 +1043,14 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) m_livecrootc_xfer_to_litter_p (:) = Values m_deadcrootc_xfer_to_litter_p (:) = Values m_gresp_xfer_to_litter_p (:) = Values - + m_leafc_to_fire_p (:) = Values m_frootc_to_fire_p (:) = Values m_livestemc_to_fire_p (:) = Values m_deadstemc_to_fire_p (:) = Values m_livecrootc_to_fire_p (:) = Values m_deadcrootc_to_fire_p (:) = Values - + m_leafc_storage_to_fire_p (:) = Values m_frootc_storage_to_fire_p (:) = Values m_livestemc_storage_to_fire_p (:) = Values @@ -1058,7 +1058,7 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) m_livecrootc_storage_to_fire_p (:) = Values m_deadcrootc_storage_to_fire_p (:) = Values m_gresp_storage_to_fire_p (:) = Values - + m_leafc_xfer_to_fire_p (:) = Values m_frootc_xfer_to_fire_p (:) = Values m_livestemc_xfer_to_fire_p (:) = Values @@ -1066,17 +1066,17 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) m_livecrootc_xfer_to_fire_p (:) = Values m_deadcrootc_xfer_to_fire_p (:) = Values m_gresp_xfer_to_fire_p (:) = Values - + m_livestemc_to_deadstemc_fire_p (:) = Values m_livecrootc_to_deadcrootc_fire_p (:) = Values - + m_leafc_to_litter_fire_p (:) = Values m_frootc_to_litter_fire_p (:) = Values m_livestemc_to_litter_fire_p (:) = Values m_deadstemc_to_litter_fire_p (:) = Values m_livecrootc_to_litter_fire_p (:) = Values m_deadcrootc_to_litter_fire_p (:) = Values - + m_leafc_storage_to_litter_fire_p (:) = Values m_frootc_storage_to_litter_fire_p (:) = Values m_livestemc_storage_to_litter_fire_p (:) = Values @@ -1084,7 +1084,7 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) m_livecrootc_storage_to_litter_fire_p(:) = Values m_deadcrootc_storage_to_litter_fire_p(:) = Values m_gresp_storage_to_litter_fire_p (:) = Values - + m_leafc_xfer_to_litter_fire_p (:) = Values m_frootc_xfer_to_litter_fire_p (:) = Values m_livestemc_xfer_to_litter_fire_p (:) = Values @@ -1092,7 +1092,7 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) m_livecrootc_xfer_to_litter_fire_p (:) = Values m_deadcrootc_xfer_to_litter_fire_p (:) = Values m_gresp_xfer_to_litter_fire_p (:) = Values - + cpool_to_xsmrpool_p (:) = Values cpool_to_gresp_storage_p (:) = Values cpool_to_leafc_p (:) = Values @@ -1109,13 +1109,13 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) cpool_to_deadcrootc_storage_p (:) = Values cpool_to_grainc_p (:) = Values cpool_to_grainc_storage_p (:) = Values - + leaf_xsmr_p (:) = Values froot_xsmr_p (:) = Values livestem_xsmr_p (:) = Values livecroot_xsmr_p (:) = Values grain_xsmr_p (:) = Values - + cpool_leaf_gr_p (:) = Values cpool_froot_gr_p (:) = Values cpool_livestem_gr_p (:) = Values @@ -1123,7 +1123,7 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) cpool_livecroot_gr_p (:) = Values cpool_deadcroot_gr_p (:) = Values cpool_grain_gr_p (:) = Values - + cpool_leaf_storage_gr_p (:) = Values cpool_froot_storage_gr_p (:) = Values cpool_livestem_storage_gr_p (:) = Values @@ -1131,7 +1131,7 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) cpool_livecroot_storage_gr_p (:) = Values cpool_deadcroot_storage_gr_p (:) = Values cpool_grain_storage_gr_p (:) = Values - + transfer_leaf_gr_p (:) = Values transfer_froot_gr_p (:) = Values transfer_livestem_gr_p (:) = Values @@ -1139,13 +1139,13 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) transfer_livecroot_gr_p (:) = Values transfer_deadcroot_gr_p (:) = Values transfer_grain_gr_p (:) = Values - + xsmrpool_to_atm_p (:) = Values - + cropprod1c_loss_p (:) = Values - + plant_ndemand_p (:) = Values - + leafn_xfer_to_leafn_p (:) = Values frootn_xfer_to_frootn_p (:) = Values livestemn_xfer_to_livestemn_p (:) = Values @@ -1153,7 +1153,7 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) livecrootn_xfer_to_livecrootn_p (:) = Values deadcrootn_xfer_to_deadcrootn_p (:) = Values grainn_xfer_to_grainn_p (:) = Values - + leafn_storage_to_xfer_p (:) = Values frootn_storage_to_xfer_p (:) = Values livestemn_storage_to_xfer_p (:) = Values @@ -1161,7 +1161,7 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) livecrootn_storage_to_xfer_p (:) = Values deadcrootn_storage_to_xfer_p (:) = Values grainn_storage_to_xfer_p (:) = Values - + leafn_to_litter_p (:) = Values frootn_to_litter_p (:) = Values grainn_to_food_p (:) = Values @@ -1170,14 +1170,14 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) livestemn_to_litter_p (:) = Values livestemn_to_deadstemn_p (:) = Values livecrootn_to_deadcrootn_p (:) = Values - + leafn_to_retransn_p (:) = Values frootn_to_retransn_p (:) = Values livestemn_to_retransn_p (:) = Values livecrootn_to_retransn_p (:) = Values retransn_to_npool_p (:) = Values free_retransn_to_npool_p (:) = Values - + m_leafn_to_litter_p (:) = Values m_frootn_to_litter_p (:) = Values m_livestemn_to_litter_p (:) = Values @@ -1185,70 +1185,70 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) m_livecrootn_to_litter_p (:) = Values m_deadcrootn_to_litter_p (:) = Values m_retransn_to_litter_p (:) = Values - + m_leafn_storage_to_litter_p (:) = Values m_frootn_storage_to_litter_p (:) = Values m_livestemn_storage_to_litter_p (:) = Values m_deadstemn_storage_to_litter_p (:) = Values m_livecrootn_storage_to_litter_p (:) = Values m_deadcrootn_storage_to_litter_p (:) = Values - + m_leafn_xfer_to_litter_p (:) = Values m_frootn_xfer_to_litter_p (:) = Values m_livestemn_xfer_to_litter_p (:) = Values m_deadstemn_xfer_to_litter_p (:) = Values m_livecrootn_xfer_to_litter_p (:) = Values m_deadcrootn_xfer_to_litter_p (:) = Values - + m_leafn_to_fire_p (:) = Values m_frootn_to_fire_p (:) = Values m_livestemn_to_fire_p (:) = Values m_deadstemn_to_fire_p (:) = Values m_livecrootn_to_fire_p (:) = Values m_deadcrootn_to_fire_p (:) = Values - + m_leafn_storage_to_fire_p (:) = Values m_frootn_storage_to_fire_p (:) = Values m_livestemn_storage_to_fire_p (:) = Values m_deadstemn_storage_to_fire_p (:) = Values m_livecrootn_storage_to_fire_p (:) = Values m_deadcrootn_storage_to_fire_p (:) = Values - + m_leafn_xfer_to_fire_p (:) = Values m_frootn_xfer_to_fire_p (:) = Values m_livestemn_xfer_to_fire_p (:) = Values m_deadstemn_xfer_to_fire_p (:) = Values m_livecrootn_xfer_to_fire_p (:) = Values m_deadcrootn_xfer_to_fire_p (:) = Values - + m_livestemn_to_deadstemn_fire_p (:) = Values m_livecrootn_to_deadcrootn_fire_p (:) = Values - + m_retransn_to_fire_p (:) = Values - + m_leafn_to_litter_fire_p (:) = Values m_frootn_to_litter_fire_p (:) = Values m_livestemn_to_litter_fire_p (:) = Values m_deadstemn_to_litter_fire_p (:) = Values m_livecrootn_to_litter_fire_p (:) = Values m_deadcrootn_to_litter_fire_p (:) = Values - + m_leafn_storage_to_litter_fire_p (:) = Values m_frootn_storage_to_litter_fire_p (:) = Values m_livestemn_storage_to_litter_fire_p (:) = Values m_deadstemn_storage_to_litter_fire_p (:) = Values m_livecrootn_storage_to_litter_fire_p(:) = Values m_deadcrootn_storage_to_litter_fire_p(:) = Values - + m_leafn_xfer_to_litter_fire_p (:) = Values m_frootn_xfer_to_litter_fire_p (:) = Values m_livestemn_xfer_to_litter_fire_p (:) = Values m_deadstemn_xfer_to_litter_fire_p (:) = Values m_livecrootn_xfer_to_litter_fire_p (:) = Values m_deadcrootn_xfer_to_litter_fire_p (:) = Values - + m_retransn_to_litter_fire_p (:) = Values - + npool_to_leafn_p (:) = Values npool_to_leafn_storage_p (:) = Values npool_to_frootn_p (:) = Values @@ -1263,7 +1263,7 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) npool_to_deadcrootn_storage_p (:) = Values npool_to_grainn_p (:) = Values npool_to_grainn_storage_p (:) = Values - + respcsun_p (:) = Values!sunlit leaf respiration respcsha_p (:) = Values!shaded leaf respiration leaf_mr_p (:) = Values!leaf maintenance respiration @@ -1271,9 +1271,9 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) livestem_mr_p (:) = Values!live stem maintenance respiration livecroot_mr_p (:) = Values!live coarse root maintenance respiration grain_mr_p (:) = Values!grain maintenance respiration - + soil_change_p (:) = Values - + psn_to_cpool_p (:) = Values gpp_p (:) = Values availc_p (:) = Values @@ -1281,7 +1281,7 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) xsmrpool_recover_p (:) = Values excess_cflux_p (:) = Values sminn_to_npool_p (:) = Values - + plant_calloc_p (:) = Values plant_nalloc_p (:) = Values leaf_curmr_p (:) = Values @@ -1289,7 +1289,7 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) livestem_curmr_p (:) = Values livecroot_curmr_p (:) = Values grain_curmr_p (:) = Values - + fire_closs_p (:) = Values fire_nloss_p (:) = Values wood_harvestc_p (:) = Values @@ -1298,7 +1298,7 @@ SUBROUTINE set_1D_BGCPFTFluxes(Values, Nan) grainn_to_cropprodn_p (:) = Values hrv_xsmrpool_to_atm_p (:) = Values soyfixn_p (:) = Values - + ENDIF ENDIF diff --git a/main/BGC/MOD_BGC_Vars_PFTimeVariables.F90 b/main/BGC/MOD_BGC_Vars_PFTimeVariables.F90 index 2a3e4e32..d087050e 100644 --- a/main/BGC/MOD_BGC_Vars_PFTimeVariables.F90 +++ b/main/BGC/MOD_BGC_Vars_PFTimeVariables.F90 @@ -6,7 +6,7 @@ MODULE MOD_BGC_Vars_PFTimeVariables !--------------------------------------------------------------------------------------------------------- ! !DESCRIPTION -! Define, allocate, and deallocate biogeochmeical state variables at pft level. +! Define, allocate, and deallocate biogeochemical state variables at pft level. ! Read and write biogeochemical state variables at pft level from/to restart files. ! !ORIGINAL: @@ -21,7 +21,7 @@ MODULE MOD_BGC_Vars_PFTimeVariables IMPLICIT NONE SAVE ! ----------------------------------------------------------------- -! Time-varying state variables which reaquired by restart run +! Time-varying state variables which required by restart run !--------------------- bgc variables --------------------------------------- real(r8), allocatable :: leafc_p (:) ! leaf display C (gC m-2) real(r8), allocatable :: leafc_storage_p (:) ! leaf storage C (gC m-2) @@ -46,7 +46,7 @@ MODULE MOD_BGC_Vars_PFTimeVariables real(r8), allocatable :: grainc_xfer_p (:) ! grain transfer C (gC m-2) real(r8), allocatable :: cropseedc_deficit_p (:) ! crop seed deficit C (gC m-2) real(r8), allocatable :: cropprod1c_p (:) ! product C (gC m-2) - real(r8), allocatable :: xsmrpool_p (:) !! maintenance respiration storage C (gC m-2) + real(r8), allocatable :: xsmrpool_p (:) ! maintenance respiration storage C (gC m-2) real(r8), allocatable :: gresp_storage_p (:) ! growth respiration storage C (gC m-2) real(r8), allocatable :: gresp_xfer_p (:) ! growth respiration transfer C (gC m-2) real(r8), allocatable :: cpool_p (:) ! available C (gC m-2) diff --git a/main/BGC/MOD_BGC_Vars_TimeInvariants.F90 b/main/BGC/MOD_BGC_Vars_TimeInvariants.F90 index 9002eda5..8c1c1dfe 100644 --- a/main/BGC/MOD_BGC_Vars_TimeInvariants.F90 +++ b/main/BGC/MOD_BGC_Vars_TimeInvariants.F90 @@ -5,7 +5,7 @@ MODULE MOD_BGC_Vars_TimeInvariants ! -------------------------------------------------------------------- ! !DESCRIPTION -! Define, allocate, and deallocate biogeochmeical constant at patch level. +! Define, allocate, and deallocate biogeochemical constant at patch level. ! Read and write biogeochemical constant at patch level from/to restart files. ! !ORIGINAL: @@ -150,7 +150,7 @@ SUBROUTINE allocate_BGCTimeInvariants () IF (p_is_worker) THEN IF (numpatch > 0) THEN - ! bgc varaibles + ! bgc variables allocate (donor_pool (ndecomp_transitions)) ; donor_pool (:) = spval_i4 allocate (receiver_pool (ndecomp_transitions)) ; receiver_pool (:) = spval_i4 allocate (floating_cn_ratio (ndecomp_pools)) ; floating_cn_ratio (:) = .false. diff --git a/main/BGC/MOD_BGC_Vars_TimeVariables.F90 b/main/BGC/MOD_BGC_Vars_TimeVariables.F90 index bc88d569..d7a2996a 100644 --- a/main/BGC/MOD_BGC_Vars_TimeVariables.F90 +++ b/main/BGC/MOD_BGC_Vars_TimeVariables.F90 @@ -4,7 +4,7 @@ MODULE MOD_BGC_Vars_TimeVariables #ifdef BGC !--------------------------------------------------------------------------------------------------------- ! !DESCRIPTION -! Define, allocate, and deallocate biogeochmeical state variables at patch level. +! Define, allocate, and deallocate biogeochemical state variables at patch level. ! Read and write biogeochemical state variables at patch level from/to restart files. ! !ORIGINAL: diff --git a/main/BGC/MOD_BGC_Veg_CNFireBase.F90 b/main/BGC/MOD_BGC_Veg_CNFireBase.F90 index 91a58e3f..9cbdbbad 100644 --- a/main/BGC/MOD_BGC_Veg_CNFireBase.F90 +++ b/main/BGC/MOD_BGC_Veg_CNFireBase.F90 @@ -4,7 +4,7 @@ MODULE MOD_BGC_Veg_CNFireBase !--------------------------------------------------------------------------------------------------------------- ! !DESCRIPTION: -! This MODULE calculate fire-induced vegetation and litter CN transfers flux, the calculation is based on the fire-induced +! This MODULE calculate fire-induced vegetation and litter CN transfers flux, the calculation is based on the fire-induced ! CN loss rates (f). The CN loss rates (f) is calculated from bgc_veg_CNFireLi2016Mod.F90. ! ! !REFERENCE: @@ -17,7 +17,7 @@ MODULE MOD_BGC_Veg_CNFireBase ! The Community Land Model version 5.0 (CLM5) ! ! !REVISION: -! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code sturcture. +! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code structure. USE MOD_Precision @@ -26,17 +26,17 @@ MODULE MOD_BGC_Veg_CNFireBase fr_fcel , fr_flig , fr_flab , lf_fcel , lf_flig, lf_flab USE MOD_Vars_TimeInvariants, only: & cmb_cmplt_fact, patchlatr, borealat, is_cwd, is_litter - + USE MOD_BGC_Vars_TimeVariables, only: & ! decomposition pools & fluxes variables (inout) decomp_cpools_vr, decomp_npools_vr, cropf, farea_burned, baf_crop, baf_peatf, totsomc - + USE MOD_BGC_Vars_1DFluxes, only: & m_decomp_cpools_to_fire_vr, m_decomp_npools_to_fire_vr, & fire_mortality_to_met_c, fire_mortality_to_cel_c, fire_mortality_to_lig_c, fire_mortality_to_cwdc, & fire_mortality_to_met_n, fire_mortality_to_cel_n, fire_mortality_to_lig_n, fire_mortality_to_cwdn, & somc_fire - + USE MOD_BGC_Vars_PFTimeVariables, only: & leafc_p , leafc_storage_p , leafc_xfer_p , frootc_p , frootc_storage_p , frootc_xfer_p , & livestemc_p , livestemc_storage_p , livestemc_xfer_p , deadstemc_p , deadstemc_storage_p , deadstemc_xfer_p , & @@ -47,7 +47,7 @@ MODULE MOD_BGC_Veg_CNFireBase livecrootn_p, livecrootn_storage_p, livecrootn_xfer_p, deadcrootn_p, deadcrootn_storage_p, deadcrootn_xfer_p, & gresp_xfer_p, gresp_storage_p , retransn_p , & leaf_prof_p , froot_prof_p , croot_prof_p , stem_prof_p - + USE MOD_BGC_Vars_1DPFTFluxes, only: & m_leafc_to_fire_p , m_leafc_storage_to_fire_p , m_leafc_xfer_to_fire_p , & m_frootc_to_fire_p , m_frootc_storage_to_fire_p , m_frootc_xfer_to_fire_p , & @@ -64,7 +64,7 @@ MODULE MOD_BGC_Veg_CNFireBase m_livecrootn_to_fire_p , m_livecrootn_storage_to_fire_p , m_livecrootn_xfer_to_fire_p, & m_deadcrootn_to_fire_p , m_deadcrootn_storage_to_fire_p , m_deadcrootn_xfer_to_fire_p, & m_livestemn_to_deadstemn_fire_p, m_livecrootn_to_deadcrootn_fire_p, & - + m_leafc_to_litter_fire_p , m_leafc_storage_to_litter_fire_p , m_leafc_xfer_to_litter_fire_p , & m_frootc_to_litter_fire_p , m_frootc_storage_to_litter_fire_p , m_frootc_xfer_to_litter_fire_p , & m_livestemc_to_litter_fire_p , m_livestemc_storage_to_litter_fire_p , m_livestemc_xfer_to_litter_fire_p , & @@ -78,11 +78,11 @@ MODULE MOD_BGC_Veg_CNFireBase m_deadstemn_to_litter_fire_p , m_deadstemn_storage_to_litter_fire_p , m_deadstemn_xfer_to_litter_fire_p , & m_livecrootn_to_litter_fire_p, m_livecrootn_storage_to_litter_fire_p, m_livecrootn_xfer_to_litter_fire_p, & m_deadcrootn_to_litter_fire_p, m_deadcrootn_storage_to_litter_fire_p, m_deadcrootn_xfer_to_litter_fire_p - + USE MOD_Vars_PFTimeInvariants, only: pftfrac - + IMPLICIT NONE - + PUBLIC CNFireFluxes CONTAINS @@ -118,7 +118,7 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) f = 0._r8 ENDIF ENDIF - + ! apply this rate to the patch state variables to get flux rates ! biomass burning ! carbon fluxes @@ -133,18 +133,18 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) m_deadstemc_storage_to_fire_p(m) = deadstemc_storage_p(m) * f * cc_other(ivt) m_deadstemc_xfer_to_fire_p(m) = deadstemc_xfer_p(m) * f * cc_other(ivt) m_frootc_to_fire_p(m) = frootc_p(m) * f * 0._r8 - m_frootc_storage_to_fire_p(m) = frootc_storage_p(m) * f * cc_other(ivt) + m_frootc_storage_to_fire_p(m) = frootc_storage_p(m) * f * cc_other(ivt) m_frootc_xfer_to_fire_p(m) = frootc_xfer_p(m) * f * cc_other(ivt) m_livecrootc_to_fire_p(m) = livecrootc_p(m) * f * 0._r8 - m_livecrootc_storage_to_fire_p(m) = livecrootc_storage_p(m) * f * cc_other(ivt) - m_livecrootc_xfer_to_fire_p(m) = livecrootc_xfer_p(m) * f * cc_other(ivt) + m_livecrootc_storage_to_fire_p(m) = livecrootc_storage_p(m) * f * cc_other(ivt) + m_livecrootc_xfer_to_fire_p(m) = livecrootc_xfer_p(m) * f * cc_other(ivt) m_deadcrootc_to_fire_p(m) = deadcrootc_p(m) * f * 0._r8 - m_deadcrootc_storage_to_fire_p(m) = deadcrootc_storage_p(m) * f* cc_other(ivt) - m_deadcrootc_xfer_to_fire_p(m) = deadcrootc_xfer_p(m) * f * cc_other(ivt) + m_deadcrootc_storage_to_fire_p(m) = deadcrootc_storage_p(m) * f* cc_other(ivt) + m_deadcrootc_xfer_to_fire_p(m) = deadcrootc_xfer_p(m) * f * cc_other(ivt) m_gresp_storage_to_fire_p(m) = gresp_storage_p(m) * f * cc_other(ivt) m_gresp_xfer_to_fire_p(m) = gresp_xfer_p(m) * f * cc_other(ivt) - - + + ! nitrogen fluxes m_leafn_to_fire_p(m) = leafn_p(m) * f * cc_leaf(ivt) m_leafn_storage_to_fire_p(m) = leafn_storage_p(m) * f * cc_other(ivt) @@ -152,20 +152,20 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) m_livestemn_to_fire_p(m) = livestemn_p(m) * f * cc_lstem(ivt) m_livestemn_storage_to_fire_p(m) = livestemn_storage_p(m) * f * cc_other(ivt) m_livestemn_xfer_to_fire_p(m) = livestemn_xfer_p(m) * f * cc_other(ivt) - m_deadstemn_to_fire_p(m) = deadstemn_p(m) * f * cc_dstem(ivt) + m_deadstemn_to_fire_p(m) = deadstemn_p(m) * f * cc_dstem(ivt) m_deadstemn_storage_to_fire_p(m) = deadstemn_storage_p(m) * f * cc_other(ivt) m_deadstemn_xfer_to_fire_p(m) = deadstemn_xfer_p(m) * f * cc_other(ivt) m_frootn_to_fire_p(m) = frootn_p(m) * f * 0._r8 m_frootn_storage_to_fire_p(m) = frootn_storage_p(m) * f * cc_other(ivt) m_frootn_xfer_to_fire_p(m) = frootn_xfer_p(m) * f * cc_other(ivt) - m_livecrootn_to_fire_p(m) = livecrootn_p(m) * f * 0._r8 - m_livecrootn_storage_to_fire_p(m) = livecrootn_storage_p(m) * f * cc_other(ivt) + m_livecrootn_to_fire_p(m) = livecrootn_p(m) * f * 0._r8 + m_livecrootn_storage_to_fire_p(m) = livecrootn_storage_p(m) * f * cc_other(ivt) m_livecrootn_xfer_to_fire_p(m) = livecrootn_xfer_p(m) * f * cc_other(ivt) m_deadcrootn_to_fire_p(m) = deadcrootn_p(m) * f * 0._r8 - m_deadcrootn_xfer_to_fire_p(m) = deadcrootn_xfer_p(m) * f * cc_other(ivt) + m_deadcrootn_xfer_to_fire_p(m) = deadcrootn_xfer_p(m) * f * cc_other(ivt) m_deadcrootn_storage_to_fire_p(m) = deadcrootn_storage_p(m) * f * cc_other(ivt) m_retransn_to_fire_p(m) = retransn_p(m) * f * cc_other(ivt) - + ! mortality due to fire ! carbon pools m_leafc_to_litter_fire_p(m) = leafc_p(m) * f * & @@ -179,19 +179,19 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) fm_other(ivt) m_livestemc_to_litter_fire_p(m) = livestemc_p(m) * f * & (1._r8 - cc_lstem(ivt)) * & - fm_droot(ivt) + fm_droot(ivt) m_livestemc_storage_to_litter_fire_p(m) = livestemc_storage_p(m) * f * & (1._r8 - cc_other(ivt)) * & fm_other(ivt) m_livestemc_xfer_to_litter_fire_p(m) = livestemc_xfer_p(m) * f * & (1._r8 - cc_other(ivt)) * & - fm_other(ivt) + fm_other(ivt) m_livestemc_to_deadstemc_fire_p(m) = livestemc_p(m) * f * & (1._r8 - cc_lstem(ivt)) * & (fm_lstem(ivt)-fm_droot(ivt)) m_deadstemc_to_litter_fire_p(m) = deadstemc_p(m) * f * m * & (1._r8 - cc_dstem(ivt)) * & - fm_droot(ivt) + fm_droot(ivt) m_deadstemc_storage_to_litter_fire_p(m) = deadstemc_storage_p(m) * f * & (1._r8 - cc_other(ivt)) * & fm_other(ivt) @@ -210,10 +210,10 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) fm_droot(ivt) m_livecrootc_storage_to_litter_fire_p(m) = livecrootc_storage_p(m) * f * & (1._r8- cc_other(ivt)) * & - fm_other(ivt) + fm_other(ivt) m_livecrootc_xfer_to_litter_fire_p(m) = livecrootc_xfer_p(m) * f * & (1._r8- cc_other(ivt)) * & - fm_other(ivt) + fm_other(ivt) m_livecrootc_to_deadcrootc_fire_p(m) = livecrootc_p(m) * f * & (fm_lroot(ivt)-fm_droot(ivt)) m_deadcrootc_to_litter_fire_p(m) = deadcrootc_p(m) * f * m * & @@ -223,22 +223,22 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) fm_other(ivt) m_deadcrootc_xfer_to_litter_fire_p(m) = deadcrootc_xfer_p(m) * f * & (1._r8- cc_other(ivt)) * & - fm_other(ivt) + fm_other(ivt) m_gresp_storage_to_litter_fire_p(m) = gresp_storage_p(m) * f * & (1._r8 - cc_other(ivt)) * & - fm_other(ivt) + fm_other(ivt) m_gresp_xfer_to_litter_fire_p(m) = gresp_xfer_p(m) * f * & (1._r8 - cc_other(ivt)) * & - fm_other(ivt) - - - ! nitrogen pools + fm_other(ivt) + + + ! nitrogen pools m_leafn_to_litter_fire_p(m) = leafn_p(m) * f * & (1._r8 - cc_leaf(ivt)) * & fm_leaf(ivt) m_leafn_storage_to_litter_fire_p(m) = leafn_storage_p(m) * f * & (1._r8 - cc_other(ivt)) * & - fm_other(ivt) + fm_other(ivt) m_leafn_xfer_to_litter_fire_p(m) = leafn_xfer_p(m) * f * & (1._r8 - cc_other(ivt)) * & fm_other(ivt) @@ -247,7 +247,7 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) fm_droot(ivt) m_livestemn_storage_to_litter_fire_p(m) = livestemn_storage_p(m) * f * & (1._r8 - cc_other(ivt)) * & - fm_other(ivt) + fm_other(ivt) m_livestemn_xfer_to_litter_fire_p(m) = livestemn_xfer_p(m) * f * & (1._r8 - cc_other(ivt)) * & fm_other(ivt) @@ -256,7 +256,7 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) (fm_lstem(ivt)-fm_droot(ivt)) m_deadstemn_to_litter_fire_p(m) = deadstemn_p(m) * f * m * & (1._r8 - cc_dstem(ivt)) * & - fm_droot(ivt) + fm_droot(ivt) m_deadstemn_storage_to_litter_fire_p(m) = deadstemn_storage_p(m) * f * & (1._r8 - cc_other(ivt)) * & fm_other(ivt) @@ -278,7 +278,7 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) fm_other(ivt) m_livecrootn_xfer_to_litter_fire_p(m) = livecrootn_xfer_p(m) * f * & (1._r8 - cc_other(ivt)) * & - fm_other(ivt) + fm_other(ivt) m_livecrootn_to_deadcrootn_fire_p(m) = livecrootn_p(m) * f * & (fm_lroot(ivt)-fm_droot(ivt)) m_deadcrootn_to_litter_fire_p(m) = deadcrootn_p(m) * f * & @@ -291,12 +291,12 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) fm_other(ivt) m_retransn_to_litter_fire_p(m) = retransn_p(m) * f * & (1._r8 - cc_other(ivt)) * & - fm_other(ivt) - - ENDDO ! END of patches loop - + fm_other(ivt) + + ENDDO ! END of patches loop + ! fire-induced transfer of carbon and nitrogen pools to litter and cwd - + DO j = 1,nl_soil fire_mortality_to_cwdc (j,i) = 0._r8 fire_mortality_to_cwdn (j,i) = 0._r8 @@ -310,8 +310,8 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) m_deadstemn_to_litter_fire_p(m) * stem_prof_p(j,m) * pftfrac(m) fire_mortality_to_cwdn(j,i) = fire_mortality_to_cwdn(j,i) + & m_deadcrootn_to_litter_fire_p(m) * croot_prof_p(j,m) * pftfrac(m) - - + + fire_mortality_to_cwdc(j,i) = fire_mortality_to_cwdc(j,i) + & m_livestemc_to_litter_fire_p(m) * stem_prof_p(j,m) * pftfrac(m) fire_mortality_to_cwdc(j,i) = fire_mortality_to_cwdc(j,i) + & @@ -320,8 +320,8 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) m_livestemn_to_litter_fire_p(m) * stem_prof_p(j,m) * pftfrac(m) fire_mortality_to_cwdn(j,i) = fire_mortality_to_cwdn(j,i) + & m_livecrootn_to_litter_fire_p(m) * croot_prof_p(j,m) * pftfrac(m) - - + + fire_mortality_to_met_c(j,i)=fire_mortality_to_met_c(j,i) & +((m_leafc_to_litter_fire_p(m)*lf_flab(ivt) & + m_leafc_storage_to_litter_fire_p(m) & @@ -345,7 +345,7 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) fire_mortality_to_lig_c(j,i)=fire_mortality_to_lig_c(j,i) & + (m_leafc_to_litter_fire_p(m)*lf_flig(ivt)*leaf_prof_p(j,m) & + m_frootc_to_litter_fire_p(m)*fr_flig(ivt)*froot_prof_p(j,m)) * pftfrac(m) - + fire_mortality_to_met_n(j,i)=fire_mortality_to_met_n(j,i) & + ((m_leafn_to_litter_fire_p(m)*lf_flab(ivt) & + m_leafn_storage_to_litter_fire_p(m) & @@ -371,7 +371,7 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) ENDDO ENDDO ! - ! vertically-resolved decomposing C/N fire loss + ! vertically-resolved decomposing C/N fire loss ! column loop ! DO j = 1, nl_soil @@ -386,7 +386,7 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) (f-baf_crop(i)) * cmb_cmplt_fact(cwd_fp) ENDIF ENDDO - + ! nitrogen fluxes DO l = 1, ndecomp_pools IF ( is_litter(l) ) THEN @@ -398,7 +398,7 @@ SUBROUTINE CNFireFluxes(i,ps,pe,dlat,nl_soil,ndecomp_pools) (f-baf_crop(i)) * cmb_cmplt_fact(cwd_fp) ENDIF ENDDO - + ENDDO ! Carbon loss due to peat fires ! diff --git a/main/BGC/MOD_BGC_Veg_CNFireLi2016.F90 b/main/BGC/MOD_BGC_Veg_CNFireLi2016.F90 index f640a5c9..d458cf15 100644 --- a/main/BGC/MOD_BGC_Veg_CNFireLi2016.F90 +++ b/main/BGC/MOD_BGC_Veg_CNFireLi2016.F90 @@ -17,7 +17,7 @@ MODULE MOD_BGC_Veg_CNFireLi2016 ! The Community Land Model version 5.0 (CLM5) ! ! !REVISION: -! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code sturcture. +! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code structure. USE MOD_Precision USE MOD_TimeManager @@ -47,9 +47,9 @@ MODULE MOD_BGC_Veg_CNFireLi2016 livecrootc_p, livecrootc_storage_p, livecrootc_xfer_p USE MOD_Eroot, only: eroot USE MOD_Qsadv - + IMPLICIT NONE - + PUBLIC CNFireArea CONTAINS @@ -102,14 +102,14 @@ SUBROUTINE CNFireArea(i,ps,pe,dlat,nl_soil,idate,dz_soi) wf2 = 0.5 ! Temporarily set up, need to revise later. fsat = 0 ! Temporarily set up, need to revise later. rh30 = 0 ! Temporarily set up, need to revise later. - + CALL julian2monthday(idate(1),idate(2),kmo,kda) - + DO m = ps, pe CALL eroot(nl_soil,0._r8,porsl(1:,i),& -#ifdef Campbell_SOIL_MODEL +#ifdef Campbell_SOIL_MODEL bsw(1:,i),& -#endif +#endif #ifdef vanGenuchten_Mualem_SOIL_MODEL theta_r(1:,i), alpha_vgm(1:,i), n_vgm(1:,i), L_vgm(1:,i), sc_vgm(1:,i), fc_vgm(1:,i), & #endif @@ -123,7 +123,7 @@ SUBROUTINE CNFireArea(i,ps,pe,dlat,nl_soil,idate,dz_soi) ! cropf(i) = 0._r8 lfwt (i) = 0._r8 - + ! For crop veg types DO m = ps, pe IF( iscrop(pftclass(m)) )THEN @@ -134,12 +134,12 @@ SUBROUTINE CNFireArea(i,ps,pe,dlat,nl_soil,idate,dz_soi) lfwt (i) = lfwt(i) + pftfrac(m) ENDIF ENDDO - + ! ! Calculate crop fuel ! fuelc_crop(i)=0._r8 - + ! For crop PFTs, fuel load includes leaf and litter; only ! column-level litter carbon ! is available, so we use leaf carbon to estimate the @@ -162,31 +162,31 @@ SUBROUTINE CNFireArea(i,ps,pe,dlat,nl_soil,idate,dz_soi) wtlf (i) = 0._r8 trotr1(i) = 0._r8 trotr2(i) = 0._r8 - + ! Warning : ivt is not initialized. ! For non-crop -- natural vegetation and bare-soil IF( isnatveg(ivt) .or. isbare(ivt) )THEN IF (btran2 <= 1._r8 ) THEN wtlf(i) = 1._r8 ENDIF - + IF( isbetr(ivt) )THEN trotr1(i)=1._r8 ENDIF IF( isbdtr(ivt) .and. abs(dlat) .lt. troplat)THEN trotr2(i)=1._r8 ENDIF - + rootc(i) = rootc(i) + sum((frootc_p(ps:pe) + frootc_storage_p(ps:pe) + & frootc_xfer_p(ps:pe) + deadcrootc_p(ps:pe) + & deadcrootc_storage_p(ps:pe) + deadcrootc_xfer_p(ps:pe) + & livecrootc_p(ps:pe)+livecrootc_storage_p(ps:pe) + & livecrootc_xfer_p(ps:pe)) * pftfrac(ps:pe)) - + fsr(i) = fsr_pft(ivt) - + ! all these constants are in Li et al. BG (2012a,b;2013) - + IF( hdm_lf(i) > 0.1_r8 )THEN ! For not bare-soil IF(.not. isbare(ivt) )THEN @@ -224,34 +224,34 @@ SUBROUTINE CNFireArea(i,ps,pe,dlat,nl_soil,idate,dz_soi) lgdp1(i) = lgdp1(i) + 1._r8/(1._r8-cropf(i)) lpop(i) = lpop(i) + 1._r8/(1._r8-cropf(i)) ENDIF - + fd(i) = fd_pft(ivt) * secsphr / (1.0_r8-cropf(i)) ENDIF ! ! calculate burned area fraction in cropland ! baf_crop(i)=0._r8 - + DO m = ps, pe IF( kmo == 1 .and. kda == 1 .and. idate(3) == 0 )THEN burndate_p(m) = 10000 ! init. value; actual range [0 365] ENDIF ENDDO - + ! For crop DO m = ps, pe IF( forc_t(i) >= tfrz .and. iscrop(ivt) .and. & kmo == abm_lf(i) .and. burndate_p(m) >= 999)THEN ! catch crop burn time - + ! calculate human density impact on ag. fire fhd = 0.04_r8+0.96_r8*exp(-1._r8*PI*(hdm_lf(i)/350._r8)**0.5_r8) - + ! calculate impact of GDP on ag. fire fgdp = 0.01_r8+0.99_r8*exp(-1._r8*PI*(gdp_lf(i)/10._r8)) - + ! calculate burned area fb = max(0.0_r8,min(1.0_r8,(fuelc_crop(i)-lfuel)/(ufuel-lfuel))) - + ! crop fire only for generic crop types at this time ! managed crops are treated as grasses IF crop model is turned on baf_crop(i) = baf_crop(i) + cropfire_a1/secsphr*fhd*fgdp @@ -260,7 +260,7 @@ SUBROUTINE CNFireArea(i,ps,pe,dlat,nl_soil,idate,dz_soi) ENDIF ENDIF ENDDO - + ! ! calculate peatland fire ! @@ -276,10 +276,10 @@ SUBROUTINE CNFireArea(i,ps,pe,dlat,nl_soil,idate,dz_soi) ! ! calculate other fires ! - + CALL qsadv(forc_t(i),forc_psrf(i),eq,deqdT,qsatq,qsatqdT) forc_rh = forc_q(i) / eq - + IF( cropf(i) < 1._r8 )THEN fuelc(i) = totlitc(i)+totvegc(i)-rootc(i)-fuelc_crop(i)*cropf(i) DO j = 1, nl_soil diff --git a/main/BGC/MOD_BGC_Veg_CNGResp.F90 b/main/BGC/MOD_BGC_Veg_CNGResp.F90 index cf435b28..4623f5d0 100644 --- a/main/BGC/MOD_BGC_Veg_CNGResp.F90 +++ b/main/BGC/MOD_BGC_Veg_CNGResp.F90 @@ -4,25 +4,25 @@ MODULE MOD_BGC_Veg_CNGResp !----------------------------------------------------------------------------------------------------- ! !DESCRIPTION: -! This module cacluate growth respiration rate. +! This module calculate growth respiration rate. ! ! !REFERENCE: -! Atkin, O.K., Bahar, N.H., Bloomfield, K.J., Griffin, K.L., Heskel, M.A., Huntingford, C., de la Torre, A.M. -! and Turnbull, M.H., 2017. Leaf respiration in terrestrial biosphere models. Plant respiration: metabolic +! Atkin, O.K., Bahar, N.H., Bloomfield, K.J., Griffin, K.L., Heskel, M.A., Huntingford, C., de la Torre, A.M. +! and Turnbull, M.H., 2017. Leaf respiration in terrestrial biosphere models. Plant respiration: metabolic ! fluxes and carbon balance, pp.107-142. ! ! !ORIGINAL: ! The Community Land Model version 5.0 (CLM5) ! ! !REVISION: -! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code sturcture. +! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code structure. USE MOD_Precision USE MOD_Const_PFT, only: & grperc, grpnow, woody - + USE MOD_Vars_PFTimeInvariants, only: pftclass - + USE MOD_BGC_Vars_1DPFTFluxes, only: & cpool_to_leafc_p , cpool_to_leafc_storage_p , leafc_xfer_to_leafc_p , & cpool_to_frootc_p , cpool_to_frootc_storage_p , frootc_xfer_to_frootc_p , & @@ -37,10 +37,10 @@ MODULE MOD_BGC_Veg_CNGResp cpool_deadstem_gr_p , cpool_deadstem_storage_gr_p , transfer_deadstem_gr_p , & cpool_livecroot_gr_p , cpool_livecroot_storage_gr_p , transfer_livecroot_gr_p , & cpool_deadcroot_gr_p , cpool_deadcroot_storage_gr_p , transfer_deadcroot_gr_p , & - cpool_grain_gr_p , cpool_grain_storage_gr_p , transfer_grain_gr_p - + cpool_grain_gr_p , cpool_grain_storage_gr_p , transfer_grain_gr_p + IMPLICIT NONE - + PUBLIC CNGResp CONTAINS @@ -78,57 +78,57 @@ SUBROUTINE CNGResp(i, ps, pe, npcropmin) respfact_livestem_storage = 1.0_r8 respfact_livecroot_storage = 1.0_r8 respfact_livestem_storage = 1.0_r8 - + IF (ivt >= npcropmin) THEN ! skip 2 generic crops cpool_livestem_gr_p (m) = cpool_to_livestemc_p (m) * grperc(ivt) * respfact_livestem - + cpool_livestem_storage_gr_p (m) = cpool_to_livestemc_storage_p (m) * grperc(ivt) * grpnow(ivt) * respfact_livestem_storage - + transfer_livestem_gr_p (m) = livestemc_xfer_to_livestemc_p (m) * grperc(ivt) * (1._r8 - grpnow(ivt)) * respfact_livestem_storage - + cpool_grain_gr_p (m) = cpool_to_grainc_p (m) * grperc(ivt) - + cpool_grain_storage_gr_p (m) = cpool_to_grainc_storage_p (m) * grperc(ivt) * grpnow(ivt) - + transfer_grain_gr_p (m) = grainc_xfer_to_grainc_p (m) * grperc(ivt) * (1._r8 - grpnow(ivt)) ENDIF - + ! leaf and fine root growth respiration cpool_leaf_gr_p (m) = cpool_to_leafc_p (m) * grperc(ivt) * respfact_leaf - + cpool_leaf_storage_gr_p (m) = cpool_to_leafc_storage_p (m) * grperc(ivt) * grpnow(ivt) * respfact_leaf_storage - + transfer_leaf_gr_p (m) = leafc_xfer_to_leafc_p (m) * grperc(ivt) * (1._r8 - grpnow(ivt)) * respfact_leaf_storage - + cpool_froot_gr_p (m) = cpool_to_frootc_p (m) * grperc(ivt) * respfact_froot * respfact_froot - + cpool_froot_storage_gr_p (m) = cpool_to_frootc_storage_p (m) * grperc(ivt) * grpnow(ivt) * respfact_froot_storage - + transfer_froot_gr_p (m) = frootc_xfer_to_frootc_p (m) * grperc(ivt) * (1._r8 - grpnow(ivt)) * respfact_froot_storage - + IF (woody(ivt) == 1._r8) THEN cpool_livestem_gr_p (m) = cpool_to_livestemc_p (m) * grperc(ivt) * respfact_livestem - + cpool_livestem_storage_gr_p (m) = cpool_to_livestemc_storage_p (m) * grperc(ivt) * grpnow(ivt) * respfact_livestem_storage - + transfer_livestem_gr_p (m) = livestemc_xfer_to_livestemc_p (m) * grperc(ivt) * (1._r8 - grpnow(ivt)) * respfact_livestem_storage - + cpool_deadstem_gr_p (m) = cpool_to_deadstemc_p (m) * grperc(ivt) - + cpool_deadstem_storage_gr_p (m) = cpool_to_deadstemc_storage_p (m) * grperc(ivt) * grpnow(ivt) - + transfer_deadstem_gr_p (m) = deadstemc_xfer_to_deadstemc_p (m) * grperc(ivt) * (1._r8 - grpnow(ivt)) - + cpool_livecroot_gr_p (m) = cpool_to_livecrootc_p (m) * grperc(ivt) * respfact_livecroot - + cpool_livecroot_storage_gr_p(m) = cpool_to_livecrootc_storage_p (m) * grperc(ivt) * grpnow(ivt) * respfact_livecroot_storage - + transfer_livecroot_gr_p (m) = livecrootc_xfer_to_livecrootc_p(m) * grperc(ivt) * (1._r8 - grpnow(ivt)) * respfact_livecroot_storage - + cpool_deadcroot_gr_p (m) = cpool_to_deadcrootc_p (m) * grperc(ivt) - + cpool_deadcroot_storage_gr_p(m) = cpool_to_deadcrootc_storage_p (m) * grperc(ivt) * grpnow(ivt) - + transfer_deadcroot_gr_p (m) = deadcrootc_xfer_to_deadcrootc_p(m) * grperc(ivt) * (1._r8 - grpnow(ivt)) ENDIF ENDDO diff --git a/main/BGC/MOD_BGC_Veg_CNGapMortality.F90 b/main/BGC/MOD_BGC_Veg_CNGapMortality.F90 index 88ba59fe..b4f22dfb 100644 --- a/main/BGC/MOD_BGC_Veg_CNGapMortality.F90 +++ b/main/BGC/MOD_BGC_Veg_CNGapMortality.F90 @@ -11,7 +11,7 @@ MODULE MOD_BGC_Veg_CNGapMortality ! The Community Land Model version 5.0 (CLM5) ! ! !REVISION: -! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code sturcture. +! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code structure. USE MOD_Precision USE MOD_Const_PFT, only: lf_flab, lf_fcel, lf_flig, fr_flab, fr_fcel, fr_flig @@ -19,16 +19,16 @@ MODULE MOD_BGC_Veg_CNGapMortality ! bgc constants am USE MOD_Vars_PFTimeInvariants, only: pftclass, pftfrac - + USE MOD_BGC_Vars_1DFluxes, only: & ! decomposition carbon flux varables (in) gap_mortality_to_met_c, gap_mortality_to_cel_c , & gap_mortality_to_lig_c, gap_mortality_to_cwdc , & - + ! decompositionn nitrogen fluxes variables (inout) gap_mortality_to_met_n, gap_mortality_to_cel_n , & - gap_mortality_to_lig_n, gap_mortality_to_cwdn - + gap_mortality_to_lig_n, gap_mortality_to_cwdn + USE MOD_BGC_Vars_1DPFTFluxes, only: & ! vegetation carbon flux variables m_leafc_to_litter_p , m_leafc_storage_to_litter_p , m_leafc_xfer_to_litter_p , & @@ -38,7 +38,7 @@ MODULE MOD_BGC_Veg_CNGapMortality m_livecrootc_to_litter_p , m_livecrootc_storage_to_litter_p, m_livecrootc_xfer_to_litter_p, & m_deadcrootc_to_litter_p , m_deadcrootc_storage_to_litter_p, m_deadcrootc_xfer_to_litter_p, & m_gresp_storage_to_litter_p, m_gresp_xfer_to_litter_p , & - + ! vegetation nitrogen flux variables m_leafn_to_litter_p , m_leafn_storage_to_litter_p , m_leafn_xfer_to_litter_p , & m_frootn_to_litter_p , m_frootn_storage_to_litter_p , m_frootn_xfer_to_litter_p , & @@ -47,7 +47,7 @@ MODULE MOD_BGC_Veg_CNGapMortality m_livecrootn_to_litter_p , m_livecrootn_storage_to_litter_p, m_livecrootn_xfer_to_litter_p, & m_deadcrootn_to_litter_p , m_deadcrootn_storage_to_litter_p, m_deadcrootn_xfer_to_litter_p, & m_retransn_to_litter_p - + USE MOD_BGC_Vars_PFTimeVariables, only: & ! vegetation carbon state variables (inout) leafc_p , leafc_storage_p , leafc_xfer_p , & @@ -57,7 +57,7 @@ MODULE MOD_BGC_Veg_CNGapMortality livecrootc_p , livecrootc_storage_p, livecrootc_xfer_p, & deadcrootc_p , deadcrootc_storage_p, deadcrootc_xfer_p, & gresp_storage_p , gresp_xfer_p , & - + ! vegetation nitrogen state variables (inout) leafn_p , leafn_storage_p , leafn_xfer_p , & frootn_p , frootn_storage_p , frootn_xfer_p , & @@ -66,14 +66,14 @@ MODULE MOD_BGC_Veg_CNGapMortality livecrootn_p , livecrootn_storage_p, livecrootn_xfer_p, & deadcrootn_p , deadcrootn_storage_p, deadcrootn_xfer_p, & retransn_p , & - + ! profiles leaf_prof_p, stem_prof_p, froot_prof_p, croot_prof_p - + IMPLICIT NONE - + PUBLIC CNGapMortality - + PRIVATE CNGap_VegToLitter CONTAINS @@ -91,13 +91,13 @@ SUBROUTINE CNGapMortality(i, ps, pe, nl_soil, npcropmin) DO m = ps , pe ivt = pftclass(m) - + mort = am/(365._r8 * 86400._r8) - + !------------------------------------------------------ ! pft-level gap mortality carbon fluxes !------------------------------------------------------ - + ! displayed pools m_leafc_to_litter_p (m) = leafc_p (m) * mort m_frootc_to_litter_p (m) = frootc_p (m) * mort @@ -105,7 +105,7 @@ SUBROUTINE CNGapMortality(i, ps, pe, nl_soil, npcropmin) m_livecrootc_to_litter_p (m) = livecrootc_p (m) * mort m_deadstemc_to_litter_p (m) = deadstemc_p (m) * mort m_deadcrootc_to_litter_p (m) = deadcrootc_p (m) * mort - + ! storage pools m_leafc_storage_to_litter_p (m) = leafc_storage_p (m) * mort m_frootc_storage_to_litter_p (m) = frootc_storage_p (m) * mort @@ -114,7 +114,7 @@ SUBROUTINE CNGapMortality(i, ps, pe, nl_soil, npcropmin) m_livecrootc_storage_to_litter_p(m) = livecrootc_storage_p(m) * mort m_deadcrootc_storage_to_litter_p(m) = deadcrootc_storage_p(m) * mort m_gresp_storage_to_litter_p (m) = gresp_storage_p (m) * mort - + ! transfer pools m_leafc_xfer_to_litter_p (m) = leafc_xfer_p (m) * mort m_frootc_xfer_to_litter_p (m) = frootc_xfer_p (m) * mort @@ -123,24 +123,24 @@ SUBROUTINE CNGapMortality(i, ps, pe, nl_soil, npcropmin) m_livecrootc_xfer_to_litter_p (m) = livecrootc_xfer_p (m) * mort m_deadcrootc_xfer_to_litter_p (m) = deadcrootc_xfer_p (m) * mort m_gresp_xfer_to_litter_p (m) = gresp_xfer_p (m) * mort - + !------------------------------------------------------ ! pft-level gap mortality nitrogen fluxes !------------------------------------------------------ - + ! displayed pools m_leafn_to_litter_p (m) = leafn_p (m) * mort m_frootn_to_litter_p (m) = frootn_p (m) * mort m_livestemn_to_litter_p (m) = livestemn_p (m) * mort m_livecrootn_to_litter_p (m) = livecrootn_p (m) * mort - + m_deadstemn_to_litter_p (m) = deadstemn_p (m) * mort m_deadcrootn_to_litter_p (m) = deadcrootn_p (m) * mort - + IF (ivt < npcropmin) THEN m_retransn_to_litter_p (m) = retransn_p (m) * mort ENDIF - + ! storage pools m_leafn_storage_to_litter_p (m) = leafn_storage_p (m) * mort m_frootn_storage_to_litter_p (m) = frootn_storage_p (m) * mort @@ -148,7 +148,7 @@ SUBROUTINE CNGapMortality(i, ps, pe, nl_soil, npcropmin) m_deadstemn_storage_to_litter_p (m) = deadstemn_storage_p (m) * mort m_livecrootn_storage_to_litter_p(m) = livecrootn_storage_p(m) * mort m_deadcrootn_storage_to_litter_p(m) = deadcrootn_storage_p(m) * mort - + ! transfer pools m_leafn_xfer_to_litter_p (m) = leafn_xfer_p (m) * mort m_frootn_xfer_to_litter_p (m) = frootn_xfer_p (m) * mort @@ -157,7 +157,7 @@ SUBROUTINE CNGapMortality(i, ps, pe, nl_soil, npcropmin) m_livecrootn_xfer_to_litter_p (m) = livecrootn_xfer_p (m) * mort m_deadcrootn_xfer_to_litter_p (m) = deadcrootn_xfer_p (m) * mort ENDDO - + CALL CNGap_VegToLitter(i, ps, pe, nl_soil) END SUBROUTINE CNGapMortality @@ -168,7 +168,7 @@ SUBROUTINE CNGap_VegToLitter(i, ps, pe, nl_soil) integer ,intent(in) :: ps integer ,intent(in) :: pe integer ,intent(in) :: nl_soil - + integer j,m,ivt real(r8) :: wtcol @@ -176,7 +176,7 @@ SUBROUTINE CNGap_VegToLitter(i, ps, pe, nl_soil) DO m = ps, pe ivt = pftclass(m) wtcol = pftfrac(m) - + ! leaf gap mortality carbon fluxes gap_mortality_to_met_c(j,i) = gap_mortality_to_met_c(j,i) + & m_leafc_to_litter_p(m) * lf_flab(ivt) * wtcol * leaf_prof_p(j,m) @@ -184,7 +184,7 @@ SUBROUTINE CNGap_VegToLitter(i, ps, pe, nl_soil) m_leafc_to_litter_p(m) * lf_fcel(ivt) * wtcol * leaf_prof_p(j,m) gap_mortality_to_lig_c(j,i) = gap_mortality_to_lig_c(j,i) + & m_leafc_to_litter_p(m) * lf_flig(ivt) * wtcol * leaf_prof_p(j,m) - + ! fine root gap mortality carbon fluxes gap_mortality_to_met_c(j,i) = gap_mortality_to_met_c(j,i) + & m_frootc_to_litter_p(m) * fr_flab(ivt) * wtcol * froot_prof_p(j,m) @@ -192,13 +192,13 @@ SUBROUTINE CNGap_VegToLitter(i, ps, pe, nl_soil) m_frootc_to_litter_p(m) * fr_fcel(ivt) * wtcol * froot_prof_p(j,m) gap_mortality_to_lig_c(j,i) = gap_mortality_to_lig_c(j,i) + & m_frootc_to_litter_p(m) * fr_flig(ivt) * wtcol * froot_prof_p(j,m) - + ! wood gap mortality carbon fluxes gap_mortality_to_cwdc(j,i) = gap_mortality_to_cwdc(j,i) + & (m_livestemc_to_litter_p(m) + m_deadstemc_to_litter_p(m)) * wtcol * stem_prof_p(j,m) gap_mortality_to_cwdc(j,i) = gap_mortality_to_cwdc(j,i) + & (m_livecrootc_to_litter_p(m) + m_deadcrootc_to_litter_p(m)) * wtcol * croot_prof_p(j,m) - + ! storage gap mortality carbon fluxes gap_mortality_to_met_c(j,i) = gap_mortality_to_met_c(j,i) + & (m_leafc_storage_to_litter_p(m) + m_gresp_storage_to_litter_p(m)) * wtcol * leaf_prof_p(j,m) @@ -208,7 +208,7 @@ SUBROUTINE CNGap_VegToLitter(i, ps, pe, nl_soil) (m_livestemc_storage_to_litter_p(m) + m_deadstemc_storage_to_litter_p(m)) * wtcol * stem_prof_p(j,m) gap_mortality_to_met_c(j,i) = gap_mortality_to_met_c(j,i) + & (m_livecrootc_storage_to_litter_p(m) + m_deadcrootc_storage_to_litter_p(m)) * wtcol * croot_prof_p(j,m) - + ! transfer gap mortality carbon fluxes gap_mortality_to_met_c(j,i) = gap_mortality_to_met_c(j,i) + & (m_leafc_xfer_to_litter_p(m) + m_gresp_xfer_to_litter_p(m)) * wtcol * leaf_prof_p(j,m) @@ -218,7 +218,7 @@ SUBROUTINE CNGap_VegToLitter(i, ps, pe, nl_soil) (m_livestemc_xfer_to_litter_p(m) + m_deadstemc_xfer_to_litter_p(m)) * wtcol * stem_prof_p(j,m) gap_mortality_to_met_c(j,i) = gap_mortality_to_met_c(j,i) + & (m_livecrootc_xfer_to_litter_p(m) + m_deadcrootc_xfer_to_litter_p(m)) * wtcol * croot_prof_p(j,m) - + ! leaf gap mortality nitrogen fluxes gap_mortality_to_met_n(j,i) = gap_mortality_to_met_n(j,i) + & m_leafn_to_litter_p(m) * lf_flab(ivt) * wtcol * leaf_prof_p(j,m) @@ -226,7 +226,7 @@ SUBROUTINE CNGap_VegToLitter(i, ps, pe, nl_soil) m_leafn_to_litter_p(m) * lf_fcel(ivt) * wtcol * leaf_prof_p(j,m) gap_mortality_to_lig_n(j,i) = gap_mortality_to_lig_n(j,i) + & m_leafn_to_litter_p(m) * lf_flig(ivt) * wtcol * leaf_prof_p(j,m) - + ! fine root litter nitrogen fluxes gap_mortality_to_met_n(j,i) = gap_mortality_to_met_n(j,i) + & m_frootn_to_litter_p(m) * fr_flab(ivt) * wtcol * froot_prof_p(j,m) @@ -234,17 +234,17 @@ SUBROUTINE CNGap_VegToLitter(i, ps, pe, nl_soil) m_frootn_to_litter_p(m) * fr_fcel(ivt) * wtcol * froot_prof_p(j,m) gap_mortality_to_lig_n(j,i) = gap_mortality_to_lig_n(j,i) + & m_frootn_to_litter_p(m) * fr_flig(ivt) * wtcol * froot_prof_p(j,m) - + ! wood gap mortality nitrogen fluxes gap_mortality_to_cwdn(j,i) = gap_mortality_to_cwdn(j,i) + & (m_livestemn_to_litter_p(m) + m_deadstemn_to_litter_p(m)) * wtcol * stem_prof_p(j,m) gap_mortality_to_cwdn(j,i) = gap_mortality_to_cwdn(j,i) + & (m_livecrootn_to_litter_p(m) + m_deadcrootn_to_litter_p(m)) * wtcol * croot_prof_p(j,m) - + ! retranslocated N pool gap mortality fluxes gap_mortality_to_met_n(j,i) = gap_mortality_to_met_n(j,i) + & m_retransn_to_litter_p(m) * wtcol * leaf_prof_p(j,m) - + ! storage gap mortality nitrogen fluxes gap_mortality_to_met_n(j,i) = gap_mortality_to_met_n(j,i) + & m_leafn_storage_to_litter_p(m) * wtcol * leaf_prof_p(j,m) @@ -254,7 +254,7 @@ SUBROUTINE CNGap_VegToLitter(i, ps, pe, nl_soil) (m_livestemn_storage_to_litter_p(m) + m_deadstemn_storage_to_litter_p(m)) * wtcol * stem_prof_p(j,m) gap_mortality_to_met_n(j,i) = gap_mortality_to_met_n(j,i) + & (m_livecrootn_storage_to_litter_p(m) + m_deadcrootn_storage_to_litter_p(m)) * wtcol * croot_prof_p(j,m) - + ! transfer gap mortality nitrogen fluxes gap_mortality_to_met_n(j,i) = gap_mortality_to_met_n(j,i) + & m_leafn_xfer_to_litter_p(m) * wtcol * leaf_prof_p(j,m) @@ -264,7 +264,7 @@ SUBROUTINE CNGap_VegToLitter(i, ps, pe, nl_soil) (m_livestemn_xfer_to_litter_p(m) + m_deadstemn_xfer_to_litter_p(m)) * wtcol * stem_prof_p(j,m) gap_mortality_to_met_n(j,i) = gap_mortality_to_met_n(j,i) + & (m_livecrootn_xfer_to_litter_p(m) + m_deadcrootn_xfer_to_litter_p(m)) * wtcol * croot_prof_p(j,m) - + ENDDO ENDDO diff --git a/main/BGC/MOD_BGC_Veg_CNMResp.F90 b/main/BGC/MOD_BGC_Veg_CNMResp.F90 index c5ce4ebc..302ae098 100644 --- a/main/BGC/MOD_BGC_Veg_CNMResp.F90 +++ b/main/BGC/MOD_BGC_Veg_CNMResp.F90 @@ -4,7 +4,7 @@ MODULE MOD_BGC_Veg_CNMResp !----------------------------------------------------------------------------------------------------- ! !DESCRIPTION: -! This module calculates plant maintenance respiration +! This module calculates plant maintenance respiration ! ! !REFERENCE: ! Atkin OK, Bloomfield KJ, Reich PB, Tjoelker MG, Asner GP, Bonal D et al (2015) Global variability in leaf respiration @@ -14,7 +14,7 @@ MODULE MOD_BGC_Veg_CNMResp ! The Community Land Model version 5.0 (CLM5) ! ! !REVISION: -! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code sturcture. +! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code structure. USE MOD_Precision USE MOD_BGC_Vars_TimeInvariants, only: & @@ -32,9 +32,9 @@ MODULE MOD_BGC_Veg_CNMResp leaf_mr_p, froot_mr_p, livestem_mr_p, livecroot_mr_p, grain_mr_p USE MOD_Const_PFT, only: & woody, rootfr_p - + IMPLICIT NONE - + PUBLIC CNMResp CONTAINS @@ -68,22 +68,22 @@ SUBROUTINE CNMResp(i, ps, pe, nl_soil, npcropmin) ! column loop to calculate temperature factors in each soil layer DO j=1,nl_soil - + ! calculate temperature corrections for each soil layer, for USE in ! estimating fine root maintenance respiration with depth tcsoi(j) = Q10**((t_soisno(j,i) - 273.15_r8 - 20.0_r8)/10.0_r8) ENDDO - + ! calculate maintenance respiration fluxes in ! gC/m2/s for each of the live plant tissues. ! Leaf and live wood MR - + tc = Q10**((tref(i) - 273.15_r8 - 20.0_r8)/10.0_r8) - + !RF: acclimation of root and stem respiration fluxes ! n.b. we DO not yet know IF this is defensible scientifically (awaiting data analysis) ! turning this on will increase R and decrease productivity in boreal forests, A LOT. :) - + DO m = ps, pe ivt = pftclass(m) IF (sigf_p(m) == 1) THEN @@ -91,7 +91,7 @@ SUBROUTINE CNMResp(i, ps, pe, nl_soil, npcropmin) ELSE !nosno leaf_mr_p(m) = 0._r8 ENDIF - + IF (woody(ivt) == 1) THEN livestem_mr_p (m) = livestemn_p (m)*br*tc livecroot_mr_p(m) = livecrootn_p(m)*br_root*tc @@ -100,9 +100,9 @@ SUBROUTINE CNMResp(i, ps, pe, nl_soil, npcropmin) grain_mr_p (m) = grainn_p (m)*br*tc ENDIF ! soil and patch loop for fine root - + DO j = 1,nl_soil - + ! Fine root MR ! crootfr(j) sums to 1.0 over all soil layers, and ! describes the fraction of root mass for carbon that is in each diff --git a/main/BGC/MOD_BGC_Veg_CNNDynamics.F90 b/main/BGC/MOD_BGC_Veg_CNNDynamics.F90 index 9e8fd293..9f3c3fec 100644 --- a/main/BGC/MOD_BGC_Veg_CNNDynamics.F90 +++ b/main/BGC/MOD_BGC_Veg_CNNDynamics.F90 @@ -4,8 +4,8 @@ MODULE MOD_BGC_Veg_CNNDynamics !--------------------------------------------------------------------------------------------------------- ! !DESCRIPTION: -! This MODULE simulates the plant biological fixation (Cleveland et al., 1999), -! crop fertilisatoin(Lawrence et al., 2016, and soy nitrogen fixation (Neitsch et al., 2005). +! This MODULE simulates the plant biological fixation (Cleveland et al., 1999), +! crop fertilisation (Lawrence et al., 2016, and soy nitrogen fixation (Neitsch et al., 2005). ! ! !REFERENCE: ! Cleveland, C.C., Townsend, A.R., Schimel, D.S., Fisher, H., Howarth, R.W., Hedin, L.O., Perakis, S.S., Latty, E.F., @@ -15,24 +15,24 @@ MODULE MOD_BGC_Veg_CNNDynamics ! Noblet-Ducoudré, N., Pongratz, J., Seneviratne, S.I., and Shevliakova, E. 2016. The Land USE Model Intercomparison ! Project (LUMIP) contribution to CMIP6: rationale and experimental design. Geosci. Model Dev. 9:2973-2998. ! DOI:10.5194/gmd-9-2973-2016. -! Neitsch, S.L., Arnold, J.G., Kiniry, J.R., and Williams J.R. 2005. Soil and Water Assessment Tool, -! Theoretical Documentation: Version 2005. Temple, TX. USDA Agricultural Research Service and +! Neitsch, S.L., Arnold, J.G., Kiniry, J.R., and Williams J.R. 2005. Soil and Water Assessment Tool, +! Theoretical Documentation: Version 2005. Temple, TX. USDA Agricultural Research Service and ! Texas A&M Blackland Research Center. ! ! !ORIGINAL: ! The Community Land Model version 5.0 (CLM5) ! ! !REVISION: -! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code sturcture. +! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code structure. USE MOD_Precision - + USE MOD_Vars_PFTimeInvariants, only: pftclass, pftfrac USE MOD_Vars_TimeInvariants, only: porsl, psi0, bsw USE MOD_Vars_TimeVariables, only: h2osoi - + USE MOD_BGC_Vars_1DFluxes, only: fert_to_sminn, soyfixn_to_sminn, nfix_to_sminn - + USE MOD_BGC_Vars_TimeVariables, only: sminn, fpg, lag_npp #ifdef CROP USE MOD_BGC_Vars_PFTimeVariables, only: croplive_p, hui_p @@ -40,11 +40,11 @@ MODULE MOD_BGC_Veg_CNNDynamics #endif USE MOD_BGC_Vars_1DPFTFluxes, only: plant_ndemand_p, soyfixn_p - + USE MOD_Vars_Global, only: z_soi, dz_soi, spval USE MOD_TimeManager IMPLICIT NONE - + PUBLIC CNNFixation #ifdef CROP PUBLIC CNNFert @@ -64,7 +64,7 @@ SUBROUTINE CNNFixation(i,idate) ELSE dayspyr = 365 ENDIF - + IF (lag_npp(i) /= spval) THEN ! need to put npp in units of gC/m^2/year here first t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * lag_npp(i)*(86400._r8 * dayspyr))))/(86400._r8 * dayspyr) @@ -106,11 +106,11 @@ SUBROUTINE CNSoyfix (i, ps, pe, nl_soil) GDDfracthreshold2 = 0.30_r8 GDDfracthreshold3 = 0.55_r8 GDDfracthreshold4 = 0.75_r8 - + rwat = 0._r8 swat = 0._r8 rz = 0._r8 - + DO j = 1, nl_soil IF (z_soi(j)+0.5_r8*dz_soi(j) <= 0.05_r8) THEN watdry = porsl(j,i) * (316230._r8/(-psi0(j,i))) ** (-1._r8/bsw(j,i)) @@ -119,27 +119,27 @@ SUBROUTINE CNSoyfix (i, ps, pe, nl_soil) rz = rz + dz_soi(j) ENDIF ENDDO - + tsw = rwat/rz stsw = swat/rz wf = tsw/stsw - + DO m = ps, pe ivt = pftclass(m) - IF(croplive_p(m) .and. ivt == 23 .or. ivt == 24 .or. ivt == 77 .or. ivt == 78)THEN - + IF(croplive_p(m) .and. ivt == 23 .or. ivt == 24 .or. ivt == 77 .or. ivt == 78)THEN + ! difference between supply and demand - + IF(fpg(i) .lt. 1._r8) THEN soy_ndemand = plant_ndemand_p(m) - plant_ndemand_p(m) * fpg(i) - + ! fixation depends on nitrogen, soil water, and growth stage ! soil water factor - + fxw = wf / 0.85_r8 - + ! soil nitrogen factor (Beth says: CHECK UNITS) - + IF (sminn(i) .gt. sminnthreshold1) THEN fxn = 0._r8 ELSE IF (sminn(i) > sminnthreshold2 .and. sminn(i) <= sminnthreshold1) THEN @@ -147,9 +147,9 @@ SUBROUTINE CNSoyfix (i, ps, pe, nl_soil) ELSE IF (sminn(i) <= sminnthreshold2) THEN fxn = 1._r8 ENDIF - + ! growth stage factor - + IF (hui_p(m) <= GDDfracthreshold1) THEN fxg = 0._r8 ELSE IF (hui_p(m) > GDDfracthreshold1 .and. hui_p(m) <= GDDfracthreshold2) THEN @@ -158,25 +158,25 @@ SUBROUTINE CNSoyfix (i, ps, pe, nl_soil) fxg = 1._r8 ELSE IF (hui_p(m) > GDDfracthreshold3 .and. hui_p(m) <= GDDfracthreshold4) THEN fxg = 3.75_r8 - 5._r8 * hui_p(m) - ELSE + ELSE fxg = 0._r8 ENDIF - + ! calculate the nitrogen fixed by the soybean - + fxr = max(0._r8, min(1._r8, fxw, fxn) * fxg) soyfixn_p(m) = min(fxr * soy_ndemand, soy_ndemand) - + ELSE ! IF nitrogen demand met, no fixation - + soyfixn_p(m) = 0._r8 - + ENDIF - + ELSE ! IF not live soybean, no fixation - + soyfixn_p(m) = 0._r8 - + ENDIF ENDDO diff --git a/main/BGC/MOD_BGC_Veg_CNPhenology.F90 b/main/BGC/MOD_BGC_Veg_CNPhenology.F90 index 4d42b4a5..220c603c 100644 --- a/main/BGC/MOD_BGC_Veg_CNPhenology.F90 +++ b/main/BGC/MOD_BGC_Veg_CNPhenology.F90 @@ -12,21 +12,21 @@ MODULE MOD_BGC_Veg_CNPhenology ! The Community Land Model version 5.0 (CLM5) ! ! !REVISION: -! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code sturcture. +! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code structure. ! Fang Li, 2022, implemented GPAM crop model in this MODULE. ! ! !USES: USE MOD_Const_PFT, only: & isevg , issed , isstd , leaf_long, woody , leafcn , frootcn, livewdcn, deadwdcn, & lflitcn, lf_flab, lf_fcel, lf_flig , fr_flab, fr_fcel, fr_flig, & - + ! crop variables manunitro, lfemerg, mxmat, grnfill, baset - + USE MOD_BGC_Vars_TimeInvariants, only: & ndays_on , ndays_off , fstor2tran, crit_dayl , crit_onset_fdd, crit_onset_swi, & crit_offset_fdd , crit_offset_swi, soilpsi_on, soilpsi_off, lwtop, rice2pdt - + USE MOD_Vars_Global, only: & !crop variables nswheat , nirrig_swheat , nsugarcane , nirrig_sugarcane , & @@ -37,33 +37,33 @@ MODULE MOD_BGC_Veg_CNPhenology ntrp_soybean , nirrig_trp_soybean, & spval USE MOD_Const_Physical, only: tfrz - + USE MOD_Vars_TimeVariables, only: & t_soisno, smp - + USE MOD_BGC_Vars_TimeVariables, only: & dayl, prev_dayl, prec10, prec60, prec365, prec_today, prec_daily, accumnstep - + USE MOD_Vars_PFTimeVariables, only: & tref_p ,tlai_p - + USE MOD_BGC_Vars_PFTimeVariables, only: & tempavg_tref_p , annavg_tref_p , gdd0_p , gdd8_p , & gdd10_p , gdd020_p , gdd820_p , gdd1020_p , nyrs_crop_active_p, & bglfr_p , bgtr_p , lgsf_p , offset_flag_p , offset_counter_p , & onset_flag_p , onset_counter_p, onset_gddflag_p, onset_gdd_p , onset_fdd_p , & onset_swi_p , offset_fdd_p , offset_swi_p , dormant_flag_p, & - + prev_leafc_to_litter_p , prev_frootc_to_litter_p , days_active_p , & - + leafc_p , frootc_p , livestemc_p , & livestemn_p , livecrootc_p , grainc_p, grainn_p , & - + leafc_storage_p , frootc_storage_p , livestemc_storage_p , & deadstemc_storage_p, livecrootc_storage_p, deadcrootc_storage_p, & leafn_storage_p , frootn_storage_p , livestemn_storage_p , & deadstemn_storage_p, livecrootn_storage_p, deadcrootn_storage_p, & - + leafc_xfer_p , frootc_xfer_p , livestemc_xfer_p , & deadstemc_xfer_p , livecrootc_xfer_p , deadcrootc_xfer_p , & leafn_xfer_p , frootn_xfer_p , livestemn_xfer_p , & @@ -82,27 +82,27 @@ MODULE MOD_BGC_Veg_CNPhenology leaf_prof_p , froot_prof_p , & cropseedc_deficit_p, cropseedn_deficit_p - - + + USE MOD_BGC_Vars_1DPFTFluxes, only: & livestemc_to_deadstemc_p , livecrootc_to_deadcrootc_p , & - + leafc_storage_to_xfer_p , frootc_storage_to_xfer_p , & livestemc_storage_to_xfer_p , deadstemc_storage_to_xfer_p , & livecrootc_storage_to_xfer_p , deadcrootc_storage_to_xfer_p , & gresp_storage_to_xfer_p , & - + leafc_xfer_to_leafc_p , frootc_xfer_to_frootc_p , & livestemc_xfer_to_livestemc_p , deadstemc_xfer_to_deadstemc_p , & livecrootc_xfer_to_livecrootc_p, deadcrootc_xfer_to_deadcrootc_p, & - + livestemn_to_deadstemn_p , livecrootn_to_deadcrootn_p , & livestemn_to_retransn_p , livecrootn_to_retransn_p , & - + leafn_storage_to_xfer_p , frootn_storage_to_xfer_p , & livestemn_storage_to_xfer_p , deadstemn_storage_to_xfer_p , & livecrootn_storage_to_xfer_p , deadcrootn_storage_to_xfer_p , & - + leafn_xfer_to_leafn_p , frootn_xfer_to_frootn_p , & livestemn_xfer_to_livestemn_p , deadstemn_xfer_to_deadstemn_p , & livecrootn_xfer_to_livecrootn_p, deadcrootn_xfer_to_deadcrootn_p, & @@ -110,33 +110,33 @@ MODULE MOD_BGC_Veg_CNPhenology leafc_to_litter_p , frootc_to_litter_p , & leafn_to_litter_p , frootn_to_litter_p , & leafn_to_retransn_p , & - + crop_seedc_to_leaf_p , crop_seedn_to_leaf_p , & grainc_to_seed_p , grainn_to_seed_p , & grainc_to_food_p , grainn_to_food_p , & cpool_to_grainc_p , npool_to_grainn_p , & livestemc_to_litter_p , livestemn_to_litter_p , & - cpool_to_livestemc_p - + cpool_to_livestemc_p + USE MOD_Vars_PFTimeInvariants, only: pftclass, pftfrac - + USE MOD_BGC_Vars_1DFluxes, only: & phenology_to_met_c , phenology_to_cel_c , phenology_to_lig_c, & phenology_to_met_n , phenology_to_cel_n , phenology_to_lig_n, & grainc_to_cropprodc, grainn_to_cropprodn - + USE MOD_Vars_1DForcing, only: forc_prc, forc_prl - + USE MOD_TimeManager USE MOD_Precision USE MOD_Namelist, only : DEF_USE_FERT USE MOD_BGC_Daylength, only: daylength USE MOD_SPMD_Task - + IMPLICIT NONE - + PUBLIC CNPhenology - + integer, parameter :: NOT_Planted = 999 ! If not planted yet in year integer, parameter :: NOT_Harvested = 999 ! If not harvested yet in year @@ -180,14 +180,14 @@ SUBROUTINE CNPhenology(i,ps,pe,nl_soil,idate,dz_soi,deltim,dlat,npcropmin,phase) ELSE dayspyr = 365 ENDIF - + IF ( phase == 1 ) THEN CALL CNPhenologyClimate (i,ps,pe,idate(1:3),deltim,dayspyr,npcropmin,nl_soil,dz_soi,dlat) - + CALL CNEvergreenPhenology (i,ps,pe,deltim,dayspyr) - + CALL CNSeasonDecidPhenology(i,ps,pe,idate(1:3),deltim,dayspyr,dlat) - + CALL CNStressDecidPhenology(i,ps,pe,deltim,dayspyr) #ifdef CROP @@ -201,15 +201,15 @@ SUBROUTINE CNPhenology(i,ps,pe,nl_soil,idate,dz_soi,deltim,dlat,npcropmin,phase) ELSE IF ( phase == 2 ) THEN ! the same onset and offset routines are called regardless of ! phenology type - they depend only on onset_flag, offset_flag, bglfr, and bgtr - + CALL CNOnsetGrowth(i,ps,pe,deltim) - + CALL CNOffsetLitterfall(i,ps,pe,deltim,npcropmin) - + CALL CNBackgroundLitterfall(i,ps,pe) - + CALL CNLivewoodTurnover(i,ps,pe) - + CALL CNLitterToColumn(i,ps,pe,nl_soil,npcropmin) ELSE write(*,*) 'bad phenology phase' @@ -264,7 +264,7 @@ SUBROUTINE CNPhenologyClimate (i,ps,pe,idate,deltim,dayspyr,npcropmin,nl_soil,dz ELSE tref_max_inst_p(m) = max(tref_max_inst_p(m) , tref_p(m)) ENDIF - + IF(idate(3) .eq. 1800 .or. tref_min_inst_p(m) .eq. spval)THEN tref_min_inst_p(m) = tref_p(m) ELSE @@ -276,19 +276,19 @@ SUBROUTINE CNPhenologyClimate (i,ps,pe,idate,deltim,dayspyr,npcropmin,nl_soil,dz ENDIF #endif ENDDO - + accumnstep(i) = accumnstep(i) + 1 prec_today(i) = forc_prc(i) + forc_prl(i) - + nsteps = amin1(10._r8 * stepperday, accumnstep(i)) prec10 (i) = ( prec10 (i) * (nsteps - 1) + prec_today(i) ) / nsteps - + nsteps = amin1(60._r8 * stepperday, accumnstep(i)) prec60 (i) = ( prec60 (i) * (nsteps - 1) + prec_today(i) ) / nsteps - + nsteps = amin1(365._r8 * stepperday, accumnstep(i)) prec365 (i) = ( prec365(i) * (nsteps - 1) + prec_today(i) ) / nsteps - + CALL julian2monthday(idate(1),idate(2),month,mday) !calculate gdd0,gdd8,gdd10,gddplant for GPAM crop phenology F. Li DO m = ps , pe @@ -387,11 +387,11 @@ SUBROUTINE CNEvergreenPhenology (i,ps,pe,deltim,dayspyr) lgsf_p(m) = 0._r8 ENDIF ENDDO - + DO m = ps , pe ivt = pftclass(m) IF (isevg(ivt)) THEN - + tranr=0.0002_r8 ! set carbon fluxes for shifting storage pools to transfer pools leafc_storage_to_xfer_p(m) = tranr * leafc_storage_p(m)/deltim @@ -403,7 +403,7 @@ SUBROUTINE CNEvergreenPhenology (i,ps,pe,deltim,dayspyr) deadcrootc_storage_to_xfer_p(m) = tranr * deadcrootc_storage_p(m)/deltim gresp_storage_to_xfer_p(m) = tranr * gresp_storage_p(m)/deltim ENDIF - + ! set nitrogen fluxes for shifting storage pools to transfer pools leafn_storage_to_xfer_p(m) = tranr * leafn_storage_p(m)/deltim frootn_storage_to_xfer_p(m) = tranr * frootn_storage_p(m)/deltim @@ -413,12 +413,12 @@ SUBROUTINE CNEvergreenPhenology (i,ps,pe,deltim,dayspyr) livecrootn_storage_to_xfer_p(m) = tranr * livecrootn_storage_p(m)/deltim deadcrootn_storage_to_xfer_p(m) = tranr * deadcrootn_storage_p(m)/deltim ENDIF - + t1 = 1.0_r8 / deltim - + leafc_xfer_to_leafc_p(m) = t1 * leafc_xfer_p(m) frootc_xfer_to_frootc_p(m) = t1 * frootc_xfer_p(m) - + leafn_xfer_to_leafn_p(m) = t1 * leafn_xfer_p(m) frootn_xfer_to_frootn_p(m) = t1 * frootn_xfer_p(m) IF (woody(ivt) == 1) THEN @@ -426,19 +426,19 @@ SUBROUTINE CNEvergreenPhenology (i,ps,pe,deltim,dayspyr) deadstemc_xfer_to_deadstemc_p(m) = t1 * deadstemc_xfer_p(m) livecrootc_xfer_to_livecrootc_p(m) = t1 * livecrootc_xfer_p(m) deadcrootc_xfer_to_deadcrootc_p(m) = t1 * deadcrootc_xfer_p(m) - + livestemn_xfer_to_livestemn_p(m) = t1 * livestemn_xfer_p(m) deadstemn_xfer_to_deadstemn_p(m) = t1 * deadstemn_xfer_p(m) livecrootn_xfer_to_livecrootn_p(m) = t1 * livecrootn_xfer_p(m) deadcrootn_xfer_to_deadcrootn_p(m) = t1 * deadcrootn_xfer_p(m) ENDIF - + ENDIF ! END of IF (isevg(ivt(p)) == 1._r8) THEN - + ENDDO ! END of pft loop END SUBROUTINE CNEvergreenPhenology - + SUBROUTINE CNSeasonDecidPhenology(i,ps,pe,idate,deltim,dayspyr,dlat) ! @@ -484,60 +484,60 @@ SUBROUTINE CNSeasonDecidPhenology(i,ps,pe,idate,deltim,dayspyr,dlat) IF(idate2_last .le. 0)idate2_last=idate2_last+365 prev_dayl(i)=daylength(dlat,idate2_last) dayl(i) =daylength(dlat,idate(2)) - + DO m = ps , pe ivt = pftclass(m) IF (issed(ivt)) THEN - + ! set background litterfall rate, background transfer rate, and ! long growing season factor to 0 for seasonal deciduous types bglfr_p(m) = 0._r8 bgtr_p(m) = 0._r8 lgsf_p(m) = 0._r8 - + ! onset gdd sum from Biome-BGC, v4.1.2 crit_onset_gdd = exp(4.8_r8 + 0.13_r8*(annavg_tref_p(m) - 273.15_r8)) - + ! set flag for solstice period (winter->summer = 1, summer->winter = 0) IF (dayl(i) >= prev_dayl(i)) THEN ws_flag = 1._r8 ELSE ws_flag = 0._r8 ENDIF - + ! update offset_counter and test for the END of the offset period IF (offset_flag_p(m) == 1.0_r8) THEN ! decrement counter for offset period offset_counter_p(m) = offset_counter_p(m) - deltim - + ! IF this is the END of the offset_period, reset phenology ! flags and indices IF (offset_counter_p(m) == 0.0_r8) THEN ! this code block was originally handled by CALL cn_offset_cleanup(i) ! inlined during vectorization - + offset_flag_p(m) = 0._r8 offset_counter_p(m) = 0._r8 dormant_flag_p(m) = 1._r8 days_active_p(m) = 0._r8 - + ! reset the previous timestep litterfall flux memory prev_leafc_to_litter_p(m) = 0._r8 prev_frootc_to_litter_p(m) = 0._r8 ENDIF ENDIF - + ! update onset_counter and test for the END of the onset period IF (onset_flag_p(m) == 1.0_r8) THEN ! decrement counter for onset period onset_counter_p(m) = onset_counter_p(m) - deltim - + ! IF this is the END of the onset period, reset phenology ! flags and indices IF (onset_counter_p(m) == 0.0_r8) THEN ! this code block was originally handled by CALL cn_onset_cleanup(i) ! inlined during vectorization - + onset_flag_p(m) = 0.0_r8 onset_counter_p(m) = 0.0_r8 ! set all transfer growth rates to 0.0 @@ -572,37 +572,37 @@ SUBROUTINE CNSeasonDecidPhenology(i,ps,pe,idate,deltim,dayspyr,dlat) ENDIF ENDIF ENDIF - + ! test for switching from dormant period to growth period IF (dormant_flag_p(m) == 1.0_r8) THEN - + ! Test to turn on growing degree-day sum, IF off. ! switch on the growing degree day sum on the winter solstice - + IF (onset_gddflag_p(m) == 0._r8 .and. ws_flag == 1._r8) THEN onset_gddflag_p(m) = 1._r8 onset_gdd_p(m) = 0._r8 ENDIF - + ! Test to turn off growing degree-day sum, IF on. ! This test resets the growing degree day sum IF it gets past ! the summer solstice without reaching the threshold value. ! in that CASE, it will take until the next winter solstice ! before the growing degree-day summation starts again. - + IF (onset_gddflag_p(m) == 1._r8 .and. ws_flag == 0._r8) THEN onset_gddflag_p(m) = 0._r8 onset_gdd_p(m) = 0._r8 ENDIF - + ! IF the gdd flag is set, and IF the soil is above freezing ! THEN accumulate growing degree days for onset trigger - + soilt = t_soisno(3,i) IF (onset_gddflag_p(m) == 1.0_r8 .and. soilt > 273.15_r8) THEN onset_gdd_p(m) = onset_gdd_p(m) + (soilt-273.15_r8)*(deltim/86400._r8) ENDIF - + ! set onset_flag IF critical growing degree-day sum is exceeded IF (onset_gdd_p(m) > crit_onset_gdd) THEN onset_flag_p(m) = 1.0_r8 @@ -610,12 +610,12 @@ SUBROUTINE CNSeasonDecidPhenology(i,ps,pe,idate,deltim,dayspyr,dlat) onset_gddflag_p(m) = 0.0_r8 onset_gdd_p(m) = 0.0_r8 onset_counter_p(m) = ndays_on * 86400._r8 - + ! move all the storage pools into transfer pools, ! WHERE they will be transfered to displayed growth over the onset period. ! this code was originally handled with CALL cn_storage_to_xfer(p) ! inlined during vectorization - + ! set carbon fluxes for shifting storage pools to transfer pools leafc_storage_to_xfer_p(m) = fstor2tran * leafc_storage_p(m)/deltim frootc_storage_to_xfer_p(m) = fstor2tran * frootc_storage_p(m)/deltim @@ -626,7 +626,7 @@ SUBROUTINE CNSeasonDecidPhenology(i,ps,pe,idate,deltim,dayspyr,dlat) deadcrootc_storage_to_xfer_p(m) = fstor2tran * deadcrootc_storage_p(m)/deltim gresp_storage_to_xfer_p(m) = fstor2tran * gresp_storage_p(m)/deltim ENDIF - + ! set nitrogen fluxes for shifting storage pools to transfer pools leafn_storage_to_xfer_p(m) = fstor2tran * leafn_storage_p(m)/deltim frootn_storage_to_xfer_p(m) = fstor2tran * frootn_storage_p(m)/deltim @@ -637,10 +637,10 @@ SUBROUTINE CNSeasonDecidPhenology(i,ps,pe,idate,deltim,dayspyr,dlat) deadcrootn_storage_to_xfer_p(m) = fstor2tran * deadcrootn_storage_p(m)/deltim ENDIF ENDIF - + ! test for switching from growth period to offset period ELSE IF (offset_flag_p(m) == 0.0_r8) THEN - + ! only begin to test for offset daylength once past the summer sol IF (ws_flag == 0._r8 .and. dayl(i) < crit_dayl) THEN offset_flag_p(m) = 1._r8 @@ -649,7 +649,7 @@ SUBROUTINE CNSeasonDecidPhenology(i,ps,pe,idate,deltim,dayspyr,dlat) prev_frootc_to_litter_p(m) = 0._r8 ENDIF ENDIF - + ENDIF ! ENDIF seasonal deciduous ENDDO @@ -692,21 +692,21 @@ SUBROUTINE CNStressDecidPhenology(i,ps,pe,deltim,dayspyr) ! specify rain threshold for leaf onset rain_threshold = 20._r8 - + DO m = ps , pe ivt = pftclass(m) IF (isstd(ivt)) THEN soilt = t_soisno(3,i) psi = smp(3,i) * 1.e-5 ! mmH2O -> MPa - + ! onset gdd sum from Biome-BGC, v4.1.2 crit_onset_gdd = exp(4.8_r8 + 0.13_r8*(annavg_tref_p(m) - 273.15_r8)) - + ! update offset_counter and test for the END of the offset period IF (offset_flag_p(m) == 1._r8) THEN ! decrement counter for offset period offset_counter_p(m) = offset_counter_p(m) - deltim - + ! IF this is the END of the offset_period, reset phenology ! flags and indices IF (offset_counter_p(m) == 0._r8) THEN @@ -716,18 +716,18 @@ SUBROUTINE CNStressDecidPhenology(i,ps,pe,deltim,dayspyr) offset_counter_p(m) = 0._r8 dormant_flag_p(m) = 1._r8 days_active_p(m) = 0._r8 - + ! reset the previous timestep litterfall flux memory prev_leafc_to_litter_p(m) = 0._r8 prev_frootc_to_litter_p(m) = 0._r8 ENDIF ENDIF - + ! update onset_counter and test for the END of the onset period IF (onset_flag_p(m) == 1.0_r8) THEN ! decrement counter for onset period onset_counter_p(m) = onset_counter_p(m) - deltim - + ! IF this is the END of the onset period, reset phenology ! flags and indices IF (onset_counter_p(m) == 0.0_r8) THEN @@ -767,70 +767,70 @@ SUBROUTINE CNStressDecidPhenology(i,ps,pe,deltim,dayspyr) ENDIF ENDIF ENDIF - + ! test for switching from dormant period to growth period IF (dormant_flag_p(m) == 1._r8) THEN - + ! keep track of the number of freezing degree days in this ! dormancy period (only IF the freeze flag has not previously been set ! for this dormancy period - + IF (onset_gddflag_p(m) == 0._r8 .and. soilt < 273.15_r8) onset_fdd_p(m) = onset_fdd_p(m) + deltim/86400._r8 - + ! IF the number of freezing degree days exceeds a critical value, ! THEN onset will require both wet soils and a critical soil ! temperature sum. IF this CASE is triggered, reset any previously ! accumulated value in onset_swi, so that onset now depends on ! the accumulated soil water index following the freeze trigger - + IF (onset_fdd_p(m) > crit_onset_fdd) THEN onset_gddflag_p(m) = 1._r8 onset_fdd_p(m) = 0._r8 onset_swi_p(m) = 0._r8 ENDIF - + ! IF the freeze flag is set, and IF the soil is above freezing ! THEN accumulate growing degree days for onset trigger - + IF (onset_gddflag_p(m) == 1._r8 .and. soilt > 273.15_r8) THEN onset_gdd_p(m) = onset_gdd_p(m) + (soilt-273.15_r8)*deltim/86400._r8 ENDIF - + ! IF soils are wet, accumulate soil water index for onset trigger additional_onset_condition = .true. ! IF additional constraint condition not met, set to false IF ((prec10(i) * (3600.0_r8*10.0_r8*24.0_r8)) < rain_threshold) THEN additional_onset_condition = .false. ENDIF - + IF (psi >= soilpsi_on) THEN onset_swi_p(m) = onset_swi_p(m) + deltim/86400._r8 ENDIF - + ! IF critical soil water index is exceeded, set onset_flag, and ! THEN test for soil temperature criteria - + ! Adding in Kyla's rainfall trigger when fun on. RF. prec10 (mm/s) needs to be higher than 8mm over 10 days. - + IF (onset_swi_p(m) > crit_onset_swi.and. additional_onset_condition) THEN onset_flag_p(m) = 1._r8 - + ! only check soil temperature criteria IF freeze flag set since ! beginning of last dormancy. IF freeze flag set and growing ! degree day sum (since freeze trigger) is lower than critical ! value, THEN override the onset_flag set from soil water. - + IF (onset_gddflag_p(m) == 1._r8 .and. onset_gdd_p(m) < crit_onset_gdd) onset_flag_p(m) = 0._r8 ENDIF - + ! only allow onset IF dayl > 6hrs IF (onset_flag_p(m) == 1._r8 .and. dayl(i) <= secspqtrday) THEN onset_flag_p(m) = 0._r8 ENDIF - + ! IF this is the beginning of the onset period ! THEN reset the phenology flags and indices - + IF (onset_flag_p(m) == 1._r8) THEN dormant_flag_p(m) = 0._r8 days_active_p(m) = 0._r8 @@ -839,12 +839,12 @@ SUBROUTINE CNStressDecidPhenology(i,ps,pe,deltim,dayspyr) onset_gdd_p(m) = 0._r8 onset_swi_p(m) = 0._r8 onset_counter_p(m) = ndays_on * 86400._r8 - + ! CALL SUBROUTINE to move all the storage pools into transfer pools, ! WHERE they will be transfered to displayed growth over the onset period. ! this code was originally handled with CALL cn_storage_to_xfer(i) ! inlined during vectorization - + ! set carbon fluxes for shifting storage pools to transfer pools leafc_storage_to_xfer_p(m) = fstor2tran * leafc_storage_p(m)/deltim frootc_storage_to_xfer_p(m) = fstor2tran * frootc_storage_p(m)/deltim @@ -855,7 +855,7 @@ SUBROUTINE CNStressDecidPhenology(i,ps,pe,deltim,dayspyr) deadcrootc_storage_to_xfer_p(m) = fstor2tran * deadcrootc_storage_p(m)/deltim gresp_storage_to_xfer_p(m) = fstor2tran * gresp_storage_p(m)/deltim ENDIF - + ! set nitrogen fluxes for shifting storage pools to transfer pools leafn_storage_to_xfer_p(m) = fstor2tran * leafn_storage_p(m)/deltim frootn_storage_to_xfer_p(m) = fstor2tran * frootn_storage_p(m)/deltim @@ -866,50 +866,50 @@ SUBROUTINE CNStressDecidPhenology(i,ps,pe,deltim,dayspyr) deadcrootn_storage_to_xfer_p(m) = fstor2tran * deadcrootn_storage_p(m)/deltim ENDIF ENDIF - + ! test for switching from growth period to offset period ELSE IF (offset_flag_p(m) == 0._r8) THEN - + ! IF soil water potential lower than critical value, accumulate ! as stress in offset soil water index - + IF (psi <= soilpsi_off) THEN offset_swi_p(m) = offset_swi_p(m) + deltim/86400._r8 - + ! IF the offset soil water index exceeds critical value, and ! IF this is not the middle of a previously initiated onset period, ! THEN set flag to start the offset period and reset index variables - + IF (offset_swi_p(m) >= crit_offset_swi .and. onset_flag_p(m) == 0._r8) offset_flag_p(m) = 1._r8 - + ! IF soil water potential higher than critical value, reduce the ! offset water stress index. By this mechanism, there must be a ! sustained period of water stress to initiate offset. - + ELSE IF (psi >= soilpsi_on) THEN offset_swi_p(m) = offset_swi_p(m) - deltim/86400._r8 offset_swi_p(m) = max(offset_swi_p(m),0._r8) ENDIF - + ! decrease freezing day accumulator for warm soil IF (offset_fdd_p(m) > 0._r8 .and. soilt > 273.15_r8) THEN offset_fdd_p(m) = offset_fdd_p(m) - deltim/86400._r8 offset_fdd_p(m) = max(0._r8, offset_fdd_p(m)) ENDIF - + ! increase freezing day accumulator for cold soil IF (soilt <= 273.15_r8) THEN offset_fdd_p(m) = offset_fdd_p(m) + deltim/86400._r8 - + ! IF freezing degree day sum is greater than critical value, initiate offset IF (offset_fdd_p(m) > crit_offset_fdd .and. onset_flag_p(m) == 0._r8) offset_flag_p(m) = 1._r8 ENDIF - + ! force offset IF daylength is < 6 hrs IF (dayl(i) <= secspqtrday) THEN offset_flag_p(m) = 1._r8 ENDIF - + ! IF this is the beginning of the offset period ! THEN reset flags and indices IF (offset_flag_p(m) == 1._r8) THEN @@ -920,14 +920,14 @@ SUBROUTINE CNStressDecidPhenology(i,ps,pe,deltim,dayspyr) prev_frootc_to_litter_p(m) = 0._r8 ENDIF ENDIF - + ! keep track of number of days since last dormancy for control on ! fraction of new growth to send to storage for next growing season - + IF (dormant_flag_p(m) == 0.0_r8) THEN days_active_p(m) = days_active_p(m) + deltim/86400._r8 ENDIF - + ! calculate long growing season factor (lgsf) ! only begin to calculate a lgsf greater than 0.0 once the number ! of days active exceeds days/year. @@ -943,10 +943,10 @@ SUBROUTINE CNStressDecidPhenology(i,ps,pe,deltim,dayspyr) ELSE ! calculate the background litterfall rate (bglfr) ! in units 1/s, based on leaf longevity (yrs) and correction for long growing season - + bglfr_p(m) = (1._r8/(leaf_long(ivt)*dayspyr*86400._r8))*lgsf_p(m) ENDIF - + ! set background transfer rate when active but not in the phenological onset period IF (onset_flag_p(m) == 1._r8) THEN bgtr_p(m) = 0._r8 @@ -954,11 +954,11 @@ SUBROUTINE CNStressDecidPhenology(i,ps,pe,deltim,dayspyr) ! the background transfer rate is calculated as the rate that would result ! in complete turnover of the storage pools in one year at steady state, ! once lgsf has reached 1.0 (after 730 days active). - + bgtr_p(m) = (1._r8/(dayspyr*86400._r8))*lgsf_p(m) - + ! set carbon fluxes for shifting storage pools to transfer pools - + ! reduced the amount of stored carbon flowing to display pool by only counting the delta ! between leafc and leafc_store in the flux. RosieF, Nov5 2015. leafc_storage_to_xfer_p(m) = max(0.0_r8,(leafc_storage_p(m)-leafc_p(m))) * bgtr_p(m) @@ -970,7 +970,7 @@ SUBROUTINE CNStressDecidPhenology(i,ps,pe,deltim,dayspyr) deadcrootc_storage_to_xfer_p(m) = deadcrootc_storage_p(m) * bgtr_p(m) gresp_storage_to_xfer_p(m) = gresp_storage_p(m) * bgtr_p(m) ENDIF - + ! set nitrogen fluxes for shifting storage pools to transfer pools leafn_storage_to_xfer_p(m) = leafn_storage_p(m) * bgtr_p(m) frootn_storage_to_xfer_p(m) = frootn_storage_p(m) * bgtr_p(m) @@ -981,7 +981,7 @@ SUBROUTINE CNStressDecidPhenology(i,ps,pe,deltim,dayspyr) deadcrootn_storage_to_xfer_p(m) = deadcrootn_storage_p(m) * bgtr_p(m) ENDIF ENDIF - + ENDIF ! ENDIF stress deciduous ENDDO !END pft loop @@ -1026,13 +1026,13 @@ SUBROUTINE CropPhenology(i,ps,pe,idate,h,deltim,dayspyr,npcropmin) jdayyrstart(1) = 1 jdayyrstart(2) = 182 - + jday = idate(2) mcsec = idate(3) ! get time info - + ndays_on = 20._r8 ! number of days to fertilize - + ! background litterfall and transfer rates; long growing season factor DO m = ps, pe ivt = pftclass(m) @@ -1040,8 +1040,8 @@ SUBROUTINE CropPhenology(i,ps,pe,idate,h,deltim,dayspyr,npcropmin) bglfr_p(m) = 0._r8 ! this value changes later in a crop's life CYCLE bgtr_p(m) = 0._r8 lgsf_p(m) = 0._r8 - - + + ! plantdate is read in ! determine IF the cft is planted in this time step IF ( (.not. croplive_p(m)) .and. (.not. cropplant_p(m)) ) THEN @@ -1083,9 +1083,9 @@ SUBROUTINE CropPhenology(i,ps,pe,idate,h,deltim,dayspyr,npcropmin) ENDIF hui_p(m)=gddplant_p(m)/gddmaturity_p(m) ENDIF - + ! all of the phenology changes are based on hui - + ! Phase 1: Planting to leaf emergence ! Phase 2: Leaf emergence to beginning of grain fill (LAI increase) ! Phase 3: Grain fill to physiological maturity and harvest (LAI decline) @@ -1093,32 +1093,32 @@ SUBROUTINE CropPhenology(i,ps,pe,idate,h,deltim,dayspyr,npcropmin) ! or number of days past planting reaches a maximum, the crop has ! reached physiological maturity and plant is harvested; ! --- --- --- - + onset_flag_p(m) = 0._r8 ! CN terminology to trigger certain offset_flag_p(m) = 0._r8 ! carbon and nitrogen transfers - + IF (croplive_p(m)) THEN cphase_p(m) = 1._r8 ! days past planting may determine harvest - + IF (jday >= idop_p(m)) THEN idpp = jday - idop_p(m) ELSE idpp = int(dayspyr) + jday - idop_p(m) ENDIF - + ! onset_counter initialized to zero when .not. croplive ! offset_counter relevant only at time step of harvest - + onset_counter_p(m) = onset_counter_p(m) - deltim - + ! enter phase 2 onset for one time step: ! transfer seed carbon to leaf emergence - + IF (peaklai_p(m) >= 1) THEN hui_p(m) = max(hui_p(m),grnfill(ivt)) ENDIF - + IF (hui_p(m) >= lfemerg(ivt) .and. hui_p(m) < grnfill(ivt) .and. idpp < mxmat(ivt)) THEN cphase_p(m) = 2._r8 ! CALL vernalization IF winter temperate cereal planted, living, and the @@ -1127,9 +1127,9 @@ SUBROUTINE CropPhenology(i,ps,pe,idate,h,deltim,dayspyr,npcropmin) IF ( vf_p(m) /= 1._r8 .and. (ivt == nwwheat .or. ivt == nirrig_wwheat) .and. hui_p(m) < 0.8_r8 * grnfill(ivt)) THEN CALL vernalization(i,m,deltim) ENDIF - + !fertilization - + IF (abs(onset_counter_p(m)) > 1.e-6_r8) THEN onset_flag_p(m) = 1._r8 onset_counter_p(m) = deltim @@ -1147,17 +1147,17 @@ SUBROUTINE CropPhenology(i,ps,pe,idate,h,deltim,dayspyr,npcropmin) ! this ensures no re-entry to onset of phase2 ! b/c onset_counter(p) = onset_counter(p) - deltim ! at every time step - + onset_counter_p(m) = deltim ENDIF - + ! enter harvest for one time step: ! - transfer live biomass to litter and to crop yield ! - send xsmrpool to the atmosphere ! IF onset and harvest needed to last longer than one timestep ! the onset_counter would change from dt and you'd need to make ! changes to the offset SUBROUTINE below - + ELSE IF (hui_p(m) >= 1._r8 .or. idpp >= mxmat(ivt)) THEN IF (harvdate_p(m) >= NOT_Harvested) harvdate_p(m) = jday croplive_p(m) = .false. ! no re-entry in greater IF-block @@ -1178,27 +1178,27 @@ SUBROUTINE CropPhenology(i,ps,pe,idate,h,deltim,dayspyr,npcropmin) leafc_xfer_p(m) = 0._r8 leafn_xfer_p(m) = leafc_xfer_p(m) / leafcn(ivt) ENDIF - + ! enter phase 3 WHILE previous criteria fail and next is true; ! in terms of order, phase 3 occurs before harvest, but when ! harvest *can* occur, we want it to have first priority. ! AgroIBIS uses a complex formula for lai decline. ! USE CN's simple formula at least as a place holder (slevis) - + ELSE IF (hui_p(m) >= grnfill(ivt)) THEN cphase_p(m) = 3._r8 bglfr_p(m) = 1._r8/(leaf_long(ivt)*dayspyr*86400.) ENDIF - + ! continue fertilizer application WHILE in phase 2; ! assumes that onset of phase 2 took one time step only - + IF (fert_counter_p(m) <= 0._r8) THEN fert_p(m) = 0._r8 ELSE ! continue same fert application every timestep fert_counter_p(m) = fert_counter_p(m) - deltim ENDIF - + ELSE ! crop not live ! next 2 lines conserve mass IF leaf*_xfer > 0 due to interpinic. ! We subtract from any existing value in crop_seedc_to_leaf / @@ -1249,10 +1249,10 @@ SUBROUTINE CNOnsetGrowth(i,ps,pe,deltim) DO m = ps, pe ivt = pftclass(m) IF (onset_flag_p(m) == 1._r8) THEN - + ! The transfer rate is a linearly decreasing FUNCTION of time, ! going to zero on the last timestep of the onset period - + IF (onset_counter_p(m) == deltim) THEN t1 = 1.0_r8 / deltim ELSE @@ -1272,13 +1272,13 @@ SUBROUTINE CNOnsetGrowth(i,ps,pe,deltim) livecrootn_xfer_to_livecrootn_p(m) = t1 * livecrootn_xfer_p(m) deadcrootn_xfer_to_deadcrootn_p(m) = t1 * deadcrootn_xfer_p(m) ENDIF - + ENDIF ! ENDIF onset period - + ! calculate the background rate of transfer growth (used for stress ! deciduous algorithm). in this CASE, all of the mass in the transfer ! pools should be moved to displayed growth in each timestep. - + IF (bgtr_p(m) > 0._r8) THEN leafc_xfer_to_leafc_p(m) = leafc_xfer_p(m) / deltim frootc_xfer_to_frootc_p(m) = frootc_xfer_p(m) / deltim @@ -1326,7 +1326,7 @@ SUBROUTINE CNOffsetLitterfall(i,ps,pe,deltim,npcropmin) ivt = pftclass(m) ! only calculate fluxes during offset period IF (offset_flag_p(m) == 1._r8) THEN - + IF (offset_counter_p(m) == deltim) THEN t1 = 1.0_r8 / deltim leafc_to_litter_p(m) = t1 * leafc_p(m) + cpool_to_leafc_p(m) @@ -1343,34 +1343,34 @@ SUBROUTINE CNOffsetLitterfall(i,ps,pe,deltim,npcropmin) ! Send the remaining grain to the food product pool grainc_to_food_p(m) = t1 * grainc_p(m) + cpool_to_grainc_p(m) - grainc_to_seed_p(m) grainn_to_food_p(m) = t1 * grainn_p(m) + npool_to_grainn_p(m) - grainn_to_seed_p(m) - + livestemc_to_litter_p(m) = t1 * livestemc_p(m) + cpool_to_livestemc_p(m) ENDIF ELSE t1 = deltim * 2.0_r8 / (offset_counter_p(m) * offset_counter_p(m)) leafc_to_litter_p(m) = prev_leafc_to_litter_p(m) + t1*(leafc_p(m) - prev_leafc_to_litter_p(m)*offset_counter_p(m)) frootc_to_litter_p(m) = prev_frootc_to_litter_p(m) + t1*(frootc_p(m) - prev_frootc_to_litter_p(m)*offset_counter_p(m)) - + ENDIF - + leafn_to_litter_p(m) = leafc_to_litter_p(m) / lflitcn(ivt) leafn_to_retransn_p(m) = (leafc_to_litter_p(m) / leafcn(ivt)) - leafn_to_litter_p(m) - - + + ! calculate fine root N litterfall (no retranslocation of fine root N) frootn_to_litter_p(m) = frootc_to_litter_p(m) / frootcn(ivt) - + IF (ivt >= npcropmin) THEN ! NOTE(slevis, 2014-12) results in -ve livestemn and -ve totpftn !X! livestemn_to_litter(p) = livestemc_to_litter(p) / livewdcn(ivt(p)) ! NOTE(slevis, 2014-12) Beth Drewniak suggested this instead livestemn_to_litter_p(m) = livestemn_p(m) / deltim ENDIF - + ! SAVE the current litterfall fluxes prev_leafc_to_litter_p(m) = leafc_to_litter_p(m) prev_frootc_to_litter_p(m) = frootc_to_litter_p(m) - + ENDIF ! ENDIF offset period ENDDO @@ -1409,7 +1409,7 @@ SUBROUTINE CNBackgroundLitterfall(i,ps,pe) ! calculate the leaf N litterfall and retranslocation leafn_to_litter_p(m) = leafc_to_litter_p(m) / lflitcn(ivt) leafn_to_retransn_p(m) = (leafc_to_litter_p(m) / leafcn(ivt)) - leafn_to_litter_p(m) - + frootn_to_litter_p(m) = frootc_to_litter_p(m) / frootcn(ivt) ENDIF ENDDO @@ -1441,24 +1441,24 @@ SUBROUTINE CNLivewoodTurnover(i,ps,pe) ! only calculate these fluxes for woody types ivt = pftclass(m) IF (woody(ivt) > 0._r8) THEN - + ! live stem to dead stem turnover - + ctovr = livestemc_p(m) * lwtop ntovr = ctovr / livewdcn(ivt) livestemc_to_deadstemc_p(m) = ctovr livestemn_to_deadstemn_p(m) = ctovr / deadwdcn(ivt) - + livestemn_to_retransn_p(m) = ntovr - livestemn_to_deadstemn_p(m) !matrix for livestemn_to_retransn will be added in allocation SUBROUTINE - + ! live coarse root to dead coarse root turnover - + ctovr = livecrootc_p(m) * lwtop ntovr = ctovr / livewdcn(ivt) livecrootc_to_deadcrootc_p(m) = ctovr livecrootn_to_deadcrootn_p(m) = ctovr / deadwdcn(ivt) - + livecrootn_to_retransn_p(m) = ntovr - livecrootn_to_deadcrootn_p(m) ENDIF ENDDO ! END pft loop @@ -1521,7 +1521,7 @@ SUBROUTINE CNLitterToColumn(i,ps,pe,nl_soil,npcropmin) + leafc_to_litter_p(m) * lf_fcel(ivt) * wtcol * leaf_prof_p(j,m) phenology_to_lig_c(j,i) = phenology_to_lig_c(j,i) & + leafc_to_litter_p(m) * lf_flig(ivt) * wtcol * leaf_prof_p(j,m) - + ! leaf litter nitrogen fluxes phenology_to_met_n(j,i) = phenology_to_met_n(j,i) & + leafn_to_litter_p(m) * lf_flab(ivt) * wtcol * leaf_prof_p(j,m) @@ -1529,7 +1529,7 @@ SUBROUTINE CNLitterToColumn(i,ps,pe,nl_soil,npcropmin) + leafn_to_litter_p(m) * lf_fcel(ivt) * wtcol * leaf_prof_p(j,m) phenology_to_lig_n(j,i) = phenology_to_lig_n(j,i) & + leafn_to_litter_p(m) * lf_flig(ivt) * wtcol * leaf_prof_p(j,m) - + ! fine root litter carbon fluxes phenology_to_met_c(j,i) = phenology_to_met_c(j,i) & + frootc_to_litter_p(m) * fr_flab(ivt) * wtcol * froot_prof_p(j,m) @@ -1537,7 +1537,7 @@ SUBROUTINE CNLitterToColumn(i,ps,pe,nl_soil,npcropmin) + frootc_to_litter_p(m) * fr_fcel(ivt) * wtcol * froot_prof_p(j,m) phenology_to_lig_c(j,i) = phenology_to_lig_c(j,i) & + frootc_to_litter_p(m) * fr_flig(ivt) * wtcol * froot_prof_p(j,m) - + ! fine root litter nitrogen fluxes phenology_to_met_n(j,i) = phenology_to_met_n(j,i) & + frootn_to_litter_p(m) * fr_flab(ivt) * wtcol * froot_prof_p(j,m) @@ -1545,12 +1545,12 @@ SUBROUTINE CNLitterToColumn(i,ps,pe,nl_soil,npcropmin) + frootn_to_litter_p(m) * fr_fcel(ivt) * wtcol * froot_prof_p(j,m) phenology_to_lig_n(j,i) = phenology_to_lig_n(j,i) & + frootn_to_litter_p(m) * fr_flig(ivt) * wtcol * froot_prof_p(j,m) - + ! agroibis puts crop stem litter together with leaf litter ! so I've used the leaf lf_f* parameters instead of making ! new ones for now (slevis) ! also for simplicity I've put "food" into the litter pools - + IF (ivt >= npcropmin) THEN ! add livestemc to litter ! stem litter carbon fluxes phenology_to_met_c(j,i) = phenology_to_met_c(j,i) & @@ -1559,7 +1559,7 @@ SUBROUTINE CNLitterToColumn(i,ps,pe,nl_soil,npcropmin) + livestemc_to_litter_p(m) * lf_fcel(ivt) * wtcol * leaf_prof_p(j,m) phenology_to_lig_c(j,i) = phenology_to_lig_c(j,i) & + livestemc_to_litter_p(m) * lf_flig(ivt) * wtcol * leaf_prof_p(j,m) - + ! stem litter nitrogen fluxes phenology_to_met_n(j,i) = phenology_to_met_n(j,i) & + livestemn_to_litter_p(m) * lf_flab(ivt) * wtcol * leaf_prof_p(j,m) @@ -1567,7 +1567,7 @@ SUBROUTINE CNLitterToColumn(i,ps,pe,nl_soil,npcropmin) + livestemn_to_litter_p(m) * lf_fcel(ivt) * wtcol * leaf_prof_p(j,m) phenology_to_lig_n(j,i) = phenology_to_lig_n(j,i) & + livestemn_to_litter_p(m) * lf_flig(ivt) * wtcol * leaf_prof_p(j,m) - + ENDIF ENDDO !END pft loop ENDDO! END soil level loop @@ -1599,13 +1599,13 @@ SUBROUTINE vernalization(i,m,deltim) vtmax=15.7_r8 dt=deltim/3600.0_r8 !dt is the time step in hour alpha=log(2._r8)/log((vtmax-vtmin)/(vtopt-vtmin)) - + tc = tref_p(m)-tfrz IF(tc >=vtmin .and. tc <= vtmax) THEN cumvd_p(m)=cumvd_p(m) + (2._r8*((tc-vtmin)**alpha)*(vtopt-vtmin)**alpha & - (tc-vtmin)**(2._r8*alpha))/(vtopt-vtmin)**(2._r8*alpha)*(dt/24._r8) ENDIF - + vf_p(m)=(cumvd_p(m)**5._r8)/(22.5_r8**5._r8+cumvd_p(m)**5._r8) END SUBROUTINE vernalization diff --git a/main/BGC/MOD_BGC_Veg_CNVegStructUpdate.F90 b/main/BGC/MOD_BGC_Veg_CNVegStructUpdate.F90 index 553fb33f..54c22971 100644 --- a/main/BGC/MOD_BGC_Veg_CNVegStructUpdate.F90 +++ b/main/BGC/MOD_BGC_Veg_CNVegStructUpdate.F90 @@ -11,7 +11,7 @@ MODULE MOD_BGC_Veg_CNVegStructUpdate ! The Community Land Model version 5.0 (CLM5) ! ! REVISION: -! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code sturcture. +! Xingjie Lu, 2021, revised the CLM5 code to be compatible with CoLM code structure. ! USE MOD_Precision @@ -20,7 +20,7 @@ MODULE MOD_BGC_Veg_CNVegStructUpdate npcropmin, ntmp_corn, nirrig_tmp_corn, ntrp_corn, nirrig_trp_corn, & nsugarcane, nirrig_sugarcane, nmiscanthus, nirrig_miscanthus, & nswitchgrass, nirrig_switchgrass, noveg - + USE MOD_Vars_PFTimeVariables, only: lai_p, tlai_p, tsai_p, leafc_p, deadstemc_p, harvdate_p USE MOD_Vars_TimeVariables, only: lai, tlai #ifdef CROP @@ -37,13 +37,13 @@ MODULE MOD_BGC_Veg_CNVegStructUpdate !----------------------------------------------------------------------- SUBROUTINE CNVegStructUpdate(i,ps,pe,deltim,npcropmin) - + integer,intent(in) :: i ! patch index integer,intent(in) :: ps ! start pft index integer,intent(in) :: pe ! END pft index real(r8),intent(in) :: deltim ! time step in seconds integer,intent(in) :: npcropmin ! first crop pft index - + ! !LOCAL VARIABLES: integer :: p,c,g ! indices integer :: fp ! lake filter indices @@ -70,33 +70,33 @@ SUBROUTINE CNVegStructUpdate(i,ps,pe,deltim,npcropmin) ! crop tsai_alpha,tsai_min = 0.0,0.1 ! noncrop tsai_alpha,tsai_min = 0.5,1.0 (includes bare soil and urban) !------------------------------------------------------------------------------- - + ! patch loop lai (i) = 0._r8 DO m = ps, pe ivt = pftclass(m) IF (ivt /= noveg) THEN - + tlai_old = tlai_p(m) ! n-1 value tsai_old = tsai_p(m) ! n-1 value - + IF(DEF_USE_LAIFEEDBACK)THEN tlai_p(m) = slatop(ivt) * leafc_p(m) tlai_p(m) = max(0._r8, tlai_p(m)) lai_p (m) = tlai_p(m) ENDIF - + ! update the stem area index and height based on LAI, stem mass, and veg type. ! With the exception of htop for woody vegetation, this follows the DGVM logic. - + ! tsai formula from Zeng et. al. 2002, Journal of Climate, p1835 (see notes) ! Assumes doalb time step .eq. CLM time step, SAI min and monthly decay factor ! alpha are set by PFT, and alpha is scaled to CLM time step by multiplying by ! deltim and dividing by dtsmonth (seconds in average 30 day month) ! tsai_min scaled by 0.5 to match MODIS satellite derived values IF (ivt == nc3crop .or. ivt == nc3irrig) THEN ! generic crops - + tsai_alpha = 1.0_r8-1.0_r8*deltim/dtsmonth tsai_min = 0.1_r8 ELSE @@ -105,17 +105,17 @@ SUBROUTINE CNVegStructUpdate(i,ps,pe,deltim,npcropmin) ENDIF tsai_min = tsai_min * 0.5_r8 tsai_p(m) = max(tsai_alpha*tsai_old+max(tlai_old-tlai_p(m),0._r8),tsai_min) - + ! calculate vegetation physiological parameters used in biomass heat storage ! IF (woody(ivt) == 1._r8) THEN - + ! trees and shrubs for now have a very simple allometry, with hard-wired ! stem taper (height:radius) and nstem from PFT parameter file ELSE IF (ivt >= npcropmin) THEN ! prognostic crops #ifdef CROP IF (tlai_p(m) >= laimx(ivt)) peaklai_p(m) = 1 ! used in CNAllocation - + IF (ivt == ntmp_corn .or. ivt == nirrig_tmp_corn .or. & ivt == ntrp_corn .or. ivt == nirrig_trp_corn .or. & ivt == nsugarcane .or. ivt == nirrig_sugarcane .or. & @@ -125,7 +125,7 @@ SUBROUTINE CNVegStructUpdate(i,ps,pe,deltim,npcropmin) ELSE tsai_p(m) = 0.2_r8 * tlai_p(m) ENDIF - + ! "stubble" after harvest IF(DEF_USE_Fire)THEN IF (harvdate_p(m) < 999 .and. tlai_p(m) == 0._r8) THEN @@ -135,18 +135,18 @@ SUBROUTINE CNVegStructUpdate(i,ps,pe,deltim,npcropmin) ENDIF #endif ENDIF - + ENDIF -! adjust lai and sai for burying by snow. -! snow burial fraction for short vegetation (e.g. grasses, crops) changes with vegetation height +! adjust lai and sai for burying by snow. +! snow burial fraction for short vegetation (e.g. grasses, crops) changes with vegetation height ! accounts for a 20% bending factor, as used in Lombardozzi et al. (2018) GRL 45(18), 9889-9897 ! NOTE: The following snow burial code is duplicated in SatellitePhenologyMod. ! Changes in one place should be accompanied by similar changes in the other. lai(i) = lai(i) + lai_p(m) * pftfrac(m) ENDDO - tlai(i) = lai(i) + tlai(i) = lai(i) END SUBROUTINE CNVegStructUpdate diff --git a/main/BGC/MOD_BGC_Veg_NutrientCompetition.F90 b/main/BGC/MOD_BGC_Veg_NutrientCompetition.F90 index fc110eeb..51f34e44 100644 --- a/main/BGC/MOD_BGC_Veg_NutrientCompetition.F90 +++ b/main/BGC/MOD_BGC_Veg_NutrientCompetition.F90 @@ -7,15 +7,15 @@ MODULE MOD_BGC_Veg_NutrientCompetition ! This MODULE simulates the plant growth with regard to the available soil mineral nitrogen. ! Allocation of NPP and N uptake to different vegetation CN pools uses allocation scheme from CLM4.5. ! CALL sequence is: calc_plant_nutrient_demand_CLM45_default => calc_plant_nutrient_competition_CLM45_default -! +! ! !ORIGINAL: ! The Community Land Model version 5.0 (CLM5.0) ! !REVISION: -! Xingjie Lu, 2022, modify original CLM5 to be compatible with CoLM code structure. +! Xingjie Lu, 2022, modify original CLM5 to be compatible with CoLM code structure. ! Fang Li, 2022, add GPAM C allocation scheme for crop. - ! + ! USE MOD_Precision USE MOD_Const_PFT, only: & woody, leafcn, frootcn, livewdcn, deadwdcn, graincn, & @@ -23,7 +23,7 @@ MODULE MOD_BGC_Veg_NutrientCompetition ! crop variables astemf, arooti, arootf, fleafi, bfact, declfact, allconss, allconsl, fleafcn, fstemcn, ffrootcn, & lfemerg, grnfill - + USE MOD_Vars_PFTimeInvariants, only: pftclass, pftfrac USE MOD_BGC_Vars_PFTimeVariables, only: & @@ -36,9 +36,9 @@ MODULE MOD_BGC_Veg_NutrientCompetition #endif c_allometry_p, n_allometry_p, downreg_p, grain_flag_p, annsum_npp_p, & leafc_p, livestemc_p, frootc_p - USE MOD_Vars_Global, only: nwwheat, nirrig_wwheat + USE MOD_Vars_Global, only: nwwheat, nirrig_wwheat - USE MOD_BGC_Vars_TimeVariables, only: fpg + USE MOD_BGC_Vars_TimeVariables, only: fpg USE MOD_Vars_Global, only: ntmp_soybean, ntrp_soybean, nirrig_tmp_soybean, nirrig_trp_soybean USE MOD_Vars_1DPFTFluxes, only: assim_p @@ -59,7 +59,7 @@ MODULE MOD_BGC_Veg_NutrientCompetition psn_to_cpool_p, gpp_p, availc_p, avail_retransn_p, xsmrpool_recover_p, sminn_to_npool_p, excess_cflux_p IMPLICIT NONE - + PUBLIC calc_plant_nutrient_competition_CLM45_default PUBLIC calc_plant_nutrient_demand_CLM45_default @@ -69,14 +69,14 @@ SUBROUTINE calc_plant_nutrient_competition_CLM45_default(i,ps,pe,npcropmin) !---------------------------------------------------------------------------- ! !DESCRIPTION -! Calulate the nitrogen limitation on the plant growth based on the available +! Calulate the nitrogen limitation on the plant growth based on the available ! nitrogen and nitrogen demand from "calc_plant_nutrient_demand_CLM45_default". ! ! !Original: ! The Community Land Model version 5.0 (CLM5.0) ! !REVISION: -! Xingjie Lu, 2022, modify original CLM5 to be compatible with CoLM code structure. +! Xingjie Lu, 2022, modify original CLM5 to be compatible with CoLM code structure. ! Fang Li, 2022, add GPAM C allocation scheme for crop. integer ,intent(in) :: i @@ -138,7 +138,7 @@ SUBROUTINE calc_plant_nutrient_competition_CLM45_default(i,ps,pe,npcropmin) ENDIF #endif - sminn_to_npool_p(m) = plant_ndemand_p(m) * fpg(i) + sminn_to_npool_p(m) = plant_ndemand_p(m) * fpg(i) plant_nalloc_p(m) = sminn_to_npool_p(m) + retransn_to_npool_p(m) plant_calloc_p(m) = plant_nalloc_p(m) * (c_allometry_p(m)/n_allometry_p(m)) @@ -218,7 +218,7 @@ SUBROUTINE calc_plant_nutrient_competition_CLM45_default(i,ps,pe,npcropmin) npool_to_deadcrootn_storage_p(m) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) npool_to_grainn_p(m) = (nlc * f5 / cng) * fcur npool_to_grainn_storage_p(m) = (nlc * f5 / cng) * (1._r8 -fcur) - ENDIF + ENDIF #endif ! Calculate the amount of carbon that needs to go into growth @@ -258,7 +258,7 @@ SUBROUTINE calc_plant_nutrient_demand_CLM45_default(i,ps,pe,deltim,npcropmin) ! The Community Land Model version 5.0 (CLM5.0) ! !REVISION: -! Xingjie Lu, 2022, modify original CLM5 to be compatible with CoLM code structure. +! Xingjie Lu, 2022, modify original CLM5 to be compatible with CoLM code structure. ! Fang Li, 2022, add GPAM C allocation scheme for crop. @@ -281,16 +281,16 @@ SUBROUTINE calc_plant_nutrient_demand_CLM45_default(i,ps,pe,deltim,npcropmin) real(r8):: dayscrecover ! number of days to recover negative cpool integer :: ivt, m dayscrecover = 30._r8 - + DO m = ps, pe ivt = pftclass(m) psn_to_cpool_p(m) = assim_p(m) * 12.011_r8 - + gpp_p(m) = psn_to_cpool_p(m) - + ! get the time step total maintenance respiration ! These fluxes should already be in gC/m2/s - + mr = leaf_mr_p(m) + froot_mr_p(m) IF (woody(ivt) == 1.0_r8) THEN mr = mr + livestem_mr_p(m) + livecroot_mr_p(m) @@ -302,7 +302,7 @@ SUBROUTINE calc_plant_nutrient_demand_CLM45_default(i,ps,pe,deltim,npcropmin) ! carbon flux available for allocation availc_p(m) = gpp_p(m) - mr - + ! new code added for isotope calculations, 7/1/05, PET ! IF mr > gpp, THEN some mr comes from gpp, the rest comes from ! cpool (xsmr) @@ -322,16 +322,16 @@ SUBROUTINE calc_plant_nutrient_demand_CLM45_default(i,ps,pe,deltim,npcropmin) livecroot_xsmr_p(m) = livecroot_mr_p(m) - livecroot_curmr_p(m) grain_curmr_p(m) = grain_mr_p(m) * curmr_ratio grain_xsmr_p(m) = grain_mr_p(m) - grain_curmr_p(m) - + ! no allocation when available c is negative availc_p(m) = max(availc_p(m),0.0_r8) - + ! test for an xsmrpool deficit IF (xsmrpool_p(m) < 0.0_r8) THEN ! Running a deficit in the xsmrpool, so the first priority is to let ! some availc from this timestep accumulate in xsmrpool. ! Determine rate of recovery for xsmrpool deficit - + xsmrpool_recover_p(m) = -xsmrpool_p(m)/(dayscrecover*86400._r8) IF (xsmrpool_recover_p(m) < availc_p(m)) THEN ! available carbon reduced by amount for xsmrpool recovery @@ -343,22 +343,22 @@ SUBROUTINE calc_plant_nutrient_demand_CLM45_default(i,ps,pe,deltim,npcropmin) ENDIF cpool_to_xsmrpool_p(m) = xsmrpool_recover_p(m) ENDIF - + f1 = froot_leaf(ivt) f2 = croot_stem(ivt) - + ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) ! This variable allocation is only for trees. Shrubs have a constant ! allocation as specified in the pft-physiologfy file. The value is also used ! as a trigger here: -1.0 means to USE the dynamic allocation (trees). - + IF (stem_leaf(ivt) == -1._r8) THEN f3 = (2.7/(1.0+exp(-0.004*(annsum_npp_p(m) - 300.0)))) - 0.4 ELSE f3 = stem_leaf(ivt) ENDIF - + f4 = flivewd(ivt) g1 = grperc(ivt) g2 = grpnow(ivt) @@ -366,24 +366,24 @@ SUBROUTINE calc_plant_nutrient_demand_CLM45_default(i,ps,pe,deltim,npcropmin) cnfr = frootcn(ivt) cnlw = livewdcn(ivt) cndw = deadwdcn(ivt) - + ! calculate f1 to f5 for prog crops following AgroIBIS subr phenocrop - + f5 = 0._r8 ! continued intializations from above #ifdef CROP IF (ivt >= npcropmin) THEN ! skip 2 generic crops - + IF (croplive_p(m)) THEN ! same phases appear in SUBROUTINE CropPhenology - + ! Phase 1 completed: ! ================== ! Next phase: leaf emergence to start of leaf decline - + IF (hui_p(m) >= lfemerg(ivt) .and. hui_p(m) < grnfill(ivt)) THEN ! allocation rules for crops based on maturity and linear decrease ! of amount allocated to roots over course of the growing season - + IF (peaklai_p(m) == 1) THEN ! lai at maximum allowed arepr_p(m) = 0._r8 aleaf_p(m) = 1.e-5_r8 @@ -398,30 +398,30 @@ SUBROUTINE calc_plant_nutrient_demand_CLM45_default(i,ps,pe,deltim,npcropmin) aleaf_p(m) = max(1.e-5_r8, (1._r8 - aroot_p(m)) * fleaf) astem_p(m) = 1._r8 - arepr_p(m) - aleaf_p(m) - aroot_p(m) ENDIF - ! AgroIBIS included here an immediate adjustment to aleaf & astem IF the + ! AgroIBIS included here an immediate adjustment to aleaf & astem IF the ! predicted lai from the above allocation coefficients exceeded laimx. ! We have decided to live with lais slightly higher than laimx by ! enforcing the cap in the following tstep through the peaklai logic above. - + astemi_p(m) = astem_p(m) ! SAVE for USE by equations after shift to reproductive grain_flag_p(m) = 0._r8 ! phenology stage begins setting to 0 WHILE in phase 2 - + ! Phase 2 completed: ! ================== ! shift allocation either when enough hui are accumulated or maximum number ! of days has elapsed since planting - + ELSE IF (hui_p(m) >= grnfill(ivt)) THEN - + aroot_p(m) = arooti(ivt) - (arooti(ivt) - arootf(ivt)) * min(1._r8, hui_p(m)) astem_p(m) = max(astemf(ivt), astem_p(m) * max(0._r8, (1._r8-hui_p(m))/ & (1._r8-grnfill(ivt)))**allconss(ivt)) aleaf_p(m) = 1.e-5_r8 - + !Beth's retranslocation of leafn, stemn, rootn to organ !Filter excess plant N to retransn pool for organ N !only DO one time THEN hold grain_flag till onset next season - + IF (astem_p(m) == astemf(ivt) .or. & (ivt /= ntmp_soybean .and. ivt /= nirrig_tmp_soybean .and.& ivt /= ntrp_soybean .and. ivt /= nirrig_trp_soybean)) THEN @@ -439,9 +439,9 @@ SUBROUTINE calc_plant_nutrient_demand_CLM45_default(i,ps,pe,deltim,npcropmin) grain_flag_p(m) = 1._r8 ENDIF ENDIF - + arepr_p(m) = 1._r8 - aroot_p(m) - astem_p(m) - aleaf_p(m) - !F. Li for vernalization effect 2 + !F. Li for vernalization effect 2 IF(ivt == nwwheat .or. ivt == nirrig_wwheat) THEN arepr_p(m) = arepr_p(m)*vf_p(m) aroot_p(m) = 1._r8 - aleaf_p(m) - astem_p(m) - arepr_p(m) @@ -452,12 +452,12 @@ SUBROUTINE calc_plant_nutrient_demand_CLM45_default(i,ps,pe,deltim,npcropmin) aroot_p(m) = 0._r8 ! this applies to this "ELSE" and to the "ELSE" arepr_p(m) = 0._r8 ! a few lines down ENDIF - + f1 = aroot_p(m) / aleaf_p(m) f3 = astem_p(m) / aleaf_p(m) f5 = arepr_p(m) / aleaf_p(m) g1 = grperc(ivt) - + ELSE ! .not croplive f1 = 0._r8 f3 = 0._r8 @@ -470,9 +470,9 @@ SUBROUTINE calc_plant_nutrient_demand_CLM45_default(i,ps,pe,deltim,npcropmin) ! based on available C, USE constant allometric relationships to ! determine N requirements -!RF. I removed the growth respiration from this, because it is used to calculate -!plantCN for N uptake and c_allometry for allocation. IF we add gresp to the -!allometry calculation THEN we allocate too much carbon since gresp is not allocated here. +!RF. I removed the growth respiration from this, because it is used to calculate +!plantCN for N uptake and c_allometry for allocation. IF we add gresp to the +!allometry calculation THEN we allocate too much carbon since gresp is not allocated here. IF (woody(ivt) == 1.0_r8) THEN c_allometry_p(m) = (1._r8+g1)*(1._r8+f1+f3*(1._r8+f2)) n_allometry_p(m) = 1._r8/cnl + f1/cnfr + (f3*f4*(1._r8+f2))/cnlw + & @@ -487,22 +487,22 @@ SUBROUTINE calc_plant_nutrient_demand_CLM45_default(i,ps,pe,deltim,npcropmin) ELSE c_allometry_p(m) = 1._r8+g1+f1+f1*g1 n_allometry_p(m) = 1._r8/cnl + f1/cnfr - ENDIF - + ENDIF + plant_ndemand_p(m) = availc_p(m)*(n_allometry_p(m)/c_allometry_p(m)) - + ! retranslocated N deployment depends on seasonal CYCLE of potential GPP ! (requires one year run to accumulate demand) - + tempsum_potential_gpp_p(m) = tempsum_potential_gpp_p(m) + gpp_p(m) - + ! Adding the following line to carry max retransn info to CN Annual Update tempmax_retransn_p(m) = max(tempmax_retransn_p(m),retransn_p(m)) - + ! Beth's code: crops pull from retransn pool only during grain fill; ! retransn pool has N from leaves, stems, and roots for ! retranslocation - + IF (ivt >= npcropmin .and. grain_flag_p(m) == 1._r8) THEN avail_retransn_p(m) = plant_ndemand_p(m) ELSE IF (ivt < npcropmin .and. annsum_potential_gpp_p(m) > 0._r8) THEN @@ -510,23 +510,23 @@ SUBROUTINE calc_plant_nutrient_demand_CLM45_default(i,ps,pe,deltim,npcropmin) ELSE avail_retransn_p(m) = 0.0_r8 ENDIF - + ! make sure available retrans N doesn't exceed storage avail_retransn_p(m) = min(avail_retransn_p(m), retransn_p(m)/deltim) - + ! modify plant N demand according to the availability of ! retranslocated N ! take from retransn pool at most the flux required to meet ! plant ndemand - + IF (plant_ndemand_p(m) > avail_retransn_p(m)) THEN retransn_to_npool_p(m) = avail_retransn_p(m) ELSE retransn_to_npool_p(m) = plant_ndemand_p(m) ENDIF - + plant_ndemand_p(m) = plant_ndemand_p(m) - retransn_to_npool_p(m) - + ENDDO ! END loop pft patch. END SUBROUTINE calc_plant_nutrient_demand_CLM45_default diff --git a/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 b/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 index cf4e61fc..50d2989a 100644 --- a/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 +++ b/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 @@ -4,17 +4,17 @@ MODULE MOD_Catch_RiverLakeFlow !------------------------------------------------------------------------------------- ! DESCRIPTION: -! +! ! Shallow water equation solver in rivers. ! ! References -! [1] Toro EF. Shock-capturing methods for free-surface shallow flows. +! [1] Toro EF. Shock-capturing methods for free-surface shallow flows. ! Chichester: John Wiley & Sons; 2001. -! [2] Liang, Q., Borthwick, A. G. L. (2009). Adaptive quadtree simulation of shallow -! flows with wet-dry fronts over complex topography. +! [2] Liang, Q., Borthwick, A. G. L. (2009). Adaptive quadtree simulation of shallow +! flows with wet-dry fronts over complex topography. ! Computers and Fluids, 38(2), 221–234. -! [3] Audusse, E., Bouchut, F., Bristeau, M.-O., Klein, R., Perthame, B. (2004). -! A Fast and Stable Well-Balanced Scheme with Hydrostatic Reconstruction for +! [3] Audusse, E., Bouchut, F., Bristeau, M.-O., Klein, R., Perthame, B. (2004). +! A Fast and Stable Well-Balanced Scheme with Hydrostatic Reconstruction for ! Shallow Water Flows. SIAM Journal on Scientific Computing, 25(6), 2050–2065. ! ! Created by Shupeng Zhang, May 2023 @@ -22,16 +22,16 @@ MODULE MOD_Catch_RiverLakeFlow USE MOD_Precision IMPLICIT NONE - + real(r8), parameter :: nmanning_riv = 0.03 - - real(r8), parameter :: RIVERMIN = 1.e-5_r8 + + real(r8), parameter :: RIVERMIN = 1.e-5_r8 real(r8), parameter :: VOLUMEMIN = 1.e-5_r8 integer :: ntimestep_riverlake - + CONTAINS - + ! --------- SUBROUTINE river_lake_flow (dt) @@ -51,7 +51,7 @@ SUBROUTINE river_lake_flow (dt) ! Local Variables integer :: nbasin integer :: hs, he, i, j - + real(r8), allocatable :: wdsrf_bsn_ds(:) real(r8), allocatable :: veloc_riv_ds(:) real(r8), allocatable :: momen_riv_ds(:) @@ -59,11 +59,11 @@ SUBROUTINE river_lake_flow (dt) real(r8), allocatable :: hflux_fc(:) real(r8), allocatable :: mflux_fc(:) real(r8), allocatable :: zgrad_dn(:) - + real(r8), allocatable :: sum_hflux_riv(:) real(r8), allocatable :: sum_mflux_riv(:) real(r8), allocatable :: sum_zgrad_riv(:) - + real(r8) :: veloct_fc, height_fc, momen_fc, zsurf_fc real(r8) :: bedelv_fc, height_up, height_dn real(r8) :: vwave_up, vwave_dn, hflux_up, hflux_dn, mflux_up, mflux_dn @@ -71,9 +71,9 @@ SUBROUTINE river_lake_flow (dt) real(r8) :: dt_res, dt_this logical, allocatable :: mask(:) - + IF (p_is_worker) THEN - + nbasin = numelm ! update water depth in basin by aggregating water depths in patches @@ -87,7 +87,7 @@ SUBROUTINE river_lake_flow (dt) wdsrf_bsn(i) = minval(hillslope_network(i)%hand + wdsrf_hru(hs:he)) - handmin(i) ELSEIF (lake_id(i) > 0) THEN - ! lake + ! lake totalvolume = sum(wdsrf_hru(hs:he) * lakes(i)%area0) wdsrf_bsn(i) = lakes(i)%surface(totalvolume) ENDIF @@ -102,7 +102,7 @@ SUBROUTINE river_lake_flow (dt) momen_riv(i) = wdsrf_bsn(i) * veloc_riv(i) ENDIF ELSE - ! water in lake or lake catchment is assumued to be stationary. + ! water in lake or lake catchment is assumed to be stationary. ! TODO: lake dynamics momen_riv(i) = 0 veloc_riv(i) = 0 @@ -127,12 +127,12 @@ SUBROUTINE river_lake_flow (dt) DO WHILE (dt_res > 0) ntimestep_riverlake = ntimestep_riverlake + 1 - + DO i = 1, nbasin sum_hflux_riv(i) = 0. sum_mflux_riv(i) = 0. sum_zgrad_riv(i) = 0. - + IF (addrdown(i) > 0) THEN wdsrf_bsn_ds(i) = wdsrf_bsn(addrdown(i)) veloc_riv_ds(i) = veloc_riv(addrdown(i)) @@ -142,7 +142,7 @@ SUBROUTINE river_lake_flow (dt) veloc_riv_ds(i) = 0 momen_riv_ds(i) = 0 ENDIF - ENDDO + ENDDO #ifdef USEMPI CALL river_data_exchange (SEND_DATA_DOWN_TO_UP, accum = .false., & vec_send1 = wdsrf_bsn, vec_recv1 = wdsrf_bsn_ds, & @@ -158,7 +158,7 @@ SUBROUTINE river_lake_flow (dt) DO i = 1, nbasin IF (riverdown(i) >= 0) THEN - + IF (riverdown(i) > 0) THEN ! both elements are dry. IF ((wdsrf_bsn(i) < RIVERMIN) .and. (wdsrf_bsn_ds(i) < RIVERMIN)) THEN @@ -172,17 +172,17 @@ SUBROUTINE river_lake_flow (dt) ! reconstruction of height of water near interface IF (riverdown(i) > 0) THEN bedelv_fc = max(bedelv(i), bedelv_ds(i)) - height_up = max(0., wdsrf_bsn(i) +bedelv(i) -bedelv_fc) - height_dn = max(0., wdsrf_bsn_ds(i)+bedelv_ds(i)-bedelv_fc) + height_up = max(0., wdsrf_bsn(i) +bedelv(i) -bedelv_fc) + height_dn = max(0., wdsrf_bsn_ds(i)+bedelv_ds(i)-bedelv_fc) ELSEIF (riverdown(i) == 0) THEN ! for river mouth bedelv_fc = bedelv(i) - height_up = wdsrf_bsn(i) + height_up = wdsrf_bsn(i) ! sea level is assumed to be 0. and sea bed is assumed to be negative infinity. - height_dn = max(0., - bedelv_fc) + height_dn = max(0., - bedelv_fc) ENDIF ! velocity at river downstream face (middle region in Riemann problem) - veloct_fc = 0.5 * (veloc_riv(i) + veloc_riv_ds(i)) & + veloct_fc = 0.5 * (veloc_riv(i) + veloc_riv_ds(i)) & + sqrt(grav * height_up) - sqrt(grav * height_dn) ! height of water at downstream face (middle region in Riemann problem) @@ -203,8 +203,8 @@ SUBROUTINE river_lake_flow (dt) hflux_up = veloc_riv(i) * height_up hflux_dn = veloc_riv_ds(i) * height_dn - mflux_up = veloc_riv(i)**2 * height_up + 0.5*grav * height_up**2 - mflux_dn = veloc_riv_ds(i)**2 * height_dn + 0.5*grav * height_dn**2 + mflux_up = veloc_riv(i)**2 * height_up + 0.5*grav * height_up**2 + mflux_dn = veloc_riv_ds(i)**2 * height_dn + 0.5*grav * height_dn**2 IF (vwave_up >= 0.) THEN hflux_fc(i) = outletwth(i) * hflux_up @@ -218,23 +218,23 @@ SUBROUTINE river_lake_flow (dt) mflux_fc(i) = outletwth(i) * (vwave_dn*mflux_up - vwave_up*mflux_dn & + vwave_up*vwave_dn*(hflux_dn-hflux_up)) / (vwave_dn-vwave_up) ENDIF - + sum_zgrad_riv(i) = sum_zgrad_riv(i) + outletwth(i) * 0.5*grav * height_up**2 zgrad_dn(i) = outletwth(i) * 0.5*grav * height_dn**2 - - ELSEIF (riverdown(i) == -3) THEN + + ELSEIF (riverdown(i) == -3) THEN ! downstream is not in model region. ! assume: 1. downstream river bed is equal to this river bed. ! 2. downstream water surface is equal to this river depth. ! 3. downstream water velocity is equal to this velocity. - + veloc_riv(i) = max(veloc_riv(i), 0.) IF (wdsrf_bsn(i) > riverdpth(i)) THEN ! reconstruction of height of water near interface - height_up = wdsrf_bsn(i) + height_up = wdsrf_bsn(i) height_dn = riverdpth(i) veloct_fc = veloc_riv(i) + sqrt(grav * height_up) - sqrt(grav * height_dn) @@ -245,8 +245,8 @@ SUBROUTINE river_lake_flow (dt) hflux_up = veloc_riv(i) * height_up hflux_dn = veloc_riv(i) * height_dn - mflux_up = veloc_riv(i)**2 * height_up + 0.5*grav * height_up**2 - mflux_dn = veloc_riv(i)**2 * height_dn + 0.5*grav * height_dn**2 + mflux_up = veloc_riv(i)**2 * height_up + 0.5*grav * height_up**2 + mflux_dn = veloc_riv(i)**2 * height_dn + 0.5*grav * height_dn**2 IF (vwave_up >= 0.) THEN hflux_fc(i) = outletwth(i) * hflux_up @@ -288,9 +288,9 @@ SUBROUTINE river_lake_flow (dt) sum_mflux_riv(j) = sum_mflux_riv(j) - mflux_fc(i) sum_zgrad_riv(j) = sum_zgrad_riv(j) - zgrad_dn(i) ENDIF - + ENDDO - + #ifdef USEMPI hflux_fc = - hflux_fc; mflux_fc = - mflux_fc; zgrad_dn = - zgrad_dn @@ -298,7 +298,7 @@ SUBROUTINE river_lake_flow (dt) vec_send1 = hflux_fc, vec_recv1 = sum_hflux_riv, & vec_send2 = mflux_fc, vec_recv2 = sum_mflux_riv, & vec_send3 = zgrad_dn, vec_recv3 = sum_zgrad_riv) - + hflux_fc = - hflux_fc; mflux_fc = - mflux_fc; zgrad_dn = - zgrad_dn #endif @@ -316,16 +316,16 @@ SUBROUTINE river_lake_flow (dt) ! for river or lake catchment totalvolume = sum((wdsrf_bsn(i) + handmin(i) - hillslope_network(i)%hand) & * hillslope_network(i)%area, & - mask = wdsrf_bsn(i) + handmin(i) >= hillslope_network(i)%hand) + mask = wdsrf_bsn(i) + handmin(i) >= hillslope_network(i)%hand) ELSEIF (lake_id(i) > 0) THEN ! for lake totalvolume = lakes(i)%volume(wdsrf_bsn(i)) ENDIF - + dt_this = min(dt_this, totalvolume / sum_hflux_riv(i)) - + ENDIF - + ! constraint 3: Avoid change of flow direction (only for rivers) IF (lake_id(i) == 0) THEN IF ((abs(veloc_riv(i)) > 0.1) & @@ -334,7 +334,7 @@ SUBROUTINE river_lake_flow (dt) abs(momen_riv(i) * riverarea(i) / (sum_mflux_riv(i)-sum_zgrad_riv(i)))) ENDIF ENDIF - ENDDO + ENDDO #ifdef USEMPI CALL mpi_allreduce (MPI_IN_PLACE, dt_this, 1, MPI_REAL8, MPI_MIN, p_comm_worker, p_err) @@ -347,13 +347,13 @@ SUBROUTINE river_lake_flow (dt) hs = basin_hru%substt(i) he = basin_hru%subend(i) allocate (mask (hillslope_network(i)%nhru)) - + totalvolume = sum((wdsrf_bsn(i) + handmin(i) - hillslope_network(i)%hand) & * hillslope_network(i)%area, & - mask = wdsrf_bsn(i) + handmin(i) >= hillslope_network(i)%hand) + mask = wdsrf_bsn(i) + handmin(i) >= hillslope_network(i)%hand) totalvolume = totalvolume - sum_hflux_riv(i) * dt_this - + IF (totalvolume < VOLUMEMIN) THEN DO j = 1, hillslope_network(i)%nhru IF (hillslope_network(i)%hand(j) <= wdsrf_bsn(i) + handmin(i)) THEN @@ -369,7 +369,7 @@ SUBROUTINE river_lake_flow (dt) DO WHILE (dvol > VOLUMEMIN) mask = hillslope_network(i)%hand < wdsrf_bsn(i) + handmin(i) nextl = maxval(hillslope_network(i)%hand, mask = mask) - nexta = sum (hillslope_network(i)%area, mask = mask) + nexta = sum (hillslope_network(i)%area, mask = mask) nextv = nexta * (wdsrf_bsn(i)+handmin(i)-nextl) IF (nextv > dvol) THEN ddep = dvol/nexta @@ -420,14 +420,14 @@ SUBROUTINE river_lake_flow (dt) ENDDO ENDDO ENDIF - + ENDIF deallocate(mask) ELSE totalvolume = lakes(i)%volume(wdsrf_bsn(i)) totalvolume = totalvolume - sum_hflux_riv(i) * dt_this - wdsrf_bsn(i) = lakes(i)%surface(totalvolume) + wdsrf_bsn(i) = lakes(i)%surface(totalvolume) ENDIF IF ((lake_id(i) /= 0) .or. (wdsrf_bsn(i) < RIVERMIN)) THEN @@ -437,10 +437,10 @@ SUBROUTINE river_lake_flow (dt) friction = grav * nmanning_riv**2 / wdsrf_bsn(i)**(7.0/3.0) * abs(momen_riv(i)) momen_riv(i) = (momen_riv(i) & - (sum_mflux_riv(i) - sum_zgrad_riv(i)) / riverarea(i) * dt_this) & - / (1 + friction * dt_this) + / (1 + friction * dt_this) veloc_riv(i) = momen_riv(i) / wdsrf_bsn(i) ENDIF - + ! inland depression river IF ((lake_id(i) == 0) .and. (riverdown(i) == -1)) THEN momen_riv(i) = min(0., momen_riv(i)) @@ -454,7 +454,7 @@ SUBROUTINE river_lake_flow (dt) momen_riv_ta(:) = momen_riv_ta(:) + momen_riv(:) * dt_this discharge (:) = discharge (:) + hflux_fc (:) * dt_this ENDIF - + DO i = 1, nbasin IF (lake_id(i) > 0) THEN ! for lakes hs = basin_hru%substt(i) diff --git a/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 b/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 index 43b73491..e7d2c15e 100644 --- a/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 +++ b/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 @@ -4,13 +4,13 @@ MODULE MOD_Catch_SubsurfaceFlow !------------------------------------------------------------------------------------- ! DESCRIPTION: -! +! ! Ground water lateral flow. ! ! Ground water fluxes are calculated ! 1. between basins ! 2. between hydrological response units -! 3. between patches inside one HRU +! 3. between patches inside one HRU ! ! Created by Shupeng Zhang, May 2023 !------------------------------------------------------------------------------------- @@ -18,17 +18,17 @@ MODULE MOD_Catch_SubsurfaceFlow USE MOD_Precision USE MOD_DataType IMPLICIT NONE - + real(r8), parameter :: e_ice = 6.0 ! soil ice impedance factor - + ! anisotropy ratio of lateral/vertical hydraulic conductivity (unitless) ! for USDA soil texture class: ! 0: undefined - ! 1: clay; 2: silty clay; 3: sandy clay; 4: clay loam; 5: silty clay loam; 6: sandy clay loam; & + ! 1: clay; 2: silty clay; 3: sandy clay; 4: clay loam; 5: silty clay loam; 6: sandy clay loam; & ! 7: loam; 8: silty loam; 9: sandy loam; 10: silt; 11: loamy sand; 12: sand real(r8), parameter :: raniso(0:12) = (/ 1., & 48., 40., 28., 24., 20., 14., 12., 10., 4., 2., 3., 2. /) - + ! -- neighbour variables -- type(pointer_real8_1d), allocatable :: agwt_nb (:) ! ground water area (for patchtype <= 2) of neighbours [m^2] type(pointer_real8_1d), allocatable :: theta_a_nb (:) ! saturated volume content [-] @@ -38,7 +38,7 @@ MODULE MOD_Catch_SubsurfaceFlow type(pointer_logic_1d), allocatable :: islake_nb (:) ! whether a neighbour is water body CONTAINS - + ! ---------- SUBROUTINE basin_neighbour_init () @@ -48,12 +48,12 @@ SUBROUTINE basin_neighbour_init () USE MOD_Catch_HillslopeNetwork, only : hillslope_network USE MOD_Catch_RiverLakeNetwork, only : lake_id IMPLICIT NONE - + integer :: numbasin, ibasin, inb - + real(r8), allocatable :: agwt_b(:) real(r8), allocatable :: islake(:) - type(pointer_real8_1d), allocatable :: iswat_nb (:) + type(pointer_real8_1d), allocatable :: iswat_nb (:) #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) @@ -62,14 +62,14 @@ SUBROUTINE basin_neighbour_init () numbasin = numelm IF (p_is_worker) THEN - + CALL allocate_neighbour_data (agwt_nb ) CALL allocate_neighbour_data (theta_a_nb) CALL allocate_neighbour_data (zwt_nb ) CALL allocate_neighbour_data (Kl_nb ) CALL allocate_neighbour_data (wdsrf_nb ) CALL allocate_neighbour_data (islake_nb ) - + CALL allocate_neighbour_data (iswat_nb ) IF (numbasin > 0) THEN @@ -85,10 +85,10 @@ SUBROUTINE basin_neighbour_init () ENDIF ENDDO ENDIF - + CALL retrieve_neighbour_data (agwt_b, agwt_nb ) CALL retrieve_neighbour_data (islake, iswat_nb) - + DO ibasin = 1, numbasin DO inb = 1, elementneighbour(ibasin)%nnb IF (elementneighbour(ibasin)%glbindex(inb) > 0) THEN ! skip ocean neighbour @@ -96,18 +96,18 @@ SUBROUTINE basin_neighbour_init () ENDIF ENDDO ENDDO - + IF (allocated(agwt_b )) deallocate(agwt_b ) IF (allocated(islake )) deallocate(islake ) IF (allocated(iswat_nb)) deallocate(iswat_nb) - + ENDIF END SUBROUTINE basin_neighbour_init ! --------- SUBROUTINE subsurface_flow (deltime) - + USE MOD_SPMD_Task USE MOD_UserDefFun USE MOD_Mesh @@ -124,7 +124,7 @@ SUBROUTINE subsurface_flow (deltime) USE MOD_Hydro_SoilWater, only : soilwater_aquifer_exchange IMPLICIT NONE - + real(r8), intent(in) :: deltime ! Local Variables @@ -132,8 +132,8 @@ SUBROUTINE subsurface_flow (deltime) type(hillslope_network_info_type), pointer :: hrus - real(r8), allocatable :: theta_a_h (:) - real(r8), allocatable :: zwt_h (:) + real(r8), allocatable :: theta_a_h (:) + real(r8), allocatable :: zwt_h (:) real(r8), allocatable :: Kl_h (:) ! [m/s] real(r8), allocatable :: xsubs_h (:) ! [m/s] real(r8), allocatable :: xsubs_fc (:) ! [m/s] @@ -146,8 +146,8 @@ SUBROUTINE subsurface_flow (deltime) real(r8) :: ca, cb real(r8) :: alp - real(r8), allocatable :: theta_a_bsn (:) - real(r8), allocatable :: zwt_bsn (:) + real(r8), allocatable :: theta_a_bsn (:) + real(r8), allocatable :: zwt_bsn (:) real(r8), allocatable :: Kl_bsn (:) ! [m/s] integer :: jnb @@ -180,10 +180,10 @@ SUBROUTINE subsurface_flow (deltime) IF (p_is_worker) THEN numbasin = numelm - - xsubs_bsn(:) = 0. ! subsurface lateral flow between basins + + xsubs_bsn(:) = 0. ! subsurface lateral flow between basins xsubs_hru(:) = 0. ! subsurface lateral flow between hydrological response units - xsubs_pch(:) = 0. ! subsurface lateral flow between patches inside one HRU + xsubs_pch(:) = 0. ! subsurface lateral flow between patches inside one HRU xwsub(:) = 0. ! total recharge/discharge from subsurface lateral flow @@ -203,13 +203,13 @@ SUBROUTINE subsurface_flow (deltime) IF (lake_id(ibasin) > 0) CYCLE ! lake IF (sum(hrus%agwt) <= 0) CYCLE ! no area of soil, urban or wetland - + allocate (theta_a_h (nhru)); theta_a_h = 0. allocate (zwt_h (nhru)); zwt_h = 0. allocate (Kl_h (nhru)); Kl_h = 0. DO i = 1, nhru - + IF (hrus%indx(i) == 0) CYCLE ! river IF (hrus%agwt(i) == 0) CYCLE ! no area of soil, urban or wetland @@ -222,14 +222,14 @@ SUBROUTINE subsurface_flow (deltime) IF (patchtype(ipatch) <= 2) THEN theta_s_h = theta_s_h + hru_patch%subfrc(ipatch) & * sum(porsl(1:nl_soil,ipatch) * dz_soi(1:nl_soil) & - - wice_soisno(1:nl_soil,ipatch)/denice) / sum(dz_soi(1:nl_soil)) + - wice_soisno(1:nl_soil,ipatch)/denice) / sum(dz_soi(1:nl_soil)) sumwt = sumwt + hru_patch%subfrc(ipatch) - ENDIF + ENDIF ENDDO IF (sumwt > 0) theta_s_h = theta_s_h / sumwt IF (theta_s_h > 0.) THEN - + air_h = 0. zwt_h(i) = 0. sumwt = 0. @@ -240,9 +240,9 @@ SUBROUTINE subsurface_flow (deltime) - wliq_soisno(1:nl_soil,ipatch)/denh2o & - wice_soisno(1:nl_soil,ipatch)/denice ) - wa(ipatch)/1.0e3) air_h = max(0., air_h) - + zwt_h(i) = zwt_h(i) + zwt(ipatch) * hru_patch%subfrc(ipatch) - + sumwt = sumwt + hru_patch%subfrc(ipatch) ENDIF ENDDO @@ -268,7 +268,7 @@ SUBROUTINE subsurface_flow (deltime) icefrac = min(1., wice_soisno(ilev,ipatch)/denice/dz_soi(ilev)/porsl(ilev,ipatch)) imped = 10.**(-e_ice*icefrac) Kl_h(i) = Kl_h(i) + hru_patch%subfrc(ipatch) * raniso(soiltext(ipatch)) & - * hksati(ilev,ipatch)/1.0e3 * imped * dz_soi(ilev)/zi_soi(nl_soil) + * hksati(ilev,ipatch)/1.0e3 * imped * dz_soi(ilev)/zi_soi(nl_soil) ENDDO sumwt = sumwt + hru_patch%subfrc(ipatch) ENDIF @@ -280,7 +280,7 @@ SUBROUTINE subsurface_flow (deltime) ENDIF ENDDO - + allocate (xsubs_h (nhru)) allocate (xsubs_fc (nhru)) @@ -288,22 +288,22 @@ SUBROUTINE subsurface_flow (deltime) xsubs_fc(:) = 0. DO i = 1, nhru - + j = hrus%inext(i) IF (j <= 0) CYCLE ! downstream is out of catchment IF (Kl_h(i) == 0.) CYCLE ! this HRU is frozen - + j_is_river = (hrus%indx(j) == 0) IF ((.not. j_is_river) .and. (Kl_h(j) == 0.)) CYCLE ! non-river downstream HRU is frozen - + zsubs_h_up = hrus%elva(i) - zwt_h(i) IF (.not. j_is_river) THEN zsubs_h_dn = hrus%elva(j) - zwt_h(j) ELSE - zsubs_h_dn = hrus%elva(1) - riverdpth(ibasin) + wdsrf_hru(hrus%ihru(1)) + zsubs_h_dn = hrus%elva(1) - riverdpth(ibasin) + wdsrf_hru(hrus%ihru(1)) ENDIF IF (.not. j_is_river) THEN @@ -343,7 +343,7 @@ SUBROUTINE subsurface_flow (deltime) ELSE cb = hrus%flen(i) * Kl_fc / delp / hrus%area(j) * deltime ENDIF - + xsubs_fc(i) = (zsubs_h_up - zsubs_h_dn) * hrus%flen(i) * Kl_fc / (1+ca+cb) / delp xsubs_h(i) = xsubs_h(i) + xsubs_fc(i) / hrus%agwt(i) @@ -353,12 +353,12 @@ SUBROUTINE subsurface_flow (deltime) ELSE xsubs_h(j) = xsubs_h(j) - xsubs_fc(i) / hrus%agwt(j) ENDIF - + ENDDO - + IF (hrus%indx(1) == 0) THEN ! xsubs_h(1) is positive = out of soil column - IF (xsubs_h(1)*deltime > wdsrf_bsn(ibasin)) THEN + IF (xsubs_h(1)*deltime > wdsrf_bsn(ibasin)) THEN alp = wdsrf_bsn(ibasin) / (xsubs_h(1)*deltime) xsubs_h(1) = xsubs_h(1) * alp DO i = 2, nhru @@ -368,33 +368,33 @@ SUBROUTINE subsurface_flow (deltime) ENDDO ENDIF ENDIF - + ! Update total subsurface lateral flow (1): Between hydrological units ! for soil, urban, wetland or river patches DO i = 1, nhru xsubs_hru(hrus%ihru(i)) = xsubs_h(i) - + ps = hru_patch%substt(hrus%ihru(i)) pe = hru_patch%subend(hrus%ihru(i)) DO ipatch = ps, pe - IF ((patchtype(ipatch) <= 2) .or. (hrus%indx(i) == 0)) THEN - xwsub(ipatch) = xwsub(ipatch) + xsubs_h(i) * 1.e3 ! (positive = out of soil column) + IF ((patchtype(ipatch) <= 2) .or. (hrus%indx(i) == 0)) THEN + xwsub(ipatch) = xwsub(ipatch) + xsubs_h(i) * 1.e3 ! (positive = out of soil column) ENDIF ENDDO IF (hrus%indx(1) == 0) THEN DO ipatch = ps, pe - IF (patchtype(ipatch) <= 2) THEN + IF (patchtype(ipatch) <= 2) THEN rsub(ipatch) = - xsubs_h(1) * riverarea(ibasin) / sum(hrus%agwt) * 1.0e3 ! m/s to mm/s ENDIF ENDDO ENDIF ENDDO - + DO i = 1, nhru ! Inside hydrological units IF (hrus%agwt(i) > 0) THEN - + IF (zwt_h(i) > 1.5) THEN ! from Fan et al., JGR 112(D10125) Kl_in = Kl_h(i) * bdamp * exp(-(zwt_h(i)-1.5)/bdamp) @@ -440,11 +440,11 @@ SUBROUTINE subsurface_flow (deltime) CALL retrieve_neighbour_data (wdsrf_bsn , wdsrf_nb ) DO ibasin = 1, numbasin - + hrus => hillslope_network(ibasin) - + iam_lake = (lake_id(ibasin) > 0) - + DO jnb = 1, elementneighbour(ibasin)%nnb IF (elementneighbour(ibasin)%glbindex(jnb) == -9) CYCLE ! skip ocean neighbour @@ -454,16 +454,16 @@ SUBROUTINE subsurface_flow (deltime) IF (iam_lake .and. nb_is_lake) THEN CYCLE ENDIF - + IF (.not. iam_lake) THEN Kl_up = Kl_bsn (ibasin) zwt_up = zwt_bsn (ibasin) theta_a_up = theta_a_bsn(ibasin) - zsubs_up = elementneighbour(ibasin)%myelva - zwt_up + zsubs_up = elementneighbour(ibasin)%myelva - zwt_up area_up = sum(hrus%agwt) ELSE theta_a_up = 1. - zsubs_up = elementneighbour(ibasin)%myelva + wdsrf_bsn(ibasin) + zsubs_up = elementneighbour(ibasin)%myelva + wdsrf_bsn(ibasin) area_up = elementneighbour(ibasin)%myarea ENDIF @@ -481,7 +481,7 @@ SUBROUTINE subsurface_flow (deltime) IF ((.not. iam_lake) .and. (area_up <= 0)) CYCLE IF ((.not. nb_is_lake) .and. (area_dn <= 0)) CYCLE - IF ((.not. iam_lake) .and. (Kl_up == 0. )) CYCLE + IF ((.not. iam_lake) .and. (Kl_up == 0. )) CYCLE IF ((.not. nb_is_lake) .and. (Kl_dn == 0. )) CYCLE ! water body is dry. @@ -491,7 +491,7 @@ SUBROUTINE subsurface_flow (deltime) IF (nb_is_lake .and. (zsubs_up < zsubs_dn) .and. (wdsrf_nb(ibasin)%val(jnb) == 0.)) THEN CYCLE ENDIF - + lenbdr = elementneighbour(ibasin)%lenbdr(jnb) delp = elementneighbour(ibasin)%dist(jnb) @@ -536,7 +536,7 @@ SUBROUTINE subsurface_flow (deltime) ELSE xsubs_nb = xsubs_nb / elementneighbour(ibasin)%myarea ENDIF - + xsubs_bsn(ibasin) = xsubs_bsn(ibasin) + xsubs_nb ENDDO @@ -560,15 +560,15 @@ SUBROUTINE subsurface_flow (deltime) ! Exchange between soil water and aquifer. IF (p_is_worker) THEN - + sp_zi(0) = 0. sp_zi(1:nl_soil) = zi_soi(1:nl_soil) * 1000.0 ! from meter to mm sp_dz(1:nl_soil) = sp_zi(1:nl_soil) - sp_zi(0:nl_soil-1) - + DO ipatch = 1, numpatch #if(defined CoLMDEBUG) - ! For water balance check, the sum of water in soil column before the calcultion + ! For water balance check, the sum of water in soil column before the calculation w_sum_before = sum(wliq_soisno(1:nl_soil,ipatch)) + sum(wice_soisno(1:nl_soil,ipatch)) & + wa(ipatch) + wdsrf(ipatch) + wetwat(ipatch) #endif @@ -579,7 +579,7 @@ SUBROUTINE subsurface_flow (deltime) is_dry_lake = .false. ENDIF - IF ((patchtype(ipatch) <= 1) .or. is_dry_lake) THEN + IF ((patchtype(ipatch) <= 1) .or. is_dry_lake) THEN exwater = xwsub(ipatch) * deltime @@ -611,10 +611,10 @@ SUBROUTINE subsurface_flow (deltime) wresi(ilev) = 0. ENDIF ENDDO - + zwtmm = zwt(ipatch) * 1000. ! m -> mm - ! check consistancy between water table location and liquid water content + ! check consistency between water table location and liquid water content DO ilev = 1, nl_soil IF ((vol_liq(ilev) < eff_porosity(ilev)-1.e-8) .and. (zwtmm <= sp_zi(ilev-1))) THEN zwtmm = sp_zi(ilev) @@ -643,7 +643,7 @@ SUBROUTINE subsurface_flow (deltime) nl_soil, exwater, sp_zi, is_permeable, eff_porosity, vl_r, psi0(:,ipatch), & hksati(:,ipatch), nprms, prms, porsl(nl_soil,ipatch), wdsrf(ipatch), & vol_liq, zwtmm, wa(ipatch), izwt) - + ! update the mass of liquid water DO ilev = nl_soil, 1, -1 IF (is_permeable(ilev)) THEN @@ -682,11 +682,11 @@ SUBROUTINE subsurface_flow (deltime) ENDIF ELSEIF (patchtype(ipatch) == 4) THEN ! land water bodies - + wdsrf(ipatch) = wa(ipatch) + wdsrf(ipatch) - xwsub(ipatch)*deltime IF (wdsrf(ipatch) < 0) THEN - wa (ipatch) = wdsrf(ipatch) + wa (ipatch) = wdsrf(ipatch) wdsrf(ipatch) = 0 ELSE wa(ipatch) = 0 @@ -695,7 +695,7 @@ SUBROUTINE subsurface_flow (deltime) ENDIF #if(defined CoLMDEBUG) - ! For water balance check, the sum of water in soil column after the calcultion + ! For water balance check, the sum of water in soil column after the calculation w_sum_after = sum(wliq_soisno(1:nl_soil,ipatch)) + sum(wice_soisno(1:nl_soil,ipatch)) & + wa(ipatch) + wdsrf(ipatch) + wetwat(ipatch) errblc = w_sum_after - w_sum_before + xwsub(ipatch)*deltime @@ -723,7 +723,7 @@ SUBROUTINE basin_neighbour_final () IF (allocated(wdsrf_nb )) deallocate(wdsrf_nb ) IF (allocated(agwt_nb )) deallocate(agwt_nb ) IF (allocated(islake_nb )) deallocate(islake_nb ) - + END SUBROUTINE basin_neighbour_final END MODULE MOD_Catch_SubsurfaceFlow diff --git a/main/HYDRO/MOD_Hydro_SoilWater.F90 b/main/HYDRO/MOD_Hydro_SoilWater.F90 index 9bc2d0ed..b7b70a0c 100644 --- a/main/HYDRO/MOD_Hydro_SoilWater.F90 +++ b/main/HYDRO/MOD_Hydro_SoilWater.F90 @@ -4,8 +4,8 @@ MODULE MOD_Hydro_SoilWater !------------------------------------------------------------------------- ! Description: -! -! Numerical Solver of Richards equation. +! +! Numerical Solver of Richards equation. ! ! Dai, Y., Zhang, S., Yuan, H., & Wei, N. (2019). ! Modeling Variably Saturated Flow in Stratified Soils @@ -25,11 +25,11 @@ MODULE MOD_Hydro_SoilWater ! public subroutines and functions PUBLIC :: soil_water_vertical_movement PUBLIC :: get_water_equilibrium_state - PUBLIC :: soilwater_aquifer_exchange + PUBLIC :: soilwater_aquifer_exchange ! boundary condition: ! 1: fixed pressure head - ! 2: rainfall condition with a ponding layer on top of groud surface + ! 2: rainfall condition with a ponding layer on top of ground surface ! and a flux such as rainfall into the ponding layer ! 3: fixed flux ! 4: drainage condition with aquifers below soil columns @@ -192,10 +192,10 @@ SUBROUTINE soil_water_vertical_movement ( & real(r8), intent(in) :: prms (nprm,1:nlev) ! parameters included in soil function real(r8), intent(in) :: porsl_wa ! soil porosity in aquifer (mm^3/mm^3) - + ! ground water including rain, snow melt and dew formation (mm/s) - real(r8), intent(in) :: qgtop - + real(r8), intent(in) :: qgtop + real(r8), intent(in) :: etr ! transpiration rate (mm/s) real(r8), intent(in) :: rootr(1:nlev) ! root fractions (percentage) real(r8), intent(in) :: rootflux(1:nlev) ! root water uptake from different layers (mm/s) @@ -291,7 +291,7 @@ SUBROUTINE soil_water_vertical_movement ( & IF (ss_vliq(ilev) < 0) THEN deficit = ( - ss_vliq(ilev)) * sp_dz(ilev) - ss_vliq(ilev) = 0 + ss_vliq(ilev) = 0 ELSEIF (ss_vliq(ilev) > porsl(ilev)) THEN deficit = - (ss_vliq(ilev) - porsl(ilev)) * sp_dz(ilev) ss_vliq(ilev) = porsl(ilev) @@ -323,7 +323,7 @@ SUBROUTINE soil_water_vertical_movement ( & ENDDO ! Impermeable levels cut the soil column into several disconnected parts. - ! The Richards solver is called to calcute water movement part by part. + ! The Richards solver is called to calculate water movement part by part. ub = nlev soilcolumn : DO WHILE (ub >= 1) @@ -460,13 +460,13 @@ END SUBROUTINE soil_water_vertical_movement SUBROUTINE soilwater_aquifer_exchange ( & nlev, exwater, sp_zi, is_permeable, porsl, vl_r, psi_s, hksat, & nprm, prms, porsl_wa, ss_dp, ss_vliq, zwt, wa, izwt) - + IMPLICIT NONE integer, intent(in) :: nlev real(r8), intent(in) :: exwater ! total water exchange [mm] - + real(r8), intent(in) :: sp_zi (0:nlev) ! soil parameter : interfaces of level [mm] logical, intent(in) :: is_permeable (1:nlev) @@ -479,7 +479,7 @@ SUBROUTINE soilwater_aquifer_exchange ( & real(r8), intent(in) :: prms (nprm,1:nlev) ! parameters included in soil function real(r8), intent(in) :: porsl_wa ! soil porosity in aquifer [mm^3/mm^3] - + real(r8), intent(inout) :: ss_dp ! depth of ponding water [mm] real(r8), intent(inout) :: ss_vliq(1:nlev) ! volume content of liquid water [mm^3/mm^3] real(r8), intent(inout) :: zwt ! location of water table [mm] @@ -501,10 +501,10 @@ SUBROUTINE soilwater_aquifer_exchange ( & ! water table location izwt = findloc_ud(zwt >= sp_zi, back=.true.) - reswater = exwater + reswater = exwater IF (reswater > 0.) THEN - + IF ((zwt <= 0.) .and. (ss_dp > 0.)) THEN IF (ss_dp > reswater) THEN ss_dp = ss_dp - reswater @@ -512,7 +512,7 @@ SUBROUTINE soilwater_aquifer_exchange ( & ELSE reswater = reswater - ss_dp ss_dp = 0. - ENDIF + ENDIF ENDIF ! remove water from aquifer @@ -640,10 +640,10 @@ SUBROUTINE Richards_solver ( & real(r8), intent(inout) :: ss_wt (lb:ub) ! soil water state : location of water table (mm) real(r8), intent(out) :: ss_q (lb-1:ub) ! soil water state : flux between levels (mm/s) - real(r8), intent(in) :: tol_q ! tolerence for flux - real(r8), intent(in) :: tol_z ! tolerence for locations - real(r8), intent(in) :: tol_v ! tolerence for volumetric water content - real(r8), intent(in) :: tol_p ! tolerence for potential head + real(r8), intent(in) :: tol_q ! tolerance for flux + real(r8), intent(in) :: tol_z ! tolerance for locations + real(r8), intent(in) :: tol_v ! tolerance for volumetric water content + real(r8), intent(in) :: tol_p ! tolerance for potential head ! Local variables real(r8) :: zwt ! location of water table (mm) @@ -723,7 +723,7 @@ SUBROUTINE Richards_solver ( & wf_m1 = ss_wf vl_m1 = ss_vl wt_m1 = ss_wt - + wsum_m1 = sum(ss_vl * (sp_dz - ss_wt)) + sum(ss_wt * vl_s) IF (ubc_typ == BC_RAINFALL) THEN wsum_m1 = wsum_m1 + ss_dp @@ -1778,7 +1778,7 @@ SUBROUTINE flux_all ( & CASE (BC_RAINFALL) IF (has_wf(lb) .and. (wf(lb) >= tol_z)) THEN - + qq(lb-1) = - hksat(lb) * ((psi_s(lb) - dp) / wf(lb) - 1) ELSE @@ -2665,7 +2665,7 @@ real(r8) FUNCTION flux_inside_hm_soil ( & psi_s, hksat, nprm, prms, & dz, psi_u, psi_l, hk_u, hk_l) - IMPLICIT NONE + IMPLICIT NONE real(r8), intent(in) :: psi_s, hksat integer, intent(in) :: nprm @@ -2838,7 +2838,7 @@ SUBROUTINE flux_top_transitive_interface ( & nlev_sat, dz_sat, psi_sat, hk_sat, psi_btm, & q_us_up, qlc, tol_q, tol_z, tol_p, flux_btm) - IMPLICIT NONE + IMPLICIT NONE real(r8), intent(in) :: psi_s_u, hksat_u integer, intent(in) :: nprm @@ -3184,7 +3184,7 @@ SUBROUTINE flux_both_transitive_interface ( & q_us_u, q_us_l, qlc, & tol_q, tol_z, tol_p) - IMPLICIT NONE + IMPLICIT NONE integer, intent(in) :: ilev_us_u, ilev_us_l real(r8), intent(in) :: dz (ilev_us_u:ilev_us_l) @@ -3550,10 +3550,10 @@ END FUNCTION find_unsat_lev_lower ! ----- SUBROUTINE print_VSF_iteration_stat_info () - + USE MOD_SPMD_Task IMPLICIT NONE - + integer(8), SAVE :: count_implicit_accum = 0 integer(8), SAVE :: count_explicit_accum = 0 integer(8), SAVE :: count_wet2dry_accum = 0 @@ -3570,7 +3570,7 @@ SUBROUTINE print_VSF_iteration_stat_info () count_implicit_accum = count_implicit_accum + count_implicit count_explicit_accum = count_explicit_accum + count_explicit count_wet2dry_accum = count_wet2dry_accum + count_wet2dry - + #ifdef USEMPI CALL mpi_send (count_implicit, 1, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) CALL mpi_send (count_explicit, 1, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) diff --git a/main/HYDRO/MOD_Hydro_VIC_Variables.F90 b/main/HYDRO/MOD_Hydro_VIC_Variables.F90 index cca4e2a6..39f2acb5 100644 --- a/main/HYDRO/MOD_Hydro_VIC_Variables.F90 +++ b/main/HYDRO/MOD_Hydro_VIC_Variables.F90 @@ -55,7 +55,7 @@ module MOD_Hydro_VIC_Variables real(r8) :: Dsmax ! /**< Maximum subsurface flow rate (mm/day) */ real(r8) :: c ! /**< Exponent in ARNO baseflow scheme */ real(r8) :: depth(MAX_LAYERS) ! /**< Thickness of each soil moisture layer (m) */ - !!! for zwt calcaulation, not used + !!! for zwt calculation, not used real(r8) :: bubble(MAX_LAYERS) ! /**< Bubbling pressure, HBH 5.15 (cm) real(r8) :: zwtvmoist_zwt(MAX_LAYERS + 2, MAX_ZWTVMOIST) ! /**< Zwt values in the zwt-v-moist curve for each layer */ real(r8) :: zwtvmoist_moist(MAX_LAYERS + 2, MAX_ZWTVMOIST) ! /**< Moist values in the zwt-v-moist curve for each layer */ diff --git a/main/HYDRO/MOD_Hydro_Vars_1DFluxes.F90 b/main/HYDRO/MOD_Hydro_Vars_1DFluxes.F90 index 4dbdd139..d222336e 100644 --- a/main/HYDRO/MOD_Hydro_Vars_1DFluxes.F90 +++ b/main/HYDRO/MOD_Hydro_Vars_1DFluxes.F90 @@ -4,12 +4,12 @@ MODULE MOD_Hydro_Vars_1DFluxes !------------------------------------------------------------------------------------- ! DESCRIPTION: -! +! ! 1D fluxes in lateral hydrological processes. ! ! Created by Shupeng Zhang, May 2023 !------------------------------------------------------------------------------------- - + USE MOD_Precision IMPLICIT NONE @@ -24,18 +24,18 @@ MODULE MOD_Hydro_Vars_1DFluxes real(r8), allocatable :: wdsrf_hru_ta (:) ! time step average of surface water depth [m] real(r8), allocatable :: momen_hru_ta (:) ! time step average of surface water momentum [m^2/s] - real(r8), allocatable :: veloc_hru_ta (:) ! time step average of surface water veloctiy [m/s] - + real(r8), allocatable :: veloc_hru_ta (:) ! time step average of surface water velocity [m/s] + real(r8), allocatable :: xwsur (:) ! surface water exchange [mm h2o/s] real(r8), allocatable :: xwsub (:) ! subsurface water exchange [mm h2o/s] - + real(r8), allocatable :: discharge (:) ! river discharge [m^3/s] ! PUBLIC MEMBER FUNCTIONS: PUBLIC :: allocate_1D_HydroFluxes PUBLIC :: deallocate_1D_HydroFluxes -CONTAINS +CONTAINS SUBROUTINE allocate_1D_HydroFluxes @@ -80,15 +80,15 @@ SUBROUTINE deallocate_1D_HydroFluxes IF (allocated(xsubs_pch)) deallocate(xsubs_pch) IF (allocated(xsubs_hru)) deallocate(xsubs_hru) IF (allocated(xsubs_bsn)) deallocate(xsubs_bsn) - + IF (allocated(wdsrf_bsn_ta)) deallocate(wdsrf_bsn_ta) IF (allocated(momen_riv_ta)) deallocate(momen_riv_ta) IF (allocated(veloc_riv_ta)) deallocate(veloc_riv_ta) - + IF (allocated(wdsrf_hru_ta)) deallocate(wdsrf_hru_ta) IF (allocated(momen_hru_ta)) deallocate(momen_hru_ta) IF (allocated(veloc_hru_ta)) deallocate(veloc_hru_ta) - + IF (allocated(xwsur)) deallocate(xwsur) IF (allocated(xwsub)) deallocate(xwsub) diff --git a/preprocess/aggregation_landtypes.F90 b/preprocess/aggregation_landtypes.F90 index 639caa72..2af9367d 100644 --- a/preprocess/aggregation_landtypes.F90 +++ b/preprocess/aggregation_landtypes.F90 @@ -265,7 +265,7 @@ SUBROUTINE aggregation_landtypes ( dir_rawdata,dir_model_landdata, & fraction_patches(15,i,j) = f_glacier_patches ! MODIS IGBP GLACIER/ICE SHEET (15) #endif Loca = maxloc(fraction_patches(:,i,j)) ! maxloc get the Loca: 1 - N_land_classification + 1 - nn = Loca(1) - 1 ! the definition of demension of fraction_patches: 0 - N_land_classification + nn = Loca(1) - 1 ! the definition of dimension of fraction_patches: 0 - N_land_classification fraction_patches(nn,i,j) = err_f_glacier + fraction_patches(nn,i,j) endif diff --git a/preprocess/rawdata_soil_hydraulic_parameters.F90 b/preprocess/rawdata_soil_hydraulic_parameters.F90 index cb6bafbc..18574062 100644 --- a/preprocess/rawdata_soil_hydraulic_parameters.F90 +++ b/preprocess/rawdata_soil_hydraulic_parameters.F90 @@ -17,9 +17,9 @@ SUBROUTINE soil_hydraulic_parameters(BD,SAND,CLAY,SOC,SOILDEPTH,& ! ! Original author: Yongjiu Dai, Wei Shangguan, 12/2013/ ! -! Rivisions: +! Revisions: ! Yongjiu Dai, Nan Wei and Yonggen Zhang, -! 06/2018: add more highly cited or newly developped soil Pedotransfer functions. +! 06/2018: add more highly cited or newly developed soil Pedotransfer functions. ! Nan Wei, 01/2019: add algorithms for fitting soil hydraulic parameters by multiple soil Pedotransfer functions. ! Yongjiu Dai and Nan Wei, ! 06/2019: consider the gravel effects on soil hydraulic parameters @@ -111,9 +111,9 @@ SUBROUTINE CampBC(BD,SAND,CLAY,SOM,SOC,phi,psi_s,lambda_s) ! ! Original author: Yongjiu Dai, Wei Shangguan, 12/2013/ ! -! Rivisions: +! Revisions: ! Yongjiu Dai, Nan Wei and Yonggen Zhang, -! 06/2018: add more highly cited or newly developped soil Pedotransfer functions. +! 06/2018: add more highly cited or newly developed soil Pedotransfer functions. ! Nan Wei, 01/2019: add algorithms for fitting soil hydraulic parameters by multiple soil Pedotransfer functions. ! ---------------------------------------------------- use MOD_Precision @@ -131,7 +131,7 @@ SUBROUTINE CampBC(BD,SAND,CLAY,SOM,SOC,phi,psi_s,lambda_s) REAL(r8), INTENT(OUT) :: lambda_s ! integer, parameter :: nc = 8 ! the number of PTFs in estimating SW retention parameters in the Campbell model -logical c(12) ! indicate wheather a soil is in an class +logical c(12) ! indicate whether a soil is in an class ! soil_classes=c('Sa','LoSa','SaLo','Lo','SaClLo','SaCl','ClLo','SiLo','Si','SiClLo','SiCl','Cl') REAL(r8) CH_b(12),CH_ths(12),CH_psi_s(12) @@ -385,9 +385,9 @@ SUBROUTINE VGM(BD,sand,clay,SOM,SOC,TOPSOIL,phi,theta_r_l,alpha_l,n_l,L_l,& ! ! Original author: Yongjiu Dai, Wei Shangguan, 12/2013/ ! -! Rivisions: +! Revisions: ! Yongjiu Dai, Nan Wei and Yonggen Zhang, -! 06/2018: add more highly cited or newly developped soil Pedotransfer functions. +! 06/2018: add more highly cited or newly developed soil Pedotransfer functions. ! Nan Wei, 01/2019: add algorithms for fitting soil hydraulic parameters by multiple soil Pedotransfer functions. ! ---------------------------------------------------- use MOD_Precision @@ -437,7 +437,7 @@ SUBROUTINE VGM(BD,sand,clay,SOM,SOC,TOPSOIL,phi,theta_r_l,alpha_l,n_l,L_l,& data PRawls02/0.0,100.0,200.0,330.0,600.0,1000.0,2000.0,4000.0,7000.0,10000.0,15000.0/ data PRawls03/0.0,200.0,300.0,600.0,1000.0,2000.0,4000.0,7000.0,10000.0,15000.0/ -logical c(12) ! indicate wheather a soil is in an class +logical c(12) ! indicate whether a soil is in an class REAL(r8) CP_thr(12),CP_alpha(12),CP_n(12) data CP_thr /0.045,0.057,0.065,0.078,0.095,0.1 ,0.095,0.067,0.034,0.089,0.07 ,0.068/ data CP_alpha/0.145,0.124,0.075,0.036,0.019,0.027,0.019,0.02 ,0.016,0.01 ,0.005,0.008/ @@ -761,8 +761,8 @@ SUBROUTINE ksat(BD,SOM,SOC,SAND,CLAY,TOPSOIL,phi,psi,lambda,k_s,k_s_Rose) ! ! Original author: Yongjiu Dai, Wei Shangguan, 12/2013/ ! -! Rivisions: -! Yongjiu Dai, Nan Wei and Yonggen Zhang, 06/2018: add more highly cited or newly developped soil Pedotransfer functions. +! Revisions: +! Yongjiu Dai, Nan Wei and Yonggen Zhang, 06/2018: add more highly cited or newly developed soil Pedotransfer functions. ! ---------------------------------------------------- use MOD_Precision @@ -786,7 +786,7 @@ SUBROUTINE ksat(BD,SOM,SOC,SAND,CLAY,TOPSOIL,phi,psi,lambda,k_s,k_s_Rose) real(r8) :: theta_33 ! the water content at a potential of -33 kPa real(r8) :: phi_e ! phi minus theta_33 real(r8) x,B,zs,z33,zs33,z1500,lam_g,d_g,sigma_g -logical c(12) ! indicate wheather a soil is in an class +logical c(12) ! indicate whether a soil is in an class integer itype real params(7,10) data params/0.025,0.403,0.0383,1.3774,0.2740, 1.2500,60.000, & diff --git a/preprocess/rawdata_soil_solids_fractions.F90 b/preprocess/rawdata_soil_solids_fractions.F90 index c2825427..b4308ef2 100644 --- a/preprocess/rawdata_soil_solids_fractions.F90 +++ b/preprocess/rawdata_soil_solids_fractions.F90 @@ -172,7 +172,7 @@ SUBROUTINE vf_quartz(sand,clay,vf_quartz_s) real(r8) silt integer, parameter :: PNUM=12 ! number of polygons(texture classes) - logical c(PNUM) ! indicate wheather a soil is in an class + logical c(PNUM) ! indicate whether a soil is in an class integer i vf_quartz_s = 0.0 @@ -216,17 +216,17 @@ SUBROUTINE USDA_soil_classes(x,y,c) integer, parameter :: PONUM(PNUM)=(/5,3,4,6,4,5,5,8,7,4,4,3/) ! number of points in a polygon (texture class) real(r8), intent(in) :: x ! x(silt) of a soil real(r8), intent(in) :: y ! y(clay) of a soil - logical, intent(out) :: c(PNUM) ! indicate wheather a soil is in an class + logical, intent(out) :: c(PNUM) ! indicate whether a soil is in an class integer i,j real(r8) :: xpos(TNUM) ! x(silt) coordinates of the points in the triangle real(r8) :: ypos(TNUM) ! y(clay) coordinates of the points in the triangle - integer :: points(PNUM,8) ! sequence number of the points in a poygon (texture class) + integer :: points(PNUM,8) ! sequence number of the points in a polygon (texture class) ! 8 is the maximun number of the points character(len=15) :: tnames(PNUM) ! name of a texture class integer :: tcodes(PNUM) ! code of a texture class, may be change accordingly - real(r8) :: xpol(8) ! x(silt) coordinates of the points in a poygon - real(r8) :: ypol(8) ! y(clay) coordinates of the points in a poygon + real(r8) :: xpol(8) ! x(silt) coordinates of the points in a polygon + real(r8) :: ypol(8) ! y(clay) coordinates of the points in a polygon xpos = (/ 0.0, 40.0, 0.0, 20.0, 15.0, 40.0, 60.0, 0.0, 27.5, 27.5, 50.0, 52.5,& 72.5, 0.0, 0.0, 40.0, 50.0, 80.0, 87.5, 15.0, 30.0, 50.0, 80.0, 0.0,& @@ -294,7 +294,7 @@ SUBROUTINE pointinpolygon(xp,yp,xpol,ypol,ponum,c) integer, intent(in) :: ponum ! number of points in a polygon real(r8), intent(in) :: xp, yp ! x, y of a point real(r8), intent(in) :: xpol(ponum), ypol(ponum) - logical, intent(out) :: c ! indicate wheather a soil is in an class + logical, intent(out) :: c ! indicate whether a soil is in an class integer i, i1 ! point index; i1 = i-1 mod n real(r8) x ! x intersection of e with ray @@ -345,7 +345,7 @@ SUBROUTINE pointinpolygon(xp,yp,xpol,ypol,ponum,c) else if( mod(Rcross,2) .NE. mod(Lcross, 2) )then c = .true. c2 = 'e' - ! q inside iff an odd number of crossings. + ! q inside if an odd number of crossings. else if( mod(Rcross,2) == 1 )then c = .true. c2 = 'i' diff --git a/preprocess/rawdata_soil_thermal_parameters.F90 b/preprocess/rawdata_soil_thermal_parameters.F90 index 26d39014..9f60839c 100644 --- a/preprocess/rawdata_soil_thermal_parameters.F90 +++ b/preprocess/rawdata_soil_thermal_parameters.F90 @@ -121,7 +121,7 @@ SUBROUTINE soil_thermal_parameters(wf_gravels_s,wf_sand_s,wf_clay_s,& k_gravels_wet = 2.875 ! Cote and Konrad(2005), Thermal conductivity of base-course materials, ! mean value of Table 3 -! The thermal conductivty of non-quartz soil minerals +! The thermal conductivity of non-quartz soil minerals if(vf_quartz_mineral_s > 0.2)then ! non-quartz soil minerals k_minerals_o = 2.0 else ! coarse-grained soil with low quartz contents diff --git a/preprocess/rd_land_types.F90 b/preprocess/rd_land_types.F90 index bb1b5b4b..6c712512 100644 --- a/preprocess/rd_land_types.F90 +++ b/preprocess/rd_land_types.F90 @@ -3,13 +3,13 @@ SUBROUTINE rd_land_types(dir_rawdata) ! ---------------------------------------------------------------------- ! => Read in land cover dataset from original "raw" data files - ! data with 30 arc seconds resolution -! => Fill the missing data +! => Fill the missing data ! => Correct and update the land types with the specific datasets ! ! 1. Global Elevation Dataset (GTOPO30) ! (http://webgis.wr.usgs.gov/globalgis/gtopo30/) ! The elevation values range from -407 to 8,752 meters. -! ocean areas have been assigned a value of -9999. +! ocean areas have been assigned a value of -9999. ! ! 2. Global Land Cover Characteristics ! 2.1 GLCC USGS Land cover /land use types @@ -62,7 +62,7 @@ SUBROUTINE rd_land_types(dir_rawdata) ! 16 Barren or Sparsely Vegetated ! 17 Land Water Bodies ! -! 2.3 PFT classification (ON GOING PROJECT ......) +! 2.3 PFT classification (ON GOING PROJECT ......) ! ! 3. Global Glacier/Ice Sheet Characteristics ! (http://www.glims.org/RGI/; http://glims.colorado.edu/glacierdata/) @@ -98,7 +98,7 @@ SUBROUTINE rd_land_types(dir_rawdata) IMPLICIT NONE ! arguments: - character(len=256), intent(in) :: dir_rawdata + character(len=256), intent(in) :: dir_rawdata ! local variables: integer, parameter :: nlat=21600 ! 180*(60*2) @@ -125,7 +125,7 @@ SUBROUTINE rd_land_types(dir_rawdata) ! (2) global land cover characteristics ! --------------------------------- #if(defined LULC_USGS) - integer, allocatable :: landtypes_usgs(:,:) ! GLCC USGS land cover types + integer, allocatable :: landtypes_usgs(:,:) ! GLCC USGS land cover types #endif #if(defined LULC_IGBP) integer, allocatable :: landtypes_igbp(:,:) ! MODIS IGBP land cover types @@ -135,19 +135,19 @@ SUBROUTINE rd_land_types(dir_rawdata) ! ------------------------------ real(r8), allocatable :: glacier(:,:) ! glacier coverage (%) - ! (4) global lakes and wetlands characteristics + ! (4) global lakes and wetlands characteristics ! ----------------------------------------- integer, allocatable :: lakewetland(:,:) ! land water and wetland types - ! (5) global urban and build-up land characteristics + ! (5) global urban and build-up land characteristics ! ----------------------------------------- - integer, allocatable :: urban(:,:) ! urban and built-up land + integer, allocatable :: urban(:,:) ! urban and built-up land ! --------------------------------------------------------------- integer ia integer i, j, L integer nrow, ncol - integer iunit + integer iunit integer length character c @@ -155,8 +155,8 @@ SUBROUTINE rd_land_types(dir_rawdata) integer ii, iii, iiii, jj, jjj, jjjj integer nl, np - integer, allocatable :: exclude(:) - integer, allocatable :: ntmp(:,:) + integer, allocatable :: exclude(:) + integer, allocatable :: ntmp(:,:) integer :: buff_lb integer :: buff_ub @@ -176,13 +176,13 @@ SUBROUTINE rd_land_types(dir_rawdata) ! Initialize MPI tasks #if (defined usempi) nrow_start = fine_lat_map%bdisp(1) + 1 - nrow_end = fine_lat_map%bdisp(1) + fine_lat_map%bstrd(1) + nrow_end = fine_lat_map%bdisp(1) + fine_lat_map%bstrd(1) buff_lb = max(nrow_start-rmax, 1) buff_ub = min(nrow_end +rmax, nlat) allocate (buff_fine_lat_map%bstrd(1)) allocate (buff_fine_lat_map%bdisp(1)) - + buff_fine_lat_map%total = nlat buff_fine_lat_map%num = buff_ub - buff_lb + 1 @@ -192,22 +192,22 @@ SUBROUTINE rd_land_types(dir_rawdata) #else nrow_start = 1 nrow_end = nlat - buff_lb = 1 + buff_lb = 1 buff_ub = nlat #endif ! --------------------------------------------------------------- -! +! allocate ( elevation (nlon,buff_lb:buff_ub) ,& #if(defined LULC_USGS) - landtypes_usgs (nlon,buff_lb:buff_ub) ,& + landtypes_usgs (nlon,buff_lb:buff_ub) ,& #endif #if(defined LULC_IGBP) - landtypes_igbp (nlon,buff_lb:buff_ub) ,& + landtypes_igbp (nlon,buff_lb:buff_ub) ,& #endif lakewetland (nlon,buff_lb:buff_ub) ,& - glacier (nlon,buff_lb:buff_ub) ,& - urban (nlon,buff_lb:buff_ub) ) + glacier (nlon,buff_lb:buff_ub) ,& + urban (nlon,buff_lb:buff_ub) ) ! ---------------------------------------------------------------------- ! ... (1) global digital elevation model (DEM) data @@ -221,7 +221,7 @@ SUBROUTINE rd_land_types(dir_rawdata) fdisp = 0 call mpi_rdwr_data (lndname, 'read', fdisp, buff_fine_lat_map, nlon*2, land_chr2) - do nrow = buff_lb, buff_ub + do nrow = buff_lb, buff_ub do ncol = 1, nlon elevation(ncol,nrow) = ia(land_chr2(ncol,nrow),2,-9999) enddo @@ -230,8 +230,8 @@ SUBROUTINE rd_land_types(dir_rawdata) #else iunit = 100 inquire(iolength=length) land_chr2 - open(iunit,file=trim(lndname),access='direct',recl=length,form='unformatted',status='old') - do nrow = 1, nlat + open(iunit,file=trim(lndname),access='direct',recl=length,form='unformatted',status='old') + do nrow = 1, nlat read(iunit,rec=nrow,err=100) land_chr2 do ncol = 1, nlon elevation(ncol,nrow) = ia(land_chr2(ncol),2,-9999) @@ -241,7 +241,7 @@ SUBROUTINE rd_land_types(dir_rawdata) #endif ii=0 - do nrow = nrow_start, nrow_end + do nrow = nrow_start, nrow_end do ncol = 1, nlon if( elevation(ncol,nrow) < -9990)then ii = ii + 1 @@ -266,15 +266,15 @@ SUBROUTINE rd_land_types(dir_rawdata) if (p_master) print*,'ii=', ii ! ........................................ -! ... (2) gloabl land cover characteristics +! ... (2) gloabl land cover characteristics ! ........................................ -! (2.1) global land cover type (version 2.0) (USGS) +! (2.1) global land cover type (version 2.0) (USGS) #if(defined LULC_USGS) ! GLCC USGS classification ! ------------------- - lndname = trim(dir_rawdata)//'landtypes/landtypes-usgs.bin' + lndname = trim(dir_rawdata)//'landtypes/landtypes-usgs.bin' if (p_master) print*,trim(lndname) #if (defined usempi) @@ -284,15 +284,15 @@ SUBROUTINE rd_land_types(dir_rawdata) landtypes_usgs = ichar(land_chr1) deallocate (land_chr1) #else - iunit = 100 - inquire(iolength=length) land_chr1 - open(iunit,file=trim(lndname),access='direct',recl=length,form='unformatted',status='old') - do nrow = 1, nlat - read(iunit,rec=nrow,err=100) land_chr1 - do ncol = 1, nlon - landtypes_usgs(ncol,nrow) = ichar(land_chr1(ncol)) - enddo - enddo + iunit = 100 + inquire(iolength=length) land_chr1 + open(iunit,file=trim(lndname),access='direct',recl=length,form='unformatted',status='old') + do nrow = 1, nlat + read(iunit,rec=nrow,err=100) land_chr1 + do ncol = 1, nlon + landtypes_usgs(ncol,nrow) = ichar(land_chr1(ncol)) + enddo + enddo close (iunit) #endif @@ -300,7 +300,7 @@ SUBROUTINE rd_land_types(dir_rawdata) iii = 0 iiii = 0 jjj = 0 - do nrow = nrow_start, nrow_end + do nrow = nrow_start, nrow_end do ncol = 1, nlon if(elevation(ncol,nrow) > -9990) then if(landtypes_usgs(ncol,nrow) == 16) then @@ -320,7 +320,7 @@ SUBROUTINE rd_land_types(dir_rawdata) if(elevation(ncol,nrow) < -9990) then landtypes_usgs(ncol,nrow) = 0 endif - enddo + enddo enddo int_min = minval(landtypes_usgs(:,nrow_start:nrow_end)) int_max = maxval(landtypes_usgs(:,nrow_start:nrow_end)) @@ -421,14 +421,14 @@ SUBROUTINE rd_land_types(dir_rawdata) if (p_master) print*, int_min, int_max if (p_master) print*,' MODIS IGBP land cover ' if (p_master) print*,'land water points =', ii, 'wetland points=', iii, 'glacier points=', iiii, 'urban points=', jjj -#endif +#endif ! ................................................ -! ... (3) global lakes and wetland characterristics +! ... (3) global lakes and wetland characteristics ! ................................................ -! (3.1) global lakes and wetland +! (3.1) global lakes and wetland - lndname = trim(dir_rawdata)//'lake_wetland/glwd.bin' + lndname = trim(dir_rawdata)//'lake_wetland/glwd.bin' if (p_master) print*,trim(lndname) #if (defined usempi) @@ -440,19 +440,19 @@ SUBROUTINE rd_land_types(dir_rawdata) #else iunit = 100 inquire(iolength=length) land_chr1 - open(iunit,file=trim(lndname),access='direct',recl=length,form='unformatted',status='old') - do nrow = 1, nlat + open(iunit,file=trim(lndname),access='direct',recl=length,form='unformatted',status='old') + do nrow = 1, nlat read(iunit,rec=nrow,err=100) land_chr1 do ncol = 1, nlon lakewetland(ncol,nrow) = ichar(land_chr1(ncol)) enddo - enddo + enddo close (iunit) #endif ii = 0 iii = 0 - do nrow = nrow_start, nrow_end + do nrow = nrow_start, nrow_end do ncol = 1, nlon if(elevation(ncol,nrow)>-9990) then ! Replace GLCC_USGS and MODIS_IGBP water bodies with GLWD classification @@ -478,12 +478,12 @@ SUBROUTINE rd_land_types(dir_rawdata) !#endif ! iii = iii + 1 ! endif - if(nrow > 18000)then ! (90N + 60S) * 120 + if(nrow > 18000)then ! (90N + 60S) * 120 lakewetland(ncol,nrow) = 255 endif endif enddo - enddo + enddo int_min = minval(lakewetland(:,nrow_start:nrow_end)) int_max = maxval(lakewetland(:,nrow_start:nrow_end)) #if (defined usempi) @@ -505,10 +505,10 @@ SUBROUTINE rd_land_types(dir_rawdata) if (p_master) print*,'land water (1-3) =', ii, 'wetland (4-12) =',iii ! ...................................... -! ... (4) global glacier and ice sheet characterristics +! ... (4) global glacier and ice sheet characteristics ! ...................................... - lndname = trim(dir_rawdata)//'glacier/glacier.bin' + lndname = trim(dir_rawdata)//'glacier/glacier.bin' if (p_master) print*,trim(lndname) #if (defined usempi) @@ -520,18 +520,18 @@ SUBROUTINE rd_land_types(dir_rawdata) #else iunit = 100 inquire(iolength=length) land_int2 - open(iunit,file=trim(lndname),access='direct',recl=length,form='unformatted',status='old') - do nrow = 1, nlat + open(iunit,file=trim(lndname),access='direct',recl=length,form='unformatted',status='old') + do nrow = 1, nlat read(iunit,rec=nrow,err=100) land_int2 do ncol = 1, nlon glacier(ncol,nrow) = land_int2(ncol) * 0.1 enddo - enddo + enddo close (iunit) #endif ii = 0 - do nrow = nrow_start, nrow_end + do nrow = nrow_start, nrow_end do ncol = 1, nlon if(elevation(ncol,nrow)>-9990) then ! Replace GLCC and MODIS glacier/ice sheet with glacier specific dataset @@ -544,8 +544,8 @@ SUBROUTINE rd_land_types(dir_rawdata) #endif ii = ii + 1 endif - ! Antarctic (ice sheet / baren ONLY) - if(nrow > 18000)then ! (90N + 60S) * 120 + ! Antarctic (ice sheet / barren ONLY) + if(nrow > 18000)then ! (90N + 60S) * 120 #if(defined LULC_USGS) if(landtypes_usgs(ncol,nrow)/=23)then landtypes_usgs(ncol,nrow) = 24 @@ -560,12 +560,12 @@ SUBROUTINE rd_land_types(dir_rawdata) #endif endif ! modified by dai, 06/02/2016 -! ! Greenland (ice sheet / baren / built-up ONLY) +! ! Greenland (ice sheet / barren / built-up ONLY) ! ! BETWEEN (59-83N, 74-11W) =>| 012720 .and. ncol<20280))then !#if(defined LULC_USGS) ! if(landtypes_usgs(ncol,nrow)/=23 .or. landtypes_usgs(ncol,nrow)/=1)then -! landtypes_usgs(ncol,nrow) = 24 +! landtypes_usgs(ncol,nrow) = 24 ! glacier(ncol,nrow) = 100. ! endif !#endif @@ -578,7 +578,7 @@ SUBROUTINE rd_land_types(dir_rawdata) ! endif endif enddo - enddo + enddo r8_min = minval(glacier(:,nrow_start:nrow_end)) @@ -600,7 +600,7 @@ SUBROUTINE rd_land_types(dir_rawdata) if (p_master) print*,'glacier (> 0.5%) =', ii ! .................................... -! ... (5) global urban characterristics +! ... (5) global urban characteristics ! .................................... lndname = trim(dir_rawdata)//'urban/urban-builtup.bin' @@ -619,7 +619,7 @@ SUBROUTINE rd_land_types(dir_rawdata) do nrow = 1, nlat read(iunit,rec=nrow,err=100) land_chr1 do ncol = 1, nlon - urban(ncol,nrow) = ichar(land_chr1(ncol)) + urban(ncol,nrow) = ichar(land_chr1(ncol)) enddo enddo close (iunit) @@ -639,7 +639,7 @@ SUBROUTINE rd_land_types(dir_rawdata) #endif ii = ii + 1 endif - if(nrow > 18000)then ! (90N + 60S) * 120 + if(nrow > 18000)then ! (90N + 60S) * 120 urban(ncol,nrow) = 0 endif endif @@ -757,7 +757,7 @@ SUBROUTINE rd_land_types(dir_rawdata) #endif #endif !--------------------------------------------------------------------------------------------- -! Correct the land cover types on which the types (GLCC_USGS/MODIS_IGBP) were classified +! Correct the land cover types on which the types (GLCC_USGS/MODIS_IGBP) were classified ! water bodies/wetland/glacier/urban, but NOT classified in GLWD/GLACIER/URBAN specific dataset !--------------------------------------------------------------------------------------------- allocate (ntmp(nlon,buff_lb:buff_ub)) @@ -773,7 +773,7 @@ SUBROUTINE rd_land_types(dir_rawdata) !! exclude = (/1,16,17,18,24/) !/urban and built-up(1),water bodies(16),herbaceous wetland(17),wooded wetland(18),snow and ice(24)/ ! np = 4 ! allocate (exclude(4)) -! exclude = (/1,16,17,18/) +! exclude = (/1,16,17,18/) ! ntmp = landtypes_usgs ! do j = nrow_start, nrow_end ! do i = 1, nlon @@ -809,7 +809,7 @@ SUBROUTINE rd_land_types(dir_rawdata) !! exclude = (/11,13,15,17/) !/permanent wetland(11),urban and built-up(13),snow and ice(15),water bodies(17)/ ! np = 3 ! allocate (exclude(3)) -! exclude = (/11,13,17/) +! exclude = (/11,13,17/) ! ntmp = landtypes_igbp ! do j = nrow_start, nrow_end ! do i = 1, nlon @@ -879,11 +879,11 @@ SUBROUTINE rd_land_types(dir_rawdata) ! if (p_master) print*, 'MODIS IGBP WATER BODIES','iiii=',iiii !#endif !#endif - + ! deleted by dai, 07/27/2016 ! The Global Lake and Wetlands Types (http://www.wwfus.org/science/data.cfm) ! may have some problems in presenting the wetland type in some regions. -! +! ! ! WETLAND ! ! ------- !#if(defined LULC_USGS) @@ -1328,7 +1328,7 @@ SUBROUTINE rd_land_types(dir_rawdata) ! ... (6) global cultural characteristics (crops) ! .............................................. ! -!#endif +!#endif ! Write out the land cover types #if(defined LULC_USGS) @@ -1421,26 +1421,26 @@ INTEGER FUNCTION ia(chr,n,ispval) ! ** the integer data file is saved as a n-byte character ! data file. this function is used to recover the ! character data to the integer data. -! +! ! n --- the number of bytes in chr ! ispval --- default value for the negative integer. - + character*(*) chr integer bit_1, bit_2 bit_1 = '200'O ! BINARY '10000000' bit_2 = '377'O ! BINARY '11111111' ia = 0 - + ii1 = ichar(chr(1:1)) ! .. get the sign -- isn=0 positive, isn=1 negative: jj = iand(ii1,bit_1) isn = ishft(jj,-7) - + ! .. for negative number: ! because the negative integers are represented by the supplementary ! binary code inside machine. - + if (isn.eq.1) then do m = n+1,4 nbit = (m-1)*8 @@ -1448,7 +1448,7 @@ INTEGER FUNCTION ia(chr,n,ispval) ia = ieor(jj,ia) end do endif - + ! .. get the byte from chr: do m = 1,n ii2 = ichar(chr(m:m)) @@ -1458,7 +1458,7 @@ INTEGER FUNCTION ia(chr,n,ispval) ! .. the abs(integer): ia = ieor(ia,ia2) end do - + if (ia.lt.0) ia = ispval return @@ -1538,8 +1538,8 @@ SUBROUTINE update_buff (buff, nlon, nlat, buff_lb, nrow_start, nrow_end, buff_ub use spmd_TM implicit none - integer, intent(in) :: nlon - integer, intent(in) :: nlat + integer, intent(in) :: nlon + integer, intent(in) :: nlat integer, intent(in) :: buff_lb integer, intent(in) :: buff_ub @@ -1554,14 +1554,14 @@ SUBROUTINE update_buff (buff, nlon, nlat, buff_lb, nrow_start, nrow_end, buff_ub character, allocatable :: cbuff_g(:,:) integer, parameter :: rmax = 100 ! searching radius (grid cells) - integer :: iproc + integer :: iproc integer, allocatable :: reqs(:) - integer :: blb, bub + integer :: blb, bub allocate (cbuff (nlon,buff_lb:buff_ub)) cbuff = char(buff) - + if (p_iam_slave == 0) then allocate (reqs (0:p_nslaves-1)) allocate (nlat_proc(0:p_nslaves-1)) @@ -1586,7 +1586,7 @@ SUBROUTINE update_buff (buff, nlon, nlat, buff_lb, nrow_start, nrow_end, buff_ub call mpi_isend (cbuff_g(:,blb:bub), nlon*(bub-blb+1), MPI_CHARACTER, & iproc, iproc, p_comm_slave, reqs(iproc), p_err) end do - call mpi_waitall (p_nslaves-1, reqs(1:p_nslaves-1), MPI_STATUSES_IGNORE, p_err) + call mpi_waitall (p_nslaves-1, reqs(1:p_nslaves-1), MPI_STATUSES_IGNORE, p_err) else call mpi_gather (nrow_end-nrow_start+1, 1, MPI_INTEGER, 0, 1, MPI_INTEGER, & 0, p_comm_slave, p_err) diff --git a/preprocess/rd_soil_properties.F90 b/preprocess/rd_soil_properties.F90 index 85e1e0fa..a26bc3c5 100644 --- a/preprocess/rd_soil_properties.F90 +++ b/preprocess/rd_soil_properties.F90 @@ -31,7 +31,7 @@ SUBROUTINE rd_soil_properties(dir_rawdata) ! ! Original author: Yongjiu Dai, 12/2013/ ! -! Rivisions: +! Revisions: ! Hua Yuan, 06/2016: add OPENMP parallel function. ! Yongjiu Dai and Nan Wei, ! 06/2018: update a new version of soil hydraulic and thermal parameters @@ -58,7 +58,7 @@ SUBROUTINE rd_soil_properties(dir_rawdata) ! --------------------------------- integer, allocatable :: landtypes(:,:) ! GLCC USGS/MODIS IGBP land cover types - ! (2) global soil characteristcs + ! (2) global soil characteristics ! -------------------------- integer(kind=1), allocatable :: int_soil_grav_l (:,:) ! Coarse fragments volumetric in % @@ -108,7 +108,7 @@ SUBROUTINE rd_soil_properties(dir_rawdata) real(r8), allocatable :: OM_density_l(:,:) ! OM_density(kg/m3) REAL(r8), allocatable :: BD_all_l(:,:) ! Bulk density of soil (GRAVELS + MINERALS + ORGANIC MATTER)(kg/m3) -! CoLM soil layer thickiness and depths +! CoLM soil layer thickness and depths integer nl_soil real(r8), allocatable :: zsoi(:) ! soil layer depth [m] real(r8), allocatable :: dzsoi(:) ! soil node thickness [m] @@ -160,7 +160,7 @@ SUBROUTINE rd_soil_properties(dir_rawdata) integer ii, iii, iiii, jj, jjj, jjjj ! ........................................ -! ... (1) gloabl land cover characteristics +! ... (1) global land cover characteristics ! ........................................ iunit = 100 inquire(iolength=length) land_chr1 @@ -195,7 +195,7 @@ SUBROUTINE rd_soil_properties(dir_rawdata) #endif ! ................................. -! ... (2) global soil charateristics +! ... (2) global soil characteristics ! ................................. nl_soil = 10 allocate ( zsoi(1:nl_soil), dzsoi(1:nl_soil), zsoih(0:nl_soil) ) @@ -267,7 +267,7 @@ SUBROUTINE rd_soil_properties(dir_rawdata) write(c,'(i1)') MODEL_SOIL_LAYER ! ------------------------------------ - ! (6.1) precentage of gravel (% volume) + ! (6.1) percentage of gravel (% volume) ! ------------------------------------ inquire(iolength=length) land_int1 lndname = trim(dir_rawdata)//'soil/GRAV_L'//trim(c) @@ -441,8 +441,8 @@ SUBROUTINE rd_soil_properties(dir_rawdata) ! ------------------------------------ if( soil_sand_l < 0.0 ) soil_sand_l = 43. ! missing value = -100 if( soil_clay_l < 0.0 ) soil_clay_l = 18. ! missing value = -100 - if( soil_oc_l < 0.0 ) soil_oc_l = 1.0 ! missing value = -999 - if( soil_bd_l < 0.0 ) soil_bd_l = 1.2 ! missing value = -999 + if( soil_oc_l < 0.0 ) soil_oc_l = 1.0 ! missing value = -999 + if( soil_bd_l < 0.0 ) soil_bd_l = 1.2 ! missing value = -999 if( soil_sand_l < 1.0 ) soil_sand_l = 1. if( soil_clay_l < 1.0 ) soil_clay_l = 1. diff --git a/share/MOD_DataType.F90 b/share/MOD_DataType.F90 index 62dba08f..59a61581 100644 --- a/share/MOD_DataType.F90 +++ b/share/MOD_DataType.F90 @@ -5,7 +5,7 @@ MODULE MOD_DataType !----------------------------------------------------------------------- ! DESCRIPTION: ! -! Definations of data types used in CoLM. +! Definitions of data types used in CoLM. ! ! Most frequently used data types in CoLM are "blocked" data types ! including, @@ -13,13 +13,13 @@ MODULE MOD_DataType ! 2. Blocked 2D data of 8-byte float type; ! 3. Blocked 3D data of 8-byte float type; ! 4. Blocked 4D data of 8-byte float type; -! -! Subroutines are used to +! +! Subroutines are used to ! 1. allocate memory; ! 2. flush data values; ! 3. copy data; ! 4. do linear transformation and interpolations. -! +! ! Created by Shupeng Zhang, May 2023 !----------------------------------------------------------------------- @@ -29,42 +29,42 @@ MODULE MOD_DataType !------- type :: pointer_real8_1d real(r8), allocatable :: val(:) - CONTAINS + CONTAINS final :: pointer_real8_1d_free_mem END type pointer_real8_1d !------- type :: pointer_int8_1d integer(1), allocatable :: val(:) - CONTAINS + CONTAINS final :: pointer_int8_1d_free_mem END type pointer_int8_1d !------- type :: pointer_int32_1d integer, allocatable :: val(:) - CONTAINS + CONTAINS final :: pointer_int32_1d_free_mem END type pointer_int32_1d !------- type :: pointer_int64_1d integer*8, allocatable :: val(:) - CONTAINS + CONTAINS final :: pointer_int64_1d_free_mem END type pointer_int64_1d !------- type :: pointer_logic_1d logical, allocatable :: val(:) - CONTAINS + CONTAINS final :: pointer_logic_1d_free_mem END type pointer_logic_1d !------- type :: pointer_int32_2d integer, allocatable :: val (:,:) - CONTAINS + CONTAINS final :: pointer_int32_2d_free_mem END type pointer_int32_2d @@ -77,7 +77,7 @@ MODULE MOD_DataType !------- type :: pointer_real8_2d real(r8), allocatable :: val (:,:) - CONTAINS + CONTAINS final :: pointer_real8_2d_free_mem END type pointer_real8_2d @@ -90,7 +90,7 @@ MODULE MOD_DataType !------- type :: pointer_real8_3d real(r8), allocatable :: val (:,:,:) - CONTAINS + CONTAINS final :: pointer_real8_3d_free_mem END type pointer_real8_3d @@ -104,7 +104,7 @@ MODULE MOD_DataType !------- type :: pointer_real8_4d real(r8), allocatable :: val (:,:,:,:) - CONTAINS + CONTAINS final :: pointer_real8_4d_free_mem END type pointer_real8_4d @@ -151,7 +151,7 @@ SUBROUTINE pointer_real8_1d_free_mem (this) deallocate(this%val) ENDIF - END SUBROUTINE pointer_real8_1d_free_mem + END SUBROUTINE pointer_real8_1d_free_mem !------------------ SUBROUTINE pointer_int8_1d_free_mem (this) @@ -164,7 +164,7 @@ SUBROUTINE pointer_int8_1d_free_mem (this) deallocate(this%val) ENDIF - END SUBROUTINE pointer_int8_1d_free_mem + END SUBROUTINE pointer_int8_1d_free_mem !------------------ SUBROUTINE pointer_int32_1d_free_mem (this) @@ -177,7 +177,7 @@ SUBROUTINE pointer_int32_1d_free_mem (this) deallocate(this%val) ENDIF - END SUBROUTINE pointer_int32_1d_free_mem + END SUBROUTINE pointer_int32_1d_free_mem !------------------ SUBROUTINE pointer_int64_1d_free_mem (this) @@ -190,7 +190,7 @@ SUBROUTINE pointer_int64_1d_free_mem (this) deallocate(this%val) ENDIF - END SUBROUTINE pointer_int64_1d_free_mem + END SUBROUTINE pointer_int64_1d_free_mem !------------------ SUBROUTINE pointer_logic_1d_free_mem (this) @@ -203,7 +203,7 @@ SUBROUTINE pointer_logic_1d_free_mem (this) deallocate(this%val) ENDIF - END SUBROUTINE pointer_logic_1d_free_mem + END SUBROUTINE pointer_logic_1d_free_mem !------------------ SUBROUTINE pointer_int32_2d_free_mem (this) @@ -216,7 +216,7 @@ SUBROUTINE pointer_int32_2d_free_mem (this) deallocate(this%val) ENDIF - END SUBROUTINE pointer_int32_2d_free_mem + END SUBROUTINE pointer_int32_2d_free_mem !------------------ SUBROUTINE allocate_block_data_int32_2d (grid, gdata) @@ -234,7 +234,7 @@ SUBROUTINE allocate_block_data_int32_2d (grid, gdata) allocate (gdata%blk (gblock%nxblk,gblock%nyblk)) - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) allocate (gdata%blk(iblk,jblk)%val (grid%xcnt(iblk), grid%ycnt(jblk))) @@ -265,7 +265,7 @@ SUBROUTINE block_data_int32_2d_free_mem (this) deallocate (this%blk) ENDIF - END SUBROUTINE block_data_int32_2d_free_mem + END SUBROUTINE block_data_int32_2d_free_mem !------------------ SUBROUTINE pointer_real8_2d_free_mem (this) @@ -278,7 +278,7 @@ SUBROUTINE pointer_real8_2d_free_mem (this) deallocate(this%val) ENDIF - END SUBROUTINE pointer_real8_2d_free_mem + END SUBROUTINE pointer_real8_2d_free_mem !------------------ SUBROUTINE allocate_block_data_real8_2d (grid, gdata) @@ -296,7 +296,7 @@ SUBROUTINE allocate_block_data_real8_2d (grid, gdata) allocate (gdata%blk (gblock%nxblk,gblock%nyblk)) - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) allocate (gdata%blk(iblk,jblk)%val (grid%xcnt(iblk), grid%ycnt(jblk))) @@ -314,7 +314,7 @@ SUBROUTINE block_data_real8_2d_free_mem (this) ! Local variables integer :: iblk, jblk - + IF (allocated (this%blk)) THEN DO jblk = 1, gblock%nyblk DO iblk = 1, gblock%nxblk @@ -326,8 +326,8 @@ SUBROUTINE block_data_real8_2d_free_mem (this) deallocate (this%blk) ENDIF - - END SUBROUTINE block_data_real8_2d_free_mem + + END SUBROUTINE block_data_real8_2d_free_mem !------------------ SUBROUTINE pointer_real8_3d_free_mem (this) @@ -340,7 +340,7 @@ SUBROUTINE pointer_real8_3d_free_mem (this) deallocate(this%val) ENDIF - END SUBROUTINE pointer_real8_3d_free_mem + END SUBROUTINE pointer_real8_3d_free_mem !------------------ SUBROUTINE allocate_block_data_real8_3d (grid, gdata, ndim1, lb1) @@ -359,7 +359,7 @@ SUBROUTINE allocate_block_data_real8_3d (grid, gdata, ndim1, lb1) integer :: iblkme, iblk, jblk allocate (gdata%blk (gblock%nxblk,gblock%nyblk)) - + IF (present(lb1)) THEN gdata%lb1 = lb1 ELSE @@ -368,7 +368,7 @@ SUBROUTINE allocate_block_data_real8_3d (grid, gdata, ndim1, lb1) gdata%ub1 = gdata%lb1-1+ndim1 - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) allocate (gdata%blk(iblk,jblk)%val (gdata%lb1:gdata%ub1, grid%xcnt(iblk), grid%ycnt(jblk))) @@ -399,7 +399,7 @@ SUBROUTINE block_data_real8_3d_free_mem (this) deallocate (this%blk) ENDIF - END SUBROUTINE block_data_real8_3d_free_mem + END SUBROUTINE block_data_real8_3d_free_mem !------------------ SUBROUTINE pointer_real8_4d_free_mem (this) @@ -412,7 +412,7 @@ SUBROUTINE pointer_real8_4d_free_mem (this) deallocate(this%val) ENDIF - END SUBROUTINE pointer_real8_4d_free_mem + END SUBROUTINE pointer_real8_4d_free_mem !------------------ SUBROUTINE allocate_block_data_real8_4d (grid, gdata, ndim1, ndim2, lb1, lb2) @@ -448,7 +448,7 @@ SUBROUTINE allocate_block_data_real8_4d (grid, gdata, ndim1, ndim2, lb1, lb2) gdata%ub2 = gdata%lb2-1+ndim2 - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) allocate (gdata%blk(iblk,jblk)%val ( & @@ -480,7 +480,7 @@ SUBROUTINE block_data_real8_4d_free_mem (this) deallocate (this%blk) ENDIF - END SUBROUTINE block_data_real8_4d_free_mem + END SUBROUTINE block_data_real8_4d_free_mem !------------------ SUBROUTINE flush_block_data_real8_2d (gdata, spval) @@ -496,7 +496,7 @@ SUBROUTINE flush_block_data_real8_2d (gdata, spval) ! Local variables integer :: iblkme, iblk, jblk - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) gdata%blk(iblk,jblk)%val = spval @@ -518,7 +518,7 @@ SUBROUTINE flush_block_data_int32_2d (gdata, spval) ! Local variables integer :: iblkme, iblk, jblk - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) gdata%blk(iblk,jblk)%val = spval @@ -540,7 +540,7 @@ SUBROUTINE flush_block_data_real8_3d (gdata, spval) ! Local variables integer :: iblkme, iblk, jblk - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) gdata%blk(iblk,jblk)%val = spval @@ -562,7 +562,7 @@ SUBROUTINE flush_block_data_real8_4d (gdata, spval) ! Local variables integer :: iblkme, iblk, jblk - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) gdata%blk(iblk,jblk)%val = spval @@ -586,7 +586,7 @@ SUBROUTINE block_data_linear_transform (gdata, scl, dsp) integer :: iblkme, iblk, jblk IF (present(scl)) THEN - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) gdata%blk(iblk,jblk)%val = gdata%blk(iblk,jblk)%val * scl @@ -594,7 +594,7 @@ SUBROUTINE block_data_linear_transform (gdata, scl, dsp) ENDIF IF (present(dsp)) THEN - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) gdata%blk(iblk,jblk)%val = gdata%blk(iblk,jblk)%val + dsp @@ -618,7 +618,7 @@ SUBROUTINE block_data_copy (gdata_from, gdata_to, sca) ! Local variables integer :: iblkme, iblk, jblk - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) IF (present(sca)) THEN @@ -640,13 +640,13 @@ SUBROUTINE block_data_linear_interp ( & IMPLICIT NONE type(block_data_real8_2d), intent(in) :: gdata_from1, gdata_from2 - real(r8), intent(in) :: alp1, alp2 + real(r8), intent(in) :: alp1, alp2 type(block_data_real8_2d), intent(inout) :: gdata_to ! Local variables integer :: iblkme, iblk, jblk - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) gdata_to%blk(iblk,jblk)%val = & @@ -676,7 +676,7 @@ SUBROUTINE block_data_division (gdata, sumdata, spv) IF (.not. present(spv)) THEN - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) WHERE (sumdata%blk(iblk,jblk)%val > 0.) @@ -684,12 +684,12 @@ SUBROUTINE block_data_division (gdata, sumdata, spv) gdata%blk(iblk,jblk)%val / sumdata%blk(iblk,jblk)%val ELSEWHERE gdata%blk(iblk,jblk)%val = spval - ENDWHERE + ENDWHERE ENDDO ELSE - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) WHERE ((sumdata%blk(iblk,jblk)%val > 0.) .and. (gdata%blk(iblk,jblk)%val /= spv)) @@ -697,7 +697,7 @@ SUBROUTINE block_data_division (gdata, sumdata, spv) gdata%blk(iblk,jblk)%val / sumdata%blk(iblk,jblk)%val ELSEWHERE gdata%blk(iblk,jblk)%val = spv - ENDWHERE + ENDWHERE ENDDO ENDIF @@ -705,5 +705,5 @@ SUBROUTINE block_data_division (gdata, sumdata, spv) ENDIF END SUBROUTINE block_data_division - + END MODULE MOD_DataType diff --git a/share/MOD_Namelist.F90 b/share/MOD_Namelist.F90 index 1e42c7da..e210b96f 100644 --- a/share/MOD_Namelist.F90 +++ b/share/MOD_Namelist.F90 @@ -5,7 +5,7 @@ MODULE MOD_Namelist !----------------------------------------------------------------------- ! DESCRIPTION: ! -! Variables in namelist files and subrroutines to read namelist files. +! Variables in namelist files and subroutines to read namelist files. ! ! Initial Authors: Shupeng Zhang, Zhongwang Wei, Xingjie Lu, Nan Wei, ! Hua Yuan, Wenzong Dong et al., May 2023 @@ -233,7 +233,7 @@ MODULE MOD_Namelist logical :: DEF_USE_CANYON_HWR = .true. ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -! ----- Part 11: parameteration schemes ----- +! ----- Part 11: parameterization schemes ----- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ integer :: DEF_Interception_scheme = 1 !1:CoLM；2:CLM4.5; 3:CLM5; 4:Noah-MP; 5:MATSIRO; 6:VIC; 7:JULES @@ -269,14 +269,14 @@ MODULE MOD_Namelist integer :: DEF_Runoff_SCHEME = 3 character(len=256) :: DEF_file_VIC_para = 'null' - ! ----- Treat exposed soil and snow surface separatly ----- + ! ----- Treat exposed soil and snow surface separately ----- ! including solar absorption, sensible/latent heat, ground temperature, - ! ground heat flux and groud evp/dew/subl/fros. Corresponding vars are + ! ground heat flux and ground evp/dew/subl/fros. Corresponding vars are ! named as ***_soil, ***_snow. logical :: DEF_SPLIT_SOILSNOW = .false. ! ----- Account for vegetation snow process ----- - ! NOTE: This option will be activated in the new release, accompained by + ! NOTE: This option will be activated in the new release, accompanied by ! a new set of canopy structure data, include the snow-free LAI. logical :: DEF_VEG_SNOW = .false. diff --git a/share/MOD_NetCDFVectorBlk.F90 b/share/MOD_NetCDFVectorBlk.F90 index 9663243e..af93975a 100644 --- a/share/MOD_NetCDFVectorBlk.F90 +++ b/share/MOD_NetCDFVectorBlk.F90 @@ -11,25 +11,25 @@ ! 2) gather from workers to IO and write vectors by IO ! 3. Block : read blocked data by IO ! Notice: input file is a single file. -! +! ! This MODULE CONTAINS subroutines of "2. Vector". -! +! ! Two implementations can be used, -! 1) "MOD_NetCDFVectorBlk.F90": -! A vector is saved in separated files, each associated with a block. +! 1) "MOD_NetCDFVectorBlk.F90": +! A vector is saved in separated files, each associated with a block. ! READ/WRITE are fast in this way and compression can be used. -! However, there may be too many files, especially when blocks are small. +! However, there may be too many files, especially when blocks are small. ! CHOOSE this implementation by "#undef VectorInOneFile" in include/define.h -! 2) "MOD_NetCDFVectorOne.F90": -! A vector is saved in one file. +! 2) "MOD_NetCDFVectorOne.F90": +! A vector is saved in one file. ! READ/WRITE may be slow in this way. ! CHOOSE this implementation by "#define VectorInOneFile" in include/define.h ! ! Created by Shupeng Zhang, May 2023 !---------------------------------------------------------------------------------- -! Put vector in seperated files. -#if (!defined(VectorInOneFileS) && !defined(VectorInOneFileP)) +! Put vector in separated files. +#if (!defined(VectorInOneFileS) && !defined(VectorInOneFileP)) MODULE MOD_NetCDFVector @@ -40,31 +40,31 @@ MODULE MOD_NetCDFVector ! PUBLIC subroutines INTERFACE ncio_read_vector - MODULE procedure ncio_read_vector_logical_1d - MODULE procedure ncio_read_vector_int32_1d - MODULE procedure ncio_read_vector_int64_1d - MODULE procedure ncio_read_vector_real8_1d - MODULE procedure ncio_read_vector_real8_2d - MODULE procedure ncio_read_vector_real8_3d - MODULE procedure ncio_read_vector_real8_4d + MODULE procedure ncio_read_vector_logical_1d + MODULE procedure ncio_read_vector_int32_1d + MODULE procedure ncio_read_vector_int64_1d + MODULE procedure ncio_read_vector_real8_1d + MODULE procedure ncio_read_vector_real8_2d + MODULE procedure ncio_read_vector_real8_3d + MODULE procedure ncio_read_vector_real8_4d END INTERFACE ncio_read_vector - PUBLIC :: ncio_create_file_vector - PUBLIC :: ncio_define_dimension_vector + PUBLIC :: ncio_create_file_vector + PUBLIC :: ncio_define_dimension_vector INTERFACE ncio_write_vector MODULE procedure ncio_write_vector_logical_1d - MODULE procedure ncio_write_vector_int32_1d - MODULE procedure ncio_write_vector_int32_3d - MODULE procedure ncio_write_vector_int64_1d - MODULE procedure ncio_write_vector_real8_1d - MODULE procedure ncio_write_vector_real8_2d - MODULE procedure ncio_write_vector_real8_3d - MODULE procedure ncio_write_vector_real8_4d + MODULE procedure ncio_write_vector_int32_1d + MODULE procedure ncio_write_vector_int32_3d + MODULE procedure ncio_write_vector_int64_1d + MODULE procedure ncio_write_vector_real8_1d + MODULE procedure ncio_write_vector_real8_2d + MODULE procedure ncio_write_vector_real8_3d + MODULE procedure ncio_write_vector_real8_4d END INTERFACE ncio_write_vector CONTAINS - + !--------------------------------------------------------- SUBROUTINE ncio_read_vector_int32_1d ( & filename, dataname, pixelset, rdata, defval) @@ -104,8 +104,8 @@ SUBROUTINE ncio_read_vector_int32_1d ( & allocate (sbuff (pixelset%vecgs%vlen(iblk,jblk))) CALL get_filename_block (filename, iblk, jblk, fileblock) - - IF (ncio_var_exist(fileblock,dataname)) THEN + + IF (ncio_var_exist(fileblock,dataname)) THEN CALL ncio_read_serial (fileblock, dataname, sbuff) any_data_exists = .true. ELSEIF (present(defval)) THEN @@ -141,11 +141,11 @@ SUBROUTINE ncio_read_vector_int32_1d ( & #ifdef USEMPI IF (p_is_worker) THEN - + DO iblkgrp = 1, pixelset%nblkgrp iblk = pixelset%xblkgrp(iblkgrp) jblk = pixelset%yblkgrp(iblkgrp) - + IF (pixelset%vecgs%vlen(iblk,jblk) > 0) THEN allocate (rbuff (pixelset%vecgs%vlen(iblk,jblk))) ELSE @@ -211,8 +211,8 @@ SUBROUTINE ncio_read_vector_int64_1d ( & allocate (sbuff (pixelset%vecgs%vlen(iblk,jblk))) CALL get_filename_block (filename, iblk, jblk, fileblock) - - IF (ncio_var_exist(fileblock,dataname)) THEN + + IF (ncio_var_exist(fileblock,dataname)) THEN CALL ncio_read_serial (fileblock, dataname, sbuff) any_data_exists = .true. ELSEIF (present(defval)) THEN @@ -248,11 +248,11 @@ SUBROUTINE ncio_read_vector_int64_1d ( & #ifdef USEMPI IF (p_is_worker) THEN - + DO iblkgrp = 1, pixelset%nblkgrp iblk = pixelset%xblkgrp(iblkgrp) jblk = pixelset%yblkgrp(iblkgrp) - + IF (pixelset%vecgs%vlen(iblk,jblk) > 0) THEN allocate (rbuff (pixelset%vecgs%vlen(iblk,jblk))) ELSE @@ -319,7 +319,7 @@ SUBROUTINE ncio_read_vector_logical_1d (filename, dataname, pixelset, rdata, & allocate (sbuff (pixelset%vecgs%vlen(iblk,jblk))) CALL get_filename_block (filename, iblk, jblk, fileblock) - IF (ncio_var_exist(fileblock,dataname)) THEN + IF (ncio_var_exist(fileblock,dataname)) THEN CALL ncio_read_serial (fileblock, dataname, sbuff) any_data_exists = .true. ELSEIF (present(defval)) THEN @@ -413,13 +413,13 @@ SUBROUTINE ncio_read_vector_real8_1d (filename, dataname, pixelset, rdata, & character(len=256) :: fileblock real(r8), allocatable :: sbuff(:), rbuff(:) logical :: any_data_exists - + IF (p_is_worker) THEN IF ((pixelset%nset > 0) .and. (.not. allocated(rdata))) THEN allocate (rdata (pixelset%nset)) ENDIF ENDIF - + any_data_exists = .false. IF (p_is_io) THEN @@ -431,7 +431,7 @@ SUBROUTINE ncio_read_vector_real8_1d (filename, dataname, pixelset, rdata, & allocate (sbuff (pixelset%vecgs%vlen(iblk,jblk))) CALL get_filename_block (filename, iblk, jblk, fileblock) - IF (ncio_var_exist(fileblock,dataname)) THEN + IF (ncio_var_exist(fileblock,dataname)) THEN CALL ncio_read_serial (fileblock, dataname, sbuff) any_data_exists = .true. ELSEIF (present(defval)) THEN @@ -467,7 +467,7 @@ SUBROUTINE ncio_read_vector_real8_1d (filename, dataname, pixelset, rdata, & #ifdef USEMPI IF (p_is_worker) THEN - + DO iblkgrp = 1, pixelset%nblkgrp iblk = pixelset%xblkgrp(iblkgrp) jblk = pixelset%yblkgrp(iblkgrp) @@ -540,7 +540,7 @@ SUBROUTINE ncio_read_vector_real8_2d ( & allocate (sbuff (ndim1, pixelset%vecgs%vlen(iblk,jblk))) CALL get_filename_block (filename, iblk, jblk, fileblock) - IF (ncio_var_exist(fileblock,dataname)) THEN + IF (ncio_var_exist(fileblock,dataname)) THEN CALL ncio_read_serial (fileblock, dataname, sbuff) any_data_exists = .true. ELSEIF (present(defval)) THEN @@ -576,7 +576,7 @@ SUBROUTINE ncio_read_vector_real8_2d ( & #ifdef USEMPI IF (p_is_worker) THEN - + DO iblkgrp = 1, pixelset%nblkgrp iblk = pixelset%xblkgrp(iblkgrp) jblk = pixelset%yblkgrp(iblkgrp) @@ -649,7 +649,7 @@ SUBROUTINE ncio_read_vector_real8_3d ( & allocate (sbuff (ndim1,ndim2, pixelset%vecgs%vlen(iblk,jblk))) CALL get_filename_block (filename, iblk, jblk, fileblock) - IF (ncio_var_exist(fileblock,dataname)) THEN + IF (ncio_var_exist(fileblock,dataname)) THEN CALL ncio_read_serial (fileblock, dataname, sbuff) any_data_exists = .true. ELSEIF (present(defval)) THEN @@ -715,7 +715,7 @@ SUBROUTINE ncio_read_vector_real8_3d ( & #endif END SUBROUTINE ncio_read_vector_real8_3d - + !--------------------------------------------------------- SUBROUTINE ncio_read_vector_real8_4d ( & filename, dataname, ndim1, ndim2, ndim3, pixelset, rdata, defval) @@ -758,7 +758,7 @@ SUBROUTINE ncio_read_vector_real8_4d ( & allocate (sbuff (ndim1,ndim2,ndim3, pixelset%vecgs%vlen(iblk,jblk))) CALL get_filename_block (filename, iblk, jblk, fileblock) - IF (ncio_var_exist(fileblock,dataname)) THEN + IF (ncio_var_exist(fileblock,dataname)) THEN CALL ncio_read_serial (fileblock, dataname, sbuff) any_data_exists = .true. ELSEIF (present(defval)) THEN @@ -794,7 +794,7 @@ SUBROUTINE ncio_read_vector_real8_4d ( & #ifdef USEMPI IF (p_is_worker) THEN - + DO iblkgrp = 1, pixelset%nblkgrp iblk = pixelset%xblkgrp(iblkgrp) jblk = pixelset%yblkgrp(iblkgrp) @@ -824,7 +824,7 @@ SUBROUTINE ncio_read_vector_real8_4d ( & #endif END SUBROUTINE ncio_read_vector_real8_4d - + !--------------------------------------------------------- SUBROUTINE ncio_create_file_vector (filename, pixelset) @@ -851,7 +851,7 @@ SUBROUTINE ncio_create_file_vector (filename, pixelset) ENDDO ENDIF - + END SUBROUTINE ncio_create_file_vector !--------------------------------------------------------- @@ -880,7 +880,7 @@ SUBROUTINE ncio_define_dimension_vector (filename, pixelset, dimname, dimlen) CALL get_filename_block (filename, iblk, jblk, fileblock) inquire (file=trim(fileblock), exist=fexists) - IF (.not. fexists) THEN + IF (.not. fexists) THEN CALL ncio_create_file (fileblock) ENDIF @@ -893,7 +893,7 @@ SUBROUTINE ncio_define_dimension_vector (filename, pixelset, dimname, dimlen) ENDDO ENDIF - + END SUBROUTINE ncio_define_dimension_vector !--------------------------------------------------------- @@ -951,7 +951,7 @@ SUBROUTINE ncio_write_vector_int32_1d ( & ENDDO ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1043,7 +1043,7 @@ SUBROUTINE ncio_write_vector_logical_1d ( & ENDDO ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1110,7 +1110,7 @@ SUBROUTINE ncio_write_vector_int32_3d ( & DO iblkgrp = 1, pixelset%nblkgrp iblk = pixelset%xblkgrp(iblkgrp) jblk = pixelset%yblkgrp(iblkgrp) - + allocate (rbuff (ndim1,ndim2,pixelset%vecgs%vlen(iblk,jblk))) #ifdef USEMPI CALL mpi_gatherv (MPI_IN_PLACE, 0, MPI_INTEGER, & @@ -1138,7 +1138,7 @@ SUBROUTINE ncio_write_vector_int32_3d ( & ENDDO ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1224,7 +1224,7 @@ SUBROUTINE ncio_write_vector_int64_1d ( & ENDDO ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1271,7 +1271,7 @@ SUBROUTINE ncio_write_vector_real8_1d ( & character(len=*), intent(in) :: dimname type(pixelset_type), intent(in) :: pixelset real(r8), intent(in) :: wdata (:) - + integer, intent(in), optional :: compress_level ! Local variables @@ -1310,7 +1310,7 @@ SUBROUTINE ncio_write_vector_real8_1d ( & ENDDO ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1400,7 +1400,7 @@ SUBROUTINE ncio_write_vector_real8_2d ( & ENDDO ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1449,7 +1449,7 @@ SUBROUTINE ncio_write_vector_real8_3d ( & type(pixelset_type), intent(in) :: pixelset integer, intent(in) :: ndim1, ndim2 real(r8), intent(in) :: wdata (:,:,:) - + integer, intent(in), optional :: compress_level ! Local variables @@ -1489,7 +1489,7 @@ SUBROUTINE ncio_write_vector_real8_3d ( & ENDDO ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1538,7 +1538,7 @@ SUBROUTINE ncio_write_vector_real8_4d ( & integer, intent(in) :: ndim1, ndim2, ndim3 type(pixelset_type), intent(in) :: pixelset real(r8), intent(in) :: wdata (:,:,:,:) - + integer, intent(in), optional :: compress_level ! Local variables @@ -1578,7 +1578,7 @@ SUBROUTINE ncio_write_vector_real8_4d ( & ENDDO ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN From f15f486e9645e3b4bb48cd3d2680c6ce2f981393 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 5 Feb 2025 16:21:56 +0800 Subject: [PATCH 22/43] Code format for URBAN model. --- main/URBAN/CoLMMAIN_Urban.F90 | 5 +++-- main/URBAN/MOD_Urban_Albedo.F90 | 18 ++++++++++-------- main/URBAN/MOD_Urban_BEM.F90 | 2 +- main/URBAN/MOD_Urban_Const_LCZ.F90 | 1 + main/URBAN/MOD_Urban_Flux.F90 | 1 + main/URBAN/MOD_Urban_GroundFlux.F90 | 1 + main/URBAN/MOD_Urban_LAIReadin.F90 | 1 + main/URBAN/MOD_Urban_LUCY.F90 | 1 + main/URBAN/MOD_Urban_Longwave.F90 | 1 + main/URBAN/MOD_Urban_NetSolar.F90 | 1 + main/URBAN/MOD_Urban_RoofFlux.F90 | 1 + main/URBAN/MOD_Urban_Shortwave.F90 | 1 + main/URBAN/MOD_Urban_Vars_TimeInvariants.F90 | 1 - main/URBAN/MOD_Urban_Vars_TimeVariables.F90 | 2 +- 14 files changed, 24 insertions(+), 13 deletions(-) diff --git a/main/URBAN/CoLMMAIN_Urban.F90 b/main/URBAN/CoLMMAIN_Urban.F90 index 34e60726..facd6763 100644 --- a/main/URBAN/CoLMMAIN_Urban.F90 +++ b/main/URBAN/CoLMMAIN_Urban.F90 @@ -137,7 +137,7 @@ SUBROUTINE CoLMMAIN_Urban ( & ! SNICAR snow model related snw_rds ,ssno ,& mss_bcpho ,mss_bcphi ,mss_ocpho ,mss_ocphi ,& - mss_dst1 , mss_dst2 ,mss_dst3 ,mss_dst4 ,& + mss_dst1 ,mss_dst2 ,mss_dst3 ,mss_dst4 ,& #if(defined CaMa_Flood) ! flood depth [mm], flood fraction[0-1], @@ -863,7 +863,8 @@ SUBROUTINE CoLMMAIN_Urban ( & ! with vegetation canopy CALL LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tref,tleaf,& prc_rain,prc_snow,prl_rain,prl_snow,bifall,& - ldew,ldew_rain,ldew_snow,z0m,forc_hgt_u,pgper_rain,pgper_snow,qintr,qintr_rain,qintr_snow) + ldew,ldew_rain,ldew_snow,z0m,forc_hgt_u,pgper_rain,pgper_snow,& + qintr,qintr_rain,qintr_snow) ! for output, patch scale qintr = qintr * fveg * (1-flake) diff --git a/main/URBAN/MOD_Urban_Albedo.F90 b/main/URBAN/MOD_Urban_Albedo.F90 index 988a78ff..cc041dbc 100644 --- a/main/URBAN/MOD_Urban_Albedo.F90 +++ b/main/URBAN/MOD_Urban_Albedo.F90 @@ -49,13 +49,15 @@ SUBROUTINE alburban (ipatch,froof,fgper,flake,hlr,hroof,& ! ! (1) snow albedos: as in BATS formulations, which are inferred from ! the calculations of Wiscombe and Warren (1980) and the snow model -! and data of Anderson(1976), and the function of snow age, grain size, -! solar zenith angle, pollution, the amount of the fresh snow -! (2) lake and wetland albedos: as in BATS, which depend on cosine solar zenith angle, -! based on data in Henderson-Sellers (1986). The frozen lake and wetland albedos -! are set to constants (0.6 for visible beam, 0.4 for near-infrared) -! (3) over the snow covered surface, the surface albedo is estimated by a linear -! combination of albedos for snow, roof, impervious and pervious ground +! and data of Anderson(1976), and the function of snow age, grain +! size, solar zenith angle, pollution, the amount of the fresh snow +! (2) lake and wetland albedos: as in BATS, which depend on cosine solar +! zenith angle, based on data in Henderson-Sellers (1986). The +! frozen lake and wetland albedos are set to constants (0.6 for +! visible beam, 0.4 for near-infrared) +! (3) over the snow covered surface, the surface albedo is estimated by +! a linear combination of albedos for snow, roof, impervious and +! pervious ground ! !======================================================================= @@ -366,4 +368,4 @@ SUBROUTINE alburban (ipatch,froof,fgper,flake,hlr,hroof,& END SUBROUTINE alburban END MODULE MOD_Urban_Albedo -! --------- EOP ---------- +! ---------- EOP ------------ diff --git a/main/URBAN/MOD_Urban_BEM.F90 b/main/URBAN/MOD_Urban_BEM.F90 index c55b7f16..734645d8 100644 --- a/main/URBAN/MOD_Urban_BEM.F90 +++ b/main/URBAN/MOD_Urban_BEM.F90 @@ -243,4 +243,4 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & END SUBROUTINE SimpleBEM END MODULE MOD_Urban_BEM -! --------- EOP ---------- +! ---------- EOP ------------ diff --git a/main/URBAN/MOD_Urban_Const_LCZ.F90 b/main/URBAN/MOD_Urban_Const_LCZ.F90 index 2ae50740..3e55f637 100644 --- a/main/URBAN/MOD_Urban_Const_LCZ.F90 +++ b/main/URBAN/MOD_Urban_Const_LCZ.F90 @@ -115,3 +115,4 @@ MODULE MOD_Urban_Const_LCZ !TODO:AHE coding END MODULE MOD_Urban_Const_LCZ +! ---------- EOP ------------ diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index f2976efb..0166087d 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -2596,3 +2596,4 @@ SUBROUTINE dewfraction (sigf,lai,sai,dewmx,ldew,ldew_rain,ldew_snow,fwet,fdry) END SUBROUTINE dewfraction END MODULE MOD_Urban_Flux +! ---------- EOP ------------ diff --git a/main/URBAN/MOD_Urban_GroundFlux.F90 b/main/URBAN/MOD_Urban_GroundFlux.F90 index 19812528..50dd0876 100644 --- a/main/URBAN/MOD_Urban_GroundFlux.F90 +++ b/main/URBAN/MOD_Urban_GroundFlux.F90 @@ -225,3 +225,4 @@ SUBROUTINE UrbanGroundFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & END SUBROUTINE UrbanGroundFlux END MODULE MOD_Urban_GroundFlux +! ---------- EOP ------------ diff --git a/main/URBAN/MOD_Urban_LAIReadin.F90 b/main/URBAN/MOD_Urban_LAIReadin.F90 index b963bf7e..015849e9 100644 --- a/main/URBAN/MOD_Urban_LAIReadin.F90 +++ b/main/URBAN/MOD_Urban_LAIReadin.F90 @@ -82,3 +82,4 @@ END SUBROUTINE UrbanLAI_readin END MODULE MOD_Urban_LAIReadin #endif +! ---------- EOP ------------ diff --git a/main/URBAN/MOD_Urban_LUCY.F90 b/main/URBAN/MOD_Urban_LUCY.F90 index 3049f43f..f44902a0 100644 --- a/main/URBAN/MOD_Urban_LUCY.F90 +++ b/main/URBAN/MOD_Urban_LUCY.F90 @@ -177,3 +177,4 @@ SUBROUTINE LUCY( idate , deltim , patchlonr, fix_holiday, & END Subroutine LUCY END MODULE MOD_Urban_LUCY +! ---------- EOP ------------ diff --git a/main/URBAN/MOD_Urban_Longwave.F90 b/main/URBAN/MOD_Urban_Longwave.F90 index 1ae69d4b..87cd70fb 100644 --- a/main/URBAN/MOD_Urban_Longwave.F90 +++ b/main/URBAN/MOD_Urban_Longwave.F90 @@ -662,3 +662,4 @@ SUBROUTINE UrbanVegLongwave (theta, HL, fb, fgper, H, LW, & END SUBROUTINE UrbanVegLongwave END MODULE MOD_Urban_Longwave +! ---------- EOP ------------ diff --git a/main/URBAN/MOD_Urban_NetSolar.F90 b/main/URBAN/MOD_Urban_NetSolar.F90 index e468ec03..05a3b088 100644 --- a/main/URBAN/MOD_Urban_NetSolar.F90 +++ b/main/URBAN/MOD_Urban_NetSolar.F90 @@ -179,3 +179,4 @@ SUBROUTINE netsolar_urban (ipatch,idate,dlon,deltim,& END SUBROUTINE netsolar_urban END MODULE MOD_Urban_NetSolar +! ---------- EOP ------------ diff --git a/main/URBAN/MOD_Urban_RoofFlux.F90 b/main/URBAN/MOD_Urban_RoofFlux.F90 index 426ac04e..d2983df0 100644 --- a/main/URBAN/MOD_Urban_RoofFlux.F90 +++ b/main/URBAN/MOD_Urban_RoofFlux.F90 @@ -233,3 +233,4 @@ SUBROUTINE UrbanRoofFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & END SUBROUTINE UrbanRoofFlux END MODULE MOD_Urban_RoofFlux +! ---------- EOP ------------ diff --git a/main/URBAN/MOD_Urban_Shortwave.F90 b/main/URBAN/MOD_Urban_Shortwave.F90 index 1911db8b..48f16393 100644 --- a/main/URBAN/MOD_Urban_Shortwave.F90 +++ b/main/URBAN/MOD_Urban_Shortwave.F90 @@ -755,3 +755,4 @@ FUNCTION MatrixInverse(A) result(Ainv) END FUNCTION MatrixInverse END MODULE MOD_Urban_Shortwave +! ---------- EOP ------------ diff --git a/main/URBAN/MOD_Urban_Vars_TimeInvariants.F90 b/main/URBAN/MOD_Urban_Vars_TimeInvariants.F90 index 64ac4984..5f6d4abd 100644 --- a/main/URBAN/MOD_Urban_Vars_TimeInvariants.F90 +++ b/main/URBAN/MOD_Urban_Vars_TimeInvariants.F90 @@ -338,4 +338,3 @@ END SUBROUTINE deallocate_UrbanTimeInvariants END MODULE MOD_Urban_Vars_TimeInvariants #endif ! ---------- EOP ------------ - diff --git a/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 b/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 index 27b4b8b6..3133f29f 100644 --- a/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 +++ b/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 @@ -502,5 +502,5 @@ SUBROUTINE deallocate_UrbanTimeVariables END SUBROUTINE deallocate_UrbanTimeVariables END MODULE MOD_Urban_Vars_TimeVariables -! ---------- EOP ------------ #endif +! ---------- EOP ------------ From 365be24caaef66ed4496b0ba012b02b7cb34c698 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 5 Feb 2025 21:20:22 +0800 Subject: [PATCH 23/43] Code tidy for LULCC. --- main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 b/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 index 96adb87e..d33859e9 100644 --- a/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 +++ b/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 @@ -19,22 +19,22 @@ SUBROUTINE LulccMassEnergyConserve ! ! !DESCRIPTION ! This is the main subroutine to execute the calculation of the restart -! variables for the begin of next year. -! There are mainly three ways to adjust restart variables: +! variables for the begin of next year. There are mainly three ways to +! adjust restart variables: ! -! 1) variable related to mass: area weighted mean of the source patches, -! e.g., ldew, wliq_soisno. -! variable related to energy: keep energy conserve after the change -! of temperature, e.g., t_soisno. +! 1) variable related to mass: area weighted mean of the source +! patches, e.g., ldew, wliq_soisno. variable related to energy: keep +! energy conserve after the change of temperature, e.g., t_soisno. ! -! 2) recalculate according to physical process, e.g., dz_sno, scv, fsno. +! 2) recalculate according to physical process, e.g., dz_sno, scv, +! fsno. ! ! Created by Wanyi Lin and Hua Yuan, 07/2023 ! ! !REVISIONS: ! -! 10/2023, Wanyi Lin: share the codes with REST_LulccTimeVariables(), and -! simplify the codes in this subroutine. +! 10/2023, Wanyi Lin: share the codes with REST_LulccTimeVariables(), +! and simplify the codes in this subroutine. ! ! 01/2024, Wanyi Lin: use "enthalpy conservation" for snow layer ! temperature calculation. @@ -546,7 +546,7 @@ SUBROUTINE LulccMassEnergyConserve mss_dst4 (:,np) = mss_dst4 (:,np) + mss_dst4_ (:,frnp_(k))*lccpct_np(patchclass_(frnp_(k)))/sum_lccpct_np ssno_lyr (:,:,:,np) = ssno_lyr (:,:,:,np) + ssno_lyr_ (:,:,:,frnp_(k))*lccpct_np(patchclass_(frnp_(k)))/sum_lccpct_np - ! TODO:or use same type assignment + ! TODO: or use same type assignment smp (:,np) = smp (:,np) + smp_ (:,frnp_(k))*lccpct_np(patchclass_(frnp_(k)))/sum_lccpct_np hk (:,np) = hk (:,np) + hk_ (:,frnp_(k))*lccpct_np(patchclass_(frnp_(k)))/sum_lccpct_np From a3963b63680043ca7aab18ab3d1d3d0c0c123894 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 5 Feb 2025 23:19:13 +0800 Subject: [PATCH 24/43] Code tidy and correct type errors for main/*.F90. --- main/CoLMDRIVER.F90 | 4 +- main/CoLMMAIN.F90 | 2 +- main/MOD_Aerosol.F90 | 4 +- main/MOD_Albedo.F90 | 6 +- main/MOD_AssimStomataConductance.F90 | 20 ++--- main/MOD_Const_LC.F90 | 12 +-- main/MOD_Const_PFT.F90 | 2 +- main/MOD_Const_Physical.F90 | 42 +++++------ main/MOD_Eroot.F90 | 2 +- main/MOD_Forcing.F90 | 17 +++-- main/MOD_FrictionVelocity.F90 | 22 +++--- main/MOD_Glacier.F90 | 79 ++++++++++--------- main/MOD_GroundFluxes.F90 | 6 +- main/MOD_GroundTemperature.F90 | 10 +-- main/MOD_Hist.F90 | 24 +++--- main/MOD_HistGridded.F90 | 24 +++--- main/MOD_HistSingle.F90 | 92 +++++++++++----------- main/MOD_HistVector.F90 | 28 +++---- main/MOD_LAIEmpirical.F90 | 2 +- main/MOD_LeafInterception.F90 | 63 +++++++++------- main/MOD_LeafTemperature.F90 | 40 +++++----- main/MOD_LeafTemperaturePC.F90 | 35 +++++---- main/MOD_LightningData.F90 | 12 +-- main/MOD_NewSnow.F90 | 2 +- main/MOD_NitrifData.F90 | 12 +-- main/MOD_OrbCoszen.F90 | 11 +-- main/MOD_Ozone.F90 | 21 +++--- main/MOD_Runoff.F90 | 23 +++--- main/MOD_SnowLayersCombineDivide.F90 | 3 +- main/MOD_SoilSnowHydrology.F90 | 12 +-- main/MOD_SoilSurfaceResistance.F90 | 11 +-- main/MOD_SoilThermalParameters.F90 | 109 ++++++++++++++------------- main/MOD_Thermal.F90 | 12 +-- main/MOD_TurbulenceLEddy.F90 | 15 ++-- main/MOD_UserSpecifiedForcing.F90 | 44 +++++------ main/MOD_Vars_1DAccFluxes.F90 | 4 +- main/MOD_Vars_1DForcing.F90 | 2 +- main/MOD_Vars_1DPFTFluxes.F90 | 92 +++++++++++----------- main/MOD_Vars_2DForcing.F90 | 2 +- main/MOD_Vars_Global.F90 | 2 +- main/MOD_Vars_TimeInvariants.F90 | 84 ++++++++++----------- 41 files changed, 521 insertions(+), 488 deletions(-) diff --git a/main/CoLMDRIVER.F90 b/main/CoLMDRIVER.F90 index 0b01c2b4..59bdc6b6 100644 --- a/main/CoLMDRIVER.F90 +++ b/main/CoLMDRIVER.F90 @@ -95,7 +95,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) hksati(1:,i), csol(1:,i), k_solids(1:,i), dksatu(1:,i), & dksatf(1:,i), dkdry(1:,i), BA_alpha(1:,i), BA_beta(1:,i), & rootfr(1:,m), lakedepth(i), dz_lake(1:,i), topostd(i), & - BVIC(i), & + BVIC(i), & #if(defined CaMa_Flood) ! flood variables [mm, m2/m2, mm/s, mm/s] flddepth_cama(i),fldfrc_cama(i),fevpg_fld(i), finfg_fld(i), & @@ -216,7 +216,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) em_gper(u) ,cv_roof(:,u) ,cv_wall(:,u) ,cv_gimp(:,u) ,& tk_roof(:,u) ,tk_wall(:,u) ,tk_gimp(:,u) ,z_roof(:,u) ,& z_wall(:,u) ,dz_roof(:,u) ,dz_wall(:,u) ,& - lakedepth(i) ,dz_lake(1:,i) ,topostd(i) ,BVIC(i) ,& + lakedepth(i) ,dz_lake(1:,i) ,topostd(i) ,BVIC(i) ,& ! LUCY INPUT PARAMETERS fix_holiday(:,u),week_holiday(:,u),hum_prof(:,u) ,pop_den(u) ,& diff --git a/main/CoLMMAIN.F90 b/main/CoLMMAIN.F90 index dd7e648b..1b5bd388 100644 --- a/main/CoLMMAIN.F90 +++ b/main/CoLMMAIN.F90 @@ -63,7 +63,7 @@ SUBROUTINE CoLMMAIN ( & !WUE stomata model parameter lambda, & !End WUE stomata model parameter - zwt, wdsrf, wa, wetwat, & + zwt, wdsrf, wa, wetwat, & t_lake, lake_icefrac, savedtke1, & ! SNICAR snow model related diff --git a/main/MOD_Aerosol.F90 b/main/MOD_Aerosol.F90 index 90f5cf40..deca3fcd 100644 --- a/main/MOD_Aerosol.F90 +++ b/main/MOD_Aerosol.F90 @@ -59,7 +59,7 @@ SUBROUTINE AerosolMasses( dtime ,snl ,do_capsnow ,& ! !ARGUMENTS: ! - real(r8),intent(in) :: dtime !seconds in a time step [second] + real(r8),intent(in) :: dtime ! seconds in a time step [second] integer, intent(in) :: snl ! number of snow layers logical, intent(in) :: do_capsnow ! true => do snow capping @@ -177,7 +177,7 @@ SUBROUTINE AerosolFluxes( dtime, snl, forc_aer, & ! !----------------------------------------------------------------------- ! !ARGUMENTS: - real(r8),intent(in) :: dtime !seconds in a time step [second] + real(r8),intent(in) :: dtime ! seconds in a time step [second] integer, intent(in) :: snl ! number of snow layers real(r8), intent(in) :: forc_aer (14 ) ! aerosol deposition from atmosphere model (grd,aer) [kg m-1 s-1] diff --git a/main/MOD_Albedo.F90 b/main/MOD_Albedo.F90 index cb0d4864..f449bddf 100644 --- a/main/MOD_Albedo.F90 +++ b/main/MOD_Albedo.F90 @@ -100,7 +100,7 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& integer, intent(in) :: & ipatch, &! patch index patchtype ! land patch type (0=soil, 1=urban or built-up, 2=wetland, - ! 3=land ice, 4=deep lake) + ! 3=land ice, 4=water body) integer, intent(in) :: & snl ! number of snow layers @@ -345,7 +345,7 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& IF (.not. DEF_USE_SNICAR) THEN cons = 0.2 conn = 0.5 - sl = 2.0 !sl helps control albedo zenith dependence + sl = 2.0 !sl helps control albedo zenith dependence ! 05/02/2023, Dai: move from CoLMMAIN.F90 ! update the snow age @@ -450,7 +450,7 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& #endif ENDIF - ! treat soil/snow albedo in direct and diffuse respectively + ! treat soil/snow absorption in direct and diffuse respectively ssoi(1,1) = tran(1,1)*(1.-albsoi(1,2)) + tran(1,3)*(1-albsoi(1,1)) ssoi(2,1) = tran(2,1)*(1.-albsoi(2,2)) + tran(2,3)*(1-albsoi(2,1)) ssoi(1,2) = tran(1,2)*(1.-albsoi(1,2)) diff --git a/main/MOD_AssimStomataConductance.F90 b/main/MOD_AssimStomataConductance.F90 index 7c0bc751..62b2af0e 100644 --- a/main/MOD_AssimStomataConductance.F90 +++ b/main/MOD_AssimStomataConductance.F90 @@ -541,21 +541,21 @@ SUBROUTINE calc_photo_params(tlef, po2m, par , psrf, rstfac, rb, effcon, vmax25, vm = vm * cint(1) rgas = 8.314467591 ! universal gas constant (J mol-1 K-1) -!---> jmax25 = 2.39 * vmax25 - 14.2e-6 ! (mol m-2 s-1) -!---> jmax25 = 2.1 * vmax25 ! (mol m-2 s-1) +!---> jmax25 = 2.39 * vmax25 - 14.2e-6 ! (mol m-2 s-1) +!---> jmax25 = 2.1 * vmax25 ! (mol m-2 s-1) !/05/2014/ - jmax25 = 1.97 * vmax25 ! (mol m-2 s-1) + jmax25 = 1.97 * vmax25 ! (mol m-2 s-1) jmax = jmax25 * exp( 37.e3 * (tlef - trop) / (rgas*trop*tlef) ) * & ( 1. + exp( (710.*trop-220.e3)/(rgas*trop) ) ) / & ( 1. + exp( (710.*tlef-220.e3)/(rgas*tlef) ) ) - ! 37000 (J mol-1) - ! 220000 (J mol-1) - ! 710 (J K-1) + ! 37000 (J mol-1) + ! 220000 (J mol-1) + ! 710 (J K-1) jmax = jmax * rstfac jmax = jmax * cint(2) -!---> epar = min(4.6e-6 * par * effcon, 0.25*jmax) +!---> epar = min(4.6e-6 * par * effcon, 0.25*jmax) ! /05/2014/ epar = min(4.6e-6 * par * effcon, jmax) @@ -578,9 +578,9 @@ SUBROUTINE calc_photo_params(tlef, po2m, par , psrf, rstfac, rb, effcon, vmax25, gbh2o = 1./rb * tprcor/tlef ! mol m-2 s-1 ! rb is for single leaf, but here the flux is for canopy, thus - ! Xingjie Lu: rb has already been converted to canopy scale, - ! thus, there is no need for gbh2o *cint(3) (sunlit/shaded LAI) -! gbh2o = gbh2o * cint(3) + ! Xingjie Lu: rb has already been converted to canopy scale, + ! thus, there is no need for gbh2o *cint(3) (sunlit/shaded LAI) +! gbh2o = gbh2o * cint(3) END SUBROUTINE calc_photo_params diff --git a/main/MOD_Const_LC.F90 b/main/MOD_Const_LC.F90 index ca5b5ea5..b8cf01bd 100644 --- a/main/MOD_Const_LC.F90 +++ b/main/MOD_Const_LC.F90 @@ -9,9 +9,9 @@ MODULE MOD_Const_LC ! Created by Hua Yuan, 08/2019 ! ! !REVISIONS: -! Hua Yuan, 08/2019: initial version adapted from IniTimeConst.F90 of CoLM2014 -! Hua Yuan, 08/2019: added constants values for IGBP land cover types -! Xingjie Lu, 05/2023: added Plant Hydraulics Parameters +! 08/2019, Hua Yuan: initial version adapted from IniTimeConst.F90 of CoLM2014 +! 08/2019, Hua Yuan: added constants values for IGBP land cover types +! 05/2023, Xingjie Lu: added Plant Hydraulics Parameters ! ! !USES: USE MOD_Precision @@ -258,7 +258,7 @@ MODULE MOD_Const_LC 2.012, 1.964, 1.955, 1.953, 1.303, 2.175, 1.631, 2.608,& 2.608, 1.631, 8.992, 8.992, 8.992, 8.992, 0.978, 2.608/) -! Plant Hydraulics Parameters + ! Plant Hydraulics Parameters real(r8), parameter, dimension(N_land_classification) :: kmax_sun0_usgs & = (/ 0., 2.e-008, 2.e-008, 2.e-008, 2.e-008, 2.e-008,& 2.e-008, 2.e-008, 2.e-008, 2.e-008, 2.e-008, 2.e-008,& @@ -548,7 +548,7 @@ MODULE MOD_Const_LC 1.627, 2.608, 2.608, 2.614, 2.614, 2.614, 2.608, 0.978,& 2.608 /) -! Plant Hydraulics Parameters + ! Plant Hydraulics Parameters real(r8), parameter, dimension(N_land_classification) :: kmax_sun0_igbp & = (/2.e-008, 2.e-008, 2.e-008, 2.e-008, 2.e-008, 2.e-008, & 2.e-008, 2.e-008, 2.e-008, 2.e-008, 2.e-008, 2.e-008, & @@ -598,7 +598,7 @@ MODULE MOD_Const_LC = (/3.95, 3.95, 3.95, 3.95, 3.95, 3.95, & 3.95, 3.95, 3.95, 3.95, 3.95, 3.95, & 3.95, 3.95, 3.95, 3.95, 3.95 /) -!end plant hydraulic parameters + !end plant hydraulic parameters ! lambda for WUE stomata model real(r8), parameter, dimension(N_land_classification) :: lambda_igbp & diff --git a/main/MOD_Const_PFT.F90 b/main/MOD_Const_PFT.F90 index 3197f517..c24177de 100644 --- a/main/MOD_Const_PFT.F90 +++ b/main/MOD_Const_PFT.F90 @@ -10,7 +10,7 @@ MODULE MOD_Const_PFT ! Created by Hua Yuan, 08/2019 ! ! REVISIONS: -! Xingjie Lu, TODO:10/2021?: added for crop PFTs +! 10/2021, Xingjie Lu: added for crop PFTs ! ! !USES: USE MOD_Precision diff --git a/main/MOD_Const_Physical.F90 b/main/MOD_Const_Physical.F90 index 6f446273..8f51a760 100644 --- a/main/MOD_Const_Physical.F90 +++ b/main/MOD_Const_Physical.F90 @@ -4,27 +4,27 @@ MODULE MOD_Const_Physical ! physical constants !======================================================================= - USE MOD_Precision - IMPLICIT NONE + USE MOD_Precision + IMPLICIT NONE - PUBLIC - real(r8), parameter :: denice = 917. ! density of ice [kg/m3] - real(r8), parameter :: denh2o = 1000. ! density of liquid water [kg/m3] - real(r8), parameter :: cpliq = 4188. ! Specific heat of water [J/kg/K] - real(r8), parameter :: cpice = 2117.27 ! Specific heat of ice [J/kg/K] - real(r8), parameter :: cpair = 1004.64 ! specific heat of dry air [J/kg/K] - real(r8), parameter :: hfus = 0.3336e6 ! latent heat of fusion for ice [J/kg] - real(r8), parameter :: hvap = 2.5104e6 ! latent heat of evap for water [J/kg] - real(r8), parameter :: hsub = 2.8440e6 ! latent heat of sublimation [J/kg] - real(r8), parameter :: tkair = 0.023 ! thermal conductivity of air [W/m/k] - real(r8), parameter :: tkice = 2.290 ! thermal conductivity of ice [W/m/k] - real(r8), parameter :: tkwat = 0.6 ! thermal conductivity of water [W/m/k] - real(r8), parameter :: tfrz = 273.16 ! freezing temperature [K] - real(r8), parameter :: rgas = 287.04 ! gas constant for dry air [J/kg/K] - real(r8), parameter :: roverg = 4.71047e4 ! rw/g = (8.3144/0.018)/(9.80616)*1000. mm/K - real(r8), parameter :: rwat = 461.296 ! gas constant for water vapor [J/(kg K)] - real(r8), parameter :: grav = 9.80616 ! gravity constant [m/s2] - real(r8), parameter :: vonkar = 0.4 ! von Karman constant [-] - real(r8), parameter :: stefnc = 5.67e-8 ! Stefan-Boltzmann constant [W/m2/K4] + PUBLIC + real(r8), parameter :: denice = 917. ! density of ice [kg/m3] + real(r8), parameter :: denh2o = 1000. ! density of liquid water [kg/m3] + real(r8), parameter :: cpliq = 4188. ! Specific heat of water [J/kg/K] + real(r8), parameter :: cpice = 2117.27 ! Specific heat of ice [J/kg/K] + real(r8), parameter :: cpair = 1004.64 ! specific heat of dry air [J/kg/K] + real(r8), parameter :: hfus = 0.3336e6 ! latent heat of fusion for ice [J/kg] + real(r8), parameter :: hvap = 2.5104e6 ! latent heat of evap for water [J/kg] + real(r8), parameter :: hsub = 2.8440e6 ! latent heat of sublimation [J/kg] + real(r8), parameter :: tkair = 0.023 ! thermal conductivity of air [W/m/k] + real(r8), parameter :: tkice = 2.290 ! thermal conductivity of ice [W/m/k] + real(r8), parameter :: tkwat = 0.6 ! thermal conductivity of water [W/m/k] + real(r8), parameter :: tfrz = 273.16 ! freezing temperature [K] + real(r8), parameter :: rgas = 287.04 ! gas constant for dry air [J/kg/K] + real(r8), parameter :: roverg = 4.71047e4 ! rw/g = (8.3144/0.018)/(9.80616)*1000. mm/K + real(r8), parameter :: rwat = 461.296 ! gas constant for water vapor [J/(kg K)] + real(r8), parameter :: grav = 9.80616 ! gravity constant [m/s2] + real(r8), parameter :: vonkar = 0.4 ! von Karman constant [-] + real(r8), parameter :: stefnc = 5.67e-8 ! Stefan-Boltzmann constant [W/m2/K4] END MODULE MOD_Const_Physical diff --git a/main/MOD_Eroot.F90 b/main/MOD_Eroot.F90 index 4bda0acc..b8923550 100644 --- a/main/MOD_Eroot.F90 +++ b/main/MOD_Eroot.F90 @@ -86,7 +86,7 @@ SUBROUTINE eroot (nl_soil,trsmx0,porsl, & ! transpiration potential(etrc) and root resistance factors (rstfac) - roota = 1.e-10 ! must be non-zero to begin + roota = 1.e-10 ! must be non-zero to begin DO i = 1, nl_soil IF(t_soisno(i)>tfrz .and. porsl(i)>=1.e-6)THEN diff --git a/main/MOD_Forcing.F90 b/main/MOD_Forcing.F90 index 04f9e285..f453f080 100644 --- a/main/MOD_Forcing.F90 +++ b/main/MOD_Forcing.F90 @@ -73,7 +73,7 @@ MODULE MOD_Forcing ! local variables integer :: deltim_int ! model time step length - ! real(r8) :: deltim_real ! model time step length + ! real(r8) :: deltim_real ! model time step length ! for SinglePoint type(timestamp), allocatable :: forctime (:) @@ -125,9 +125,9 @@ SUBROUTINE forcing_init (dir_forcing, deltatime, ststamp, lc_year, etstamp, lulc character(len=*), intent(in) :: dir_forcing real(r8), intent(in) :: deltatime ! model time step type(timestamp), intent(in) :: ststamp - integer, intent(in) :: lc_year ! which year of land cover data used + integer, intent(in) :: lc_year ! which year of land cover data used type(timestamp), intent(in), optional :: etstamp - logical, intent(in), optional :: lulcc_call ! whether it is a lulcc CALL + logical, intent(in), optional :: lulcc_call ! whether it is a lulcc CALL ! Local variables integer :: idate(3) @@ -755,7 +755,7 @@ SUBROUTINE read_forcing (idate, dir_forcing) forc_th_grid(np)%val(ipart) = forc_t_grid(np)%val(ipart) & * (1.e5/forc_pbot_grid(np)%val(ipart)) ** (rair/cpair) - ! caculate sun zenith angle and sun azimuth angle and turn to degree + ! calculate sun zenith angle and sun azimuth angle and turn to degree coszen(np) = orb_coszen(calday, patchlonr(np), patchlatr(np)) cosazi(np) = orb_cosazi(calday, patchlonr(np), patchlatr(np), coszen(np)) @@ -812,7 +812,8 @@ SUBROUTINE read_forcing (idate, dir_forcing) IF (p_is_worker) THEN DO np = 1, numpatch IF ((forc_us(np)==spval).or.(forc_vs(np)==spval)) cycle - CALL downscale_wind(forc_us(np), forc_vs(np), slp_type_patches(:,np), asp_type_patches(:,np), area_type_patches(:,np), cur_patches(np)) + CALL downscale_wind(forc_us(np), forc_vs(np), slp_type_patches(:,np), & + asp_type_patches(:,np), area_type_patches(:,np), cur_patches(np)) ENDDO ENDIF @@ -934,8 +935,8 @@ END SUBROUTINE read_forcing ! ------------------------------------------------------------ ! ! !DESCRIPTION: - ! read lower and upper boundary forcing data, a major interface of this - ! MODULE + ! read lower and upper boundary forcing data, a major interface of + ! this MODULE ! ! REVISIONS: ! Hua Yuan, 04/2014: initial code @@ -1266,7 +1267,7 @@ END SUBROUTINE metread_time ! o year alternation ! o month alternation ! o leap year -! o required dada just beyond the first record +! o required data just beyond the first record ! ! REVISIONS: ! Hua Yuan, 04/2014: initial code diff --git a/main/MOD_FrictionVelocity.F90 b/main/MOD_FrictionVelocity.F90 index e54119ac..14b52bf8 100644 --- a/main/MOD_FrictionVelocity.F90 +++ b/main/MOD_FrictionVelocity.F90 @@ -29,8 +29,9 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& ! calculation of friction velocity, relation for potential temperature ! and humidity profiles of surface boundary layer. ! the scheme is based on the work of Zeng et al. (1998): -! Intercomparison of bulk aerodynamic algorithms for the computation -! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, Vol. 11: 2628-2644 +! Intercomparison of bulk aerodynamic algorithms for the computation of +! sea surface fluxes using TOGA CORE and TAO data. J. Climate, Vol. 11: +! 2628-2644 ! ====================================================================== USE MOD_Precision @@ -176,14 +177,15 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& ! Original author : Yongjiu Dai, September 15, 1999 ! ! calculation of friction velocity, relation for potential temperature -! and humidity profiles of surface boundary layer. -! the scheme is based on the work of Zeng et al. (1998): -! Intercomparison of bulk aerodynamic algorithms for the computation -! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, Vol. 11: 2628-2644 +! and humidity profiles of surface boundary layer. the scheme is based +! on the work of Zeng et al. (1998): Intercomparison of bulk aerodynamic +! algorithms for the computation of sea surface fluxes using TOGA CORE +! and TAO data. J. Climate, Vol. 11: 2628-2644 ! ! REVISIONS: -! Hua Yuan, 09/2017: adapted from moninobuk FUNCTION to calculate canopy top -! fm, fq and phih for roughness sublayer u/k profile calculation +! 09/2017, Hua Yuan: adapted from moninobuk FUNCTION to calculate canopy +! top fm, fq and phih for roughness sublayer u/k profile +! calculation. ! ====================================================================== USE MOD_Precision @@ -491,7 +493,8 @@ SUBROUTINE moninobukini(ur,th,thm,thv,dth,dqh,dthv,zldis,z0m,um,obu) ! initialization of Monin-Obukhov length, ! the scheme is based on the work of Zeng et al. (1998): ! Intercomparison of bulk aerodynamic algorithms for the computation -! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, Vol. 11: 2628-2644 +! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, Vol. +! 11: 2628-2644 ! ====================================================================== USE MOD_Precision @@ -541,7 +544,6 @@ SUBROUTINE moninobukini(ur,th,thm,thv,dth,dqh,dthv,zldis,z0m,um,obu) END SUBROUTINE moninobukini - real(r8) FUNCTION psi(k,zeta) !======================================================================= diff --git a/main/MOD_Glacier.F90 b/main/MOD_Glacier.F90 index 83426692..731412c1 100644 --- a/main/MOD_Glacier.F90 +++ b/main/MOD_Glacier.F90 @@ -8,12 +8,12 @@ MODULE MOD_Glacier ! Original author: Yongjiu Dai, /05/2014/ ! ! REVISIONS: -! Hua Yuan, 01/2023: added GLACIER_WATER_snicar() to account for SNICAR -! model effects on snow water [see snowwater_snicar()], -! snow layers combine [see snowlayerscombine_snicar()], -! snow layers divide [see snowlayersdivide_snicar()] +! 01/2023, Hua Yuan: added GLACIER_WATER_snicar() to account for SNICAR +! model effects on snow water [see snowwater_snicar()], snow +! layers combine [see snowlayerscombine_snicar()], snow layers +! divide [see snowlayersdivide_snicar()] ! -! Hua Yuan, 01/2023: added snow layer absorption in GLACIER_TEMP() +! 01/2023, Hua Yuan: added snow layer absorption in GLACIER_TEMP() !----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE @@ -56,8 +56,8 @@ SUBROUTINE GLACIER_TEMP (patchtype, lb ,nl_ice ,deltim ,& pg_snow ,t_precip ,snofrz ,sabg_snow_lyr) !======================================================================= -! this is the main SUBROUTINE to execute the calculation -! of thermal processes and surface fluxes of the land ice (glacier and ice sheet) +! this is the main SUBROUTINE to execute the calculation of thermal processes +! and surface fluxes of the land ice (glacier and ice sheet) ! ! Original author : Yongjiu Dai and Nan Wei, /05/2014/ ! Modified by Nan Wei, 07/2017/ interaction btw prec and land ice @@ -81,7 +81,8 @@ SUBROUTINE GLACIER_TEMP (patchtype, lb ,nl_ice ,deltim ,& !---------------------Argument------------------------------------------ integer, intent(in) :: & - patchtype,& ! land patch type (0=soil, 1=urban and built-up, 2=wetland, 3=land ice, 4=land water bodies, 99 = ocean) + patchtype,& ! land patch type (0=soil, 1=urban and built-up, + ! 2=wetland, 3=land ice, 4=land water bodies, 99 = ocean) lb, &! lower bound of array nl_ice ! upper bound of array @@ -130,10 +131,10 @@ SUBROUTINE GLACIER_TEMP (patchtype, lb ,nl_ice ,deltim ,& snowdp ! snow depth [m] real(r8), intent(inout) :: & - snofrz (lb:0) ! snow freezing rate (lyr) [kg m-2 s-1] + snofrz (lb:0) ! snow freezing rate (lyr) [kg m-2 s-1] integer, intent(out) :: & - imelt(lb:nl_ice) ! flag for melting or freezing [-] + imelt(lb:nl_ice) ! flag for melting or freezing [-] ! Output fluxes real(r8), intent(out) :: & @@ -349,9 +350,8 @@ SUBROUTINE groundfluxes_glacier (zlnd,zsno,hu,ht,hq,& ! Original author : Yongjiu Dai and Nan Wei, /05/2014/ ! ! REVISIONS: -! Shaofeng Liu, 05/2023: add option to CALL moninobuk_leddy, the LargeEddy -! surface turbulence scheme (LZD2022); -! make a proper update of um. +! 05/2023, Shaofeng Liu: add option to CALL moninobuk_leddy, the LargeEddy +! surface turbulence scheme (LZD2022); make a proper update of um. !======================================================================= USE MOD_Precision @@ -573,25 +573,26 @@ SUBROUTINE groundtem_glacier (patchtype,lb,nl_ice,deltim,& ! SNOW and LAND ICE temperatures ! o The volumetric heat capacity is calculated as a linear combination ! in terms of the volumetric fraction of the constituent phases. -! o The thermal conductivity of snow/ice is computed from -! the formulation used in SNTHERM (Jordan 1991) and Yen (1981), respectively. +! o The thermal conductivity of snow/ice is computed from the +! formulation used in SNTHERM (Jordan 1991) and Yen (1981), +! respectively. ! o Boundary conditions: ! F = Rnet - Hg - LEg (top) + HPR, F= 0 (base of the land ice column). -! o Ice/snow temperature is predicted from heat conduction -! in 10 ice layers and up to 5 snow layers. -! The thermal conductivities at the interfaces between two neighbor layers -! (j, j+1) are derived from an assumption that the flux across the interface -! is equal to that from the node j to the interface and the flux from the -! interface to the node j+1. The equation is solved using the Crank-Nicholson -! method and resulted in a tridiagonal system equation. +! o Ice/snow temperature is predicted from heat conduction in 10 ice +! layers and up to 5 snow layers. The thermal conductivities at the +! interfaces between two neighbor layers (j, j+1) are derived from an +! assumption that the flux across the interface is equal to that from +! the node j to the interface and the flux from the interface to the +! node j+1. The equation is solved using the Crank-Nicholson method +! and resulted in a tridiagonal system equation. ! ! Phase change (see meltf.F90) ! ! Original author : Yongjiu Dai, /05/2014/ ! ! REVISIONS: -! Hua Yuan, 01/2023: account for snow layer absorption (SNICAR) in ground heat -! flux, temperature and melt calculation. +! 01/2023, Hua Yuan: account for snow layer absorption (SNICAR) in +! ground heat flux, temperature and melt calculation. !======================================================================= USE MOD_Precision @@ -906,7 +907,7 @@ SUBROUTINE GLACIER_WATER ( nl_ice,maxsnl,deltim,& forc_vs integer, intent(in) :: imelt(maxsnl+1:nl_ice) ! flag for: melting=1, freezing=2, nothing happened=0 - integer, intent(inout) :: snl ! lower bound of array + integer, intent(inout) :: snl ! lower bound of array real(r8), intent(inout) :: & z_icesno (maxsnl+1:nl_ice) , &! layer depth (m) @@ -926,13 +927,16 @@ SUBROUTINE GLACIER_WATER ( nl_ice,maxsnl,deltim,& integer lb, j !======================================================================= -! [1] update the liquid water within snow layer and the water onto the ice surface +! [1] update the liquid water within snow layer and the water onto the +! ice surface ! ! Snow melting is treated in a realistic fashion, with meltwater -! percolating downward through snow layers as long as the snow is unsaturated. -! Once the underlying snow is saturated, any additional meltwater runs off. -! When glacier ice melts, however, the meltwater is assumed to remain in place until it refreezes. -! In warm parts of the ice sheet, the meltwater does not refreeze, but stays in place indefinitely. +! percolating downward through snow layers as long as the snow is +! unsaturated. Once the underlying snow is saturated, any additional +! meltwater runs off. When glacier ice melts, however, the meltwater is +! assumed to remain in place until it refreezes. In warm parts of the +! ice sheet, the meltwater does not refreeze, but stays in place +! indefinitely. !======================================================================= lb = snl + 1 @@ -1024,7 +1028,7 @@ SUBROUTINE GLACIER_WATER_snicar ( nl_ice,maxsnl,deltim,& fiold(maxsnl+1:nl_ice) ! fraction of ice relative to the total water integer, intent(in) :: imelt(maxsnl+1:nl_ice) ! flag for: melting=1, freezing=2, nothing happened=0 - integer, intent(inout) :: snl ! lower bound of array + integer, intent(inout) :: snl ! lower bound of array real(r8), intent(inout) :: & z_icesno (maxsnl+1:nl_ice) , &! layer depth (m) @@ -1062,13 +1066,16 @@ SUBROUTINE GLACIER_WATER_snicar ( nl_ice,maxsnl,deltim,& integer lb, j !======================================================================= -! [1] update the liquid water within snow layer and the water onto the ice surface +! [1] update the liquid water within snow layer and the water onto the +! ice surface ! ! Snow melting is treated in a realistic fashion, with meltwater -! percolating downward through snow layers as long as the snow is unsaturated. -! Once the underlying snow is saturated, any additional meltwater runs off. -! When glacier ice melts, however, the meltwater is assumed to remain in place until it refreezes. -! In warm parts of the ice sheet, the meltwater does not refreeze, but stays in place indefinitely. +! percolating downward through snow layers as long as the snow is +! unsaturated. Once the underlying snow is saturated, any additional +! meltwater runs off. When glacier ice melts, however, the meltwater is +! assumed to remain in place until it refreezes. In warm parts of the +! ice sheet, the meltwater does not refreeze, but stays in place +! indefinitely. !======================================================================= lb = snl + 1 diff --git a/main/MOD_GroundFluxes.F90 b/main/MOD_GroundFluxes.F90 index 90868fce..6edd906d 100644 --- a/main/MOD_GroundFluxes.F90 +++ b/main/MOD_GroundFluxes.F90 @@ -26,8 +26,8 @@ SUBROUTINE GroundFluxes (zlnd, zsno, hu, ht, hq, hpbl, & z0m, z0hg, zol, rib, ustar, qstar, tstar, fm, fh, fq) !======================================================================= -! this is the main SUBROUTINE to execute the calculation of thermal processes -! and surface fluxes +! This is the main SUBROUTINE to execute the calculation of thermal +! processes and surface fluxes ! ! Original author : Yongjiu Dai, 09/15/1999; 08/30/2002 ! @@ -187,7 +187,7 @@ SUBROUTINE GroundFluxes (zlnd, zsno, hu, ht, hq, hpbl, & z0hg = z0mg/exp(0.13 * (ustar*z0mg/1.5e-5)**0.45) z0qg = z0hg - ! 2023.04.06, weinan + ! 2023.04.06, weinan !thvstar=tstar+0.61*th*qstar thvstar=tstar*(1.+0.61*qm)+0.61*th*qstar zeta=zldis*vonkar*grav*thvstar/(ustar**2*thv) diff --git a/main/MOD_GroundTemperature.F90 b/main/MOD_GroundTemperature.F90 index f2b694a8..97f23fbe 100644 --- a/main/MOD_GroundTemperature.F90 +++ b/main/MOD_GroundTemperature.F90 @@ -59,11 +59,11 @@ SUBROUTINE GroundTemperature (patchtype,is_dry_lake,lb,nl_soil,deltim,& ! Original author : Yongjiu Dai, 09/15/1999; 08/30/2002; 05/2018 ! ! REVISIONS: -! Nan Wei, 07/2017: interaction btw prec and land surface -! Nan Wei, 01/2019: USE the new version of soil thermal parameters to -! calculate soil temperature -! Hua Yuan, 01/2023: modified ground heat flux, temperature and meltf -! calculation for SNICAR model +! 07/2017, Nan Wei: interaction btw prec and land surface +! 01/2019, Nan Wei: USE the new version of soil thermal parameters to +! calculate soil temperature +! 01/2023, Hua Yuan: modified ground heat flux, temperature and meltf +! calculation for SNICAR model !======================================================================= USE MOD_Precision diff --git a/main/MOD_Hist.F90 b/main/MOD_Hist.F90 index adc3e534..af434895 100644 --- a/main/MOD_Hist.F90 +++ b/main/MOD_Hist.F90 @@ -2,18 +2,18 @@ MODULE MOD_Hist - !---------------------------------------------------------------------------- - ! DESCRIPTION: - ! - ! Write out gridded model results to history files. - ! - ! Original version: Yongjiu Dai, September 15, 1999, 03/2014 - ! - ! REVISIONS: - ! Shupeng Zhang, 05/2023: 1) porting codes to MPI parallel version - ! - ! TODO...(need complement) - !---------------------------------------------------------------------------- +!---------------------------------------------------------------------------- +! DESCRIPTION: +! +! Write out gridded model results to history files. +! +! Original version: Yongjiu Dai, September 15, 1999, 03/2014 +! +! REVISIONS: +! Shupeng Zhang, 05/2023: 1) porting codes to MPI parallel version +! +! TODO...(need complement) +!---------------------------------------------------------------------------- USE MOD_Vars_1DAccFluxes USE MOD_Vars_Global, only : spval diff --git a/main/MOD_HistGridded.F90 b/main/MOD_HistGridded.F90 index 068cc648..dc19cb03 100644 --- a/main/MOD_HistGridded.F90 +++ b/main/MOD_HistGridded.F90 @@ -2,18 +2,18 @@ MODULE MOD_HistGridded - !---------------------------------------------------------------------------- - ! DESCRIPTION: - ! - ! Write out gridded model results to history files. - ! - ! Original version: Yongjiu Dai, September 15, 1999, 03/2014 - ! - ! REVISIONS: - ! Shupeng Zhang, 05/2023: 1) porting codes to MPI parallel version - ! - ! TODO...(need complement) - !---------------------------------------------------------------------------- +!---------------------------------------------------------------------------- +! DESCRIPTION: +! +! Write out gridded model results to history files. +! +! Original version: Yongjiu Dai, September 15, 1999, 03/2014 +! +! REVISIONS: +! Shupeng Zhang, 05/2023: 1) porting codes to MPI parallel version +! +! TODO...(need complement) +!---------------------------------------------------------------------------- USE MOD_Precision USE MOD_SPMD_Task diff --git a/main/MOD_HistSingle.F90 b/main/MOD_HistSingle.F90 index 4383d6f5..74356fff 100644 --- a/main/MOD_HistSingle.F90 +++ b/main/MOD_HistSingle.F90 @@ -3,15 +3,15 @@ #ifdef SinglePoint module MOD_HistSingle - !---------------------------------------------------------------------------- - ! DESCRIPTION: - ! - ! Write out model results at sites to history files. - ! - ! Created by Shupeng Zhang, July 2023 - ! - ! TODO...(need complement) - !---------------------------------------------------------------------------- +!---------------------------------------------------------------------------- +! DESCRIPTION: +! +! Write out model results at sites to history files. +! +! Created by Shupeng Zhang, July 2023 +! +! TODO...(need complement) +!---------------------------------------------------------------------------- USE MOD_Precision USE MOD_NetCDFSerial USE MOD_Namelist, only : USE_SITE_HistWriteBack @@ -40,7 +40,7 @@ module MOD_HistSingle ! -- initialize history IO -- SUBROUTINE hist_single_init () - + USE MOD_Namelist IMPLICIT NONE @@ -87,11 +87,11 @@ END SUBROUTINE hist_single_init ! -- finalize history IO -- SUBROUTINE hist_single_final () - + IMPLICIT NONE IF (USE_SITE_HistWriteBack) THEN - + thisvar => hist_memory%next DO WHILE (associated(thisvar)) nextvar => thisvar%next @@ -156,9 +156,9 @@ subroutine hist_single_write_time (filename, dataname, time, itime) endif IF (USE_SITE_HistWriteBack) THEN - + minutes = minutes_since_1900 (time(1), time(2), time(3)) - + select case (trim(adjustl(DEF_HIST_FREQ))) case ('HOURLY') minutes = minutes - 30 @@ -168,8 +168,8 @@ subroutine hist_single_write_time (filename, dataname, time, itime) minutes = minutes - 21600 case ('YEARLY') minutes = minutes - 262800 - END select - + END select + itime_mem = itime_mem + 1 time_memory(itime_mem) = minutes @@ -186,12 +186,12 @@ subroutine hist_single_write_time (filename, dataname, time, itime) call ncio_write_time (filename, dataname, time, itime, DEF_HIST_FREQ) ENDIF - END SUBROUTINE hist_single_write_time + END SUBROUTINE hist_single_write_time ! -- write 2D data -- SUBROUTINE single_write_2d ( & acc_vec, file_hist, varname, itime_in_file, longname, units) - + USE MOD_Vars_1DAccFluxes, only : nac use MOD_Vars_Global, only : spval implicit none @@ -204,7 +204,7 @@ SUBROUTINE single_write_2d ( & character(len=*), intent(in) :: units where (acc_vec /= spval) acc_vec = acc_vec / nac - + IF (USE_SITE_HistWriteBack) THEN IF (.not. associated(thisvar%next)) THEN @@ -217,13 +217,13 @@ SUBROUTINE single_write_2d ( & ELSE thisvar => thisvar%next ENDIF - + IF (thisvar%varname /= varname) THEN write(*,*) 'Warning: history variable in memory is wrong: ' & - // trim(thisvar%varname) // ' should be ' // trim(varname) + // trim(thisvar%varname) // ' should be ' // trim(varname) CALL CoLM_stop () ENDIF - + thisvar%v2d(:,itime_mem) = acc_vec(:) IF (memory_to_disk) THEN @@ -249,7 +249,7 @@ END SUBROUTINE single_write_2d ! -- write urban 2D data -- SUBROUTINE single_write_urb_2d ( & acc_vec, file_hist, varname, itime_in_file, longname, units) - + USE MOD_Vars_1DAccFluxes, only : nac use MOD_Vars_Global, only : spval implicit none @@ -262,26 +262,26 @@ SUBROUTINE single_write_urb_2d ( & character(len=*), intent(in) :: units where (acc_vec /= spval) acc_vec = acc_vec / nac - + IF (USE_SITE_HistWriteBack) THEN IF (.not. associated(thisvar%next)) THEN allocate (thisvar%next) thisvar => thisvar%next - + thisvar%next => null() thisvar%varname = varname allocate(thisvar%v2d (size(acc_vec),ntime_mem)) ELSE thisvar => thisvar%next ENDIF - + IF (thisvar%varname /= varname) THEN write(*,*) 'Warning: history variable in memory is wrong: ' & - // trim(thisvar%varname) // ' should be ' // trim(varname) + // trim(thisvar%varname) // ' should be ' // trim(varname) CALL CoLM_stop () ENDIF - + thisvar%v2d(:,itime_mem) = acc_vec IF (memory_to_disk) THEN @@ -307,7 +307,7 @@ END SUBROUTINE single_write_urb_2d ! -- write local noon 2D data -- SUBROUTINE single_write_ln ( & acc_vec, file_hist, varname, itime_in_file, longname, units) - + USE MOD_Vars_1DAccFluxes, only : nac_ln use MOD_Vars_Global, only : spval implicit none @@ -322,7 +322,7 @@ SUBROUTINE single_write_ln ( & where ((acc_vec /= spval) .and. (nac_ln > 0)) acc_vec = acc_vec / nac_ln END WHERE - + IF (USE_SITE_HistWriteBack) THEN IF (.not. associated(thisvar%next)) THEN @@ -335,14 +335,14 @@ SUBROUTINE single_write_ln ( & ELSE thisvar => thisvar%next ENDIF - - + + IF (thisvar%varname /= varname) THEN write(*,*) 'Warning: history variable in memory is wrong: ' & - // trim(thisvar%varname) // ' should be ' // trim(varname) + // trim(thisvar%varname) // ' should be ' // trim(varname) CALL CoLM_stop () ENDIF - + thisvar%v2d(:,itime_mem) = acc_vec IF (memory_to_disk) THEN @@ -367,7 +367,7 @@ END SUBROUTINE single_write_ln ! -- write 3D data -- SUBROUTINE single_write_3d ( & acc_vec, file_hist, varname, itime_in_file, dim1name, ndim1, longname, units) - + USE MOD_Vars_1DAccFluxes, only : nac use MOD_Vars_Global, only : spval implicit none @@ -382,26 +382,26 @@ SUBROUTINE single_write_3d ( & character(len=*), intent(in) :: units where (acc_vec /= spval) acc_vec = acc_vec / nac - + IF (USE_SITE_HistWriteBack) THEN IF (.not. associated(thisvar%next)) THEN allocate (thisvar%next) thisvar => thisvar%next - + thisvar%next => null() thisvar%varname = varname allocate(thisvar%v3d (ndim1,size(acc_vec,2),ntime_mem)) ELSE thisvar => thisvar%next ENDIF - + IF (thisvar%varname /= varname) THEN write(*,*) 'Warning: history variable in memory is wrong: ' & - // trim(thisvar%varname) // ' should be ' // trim(varname) + // trim(thisvar%varname) // ' should be ' // trim(varname) CALL CoLM_stop () ENDIF - + thisvar%v3d(:,:,itime_mem) = acc_vec IF (memory_to_disk) THEN @@ -430,7 +430,7 @@ END SUBROUTINE single_write_3d SUBROUTINE single_write_4d ( & acc_vec, file_hist, varname, itime_in_file, & dim1name, ndim1, dim2name, ndim2, longname, units) - + USE MOD_Vars_1DAccFluxes, only : nac use MOD_Vars_Global, only : spval implicit none @@ -447,26 +447,26 @@ SUBROUTINE single_write_4d ( & character(len=*), intent(in) :: units where (acc_vec /= spval) acc_vec = acc_vec / nac - + IF (USE_SITE_HistWriteBack) THEN IF (.not. associated(thisvar%next)) THEN allocate (thisvar%next) thisvar => thisvar%next - + thisvar%next => null() thisvar%varname = varname allocate(thisvar%v4d (ndim1,ndim2,size(acc_vec,3),ntime_mem)) ELSE thisvar => thisvar%next ENDIF - + IF (thisvar%varname /= varname) THEN write(*,*) 'Warning: history variable in memory is wrong: ' & - // trim(thisvar%varname) // ' should be ' // trim(varname) + // trim(thisvar%varname) // ' should be ' // trim(varname) CALL CoLM_stop () ENDIF - + thisvar%v4d(:,:,:,itime_mem) = acc_vec IF (memory_to_disk) THEN diff --git a/main/MOD_HistVector.F90 b/main/MOD_HistVector.F90 index 0ebc610d..3073f5c8 100644 --- a/main/MOD_HistVector.F90 +++ b/main/MOD_HistVector.F90 @@ -3,15 +3,15 @@ #if (defined UNSTRUCTURED || defined CATCHMENT) MODULE MOD_HistVector - !---------------------------------------------------------------------------- - ! DESCRIPTION: - ! - ! Write out vectorized model results to history files. - ! - ! Created by Shupeng Zhang, May 2023 - ! - ! TODO...(need complement) - !---------------------------------------------------------------------------- +!---------------------------------------------------------------------------- +! DESCRIPTION: +! +! Write out vectorized model results to history files. +! +! Created by Shupeng Zhang, May 2023 +! +! TODO...(need complement) +!---------------------------------------------------------------------------- USE MOD_Precision USE MOD_SPMD_Task @@ -35,9 +35,9 @@ MODULE MOD_HistVector ! -- write history time -- SUBROUTINE hist_vector_write_time (filename, dataname, time, itime_in_file) - + IMPLICIT NONE - + character (len=*), intent(in) :: filename character (len=*), intent(in) :: dataname integer, intent(in) :: time(3) @@ -71,14 +71,14 @@ SUBROUTINE hist_vector_write_time (filename, dataname, time, itime_in_file) #endif CALL ncio_write_colm_dimension (filename) - + ENDIF CALL ncio_write_time (filename, dataname, time, itime_in_file, DEF_HIST_FREQ) ENDIF - END SUBROUTINE hist_vector_write_time + END SUBROUTINE hist_vector_write_time ! ------- SUBROUTINE aggregate_to_vector_and_write_2d ( & @@ -269,7 +269,7 @@ SUBROUTINE aggregate_to_vector_and_write_3d ( & #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - + ub1 = lb1 + ndim1 - 1 IF (p_is_worker) THEN diff --git a/main/MOD_LAIEmpirical.F90 b/main/MOD_LAIEmpirical.F90 index d43123e9..0f76b68d 100644 --- a/main/MOD_LAIEmpirical.F90 +++ b/main/MOD_LAIEmpirical.F90 @@ -52,7 +52,7 @@ SUBROUTINE LAI_empirical(ivt,nl_soil,rootfr,t,lai,sai,fveg,green) 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 0.0, & 1.0, 1.0, 0.0, 1.0, 1.0, 1.0, 0.0, 0.0 /) ! Maximum leaf area index, the numbers are based on the data of -! "worldwide histrorical estimates of leaf area index, 1932-2000" : +! "worldwide historical estimates of leaf area index, 1932-2000" : ! http://www.daac.ornl.gov/global_vegetation/HistoricalLai/data" real(r8), dimension(24), parameter :: & xla=(/1.50, 3.29, 4.18, 3.50, 2.50, 3.60, 2.02, 1.53, & diff --git a/main/MOD_LeafInterception.F90 b/main/MOD_LeafInterception.F90 index 07454ae4..2d0a7794 100644 --- a/main/MOD_LeafInterception.F90 +++ b/main/MOD_LeafInterception.F90 @@ -2,21 +2,21 @@ MODULE MOD_LeafInterception ! ----------------------------------------------------------------- ! !DESCRIPTION: -! For calculating vegetation canopy preciptation interception. +! For calculating vegetation canopy precipitation interception. ! ! This MODULE is the coupler for the colm and CaMa-Flood model. !ANCILLARY FUNCTIONS AND SUBROUTINES !------------------- - !* :SUBROUTINE:"LEAF_interception_CoLM2014" : interception and drainage of precipitation schemes based on colm2014 version - !* :SUBROUTINE:"LEAF_interception_CoLM202x" : interception and drainage of precipitation schemes besed on new colm version (under development) - !* :SUBROUTINE:"LEAF_interception_CLM4" : interception and drainage of precipitation schemes modified from CLM4 - !* :SUBROUTINE:"LEAF_interception_CLM5" : interception and drainage of precipitation schemes modified from CLM5 - !* :SUBROUTINE:"LEAF_interception_NOAHMP" : interception and drainage of precipitation schemes modified from Noah-MP - !* :SUBROUTINE:"LEAF_interception_MATSIRO" : interception and drainage of precipitation schemes modified from MATSIRO 2021 version - !* :SUBROUTINE:"LEAF_interception_VIC" : interception and drainage of precipitation schemes modified from VIC - !* :SUBROUTINE:"LEAF_interception_JULES" : interception and drainage of precipitation schemes modified from JULES - !* :SUBROUTINE:"LEAF_interception_pftwrap" : wapper for pft land use classification + !* :SUBROUTINE:"LEAF_interception_CoLM2014" : Leaf interception and drainage schemes based on colm2014 version + !* :SUBROUTINE:"LEAF_interception_CoLM202x" : Leaf interception and drainage schemes besed on new colm version (under development) + !* :SUBROUTINE:"LEAF_interception_CLM4" : Leaf interception and drainage schemes modified from CLM4 + !* :SUBROUTINE:"LEAF_interception_CLM5" : Leaf interception and drainage schemes modified from CLM5 + !* :SUBROUTINE:"LEAF_interception_NOAHMP" : Leaf interception and drainage schemes modified from Noah-MP + !* :SUBROUTINE:"LEAF_interception_MATSIRO" : Leaf interception and drainage schemes modified from MATSIRO 2021 version + !* :SUBROUTINE:"LEAF_interception_VIC" : Leaf interception and drainage schemes modified from VIC + !* :SUBROUTINE:"LEAF_interception_JULES" : Leaf interception and drainage schemes modified from JULES + !* :SUBROUTINE:"LEAF_interception_pftwrap" : wrapper for pft land use classification !REVISION HISTORY: !---------------- @@ -102,25 +102,30 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la !References: !------------------- - !---Dai, Y., Zeng, X., Dickinson, R.E., Baker, I., Bonan, G.B., BosiloVICh, M.G., Denning, A.S., - ! Dirmeyer, P.A., Houser, P.R., Niu, G. and Oleson, K.W., 2003. - ! The common land model. Bulletin of the American Meteorological Society, 84(8), pp.1013-1024. - - !---Lawrence, D.M., Thornton, P.E., Oleson, K.W. and Bonan, G.B., 2007. - ! The partitioning of evapotranspiration into transpiration, soil evaporation, - ! and canopy evaporation in a GCM: Impacts on land–atmosphere interaction. Journal of Hydrometeorology, 8(4), pp.862-880. - - !---Oleson, K., Dai, Y., Bonan, B., BosiloVIChm, M., Dickinson, R., Dirmeyer, P., Hoffman, - ! F., Houser, P., Levis, S., Niu, G.Y. and Thornton, P., 2004. - ! Technical description of the community land model (CLM). - - !---Sellers, P.J., Randall, D.A., Collatz, G.J., Berry, J.A., Field, C.B., Dazlich, D.A., Zhang, C., - ! Collelo, G.D. and Bounoua, L., 1996. A revised land surface parameterization (SiB2) for atmospheric GCMs. - ! Part I: Model formulation. Journal of climate, 9(4), pp.676-705. - - !---Sellers, P.J., Tucker, C.J., Collatz, G.J., Los, S.O., Justice, C.O., Dazlich, D.A. and Randall, D.A., 1996. - ! A revised land surface parameterization (SiB2) for atmospheric GCMs. Part II: - ! The generation of global fields of terrestrial biophysical parameters from satellite data. + !---Dai, Y., Zeng, X., Dickinson, R.E., Baker, I., Bonan, G.B., BosiloVICh, + ! M.G., Denning, A.S., Dirmeyer, P.A., Houser, P.R., Niu, G. and Oleson, + ! K.W., 2003. The common land model. Bulletin of the American + ! Meteorological Society, 84(8), pp.1013-1024. + + !---Lawrence, D.M., Thornton, P.E., Oleson, K.W. and Bonan, G.B., 2007. The + ! partitioning of evapotranspiration into transpiration, soil evaporation, + ! and canopy evaporation in a GCM: Impacts on land–atmosphere interaction. + ! Journal of Hydrometeorology, 8(4), pp.862-880. + + !---Oleson, K., Dai, Y., Bonan, B., BosiloVIChm, M., Dickinson, R., + ! Dirmeyer, P., Hoffman, F., Houser, P., Levis, S., Niu, G.Y. and + ! Thornton, P., 2004. Technical description of the community land model + ! (CLM). + + !---Sellers, P.J., Randall, D.A., Collatz, G.J., Berry, J.A., Field, C.B., + ! Dazlich, D.A., Zhang, C., Collelo, G.D. and Bounoua, L., 1996. A revised + ! land surface parameterization (SiB2) for atmospheric GCMs. Part I: + ! Model formulation. Journal of climate, 9(4), pp.676-705. + + !---Sellers, P.J., Tucker, C.J., Collatz, G.J., Los, S.O., Justice, C.O., + ! Dazlich, D.A. and Randall, D.A., 1996. A revised land surface + ! parameterization (SiB2) for atmospheric GCMs. Part II: The generation of + ! global fields of terrestrial biophysical parameters from satellite data. ! Journal of climate, 9(4), pp.706-737. diff --git a/main/MOD_LeafTemperature.F90 b/main/MOD_LeafTemperature.F90 index d4438612..8f79d335 100644 --- a/main/MOD_LeafTemperature.F90 +++ b/main/MOD_LeafTemperature.F90 @@ -52,7 +52,7 @@ SUBROUTINE LeafTemperature ( & lai_old ,o3uptakesun,o3uptakesha,forc_ozone ,& !End ozone stress variables !WUE stomata model parameter - lambda ,& + lambda ,& !End WUE stomata model parameter hpbl ,& qintr_rain ,qintr_snow ,t_precip ,hprl ,dheatl ,smp ,& @@ -62,36 +62,40 @@ SUBROUTINE LeafTemperature ( & ! !DESCRIPTION: ! Foliage energy conservation is given by foliage energy budget equation ! Rnet - Hf - LEf = 0 -! The equation is solved by Newton-Raphson iteration, in which this iteration -! includes the calculation of the photosynthesis and stomatal resistance, and the -! integration of turbulent flux profiles. The sensible and latent heat -! transfer between foliage and atmosphere and ground is linked by the equations: +! The equation is solved by Newton-Raphson iteration, in which this +! iteration includes the calculation of the photosynthesis and stomatal +! resistance, and the integration of turbulent flux profiles. The +! sensible and latent heat transfer between foliage and atmosphere and +! ground is linked by the equations: ! Ha = Hf + Hg and Ea = Ef + Eg ! ! Original author : Yongjiu Dai, August 15, 2001 ! ! !REVISIONS: ! -! 09/2014, Hua Yuan: imbalanced energy due to T/q adjustment is allocated -! to sensible heat flux. +! 09/2014, Hua Yuan: imbalanced energy due to T/q adjustment is +! allocated to sensible heat flux. ! -! 10/2017, Hua Yuan: added options for z0, displa, rb and rd calculation -! (Dai, Y., Yuan, H., Xin, Q., Wang, D., Shangguan, W., -! Zhang, S., et al. (2019). Different representations of -! canopy structure—A large source of uncertainty in global -! land surface modeling. Agricultural and Forest Meteorology, -! 269–270, 119–135. https://doi.org/10.1016/j.agrformet.2019.02.006 +! 10/2017, Hua Yuan: added options for z0, displa, rb and rd +! calculation (Dai, Y., Yuan, H., Xin, Q., Wang, D., +! Shangguan, W., Zhang, S., et al. (2019). Different +! representations of canopy structure—A large source of +! uncertainty in global land surface modeling. Agricultural +! and Forest Meteorology, 269–270, 119–135. +! https://doi.org/10.1016/j.agrformet.2019.02.006 ! ! 10/2019, Hua Yuan: change only the leaf temperature from two-leaf ! to one-leaf (due to large differences may exist between ! sunlit/shaded leaf temperature. ! -! 01/2021, Xingjie Lu and Nan Wei: added plant hydraulic process interface. +! 01/2021, Xingjie Lu and Nan Wei: added plant hydraulic process +! interface. ! ! 01/2021, Nan Wei: added interaction btw prec and canopy. ! -! 05/2023, Shaofeng Liu: add option to call moninobuk_leddy, the LargeEddy -! surface turbulence scheme (LZD2022); make a proper update of um. +! 05/2023, Shaofeng Liu: add option to call moninobuk_leddy, the +! LargeEddy surface turbulence scheme (LZD2022); make a proper +! update of um. ! ! 04/2024, Hua Yuan: add option to account for vegetation snow process. ! @@ -493,7 +497,7 @@ SUBROUTINE LeafTemperature ( & CALL cal_z0_displa(lai+sai, htop, 1., z0mv, displa) - ! NOTE: adjusted for samll displa + ! NOTE: adjusted for small displa displasink = max(htop/2., displa) hsink = z0mv + displasink @@ -1158,7 +1162,7 @@ SUBROUTINE LeafTemperature ( & ldew = ldew_rain + ldew_snow ENDIF - ELSEIF (DEF_Interception_scheme .eq. 2) THEN!CLM4.5 + ELSEIF (DEF_Interception_scheme .eq. 2) THEN !CLM4.5 ldew = max(0., ldew-evplwet*deltim) ELSEIF (DEF_Interception_scheme .eq. 3) THEN !CLM5 diff --git a/main/MOD_LeafTemperaturePC.F90 b/main/MOD_LeafTemperaturePC.F90 index 0564dd85..eff6c4b2 100644 --- a/main/MOD_LeafTemperaturePC.F90 +++ b/main/MOD_LeafTemperaturePC.F90 @@ -71,34 +71,37 @@ SUBROUTINE LeafTemperaturePC ( & !======================================================================= ! ! !DESCRIPTION: -! Leaf temperature resolved for Plant Community (3D) case Foliage energy -! conservation for each PFT is given by foliage energy budget equation +! Leaf temperature resolved for Plant Community (3D) case Foliage +! energy conservation for each PFT is given by foliage energy budget +! equation: ! Rnet - Hf - LEf = 0 -! The equation is solved by Newton-Raphson iteration, in which this iteration -! includes the calculation of the photosynthesis and stomatal resistance, and -! the integration of turbulent flux profiles. The sensible and latent heat -! transfer between foliage and atmosphere and ground is linked by the -! equations: +! The equation is solved by Newton-Raphson iteration, in which this +! iteration includes the calculation of the photosynthesis and stomatal +! resistance, and the integration of turbulent flux profiles. The +! sensible and latent heat transfer between foliage and atmosphere and +! ground is linked by the equations: ! Ha = Hf + Hg and Ea = Ef + Eg ! ! Original author : Hua Yuan and Yongjiu Dai, September, 2017 ! ! ! !REFERENCES: -! 1) Dai, Y., Yuan, H., Xin, Q., Wang, D., Shangguan, W., Zhang, S., et al. -! (2019). Different representations of canopy structure—A large source of -! uncertainty in global land surface modeling. Agricultural and Forest -! Meteorology, 269–270, 119–135. +! 1) Dai, Y., Yuan, H., Xin, Q., Wang, D., Shangguan, W., Zhang, S., et +! al. (2019). Different representations of canopy structure—A large +! source of uncertainty in global land surface modeling. Agricultural +! and Forest Meteorology, 269–270, 119–135. ! https://doi.org/10.1016/j.agrformet.2019.02.006 ! ! !REVISIONS: ! -! 01/2021, Xingjie Lu and Nan Wei: added plant hydraulic process interface. +! 01/2021, Xingjie Lu and Nan Wei: added plant hydraulic process +! interface. ! ! 01/2021, Nan Wei: added interaction btw prec and canopy. ! -! 05/2023, Shaofeng Liu: add option to call moninobuk_leddy, the LargeEddy -! surface turbulence scheme (LZD2022); make a proper update of um. +! 05/2023, Shaofeng Liu: add option to call moninobuk_leddy, the +! LargeEddy surface turbulence scheme (LZD2022); make a proper +! update of um. ! ! 04/2024, Hua Yuan: add option to account for vegetation snow process. ! @@ -106,8 +109,8 @@ SUBROUTINE LeafTemperaturePC ( & USE MOD_Precision USE MOD_Vars_Global - USE MOD_Const_Physical, only: vonkar, grav, hvap, hsub, cpair, stefnc, cpliq, cpice, & - hfus, tfrz, denice, denh2o + USE MOD_Const_Physical, only: vonkar, grav, hvap, hsub, cpair, stefnc, & + cpliq, cpice, hfus, tfrz, denice, denh2o USE MOD_Const_PFT USE MOD_FrictionVelocity USE MOD_CanopyLayerProfile diff --git a/main/MOD_LightningData.F90 b/main/MOD_LightningData.F90 index 5509bfce..9ae66921 100644 --- a/main/MOD_LightningData.F90 +++ b/main/MOD_LightningData.F90 @@ -2,12 +2,12 @@ #ifdef BGC MODULE MOD_LightningData - !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! This module read in lightning data for fire subroutine - ! - ! !ORIGINAL: - ! Zhang Shupeng, 2022, prepare the original version of the lightning data module. +!----------------------------------------------------------------------- +! !DESCRIPTION: +! This module read in lightning data for fire subroutine +! +! !ORIGINAL: +! Zhang Shupeng, 2022, prepare the original version of the lightning data module. USE MOD_Grid diff --git a/main/MOD_NewSnow.F90 b/main/MOD_NewSnow.F90 index a1fa4cff..3e3907a5 100644 --- a/main/MOD_NewSnow.F90 +++ b/main/MOD_NewSnow.F90 @@ -69,7 +69,7 @@ SUBROUTINE newsnow (patchtype,maxsnl,deltim,t_grnd,pg_rain,pg_snow,bifall,& dz_snowf = pg_snow/bifall snowdp = snowdp + dz_snowf*deltim - scv = scv + pg_snow*deltim ! snow water equivalent (mm) + scv = scv + pg_snow*deltim ! snow water equivalent (mm) IF(patchtype==2 .and. t_grnd>tfrz)THEN ! snowfall on warmer wetland IF (present(wetwat) .and. DEF_USE_VariablySaturatedFlow) THEN diff --git a/main/MOD_NitrifData.F90 b/main/MOD_NitrifData.F90 index 82db053a..a67afd49 100644 --- a/main/MOD_NitrifData.F90 +++ b/main/MOD_NitrifData.F90 @@ -2,12 +2,12 @@ #ifdef BGC MODULE MOD_NitrifData - !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! This module read in nitrif data. - ! - ! !ORIGINAL: - ! Lu Xingjie and Zhang Shupeng, 2023, prepare the original version of the nitrif data module. +!----------------------------------------------------------------------- +! !DESCRIPTION: +! This module read in nitrif data. +! +! !ORIGINAL: +! Lu Xingjie and Zhang Shupeng, 2023, prepare the original version of the nitrif data module. USE MOD_Grid USE MOD_SpatialMapping diff --git a/main/MOD_OrbCoszen.F90 b/main/MOD_OrbCoszen.F90 index 94187c64..dd38a4a2 100644 --- a/main/MOD_OrbCoszen.F90 +++ b/main/MOD_OrbCoszen.F90 @@ -20,14 +20,15 @@ MODULE MOD_OrbCoszen FUNCTION orb_coszen(calday,dlon,dlat) !----------------------------------------------------------------------- -! FUNCTION to return the cosine of the solar zenith angle. Assumes 365.0 days/year. -! Compute earth/orbit parameters using formula suggested by -! Duane Thresher. Use formulas from Berger, Andre 1978: Long-Term Variations of Daily -! Insolation and Quaternary Climatic Changes. J. of the Atmo. Sci. 35:2362-2367. +! FUNCTION to return the cosine of the solar zenith angle. Assumes 365.0 +! days/year. Compute earth/orbit parameters using formula suggested by +! Duane Thresher. Use formulas from Berger, Andre 1978: Long-Term +! Variations of Daily Insolation and Quaternary Climatic Changes. J. of +! the Atmo. Sci. 35:2362-2367. ! ! Original version: Erik Kluzek, Oct/1997, Brian Kauffman, Jan/98 ! CCSM2.0 standard -! yongjiu dai (07/23/2002) +! Yongjiu Dai (07/23/2002) !----------------------------------------------------------------------- USE MOD_Precision diff --git a/main/MOD_Ozone.F90 b/main/MOD_Ozone.F90 index eb675545..02c4fc82 100644 --- a/main/MOD_Ozone.F90 +++ b/main/MOD_Ozone.F90 @@ -2,16 +2,17 @@ Module MOD_Ozone - !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! This module hold the plant physiological response to the ozone, including vcmax response and stomata response. - ! Ozone concentration can be either readin through Mod_OzoneData module or set to constant. - ! - ! !ORIGINAL: - ! The Community Land Model version 5.0 (CLM5.0) - ! - ! !REVISION: - ! Xingjie Lu 2022, revised the CLM5 code to be compatible with CoLM code structure. +!----------------------------------------------------------------------- +! !DESCRIPTION: +! This module hold the plant physiological response to the ozone, +! including vcmax response and stomata response. Ozone concentration +! can be either readin through Mod_OzoneData module or set to constant. +! +! !ORIGINAL: +! The Community Land Model version 5.0 (CLM5.0) +! +! !REVISION: +! Xingjie Lu 2022, revised the CLM5 code to be compatible with CoLM code structure. diff --git a/main/MOD_Runoff.F90 b/main/MOD_Runoff.F90 index eeff455f..c53e3519 100644 --- a/main/MOD_Runoff.F90 +++ b/main/MOD_Runoff.F90 @@ -24,11 +24,12 @@ SUBROUTINE SurfaceRunoff_SIMTOP (nl_soil,wimp,porsl,psi0,hksati,& rsur,rsur_se,rsur_ie) !======================================================================= -! the original code was provide by Robert E. Dickinson based on following clues: -! a water table level determination level added including highland and -! lowland levels and fractional area of wetland (water table above the surface. -! Runoff is parametrized from the lowlands in terms of precip incident on -! wet areas and a base flow, where these are estimated using ideas from TOPMODEL. +! the original code was provide by Robert E. Dickinson based on +! following clues: a water table level determination level added +! including highland and lowland levels and fractional area of wetland +! (water table above the surface. Runoff is parametrized from the +! lowlands in terms of precip incident on wet areas and a base flow, +! where these are estimated using ideas from TOPMODEL. ! ! Author : Yongjiu Dai, 07/29/2002, Guoyue Niu, 06/2012 !======================================================================= @@ -207,12 +208,12 @@ SUBROUTINE Runoff_SimpleVIC ( & integer, intent(in) :: nl_soil ! number of soil layers real(r8), intent(in) :: & - dz_soisno (1:nl_soil), & ! layer thickness (m) - eff_porosity(1:nl_soil), & ! effective porosity = porosity - vol_ice - vol_liq (1:nl_soil), & ! partial volume of liquid water in layer - BVIC, & ! VIC infiltration parameter - gwat, & ! net water input from top - deltim ! time step (s) + dz_soisno (1:nl_soil), & ! layer thickness (m) + eff_porosity(1:nl_soil), & ! effective porosity = porosity - vol_ice + vol_liq (1:nl_soil), & ! partial volume of liquid water in layer + BVIC, & ! VIC infiltration parameter + gwat, & ! net water input from top + deltim ! time step (s) real(r8), intent(out) :: rsur ! surface runoff (mm h2o/s) real(r8), intent(out) :: rsubst ! subsurface runoff (mm h2o/s) diff --git a/main/MOD_SnowLayersCombineDivide.F90 b/main/MOD_SnowLayersCombineDivide.F90 index fdf31b14..ee447e66 100644 --- a/main/MOD_SnowLayersCombineDivide.F90 +++ b/main/MOD_SnowLayersCombineDivide.F90 @@ -54,7 +54,8 @@ SUBROUTINE snowcompaction (lb,deltim,imelt,fiold,& integer, intent(in) :: lb ! lower bound of array real(r8), intent(in) :: deltim ! seconds i a time step [second] integer, intent(in) :: imelt(lb:0) ! signifies IF node in melting (imelt = 1) - real(r8), intent(in) :: fiold(lb:0) ! fraction of ice relative to the total water content at the previous time step + real(r8), intent(in) :: fiold(lb:0) ! fraction of ice relative to the total water content + ! at the previous time step real(r8), intent(in) :: t_soisno(lb:0) ! nodal temperature [K] real(r8), intent(in) :: wice_soisno(lb:0) ! ice lens [kg/m2] real(r8), intent(in) :: wliq_soisno(lb:0) ! liquid water [kg/m2] diff --git a/main/MOD_SoilSnowHydrology.F90 b/main/MOD_SoilSnowHydrology.F90 index 420d1270..35f28888 100644 --- a/main/MOD_SoilSnowHydrology.F90 +++ b/main/MOD_SoilSnowHydrology.F90 @@ -83,13 +83,13 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& !-----------------------Argument---------- ------------------------------ integer, intent(in) :: & - ipatch ,& ! patch index - patchtype ! land patch type (0=soil, 1=urban or built-up, 2=wetland, - ! 3=land ice, 4=land water bodies, 99=ocean + ipatch ,&! patch index + patchtype ! land patch type (0=soil, 1=urban or built-up, 2=wetland, + ! 3=land ice, 4=land water bodies, 99=ocean integer, intent(in) :: & - lb ,& ! lower bound of array - nl_soil ! upper bound of array + lb ,&! lower bound of array + nl_soil ! upper bound of array real(r8), intent(in) :: & deltim ,&! time step (s) @@ -550,7 +550,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& ! wtfact , &! (updated to gridded 'fsatmax' data) fraction of model area with high water table ssi , &! irreducible water saturation of snow pondmx , &! ponding depth (mm) - wimp , &! water impremeable IF porosity less than wimp + wimp , &! water impermeable IF porosity less than wimp topostd , &! standard deviation of elevation (m) BVIC , &! z_soisno (lb:nl_soil) , &! layer depth (m) diff --git a/main/MOD_SoilSurfaceResistance.F90 b/main/MOD_SoilSurfaceResistance.F90 index 2fa6e3e9..7fa703de 100644 --- a/main/MOD_SoilSurfaceResistance.F90 +++ b/main/MOD_SoilSurfaceResistance.F90 @@ -3,7 +3,8 @@ MODULE MOD_SoilSurfaceResistance ! ----------------------------------------------------------------------- ! !DESCRIPTION: -! Calculate the soil surface resistance with multiple parameterization schemes +! Calculate the soil surface resistance with multiple parameterization +! schemes ! ! Created by Zhuo Liu and Hua Yuan, 06/2023 ! @@ -47,15 +48,15 @@ SUBROUTINE SoilSurfaceResistance (nl_soil,forc_rhoair,hksati,porsl,psi0, & !======================================================================= ! !DESCRIPTION: -! Main SUBROUTINE to CALL soil resistance model -! - Options for soil surface resistance schemes +! Main SUBROUTINE to CALL soil resistance model +! - Options for soil surface resistance schemes ! 1: SL14, Swenson and Lawrence (2014) ! 2: SZ09, Sakaguchi and Zeng (2009) ! 3: TR13, Tang and Riley (2013) ! 4: LP92, Lee and Pielke (1992) ! 5: S92, Sellers et al (1992) ! -! NOTE: Support for both Campbell and VG soil parameters. +! NOTE: Support for both Campbell and VG soil parameters. !======================================================================= USE MOD_Precision @@ -99,7 +100,7 @@ SUBROUTINE SoilSurfaceResistance (nl_soil,forc_rhoair,hksati,porsl,psi0, & !-----------------------Local Variables------------------------------ REAL(r8) :: & - wx, &! patial volume of ice and water of surface layer + wx, &! partial volume of ice and water of surface layer vol_liq, &! water content by volume [m3/m3] s_node, &! vol_liq/porosity smp_node, &! matrix potential [m] diff --git a/main/MOD_SoilThermalParameters.F90 b/main/MOD_SoilThermalParameters.F90 index 71a4b3c1..2232627b 100644 --- a/main/MOD_SoilThermalParameters.F90 +++ b/main/MOD_SoilThermalParameters.F90 @@ -29,17 +29,17 @@ SUBROUTINE hCapacity (patchtype,lb,nl_soil,csol,porsl,wice_soisno,wliq_soisno,sc !----------------------------------------------------------------------- ! Original author : Yongjiu Dai, September 15, 1999 ! -! calculation of heat capacities of snow / soil layers -! the volumetric heat capacity is calculated as a linear combination -! in terms of the volumetric fraction of the constituent phases. -! Only used in urban model. TODO: merge with SUBROUTINE soil_hcap_cond +! calculation of heat capacities of snow / soil layers the volumetric +! heat capacity is calculated as a linear combination in terms of the +! volumetric fraction of the constituent phases. Only used in urban +! model. TODO: merge with SUBROUTINE soil_hcap_cond ! ! ________________ ! REVISION HISTORY: -! 07/19/2014, Yongjiu Dai: treat the wetland as soil column instead of water -! body. +! 07/19/2014, Yongjiu Dai: treat the wetland as soil column instead of +! water body. ! 08/16/2014, Nan Wei: recalculate the heat capacity of soil layers -! underneath the lake +! underneath the lake ! !----------------------------------------------------------------------- @@ -47,16 +47,16 @@ SUBROUTINE hCapacity (patchtype,lb,nl_soil,csol,porsl,wice_soisno,wliq_soisno,sc USE MOD_Const_Physical, only : cpice,cpliq IMPLICIT NONE - integer, intent(in) :: lb ! lower bound of array - integer, intent(in) :: nl_soil ! upper bound of array - integer, intent(in) :: patchtype! land patch type (0=soil, 1=urban, 2=wetland, - real(r8), intent(in) :: csol(1:nl_soil) ! heat capacity of soil soilds [J/(m3 K)] - real(r8), intent(in) :: porsl(1:nl_soil) ! soil porosity - real(r8), intent(in) :: wice_soisno(lb:nl_soil) ! ice lens [kg/m2] - real(r8), intent(in) :: wliq_soisno(lb:nl_soil) ! liquid water [kg/m2] - real(r8), intent(in) :: dz_soisno(lb:nl_soil) ! layer thickness [m] - real(r8), intent(in) :: scv ! snow water equivalent [mm] - real(r8), intent(out) :: cv(lb:nl_soil) ! heat capacity [J/(m2 K)] + integer, intent(in) :: lb ! lower bound of array + integer, intent(in) :: nl_soil ! upper bound of array + integer, intent(in) :: patchtype ! land patch type (0=soil, 1=urban, 2=wetland, + real(r8), intent(in) :: csol(1:nl_soil) ! heat capacity of soil soilds [J/(m3 K)] + real(r8), intent(in) :: porsl(1:nl_soil) ! soil porosity + real(r8), intent(in) :: wice_soisno(lb:nl_soil) ! ice lens [kg/m2] + real(r8), intent(in) :: wliq_soisno(lb:nl_soil) ! liquid water [kg/m2] + real(r8), intent(in) :: dz_soisno(lb:nl_soil) ! layer thickness [m] + real(r8), intent(in) :: scv ! snow water equivalent [mm] + real(r8), intent(out) :: cv(lb:nl_soil) ! heat capacity [J/(m2 K)] !----------------------------------------------------------------------- ! Soil heat capacity, which from de Vires (1963) @@ -82,36 +82,36 @@ SUBROUTINE hConductivity (patchtype,lb,nl_soil,& !----------------------------------------------------------------------- ! Original author : Yongjiu Dai, September 15, 1999 ! -! calculation of thermal conductivities of snow / soil layers -! The thermal conductivity of soil is computed from -! the algorithm of Johansen (as reported by Farouki 1981), and of snow is from -! the formulation used in SNTHERM (Jordan 1991). +! calculation of thermal conductivities of snow / soil layers The +! thermal conductivity of soil is computed from the algorithm of +! Johansen (as reported by Farouki 1981), and of snow is from the +! formulation used in SNTHERM (Jordan 1991). ! -! The thermal conductivities at the interfaces between two neighbor layers -! (j, j+1) are derived from an assumption that the flux across the interface -! is equal to that from the node j to the interface and the flux from the -! interface to the node j+1. +! The thermal conductivities at the interfaces between two neighbor +! layers (j, j+1) are derived from an assumption that the flux across +! the interface is equal to that from the node j to the interface and +! the flux from the interface to the node j+1. ! ! Only used in urban model. TODO: merge with subroutine soil_hcap_cond ! ________________ ! REVISION HISTORY: -! 07/19/2014, Yongjiu Dai: treat the wetland as soil column instead of water -! body. +! 07/19/2014, Yongjiu Dai: treat the wetland as soil column instead of +! water body. ! 08/16/2014, Nan Wei: recalculate the heat conductivity of soil layers -! underneath the lake +! underneath the lake !----------------------------------------------------------------------- USE MOD_Precision USE MOD_Const_Physical, only : denh2o,denice,tfrz,tkwat,tkice,tkair IMPLICIT NONE - integer, intent(in) :: lb ! lower bound of array - integer, intent(in) :: nl_soil ! upper bound of array - integer, intent(in) :: patchtype! land patch type (0=soil, 1=urban, 2=wetland, - ! 3=land ice, 4=deep lake, 5=shallow lake) - real(r8), intent(in) :: dkdry(1:nl_soil) ! thermal conductivity for dry soil [W/m-K] - real(r8), intent(in) :: dksatu(1:nl_soil) ! Thermal conductivity of saturated soil [W/m-K] - real(r8), intent(in) :: porsl(1:nl_soil) ! fractional volume between soil grains=1.-dmvol + integer, intent(in) :: lb ! lower bound of array + integer, intent(in) :: nl_soil ! upper bound of array + integer, intent(in) :: patchtype ! land patch type (0=soil, 1=urban, 2=wetland, + ! 3=land ice, 4=deep lake, 5=shallow lake) + real(r8), intent(in) :: dkdry(1:nl_soil) ! thermal conductivity for dry soil [W/m-K] + real(r8), intent(in) :: dksatu(1:nl_soil) ! Thermal conductivity of saturated soil [W/m-K] + real(r8), intent(in) :: porsl(1:nl_soil) ! fractional volume between soil grains=1.-dmvol real(r8), intent(in) :: dz_soisno(lb:nl_soil) ! layer thickness [m] real(r8), intent(in) :: z_soisno(lb:nl_soil) ! node depth [m] real(r8), intent(in) :: zi_soisno(lb-1:nl_soil) ! interface depth [m] @@ -119,16 +119,16 @@ SUBROUTINE hConductivity (patchtype,lb,nl_soil,& real(r8), intent(in) :: wice_soisno(lb:nl_soil) ! ice lens [kg/m2] real(r8), intent(in) :: wliq_soisno(lb:nl_soil) ! liquid water [kg/m2] - real(r8), intent(out) :: tk(lb:nl_soil) ! thermal conductivity [W/(m K)] + real(r8), intent(out) :: tk(lb:nl_soil) ! thermal conductivity [W/(m K)] real(r8), optional, intent(out) :: tktopsoil ! local - real(r8) rhosnow ! partial density of water (ice + liquid) - real(r8) dksat ! thermal conductivity for saturated soil (j/(k s m)) - real(r8) dke ! kersten number - real(r8) fl ! fraction of liquid or unfrozen water to total water - real(r8) satw ! relative total water content of soil. - real(r8) thk(lb:nl_soil) ! thermal conductivity of layer + real(r8) rhosnow ! partial density of water (ice + liquid) + real(r8) dksat ! thermal conductivity for saturated soil (j/(k s m)) + real(r8) dke ! kersten number + real(r8) fl ! fraction of liquid or unfrozen water to total water + real(r8) satw ! relative total water content of soil. + real(r8) thk(lb:nl_soil) ! thermal conductivity of layer real(r8) xicevol integer i @@ -233,20 +233,23 @@ SUBROUTINE soil_hcap_cond(vf_gravels_s,vf_om_s,vf_sand_s,vf_pores_s,& temperature,vf_water,vf_ice,hcap,thk) !----------------------------------------------------------------------- -! DESCRIPTION: -! Calculate bulk soil heat capacity and soil thermal conductivity with 8 optional schemes -! The default soil thermal conductivity scheme is the fourth one (Balland V. and P. A. Arp, 2005) +! !DESCRIPTION: +! Calculate bulk soil heat capacity and soil thermal conductivity with +! 8 optional schemes The default soil thermal conductivity scheme is +! the fourth one (Balland V. and P. A. Arp, 2005) ! -! Reference: -! Dai et al.,2019: Evaluation of Soil Thermal Conductivity Schemes for Use in Land Surface Modeling -! J. of Advances in Modeling Earth Systems, DOI: 10.1029/2019MS001723 +! !Reference: +! Dai et al.,2019: Evaluation of Soil Thermal Conductivity Schemes for +! Use in Land Surface Modeling J. of Advances in Modeling Earth +! Systems, DOI: 10.1029/2019MS001723 ! -! Original author: Yongjiu Dai, 02/2018/ +! !Original author: Yongjiu Dai, 02/2018/ ! -! Revisions: -! Nan Wei, 06/2018: add to CoLM/main -! Nan Wei, 09/2022: add soil thermal conductivity of Hailong He (Yan & He et al., 2019) -! ----------------------------------------------------------------------------------------- +! !Revisions: +! 06/2018, Nan Wei: add to CoLM/main +! 09/2022, Nan Wei: add soil thermal conductivity of Hailong He (Yan & +! He et al., 2019) +! ----------------------------------------------------------------------------------------- USE MOD_Precision USE MOD_Const_Physical,only:tfrz USE MOD_Namelist diff --git a/main/MOD_Thermal.F90 b/main/MOD_Thermal.F90 index ae93e3be..d60805dc 100644 --- a/main/MOD_Thermal.F90 +++ b/main/MOD_Thermal.F90 @@ -96,11 +96,12 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , ! ! ! REVISIONS: -! Hua Yuan, 08/2019: added initial codes for PFT and Plant Community (PC) -! vegetation classification processes +! 08/2019, Hua Yuan: added initial codes for PFT and Plant Community +! (PC) vegetation classification processes ! -! Nan Wei, 01/2021: added variables passing of plant hydraulics and precipitation sensible heat -! with canopy and ground for PFT and Plant Community (PC) +! 01/2021, Nan Wei: added variables passing of plant hydraulics and +! precipitation sensible heat with canopy and ground for PFT +! and Plant Community (PC) !======================================================================= USE MOD_Precision @@ -1084,7 +1085,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , ! calculation of evaporative potential; flux in kg m-2 s-1. ! egidif holds the excess energy IF all water is evaporated -! during the timestep. this energy is later added to the sensible heat flux. +! during the timestep. This energy is later added to the sensible heat flux. qseva = 0. qsubl = 0. @@ -1264,3 +1265,4 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , END SUBROUTINE THERMAL END MODULE MOD_Thermal +! ---------- EOP ------------ diff --git a/main/MOD_TurbulenceLEddy.F90 b/main/MOD_TurbulenceLEddy.F90 index 8c9d1d7f..3bbe0818 100644 --- a/main/MOD_TurbulenceLEddy.F90 +++ b/main/MOD_TurbulenceLEddy.F90 @@ -25,17 +25,18 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & ! ====================================================================== ! -! Implement the LZD2022 scheme (Liu et al., 2022), which accounts for large -! eddy effects by including the boundary layer height in the phim FUNCTION, -! to compute friction velocity, relation for potential temperature and -! humidity profiles of surface boundary layer. +! Implement the LZD2022 scheme (Liu et al., 2022), which accounts for +! large eddy effects by including the boundary layer height in the phim +! FUNCTION, to compute friction velocity, relation for potential +! temperature and humidity profiles of surface boundary layer. ! ! References: ! [1] Zeng et al., 1998: Intercomparison of bulk aerodynamic algorithms -! for the computation of sea surface fluxes using TOGA CORE and TAO data. -! J. Climate, 11: 2628-2644. +! for the computation of sea surface fluxes using TOGA CORE and TAO +! data. J. Climate, 11: 2628-2644. ! [2] Liu et al., 2022: A surface flux estimation scheme accounting for -! large-eddy effects for land surface modeling. GRL, 49, e2022GL101754. +! large-eddy effects for land surface modeling. GRL, 49, +! e2022GL101754. ! ! Created by Shaofeng Liu, May 5, 2023 ! diff --git a/main/MOD_UserSpecifiedForcing.F90 b/main/MOD_UserSpecifiedForcing.F90 index fe1da56d..78367a4c 100644 --- a/main/MOD_UserSpecifiedForcing.F90 +++ b/main/MOD_UserSpecifiedForcing.F90 @@ -44,36 +44,36 @@ MODULE MOD_UserSpecifiedForcing character(len=256) :: dataset - logical :: solarin_all_band ! whether solar radiation in all bands is available + logical :: solarin_all_band ! whether solar radiation in all bands is available character(len=256) :: HEIGHT_mode ! observation height mode - real(r8) :: HEIGHT_V ! observation height of wind speed - real(r8) :: HEIGHT_T ! observation height of air temperature - real(r8) :: HEIGHT_Q ! observation height of specific humidity + real(r8) :: HEIGHT_V ! observation height of wind speed + real(r8) :: HEIGHT_T ! observation height of air temperature + real(r8) :: HEIGHT_Q ! observation height of specific humidity - integer :: NVAR ! variable number of forcing data - integer :: startyr ! start year of forcing data - integer :: startmo ! start month of forcing data - integer :: endyr ! END year of forcing data - integer :: endmo ! END month of forcing data + integer :: NVAR ! variable number of forcing data + integer :: startyr ! start year of forcing data + integer :: startmo ! start month of forcing data + integer :: endyr ! END year of forcing data + integer :: endmo ! END month of forcing data - integer, allocatable :: dtime(:) ! time interval of forcing data - integer, allocatable :: offset(:) ! offset of forcing data + integer, allocatable :: dtime(:) ! time interval of forcing data + integer, allocatable :: offset(:) ! offset of forcing data - logical :: leapyear ! leapyear calendar - logical :: data2d ! data in 2 dimension (lon, lat) - logical :: hightdim ! have "z" dimension - logical :: dim2d ! lat/lon value in 2 dimension (lon, lat) + logical :: leapyear ! leapyear calendar + logical :: data2d ! data in 2 dimension (lon, lat) + logical :: hightdim ! have "z" dimension + logical :: dim2d ! lat/lon value in 2 dimension (lon, lat) - character(len=256) :: latname ! dimension name of latitude - character(len=256) :: lonname ! dimension name of longitude + character(len=256) :: latname ! dimension name of latitude + character(len=256) :: lonname ! dimension name of longitude - character(len=256) :: groupby ! file grouped by year/month + character(len=256) :: groupby ! file grouped by year/month - character(len=256), allocatable :: fprefix(:) ! file prefix - character(len=256), allocatable :: vname(:) ! variable name - character(len=256), allocatable :: timelog(:) ! variable time log info - character(len=256), allocatable :: tintalgo(:) ! interpolation algorithm + character(len=256), allocatable :: fprefix(:) ! file prefix + character(len=256), allocatable :: vname(:) ! variable name + character(len=256), allocatable :: timelog(:) ! variable time log info + character(len=256), allocatable :: tintalgo(:) ! interpolation algorithm ! ----- public subroutines ----- PUBLIC :: init_user_specified_forcing ! initialization of the selected forcing dataset diff --git a/main/MOD_Vars_1DAccFluxes.F90 b/main/MOD_Vars_1DAccFluxes.F90 index 06a4f53d..c250ea69 100644 --- a/main/MOD_Vars_1DAccFluxes.F90 +++ b/main/MOD_Vars_1DAccFluxes.F90 @@ -290,7 +290,7 @@ MODULE MOD_Vars_1DAccFluxes real(r8), allocatable :: a_deadcrootn_xferCap (:) #endif ! Ozone stress variables - real(r8), allocatable :: a_ozone (:) + real(r8), allocatable :: a_ozone (:) ! End ozone stress variables real(r8), allocatable :: a_t_soisno (:,:) @@ -2447,4 +2447,4 @@ SUBROUTINE acc3d (var, s) END SUBROUTINE acc3d END MODULE MOD_Vars_1DAccFluxes -! ----- EOP --------- +! ---------- EOP ------------ diff --git a/main/MOD_Vars_1DForcing.F90 b/main/MOD_Vars_1DForcing.F90 index d185880a..02fbcfe2 100644 --- a/main/MOD_Vars_1DForcing.F90 +++ b/main/MOD_Vars_1DForcing.F90 @@ -159,4 +159,4 @@ SUBROUTINE deallocate_1D_Forcing () END SUBROUTINE deallocate_1D_Forcing END MODULE MOD_Vars_1DForcing -! ------ EOP -------- +! ---------- EOP ------------ diff --git a/main/MOD_Vars_1DPFTFluxes.F90 b/main/MOD_Vars_1DPFTFluxes.F90 index a6042f3f..f7048e95 100644 --- a/main/MOD_Vars_1DPFTFluxes.F90 +++ b/main/MOD_Vars_1DPFTFluxes.F90 @@ -20,22 +20,22 @@ MODULE MOD_Vars_1DPFTFluxes ! ----------------------------------------------------------------- ! Fluxes ! ----------------------------------------------------------------- - real(r8), allocatable :: taux_p (:) !wind stress: E-W [kg/m/s2] - real(r8), allocatable :: tauy_p (:) !wind stress: N-S [kg/m/s2] - real(r8), allocatable :: fsenl_p (:) !sensible heat from leaves [W/m2] - real(r8), allocatable :: fevpl_p (:) !evaporation+transpiration from leaves [mm/s] - real(r8), allocatable :: etr_p (:) !transpiration rate [mm/s] - real(r8), allocatable :: fseng_p (:) !sensible heat flux from ground [W/m2] - real(r8), allocatable :: fevpg_p (:) !evaporation heat flux from ground [mm/s] - real(r8), allocatable :: parsun_p (:) !solar absorbed by sunlit vegetation [W/m2] - real(r8), allocatable :: parsha_p (:) !solar absorbed by shaded vegetation [W/m2] - real(r8), allocatable :: sabvsun_p(:) !solar absorbed by sunlit vegetation [W/m2] - real(r8), allocatable :: sabvsha_p(:) !solar absorbed by shaded vegetation [W/m2] - real(r8), allocatable :: qintr_p (:) !interception (mm h2o/s) + real(r8), allocatable :: taux_p (:) !wind stress: E-W [kg/m/s2] + real(r8), allocatable :: tauy_p (:) !wind stress: N-S [kg/m/s2] + real(r8), allocatable :: fsenl_p (:) !sensible heat from leaves [W/m2] + real(r8), allocatable :: fevpl_p (:) !evaporation+transpiration from leaves [mm/s] + real(r8), allocatable :: etr_p (:) !transpiration rate [mm/s] + real(r8), allocatable :: fseng_p (:) !sensible heat flux from ground [W/m2] + real(r8), allocatable :: fevpg_p (:) !evaporation heat flux from ground [mm/s] + real(r8), allocatable :: parsun_p (:) !solar absorbed by sunlit vegetation [W/m2] + real(r8), allocatable :: parsha_p (:) !solar absorbed by shaded vegetation [W/m2] + real(r8), allocatable :: sabvsun_p(:) !solar absorbed by sunlit vegetation [W/m2] + real(r8), allocatable :: sabvsha_p(:) !solar absorbed by shaded vegetation [W/m2] + real(r8), allocatable :: qintr_p (:) !interception (mm h2o/s) real(r8), allocatable :: qintr_rain_p(:) !rainfall interception (mm h2o/s) real(r8), allocatable :: qintr_snow_p(:) !snowfall interception (mm h2o/s) - real(r8), allocatable :: assim_p (:) !canopy assimilation rate (mol m-2 s-1) - real(r8), allocatable :: respc_p (:) !canopy respiration (mol m-2 s-1) + real(r8), allocatable :: assim_p (:) !canopy assimilation rate (mol m-2 s-1) + real(r8), allocatable :: respc_p (:) !canopy respiration (mol m-2 s-1) ! PUBLIC MEMBER FUNCTIONS: PUBLIC :: allocate_1D_PFTFluxes @@ -63,22 +63,22 @@ SUBROUTINE allocate_1D_PFTFluxes IF (p_is_worker) THEN IF (numpft > 0) THEN - allocate (taux_p (numpft)) ; taux_p (:) = spval !wind stress: E-W [kg/m/s2] - allocate (tauy_p (numpft)) ; tauy_p (:) = spval !wind stress: N-S [kg/m/s2] - allocate (fsenl_p (numpft)) ; fsenl_p (:) = spval !sensible heat from leaves [W/m2] - allocate (fevpl_p (numpft)) ; fevpl_p (:) = spval !evaporation+transpiration from leaves [mm/s] - allocate (etr_p (numpft)) ; etr_p (:) = spval !transpiration rate [mm/s] - allocate (fseng_p (numpft)) ; fseng_p (:) = spval !sensible heat flux from ground [W/m2] - allocate (fevpg_p (numpft)) ; fevpg_p (:) = spval !evaporation heat flux from ground [mm/s] - allocate (parsun_p (numpft)) ; parsun_p (:) = spval !solar absorbed by sunlit vegetation [W/m2] - allocate (parsha_p (numpft)) ; parsha_p (:) = spval !solar absorbed by shaded vegetation [W/m2] - allocate (sabvsun_p (numpft)) ; sabvsun_p (:) = spval !solar absorbed by sunlit vegetation [W/m2] - allocate (sabvsha_p (numpft)) ; sabvsha_p (:) = spval !solar absorbed by shaded vegetation [W/m2] - allocate (qintr_p (numpft)) ; qintr_p (:) = spval !interception (mm h2o/s) - allocate (qintr_rain_p (numpft)) ; qintr_rain_p (:) = spval!rainfall interception (mm h2o/s) - allocate (qintr_snow_p (numpft)) ; qintr_snow_p (:) = spval!snowfall interception (mm h2o/s) - allocate (assim_p (numpft)) ; assim_p (:) = spval !canopy assimilation rate (mol m-2 s-1) - allocate (respc_p (numpft)) ; respc_p (:) = spval !canopy respiration (mol m-2 s-1) + allocate (taux_p (numpft)) ; taux_p (:) = spval !wind stress: E-W [kg/m/s2] + allocate (tauy_p (numpft)) ; tauy_p (:) = spval !wind stress: N-S [kg/m/s2] + allocate (fsenl_p (numpft)) ; fsenl_p (:) = spval !sensible heat from leaves [W/m2] + allocate (fevpl_p (numpft)) ; fevpl_p (:) = spval !evaporation+transpiration from leaves [mm/s] + allocate (etr_p (numpft)) ; etr_p (:) = spval !transpiration rate [mm/s] + allocate (fseng_p (numpft)) ; fseng_p (:) = spval !sensible heat flux from ground [W/m2] + allocate (fevpg_p (numpft)) ; fevpg_p (:) = spval !evaporation heat flux from ground [mm/s] + allocate (parsun_p (numpft)) ; parsun_p (:) = spval !solar absorbed by sunlit vegetation [W/m2] + allocate (parsha_p (numpft)) ; parsha_p (:) = spval !solar absorbed by shaded vegetation [W/m2] + allocate (sabvsun_p (numpft)) ; sabvsun_p (:) = spval !solar absorbed by sunlit vegetation [W/m2] + allocate (sabvsha_p (numpft)) ; sabvsha_p (:) = spval !solar absorbed by shaded vegetation [W/m2] + allocate (qintr_p (numpft)) ; qintr_p (:) = spval !interception (mm h2o/s) + allocate (qintr_rain_p (numpft)) ; qintr_rain_p (:) = spval !rainfall interception (mm h2o/s) + allocate (qintr_snow_p (numpft)) ; qintr_snow_p (:) = spval !snowfall interception (mm h2o/s) + allocate (assim_p (numpft)) ; assim_p (:) = spval !canopy assimilation rate (mol m-2 s-1) + allocate (respc_p (numpft)) ; respc_p (:) = spval !canopy respiration (mol m-2 s-1) ENDIF ENDIF @@ -99,22 +99,22 @@ SUBROUTINE deallocate_1D_PFTFluxes IF (p_is_worker) THEN IF (numpft > 0) THEN - deallocate (taux_p ) - deallocate (tauy_p ) - deallocate (fsenl_p ) - deallocate (fevpl_p ) - deallocate (etr_p ) - deallocate (fseng_p ) - deallocate (fevpg_p ) - deallocate (parsun_p ) - deallocate (parsha_p ) - deallocate (sabvsun_p ) - deallocate (sabvsha_p ) - deallocate (qintr_p ) - deallocate (qintr_rain_p) - deallocate (qintr_snow_p) - deallocate (assim_p ) - deallocate (respc_p ) + deallocate (taux_p ) + deallocate (tauy_p ) + deallocate (fsenl_p ) + deallocate (fevpl_p ) + deallocate (etr_p ) + deallocate (fseng_p ) + deallocate (fevpg_p ) + deallocate (parsun_p ) + deallocate (parsha_p ) + deallocate (sabvsun_p ) + deallocate (sabvsha_p ) + deallocate (qintr_p ) + deallocate (qintr_rain_p ) + deallocate (qintr_snow_p ) + deallocate (assim_p ) + deallocate (respc_p ) ENDIF ENDIF diff --git a/main/MOD_Vars_2DForcing.F90 b/main/MOD_Vars_2DForcing.F90 index 5b29f352..3f494d63 100644 --- a/main/MOD_Vars_2DForcing.F90 +++ b/main/MOD_Vars_2DForcing.F90 @@ -78,4 +78,4 @@ SUBROUTINE allocate_2D_Forcing (grid) END SUBROUTINE allocate_2D_Forcing END MODULE MOD_Vars_2DForcing -! ------ EOP -------- +! ---------- EOP ------------ diff --git a/main/MOD_Vars_Global.F90 b/main/MOD_Vars_Global.F90 index b64233d5..8e10bdc2 100644 --- a/main/MOD_Vars_Global.F90 +++ b/main/MOD_Vars_Global.F90 @@ -1,7 +1,7 @@ #include MODULE MOD_Vars_Global -!------------------------------------------------------------------------------- +!----------------------------------------------------------------------- ! ! !DESCRIPTION: ! Define some global variables diff --git a/main/MOD_Vars_TimeInvariants.F90 b/main/MOD_Vars_TimeInvariants.F90 index 9a450e6f..266c1828 100644 --- a/main/MOD_Vars_TimeInvariants.F90 +++ b/main/MOD_Vars_TimeInvariants.F90 @@ -19,12 +19,12 @@ MODULE MOD_Vars_PFTimeInvariants SAVE ! for LULC_IGBP_PFT and LULC_IGBP_PC - integer , allocatable :: pftclass (:) !PFT type - real(r8), allocatable :: pftfrac (:) !PFT fractional cover - real(r8), allocatable :: htop_p (:) !canopy top height [m] - real(r8), allocatable :: hbot_p (:) !canopy bottom height [m] + integer , allocatable :: pftclass (:) !PFT type + real(r8), allocatable :: pftfrac (:) !PFT fractional cover + real(r8), allocatable :: htop_p (:) !canopy top height [m] + real(r8), allocatable :: hbot_p (:) !canopy bottom height [m] #ifdef CROP - real(r8), allocatable :: cropfrac (:) !Crop fractional cover + real(r8), allocatable :: cropfrac (:) !Crop fractional cover #endif ! PUBLIC MEMBER FUNCTIONS: @@ -209,17 +209,17 @@ MODULE MOD_Vars_TimeInvariants real(r8), allocatable :: theta_r (:,:) !residual moisture content [-] real(r8), allocatable :: BVIC (:) !b parameter in Fraction of saturated soil in a grid calculated by VIC #ifdef vanGenuchten_Mualem_SOIL_MODEL - real(r8), allocatable :: alpha_vgm (:,:) ! a parameter corresponding approximately to the inverse of the air-entry value - real(r8), allocatable :: L_vgm (:,:) ! pore-connectivity parameter [dimensionless] - real(r8), allocatable :: n_vgm (:,:) ! a shape parameter [dimensionless] - real(r8), allocatable :: sc_vgm (:,:) ! saturation at the air entry value in the classical vanGenuchten model [-] - real(r8), allocatable :: fc_vgm (:,:) ! a scaling factor by using air entry value in the Mualem model [-] + real(r8), allocatable :: alpha_vgm (:,:) !a parameter corresponding approximately to the inverse of the air-entry value + real(r8), allocatable :: L_vgm (:,:) !pore-connectivity parameter [dimensionless] + real(r8), allocatable :: n_vgm (:,:) !a shape parameter [dimensionless] + real(r8), allocatable :: sc_vgm (:,:) !saturation at the air entry value in the classical vanGenuchten model [-] + real(r8), allocatable :: fc_vgm (:,:) !a scaling factor by using air entry value in the Mualem model [-] #endif - integer, allocatable :: soiltext (:) ! USDA soil texture class + integer, allocatable :: soiltext (:) !USDA soil texture class - real(r8), allocatable :: fsatmax (:) ! maximum saturated area fraction [-] - real(r8), allocatable :: fsatdcf (:) ! decay factor in calculation of saturated area fraction [1/m] + real(r8), allocatable :: fsatmax (:) !maximum saturated area fraction [-] + real(r8), allocatable :: fsatdcf (:) !decay factor in calculation of saturated area fraction [1/m] real(r8), allocatable :: vic_b_infilt (:) real(r8), allocatable :: vic_Dsmax (:) @@ -452,7 +452,7 @@ SUBROUTINE READ_TimeInvariants (lc_year, casename, dir_restart) CALL ncio_read_vector (file_restart, 'psi0 ' , nl_soil, landpatch, psi0 ) ! minimum soil suction [mm] (NOTE: "-" valued) CALL ncio_read_vector (file_restart, 'bsw ' , nl_soil, landpatch, bsw ) ! clapp and hornberger "b" parameter [-] CALL ncio_read_vector (file_restart, 'theta_r ' , nl_soil, landpatch, theta_r ) ! residual moisture content [-] - CALL ncio_read_vector (file_restart, 'BVIC ' , landpatch, BVIC ) ! b parameter in Fraction of saturated soil in a grid calculated by VIC + CALL ncio_read_vector (file_restart, 'BVIC ' , landpatch, BVIC ) ! b parameter in Fraction of saturated soil in a grid calculated by VIC #ifdef vanGenuchten_Mualem_SOIL_MODEL CALL ncio_read_vector (file_restart, 'alpha_vgm' , nl_soil, landpatch, alpha_vgm ) ! a parameter corresponding approximately to the inverse of the air-entry value CALL ncio_read_vector (file_restart, 'L_vgm ' , nl_soil, landpatch, L_vgm ) ! pore-connectivity parameter [dimensionless] @@ -704,22 +704,22 @@ SUBROUTINE WRITE_TimeInvariants (lc_year, casename, dir_restart) CALL ncio_create_file (file_restart) #endif - CALL ncio_write_serial (file_restart, 'zlnd ', zlnd ) ! roughness length for soil [m] - CALL ncio_write_serial (file_restart, 'zsno ', zsno ) ! roughness length for snow [m] - CALL ncio_write_serial (file_restart, 'csoilc', csoilc) ! drag coefficient for soil under canopy [-] - CALL ncio_write_serial (file_restart, 'dewmx ', dewmx ) ! maximum dew - ! CALL ncio_write_serial (file_restart, 'wtfact', wtfact) ! fraction of model area with high water table - CALL ncio_write_serial (file_restart, 'capr ', capr ) ! tuning factor to turn first layer T into surface T - CALL ncio_write_serial (file_restart, 'cnfac ', cnfac ) ! Crank Nicholson factor between 0 and 1 - CALL ncio_write_serial (file_restart, 'ssi ', ssi ) ! irreducible water saturation of snow - CALL ncio_write_serial (file_restart, 'wimp ', wimp ) ! water impermeable if porosity less than wimp - CALL ncio_write_serial (file_restart, 'pondmx', pondmx) ! ponding depth (mm) - CALL ncio_write_serial (file_restart, 'smpmax', smpmax) ! wilting point potential in mm - CALL ncio_write_serial (file_restart, 'smpmin', smpmin) ! restriction for min of soil poten. (mm) + CALL ncio_write_serial (file_restart, 'zlnd ', zlnd ) ! roughness length for soil [m] + CALL ncio_write_serial (file_restart, 'zsno ', zsno ) ! roughness length for snow [m] + CALL ncio_write_serial (file_restart, 'csoilc', csoilc) ! drag coefficient for soil under canopy [-] + CALL ncio_write_serial (file_restart, 'dewmx ', dewmx ) ! maximum dew + ! CALL ncio_write_serial (file_restart, 'wtfact', wtfact) ! fraction of model area with high water table + CALL ncio_write_serial (file_restart, 'capr ', capr ) ! tuning factor to turn first layer T into surface T + CALL ncio_write_serial (file_restart, 'cnfac ', cnfac ) ! Crank Nicholson factor between 0 and 1 + CALL ncio_write_serial (file_restart, 'ssi ', ssi ) ! irreducible water saturation of snow + CALL ncio_write_serial (file_restart, 'wimp ', wimp ) ! water impermeable if porosity less than wimp + CALL ncio_write_serial (file_restart, 'pondmx', pondmx) ! ponding depth (mm) + CALL ncio_write_serial (file_restart, 'smpmax', smpmax) ! wilting point potential in mm + CALL ncio_write_serial (file_restart, 'smpmin', smpmin) ! restriction for min of soil poten. (mm) CALL ncio_write_serial (file_restart, 'smpmax_hr', smpmax_hr) ! wilting point potential in mm CALL ncio_write_serial (file_restart, 'smpmin_hr', smpmin_hr) ! restriction for min of soil poten. (mm) - CALL ncio_write_serial (file_restart, 'trsmx0', trsmx0) ! max transpiration for moist soil+100% veg. [mm/s] - CALL ncio_write_serial (file_restart, 'tcrit ', tcrit ) ! critical temp. to determine rain or snow + CALL ncio_write_serial (file_restart, 'trsmx0', trsmx0) ! max transpiration for moist soil+100% veg. [mm/s] + CALL ncio_write_serial (file_restart, 'tcrit ', tcrit ) ! critical temp. to determine rain or snow CALL ncio_write_serial (file_restart, 'wetwatmax', wetwatmax) ! maximum wetland water (mm) END if @@ -943,22 +943,22 @@ SUBROUTINE check_TimeInvariants () IF (p_is_master) THEN write(*,'(/,A)') 'Checking Constants ...' - write(*,'(A,E20.10)') 'zlnd [m] ', zlnd ! roughness length for soil [m] - write(*,'(A,E20.10)') 'zsno [m] ', zsno ! roughness length for snow [m] - write(*,'(A,E20.10)') 'csoilc [-] ', csoilc ! drag coefficient for soil under canopy [-] - write(*,'(A,E20.10)') 'dewmx [mm] ', dewmx ! maximum dew - ! write(*,'(A,E20.10)') 'wtfact [-] ', wtfact ! fraction of model area with high water table - write(*,'(A,E20.10)') 'capr [-] ', capr ! tuning factor to turn first layer T into surface T - write(*,'(A,E20.10)') 'cnfac [-] ', cnfac ! Crank Nicholson factor between 0 and 1 - write(*,'(A,E20.10)') 'ssi [-] ', ssi ! irreducible water saturation of snow - write(*,'(A,E20.10)') 'wimp [m3/m3]', wimp ! water impermeable IF porosity less than wimp - write(*,'(A,E20.10)') 'pondmx [mm] ', pondmx ! ponding depth (mm) - write(*,'(A,E20.10)') 'smpmax [mm] ', smpmax ! wilting point potential in mm - write(*,'(A,E20.10)') 'smpmin [mm] ', smpmin ! restriction for min of soil poten. (mm) + write(*,'(A,E20.10)') 'zlnd [m] ', zlnd ! roughness length for soil [m] + write(*,'(A,E20.10)') 'zsno [m] ', zsno ! roughness length for snow [m] + write(*,'(A,E20.10)') 'csoilc [-] ', csoilc ! drag coefficient for soil under canopy [-] + write(*,'(A,E20.10)') 'dewmx [mm] ', dewmx ! maximum dew + ! write(*,'(A,E20.10)') 'wtfact [-] ', wtfact ! fraction of model area with high water table + write(*,'(A,E20.10)') 'capr [-] ', capr ! tuning factor to turn first layer T into surface T + write(*,'(A,E20.10)') 'cnfac [-] ', cnfac ! Crank Nicholson factor between 0 and 1 + write(*,'(A,E20.10)') 'ssi [-] ', ssi ! irreducible water saturation of snow + write(*,'(A,E20.10)') 'wimp [m3/m3]', wimp ! water impermeable IF porosity less than wimp + write(*,'(A,E20.10)') 'pondmx [mm] ', pondmx ! ponding depth (mm) + write(*,'(A,E20.10)') 'smpmax [mm] ', smpmax ! wilting point potential in mm + write(*,'(A,E20.10)') 'smpmin [mm] ', smpmin ! restriction for min of soil poten. (mm) write(*,'(A,E20.10)') 'smpmax_hr [mm]', smpmax_hr ! wilting point potential in mm write(*,'(A,E20.10)') 'smpmin_hr [mm]', smpmin_hr ! restriction for min of soil poten. (mm) - write(*,'(A,E20.10)') 'trsmx0 [mm/s] ', trsmx0 ! max transpiration for moist soil+100% veg. [mm/s] - write(*,'(A,E20.10)') 'tcrit [K] ', tcrit ! critical temp. to determine rain or snow + write(*,'(A,E20.10)') 'trsmx0 [mm/s] ', trsmx0 ! max transpiration for moist soil+100% veg. [mm/s] + write(*,'(A,E20.10)') 'tcrit [K] ', tcrit ! critical temp. to determine rain or snow write(*,'(A,E20.10)') 'wetwatmax [mm]', wetwatmax ! maximum wetland water (mm) ENDIF From 5c72a6ea49b03f505528d898047054b1c06294b5 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Thu, 6 Feb 2025 16:15:39 +0800 Subject: [PATCH 25/43] Code tidy for urban model. --- main/URBAN/CoLMMAIN_Urban.F90 | 18 +++++++------ main/URBAN/MOD_Urban_Albedo.F90 | 2 +- main/URBAN/MOD_Urban_BEM.F90 | 25 +++++++++-------- main/URBAN/MOD_Urban_Flux.F90 | 27 ++++++++++--------- main/URBAN/MOD_Urban_GroundFlux.F90 | 7 ++--- main/URBAN/MOD_Urban_Hydrology.F90 | 10 ++++--- .../URBAN/MOD_Urban_ImperviousTemperature.F90 | 5 +++- main/URBAN/MOD_Urban_LUCY.F90 | 8 +++--- main/URBAN/MOD_Urban_Longwave.F90 | 12 +++++---- main/URBAN/MOD_Urban_NetSolar.F90 | 6 +++-- main/URBAN/MOD_Urban_PerviousTemperature.F90 | 3 ++- main/URBAN/MOD_Urban_RoofFlux.F90 | 12 ++++----- main/URBAN/MOD_Urban_RoofTemperature.F90 | 7 ++--- main/URBAN/MOD_Urban_Shortwave.F90 | 19 +++++++++---- main/URBAN/MOD_Urban_Thermal.F90 | 4 +-- main/URBAN/MOD_Urban_WallTemperature.F90 | 5 ++-- 16 files changed, 100 insertions(+), 70 deletions(-) diff --git a/main/URBAN/CoLMMAIN_Urban.F90 b/main/URBAN/CoLMMAIN_Urban.F90 index facd6763..e8a01b91 100644 --- a/main/URBAN/CoLMMAIN_Urban.F90 +++ b/main/URBAN/CoLMMAIN_Urban.F90 @@ -31,9 +31,9 @@ ! ! The CoLM urban model utilizes comprehensive high-resolution data on ! urban cover, geometric structure, vegetation, water bodies, etc. -! Furthermore, it has developed a complete simulation of anthropogenic -! heat processes, including building energy consumption, traffic heat, -! and metabolic heat. +! Furthermore, it has developed a relatively complete simulation of +! anthropogenic heat processes, including building energy consumption, +! traffic heat, and metabolic heat. ! ! Created by Hua Yuan, 09/2021 ! @@ -200,7 +200,7 @@ SUBROUTINE CoLMMAIN_Urban ( & IMPLICIT NONE -! ------------------------ Dummy Argument ------------------------------ +!------------------------- Dummy Arguments ----------------------------- integer, intent(in) :: & ipatch ,&! maximum number of snow layers idate(3) ,&! next time-step /year/julian day/second in a day/ @@ -259,7 +259,7 @@ SUBROUTINE CoLMMAIN_Urban ( & bsw (nl_soil) ,&! clapp and hornberger "b" parameter [-] theta_r (nl_soil) ,&! residual water content (cm3/cm3) fsatmax ,&! maximum saturated area fraction [-] - fsatdcf ,&! decay factor in calucation of saturated area fraction [1/m] + fsatdcf ,&! decay factor in calculation of saturated area fraction [1/m] #ifdef vanGenuchten_Mualem_SOIL_MODEL alpha_vgm (1:nl_soil) ,&! the parameter corresponding approximately to the inverse of the air-entry value @@ -435,7 +435,7 @@ SUBROUTINE CoLMMAIN_Urban ( & mss_dst2 ( maxsnl+1:0 ) ,&! mass of dust species 2 in snow (col,lyr) [kg] mss_dst3 ( maxsnl+1:0 ) ,&! mass of dust species 3 in snow (col,lyr) [kg] mss_dst4 ( maxsnl+1:0 ) ,&! mass of dust species 4 in snow (col,lyr) [kg] - ssno (2,2,maxsnl+1:1) ,&! snow layer absorption [-] + ssno (2,2,maxsnl+1:1 ) ,&! snow layer absorption [-] fveg ,&! fraction of vegetation cover fsno ,&! fractional snow cover @@ -574,7 +574,7 @@ SUBROUTINE CoLMMAIN_Urban ( & fh ,&! integral of profile function for heat fq ! integral of profile function for moisture -! ----------------------- Local Variables ----------------------------- +!-------------------------- Local Variables ---------------------------- real(r8) :: & calday ,&! Julian cal day (1.xx to 365.xx) endwb ,&! water mass at the end of time step @@ -699,6 +699,8 @@ SUBROUTINE CoLMMAIN_Urban ( & ! a factor represents irrigation efficiency, '1' represents a 50% direct irrigation efficiency. real(r8), parameter :: wst_irrig = 1.0 +!----------------------------------------------------------------------- + theta = acos(max(coszen,0.01)) forc_aer(:) = 0. !aerosol deposition from atmosphere model (grd,aer) [kg m-1 s-1] @@ -1080,7 +1082,7 @@ SUBROUTINE CoLMMAIN_Urban ( & ! SNICAR model variables forc_aer ,& mss_bcpho(lbsn:0) ,mss_bcphi(lbsn:0) ,mss_ocpho(lbsn:0) ,mss_ocphi(lbsn:0) ,& - mss_dst1(lbsn:0) ,mss_dst2(lbsn:0) ,mss_dst3(lbsn:0) ,mss_dst4(lbsn:0) ,& + mss_dst1 (lbsn:0) ,mss_dst2 (lbsn:0) ,mss_dst3 (lbsn:0) ,mss_dst4 (lbsn:0) ,& ! END SNICAR model variables ! output diff --git a/main/URBAN/MOD_Urban_Albedo.F90 b/main/URBAN/MOD_Urban_Albedo.F90 index cc041dbc..d6beaede 100644 --- a/main/URBAN/MOD_Urban_Albedo.F90 +++ b/main/URBAN/MOD_Urban_Albedo.F90 @@ -125,7 +125,7 @@ SUBROUTINE alburban (ipatch,froof,fgper,flake,hlr,hroof,& sgper(2,2), &! pervious ground absorption for solar radiation, slake(2,2) ! lake absorption for solar radiation, -!-------------------------- Local variables ---------------------------- +!-------------------------- Local Variables ---------------------------- real(r8) :: & age, &! factor to reduce visible snow alb due to snow age [-] albg0, &! temporary varaiable [-] diff --git a/main/URBAN/MOD_Urban_BEM.F90 b/main/URBAN/MOD_Urban_BEM.F90 index 734645d8..9da791ec 100644 --- a/main/URBAN/MOD_Urban_BEM.F90 +++ b/main/URBAN/MOD_Urban_BEM.F90 @@ -16,15 +16,15 @@ MODULE MOD_Urban_BEM CONTAINS -!----------------------------------------------------------------------------------- - SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & - troof_nl_bef, twsun_nl_bef, twsha_nl_bef, & - troof_nl, twsun_nl, twsha_nl, & - tkdz_roof, tkdz_wsun, tkdz_wsha, taf, & - troom, troof_inner, twsun_inner, twsha_inner, & - Fhac, Fwst, Fach, Fhah) - -!----------------------------------------------------------------------------------- +!----------------------------------------------------------------------- + SUBROUTINE SimpleBEM (deltim, rhoair, fcover, H, troom_max, troom_min, & + troof_nl_bef, twsun_nl_bef, twsha_nl_bef, & + troof_nl, twsun_nl, twsha_nl, & + tkdz_roof, tkdz_wsun, tkdz_wsha, taf, & + troom, troof_inner, twsun_inner, twsha_inner, & + Fhac, Fwst, Fach, Fhah) + +!----------------------------------------------------------------------- ! ! !DESCRIPTION: ! @@ -71,10 +71,11 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & ! ! 11/2022, Hua Yuan: Add option for constant AC. ! -!----------------------------------------------------------------------------------- +!----------------------------------------------------------------------- IMPLICIT NONE +!------------------------- Dummy Arguments ----------------------------- real(r8), intent(in) :: & deltim, &! seconds in a time step [second] rhoair, &! density air [kg/m3] @@ -105,7 +106,7 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & Fwst, &! waste heat from cool or heat Fach ! flux from air exchange - ! local variables +!-------------------------- Local Variables ---------------------------- real(r8) :: & ACH, &! air exchange coefficient hcv_roof, &! convective exchange coefficient for roof<->room @@ -136,6 +137,8 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & ! Option for continuous AC logical, parameter :: Constant_AC = .true. +!----------------------------------------------------------------------- + ACH = 0.3 !air exchange coefficient hcv_roof = 4.040 !convective exchange coefficient for roof<->room (W m-2 K-1) hcv_wall = 3.076 !convective exchange coefficient for wall<->room (W m-2 K-1) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 0166087d..00cb2b60 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -55,23 +55,24 @@ MODULE MOD_Urban_Flux PUBLIC :: UrbanVegFlux PUBLIC :: dewfraction -! Exponential extinction factor (alpha) options: -! 1. Masson, 2000; Oleson et al., 2008 -! 2. Swaid, 1993; Kusaka, 2001; Lee and Park, 2008 -! 3. Macdonald, 2000 + ! Exponential extinction factor (alpha) options: + ! 1. Masson, 2000; Oleson et al., 2008 + ! 2. Swaid, 1993; Kusaka, 2001; Lee and Park, 2008 + ! 3. Macdonald, 2000 integer, parameter :: alpha_opt = 3 -! Layer number setting, default is false, i.e., 2 layers + ! Layer number setting, default is false, i.e., 2 layers logical, parameter :: run_three_layer = .false. -! Percent of sensible/latent to AHE (only for Fhac, Fwst, vehc now), -! 92% heat release as SH, 8% heat release as LH, Pigeon et al., 2007 + ! Percent of sensible/latent to AHE (only for Fhac, Fwst, vehc now), + ! 92% heat release as SH, 8% heat release as LH, Pigeon et al., 2007 real(r8), parameter :: fsh = 0.92 real(r8), parameter :: flh = 0.08 -! A simple urban irrigation scheme accounts for soil water stress of trees + ! A simple urban irrigation scheme accounts for soil water stress of trees logical, parameter :: DEF_URBAN_Irrigation = .true. real(r8), parameter :: rstfac_irrig = 1. + !----------------------------------------------------------------------- CONTAINS @@ -114,7 +115,7 @@ SUBROUTINE UrbanOnlyFlux ( & USE MOD_UserSpecifiedForcing, only: HEIGHT_mode IMPLICIT NONE -!----------------------- Dummy argument -------------------------------- +!------------------------- Dummy Arguments ----------------------------- integer, intent(in) :: & ipatch, &! patch index [-] lbr, &! lower bound of array @@ -221,7 +222,7 @@ SUBROUTINE UrbanOnlyFlux ( & fq, &! integral of profile function for moisture tafu ! effective urban air temperature (2nd layer, walls) -!------------------------ LOCAL VARIABLES ------------------------------ +!-------------------------- Local Variables ---------------------------- integer :: & niters, &! maximum number of iterations for surface temperature iter, &! iteration index @@ -347,7 +348,7 @@ SUBROUTINE UrbanOnlyFlux ( & real(r8) fwet_roof, fwet_roof_, fwet_gimp, fwet_gimp_, rss_ real(r8) fwetfac -!-----------------------End Variable List------------------------------- +!----------------------------------------------------------------------- ! initialization tu(0) = troof; tu(1) = twsun; tu(2) = twsha @@ -912,7 +913,7 @@ SUBROUTINE UrbanVegFlux ( & USE MOD_UserSpecifiedForcing, only: HEIGHT_mode IMPLICIT NONE -!-----------------------Arguments--------------------------------------- +!------------------------- Dummy Arguments ----------------------------- integer, intent(in) :: & ipatch, &! patch index [-] lbr, &! lower bound of array @@ -1275,7 +1276,7 @@ SUBROUTINE UrbanVegFlux ( & ! for interface real(r8) o3coefv, o3coefg, assim_RuBP, assim_Rubisco, ci, vpd, gammas -!-----------------------End Variable List------------------------------- +!----------------------------------------------------------------------- ! initialization of errors and iteration parameters it = 1 !counter for leaf temperature iteration diff --git a/main/URBAN/MOD_Urban_GroundFlux.F90 b/main/URBAN/MOD_Urban_GroundFlux.F90 index 50dd0876..b88d28b3 100644 --- a/main/URBAN/MOD_Urban_GroundFlux.F90 +++ b/main/URBAN/MOD_Urban_GroundFlux.F90 @@ -34,7 +34,7 @@ SUBROUTINE UrbanGroundFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & USE MOD_FrictionVelocity IMPLICIT NONE -!----------------------- Dummy argument -------------------------------- +!------------------------- Dummy Arguments ----------------------------- integer , intent(in) :: & lbi real(r8), intent(in) :: & @@ -82,7 +82,7 @@ SUBROUTINE UrbanGroundFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & fh, &! integral of profile function for heat fq ! integral of profile function for moisture -!------------------------ LOCAL VARIABLES ------------------------------ +!-------------------------- Local Variables ---------------------------- integer niters, &! maximum number of iterations for surface temperature iter, &! iteration index nmozsgn ! number of times moz changes sign @@ -115,7 +115,8 @@ SUBROUTINE UrbanGroundFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & real(r8) fwet_gimp, fwetfac -!----------------------- Dummy argument -------------------------------- +!----------------------------------------------------------------------- + ! initial roughness length !NOTE: change to original !z0mg = (1.-fsno)*zlnd + fsno*zsno diff --git a/main/URBAN/MOD_Urban_Hydrology.F90 b/main/URBAN/MOD_Urban_Hydrology.F90 index f3d8110b..a2788efc 100644 --- a/main/URBAN/MOD_Urban_Hydrology.F90 +++ b/main/URBAN/MOD_Urban_Hydrology.F90 @@ -91,7 +91,7 @@ SUBROUTINE UrbanHydrology ( & IMPLICIT NONE -!-----------------------Argument---------------------------------------- +!------------------------- Dummy Arguments ----------------------------- integer, intent(in) :: & ipatch ,&! patch index patchtype ,&! land patch type (0=soil, 1=urban or built-up, 2=wetland, @@ -227,9 +227,9 @@ SUBROUTINE UrbanHydrology ( & real(r8), intent(out) :: & smp(1:nl_soil) ,&! soil matrix potential [mm] hk (1:nl_soil) ! hydraulic conductivity [mm h2o/m] -! -!-----------------------Local Variables------------------------------ -! + +!-------------------------- Local Variables ---------------------------- + real(r8) :: & fg ,&! ground fractional cover [-] gwat ,&! net water input from top (mm/s) @@ -246,6 +246,8 @@ SUBROUTINE UrbanHydrology ( & real(r8) :: a, aa, xs1 +!----------------------------------------------------------------------- + fg = 1 - froof dfseng = 0. dfgrnd = 0. diff --git a/main/URBAN/MOD_Urban_ImperviousTemperature.F90 b/main/URBAN/MOD_Urban_ImperviousTemperature.F90 index c83b0f2b..6a29b556 100644 --- a/main/URBAN/MOD_Urban_ImperviousTemperature.F90 +++ b/main/URBAN/MOD_Urban_ImperviousTemperature.F90 @@ -69,6 +69,7 @@ SUBROUTINE UrbanImperviousTem (patchtype,lb,deltim, & IMPLICIT NONE +!------------------------- Dummy Arguments ----------------------------- integer, intent(in) :: lb !lower bound of array integer, intent(in) :: patchtype !land patch type (0=soil,1=urban or built-up,2=wetland, !3=land ice, 4=deep lake, 5=shallow lake) @@ -121,7 +122,7 @@ SUBROUTINE UrbanImperviousTem (patchtype,lb,deltim, & real(r8), intent(out) :: fact (lb:nl_soil) !used in computing tridiagonal matrix integer, intent(out) :: imelt(lb:nl_soil) !flag for melting or freezing [-] -!------------------------ local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- real(r8) cv (lb:nl_soil) !heat capacity [J/(m2 K)] real(r8) tk (lb:nl_soil) !thermal conductivity [W/(m K)] @@ -149,6 +150,8 @@ SUBROUTINE UrbanImperviousTem (patchtype,lb,deltim, & integer i,j +!----------------------------------------------------------------------- + wice_gimpsno(2:) = 0.0 !ice lens [kg/m2] wliq_gimpsno(2:) = 0.0 !liquid water [kg/m2] diff --git a/main/URBAN/MOD_Urban_LUCY.F90 b/main/URBAN/MOD_Urban_LUCY.F90 index f44902a0..27f865b3 100644 --- a/main/URBAN/MOD_Urban_LUCY.F90 +++ b/main/URBAN/MOD_Urban_LUCY.F90 @@ -18,7 +18,7 @@ MODULE MOD_Urban_LUCY USE MOD_TimeManager IMPLICIT NONE SAVE - PUBLIC :: LUCY + PUBLIC :: LUCY CONTAINS @@ -44,6 +44,7 @@ SUBROUTINE LUCY( idate , deltim , patchlonr, fix_holiday, & ! ----------------------------------------------------------------------- IMPLICIT NONE +!------------------------- Dummy Arguments ----------------------------- integer , intent(in) :: & idate(3) ! calendar (year, julian day, seconds) @@ -80,8 +81,7 @@ SUBROUTINE LUCY( idate , deltim , patchlonr, fix_holiday, & motflx ,&! flux from motorbike [W/m2] freflx ! flux from freight [W/m2] - - ! local vars +!-------------------------- Local Variables ---------------------------- real(r8):: ldate(3) ! local time (year, julian day, seconds) integer :: & iweek ,&! day of week @@ -93,6 +93,8 @@ SUBROUTINE LUCY( idate , deltim , patchlonr, fix_holiday, & EF ,&! emission factor of freight [J/m] EM ! emission factor of motorbike [J/m] +!----------------------------------------------------------------------- + ! initialization meta = 0. vehc = 0. diff --git a/main/URBAN/MOD_Urban_Longwave.F90 b/main/URBAN/MOD_Urban_Longwave.F90 index 87cd70fb..d86e0523 100644 --- a/main/URBAN/MOD_Urban_Longwave.F90 +++ b/main/URBAN/MOD_Urban_Longwave.F90 @@ -61,6 +61,7 @@ SUBROUTINE UrbanOnlyLongwave (theta, HL, fb, fgper, H, LW, & IMPLICIT NONE +!------------------------- Dummy Arguments ----------------------------- real(r8), intent(in) :: & theta, &! Sun zenith angle [radian] HL, &! Ratio of building height to ground width [-] @@ -86,8 +87,7 @@ SUBROUTINE UrbanOnlyLongwave (theta, HL, fb, fgper, H, LW, & SkyVF(4), &! View factor to sky fcover(0:4) ! View factor to sky - ! Local variables - !------------------------------------------------- +!-------------------------- Local Variables ---------------------------- real(r8) :: & W, &! Urban ground average width [m] L, &! Urban building average length [m] @@ -116,6 +116,7 @@ SUBROUTINE UrbanOnlyLongwave (theta, HL, fb, fgper, H, LW, & ! Temporal real(r8) :: tmp, eb +!----------------------------------------------------------------------- ! Calculate urban structure parameters !------------------------------------------------- @@ -277,6 +278,7 @@ SUBROUTINE UrbanVegLongwave (theta, HL, fb, fgper, H, LW, & IMPLICIT NONE +!------------------------- Dummy Arguments ----------------------------- real(r8), intent(in) :: & theta, &! Sun zenith angle [radian] HL, &! Ratio of building height to ground width [-] @@ -308,9 +310,8 @@ SUBROUTINE UrbanVegLongwave (theta, HL, fb, fgper, H, LW, & VegVF(5), &! View factor to sky fcover(0:5) ! View factor to sky - ! Local variables - !------------------------------------------------- - real(r16),parameter:: DD1=1.0_r16 !quad accuracy real number +!-------------------------- Local Variables ---------------------------- + real(r16),parameter :: DD1=1.0_r16 !quad accuracy real number real(r8) :: & W, &! Urban ground average width [m] @@ -371,6 +372,7 @@ SUBROUTINE UrbanVegLongwave (theta, HL, fb, fgper, H, LW, & ! Temporal real(r8) :: tmp, eb, fac1, fac2, lsai +!----------------------------------------------------------------------- ! Calculate urban structure parameters !------------------------------------------------- diff --git a/main/URBAN/MOD_Urban_NetSolar.F90 b/main/URBAN/MOD_Urban_NetSolar.F90 index 05a3b088..06d634ca 100644 --- a/main/URBAN/MOD_Urban_NetSolar.F90 +++ b/main/URBAN/MOD_Urban_NetSolar.F90 @@ -32,7 +32,7 @@ SUBROUTINE netsolar_urban (ipatch,idate,dlon,deltim,& USE MOD_TimeManager, only: isgreenwich IMPLICIT NONE -! Dummy argument +!------------------------- Dummy Arguments ----------------------------- integer, intent(in) :: ipatch ! patch index integer, intent(in) :: idate(3) ! model time @@ -90,10 +90,12 @@ SUBROUTINE netsolar_urban (ipatch,idate,dlon,deltim,& srndln, &! reflected direct beam nir solar radiation at local noon(W/m2) srniln ! reflected diffuse beam nir solar radiation at local noon(W/m2) -! ----------------local variables --------------------------------- +!-------------------------- Local Variables ---------------------------- integer :: local_secs real(r8) :: radpsec +!----------------------------------------------------------------------- + sabroof = 0. sabwsun = 0. sabwsha = 0. diff --git a/main/URBAN/MOD_Urban_PerviousTemperature.F90 b/main/URBAN/MOD_Urban_PerviousTemperature.F90 index 1010ba6f..b2d3846b 100644 --- a/main/URBAN/MOD_Urban_PerviousTemperature.F90 +++ b/main/URBAN/MOD_Urban_PerviousTemperature.F90 @@ -75,6 +75,7 @@ SUBROUTINE UrbanPerviousTem (patchtype,lb,deltim, & IMPLICIT NONE +!------------------------- Dummy Arguments ----------------------------- integer, intent(in) :: lb !lower bound of array integer, intent(in) :: patchtype !land patch type (0=soil,1=urban or built-up,2=wetland, !3=land ice, 4=deep lake, 5=shallow lake) @@ -136,7 +137,7 @@ SUBROUTINE UrbanPerviousTem (patchtype,lb,deltim, & real(r8), intent(out) :: fact (lb:nl_soil) !used in computing tridiagonal matrix integer, intent(out) :: imelt(lb:nl_soil) !flag for melting or freezing [-] -!------------------------ local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- real(r8) cv(lb:nl_soil) !heat capacity [J/(m2 K)] real(r8) tk(lb:nl_soil) !thermal conductivity [W/(m K)] diff --git a/main/URBAN/MOD_Urban_RoofFlux.F90 b/main/URBAN/MOD_Urban_RoofFlux.F90 index d2983df0..27033248 100644 --- a/main/URBAN/MOD_Urban_RoofFlux.F90 +++ b/main/URBAN/MOD_Urban_RoofFlux.F90 @@ -83,7 +83,7 @@ SUBROUTINE UrbanRoofFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & fh, &! integral of profile function for heat fq ! integral of profile function for moisture -!------------------------ LOCAL VARIABLES ------------------------------ +!-------------------------- Local Variables ---------------------------- integer niters,&! maximum number of iterations for surface temperature iter, &! iteration index nmozsgn ! number of times moz changes sign @@ -120,7 +120,7 @@ SUBROUTINE UrbanRoofFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & real(r8) fwet_roof -!----------------------- Dummy argument -------------------------------- +!----------------------------------------------------------------------- ! initial roughness length !TODO: change to original !z0mg = (1.-fsno)*zlnd + fsno*zsno @@ -225,10 +225,10 @@ SUBROUTINE UrbanRoofFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & ! surface fluxes of momentum, sensible and latent ! using ground temperatures from previous time step - !taux = -rhoair*us/ram - !tauy = -rhoair*vs/ram - fsenroof = -raih*dth - fevproof = -raiw*dqh*fwet_roof + !taux = -rhoair*us/ram + !tauy = -rhoair*vs/ram + fsenroof = -raih*dth + fevproof = -raiw*dqh*fwet_roof END SUBROUTINE UrbanRoofFlux diff --git a/main/URBAN/MOD_Urban_RoofTemperature.F90 b/main/URBAN/MOD_Urban_RoofTemperature.F90 index 74ed9d82..0fc5bdea 100644 --- a/main/URBAN/MOD_Urban_RoofTemperature.F90 +++ b/main/URBAN/MOD_Urban_RoofTemperature.F90 @@ -67,6 +67,7 @@ SUBROUTINE UrbanRoofTem (lb,deltim,capr,cnfac,& IMPLICIT NONE +!------------------------- Dummy Arguments ----------------------------- integer , intent(in) :: lb !lower bound of array real(r8), intent(in) :: deltim !seconds in a time step [second] real(r8), intent(in) :: capr !tuning factor to turn first layer T into surface T @@ -100,7 +101,7 @@ SUBROUTINE UrbanRoofTem (lb,deltim,capr,cnfac,& real(r8), intent(out) :: tkdz_roof !heat diffusion with inner room space integer , intent(out) :: imelt_roof(lb:nl_roof) !flag for melting or freezing [-] -!------------------------ local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- real(r8) cv (lb:nl_roof) !heat capacity [J/(m2 K)] real(r8) thk(lb:nl_roof) !thermal conductivity of layer real(r8) tk (lb:nl_roof) !thermal conductivity [W/(m K)] @@ -123,7 +124,7 @@ SUBROUTINE UrbanRoofTem (lb,deltim,capr,cnfac,& integer i,j -!======================================================================= +!----------------------------------------------------------------------- wice_roofsno(2:) = 0.0 !ice lens [kg/m2] wliq_roofsno(2:) = 0.0 !liquid water [kg/m2] @@ -155,7 +156,7 @@ SUBROUTINE UrbanRoofTem (lb,deltim,capr,cnfac,& ENDDO ENDIF - ! thermal conductivity at the layer interface +! thermal conductivity at the layer interface thk(1:) = tk_roof(1:) IF (lb <= 0) THEN DO j = lb, 0 diff --git a/main/URBAN/MOD_Urban_Shortwave.F90 b/main/URBAN/MOD_Urban_Shortwave.F90 index 48f16393..8accc23e 100644 --- a/main/URBAN/MOD_Urban_Shortwave.F90 +++ b/main/URBAN/MOD_Urban_Shortwave.F90 @@ -54,10 +54,14 @@ SUBROUTINE UrbanOnlyShortwave ( theta, HL, fb, fgper, H, & ! ! ! Created by Hua Yuan, 09/2021 +! +! !REVISIONS: +! !----------------------------------------------------------------------- IMPLICIT NONE +!------------------------- Dummy Arguments ----------------------------- real(r8), intent(in) :: & theta, &! Sun zenith angle [radian] HL, &! Ratio of building height to their side length [-] @@ -80,8 +84,7 @@ SUBROUTINE UrbanOnlyShortwave ( theta, HL, fb, fgper, H, & sgper(2), &! Urban pervious ground absorption [-] albu(2) ! Urban overall albedo [-] - ! Local variables - !------------------------------------------------- +!-------------------------- Local Variables ---------------------------- real(r8) :: & W, &! Urban ground average width [m] L, &! Urban building average length [m] @@ -113,6 +116,8 @@ SUBROUTINE UrbanOnlyShortwave ( theta, HL, fb, fgper, H, & ! Temporal real(r8) :: fac1, fac2, eb +!----------------------------------------------------------------------- + ! Calculate urban structure parameters !------------------------------------------------- !W = H/HW @@ -289,10 +294,14 @@ SUBROUTINE UrbanVegShortwave ( theta, HL, fb, fgper, H, & ! calculation including the vegetation. ! ! Created by Hua Yuan, 09/2021 +! +! !REVISIONS: +! !----------------------------------------------------------------------- IMPLICIT NONE +!------------------------- Dummy Arguments ----------------------------- real(r8), intent(in) :: & theta, &! Sun zenith angle [radian] HL, &! Ratio of building height to their side length [-] @@ -324,9 +333,8 @@ SUBROUTINE UrbanVegShortwave ( theta, HL, fb, fgper, H, & sveg(2), &! Urban building tree absorption [-] albu(2) ! Urban overall albedo [-] - ! Local variables - !------------------------------------------------- - real(r16),parameter:: DD1=1.0_r16 !quad accuracy real number +!-------------------------- Local Variables ---------------------------- + real(r16),parameter :: DD1=1.0_r16 !quad accuracy real number real(r8) :: & W, &! Urban ground average width @@ -395,6 +403,7 @@ SUBROUTINE UrbanVegShortwave ( theta, HL, fb, fgper, H, & real(r8) :: phi_dif !Temporal real(r8) :: pa2 !Temporal real(r8) :: lsai !lai+sai +!----------------------------------------------------------------------- ! Calculate urban structure parameters !------------------------------------------------- diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 5803d698..d59b57b6 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -130,7 +130,7 @@ SUBROUTINE UrbanTHERMAL ( & IMPLICIT NONE -!---------------------Argument------------------------------------------ +!------------------------- Dummy Arguments ----------------------------- integer, intent(in) :: & idate(3) ,& ipatch ,&! patch index @@ -430,7 +430,7 @@ SUBROUTINE UrbanTHERMAL ( & real(r8), intent(out) :: snofrz (lbp:0) !snow freezing rate (col,lyr) [kg m-2 s-1] ! END SNICAR model variables -!---------------------Local Variables----------------------------------- +!-------------------------- Local Variables ---------------------------- integer :: nurb ! number of aboveground urban components [-] diff --git a/main/URBAN/MOD_Urban_WallTemperature.F90 b/main/URBAN/MOD_Urban_WallTemperature.F90 index 24b6f1d0..125b4075 100644 --- a/main/URBAN/MOD_Urban_WallTemperature.F90 +++ b/main/URBAN/MOD_Urban_WallTemperature.F90 @@ -68,6 +68,7 @@ SUBROUTINE UrbanWallTem (deltim,capr,cnfac,& IMPLICIT NONE +!------------------------- Dummy Arguments ----------------------------- real(r8), intent(in) :: deltim !seconds in a time step [second] real(r8), intent(in) :: capr !tuning factor to turn first layer T into surface T real(r8), intent(in) :: cnfac !Crank Nicholson factor between 0 and 1 @@ -89,7 +90,7 @@ SUBROUTINE UrbanWallTem (deltim,capr,cnfac,& real(r8), intent(inout) :: t_wall(1:nl_wall) !wall layers' temperature [K] real(r8), intent(inout) :: tkdz_wall !inner wall heat flux [w/m2/k] -!------------------------ local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- real(r8) wice_wall(1:nl_wall) !ice lens [kg/m2] real(r8) wliq_wall(1:nl_wall) !liquid water [kg/m2] @@ -114,7 +115,7 @@ SUBROUTINE UrbanWallTem (deltim,capr,cnfac,& integer i,j -!======================================================================= +!----------------------------------------------------------------------- wice_wall(1:) = 0.0 !ice lens [kg/m2] wliq_wall(1:) = 0.0 !liquid water [kg/m2] From 2daeea8dbe5b9ca8cdeadcce9fca4921c758f7f6 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Thu, 6 Feb 2025 16:27:43 +0800 Subject: [PATCH 26/43] Code tidy for LULCC. --- main/LULCC/MOD_Lulcc_Driver.F90 | 1 + main/LULCC/MOD_Lulcc_Initialize.F90 | 7 ++++--- main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 | 3 ++- main/LULCC/MOD_Lulcc_TransferTrace.F90 | 4 ++-- 4 files changed, 9 insertions(+), 6 deletions(-) diff --git a/main/LULCC/MOD_Lulcc_Driver.F90 b/main/LULCC/MOD_Lulcc_Driver.F90 index c7aeda24..7c9eabff 100644 --- a/main/LULCC/MOD_Lulcc_Driver.F90 +++ b/main/LULCC/MOD_Lulcc_Driver.F90 @@ -96,6 +96,7 @@ SUBROUTINE LulccDriver (casename,dir_landdata,dir_restart,& logical, intent(in) :: greenwich !true: greenwich time, false: local time integer, intent(inout) :: idate(3) !year, julian day, seconds of the starting time +!----------------------------------------------------------------------- ! allocate Lulcc memory CALL allocate_LulccTimeInvariants diff --git a/main/LULCC/MOD_Lulcc_Initialize.F90 b/main/LULCC/MOD_Lulcc_Initialize.F90 index d58f4049..12887933 100644 --- a/main/LULCC/MOD_Lulcc_Initialize.F90 +++ b/main/LULCC/MOD_Lulcc_Initialize.F90 @@ -52,7 +52,7 @@ SUBROUTINE LulccInitialize (casename,dir_landdata,dir_restart,& IMPLICIT NONE - ! ---------------------------------------------------------------------- +!------------------------- Dummy Arguments ----------------------------- character(len=*), intent(in) :: casename ! case name character(len=*), intent(in) :: dir_landdata character(len=*), intent(in) :: dir_restart @@ -60,9 +60,10 @@ SUBROUTINE LulccInitialize (casename,dir_landdata,dir_restart,& integer, intent(inout) :: idate(3) ! year, julian day, seconds of the starting time logical, intent(in) :: greenwich ! true: greenwich time, false: local time - ! local vars +!-------------------------- Local Variables ---------------------------- integer :: year, jday - ! ---------------------------------------------------------------------- + +!----------------------------------------------------------------------- ! initial time of model run ! ............................ diff --git a/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 b/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 index d33859e9..562c355e 100644 --- a/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 +++ b/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 @@ -41,7 +41,6 @@ SUBROUTINE LulccMassEnergyConserve ! !----------------------------------------------------------------------- - USE MOD_Precision USE MOD_Vars_Global USE MOD_LandPatch @@ -71,6 +70,7 @@ SUBROUTINE LulccMassEnergyConserve IMPLICIT NONE +!-------------------------- Local Variables ---------------------------- integer, allocatable, dimension(:) :: grid_patch_s , grid_patch_e integer, allocatable, dimension(:) :: grid_patch_s_, grid_patch_e_ integer, allocatable, dimension(:) :: locpxl @@ -104,6 +104,7 @@ SUBROUTINE LulccMassEnergyConserve real(r8), parameter :: m = 1.0 !the value of m used in CLM4.5 is 1.0. ! real(r8) :: deltim = 1800. !time step (seconds) TODO: be intent in logical :: FROM_SOIL +!----------------------------------------------------------------------- IF (p_is_worker) THEN diff --git a/main/LULCC/MOD_Lulcc_TransferTrace.F90 b/main/LULCC/MOD_Lulcc_TransferTrace.F90 index 4cc543b7..ac564133 100644 --- a/main/LULCC/MOD_Lulcc_TransferTrace.F90 +++ b/main/LULCC/MOD_Lulcc_TransferTrace.F90 @@ -87,8 +87,7 @@ SUBROUTINE MAKE_LulccTransferTrace (lc_year) integer, intent(in) :: lc_year - ! local variables: - ! --------------------------------------------------------------- +!-------------------------- Local Variables ---------------------------- character(len=256) :: dir_5x5, suffix, lastyr, thisyr, dir_landdata, lndname integer :: i,ipatch,ipxl,ipxstt,ipxend,numpxl,ilc integer, allocatable, dimension(:) :: locpxl @@ -101,6 +100,7 @@ SUBROUTINE MAKE_LulccTransferTrace (lc_year) #ifdef SrfdataDiag integer :: ityp integer, allocatable, dimension(:) :: typindex +!----------------------------------------------------------------------- allocate( typindex(N_land_classification+1) ) #endif From 40604ecb60dc124d011a6873985a78b5bb6d4431 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Thu, 6 Feb 2025 17:27:18 +0800 Subject: [PATCH 27/43] Code format tidy for main/*.F90. --- main/CoLM.F90 | 1 + main/CoLMMAIN.F90 | 7 +- main/LULCC/MOD_Lulcc_Initialize.F90 | 2 +- main/MOD_3DCanopyRadiation.F90 | 25 ++++--- main/MOD_Albedo.F90 | 73 ++++++++++--------- main/MOD_AssimStomataConductance.F90 | 23 ++++-- main/MOD_Eroot.F90 | 6 +- main/MOD_FrictionVelocity.F90 | 24 +++--- main/MOD_Glacier.F90 | 38 +++++----- main/MOD_GroundFluxes.F90 | 6 +- main/MOD_GroundTemperature.F90 | 13 ++-- main/MOD_LAIEmpirical.F90 | 7 +- main/MOD_Lake.F90 | 40 +++++----- main/MOD_LeafInterception.F90 | 2 + main/MOD_LeafTemperature.F90 | 6 +- main/MOD_LeafTemperaturePC.F90 | 8 +- main/MOD_NetSolar.F90 | 11 ++- main/MOD_NewSnow.F90 | 6 +- main/MOD_OrbCosazi.F90 | 7 +- main/MOD_OrbCoszen.F90 | 6 +- main/MOD_Ozone.F90 | 1 + main/MOD_PhaseChange.F90 | 13 ++-- main/MOD_PlantHydraulic.F90 | 9 +-- main/MOD_Qsadv.F90 | 7 +- main/MOD_RainSnowTemp.F90 | 4 +- main/MOD_Runoff.F90 | 13 ++-- main/MOD_SimpleOcean.F90 | 13 ++-- main/MOD_SnowFraction.F90 | 11 ++- main/MOD_SnowLayersCombineDivide.F90 | 29 ++++---- main/MOD_SnowSnicar.F90 | 1 + main/MOD_SoilSnowHydrology.F90 | 42 +++++------ main/MOD_SoilSurfaceResistance.F90 | 16 ++-- main/MOD_Thermal.F90 | 4 +- main/MOD_TurbulenceLEddy.F90 | 5 +- main/MOD_UserSpecifiedForcing.F90 | 2 +- main/MOD_WetBulb.F90 | 1 + main/URBAN/CoLMMAIN_Urban.F90 | 2 +- main/URBAN/MOD_Urban_Albedo.F90 | 2 +- main/URBAN/MOD_Urban_BEM.F90 | 2 +- main/URBAN/MOD_Urban_Flux.F90 | 4 +- main/URBAN/MOD_Urban_GroundFlux.F90 | 2 +- main/URBAN/MOD_Urban_Hydrology.F90 | 2 +- .../URBAN/MOD_Urban_ImperviousTemperature.F90 | 2 +- main/URBAN/MOD_Urban_LUCY.F90 | 2 +- main/URBAN/MOD_Urban_Longwave.F90 | 4 +- main/URBAN/MOD_Urban_NetSolar.F90 | 2 +- main/URBAN/MOD_Urban_PerviousTemperature.F90 | 2 +- main/URBAN/MOD_Urban_RoofTemperature.F90 | 2 +- main/URBAN/MOD_Urban_Shortwave.F90 | 4 +- main/URBAN/MOD_Urban_Thermal.F90 | 2 +- main/URBAN/MOD_Urban_WallTemperature.F90 | 2 +- 51 files changed, 284 insertions(+), 234 deletions(-) diff --git a/main/CoLM.F90 b/main/CoLM.F90 index c5384eca..4a538520 100644 --- a/main/CoLM.F90 +++ b/main/CoLM.F90 @@ -131,6 +131,7 @@ PROGRAM CoLM type(timestamp) :: ststamp, itstamp, etstamp, ptstamp integer*8 :: start_time, end_time, c_per_sec, time_used +!----------------------------------------------------------------------- #ifdef USEMPI #ifdef USESplitAI diff --git a/main/CoLMMAIN.F90 b/main/CoLMMAIN.F90 index 1b5bd388..5cdb14bc 100644 --- a/main/CoLMMAIN.F90 +++ b/main/CoLMMAIN.F90 @@ -175,7 +175,7 @@ SUBROUTINE CoLMMAIN ( & IMPLICIT NONE -! ------------------------ Dummy Argument ------------------------------ +!-------------------------- Dummy Arguments ---------------------------- real(r8),intent(in) :: deltim !seconds in a time step [second] logical, intent(in) :: doalb !true if time for surface albedo calculation logical, intent(in) :: dolai !true if time for leaf area index calculation @@ -475,7 +475,7 @@ SUBROUTINE CoLMMAIN ( & fh ,&! integral of profile function for heat fq ! integral of profile function for moisture -! ----------------------- Local Variables ----------------------------- +!-------------------------- Local Variables ---------------------------- logical :: is_dry_lake real(r8) :: & @@ -545,7 +545,6 @@ SUBROUTINE CoLMMAIN ( & real(r8) :: wextra, t_rain, t_snow integer ps, pe, pc -!====================================================================== #if(defined CaMa_Flood) !add variables for flood evaporation [mm/s] and re-infiltration [mm/s] calculation. real(r8) :: kk @@ -567,6 +566,8 @@ SUBROUTINE CoLMMAIN ( & real(r8) :: fq_fld ! integral of profile function for moisture #endif +!----------------------------------------------------------------------- + z_soisno (maxsnl+1:0) = z_sno (maxsnl+1:0) z_soisno (1:nl_soil ) = z_soi (1:nl_soil ) dz_soisno(maxsnl+1:0) = dz_sno(maxsnl+1:0) diff --git a/main/LULCC/MOD_Lulcc_Initialize.F90 b/main/LULCC/MOD_Lulcc_Initialize.F90 index 12887933..662e45cd 100644 --- a/main/LULCC/MOD_Lulcc_Initialize.F90 +++ b/main/LULCC/MOD_Lulcc_Initialize.F90 @@ -52,7 +52,7 @@ SUBROUTINE LulccInitialize (casename,dir_landdata,dir_restart,& IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- character(len=*), intent(in) :: casename ! case name character(len=*), intent(in) :: dir_landdata character(len=*), intent(in) :: dir_restart diff --git a/main/MOD_3DCanopyRadiation.F90 b/main/MOD_3DCanopyRadiation.F90 index c19be318..80e35748 100644 --- a/main/MOD_3DCanopyRadiation.F90 +++ b/main/MOD_3DCanopyRadiation.F90 @@ -42,9 +42,9 @@ MODULE MOD_3DCanopyRadiation #ifdef LULC_IGBP_PC -!----------------------------------------------------------------------- SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) +!----------------------------------------------------------------------- ! ! !DESCRIPTION: ! This is a wrap SUBROUTINE to CALL 3D canopy radiative model below @@ -60,6 +60,7 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) ! ! !REVISIONS: ! +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Namelist, only: DEF_VEG_SNOW @@ -71,6 +72,7 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) IMPLICIT NONE +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: ipatch real(r8), intent(in) :: czen real(r8), intent(in) :: albg(2,2) @@ -79,7 +81,7 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) real(r8), intent(out) :: ssun(2,2) real(r8), intent(out) :: ssha(2,2) - ! local variables +!-------------------------- Local Variables ---------------------------- integer :: i, p, ps, pe; ! sunlit absorption fraction calculation mode @@ -102,6 +104,7 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) real(r8) :: rho_sno(2), tau_sno(2) data rho_sno(1), rho_sno(2) /0.3, 0.2/ data tau_sno(1), tau_sno(2) /0.3, 0.2/ +!----------------------------------------------------------------------- ! get patch PFT index ps = patch_pft_s(ipatch) @@ -264,7 +267,7 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & lsai, rho, tau, albgrd, albgri, albd, albi, & fabd, fabi, ftdd, ftid, ftii, fadd, psun, & fsun_id, fsun_ii, thermk, fshade) -! +!----------------------------------------------------------------------- ! !DESCRIPTION: ! ThreeDCanopy based on Dickinson (2008) using three canopy layer ! to calculate fluxes absorbed by vegetation, reflected by vegetation, @@ -282,14 +285,16 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & ! and D. Ji, 2014: A 3D canopy radiative transfer model for global climate ! modeling: Description, validation, and application. Journal of Climate, ! 27, 1168–1192, https://doi.org/10.1175/JCLI-D-13-00155.1. - ! -! !ARGUMENTS: +! !REVISIONS: +! +!----------------------------------------------------------------------- + IMPLICIT NONE integer, parameter :: numrad = 2 -! !ARGUMENTS: +!-------------------------- Dummy Arguments ---------------------------- integer , intent(in) :: ps, pe !pft index bounds integer , intent(in) :: canlay(ps:pe) !canopy level for current pft real(r8), intent(in) :: fcover(ps:pe) !fractional cover of pft within a patch @@ -321,7 +326,7 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & real(r8), intent(out) :: thermk (ps:pe) !direct transmittance of diffuse radiation real(r8), intent(out) :: fshade (ps:pe) !shadow in diffuse case of vegetation -! !OTHER LOCAL VARIABLES: +!-------------------------- Local Variables ---------------------------- real(r8), parameter :: mpe = 1.0e-06_r8 !prevents overflow for division by zero integer , parameter :: nlay=3 !number of canopy layers real(r8), parameter :: D0=0.0_r8 !double accuracy real number @@ -447,6 +452,7 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & logical :: soilveg(ps:pe) !true if pft over soil with veg and cosz > 0 real(r8) :: phi1(ps:pe), phi2(ps:pe) +!----------------------------------------------------------------------- ! 11/07/2018: calculate gee FUNCTION consider LAD phi1 = 0.5 - 0.633 * chil - 0.33 * chil * chil @@ -1123,7 +1129,7 @@ SUBROUTINE CanopyRad(tau_d, tau_i, ftdd, ftdi, cosz, cosd, & ftid, ftii, frid, frii, faid, faii) IMPLICIT NONE - ! input variables +!-------------------------- Dummy Arguments ---------------------------- real(r8) :: cosz !0.001 <= coszen <= 1.000 real(r8) :: cosd !0.001 <= coszen <= 1.000 real(r8) :: faid !direct absorption @@ -1154,7 +1160,7 @@ SUBROUTINE CanopyRad(tau_d, tau_i, ftdd, ftdi, cosz, cosd, & real(r8) :: phi_dif_o !total rad scattered in all direction per diffuse beam real(r8) :: pa2 !total rad scattered in all direction per direct beam - ! local variables +!-------------------------- Local Variables ---------------------------- logical :: runmode = .true. real(r8) :: tau real(r8) :: muv !forward frac of 3D scat rad in all direction for diffuse @@ -1178,6 +1184,7 @@ SUBROUTINE CanopyRad(tau_d, tau_i, ftdd, ftdi, cosz, cosd, & real(r16), parameter :: DD1 = 1.0_r16 !128-bit real number real(r8) , parameter :: pi = 3.14159265358979323846_R8 !pi +!----------------------------------------------------------------------- tau = D3/D4*gee*lsai diff --git a/main/MOD_Albedo.F90 b/main/MOD_Albedo.F90 index f449bddf..956c9e82 100644 --- a/main/MOD_Albedo.F90 +++ b/main/MOD_Albedo.F90 @@ -95,7 +95,7 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- ! ground cover index integer, intent(in) :: & ipatch, &! patch index @@ -163,7 +163,7 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& ssno(2,2), &! ground snow absorption [-] ssno_lyr(2,2,maxsnl+1:1) ! ground snow layer absorption, by SNICAR [-] -!-------------------------- Local variables ---------------------------- +!-------------------------- Local Variables ---------------------------- real(r8) :: &! age, &! factor to reduce visible snow alb due to snow age [-] @@ -482,7 +482,7 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, fwet_snow, & USE MOD_Namelist, only: DEF_VEG_SNOW IMPLICIT NONE -! parameters +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: & ! static parameters associated with vegetation type chil, &! leaf angle distribution factor @@ -511,7 +511,7 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, fwet_snow, & ssha(2,2) ! shaded canopy absorption for solar radiation, ! normalized by the incident flux -!-------------------------- local ----------------------------------- +!-------------------------- Local Variables ---------------------------- real(r8) :: & lsai, &! lai+sai sai_, &! sai=0 for USGS, no stem @@ -816,7 +816,7 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, fwet_snow, & USE MOD_Namelist, only: DEF_VEG_SNOW IMPLICIT NONE -! parameters +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: & ! static parameters associated with vegetation type chil, &! leaf angle distribution factor @@ -845,7 +845,7 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, fwet_snow, & ssha(2,2) ! shaded canopy absorption for solar radiation, ! normalized by the incident flux -!-------------------------- local ----------------------------------- +!-------------------------- Local Variables ---------------------------- real(r8) :: & lsai, &! lai+sai phi1, &! (phi-1) @@ -1191,33 +1191,36 @@ SUBROUTINE twostream_wrap ( ipatch, coszen, albg, & ! Created by Hua Yuan, 03/2020 ! !----------------------------------------------------------------------- - USE MOD_Precision - USE MOD_LandPFT - USE MOD_Const_PFT - USE MOD_Vars_PFTimeInvariants - USE MOD_Vars_PFTimeVariables - IMPLICIT NONE - - ! parameters - integer, intent(in) :: & - ipatch ! patch index - - ! environmental variables - real(r8), intent(in) :: & - coszen, &! cosine of solar zenith angle - albg(2,2) ! albedos of ground + USE MOD_Precision + USE MOD_LandPFT + USE MOD_Const_PFT + USE MOD_Vars_PFTimeInvariants + USE MOD_Vars_PFTimeVariables + IMPLICIT NONE - ! output - real(r8), intent(out) :: & - albv(2,2), &! albedo, vegetation [-] - tran(2,3), &! canopy transmittances for solar radiation - ssun(2,2), &! sunlit canopy absorption for solar radiation - ssha(2,2) ! shaded canopy absorption for solar radiation, - ! normalized by the incident flux +!-------------------------- Dummy Arguments ---------------------------- + integer, intent(in) :: & + ipatch ! patch index + + ! environmental variables + real(r8), intent(in) :: & + coszen, &! cosine of solar zenith angle + albg(2,2) ! albedos of ground - integer :: i, p, ps, pe - real(r8), allocatable :: tran_p(:,:,:) - real(r8), allocatable :: albv_p(:,:,:) + ! output + real(r8), intent(out) :: & + albv(2,2), &! albedo, vegetation [-] + tran(2,3), &! canopy transmittances for solar radiation + ssun(2,2), &! sunlit canopy absorption for solar radiation + ssha(2,2) ! shaded canopy absorption for solar radiation, + ! normalized by the incident flux + +!-------------------------- Local Variables ---------------------------- + integer :: i, p, ps, pe + real(r8), allocatable :: tran_p(:,:,:) + real(r8), allocatable :: albv_p(:,:,:) + +!----------------------------------------------------------------------- ps = patch_pft_s(ipatch) pe = patch_pft_e(ipatch) @@ -1287,7 +1290,7 @@ SUBROUTINE snowage ( deltim,tg,scv,scvold,sag ) USE MOD_Const_Physical, only : tfrz IMPLICIT NONE -!-------------------------- Dummy Argument ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: deltim ! seconds in a time step [second] real(r8), intent(in) :: tg ! temperature of soil at surface [K] @@ -1295,7 +1298,7 @@ SUBROUTINE snowage ( deltim,tg,scv,scvold,sag ) real(r8), intent(in) :: scvold ! snow cover for previous time step [mm] real(r8), intent(inout) :: sag ! non dimensional snow age [-] -!-------------------------- Local variables ---------------------------- +!-------------------------- Local Variables ---------------------------- real(r8) :: age1 ! snow aging factor due to crystal growth [-] real(r8) :: age2 ! snow aging factor due to surface growth [-] @@ -1985,7 +1988,7 @@ SUBROUTINE albocean (oro, scv, coszrs, alb) USE MOD_Precision IMPLICIT NONE -!------------------------------Arguments-------------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: oro ! /ocean(0)/seaice(2) flag real(r8), intent(in) :: scv ! snow water equivalent) [mm] @@ -1994,7 +1997,7 @@ SUBROUTINE albocean (oro, scv, coszrs, alb) real(r8), intent(out) :: alb(2,2) ! srf alb for direct (diffuse) rad 0.2-0.7 micro-ms ! Srf alb for direct (diffuse) rad 0.7-5.0 micro-ms -!---------------------------Local variables----------------------------- +!-------------------------- Local Variables ---------------------------- real(r8) frsnow ! horizontal fraction of snow cover real(r8) snwhgt ! physical snow height diff --git a/main/MOD_AssimStomataConductance.F90 b/main/MOD_AssimStomataConductance.F90 index 62b2af0e..ea74e6b2 100644 --- a/main/MOD_AssimStomataConductance.F90 +++ b/main/MOD_AssimStomataConductance.F90 @@ -78,6 +78,7 @@ SUBROUTINE stomata (vmax25,effcon,slti,hlti,shti, & USE MOD_Precision IMPLICIT NONE +!-------------------------- Dummy Arguments ---------------------------- real(r8),intent(in) :: & effcon, &! quantum efficiency of RuBP regeneration (mol CO2 / mol quanta) vmax25, &! maximum carboxylation rate at 25 C at canopy top @@ -127,7 +128,7 @@ SUBROUTINE stomata (vmax25,effcon,slti,hlti,shti, & real(r8) gammas -!-------------------- local -------------------------------------------- +!-------------------------- Local Variables ---------------------------- integer, parameter :: iterationtotal = 6 ! total iteration number in pco2i calculation @@ -179,6 +180,7 @@ SUBROUTINE stomata (vmax25,effcon,slti,hlti,shti, & range ! integer ic +!----------------------------------------------------------------------- CALL calc_photo_params(tlef, po2m, par , psrf, rstfac, rb, effcon, vmax25, & trop, slti, hlti, shti, hhti, trda, trdm, cint, & @@ -369,12 +371,13 @@ SUBROUTINE sortin( eyy, pco2y, range, gammas, ic, iterationtotal ) USE MOD_Precision IMPLICIT NONE - integer, intent(in) :: ic,iterationtotal +!-------------------------- Dummy Arguments ---------------------------- + integer, intent(in) :: ic,iterationtotal real(r8), intent(in) :: range real(r8), intent(in) :: gammas real(r8), intent(inout), dimension(iterationtotal) :: eyy, pco2y -!----- Local ----------------------------------------------------------- +!-------------------------- Local Variables ---------------------------- integer i, j, n, i1, i2, i3, is, isp, ix real(r8) a, b, pmin, emin, eyy_a real(r8) pco2b, pco2yl, pco2yq @@ -457,6 +460,7 @@ SUBROUTINE calc_photo_params(tlef, po2m, par , psrf, rstfac, rb, effcon, vmax25, USE MOD_Precision IMPLICIT NONE +!-------------------------- Dummy Arguments ---------------------------- real(r8),intent(in) :: & tlef, &! leaf temperature (K) po2m, &! O2 concentration in atmos. (pascals) @@ -490,6 +494,7 @@ SUBROUTINE calc_photo_params(tlef, po2m, par , psrf, rstfac, rb, effcon, vmax25, c3, &! c3 vegetation : 1; 0 for c4 c4 ! c4 vegetation : 1; 0 for c3 +!-------------------------- Local Variables ---------------------------- real(r8) :: & qt, &! (tleaf - 298.16) / 10 kc, &! Michaelis-Menten constant for co2 @@ -502,7 +507,7 @@ SUBROUTINE calc_photo_params(tlef, po2m, par , psrf, rstfac, rb, effcon, vmax25, respcp, &! respiration fraction of vmax (mol co2 m-2 s-1) tprcor ! coefficient for unit transfer -!======================================================================= +!----------------------------------------------------------------------- c3 = 0. IF( effcon .gt. 0.07 ) c3 = 1. @@ -591,6 +596,7 @@ SUBROUTINE update_photosyn(tlef, po2m, pco2m, pco2a, par, psrf, rstfac, rb, gsh2 USE MOD_Precision IMPLICIT NONE +!-------------------------- Dummy Arguments ---------------------------- real(r8),intent(in) :: & tlef, &! leaf temperature (K) po2m, &! O2 concentration in atmos. (pascals) @@ -621,6 +627,7 @@ SUBROUTINE update_photosyn(tlef, po2m, pco2m, pco2a, par, psrf, rstfac, rb, gsh2 assim, &! canopy assimilation rate (mol m-2 s-1) respc ! canopy respiration (mol m-2 s-1) +!-------------------------- Local Variables ---------------------------- real(r8) :: & vm, &! maximum catalytic activity of Rubison (mol co2 m-2 s-1) epar, &! electron transport rate (mol electron m-2 s-1) @@ -659,6 +666,7 @@ SUBROUTINE update_photosyn(tlef, po2m, pco2m, pco2a, par, psrf, rstfac, rb, gsh2 range ! integer ic +!----------------------------------------------------------------------- CALL calc_photo_params(tlef, po2m, par , psrf, rstfac, rb, effcon, vmax25, & trop, slti, hlti, shti, hhti, trda, trdm, cint, & @@ -764,7 +772,7 @@ END SUBROUTINE update_photosyn SUBROUTINE WUE_solver(gammas, lambda, co2a, ei, ea, psrf, pco2i_c, pco2i_e) -!------------------------------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Solve internal co2 concentration for Rubisco limit and RuBP regeneration limit. ! ! When Rubisco is limit (omc < ome), solve following equation (Liang et al., 2023, S18a) @@ -778,10 +786,12 @@ SUBROUTINE WUE_solver(gammas, lambda, co2a, ei, ea, psrf, pco2i_c, pco2i_e) ! [1-(1.6*D)/(3*lambda*gammas)] * co2i_e^2 & ! - [2*co2a-(3.2*D)/(3*lambda)] * co2i_e & ! + [co2a^2 - (1.6*D*co2a)/lambda + (3.2*D*gammas)/(3*lambda)] = 0 +!----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE +!-------------------------- Dummy Arguments ---------------------------- real(r8),intent(in) :: & gammas, &! CO2 compensation point (pa) lambda, &! marginal water use efficiency ((mol h2o) (mol co2)-1) @@ -794,11 +804,14 @@ SUBROUTINE WUE_solver(gammas, lambda, co2a, ei, ea, psrf, pco2i_c, pco2i_e) pco2i_c, &! internal co2 concentration when Rubisco is limited (pa) pco2i_e ! internal co2 concentration when RuBP regeneration is limited (pa) +!-------------------------- Local Variables ---------------------------- real(r8) :: & D, &! leaf-to-air-vapour mole fraction difference ((mol h2o) (mol air)-1) co2i_c, &! internal co2 concentration when Rubisco is limited ((mol co2) (mol air)-1) co2i_e ! internal co2 concentration when RuBP is limited ((mol co2) (mol air)-1) +!----------------------------------------------------------------------- + ! solve co2i_c D = amax1((ei - ea),50._r8) / psrf diff --git a/main/MOD_Eroot.F90 b/main/MOD_Eroot.F90 index b8923550..322af477 100644 --- a/main/MOD_Eroot.F90 +++ b/main/MOD_Eroot.F90 @@ -45,7 +45,7 @@ SUBROUTINE eroot (nl_soil,trsmx0,porsl, & #endif IMPLICIT NONE - !-----------------------Argument-------------------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: nl_soil ! upper bound of array @@ -72,7 +72,7 @@ SUBROUTINE eroot (nl_soil,trsmx0,porsl, & real(r8), intent(out) :: etrc ! maximum possible transpiration rate (mm h2o/s) real(r8), intent(out) :: rstfac ! factor of soil water stress for photosynthesis - !-----------------------Local Variables------------------------------- +!-------------------------- Local Variables ---------------------------- real(r8) roota ! accumulates root resistance factors real(r8) rresis(1:nl_soil) ! soil water contribution to root resistance @@ -82,7 +82,7 @@ SUBROUTINE eroot (nl_soil,trsmx0,porsl, & integer i ! loop counter - !-----------------------End Variables list---------------------------- +!----------------------------------------------------------------------- ! transpiration potential(etrc) and root resistance factors (rstfac) diff --git a/main/MOD_FrictionVelocity.F90 b/main/MOD_FrictionVelocity.F90 index 14b52bf8..45672ebd 100644 --- a/main/MOD_FrictionVelocity.F90 +++ b/main/MOD_FrictionVelocity.F90 @@ -38,7 +38,7 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& USE MOD_Const_Physical, only : vonkar IMPLICIT NONE -! ---------------------- dummy argument -------------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: hu ! observational height of wind [m] real(r8), intent(in) :: ht ! observational height of temperature [m] @@ -58,7 +58,7 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& real(r8), intent(out) :: fh ! integral of profile FUNCTION for heat real(r8), intent(out) :: fq ! integral of profile FUNCTION for moisture -!------------------------ local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- real(r8) zldis ! reference height "minus" zero displacement height [m] real(r8) zetam ! transition point of flux-gradient relation (wind profile) @@ -192,7 +192,7 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& USE MOD_Const_Physical, only : vonkar IMPLICIT NONE -! ---------------------- dummy argument -------------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: hu ! observational height of wind [m] real(r8), intent(in) :: ht ! observational height of temperature [m] @@ -218,7 +218,7 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& real(r8), intent(out) :: fqt ! integral of profile FUNCTION for moisture at the top layer real(r8), intent(out) :: phih ! phi(h), similarity FUNCTION for sensible heat -!------------------------ local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- real(r8) zldis ! reference height "minus" zero displacement height [m] real(r8) zetam ! transition point of flux-gradient relation (wind profile) @@ -383,14 +383,14 @@ real(r8) FUNCTION kmoninobuk(displa,obu,ustar,z) USE MOD_Const_Physical, only : vonkar IMPLICIT NONE -! ---------------------- dummy argument -------------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: displa ! displacement height [m] real(r8), intent(in) :: obu ! monin-obukhov length (m) real(r8), intent(in) :: ustar ! friction velocity [m/s] real(r8), intent(in) :: z ! height of windspeed [m] -!------------------------ local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- real(r8) zldis ! reference height "minus" zero displacement height [m] real(r8) zetam ! transition point of flux-gradient relation (wind profile) @@ -398,6 +398,8 @@ real(r8) FUNCTION kmoninobuk(displa,obu,ustar,z) real(r8) zeta ! dimensionless height used in Monin-Obukhov theory real(r8) phih ! phi(h), similarity FUNCTION for sensible heat +!----------------------------------------------------------------------- + IF ( z .le. displa ) THEN kmoninobuk = 0. RETURN @@ -434,7 +436,7 @@ real(r8) FUNCTION kintmoninobuk(displa,z0h,obu,ustar,ztop,zbot) USE MOD_Const_Physical, only : vonkar IMPLICIT NONE -! ---------------------- dummy argument -------------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: displa ! displacement height [m] real(r8), intent(in) :: z0h ! roughness length, sensible heat [m] @@ -443,7 +445,7 @@ real(r8) FUNCTION kintmoninobuk(displa,z0h,obu,ustar,ztop,zbot) real(r8), intent(in) :: ztop ! height top real(r8), intent(in) :: zbot ! height bottom -!------------------------ local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- real(r8) zldis ! reference height "minus" zero displacement height [m] real(r8) zetam ! transition point of flux-gradient relation (wind profile) @@ -452,6 +454,8 @@ real(r8) FUNCTION kintmoninobuk(displa,z0h,obu,ustar,ztop,zbot) real(r8) :: fh_top, fh_bot ! integral of profile FUNCTION for heat +!----------------------------------------------------------------------- + zldis=ztop-displa zeta=zldis/obu zetat=0.465 @@ -501,7 +505,7 @@ SUBROUTINE moninobukini(ur,th,thm,thv,dth,dqh,dthv,zldis,z0m,um,obu) USE MOD_Const_Physical, only : grav, vonkar IMPLICIT NONE -! Dummy argument +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: ur ! wind speed at reference height [m/s] real(r8), intent(in) :: thm ! intermediate variable (tm+0.0098*ht) real(r8), intent(in) :: th ! potential temperature [kelvin] @@ -515,7 +519,7 @@ SUBROUTINE moninobukini(ur,th,thm,thv,dth,dqh,dthv,zldis,z0m,um,obu) real(r8), intent(out) :: um ! wind speed including the stability effect [m/s] real(r8), intent(out) :: obu ! monin-obukhov length (m) -! Local +!-------------------------- Local Variables ---------------------------- real(r8) wc ! convective velocity [m/s] real(r8) rib ! bulk Richardson number real(r8) zeta ! dimensionless height used in Monin-Obukhov theory diff --git a/main/MOD_Glacier.F90 b/main/MOD_Glacier.F90 index 731412c1..c700896b 100644 --- a/main/MOD_Glacier.F90 +++ b/main/MOD_Glacier.F90 @@ -78,7 +78,7 @@ SUBROUTINE GLACIER_TEMP (patchtype, lb ,nl_ice ,deltim ,& IMPLICIT NONE -!---------------------Argument------------------------------------------ +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & patchtype,& ! land patch type (0=soil, 1=urban and built-up, @@ -169,7 +169,7 @@ SUBROUTINE GLACIER_TEMP (patchtype, lb ,nl_ice ,deltim ,& fh, &! integral of profile FUNCTION for heat fq ! integral of profile FUNCTION for moisture -!---------------------Local Variables----------------------------------- +!-------------------------- Local Variables ---------------------------- integer i,j real(r8) :: & @@ -361,7 +361,7 @@ SUBROUTINE groundfluxes_glacier (zlnd,zsno,hu,ht,hq,& USE MOD_TurbulenceLEddy IMPLICIT NONE -!----------------------- Dummy argument -------------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: & zlnd, &! roughness length for ice [m] zsno, &! roughness length for snow [m] @@ -415,7 +415,7 @@ SUBROUTINE groundfluxes_glacier (zlnd,zsno,hu,ht,hq,& fh, &! integral of profile FUNCTION for heat fq ! integral of profile FUNCTION for moisture -!------------------------ LOCAL VARIABLES ------------------------------ +!-------------------------- Local Variables ---------------------------- integer niters, &! maximum number of iterations for surface temperature iter, &! iteration index nmozsgn ! number of times moz changes sign @@ -447,7 +447,7 @@ SUBROUTINE groundfluxes_glacier (zlnd,zsno,hu,ht,hq,& z0hg, &! roughness length over ground, sensible heat [m] z0qg ! roughness length over ground, latent heat [m] -!----------------------- Dummy argument -------------------------------- +!----------------------------------------------------------------------- ! initial roughness length IF(fsno > 0.)THEN ! z0mg = zsno @@ -603,10 +603,11 @@ SUBROUTINE groundtem_glacier (patchtype,lb,nl_ice,deltim,& IMPLICIT NONE - integer, intent(in) :: patchtype ! land patch type (0=soil, 1=urban and built-up, - ! 2=wetland, 3=land ice, 4=land water bodies, 99 = ocean) - integer, intent(in) :: lb !lower bound of array - integer, intent(in) :: nl_ice !upper bound of array +!-------------------------- Dummy Arguments ---------------------------- + integer, intent(in) :: patchtype !land patch type (0=soil, 1=urban and built-up, + !2=wetland, 3=land ice, 4=land water bodies, 99 = ocean) + integer, intent(in) :: lb !lower bound of array + integer, intent(in) :: nl_ice !upper bound of array real(r8), intent(in) :: deltim !seconds in a time step [second] real(r8), intent(in) :: capr !tuning factor to turn first layer T into surface T real(r8), intent(in) :: cnfac !Crank Nicholson factor between 0 and 1 @@ -641,7 +642,7 @@ SUBROUTINE groundtem_glacier (patchtype,lb,nl_ice,deltim,& real(r8), intent(out) :: snofrz(lb:0) !snow freezing rate (lyr) [kg m-2 s-1] -!------------------------ local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- real(r8) rhosnow ! partial density of water (ice + liquid) real(r8) cv(lb:nl_ice) ! heat capacity [J/(m2 K)] real(r8) thk(lb:nl_ice) ! thermal conductivity of layer @@ -679,7 +680,7 @@ SUBROUTINE groundtem_glacier (patchtype,lb,nl_ice,deltim,& fc_vgm (1:nl_ice) #endif -!======================================================================= +!----------------------------------------------------------------------- ! SNOW and LAND ICE heat capacity cv(1:) = wice_icesno(1:)*cpice + wliq_icesno(1:)*cpliq IF(lb==1 .and. scv>0.) cv(1) = cv(1) + cpice*scv @@ -885,7 +886,7 @@ SUBROUTINE GLACIER_WATER ( nl_ice,maxsnl,deltim,& IMPLICIT NONE -!-----------------------Argument---------- ------------------------------ +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: nl_ice ! upper bound of array integer, intent(in) :: maxsnl ! maximum number of snow layers @@ -921,9 +922,9 @@ SUBROUTINE GLACIER_WATER ( nl_ice,maxsnl,deltim,& real(r8), intent(out) :: & gwat ! net water input from top (mm/s) -! -!-----------------------Local Variables------------------------------ -! + +!-------------------------- Local Variables ---------------------------- + integer lb, j !======================================================================= @@ -1010,7 +1011,7 @@ SUBROUTINE GLACIER_WATER_snicar ( nl_ice,maxsnl,deltim,& IMPLICIT NONE -!-----------------------Argument---------- ------------------------------ +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: nl_ice ! upper bound of array integer, intent(in) :: maxsnl ! maximum number of snow layers @@ -1060,9 +1061,8 @@ SUBROUTINE GLACIER_WATER_snicar ( nl_ice,maxsnl,deltim,& mss_dst4 (maxsnl+1:0) ! mass of dust species 4 in snow (col,lyr) [kg] ! Aerosol Fluxes (Jan. 07, 2023) -! -!-----------------------Local Variables------------------------------ -! +!-------------------------- Local Variables ---------------------------- + integer lb, j !======================================================================= diff --git a/main/MOD_GroundFluxes.F90 b/main/MOD_GroundFluxes.F90 index 6edd906d..248006f5 100644 --- a/main/MOD_GroundFluxes.F90 +++ b/main/MOD_GroundFluxes.F90 @@ -48,7 +48,7 @@ SUBROUTINE GroundFluxes (zlnd, zsno, hu, ht, hq, hpbl, & IMPLICIT NONE -!----------------------- Dummy argument -------------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: & zlnd, &! roughness length for soil [m] zsno, &! roughness length for snow [m] @@ -108,7 +108,7 @@ SUBROUTINE GroundFluxes (zlnd, zsno, hu, ht, hq, hpbl, & fh, &! integral of profile FUNCTION for heat fq ! integral of profile FUNCTION for moisture - !------------------------ LOCAL VARIABLES ------------------------------ +!-------------------------- Local Variables ---------------------------- integer niters, &! maximum number of iterations for surface temperature iter, &! iteration index nmozsgn ! number of times moz changes sign @@ -139,7 +139,7 @@ SUBROUTINE GroundFluxes (zlnd, zsno, hu, ht, hq, hpbl, & z0mg, &! roughness length over ground, momentum [m] z0qg ! roughness length over ground, latent heat [m] - !----------------------- Dummy argument -------------------------------- +!----------------------------------------------------------------------- ! initial roughness length ! 09/2019, yuan: change to a combination of zlnd and zsno z0mg = (1.-fsno)*zlnd + fsno*zsno diff --git a/main/MOD_GroundTemperature.F90 b/main/MOD_GroundTemperature.F90 index 97f23fbe..5823d592 100644 --- a/main/MOD_GroundTemperature.F90 +++ b/main/MOD_GroundTemperature.F90 @@ -76,11 +76,12 @@ SUBROUTINE GroundTemperature (patchtype,is_dry_lake,lb,nl_soil,deltim,& IMPLICIT NONE - integer, intent(in) :: lb !lower bound of array - integer, intent(in) :: nl_soil !upper bound of array - integer, intent(in) :: patchtype !land patch type (0=soil,1=urban or built-up,2=wetland, +!-------------------------- Dummy Arguments ---------------------------- + integer, intent(in) :: lb !lower bound of array + integer, intent(in) :: nl_soil !upper bound of array + integer, intent(in) :: patchtype !land patch type (0=soil,1=urban or built-up,2=wetland, !3=land ice, 4=deep lake, 5=shallow lake) - logical, intent(in) :: is_dry_lake + logical, intent(in) :: is_dry_lake real(r8), intent(in) :: deltim !seconds in a time step [second] real(r8), intent(in) :: capr !tuning factor to turn first layer T into surface T real(r8), intent(in) :: cnfac !Crank Nicholson factor between 0 and 1 @@ -155,7 +156,7 @@ SUBROUTINE GroundTemperature (patchtype,is_dry_lake,lb,nl_soil,deltim,& real(r8), intent(out) :: snofrz(lb:0) !snow freezing rate (lyr) [kg m-2 s-1] -!------------------------ local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- real(r8) cv (lb:nl_soil) !heat capacity [J/(m2 K)] real(r8) tk (lb:nl_soil) !thermal conductivity [W/(m K)] real(r8) hcap(1:nl_soil) !J/(m3 K) @@ -183,7 +184,7 @@ SUBROUTINE GroundTemperature (patchtype,is_dry_lake,lb,nl_soil,deltim,& real(r8) rhosnow !partial density of water (ice + liquid) integer i,j -!======================================================================= +!----------------------------------------------------------------------- ! soil ground and wetland heat capacity DO i = 1, nl_soil vf_water(i) = wliq_soisno(i)/(dz_soisno(i)*denh2o) diff --git a/main/MOD_LAIEmpirical.F90 b/main/MOD_LAIEmpirical.F90 index 0f76b68d..e18df316 100644 --- a/main/MOD_LAIEmpirical.F90 +++ b/main/MOD_LAIEmpirical.F90 @@ -28,8 +28,9 @@ SUBROUTINE LAI_empirical(ivt,nl_soil,rootfr,t,lai,sai,fveg,green) USE MOD_Precision IMPLICIT NONE - integer, intent(in) :: ivt !land cover type - integer, intent(in) :: nl_soil !number of soil layers +!-------------------------- Dummy Arguments ---------------------------- + integer, intent(in) :: ivt !land cover type + integer, intent(in) :: nl_soil !number of soil layers real(r8), intent(in) :: rootfr(1:nl_soil) !root fraction real(r8), intent(in) :: t(1:nl_soil) !soil temperature @@ -38,7 +39,7 @@ SUBROUTINE LAI_empirical(ivt,nl_soil,rootfr,t,lai,sai,fveg,green) real(r8), intent(out) :: fveg !fractional cover of vegetation real(r8), intent(out) :: green !greenness -!local variable +!-------------------------- Local Variables ---------------------------- real(r8) f ! real(r8) roota !accumulates root fraction integer jrt !number of soil layers with 90% root fraction diff --git a/main/MOD_Lake.F90 b/main/MOD_Lake.F90 index 879f9460..b589825d 100644 --- a/main/MOD_Lake.F90 +++ b/main/MOD_Lake.F90 @@ -67,16 +67,17 @@ SUBROUTINE newsnow_lake ( USE_Dynamic_Lake, & USE MOD_Precision USE MOD_Const_Physical, only : tfrz, denh2o, cpliq, cpice, hfus IMPLICIT NONE -! ------------------------ Dummy Argument ------------------------------ - logical, intent(in) :: USE_Dynamic_Lake - integer, intent(in) :: maxsnl ! maximum number of snow layers - integer, intent(in) :: nl_lake ! number of soil layers - real(r8), intent(in) :: deltim ! seconds in a time step [second] - real(r8), intent(inout) :: pg_rain ! liquid water onto ground [kg/(m2 s)] - real(r8), intent(inout) :: pg_snow ! ice onto ground [kg/(m2 s)] - real(r8), intent(in) :: t_precip ! snowfall/rainfall temperature [kelvin] - real(r8), intent(in) :: bifall ! bulk density of newly fallen dry snow [kg/m3] +!-------------------------- Dummy Arguments ---------------------------- + logical, intent(in) :: USE_Dynamic_Lake + + integer, intent(in) :: maxsnl ! maximum number of snow layers + integer, intent(in) :: nl_lake ! number of soil layers + real(r8), intent(in) :: deltim ! seconds in a time step [second] + real(r8), intent(inout) :: pg_rain ! liquid water onto ground [kg/(m2 s)] + real(r8), intent(inout) :: pg_snow ! ice onto ground [kg/(m2 s)] + real(r8), intent(in) :: t_precip ! snowfall/rainfall temperature [kelvin] + real(r8), intent(in) :: bifall ! bulk density of newly fallen dry snow [kg/m3] real(r8), intent(inout) :: dz_lake(1:nl_lake) ! lake layer thickness (m) real(r8), intent(inout) :: zi_soisno(maxsnl:0) ! interface level below a "z" level (m) @@ -86,14 +87,14 @@ SUBROUTINE newsnow_lake ( USE_Dynamic_Lake, & real(r8), intent(inout) :: wliq_soisno(maxsnl+1:0) ! snow layer liquid water (kg/m2) real(r8), intent(inout) :: wice_soisno(maxsnl+1:0) ! snow layer ice lens (kg/m2) real(r8), intent(inout) :: fiold(maxsnl+1:0) ! fraction of ice relative to the total water - integer, intent(inout) :: snl ! number of snow layers - real(r8), intent(inout) :: sag ! non dimensional snow age [-] - real(r8), intent(inout) :: scv ! snow mass (kg/m2) - real(r8), intent(inout) :: snowdp ! snow depth (m) + integer, intent(inout) :: snl ! number of snow layers + real(r8), intent(inout) :: sag ! non dimensional snow age [-] + real(r8), intent(inout) :: scv ! snow mass (kg/m2) + real(r8), intent(inout) :: snowdp ! snow depth (m) real(r8), intent(inout) :: lake_icefrac(1:nl_lake) ! mass fraction of lake layer that is frozen real(r8), intent(inout) :: t_lake(1:nl_lake) ! lake layer temperature (m) -! ----------------------- Local Variables ----------------------------- +!-------------------------- Local Variables ---------------------------- integer lb integer newnode ! signification when new snow node is set, (1=yes, 0=non) @@ -373,7 +374,7 @@ SUBROUTINE laketem (& USE MOD_Utils IMPLICIT NONE -! ------------------------ input/output variables ----------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: patchtype ! land patch type (4=deep lake, 5=shallow lake) integer, intent(in) :: maxsnl ! maximum number of snow layers integer, intent(in) :: nl_soil ! number of soil layers @@ -473,6 +474,7 @@ SUBROUTINE laketem (& real(r8), intent(out) :: sm ! rate of snowmelt [mm/s, kg/(m2 s)] logical, optional, intent(in) :: urban_call ! whether it is a urban CALL +!-------------------------- Local Variables ---------------------------- ! ---------------- local variables in surface temp and fluxes calculation ----------------- integer idlak ! index of lake, 1 = deep lake, 2 = shallow lake real(r8) z_lake (nl_lake) ! lake node depth (middle point of layer) (m) @@ -1592,7 +1594,7 @@ SUBROUTINE snowwater_lake ( USE_Dynamic_Lake, & IMPLICIT NONE -! ------------- in/inout/out variables ----------------------------------------- +!-------------------------- Dummy Arguments ---------------------------- logical, intent(in) :: USE_Dynamic_Lake integer, intent(in) :: maxsnl ! maximum number of snow layers @@ -1655,7 +1657,7 @@ SUBROUTINE snowwater_lake ( USE_Dynamic_Lake, & ! Aerosol Fluxes (Jan. 07, 2023) ! END SNICAR model variables -! ------------- other local variables ----------------------------------------- +!-------------------------- Local Variables ---------------------------- logical has_snow_bef integer j ! indices integer lb ! lower bound of array @@ -1936,6 +1938,7 @@ SUBROUTINE roughness_lake (snl,t_grnd,t_lake,lake_icefrac,forc_psrf,& real(r8) kva ! kinematic viscosity of air at ground temperature and forcing pressure real(r8) sqre0 ! root of roughness Reynolds number +!----------------------------------------------------------------------- IF (t_grnd > tfrz .and. t_lake(1) > tfrz .and. snl == 0) THEN kva = kva0 * (t_grnd/293.15)**1.5 * 1.013e5/forc_psrf ! kinematic viscosity of air @@ -1974,6 +1977,7 @@ SUBROUTINE hConductivity_lake(nl_lake,snl,t_grnd,& IMPLICIT NONE +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: nl_lake ! number of soil layers integer, intent(in) :: snl ! number of snow layers real(r8), intent(in) :: t_grnd ! ground surface temperature [k] @@ -1992,7 +1996,7 @@ SUBROUTINE hConductivity_lake(nl_lake,snl,t_grnd,& real(r8), intent(out) :: tk_lake(nl_lake) ! thermal conductivity at layer node [W/(m K)] real(r8), intent(out) :: savedtke1 ! top level eddy conductivity (W/mK) -! local +!-------------------------- Local Variables ---------------------------- real(r8) kme(nl_lake) ! molecular + eddy diffusion coefficient (m**2/s) real(r8) cwat ! specific heat capacity of water (j/m**3/kelvin) real(r8) den ! used in calculating ri diff --git a/main/MOD_LeafInterception.F90 b/main/MOD_LeafInterception.F90 index 2d0a7794..f654b46b 100644 --- a/main/MOD_LeafInterception.F90 +++ b/main/MOD_LeafInterception.F90 @@ -172,6 +172,8 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la real(r8), intent(out) :: qintr_rain !rainfall interception (mm h2o/s) real(r8), intent(out) :: qintr_snow !snowfall interception (mm h2o/s) +!----------------------------------------------------------------------- + IF (lai+sai > 1e-6) THEN lsai = lai + sai vegt = lsai diff --git a/main/MOD_LeafTemperature.F90 b/main/MOD_LeafTemperature.F90 index 8f79d335..44904e89 100644 --- a/main/MOD_LeafTemperature.F90 +++ b/main/MOD_LeafTemperature.F90 @@ -118,7 +118,7 @@ SUBROUTINE LeafTemperature ( & IMPLICIT NONE -!-----------------------Arguments--------------------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: ipatch,ivt real(r8), intent(in) :: & @@ -297,7 +297,7 @@ SUBROUTINE LeafTemperature ( & fh, &! integral of profile function for heat fq ! integral of profile function for moisture -!-----------------------Local Variables--------------------------------- +!-------------------------- Local Variables ---------------------------- ! assign iteration parameters integer, parameter :: itmax = 40 !maximum number of iteration integer, parameter :: itmin = 6 !minimum number of iteration @@ -419,7 +419,7 @@ SUBROUTINE LeafTemperature ( & integer, parameter :: rb_opt = 3 ! rb with vertical profile consideration integer, parameter :: rd_opt = 3 ! rd with vertical profile consideration -!-----------------------End Variable List------------------------------- +!----------------------------------------------------------------------- ! initialization of errors and iteration parameters it = 1 !counter for leaf temperature iteration diff --git a/main/MOD_LeafTemperaturePC.F90 b/main/MOD_LeafTemperaturePC.F90 index eff6c4b2..7865b1f5 100644 --- a/main/MOD_LeafTemperaturePC.F90 +++ b/main/MOD_LeafTemperaturePC.F90 @@ -123,7 +123,7 @@ SUBROUTINE LeafTemperaturePC ( & IMPLICIT NONE -!-----------------------Arguments--------------------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: ipatch integer, intent(in) :: & @@ -283,7 +283,7 @@ SUBROUTINE LeafTemperaturePC ( & cgrndl, &! deriv, of soil latent heat flux wrt soil temp [w/m2/k] cgrnds ! deriv of soil sensible heat flux wrt soil temp [w/m**2/k] -!-----------------------Local Variables--------------------------------- +!-------------------------- Local Variables ---------------------------- ! assign iteration parameters integer, parameter :: itmax = 40 !maximum number of iteration integer, parameter :: itmin = 6 !minimum number of iteration @@ -511,7 +511,7 @@ SUBROUTINE LeafTemperaturePC ( & real(r8) :: dLv(ps:pe) !LW change due to temperature change real(r8) :: dLvpar(nlay) !temporal variable for calculating dLv -!-----------------------End Variable List------------------------------- +!----------------------------------------------------------------------- ! only process with vegetated patches @@ -2055,7 +2055,7 @@ SUBROUTINE dewfraction (sigf,lai,sai,dewmx,ldew,ldew_rain,ldew_snow,fwet,fdry) real(r8) :: vegt !sigf*lsai, NOTE: remove sigf real(r8) :: fwet_rain !fraction of foliage covered by water [-] real(r8) :: fwet_snow !fraction of foliage covered by snow [-] -! + !----------------------------------------------------------------------- ! Fwet is the fraction of all vegetation surfaces which are wet ! including stem area which contribute to evaporation diff --git a/main/MOD_NetSolar.F90 b/main/MOD_NetSolar.F90 index a71eab47..5e85454e 100644 --- a/main/MOD_NetSolar.F90 +++ b/main/MOD_NetSolar.F90 @@ -24,7 +24,8 @@ SUBROUTINE netsolar (ipatch,idate,deltim,dlon,patchtype,& parsun,parsha,sabvsun,sabvsha,sabg,sabg_soil,sabg_snow,fsno,sabg_snow_lyr,sr,& solvd,solvi,solnd,solni,srvd,srvi,srnd,srni,& solvdln,solviln,solndln,solniln,srvdln,srviln,srndln,srniln) -! + +!----------------------------------------------------------------------- ! !DESCRIPTION: ! Net solar absorbed by surface ! @@ -39,6 +40,7 @@ SUBROUTINE netsolar (ipatch,idate,deltim,dlon,patchtype,& ! ! Hua Yuan, 12/2022: calculated snow layer absorption by SNICAR model ! +!----------------------------------------------------------------------- ! !USES: USE MOD_Precision USE MOD_Vars_Global @@ -53,7 +55,7 @@ SUBROUTINE netsolar (ipatch,idate,deltim,dlon,patchtype,& IMPLICIT NONE -! Dummy argument +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: ipatch !patch index integer, intent(in) :: idate(3) !model time integer, intent(in) :: patchtype !land patch type (99-sea) @@ -116,13 +118,13 @@ SUBROUTINE netsolar (ipatch,idate,deltim,dlon,patchtype,& real(r8), intent(out) :: & sabg_snow_lyr(maxsnl+1:1) ! solar absorbed by snow layers [W/m2] -! ----------------local variables --------------------------------- +!-------------------------- Local Variables ---------------------------- integer :: local_secs real(r8) :: radpsec, sabvg, sabg_noadj integer ps, pe, p -!======================================================================= +!----------------------------------------------------------------------- sabvsun = 0. sabvsha = 0. @@ -312,3 +314,4 @@ SUBROUTINE netsolar (ipatch,idate,deltim,dlon,patchtype,& END SUBROUTINE netsolar END MODULE MOD_NetSolar +! ---------- EOP ------------ diff --git a/main/MOD_NewSnow.F90 b/main/MOD_NewSnow.F90 index 3e3907a5..9050ce1a 100644 --- a/main/MOD_NewSnow.F90 +++ b/main/MOD_NewSnow.F90 @@ -31,7 +31,7 @@ SUBROUTINE newsnow (patchtype,maxsnl,deltim,t_grnd,pg_rain,pg_snow,bifall,& IMPLICIT NONE -! ------------------------ Dummy Argument ------------------------------ +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: maxsnl ! maximum number of snow layers integer, intent(in) :: patchtype ! land patch type (0=soil, 1=urban and built-up, @@ -58,13 +58,14 @@ SUBROUTINE newsnow (patchtype,maxsnl,deltim,t_grnd,pg_rain,pg_snow,bifall,& real(r8), intent(inout), optional :: wetwat ! wetland water [mm] -! ----------------------- Local Variables ----------------------------- +!-------------------------- Local Variables ---------------------------- real(r8) dz_snowf ! layer thickness rate change due to precipitation [mm/s] integer newnode ! signification when new snow node is set, (1=yes, 0=no) integer lb !----------------------------------------------------------------------- + newnode = 0 dz_snowf = pg_snow/bifall @@ -121,3 +122,4 @@ SUBROUTINE newsnow (patchtype,maxsnl,deltim,t_grnd,pg_rain,pg_snow,bifall,& END SUBROUTINE newsnow END MODULE MOD_NewSnow +! ---------- EOP ------------ diff --git a/main/MOD_OrbCosazi.F90 b/main/MOD_OrbCosazi.F90 index 840bd1ef..34b29cb3 100644 --- a/main/MOD_OrbCosazi.F90 +++ b/main/MOD_OrbCosazi.F90 @@ -17,17 +17,17 @@ MODULE MOD_OrbCosazi FUNCTION orb_cosazi(calday, dlon, dlat, coszen) -!----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: calday !Julian cal day (1.xx to 365.xx) real(r8), intent(in) :: dlat !Centered latitude (radians) real(r8), intent(in) :: dlon !Centered longitude (radians) real(r8), intent(in) :: coszen !cosine of sun zenith angle real(r8) :: orb_cosazi !cosine of sun azimuth angle - ! --- Local variables --- +!-------------------------- Local Variables ---------------------------- real(r8) declin !Solar declination (radians) real(r8) eccf !Earth-sun distance factor (ie. (1/r)**2) real(r8) lambm !Lambda m, mean long of perihelion (rad) @@ -44,7 +44,7 @@ FUNCTION orb_cosazi(calday, dlon, dlat, coszen) lambm0=-3.2625366E-2, &!Mean long of perihelion at the vernal equinox (radians) mvelpp=4.92251015 !moving vernal equinox longitude of !perihelion plus pi (radians) - !--------------------------------------------------------------------- +!----------------------------------------------------------------------- pi = 4.*atan(1.) lambm = lambm0 + (calday - ve)*2.*pi/dayspy @@ -67,3 +67,4 @@ FUNCTION orb_cosazi(calday, dlon, dlat, coszen) END FUNCTION orb_cosazi END MODULE MOD_OrbCosazi +! ---------- EOP ------------ diff --git a/main/MOD_OrbCoszen.F90 b/main/MOD_OrbCoszen.F90 index dd38a4a2..6859b469 100644 --- a/main/MOD_OrbCoszen.F90 +++ b/main/MOD_OrbCoszen.F90 @@ -34,12 +34,13 @@ FUNCTION orb_coszen(calday,dlon,dlat) USE MOD_Precision IMPLICIT NONE +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: calday !Julian cal day (1.xx to 365.xx) real(r8), intent(in) :: dlat !Centered latitude (radians) real(r8), intent(in) :: dlon !Centered longitude (radians) real(r8) :: orb_coszen - ! --- Local variables --- +!-------------------------- Local Variables ---------------------------- real(r8) declin !Solar declination (radians) real(r8) eccf !Earth-sun distance factor (ie. (1/r)**2) real(r8) lambm !Lambda m, mean long of perihelion (rad) @@ -56,7 +57,7 @@ FUNCTION orb_coszen(calday,dlon,dlat) lambm0=-3.2625366E-2, &!Mean long of perihelion at the vernal equinox (radians) mvelpp=4.92251015 !moving vernal equinox longitude of !perihelion plus pi (radians) - !--------------------------------------------------------------------- +!----------------------------------------------------------------------- pi = 4.*atan(1.) lambm = lambm0 + (calday - ve)*2.*pi/dayspy @@ -76,3 +77,4 @@ FUNCTION orb_coszen(calday,dlon,dlat) END FUNCTION orb_coszen END MODULE MOD_OrbCoszen +! ---------- EOP ------------ diff --git a/main/MOD_Ozone.F90 b/main/MOD_Ozone.F90 index 02c4fc82..d650a1d5 100644 --- a/main/MOD_Ozone.F90 +++ b/main/MOD_Ozone.F90 @@ -290,3 +290,4 @@ SUBROUTINE update_ozone_data (time, deltim) END SUBROUTINE update_ozone_data END MODULE MOD_Ozone +! ---------- EOP ------------ diff --git a/main/MOD_PhaseChange.F90 b/main/MOD_PhaseChange.F90 index e9a9cd30..7465ad14 100644 --- a/main/MOD_PhaseChange.F90 +++ b/main/MOD_PhaseChange.F90 @@ -58,7 +58,7 @@ SUBROUTINE meltf (patchtype,is_dry_lake,lb,nl_soil,deltim, & USE MOD_Namelist IMPLICIT NONE -!----------------------------------------------------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: patchtype !land patch type (0=soil,1=urban or built-up,2=wetland, !3=land ice, 4=deep lake, 5=shallow lake) @@ -99,7 +99,7 @@ SUBROUTINE meltf (patchtype,is_dry_lake,lb,nl_soil,deltim, & real(r8), intent(out) :: xmf !total latent heat of phase change integer, intent(out) :: imelt(lb:nl_soil) !flag for melting or freezing [-] -! Local +!-------------------------- Local Variables ---------------------------- real(r8) :: hm(lb:nl_soil) !energy residual [W/m2] real(r8) :: xm(lb:nl_soil) !melting or freezing within a time step [kg/m2] real(r8) :: heatr !energy residual or loss after melting or freezing @@ -358,7 +358,7 @@ SUBROUTINE meltf_snicar (patchtype,is_dry_lake,lb,nl_soil,deltim, & USE MOD_Namelist IMPLICIT NONE -!----------------------------------------------------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: patchtype !land patch type (0=soil,1=urban or built-up,2=wetland, !3=land ice, 4=deep lake, 5=shallow lake) @@ -400,7 +400,7 @@ SUBROUTINE meltf_snicar (patchtype,is_dry_lake,lb,nl_soil,deltim, & real(r8), intent(out) :: xmf !total latent heat of phase change integer, intent(out) :: imelt(lb:nl_soil) !flag for melting or freezing [-] -! Local +!-------------------------- Local Variables ---------------------------- real(r8) :: hm(lb:nl_soil) !energy residual [W/m2] real(r8) :: xm(lb:nl_soil) !melting or freezing within a time step [kg/m2] real(r8) :: heatr !energy residual or loss after melting or freezing @@ -655,7 +655,7 @@ SUBROUTINE meltf_urban (lb,nl_soil,deltim, & USE MOD_Const_Physical, only : tfrz, hfus IMPLICIT NONE -!----------------------------------------------------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: nl_soil !upper bound of array (i.e., soil layers) integer, intent(in) :: lb !lower bound of array (i.e., snl +1) @@ -676,7 +676,7 @@ SUBROUTINE meltf_urban (lb,nl_soil,deltim, & real(r8), intent(out) :: xmf !total latent heat of phase change integer, intent(out) :: imelt(lb:nl_soil) !flag for melting or freezing [-] -! Local +!-------------------------- Local Variables ---------------------------- real(r8) :: hm(lb:nl_soil) !energy residual [W/m2] real(r8) :: xm(lb:nl_soil) !melting or freezing within a time step [kg/m2] real(r8) :: heatr !energy residual or loss after melting or freezing @@ -817,3 +817,4 @@ SUBROUTINE meltf_urban (lb,nl_soil,deltim, & END SUBROUTINE meltf_urban END MODULE MOD_PhaseChange +! ---------- EOP ------------ diff --git a/main/MOD_PlantHydraulic.F90 b/main/MOD_PlantHydraulic.F90 index 8260a949..ba8014b5 100644 --- a/main/MOD_PlantHydraulic.F90 +++ b/main/MOD_PlantHydraulic.F90 @@ -47,6 +47,7 @@ SUBROUTINE PlantHydraulicStress_twoleaf (nl_soil ,nvegwcs ,z_soi ,& USE MOD_Precision IMPLICIT NONE +!-------------------------- Dummy Arguments ---------------------------- integer ,intent(in) :: nl_soil ! upper bound of array integer ,intent(in) :: nvegwcs ! upper bound of array real(r8),intent(in), dimension(nl_soil) :: & @@ -60,7 +61,7 @@ SUBROUTINE PlantHydraulicStress_twoleaf (nl_soil ,nvegwcs ,z_soi ,& real(r8),intent(in) :: & rss, &! soil surface resistance [s/m] - psrf, & ! surface atmospheric pressure (pa) + psrf, &! surface atmospheric pressure (pa) qg, &! specific humidity at ground surface [kg/kg] qm ! specific humidity at reference height [kg/kg] @@ -117,9 +118,7 @@ SUBROUTINE PlantHydraulicStress_twoleaf (nl_soil ,nvegwcs ,z_soi ,& real(r8),intent(inout) :: gssun ! sunlit leaf conductance real(r8),intent(inout) :: gssha ! shaded leaf conductance - - -!-------------------- local -------------------------------------------- +!-------------------------- Local Variables ---------------------------- integer, parameter :: iterationtotal = 6 @@ -1086,4 +1085,4 @@ END FUNCTION d1plc END MODULE MOD_PlantHydraulic -! -------------- EOP --------------- +! ---------- EOP ------------ diff --git a/main/MOD_Qsadv.F90 b/main/MOD_Qsadv.F90 index 41e8a2e7..8ebb555b 100644 --- a/main/MOD_Qsadv.F90 +++ b/main/MOD_Qsadv.F90 @@ -32,7 +32,7 @@ SUBROUTINE qsadv(T,p,es,esdT,qs,qsdT) USE MOD_Precision IMPLICIT NONE -! dummy arguments +! ------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: T ! temperature (K) real(r8), intent(in) :: p ! surface atmospheric pressure (pa) @@ -41,7 +41,7 @@ SUBROUTINE qsadv(T,p,es,esdT,qs,qsdT) real(r8), intent(out) :: qs ! humidity (kg/kg) real(r8), intent(out) :: qsdT ! d(qs)/d(T) -! local +!-------------------------- Local Variables ---------------------------- real(r8) td,vp,vp1,vp2 real(r8) a0,a1,a2,a3,a4,a5,a6,a7,a8 real(r8) b0,b1,b2,b3,b4,b5,b6,b7,b8 @@ -69,7 +69,7 @@ SUBROUTINE qsadv(T,p,es,esdT,qs,qsdT) ,d3/0.249468427e-04/,d4/0.313703411e-06/,d5/0.257180651e-08/ & ,d6/0.133268878e-10/,d7/0.394116744e-13/,d8/0.498070196e-16/ -!======================================================================= +!----------------------------------------------------------------------- td = T-273.16 @@ -105,3 +105,4 @@ SUBROUTINE qsadv(T,p,es,esdT,qs,qsdT) END SUBROUTINE qsadv END MODULE MOD_Qsadv +! ---------- EOP ------------ diff --git a/main/MOD_RainSnowTemp.F90 b/main/MOD_RainSnowTemp.F90 index f7bc0775..85a268b7 100644 --- a/main/MOD_RainSnowTemp.F90 +++ b/main/MOD_RainSnowTemp.F90 @@ -34,7 +34,7 @@ SUBROUTINE rain_snow_temp (patchtype,& IMPLICIT NONE -! ------------------------ Dummy Argument ------------------------------ +! ------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: patchtype ! land patch type (3=glaciers) real(r8), intent(in) :: forc_t ! temperature at agcm reference height [kelvin] @@ -54,7 +54,7 @@ SUBROUTINE rain_snow_temp (patchtype,& real(r8), intent(out) :: t_precip ! snowfall/rainfall temperature [kelvin] real(r8), intent(out) :: bifall ! bulk density of newly fallen dry snow [kg/m3] - ! local variables +!-------------------------- Local Variables ---------------------------- real(r8) :: flfall ! fraction of liquid water within falling precip. real(r8) :: all_snow_t ! temperature at which all precip falls entirely as snow (K) diff --git a/main/MOD_Runoff.F90 b/main/MOD_Runoff.F90 index c53e3519..83a3ffdf 100644 --- a/main/MOD_Runoff.F90 +++ b/main/MOD_Runoff.F90 @@ -36,7 +36,7 @@ SUBROUTINE SurfaceRunoff_SIMTOP (nl_soil,wimp,porsl,psi0,hksati,& IMPLICIT NONE -!-----------------------Arguments--------------------------------------- +! ------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: nl_soil ! number of soil layers real(r8), intent(in) :: & @@ -59,7 +59,7 @@ SUBROUTINE SurfaceRunoff_SIMTOP (nl_soil,wimp,porsl,psi0,hksati,& real(r8), intent(out), optional :: rsur_se! saturation excess surface runoff (mm h2o/s) real(r8), intent(out), optional :: rsur_ie! infiltration excess surface runoff (mm h2o/s) -!-----------------------Local Variables--------------------------------- +!-------------------------- Local Variables ---------------------------- real(r8) qinmax ! maximum infiltration capability real(r8) fsat ! fractional area with water table at surface @@ -67,7 +67,7 @@ SUBROUTINE SurfaceRunoff_SIMTOP (nl_soil,wimp,porsl,psi0,hksati,& ! updated to gridded 'fsatdcf' (by Shupeng Zhang) ! real(r8), parameter :: fff = 0.5 ! runoff decay factor (m-1) -!-----------------------END Variable List------------------------------- +!----------------------------------------------------------------------- ! fraction of saturated area (updated to gridded 'fsatmax' and 'fsatdcf') !fsat = wtfact*min(1.0,exp(-0.5*fff*zwt)) @@ -93,9 +93,9 @@ END SUBROUTINE SurfaceRunoff_SIMTOP ! ------------------------------------------------------------------------- SUBROUTINE SubsurfaceRunoff_SIMTOP (nl_soil, icefrac, dz_soisno, zi_soisno, zwt, rsubst) -! ARGUMENTS: IMPLICIT NONE +! ------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: nl_soil ! real(r8), intent(in) :: icefrac(1:nl_soil) ! ice fraction (-) @@ -105,7 +105,7 @@ SUBROUTINE SubsurfaceRunoff_SIMTOP (nl_soil, icefrac, dz_soisno, zi_soisno, zwt, real(r8), intent(in) :: zwt ! the depth from ground (soil) surface to water table [m] real(r8), intent(out) :: rsubst ! subsurface runoff (positive = out of soil column) (mm H2O /s) -! LOCAL ARGUMENTS +!-------------------------- Local Variables ---------------------------- integer :: j ! indices integer :: jwt ! index of the soil layer right above the water table (-) @@ -115,6 +115,7 @@ SUBROUTINE SubsurfaceRunoff_SIMTOP (nl_soil, icefrac, dz_soisno, zi_soisno, zwt, real(r8) :: icefracsum real(r8) :: fracice_rsub real(r8) :: imped +!----------------------------------------------------------------------- DO j = 1,nl_soil dzmm(j) = dz_soisno(j)*1000. @@ -263,4 +264,4 @@ SUBROUTINE Runoff_SimpleVIC ( & END SUBROUTINE Runoff_SimpleVIC END MODULE MOD_Runoff -! --------- EOP ---------- +! ---------- EOP ------------ diff --git a/main/MOD_SimpleOcean.F90 b/main/MOD_SimpleOcean.F90 index d162749d..e2caac1c 100644 --- a/main/MOD_SimpleOcean.F90 +++ b/main/MOD_SimpleOcean.F90 @@ -39,7 +39,7 @@ SUBROUTINE socean (dosst,deltim,oro,hu,ht,hq,& USE MOD_Const_Physical, only : tfrz, hvap, hsub, stefnc, vonkar IMPLICIT NONE -!------------------------------Arguments-------------------------------- +! ------------------------- Dummy Arguments ---------------------------- integer, parameter :: psrfty=7 ! Number of surface types integer, parameter :: plsice=4 ! number of seaice levels @@ -85,7 +85,7 @@ SUBROUTINE socean (dosst,deltim,oro,hu,ht,hq,& real(r8), intent(out) :: emis ! averaged bulk surface emissivity real(r8), intent(out) :: olrg ! longwave up flux at surface [W/m2] -!----------------------------------------------------------------------- +!-------------------------- Local Variables ---------------------------- integer isrfty ! surface type index (1-7) real(r8) cgrndl ! deriv, of soil sensible heat flux wrt soil temp [w/m2/k] real(r8) cgrnds ! deriv of soil latent heat flux wrt soil temp [w/m**2/k] @@ -199,7 +199,7 @@ SUBROUTINE seafluxes (oro,hu,ht,hq,& USE MOD_Qsadv IMPLICIT NONE -!----------------------- Dummy argument -------------------------------- +! ------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: & oro, &! ocean(0)/seaice(2)/ flag @@ -239,7 +239,7 @@ SUBROUTINE seafluxes (oro,hu,ht,hq,& cgrndl, &! deriv, of soil sensible heat flux wrt soil temp [w/m2/k] cgrnds ! deriv of soil latent heat flux wrt soil temp [w/m**2/k] -!------------------------ LOCAL VARIABLES ------------------------------ +!-------------------------- Local Variables ---------------------------- integer i integer niters,&! maximum number of iterations for surface temperature iter, &! iteration index @@ -440,7 +440,7 @@ SUBROUTINE srftsb(isrfty,deltim,fnt,dfntdt,snowh,tsbsf) USE MOD_Utils IMPLICIT NONE -!------------------------------Arguments-------------------------------- +! ------------------------- Dummy Arguments ---------------------------- integer, parameter :: psrfty = 7 ! Number of surface types integer, parameter :: plsice = 4 ! number of seaice levels @@ -453,7 +453,7 @@ SUBROUTINE srftsb(isrfty,deltim,fnt,dfntdt,snowh,tsbsf) real(r8), intent(inout) :: tsbsf(1:plsice) ! surface/sub-surface tmps -!---------------------------Local variables----------------------------- +!-------------------------- Local Variables ---------------------------- integer :: j, jndx ! sub-surface layer index @@ -677,3 +677,4 @@ SUBROUTINE srftsb(isrfty,deltim,fnt,dfntdt,snowh,tsbsf) END SUBROUTINE srftsb END MODULE MOD_SimpleOcean +! ---------- EOP ------------ diff --git a/main/MOD_SnowFraction.F90 b/main/MOD_SnowFraction.F90 index 183f3a8e..eecbd9af 100644 --- a/main/MOD_SnowFraction.F90 +++ b/main/MOD_SnowFraction.F90 @@ -37,7 +37,7 @@ SUBROUTINE snowfraction (lai,sai,z0m,zlnd,scv,snowdp,wt,sigf,fsno) USE MOD_Precision IMPLICIT NONE -! dummy arguments +! ------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: scv ! snow water equivalent [mm or kg/m3] real(r8), intent(in) :: snowdp ! snow depth [m] real(r8), intent(in) :: z0m ! aerodynamic roughness length [m] @@ -49,10 +49,12 @@ SUBROUTINE snowfraction (lai,sai,z0m,zlnd,scv,snowdp,wt,sigf,fsno) real(r8), intent(out) :: sigf ! fraction of veg cover, excluding snow-covered veg [-] real(r8), intent(out) :: fsno ! fraction of soil covered by snow [-] +!-------------------------- Local Variables ---------------------------- real(r8) :: fmelt ! dimensionless melting factor real(r8), parameter :: m = 1.0 ! the value of m used in CLM4.5 is 1.0. ! WHILE the value of m given by Niu et al (2007) is 1.6 ! WHILE Niu (2012) suggested 3.0 + !----------------------------------------------------------------------- IF(lai+sai > 1e-6) THEN ! Fraction of vegetation buried (covered) by snow @@ -100,7 +102,7 @@ SUBROUTINE snowfraction_pftwrap (ipatch,zlnd,scv,snowdp,wt,sigf,fsno) USE MOD_Vars_PFTimeVariables IMPLICIT NONE -! dummy arguments +! ------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: ipatch ! patch index real(r8), intent(in) :: zlnd ! aerodynamic roughness length over soil surface [m] @@ -111,15 +113,15 @@ SUBROUTINE snowfraction_pftwrap (ipatch,zlnd,scv,snowdp,wt,sigf,fsno) real(r8), intent(out) :: sigf ! fraction of veg cover, excluding snow-covered veg [-] real(r8), intent(out) :: fsno ! fraction of soil covered by snow [-] +!-------------------------- Local Variables ---------------------------- real(r8) :: fmelt ! dimensionless melting factor real(r8), parameter :: m = 1.0 ! the value of m used in CLM4.5 is 1.0. ! WHILE the value of m given by Niu et al (2007) is 1.6 ! WHILE Niu (2012) suggested 3.0 -!----------------------------------------------------------------------- - ! local variables integer i, p, ps, pe real(r8) wt_tmp +!----------------------------------------------------------------------- wt_tmp = 0. ps = patch_pft_s(ipatch) @@ -167,3 +169,4 @@ END SUBROUTINE snowfraction_pftwrap #endif END MODULE MOD_SnowFraction +! ---------- EOP ------------ diff --git a/main/MOD_SnowLayersCombineDivide.F90 b/main/MOD_SnowLayersCombineDivide.F90 index ee447e66..8767640e 100644 --- a/main/MOD_SnowLayersCombineDivide.F90 +++ b/main/MOD_SnowLayersCombineDivide.F90 @@ -49,7 +49,7 @@ SUBROUTINE snowcompaction (lb,deltim,imelt,fiold,& USE MOD_Const_Physical, only : denice, denh2o, tfrz IMPLICIT NONE -!-------------------------- Dummy argument ----------------------------- +! ------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: lb ! lower bound of array real(r8), intent(in) :: deltim ! seconds i a time step [second] @@ -64,7 +64,7 @@ SUBROUTINE snowcompaction (lb,deltim,imelt,fiold,& real(r8), intent(inout) :: dz_soisno(lb:0) ! layer thickness [m] -!----------------------- local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- integer j ! Numeber of doing loop real(r8), parameter :: c1 = 2.777e-7 ! [m2/(kg s)] @@ -97,7 +97,7 @@ SUBROUTINE snowcompaction (lb,deltim,imelt,fiold,& ! (only valid IF wind_dependent_snow_density is .true.) real(r8) :: f1, f2, eta, forc_wind -!======================================================================= +!----------------------------------------------------------------------- ! Begin calculation - note that the following column loops are only invoked IF lb < 0 burden = 0.0 @@ -257,7 +257,7 @@ SUBROUTINE snowlayerscombine (lb,snl, & USE MOD_Precision IMPLICIT NONE -!-------------------------- Dummy argument ----------------------------- +! ------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: lb ! lower bound of array ! numbering from 1 (bottom) mss (surface) @@ -271,7 +271,7 @@ SUBROUTINE snowlayerscombine (lb,snl, & real(r8), intent(inout) :: scv ! snow mass - water equivalent [kg/m2] integer, intent(inout) :: snl ! Number of snow -!----------------------- Local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- real(r8) :: drr ! thickness of the combined [m] real(r8) :: dzmin(5) ! minimum of snow layer 1 (top) to msn0 (bottom) real(r8) :: zwice ! total ice mass in snow @@ -431,7 +431,7 @@ SUBROUTINE snowlayersdivide (lb,snl,z_soisno,dz_soisno,zi_soisno,wliq_soisno,wic USE MOD_Precision IMPLICIT NONE -!-------------------------- Dummy argument ----------------------------- +! ------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: lb ! lower bound of array integer, intent(inout) :: snl ! Number of snow @@ -442,7 +442,7 @@ SUBROUTINE snowlayersdivide (lb,snl,z_soisno,dz_soisno,zi_soisno,wliq_soisno,wic real(r8), intent(inout) :: z_soisno (lb:0) ! Node depth [m] real(r8), intent(inout) :: zi_soisno (lb-1:0) ! Depth of layer interface [m] -!----------------------- Local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- ! numbering from 1 (surface) msno (bottom) real(r8) :: drr ! thickness of the combined [m] @@ -637,7 +637,7 @@ SUBROUTINE combo ( dz_soisno, wliq_soisno, wice_soisno, t, & USE MOD_Const_Physical, only : cpice, cpliq, hfus, tfrz IMPLICIT NONE -!-------------------------- Dummy argument ----------------------------- +! ------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: dz2 ! nodal thickness of 2 elements being combined [m] real(r8), intent(in) :: wliq2 ! liquid water of element 2 [kg/m2] @@ -649,7 +649,7 @@ SUBROUTINE combo ( dz_soisno, wliq_soisno, wice_soisno, t, & real(r8), intent(inout) :: wice_soisno ! ice of element 1 [kg/m2] real(r8), intent(inout) :: t ! node temperature of elment 1 [K] -!----------------------- Local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- real(r8) dzc ! Total thickness of nodes 1 and 2 (dzc=dz_soisno+dz2). real(r8) wliqc ! Combined liquid water [kg/m2] @@ -707,7 +707,7 @@ SUBROUTINE SnowLayersCombine_snicar (lb,snl, & IMPLICIT NONE -!-------------------------- Dummy argument ----------------------------- +! ------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: lb ! lower bound of array ! numbering from 1 (bottom) mss (surface) @@ -733,7 +733,7 @@ SUBROUTINE SnowLayersCombine_snicar (lb,snl, & mss_dst4 (lb:0) ! mass of dust species 4 in snow (col,lyr) [kg] ! Aerosol Fluxes (Jan. 07, 2023) -!----------------------- Local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- real(r8) :: drr ! thickness of the combined [m] real(r8) :: dzmin(5) ! minimum of snow layer 1 (top) to msn0 (bottom) real(r8) :: zwice ! total ice mass in snow @@ -973,7 +973,7 @@ SUBROUTINE SnowLayersDivide_snicar (lb,snl,z_soisno,dz_soisno,zi_soisno,& IMPLICIT NONE -!-------------------------- Dummy argument ----------------------------- +! ------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: lb ! lower bound of array integer, intent(inout) :: snl ! Number of snow @@ -996,7 +996,7 @@ SUBROUTINE SnowLayersDivide_snicar (lb,snl,z_soisno,dz_soisno,zi_soisno,& mss_dst4 (lb:0) ! mass of dust species 4 in snow (col,lyr) [kg] ! Aerosol Fluxes (Jan. 07, 2023) -!----------------------- Local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- ! numbering from 1 (surface) msno (bottom) real(r8) :: drr ! thickness of the combined [m] @@ -1276,7 +1276,6 @@ SUBROUTINE SnowLayersDivide_snicar (lb,snl,z_soisno,dz_soisno,zi_soisno,& ENDDO END SUBROUTINE SnowLayersDivide_snicar -!----------------------------------------------------------------------- - END MODULE MOD_SnowLayersCombineDivide +! ---------- EOP ------------ diff --git a/main/MOD_SnowSnicar.F90 b/main/MOD_SnowSnicar.F90 index 063a6c72..93695663 100644 --- a/main/MOD_SnowSnicar.F90 +++ b/main/MOD_SnowSnicar.F90 @@ -2992,3 +2992,4 @@ real(r8) FUNCTION FreshSnowRadius (forc_t) END FUNCTION FreshSnowRadius END MODULE MOD_SnowSnicar +! ---------- EOP ------------ diff --git a/main/MOD_SoilSnowHydrology.F90 b/main/MOD_SoilSnowHydrology.F90 index 35f28888..9ef2f30e 100644 --- a/main/MOD_SoilSnowHydrology.F90 +++ b/main/MOD_SoilSnowHydrology.F90 @@ -81,7 +81,7 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& IMPLICIT NONE -!-----------------------Argument---------- ------------------------------ +! ------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & ipatch ,&! patch index patchtype ! land patch type (0=soil, 1=urban or built-up, 2=wetland, @@ -172,8 +172,8 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& ! Aerosol Fluxes (Jan. 07, 2023) ! END SNICAR model variables -!-----------------------Local Variables------------------------------ -! +!-------------------------- Local Variables ---------------------------- + integer j ! loop counter real(r8) :: & @@ -202,7 +202,6 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& real(r8) :: qflx_irrig_paddy #endif - ! ** real(r8) :: wliq_soisno_tmp(1:nl_soil) !======================================================================= @@ -534,7 +533,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& IMPLICIT NONE -!-----------------------Argument---------- ------------------------------ +! ------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & ipatch ,& ! patch index patchtype ! land patch type (0=soil, 1=urban or built-up, 2=wetland, @@ -634,8 +633,8 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& ! Aerosol Fluxes (Jan. 07, 2023) ! END SNICAR model variables -!-----------------------Local Variables------------------------------ -! +!-------------------------- Local Variables ---------------------------- + integer j ! loop counter real(r8) :: & @@ -1159,7 +1158,7 @@ SUBROUTINE snowwater (lb,deltim,ssi,wimp, & USE MOD_Const_Physical, only : denice, denh2o ! physical constant IMPLICIT NONE -!----------------------- dummy argument -------------------------------- +! ------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & lb ! lower bound of array @@ -1182,7 +1181,7 @@ SUBROUTINE snowwater (lb,deltim,ssi,wimp, & real(r8), intent(out) :: & qout_snowb ! rate of water out of snow bottom (mm/s) -!----------------------- local variables -------------------------------- +!-------------------------- Local Variables ---------------------------- integer j ! k do loop/array indices real(r8) :: & @@ -1285,7 +1284,7 @@ SUBROUTINE SnowWater_snicar (lb,deltim,ssi,wimp, & real(r8), parameter :: denice = 917.0_r8 ! density of ice [kg/m3] real(r8), parameter :: denh2o = 1000.0_r8 ! density of liquid water [kg/m3] -!----------------------- dummy argument -------------------------------- +! ------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & lb ! lower bound of array @@ -1322,7 +1321,7 @@ SUBROUTINE SnowWater_snicar (lb,deltim,ssi,wimp, & mss_dst4 (lb:0) ! mass of dust species 4 in snow (col,lyr) [kg] ! Aerosol Fluxes (Jan. 07, 2023) -!----------------------- local variables -------------------------------- +!-------------------------- Local Variables ---------------------------- integer j ! do loop/array indices real(r8) :: & @@ -1769,11 +1768,12 @@ SUBROUTINE soilwater(patchtype,nl_soil,deltim,wimp,smpmin,& ! !----------------------------------------------------------------------- USE MOD_Precision - USE MOD_Const_Physical , only : grav,hfus,tfrz,denh2o,denice + USE MOD_Const_Physical, only: grav,hfus,tfrz,denh2o,denice USE MOD_Utils IMPLICIT NONE +! ------------------------- Dummy Arguments ---------------------------- integer , intent(in) :: patchtype ! land patch type integer , intent(in) :: nl_soil ! number of soil layers real(r8), intent(in) :: deltim ! land model time step (sec) @@ -1806,9 +1806,8 @@ SUBROUTINE soilwater(patchtype,nl_soil,deltim,wimp,smpmin,& real(r8), intent(out) :: smp(1:nl_soil) ! soil matrix potential [mm] real(r8), intent(out) :: hk (1:nl_soil) ! hydraulic conductivity [mm h2o/s] -! -! local arguments -! +!-------------------------- Local Variables ---------------------------- + integer :: j ! do loop indices real(r8) :: amx(1:nl_soil) ! "a" left off diagonal of tridiagonal matrix real(r8) :: bmx(1:nl_soil) ! "b" diagonal column for tridiagonal matrix @@ -2071,10 +2070,9 @@ SUBROUTINE groundwater (nl_soil,deltim,pondmx,& USE MOD_Precision USE MOD_Const_Physical, only : tfrz -! -! ARGUMENTS: IMPLICIT NONE +! ------------------------- Dummy Arguments ---------------------------- integer , intent(in) :: nl_soil ! real(r8), intent(in) :: deltim ! land model time step (sec) real(r8), intent(in) :: pondmx ! @@ -2096,10 +2094,7 @@ SUBROUTINE groundwater (nl_soil,deltim,pondmx,& real(r8), intent(in) :: qcharge ! aquifer recharge rate (positive to aquifer) (mm/s) real(r8), intent(inout) :: rsubst ! subsurface runoff (positive = out of soil column) (mm H2O /s) -! -! LOCAL ARGUMENTS -! - +!-------------------------- Local Variables ---------------------------- integer :: j ! indices integer :: jwt ! index of the soil layer right above the water table (-) real(r8) :: xs ! water needed to bring soil moisture to watmin (mm) @@ -2131,10 +2126,9 @@ SUBROUTINE groundwater (nl_soil,deltim,pondmx,& real(r8), parameter :: rsbmx = 5.0 ! baseflow coefficient [mm/s] real(r8), parameter :: timean = 10.5 ! global mean topographic index - ! ------------------------------------------------------------------------- -! ! Convert layer thicknesses from m to mm +! ! Convert layer thicknesses from m to mm DO j = 1,nl_soil dzmm(j) = dz_soisno(j)*1000. @@ -2366,4 +2360,4 @@ END SUBROUTINE groundwater END MODULE MOD_SoilSnowHydrology -! --------- EOP ---------- +! ---------- EOP ------------ diff --git a/main/MOD_SoilSurfaceResistance.F90 b/main/MOD_SoilSurfaceResistance.F90 index 7fa703de..f523ebeb 100644 --- a/main/MOD_SoilSurfaceResistance.F90 +++ b/main/MOD_SoilSurfaceResistance.F90 @@ -65,9 +65,7 @@ SUBROUTINE SoilSurfaceResistance (nl_soil,forc_rhoair,hksati,porsl,psi0, & USE MOD_Hydro_SoilFunction IMPLICIT NONE - -!-----------------------Argument----------------------------------------- - +! ------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & nl_soil ! upper bound of array @@ -97,7 +95,7 @@ SUBROUTINE SoilSurfaceResistance (nl_soil,forc_rhoair,hksati,porsl,psi0, & real(r8), intent(out) :: & rss ! soil surface resistance [s/m] -!-----------------------Local Variables------------------------------ +!-------------------------- Local Variables ---------------------------- REAL(r8) :: & wx, &! partial volume of ice and water of surface layer @@ -124,8 +122,7 @@ SUBROUTINE SoilSurfaceResistance (nl_soil,forc_rhoair,hksati,porsl,psi0, & fac_fc, &! temporal variable for calculating wx/wfc B ! bunsen solubility coefficient -!-----------------------End Variables list--------------------------- - +!----------------------------------------------------------------------- ! calculate the top soil volumetric water content (m3/m3), soil matrix potential ! and soil hydraulic conductivity @@ -226,6 +223,7 @@ SUBROUTINE SoilSurfaceResistance (nl_soil,forc_rhoair,hksati,porsl,psi0, & SELECTCASE (DEF_RSS_SCHEME) +!----------------------------------------------------------------------- ! calculate rss by SL14 CASE (1) dsl = dz_soisno(1)*max(1.e-6_r8,(0.8*eff_porosity - vol_liq)) & @@ -238,6 +236,7 @@ SUBROUTINE SoilSurfaceResistance (nl_soil,forc_rhoair,hksati,porsl,psi0, & !fordebug only !write(*,*) dsl, dg, aird, vol_liq/porsl(1), eff_porosity, wice_soisno(1),vol_liq, rss +!----------------------------------------------------------------------- ! calculate rss by SZ09 CASE (2) dsl = dz_soisno(1)*(exp((1._r8 - vol_liq/porsl(1))**5) - 1._r8)/ (exp(1._r8) - 1._r8) @@ -246,6 +245,7 @@ SUBROUTINE SoilSurfaceResistance (nl_soil,forc_rhoair,hksati,porsl,psi0, & rss = dsl/dg +!----------------------------------------------------------------------- ! calculate rss by TR13 CASE (3) ! TR13, Eq. (11) and Eq. (12): @@ -256,6 +256,7 @@ SUBROUTINE SoilSurfaceResistance (nl_soil,forc_rhoair,hksati,porsl,psi0, & rss_1 = rg_1 + rw_1 rss = 1.0/rss_1 +!----------------------------------------------------------------------- ! LP92 beta scheme CASE (4) wx = (max(wliq_soisno(1),1.e-6)/denh2o+wice_soisno(1)/denice)/dz_soisno(1) @@ -280,6 +281,7 @@ SUBROUTINE SoilSurfaceResistance (nl_soil,forc_rhoair,hksati,porsl,psi0, & rss = 1._r8 ENDIF +!----------------------------------------------------------------------- ! Sellers, 1992 CASE (5) wx = (max(wliq_soisno(1),1.e-6)/denh2o+wice_soisno(1)/denice)/dz_soisno(1) @@ -290,6 +292,7 @@ SUBROUTINE SoilSurfaceResistance (nl_soil,forc_rhoair,hksati,porsl,psi0, & !for wet soil according to Noah-MP v5 ENDSELECT +!----------------------------------------------------------------------- ! account for snow fractional cover for rss IF (DEF_RSS_SCHEME .ne. 4) THEN ! with 1/rss = fsno/rss_snow + (1-fsno)/rss_soil, @@ -312,3 +315,4 @@ SUBROUTINE SoilSurfaceResistance (nl_soil,forc_rhoair,hksati,porsl,psi0, & END Subroutine SoilSurfaceResistance END MODULE MOD_SoilSurfaceResistance +! ---------- EOP ------------ diff --git a/main/MOD_Thermal.F90 b/main/MOD_Thermal.F90 index d60805dc..c2b3fc3d 100644 --- a/main/MOD_Thermal.F90 +++ b/main/MOD_Thermal.F90 @@ -133,7 +133,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , IMPLICIT NONE -!---------------------Argument------------------------------------------ +! ------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & ipatch, &! patch index @@ -361,7 +361,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , fh, &! integral of profile function for heat fq ! integral of profile function for moisture -!---------------------Local Variables----------------------------------- +!-------------------------- Local Variables ---------------------------- integer i,j diff --git a/main/MOD_TurbulenceLEddy.F90 b/main/MOD_TurbulenceLEddy.F90 index 3bbe0818..c9557006 100644 --- a/main/MOD_TurbulenceLEddy.F90 +++ b/main/MOD_TurbulenceLEddy.F90 @@ -46,7 +46,7 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & USE MOD_Const_Physical, only : vonkar IMPLICIT NONE -! ---------------------- dummy argument -------------------------------- +! ------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: hu ! observational height of wind [m] real(r8), intent(in) :: ht ! observational height of temperature [m] @@ -67,7 +67,7 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & real(r8), intent(out) :: fh ! integral of profile FUNCTION for heat real(r8), intent(out) :: fq ! integral of profile FUNCTION for moisture -!------------------------ local variables ------------------------------ +!-------------------------- Local Variables ---------------------------- real(r8) zldis ! reference height "minus" zero displacement height [m] real(r8) zetam, & @@ -463,4 +463,3 @@ END FUNCTION psi END MODULE MOD_TurbulenceLEddy ! --------- EOP ------------ - diff --git a/main/MOD_UserSpecifiedForcing.F90 b/main/MOD_UserSpecifiedForcing.F90 index 78367a4c..074dabec 100644 --- a/main/MOD_UserSpecifiedForcing.F90 +++ b/main/MOD_UserSpecifiedForcing.F90 @@ -868,4 +868,4 @@ SUBROUTINE metpreprocess(grid, forcn) END SUBROUTINE metpreprocess END MODULE MOD_UserSpecifiedForcing -! ----------- EOP --------------- +! ---------- EOP ------------ diff --git a/main/MOD_WetBulb.F90 b/main/MOD_WetBulb.F90 index edc56409..36ebf0a3 100644 --- a/main/MOD_WetBulb.F90 +++ b/main/MOD_WetBulb.F90 @@ -116,3 +116,4 @@ SUBROUTINE wetbulb(t,p,q,twc) END SUBROUTINE wetbulb END MODULE MOD_WetBulb +! ---------- EOP ------------ diff --git a/main/URBAN/CoLMMAIN_Urban.F90 b/main/URBAN/CoLMMAIN_Urban.F90 index e8a01b91..81e0ccb6 100644 --- a/main/URBAN/CoLMMAIN_Urban.F90 +++ b/main/URBAN/CoLMMAIN_Urban.F90 @@ -200,7 +200,7 @@ SUBROUTINE CoLMMAIN_Urban ( & IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & ipatch ,&! maximum number of snow layers idate(3) ,&! next time-step /year/julian day/second in a day/ diff --git a/main/URBAN/MOD_Urban_Albedo.F90 b/main/URBAN/MOD_Urban_Albedo.F90 index d6beaede..77908a80 100644 --- a/main/URBAN/MOD_Urban_Albedo.F90 +++ b/main/URBAN/MOD_Urban_Albedo.F90 @@ -68,7 +68,7 @@ SUBROUTINE alburban (ipatch,froof,fgper,flake,hlr,hroof,& IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- ! ground cover index integer, intent(in) :: & ipatch ! patch index diff --git a/main/URBAN/MOD_Urban_BEM.F90 b/main/URBAN/MOD_Urban_BEM.F90 index 9da791ec..6a616486 100644 --- a/main/URBAN/MOD_Urban_BEM.F90 +++ b/main/URBAN/MOD_Urban_BEM.F90 @@ -75,7 +75,7 @@ SUBROUTINE SimpleBEM (deltim, rhoair, fcover, H, troom_max, troom_min, & IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: & deltim, &! seconds in a time step [second] rhoair, &! density air [kg/m3] diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 00cb2b60..696e033f 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -115,7 +115,7 @@ SUBROUTINE UrbanOnlyFlux ( & USE MOD_UserSpecifiedForcing, only: HEIGHT_mode IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & ipatch, &! patch index [-] lbr, &! lower bound of array @@ -913,7 +913,7 @@ SUBROUTINE UrbanVegFlux ( & USE MOD_UserSpecifiedForcing, only: HEIGHT_mode IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & ipatch, &! patch index [-] lbr, &! lower bound of array diff --git a/main/URBAN/MOD_Urban_GroundFlux.F90 b/main/URBAN/MOD_Urban_GroundFlux.F90 index b88d28b3..b2d34953 100644 --- a/main/URBAN/MOD_Urban_GroundFlux.F90 +++ b/main/URBAN/MOD_Urban_GroundFlux.F90 @@ -34,7 +34,7 @@ SUBROUTINE UrbanGroundFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & USE MOD_FrictionVelocity IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer , intent(in) :: & lbi real(r8), intent(in) :: & diff --git a/main/URBAN/MOD_Urban_Hydrology.F90 b/main/URBAN/MOD_Urban_Hydrology.F90 index a2788efc..8f224560 100644 --- a/main/URBAN/MOD_Urban_Hydrology.F90 +++ b/main/URBAN/MOD_Urban_Hydrology.F90 @@ -91,7 +91,7 @@ SUBROUTINE UrbanHydrology ( & IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & ipatch ,&! patch index patchtype ,&! land patch type (0=soil, 1=urban or built-up, 2=wetland, diff --git a/main/URBAN/MOD_Urban_ImperviousTemperature.F90 b/main/URBAN/MOD_Urban_ImperviousTemperature.F90 index 6a29b556..8bf54bd0 100644 --- a/main/URBAN/MOD_Urban_ImperviousTemperature.F90 +++ b/main/URBAN/MOD_Urban_ImperviousTemperature.F90 @@ -69,7 +69,7 @@ SUBROUTINE UrbanImperviousTem (patchtype,lb,deltim, & IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: lb !lower bound of array integer, intent(in) :: patchtype !land patch type (0=soil,1=urban or built-up,2=wetland, !3=land ice, 4=deep lake, 5=shallow lake) diff --git a/main/URBAN/MOD_Urban_LUCY.F90 b/main/URBAN/MOD_Urban_LUCY.F90 index 27f865b3..9d2003f4 100644 --- a/main/URBAN/MOD_Urban_LUCY.F90 +++ b/main/URBAN/MOD_Urban_LUCY.F90 @@ -44,7 +44,7 @@ SUBROUTINE LUCY( idate , deltim , patchlonr, fix_holiday, & ! ----------------------------------------------------------------------- IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer , intent(in) :: & idate(3) ! calendar (year, julian day, seconds) diff --git a/main/URBAN/MOD_Urban_Longwave.F90 b/main/URBAN/MOD_Urban_Longwave.F90 index d86e0523..3e716490 100644 --- a/main/URBAN/MOD_Urban_Longwave.F90 +++ b/main/URBAN/MOD_Urban_Longwave.F90 @@ -61,7 +61,7 @@ SUBROUTINE UrbanOnlyLongwave (theta, HL, fb, fgper, H, LW, & IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: & theta, &! Sun zenith angle [radian] HL, &! Ratio of building height to ground width [-] @@ -278,7 +278,7 @@ SUBROUTINE UrbanVegLongwave (theta, HL, fb, fgper, H, LW, & IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: & theta, &! Sun zenith angle [radian] HL, &! Ratio of building height to ground width [-] diff --git a/main/URBAN/MOD_Urban_NetSolar.F90 b/main/URBAN/MOD_Urban_NetSolar.F90 index 06d634ca..2992510f 100644 --- a/main/URBAN/MOD_Urban_NetSolar.F90 +++ b/main/URBAN/MOD_Urban_NetSolar.F90 @@ -32,7 +32,7 @@ SUBROUTINE netsolar_urban (ipatch,idate,dlon,deltim,& USE MOD_TimeManager, only: isgreenwich IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: ipatch ! patch index integer, intent(in) :: idate(3) ! model time diff --git a/main/URBAN/MOD_Urban_PerviousTemperature.F90 b/main/URBAN/MOD_Urban_PerviousTemperature.F90 index b2d3846b..89e3b4e0 100644 --- a/main/URBAN/MOD_Urban_PerviousTemperature.F90 +++ b/main/URBAN/MOD_Urban_PerviousTemperature.F90 @@ -75,7 +75,7 @@ SUBROUTINE UrbanPerviousTem (patchtype,lb,deltim, & IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: lb !lower bound of array integer, intent(in) :: patchtype !land patch type (0=soil,1=urban or built-up,2=wetland, !3=land ice, 4=deep lake, 5=shallow lake) diff --git a/main/URBAN/MOD_Urban_RoofTemperature.F90 b/main/URBAN/MOD_Urban_RoofTemperature.F90 index 0fc5bdea..1d123021 100644 --- a/main/URBAN/MOD_Urban_RoofTemperature.F90 +++ b/main/URBAN/MOD_Urban_RoofTemperature.F90 @@ -67,7 +67,7 @@ SUBROUTINE UrbanRoofTem (lb,deltim,capr,cnfac,& IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer , intent(in) :: lb !lower bound of array real(r8), intent(in) :: deltim !seconds in a time step [second] real(r8), intent(in) :: capr !tuning factor to turn first layer T into surface T diff --git a/main/URBAN/MOD_Urban_Shortwave.F90 b/main/URBAN/MOD_Urban_Shortwave.F90 index 8accc23e..0a3946b2 100644 --- a/main/URBAN/MOD_Urban_Shortwave.F90 +++ b/main/URBAN/MOD_Urban_Shortwave.F90 @@ -61,7 +61,7 @@ SUBROUTINE UrbanOnlyShortwave ( theta, HL, fb, fgper, H, & IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: & theta, &! Sun zenith angle [radian] HL, &! Ratio of building height to their side length [-] @@ -301,7 +301,7 @@ SUBROUTINE UrbanVegShortwave ( theta, HL, fb, fgper, H, & IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: & theta, &! Sun zenith angle [radian] HL, &! Ratio of building height to their side length [-] diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index d59b57b6..fcfc90ef 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -130,7 +130,7 @@ SUBROUTINE UrbanTHERMAL ( & IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & idate(3) ,& ipatch ,&! patch index diff --git a/main/URBAN/MOD_Urban_WallTemperature.F90 b/main/URBAN/MOD_Urban_WallTemperature.F90 index 125b4075..9b3e0f11 100644 --- a/main/URBAN/MOD_Urban_WallTemperature.F90 +++ b/main/URBAN/MOD_Urban_WallTemperature.F90 @@ -68,7 +68,7 @@ SUBROUTINE UrbanWallTem (deltim,capr,cnfac,& IMPLICIT NONE -!------------------------- Dummy Arguments ----------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: deltim !seconds in a time step [second] real(r8), intent(in) :: capr !tuning factor to turn first layer T into surface T real(r8), intent(in) :: cnfac !Crank Nicholson factor between 0 and 1 From 4f2290243ca6ff9013fb8ed980b47da47f6240ab Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Sun, 9 Feb 2025 19:38:44 +0800 Subject: [PATCH 28/43] bug fixed of fsatdcf in CoLMDRIVER.F90 --- main/CoLMDRIVER.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/CoLMDRIVER.F90 b/main/CoLMDRIVER.F90 index 2f21e305..9cd68edd 100644 --- a/main/CoLMDRIVER.F90 +++ b/main/CoLMDRIVER.F90 @@ -87,7 +87,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) soil_s_v_alb(i), soil_d_v_alb(i), soil_s_n_alb(i), soil_d_n_alb(i), & vf_quartz(1:,i), vf_gravels(1:,i),vf_om(1:,i), vf_sand(1:,i), & wf_gravels(1:,i),wf_sand(1:,i), porsl(1:,i), psi0(1:,i), & - bsw(1:,i), theta_r(1:,i), fsatmax(i), fsatdcf(:), & + bsw(1:,i), theta_r(1:,i), fsatmax(i), fsatdcf(i), & #ifdef vanGenuchten_Mualem_SOIL_MODEL alpha_vgm(1:,i), n_vgm(1:,i), L_vgm(1:,i), & sc_vgm(1:,i), fc_vgm(1:,i), & From 70b5955ff5c6fa9841923f4f4295d80e9c5f3c7f Mon Sep 17 00:00:00 2001 From: weinan123 Date: Sun, 9 Feb 2025 19:39:16 +0800 Subject: [PATCH 29/43] Add vf_clay as a global variable required by land assimulation --- main/MOD_Vars_TimeInvariants.F90 | 6 ++ mkinidata/MOD_SoilParametersReadin.F90 | 12 +++ mksrfdata/Aggregation_SoilParameters.F90 | 119 ++++++++++++++++++----- mksrfdata/MOD_RegionClip.F90 | 6 ++ mksrfdata/MOD_SingleSrfdata.F90 | 8 ++ 5 files changed, 128 insertions(+), 23 deletions(-) diff --git a/main/MOD_Vars_TimeInvariants.F90 b/main/MOD_Vars_TimeInvariants.F90 index 2cce81a4..5e52fa4c 100644 --- a/main/MOD_Vars_TimeInvariants.F90 +++ b/main/MOD_Vars_TimeInvariants.F90 @@ -197,6 +197,7 @@ MODULE MOD_Vars_TimeInvariants real(r8), allocatable :: vf_gravels (:,:) !volumetric fraction of gravels real(r8), allocatable :: vf_om (:,:) !volumetric fraction of organic matter real(r8), allocatable :: vf_sand (:,:) !volumetric fraction of sand + real(r8), allocatable :: vf_clay (:,:) !volumetric fraction of clay real(r8), allocatable :: wf_gravels (:,:) !gravimetric fraction of gravels real(r8), allocatable :: wf_sand (:,:) !gravimetric fraction of sand real(r8), allocatable :: OM_density (:,:) !OM density (kg/m3) @@ -320,6 +321,7 @@ SUBROUTINE allocate_TimeInvariants () allocate (vf_gravels (nl_soil,numpatch)) allocate (vf_om (nl_soil,numpatch)) allocate (vf_sand (nl_soil,numpatch)) + allocate (vf_clay (nl_soil,numpatch)) allocate (wf_gravels (nl_soil,numpatch)) allocate (wf_sand (nl_soil,numpatch)) allocate (OM_density (nl_soil,numpatch)) @@ -442,6 +444,7 @@ SUBROUTINE READ_TimeInvariants (lc_year, casename, dir_restart) CALL ncio_read_vector (file_restart, 'vf_gravels', nl_soil, landpatch, vf_gravels) ! volumetric fraction of gravels CALL ncio_read_vector (file_restart, 'vf_om ', nl_soil, landpatch, vf_om ) ! volumetric fraction of organic matter CALL ncio_read_vector (file_restart, 'vf_sand ', nl_soil, landpatch, vf_sand ) ! volumetric fraction of sand + CALL ncio_read_vector (file_restart, 'vf_clay ', nl_soil, landpatch, vf_clay ,defval = 0.1 ) ! volumetric fraction of clay CALL ncio_read_vector (file_restart, 'wf_gravels', nl_soil, landpatch, wf_gravels) ! gravimetric fraction of gravels CALL ncio_read_vector (file_restart, 'wf_sand ', nl_soil, landpatch, wf_sand ) ! gravimetric fraction of sand CALL ncio_read_vector (file_restart, 'OM_density', nl_soil, landpatch, OM_density) ! OM density @@ -623,6 +626,7 @@ SUBROUTINE WRITE_TimeInvariants (lc_year, casename, dir_restart) CALL ncio_write_vector (file_restart, 'vf_gravels', 'soil', nl_soil, 'patch', landpatch, vf_gravels, compress) ! volumetric fraction of gravels CALL ncio_write_vector (file_restart, 'vf_om ', 'soil', nl_soil, 'patch', landpatch, vf_om , compress) ! volumetric fraction of organic matter CALL ncio_write_vector (file_restart, 'vf_sand ', 'soil', nl_soil, 'patch', landpatch, vf_sand , compress) ! volumetric fraction of sand + CALL ncio_write_vector (file_restart, 'vf_clay ', 'soil', nl_soil, 'patch', landpatch, vf_clay , compress) ! volumetric fraction of clay CALL ncio_write_vector (file_restart, 'wf_gravels', 'soil', nl_soil, 'patch', landpatch, wf_gravels, compress) ! gravimetric fraction of gravels CALL ncio_write_vector (file_restart, 'wf_sand ', 'soil', nl_soil, 'patch', landpatch, wf_sand , compress) ! gravimetric fraction of sand CALL ncio_write_vector (file_restart, 'OM_density', 'soil', nl_soil, 'patch', landpatch, OM_density, compress) ! OM_density @@ -772,6 +776,7 @@ SUBROUTINE deallocate_TimeInvariants () deallocate (vf_gravels ) deallocate (vf_om ) deallocate (vf_sand ) + deallocate (vf_clay ) deallocate (wf_gravels ) deallocate (wf_sand ) deallocate (OM_density ) @@ -876,6 +881,7 @@ SUBROUTINE check_TimeInvariants () CALL check_vector_data ('vf_gravels [m3/m3] ', vf_gravels ) ! volumetric fraction of gravels CALL check_vector_data ('vf_om [m3/m3] ', vf_om ) ! volumetric fraction of organic matter CALL check_vector_data ('vf_sand [m3/m3] ', vf_sand ) ! volumetric fraction of sand + CALL check_vector_data ('vf_clay [m3/m3] ', vf_clay ) ! volumetric fraction of clay CALL check_vector_data ('wf_gravels [kg/kg] ', wf_gravels ) ! gravimetric fraction of gravels CALL check_vector_data ('wf_sand [kg/kg] ', wf_sand ) ! gravimetric fraction of sand CALL check_vector_data ('OM_density [kg/m3] ', OM_density ) ! OM density diff --git a/mkinidata/MOD_SoilParametersReadin.F90 b/mkinidata/MOD_SoilParametersReadin.F90 index e225e929..deac6b8f 100644 --- a/mkinidata/MOD_SoilParametersReadin.F90 +++ b/mkinidata/MOD_SoilParametersReadin.F90 @@ -49,6 +49,7 @@ SUBROUTINE soil_parameters_readin (dir_landdata, lc_year) real(r8), allocatable :: soil_vf_gravels_s_l (:) ! volumetric fraction of gravels real(r8), allocatable :: soil_vf_om_s_l (:) ! volumetric fraction of organic matter real(r8), allocatable :: soil_vf_sand_s_l (:) ! volumetric fraction of sand + real(r8), allocatable :: soil_vf_clay_s_l (:) ! volumetric fraction of clay real(r8), allocatable :: soil_wf_gravels_s_l (:) ! gravimetric fraction of gravels real(r8), allocatable :: soil_wf_sand_s_l (:) ! gravimetric fraction of sand real(r8), allocatable :: soil_OM_density_s_l (:) ! OM_density (kg/m3) @@ -90,6 +91,7 @@ SUBROUTINE soil_parameters_readin (dir_landdata, lc_year) allocate ( soil_vf_gravels_s_l (numpatch) ) allocate ( soil_vf_om_s_l (numpatch) ) allocate ( soil_vf_sand_s_l (numpatch) ) + allocate ( soil_vf_clay_s_l (numpatch) ) allocate ( soil_wf_gravels_s_l (numpatch) ) allocate ( soil_wf_sand_s_l (numpatch) ) allocate ( soil_OM_density_s_l (numpatch) ) @@ -126,6 +128,7 @@ SUBROUTINE soil_parameters_readin (dir_landdata, lc_year) soil_vf_gravels_s_l (:) = SITE_soil_vf_gravels (nsl) soil_vf_om_s_l (:) = SITE_soil_vf_om (nsl) soil_vf_sand_s_l (:) = SITE_soil_vf_sand (nsl) + soil_vf_clay_s_l (:) = SITE_soil_vf_clay (nsl) soil_wf_gravels_s_l (:) = SITE_soil_wf_gravels (nsl) soil_wf_sand_s_l (:) = SITE_soil_wf_sand (nsl) soil_OM_density_s_l (:) = SITE_soil_OM_density (nsl) @@ -245,6 +248,10 @@ SUBROUTINE soil_parameters_readin (dir_landdata, lc_year) lndname = trim(landdir)//'/BD_all_s_l'//trim(c)//'_patches.nc' CALL ncio_read_vector (lndname, 'BD_all_s_l'//trim(c)//'_patches', landpatch, soil_BD_all_s_l) + ! (24) read in the volumetric fraction of clay + lndname = trim(landdir)//'/vf_clay_s_l'//trim(c)//'_patches.nc' + CALL ncio_read_vector (lndname, 'vf_clay_s_l'//trim(c)//'_patches', landpatch, soil_vf_clay_s_l) + #endif IF (p_is_worker) THEN @@ -256,6 +263,7 @@ SUBROUTINE soil_parameters_readin (dir_landdata, lc_year) vf_gravels(nsl,ipatch) = -1.e36 vf_om (nsl,ipatch) = -1.e36 vf_sand (nsl,ipatch) = -1.e36 + vf_clay (nsl,ipatch) = -1.e36 wf_gravels(nsl,ipatch) = -1.e36 wf_sand (nsl,ipatch) = -1.e36 OM_density(nsl,ipatch) = -1.e36 @@ -283,6 +291,7 @@ SUBROUTINE soil_parameters_readin (dir_landdata, lc_year) vf_gravels (nsl,ipatch) = soil_vf_gravels_s_l (ipatch) vf_om (nsl,ipatch) = soil_vf_om_s_l (ipatch) vf_sand (nsl,ipatch) = soil_vf_sand_s_l (ipatch) + vf_clay (nsl,ipatch) = soil_vf_clay_s_l (ipatch) wf_gravels (nsl,ipatch) = soil_wf_gravels_s_l (ipatch) wf_sand (nsl,ipatch) = soil_wf_sand_s_l (ipatch) OM_density (nsl,ipatch) = soil_OM_density_s_l (ipatch) @@ -325,6 +334,7 @@ SUBROUTINE soil_parameters_readin (dir_landdata, lc_year) deallocate ( soil_vf_gravels_s_l ) deallocate ( soil_vf_om_s_l ) deallocate ( soil_vf_sand_s_l ) + deallocate ( soil_vf_clay_s_l ) deallocate ( soil_wf_gravels_s_l ) deallocate ( soil_wf_sand_s_l ) deallocate ( soil_OM_density_s_l ) @@ -363,6 +373,7 @@ SUBROUTINE soil_parameters_readin (dir_landdata, lc_year) vf_gravels (nsl,:) = vf_gravels(nsl-1,:) vf_om (nsl,:) = vf_om (nsl-1,:) vf_sand (nsl,:) = vf_sand (nsl-1,:) + vf_clay (nsl,:) = vf_clay (nsl-1,:) wf_gravels (nsl,:) = wf_gravels(nsl-1,:) wf_sand (nsl,:) = wf_sand (nsl-1,:) OM_density (nsl,:) = OM_density(nsl-1,:) @@ -392,6 +403,7 @@ SUBROUTINE soil_parameters_readin (dir_landdata, lc_year) vf_gravels (nsl,:) = vf_gravels(9,:) vf_om (nsl,:) = vf_om (9,:) vf_sand (nsl,:) = vf_sand (9,:) + vf_clay (nsl,:) = vf_clay (9,:) wf_gravels (nsl,:) = wf_gravels(9,:) wf_sand (nsl,:) = wf_sand (9,:) OM_density (nsl,:) = OM_density(9,:) diff --git a/mksrfdata/Aggregation_SoilParameters.F90 b/mksrfdata/Aggregation_SoilParameters.F90 index 3cf1631b..be4e950a 100644 --- a/mksrfdata/Aggregation_SoilParameters.F90 +++ b/mksrfdata/Aggregation_SoilParameters.F90 @@ -61,6 +61,7 @@ SUBROUTINE Aggregation_SoilParameters ( & type (block_data_real8_2d) :: vf_gravels_s_grid type (block_data_real8_2d) :: vf_om_s_grid type (block_data_real8_2d) :: vf_sand_s_grid + type (block_data_real8_2d) :: vf_clay_s_grid type (block_data_real8_2d) :: wf_gravels_s_grid type (block_data_real8_2d) :: wf_sand_s_grid type (block_data_real8_2d) :: OM_density_s_grid @@ -85,6 +86,7 @@ SUBROUTINE Aggregation_SoilParameters ( & real(r8), allocatable :: vf_gravels_s_patches (:) real(r8), allocatable :: vf_om_s_patches (:) real(r8), allocatable :: vf_sand_s_patches (:) + real(r8), allocatable :: vf_clay_s_patches (:) real(r8), allocatable :: wf_gravels_s_patches (:) real(r8), allocatable :: wf_sand_s_patches (:) real(r8), allocatable :: OM_density_s_patches (:) @@ -111,6 +113,7 @@ SUBROUTINE Aggregation_SoilParameters ( & real(r8), allocatable :: vf_gravels_s_one (:) real(r8), allocatable :: vf_om_s_one (:) real(r8), allocatable :: vf_sand_s_one (:) + real(r8), allocatable :: vf_clay_s_one (:) real(r8), allocatable :: wf_gravels_s_one (:) real(r8), allocatable :: wf_sand_s_one (:) real(r8), allocatable :: OM_density_s_one (:) @@ -171,29 +174,30 @@ SUBROUTINE Aggregation_SoilParameters ( & integer isiter ! flags to tell whether the iteration is completed, 1=Yes, 0=No ! Parameters to fill water body patches - real(r8), parameter :: vf_quartz_mineral_fill_water(8) = (/0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.4 /) - real(r8), parameter :: vf_gravels_fill_water(8) = (/0., 0., 0., 0., 0., 0.011, 0.010, 0.010/) - real(r8), parameter :: vf_sand_fill_water(8) = (/0.703, 0.703, 0.704, 0.705, 0.717, 0.722, 0.697, 0.512/) - real(r8), parameter :: vf_om_fill_water(8) = (/0.023, 0.022, 0.021, 0.019, 0.016, 0.011, 0.006, 0.003/) - real(r8), parameter :: wf_gravels_fill_water(8) = (/0., 0., 0., 0., 0., 0.011, 0.011, 0.010/) - real(r8), parameter :: wf_sand_fill_water(8) = (/0.72, 0.72, 0.72, 0.72, 0.73, 0.74, 0.71, 0.52 /) - real(r8), parameter :: theta_r_fill_water(8) = (/0.078, 0.078, 0.077, 0.074, 0.075, 0.074, 0.075, 0.091/) - real(r8), parameter :: alpha_vgm_fill_water(8) = (/0.051, 0.051, 0.050, 0.048, 0.047, 0.044, 0.040, 0.029/) - real(r8), parameter :: n_vgm_fill_water(8) = (/1.413, 1.412, 1.412, 1.414, 1.410, 1.422, 1.399, 1.188/) - real(r8), parameter :: theta_s_fill_water(8) = (/0.374, 0.371, 0.366, 0.358, 0.345, 0.323, 0.297, 0.281/) - real(r8), parameter :: k_s_fill_water(8) = (/96., 89., 79., 75., 79., 74., 55., 19. /) - real(r8), parameter :: L_vgm_fill_water(8) = (/0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5 /) - real(r8), parameter :: psi_s_fill_water(8) = (/-13.5, -13.7, -13.9, -14.8, -15.1, -16.0, -19.8, -45.6/) - real(r8), parameter :: lambda_fill_water(8) = (/0.275, 0.275, 0.275, 0.284, 0.287, 0.291, 0.286, 0.194/) - real(r8), parameter :: csol_fill_water(8) = (/1.3e6, 1.3e6, 1.3e6, 1.3e6, 1.4e6, 1.4e6, 1.5e6, 1.5e6/) - real(r8), parameter :: tksatu_fill_water(8) = (/1.985, 2.002, 2.026, 2.066, 2.133, 2.240, 2.388, 2.053/) - real(r8), parameter :: tksatf_fill_water(8) = (/3.343, 3.356, 3.373, 3.401, 3.448, 3.515, 3.613, 3.036/) - real(r8), parameter :: tkdry_fill_water(8) = (/0.260, 0.264, 0.269, 0.278, 0.293, 0.321, 0.359, 0.387/) - real(r8), parameter :: k_solids_fill_water(8) = (/2.450, 2.467, 2.490, 2.528, 2.590, 2.688, 2.823, 2.405/) - real(r8), parameter :: OM_density_fill_water(8) = (/19.18, 18.57, 17.74, 16.37, 14.18, 10.54, 6.088, 3.319/) - real(r8), parameter :: BD_all_fill_water(8) = (/1673., 1683., 1698., 1721., 1758., 1821., 1897., 1944./) - real(r8), parameter :: BA_alpha_fill_water(8) = (/0.38, 0.38, 0.38, 0.38, 0.38, 0.38, 0.38, 0.38 /) - real(r8), parameter :: BA_beta_fill_water (8) = (/35, 35, 35, 35, 35, 35, 35, 35 /) + real(r8), parameter :: vf_quartz_mineral_fill_water(8) = 0.1 + real(r8), parameter :: vf_gravels_fill_water(8) = 0.0 + real(r8), parameter :: vf_sand_fill_water(8) = 0.09 + real(r8), parameter :: vf_clay_fill_water(8) = 0.189 + real(r8), parameter :: vf_om_fill_water(8) = 0.102 + real(r8), parameter :: wf_gravels_fill_water(8) = 0.0 + real(r8), parameter :: wf_sand_fill_water(8) = 0.1 + real(r8), parameter :: theta_r_fill_water(8) = 0.116 + real(r8), parameter :: alpha_vgm_fill_water(8) = 0.01 + real(r8), parameter :: n_vgm_fill_water(8) = 1.352 + real(r8), parameter :: theta_s_fill_water(8) = 0.532 + real(r8), parameter :: k_s_fill_water(8) = 11.616 + real(r8), parameter :: L_vgm_fill_water(8) = 0.5 + real(r8), parameter :: psi_s_fill_water(8) = -35.446 + real(r8), parameter :: lambda_fill_water(8) = 0.108 + real(r8), parameter :: csol_fill_water(8) = 1.102e6 + real(r8), parameter :: tksatu_fill_water(8) = 1.145 + real(r8), parameter :: tksatf_fill_water(8) = 2.401 + real(r8), parameter :: tkdry_fill_water(8) = 0.136 + real(r8), parameter :: k_solids_fill_water(8) = 1.545 + real(r8), parameter :: OM_density_fill_water(8) = 62.064 + real(r8), parameter :: BD_all_fill_water(8) = 1200 + real(r8), parameter :: BA_alpha_fill_water(8) = 0.2 + real(r8), parameter :: BA_beta_fill_water (8) = 10 #ifdef SrfdataDiag @@ -229,6 +233,7 @@ SUBROUTINE Aggregation_SoilParameters ( & allocate ( SITE_soil_vf_gravels (nl_soil) ) allocate ( SITE_soil_vf_om (nl_soil) ) allocate ( SITE_soil_vf_sand (nl_soil) ) + allocate ( SITE_soil_vf_clay (nl_soil) ) allocate ( SITE_soil_wf_gravels (nl_soil) ) allocate ( SITE_soil_wf_sand (nl_soil) ) allocate ( SITE_soil_OM_density (nl_soil) ) @@ -259,6 +264,7 @@ SUBROUTINE Aggregation_SoilParameters ( & allocate ( vf_gravels_s_patches (numpatch) ) allocate ( vf_om_s_patches (numpatch) ) allocate ( vf_sand_s_patches (numpatch) ) + allocate ( vf_clay_s_patches (numpatch) ) allocate ( wf_gravels_s_patches (numpatch) ) allocate ( wf_sand_s_patches (numpatch) ) allocate ( OM_density_s_patches (numpatch) ) @@ -1697,6 +1703,71 @@ SUBROUTINE Aggregation_SoilParameters ( & SITE_soil_BD_all(nsl) = BD_all_s_patches(1) #endif + ! (22) volumetric fraction of clay + IF (p_is_io) THEN + + CALL allocate_block_data (gland, vf_clay_s_grid) + lndname = trim(dir_rawdata)//'/soil/vf_clay_s.nc' + CALL ncio_read_block (lndname, 'vf_clay_s_l'//trim(c), gland, vf_clay_s_grid) +#ifdef USEMPI + CALL aggregation_data_daemon (gland, data_r8_2d_in1 = vf_clay_s_grid) +#endif + ENDIF + + IF (p_is_worker) THEN + + DO ipatch = 1, numpatch + L = landpatch%settyp(ipatch) + + IF (L /= 0) THEN + CALL aggregation_request_data (landpatch, ipatch, gland, zip = USE_zip_for_aggregation, area = area_one, & + data_r8_2d_in1 = vf_clay_s_grid, data_r8_2d_out1 = vf_clay_s_one) + CALL fillnan (vf_clay_s_one) + vf_clay_s_patches (ipatch) = sum (vf_clay_s_one * (area_one/sum(area_one))) + ELSE + vf_clay_s_patches (ipatch) = -1.0e36_r8 + ENDIF + + IF (isnan_ud(vf_clay_s_patches(ipatch))) THEN + IF (L == WATERBODY) THEN + vf_clay_s_patches(ipatch) = vf_clay_fill_water(nsl) + ELSE + write(*,*) "Warning: NAN appears in vf_clay_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) + ENDIF + ENDIF + + ENDDO + +#ifdef USEMPI + CALL aggregation_worker_done () +#endif + ENDIF + +#ifdef USEMPI + CALL mpi_barrier (p_comm_glb, p_err) +#endif + +#ifdef RangeCheck + CALL check_vector_data ('vf_clay_s lev '//trim(c), vf_clay_s_patches) +#endif + +#ifndef SinglePoint + lndname = trim(landdir)//'/vf_clay_s_l'//trim(c)//'_patches.nc' + CALL ncio_create_file_vector (lndname, landpatch) + CALL ncio_define_dimension_vector (lndname, landpatch, 'patch') + CALL ncio_write_vector (lndname, 'vf_clay_s_l'//trim(c)//'_patches', 'patch',& + landpatch, vf_clay_s_patches, DEF_Srfdata_CompressLevel) + +#ifdef SrfdataDiag + typpatch = (/(ityp, ityp = 0, N_land_classification)/) + lndname = trim(dir_model_landdata) // '/diag/soil_parameters_' // trim(cyear) // '.nc' + CALL srfdata_map_and_write (vf_clay_s_patches, landpatch%settyp, typpatch, m_patch2diag, & + -1.0e36_r8, lndname, 'vf_clay_s_l'//trim(c), compress = 1, write_mode = 'one') +#endif +#else + SITE_soil_vf_clay(nsl) = vf_clay_s_patches(1) +#endif ENDDO @@ -1710,6 +1781,7 @@ SUBROUTINE Aggregation_SoilParameters ( & deallocate ( vf_gravels_s_patches ) deallocate ( vf_om_s_patches ) deallocate ( vf_sand_s_patches ) + deallocate ( vf_clay_s_patches ) deallocate ( wf_gravels_s_patches ) deallocate ( wf_sand_s_patches ) deallocate ( OM_density_s_patches ) @@ -1736,6 +1808,7 @@ SUBROUTINE Aggregation_SoilParameters ( & IF (allocated(vf_gravels_s_one)) deallocate (vf_gravels_s_one) IF (allocated(vf_om_s_one)) deallocate (vf_om_s_one) IF (allocated(vf_sand_s_one)) deallocate (vf_sand_s_one) + IF (allocated(vf_clay_s_one)) deallocate (vf_clay_s_one) IF (allocated(wf_gravels_s_one)) deallocate (wf_gravels_s_one) IF (allocated(wf_sand_s_one)) deallocate (wf_sand_s_one) IF (allocated(OM_density_s_one)) deallocate (OM_density_s_one) diff --git a/mksrfdata/MOD_RegionClip.F90 b/mksrfdata/MOD_RegionClip.F90 index 56af5907..37f441ca 100644 --- a/mksrfdata/MOD_RegionClip.F90 +++ b/mksrfdata/MOD_RegionClip.F90 @@ -495,6 +495,12 @@ SUBROUTINE srfdata_region_clip (dir_landdata_in, dir_landdata_out) CALL clip_vector (file_in, file_out, iblk, jblk, & 'BD_all_s_l'//trim(c1)//'_patches', patchmask) + ! (22) volumetric fraction of clay + file_in = trim(dir_landdata_in) // '/soil/vf_clay_s_l'//trim(c1)//'_patches.nc' + file_out = trim(dir_landdata_out) // '/soil/vf_clay_s_l'//trim(c1)//'_patches.nc' + CALL clip_vector (file_in, file_out, iblk, jblk, & + 'vf_clay_s_l'//trim(c1)//'_patches', patchmask) + ENDDO ! topography diff --git a/mksrfdata/MOD_SingleSrfdata.F90 b/mksrfdata/MOD_SingleSrfdata.F90 index a3a81c4d..ff9df640 100644 --- a/mksrfdata/MOD_SingleSrfdata.F90 +++ b/mksrfdata/MOD_SingleSrfdata.F90 @@ -53,6 +53,7 @@ MODULE MOD_SingleSrfdata real(r8), allocatable :: SITE_soil_vf_quartz_mineral (:) real(r8), allocatable :: SITE_soil_vf_gravels (:) real(r8), allocatable :: SITE_soil_vf_sand (:) + real(r8), allocatable :: SITE_soil_vf_clay (:) real(r8), allocatable :: SITE_soil_vf_om (:) real(r8), allocatable :: SITE_soil_wf_gravels (:) real(r8), allocatable :: SITE_soil_wf_sand (:) @@ -257,6 +258,7 @@ SUBROUTINE read_surface_data_single (fsrfdata, mksrfdata) CALL ncio_read_serial (fsrfdata, 'soil_vf_quartz_mineral', SITE_soil_vf_quartz_mineral) CALL ncio_read_serial (fsrfdata, 'soil_vf_gravels ', SITE_soil_vf_gravels ) CALL ncio_read_serial (fsrfdata, 'soil_vf_sand ', SITE_soil_vf_sand ) + CALL ncio_read_serial (fsrfdata, 'soil_vf_clay ', SITE_soil_vf_clay ) CALL ncio_read_serial (fsrfdata, 'soil_vf_om ', SITE_soil_vf_om ) CALL ncio_read_serial (fsrfdata, 'soil_wf_gravels ', SITE_soil_wf_gravels ) CALL ncio_read_serial (fsrfdata, 'soil_wf_sand ', SITE_soil_wf_sand ) @@ -441,6 +443,7 @@ SUBROUTINE read_urban_surface_data_single (fsrfdata, mksrfdata, mkrun) CALL ncio_read_serial (fsrfdata, 'soil_vf_quartz_mineral', SITE_soil_vf_quartz_mineral) CALL ncio_read_serial (fsrfdata, 'soil_vf_gravels ', SITE_soil_vf_gravels ) CALL ncio_read_serial (fsrfdata, 'soil_vf_sand ', SITE_soil_vf_sand ) + CALL ncio_read_serial (fsrfdata, 'soil_vf_clay ', SITE_soil_vf_clay ) CALL ncio_read_serial (fsrfdata, 'soil_vf_om ', SITE_soil_vf_om ) CALL ncio_read_serial (fsrfdata, 'soil_wf_gravels ', SITE_soil_wf_gravels ) CALL ncio_read_serial (fsrfdata, 'soil_wf_sand ', SITE_soil_wf_sand ) @@ -603,6 +606,7 @@ SUBROUTINE write_surface_data_single (numpatch, numpft) CALL ncio_write_serial (fsrfdata, 'soil_vf_quartz_mineral', SITE_soil_vf_quartz_mineral, 'soil') CALL ncio_write_serial (fsrfdata, 'soil_vf_gravels ', SITE_soil_vf_gravels , 'soil') CALL ncio_write_serial (fsrfdata, 'soil_vf_sand ', SITE_soil_vf_sand , 'soil') + CALL ncio_write_serial (fsrfdata, 'soil_vf_clay ', SITE_soil_vf_clay , 'soil') CALL ncio_write_serial (fsrfdata, 'soil_vf_om ', SITE_soil_vf_om , 'soil') CALL ncio_write_serial (fsrfdata, 'soil_wf_gravels ', SITE_soil_wf_gravels , 'soil') CALL ncio_write_serial (fsrfdata, 'soil_wf_sand ', SITE_soil_wf_sand , 'soil') @@ -618,6 +622,7 @@ SUBROUTINE write_surface_data_single (numpatch, numpft) CALL ncio_put_attr (fsrfdata, 'soil_vf_quartz_mineral', 'source', source) CALL ncio_put_attr (fsrfdata, 'soil_vf_gravels ', 'source', source) CALL ncio_put_attr (fsrfdata, 'soil_vf_sand ', 'source', source) + CALL ncio_put_attr (fsrfdata, 'soil_vf_clay ', 'source', source) CALL ncio_put_attr (fsrfdata, 'soil_vf_om ', 'source', source) CALL ncio_put_attr (fsrfdata, 'soil_wf_gravels ', 'source', source) CALL ncio_put_attr (fsrfdata, 'soil_wf_sand ', 'source', source) @@ -803,6 +808,7 @@ SUBROUTINE write_urban_surface_data_single (numurban) CALL ncio_write_serial (fsrfdata, 'soil_vf_quartz_mineral', SITE_soil_vf_quartz_mineral, 'soil') CALL ncio_write_serial (fsrfdata, 'soil_vf_gravels ', SITE_soil_vf_gravels , 'soil') CALL ncio_write_serial (fsrfdata, 'soil_vf_sand ', SITE_soil_vf_sand , 'soil') + CALL ncio_write_serial (fsrfdata, 'soil_vf_clay ', SITE_soil_vf_clay , 'soil') CALL ncio_write_serial (fsrfdata, 'soil_vf_om ', SITE_soil_vf_om , 'soil') CALL ncio_write_serial (fsrfdata, 'soil_wf_gravels ', SITE_soil_wf_gravels , 'soil') CALL ncio_write_serial (fsrfdata, 'soil_wf_sand ', SITE_soil_wf_sand , 'soil') @@ -818,6 +824,7 @@ SUBROUTINE write_urban_surface_data_single (numurban) CALL ncio_put_attr (fsrfdata, 'soil_vf_quartz_mineral', 'source', source) CALL ncio_put_attr (fsrfdata, 'soil_vf_gravels ', 'source', source) CALL ncio_put_attr (fsrfdata, 'soil_vf_sand ', 'source', source) + CALL ncio_put_attr (fsrfdata, 'soil_vf_clay ', 'source', source) CALL ncio_put_attr (fsrfdata, 'soil_vf_om ', 'source', source) CALL ncio_put_attr (fsrfdata, 'soil_wf_gravels ', 'source', source) CALL ncio_put_attr (fsrfdata, 'soil_wf_sand ', 'source', source) @@ -933,6 +940,7 @@ SUBROUTINE single_srfdata_final () IF (allocated(SITE_soil_vf_quartz_mineral)) deallocate(SITE_soil_vf_quartz_mineral) IF (allocated(SITE_soil_vf_gravels )) deallocate(SITE_soil_vf_gravels ) IF (allocated(SITE_soil_vf_sand )) deallocate(SITE_soil_vf_sand ) + IF (allocated(SITE_soil_vf_clay )) deallocate(SITE_soil_vf_clay ) IF (allocated(SITE_soil_vf_om )) deallocate(SITE_soil_vf_om ) IF (allocated(SITE_soil_wf_gravels )) deallocate(SITE_soil_wf_gravels ) IF (allocated(SITE_soil_wf_sand )) deallocate(SITE_soil_wf_sand ) From 32bd86af34fe61b74912539458716ee2678e9933 Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Sun, 9 Feb 2025 20:03:30 +0800 Subject: [PATCH 30/43] New basin network to improve efficiency of lateral flow. --- Makefile | 9 +- main/CoLM.F90 | 6 +- main/HYDRO/MOD_Catch_BasinNetwork.F90 | 1036 +++++++++++++++++ main/HYDRO/MOD_Catch_HillslopeFlow.F90 | 46 +- main/HYDRO/MOD_Catch_HillslopeNetwork.F90 | 322 +++-- ...{MOD_Hydro_Hist.F90 => MOD_Catch_Hist.F90} | 196 ++-- .../{MOD_Hydro_IO.F90 => MOD_Catch_IO.F90} | 75 +- main/HYDRO/MOD_Catch_LateralFlow.F90 | 74 +- main/HYDRO/MOD_Catch_RiverLakeFlow.F90 | 168 ++- main/HYDRO/MOD_Catch_RiverLakeNetwork.F90 | 976 +++++++--------- main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 | 253 ++-- ...Fluxes.F90 => MOD_Catch_Vars_1DFluxes.F90} | 74 +- main/HYDRO/MOD_Catch_Vars_TimeVariables.F90 | 177 +++ main/HYDRO/MOD_Hydro_Vars_TimeVariables.F90 | 160 --- main/MOD_Hist.F90 | 6 +- main/MOD_Vars_1DAccFluxes.F90 | 4 +- main/MOD_Vars_1DFluxes.F90 | 6 +- main/MOD_Vars_TimeInvariants.F90 | 15 +- main/MOD_Vars_TimeVariables.F90 | 10 +- mkinidata/MOD_Initialize.F90 | 89 +- mksrfdata/Aggregation_SoilParameters.F90 | 255 ++-- mksrfdata/MOD_AggregationRequestData.F90 | 8 +- mksrfdata/MOD_HRUVector.F90 | 4 +- mksrfdata/MOD_LandHRU.F90 | 2 +- share/MOD_RangeCheck.F90 | 197 ++-- share/MOD_SPMD_Task.F90 | 1 + 26 files changed, 2496 insertions(+), 1673 deletions(-) create mode 100644 main/HYDRO/MOD_Catch_BasinNetwork.F90 rename main/HYDRO/{MOD_Hydro_Hist.F90 => MOD_Catch_Hist.F90} (53%) rename main/HYDRO/{MOD_Hydro_IO.F90 => MOD_Catch_IO.F90} (71%) rename main/HYDRO/{MOD_Hydro_Vars_1DFluxes.F90 => MOD_Catch_Vars_1DFluxes.F90} (56%) create mode 100644 main/HYDRO/MOD_Catch_Vars_TimeVariables.F90 delete mode 100644 main/HYDRO/MOD_Hydro_Vars_TimeVariables.F90 diff --git a/Makefile b/Makefile index 9142ae42..23f624b1 100755 --- a/Makefile +++ b/Makefile @@ -101,9 +101,10 @@ mksrfdata.x : mkdir_build ${HEADER} ${OBJS_SHARED} ${OBJS_MKSRFDATA} # ----- End of Target 1 mksrfdata ---- OBJS_BASIC = \ - MOD_Hydro_IO.o \ - MOD_Hydro_Vars_TimeVariables.o \ - MOD_Hydro_Vars_1DFluxes.o \ + MOD_Catch_BasinNetwork.o \ + MOD_Catch_IO.o \ + MOD_Catch_Vars_TimeVariables.o \ + MOD_Catch_Vars_1DFluxes.o \ MOD_BGC_Vars_1DFluxes.o \ MOD_BGC_Vars_1DPFTFluxes.o \ MOD_BGC_Vars_PFTimeVariables.o \ @@ -224,7 +225,7 @@ OBJS_MAIN = \ MOD_Catch_HillslopeFlow.o \ MOD_Catch_SubsurfaceFlow.o \ MOD_Catch_RiverLakeFlow.o \ - MOD_Hydro_Hist.o \ + MOD_Catch_Hist.o \ MOD_BGC_CNCStateUpdate1.o \ MOD_BGC_CNCStateUpdate2.o \ MOD_BGC_CNCStateUpdate3.o \ diff --git a/main/CoLM.F90 b/main/CoLM.F90 index 77a1ecd4..6ac11c82 100644 --- a/main/CoLM.F90 +++ b/main/CoLM.F90 @@ -60,8 +60,8 @@ PROGRAM CoLM #ifdef SinglePoint USE MOD_SingleSrfdata #endif - #if (defined CatchLateralFlow) + USE MOD_Catch_BasinNetwork USE MOD_Catch_LateralFlow #endif @@ -250,6 +250,10 @@ PROGRAM CoLM #endif #endif +#ifdef CatchLateralFlow + CALL build_basin_network () +#endif + CALL adj2end(sdate) CALL adj2end(edate) CALL adj2end(pdate) diff --git a/main/HYDRO/MOD_Catch_BasinNetwork.F90 b/main/HYDRO/MOD_Catch_BasinNetwork.F90 new file mode 100644 index 00000000..f16abd96 --- /dev/null +++ b/main/HYDRO/MOD_Catch_BasinNetwork.F90 @@ -0,0 +1,1036 @@ +#include + +#ifdef CatchLateralFlow +MODULE MOD_Catch_BasinNetwork +!-------------------------------------------------------------------------------- +! DESCRIPTION: +! +! Created by Shupeng Zhang, Feb 2025 +!-------------------------------------------------------------------------------- + + USE MOD_Pixelset + IMPLICIT NONE + + ! -- instances -- + integer :: numbasin + integer, allocatable :: basinindex(:) + + integer :: numbsnhru + type(subset_type) :: basin_hru + + ! -- communications -- + type :: basin_pushdata_type + ! data is on the same processor + integer :: nself + integer, allocatable :: iself (:) + ! data is on other processors + integer :: nproc + integer, allocatable :: paddr (:) + integer, allocatable :: ndata (:) + integer, allocatable :: ipush (:) + CONTAINS + final :: basin_pushdata_free_mem + END type basin_pushdata_type + + type(basin_pushdata_type), target :: iam_bsn + type(basin_pushdata_type), target :: iam_elm + + ! -- public subroutines -- + interface worker_push_data + MODULE procedure worker_push_data_real8 + MODULE procedure worker_push_data_int32 + END interface worker_push_data + + PUBLIC :: worker_push_subset_data + +CONTAINS + + ! ---------- + SUBROUTINE build_basin_network () + + USE MOD_SPMD_Task + USE MOD_Namelist + USE MOD_NetCDFSerial + USE MOD_Mesh + USE MOD_LandElm + USE MOD_Utils + IMPLICIT NONE + + ! Local Variables + character(len=256) :: basin_file + integer, allocatable :: basindown(:), lakeid(:), nhru_all(:), nhru_in_bsn(:) + + integer :: totalnumbasin, ibasin, nbasin + integer :: iworker, mesg(2), isrc, nrecv, idata, ndatall, ip, iloc, ielm, i, j, ithis, nave + + integer, allocatable :: eindex (:), bindex (:), addrelm (:), addrbasin(:) + integer, allocatable :: nups_nst(:), iups_nst(:), nups_all(:), b_up2down(:), orderbsn(:) + integer, allocatable :: nelm_wrk(:), paddr (:), icache (:) + + integer, allocatable :: basin_sorted(:), element_sorted(:) + integer, allocatable :: basin_order (:), element_order (:) + +#ifdef USEMPI + CALL mpi_barrier (p_comm_glb, p_err) +#endif + + basin_file = DEF_CatchmentMesh_data + + ! step 1: read in parameters from file. + IF (p_is_master) THEN + CALL ncio_read_serial (basin_file, 'basin_downstream', basindown) + CALL ncio_read_serial (basin_file, 'lake_id', lakeid) + CALL ncio_read_serial (basin_file, 'basin_numhru', nhru_all ) + totalnumbasin = size(basindown) + ENDIF + +#ifdef USEMPI + ! 3-1: get address of elements + IF (p_is_master) THEN + + allocate (addrelm (totalnumbasin)) + + DO iworker = 0, p_np_worker-1 + + CALL mpi_recv (mesg(1:2), 2, MPI_INTEGER, MPI_ANY_SOURCE, mpi_tag_mesg, p_comm_glb, p_stat, p_err) + isrc = mesg(1) + nrecv = mesg(2) + + IF (nrecv > 0) THEN + allocate (eindex (nrecv)) + + CALL mpi_recv (eindex, nrecv, MPI_INTEGER, isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) + + addrelm(eindex) = isrc + + deallocate(eindex) + ENDIF + + ENDDO + + ELSEIF (p_is_worker) THEN + + mesg(1:2) = (/p_iam_glb, numelm/) + CALL mpi_send (mesg(1:2), 2, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) + + IF (numelm > 0) THEN + allocate (eindex (numelm)) + + eindex = landelm%eindex + + CALL mpi_send (eindex, numelm, MPI_INTEGER, p_address_master, mpi_tag_data, p_comm_glb, p_err) + + deallocate (eindex) + ENDIF + + ENDIF + + CALL mpi_barrier (p_comm_glb, p_err) + + ! 3-2: divide basins into groups and assign to workers + IF (p_is_master) THEN + + ! sort basins from up to down, recorded by "b_up2down" + + allocate (nups_nst (totalnumbasin)); nups_nst(:) = 0 + allocate (iups_nst (totalnumbasin)); iups_nst(:) = 0 + allocate (b_up2down(totalnumbasin)) + + DO i = 1, totalnumbasin + j = basindown(i) + IF (j > 0) THEN + nups_nst(j) = nups_nst(j) + 1 + ENDIF + ENDDO + + ithis = 0 + DO i = 1, totalnumbasin + IF (iups_nst(i) == nups_nst(i)) THEN + + ithis = ithis + 1 + b_up2down(ithis) = i + + j = basindown(i) + DO WHILE (j > 0) + + iups_nst(j) = iups_nst(j) + 1 + + IF (iups_nst(j) == nups_nst(j)) THEN + ithis = ithis + 1 + b_up2down(ithis) = j + j = basindown(j) + ELSE + EXIT + ENDIF + ENDDO + ENDIF + ENDDO + + deallocate (nups_nst) + deallocate (iups_nst) + + allocate (nups_all (totalnumbasin)); + nups_all(:) = 1 + ! WHERE (lakeid == -1) + ! nups_all(:) = 0 + ! ENDWHERE + + DO i = 1, totalnumbasin + j = basindown(b_up2down(i)) + IF (j > 0) THEN + nups_all(j) = nups_all(j) + nups_all(b_up2down(i)) + ENDIF + ENDDO + + nave = totalnumbasin / p_np_worker + IF (mod(totalnumbasin, p_np_worker) /= 0) THEN + nave = nave + 1 + ENDIF + + allocate (orderbsn(totalnumbasin)) + orderbsn(b_up2down) = (/(i, i = 1, totalnumbasin)/) + + allocate (nelm_wrk (0:p_np_worker-1)); nelm_wrk(:) = 0 + + allocate (addrbasin (totalnumbasin)) + addrbasin(:) = -1 + + ithis = totalnumbasin + DO WHILE (ithis > 0) + + i = b_up2down(ithis) + + IF (addrbasin(i) >= 0) THEN + ithis = ithis - 1 + CYCLE + ENDIF + + j = basindown(i) + IF (j > 0) THEN + IF (addrbasin(j) >= 0) THEN + addrbasin(i) = addrbasin(j) + ithis = ithis - 1 + CYCLE + ENDIF + ENDIF + + ! IF (lakeid(i) == -1) THEN + ! ithis = ithis - 1 + ! CYCLE + ! ENDIF + + IF (nups_all(i) <= nave) THEN + iworker = p_itis_worker(addrelm(i)) + IF (nelm_wrk(iworker) >= nave) THEN + iworker = minloc(nelm_wrk,1) - 1 + ENDIF + + addrbasin(i) = p_address_worker(iworker) + nelm_wrk(iworker) = nelm_wrk(iworker) + nups_all(i) + + j = basindown(i) + DO WHILE (j > 0) + nups_all(j) = nups_all(j) - nups_all(i) + ithis = orderbsn(j) + j = basindown(j) + ENDDO + ELSE + ithis = ithis - 1 + ENDIF + ENDDO + + DO i = totalnumbasin, 1, -1 + j = b_up2down(i) + IF ((addrbasin(j) == -1) .and. (lakeid(j) == -1)) THEN + addrbasin(j) = addrbasin(basindown(j)) + ENDIF + ENDDO + + deallocate (b_up2down) + deallocate (nups_all ) + deallocate (orderbsn ) + deallocate (nelm_wrk ) + + ENDIF + + ! 3-3: send basin index to workers + IF (p_is_master) THEN + + allocate(basinindex (totalnumbasin)) + basinindex = (/(i, i = 1, totalnumbasin)/) + + DO iworker = 0, p_np_worker-1 + + nbasin = count(addrbasin == p_address_worker(iworker)) + CALL mpi_send (nbasin, 1, MPI_INTEGER, p_address_worker(iworker), mpi_tag_mesg, p_comm_glb, p_err) + + IF (nbasin > 0) THEN + allocate (bindex (nbasin)) + allocate (icache (nbasin)) + allocate (nhru_in_bsn (nbasin)) + + bindex = pack(basinindex, mask = (addrbasin == p_address_worker(iworker))) + CALL mpi_send (bindex, nbasin, MPI_INTEGER, p_address_worker(iworker), & + mpi_tag_data, p_comm_glb, p_err) + + icache = addrelm(bindex) + CALL mpi_send (icache, nbasin, MPI_INTEGER, p_address_worker(iworker), & + mpi_tag_data, p_comm_glb, p_err) + + icache = basindown(bindex) + CALL mpi_send (icache, nbasin, MPI_INTEGER, p_address_worker(iworker), & + mpi_tag_data, p_comm_glb, p_err) + + nhru_in_bsn = nhru_all(bindex) + CALL mpi_send (nhru_in_bsn, nbasin, MPI_INTEGER, p_address_worker(iworker), & + mpi_tag_data, p_comm_glb, p_err) + + deallocate (bindex) + deallocate (icache) + deallocate (nhru_in_bsn) + ENDIF + + ENDDO + + deallocate (basinindex) + + ELSEIF (p_is_worker) THEN + + CALL mpi_recv (numbasin, 1, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_stat, p_err) + + IF (numbasin > 0) THEN + + allocate (basinindex (numbasin)) + CALL mpi_recv (basinindex, numbasin, MPI_INTEGER, p_address_master, & + mpi_tag_data, p_comm_glb, p_stat, p_err) + + allocate (addrelm (numbasin)) + CALL mpi_recv (addrelm, numbasin, MPI_INTEGER, p_address_master, & + mpi_tag_data, p_comm_glb, p_stat, p_err) + + allocate (basindown (numbasin)) + CALL mpi_recv (basindown, numbasin, MPI_INTEGER, p_address_master, & + mpi_tag_data, p_comm_glb, p_stat, p_err) + + allocate (nhru_in_bsn (numbasin)) + CALL mpi_recv (nhru_in_bsn, numbasin, MPI_INTEGER, p_address_master, & + mpi_tag_data, p_comm_glb, p_stat, p_err) + + ENDIF + + ENDIF + + CALL mpi_barrier (p_comm_glb, p_err) + + ! 3-4: send basin index of elements to workers + IF (p_is_master) THEN + + DO iworker = 0, p_np_worker-1 + + CALL mpi_recv (mesg(1:2), 2, MPI_INTEGER, MPI_ANY_SOURCE, mpi_tag_mesg, p_comm_glb, p_stat, p_err) + isrc = mesg(1) + nrecv = mesg(2) + + IF (nrecv > 0) THEN + allocate (eindex (nrecv)) + allocate (icache (nrecv)) + + CALL mpi_recv (eindex, nrecv, MPI_INTEGER, isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) + + icache = addrbasin(eindex) + CALL mpi_send (icache, nrecv, MPI_INTEGER, isrc, mpi_tag_data, p_comm_glb, p_err) + + deallocate(eindex) + deallocate(icache) + ENDIF + + ENDDO + + ELSEIF (p_is_worker) THEN + + mesg(1:2) = (/p_iam_glb, numelm/) + CALL mpi_send (mesg(1:2), 2, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) + + IF (numelm > 0) THEN + allocate (eindex (numelm)) + eindex = landelm%eindex + + CALL mpi_send (eindex, numelm, MPI_INTEGER, p_address_master, & + mpi_tag_data, p_comm_glb, p_err) + + allocate(addrbasin (numelm)) + CALL mpi_recv (addrbasin, numelm, MPI_INTEGER, p_address_master, & + mpi_tag_data, p_comm_glb, p_stat, p_err) + + deallocate (eindex) + ENDIF + + ENDIF + + CALL mpi_barrier (p_comm_glb, p_err) + + ! step 4: building push data type + IF (p_is_worker) THEN + + IF (numbasin > 0) THEN + allocate (basin_sorted (numbasin)) + allocate (basin_order (numbasin)) + basin_sorted = basinindex + basin_order = (/(ibasin, ibasin = 1, numbasin)/) + + CALL quicksort (numbasin, basin_sorted, basin_order) + + ENDIF + + IF (numelm > 0) THEN + allocate (element_sorted (numelm)) + allocate (element_order (numelm)) + element_sorted = landelm%eindex + element_order = (/(ielm, ielm = 1, numelm)/) + + CALL quicksort (numelm, element_sorted, element_order) + + ENDIF + + + iam_bsn%nself = 0 + iam_bsn%nproc = 0 + iam_elm%nself = 0 + iam_elm%nproc = 0 + + IF (numelm > 0) THEN + + allocate (bindex(numelm)) + allocate (paddr (numelm)) + + ndatall = 0 + DO ielm = 1, numelm + IF (addrbasin(ielm) /= p_iam_glb) THEN + CALL insert_into_sorted_list2 (int(landelm%eindex(ielm)), addrbasin(ielm), & + ndatall, bindex, paddr, iloc) + ENDIF + ENDDO + + IF (ndatall > 0) THEN + + DO idata = 1, ndatall + IF (idata == 1) THEN + iam_elm%nproc = 1 + ELSEIF (paddr(idata) /= paddr(idata-1)) THEN + iam_elm%nproc = iam_elm%nproc + 1 + ENDIF + ENDDO + + allocate (iam_elm%paddr (iam_elm%nproc)) + allocate (iam_elm%ndata (iam_elm%nproc)) + allocate (iam_elm%ipush (ndatall)) + + DO idata = 1, ndatall + + IF (idata == 1) THEN + ip = 1 + iam_elm%paddr(ip) = paddr(idata) + iam_elm%ndata(ip) = 1 + ELSEIF (paddr(idata) /= paddr(idata-1)) THEN + ip = ip + 1 + iam_elm%paddr(ip) = paddr(idata) + iam_elm%ndata(ip) = 1 + ELSE + iam_elm%ndata(ip) = iam_elm%ndata(ip) + 1 + ENDIF + + iloc = find_in_sorted_list1 (bindex(idata), numelm, element_sorted) + iam_elm%ipush(idata) = element_order(iloc) + + ENDDO + + ENDIF + + deallocate (bindex) + deallocate (paddr ) + + ENDIF + + + IF (numbasin > 0) THEN + + iam_bsn%nself = count(addrelm == p_iam_glb) + + IF (iam_bsn%nself > 0) THEN + + allocate (iam_bsn%iself (iam_bsn%nself)) + + iam_elm%nself = iam_bsn%nself + allocate (iam_elm%iself (iam_elm%nself)) + + idata = 0 + DO ibasin = 1, numbasin + IF (addrelm(ibasin) == p_iam_glb) THEN + idata = idata + 1 + iloc = find_in_sorted_list1 (basinindex(ibasin), numelm, element_sorted) + iam_bsn%iself(idata) = ibasin + iam_elm%iself(idata) = element_order(iloc) + ENDIF + ENDDO + + ENDIF + + + allocate (eindex(numbasin)) + allocate (paddr (numbasin)) + + ndatall = 0 + DO ibasin = 1, numbasin + IF (addrelm(ibasin) /= p_iam_glb) THEN + CALL insert_into_sorted_list2 (basinindex(ibasin), addrelm(ibasin), & + ndatall, eindex, paddr, iloc) + ENDIF + ENDDO + + IF (ndatall > 0) THEN + + DO idata = 1, ndatall + IF (idata == 1) THEN + iam_bsn%nproc = 1 + ELSEIF (paddr(idata) /= paddr(idata-1)) THEN + iam_bsn%nproc = iam_bsn%nproc + 1 + ENDIF + ENDDO + + allocate (iam_bsn%paddr (iam_bsn%nproc)) + allocate (iam_bsn%ndata (iam_bsn%nproc)) + allocate (iam_bsn%ipush (ndatall)) + + DO idata = 1, ndatall + + IF (idata == 1) THEN + ip = 1 + iam_bsn%paddr(ip) = paddr(idata) + iam_bsn%ndata(ip) = 1 + ELSEIF (paddr(idata) /= paddr(idata-1)) THEN + ip = ip + 1 + iam_bsn%paddr(ip) = paddr(idata) + iam_bsn%ndata(ip) = 1 + ELSE + iam_bsn%ndata(ip) = iam_bsn%ndata(ip) + 1 + ENDIF + + iloc = find_in_sorted_list1 (eindex(idata), numbasin, basin_sorted) + iam_bsn%ipush(idata) = basin_order(iloc) + + ENDDO + + ENDIF + + deallocate (eindex) + deallocate (paddr ) + + ENDIF + + ENDIF + + CALL mpi_barrier (p_comm_glb, p_err) +#else + + numbasin = numelm + allocate(basinindex (numbasin)) + basinindex = landelm%eindex + + iam_bsn%nself = numbasin + allocate(iam_bsn%iself (numbasin)) + iam_bsn%iself = (/(ibasin, ibasin = 1, numbasin)/) + + iam_bsn%nproc = 0 + + iam_elm%nself = numelm + allocate(iam_elm%iself (numelm)) + iam_elm%iself = (/(ielm, ielm = 1, numelm)/) + + iam_elm%nproc = 0 + +#endif + + IF (p_is_worker) THEN + + numbsnhru = 0 + + IF (numbasin > 0) THEN + + numbsnhru = sum(nhru_in_bsn) + + allocate (basin_hru%substt (numbasin)) + allocate (basin_hru%subend (numbasin)) + + DO ibasin = 1, numbasin + IF (ibasin == 1) THEN + basin_hru%substt(1) = 1 + ELSE + basin_hru%substt(ibasin) = basin_hru%subend(ibasin-1) + 1 + ENDIF + basin_hru%subend(ibasin) = basin_hru%substt(ibasin) + nhru_in_bsn(ibasin) - 1 + ENDDO + ENDIF + + ENDIF + +#ifdef CoLMDEBUG + ! check basin network. + IF (p_is_worker) THEN + nbasin = 0 + DO ibasin = 1, numbasin + IF (basindown(ibasin) > 0) THEN + iloc = find_in_sorted_list1 (basindown(ibasin), numbasin, basin_sorted) + IF (iloc <= 0) nbasin = nbasin + 1 + ENDIF + ENDDO + + write(*,'(A,I6,A,I8,A,I8,A)') 'Check basin network: worker ', p_iam_glb, & + ' has total ', numbasin, ' basins with ', nbasin, ' downstream on other processors.' + ENDIF +#endif + +#ifdef USEMPI + CALL mpi_barrier (p_comm_glb, p_err) +#endif + + IF (allocated(addrbasin )) deallocate(addrbasin ) + IF (allocated(addrelm )) deallocate(addrelm ) + IF (allocated(basindown )) deallocate(basindown ) + IF (allocated(lakeid )) deallocate(lakeid ) + IF (allocated(nhru_all )) deallocate(nhru_all ) + IF (allocated(nhru_in_bsn )) deallocate(nhru_in_bsn ) + IF (allocated(basin_sorted )) deallocate(basin_sorted ) + IF (allocated(basin_order )) deallocate(basin_order ) + IF (allocated(element_sorted)) deallocate(element_sorted) + IF (allocated(element_order )) deallocate(element_order ) + + END SUBROUTINE build_basin_network + + + ! ---------- + SUBROUTINE worker_push_data_real8 (send_pointer, recv_pointer, accum, vec_send, vec_recv) + + USE MOD_Precision + USE MOD_SPMD_Task + IMPLICIT NONE + + type(basin_pushdata_type) :: send_pointer + type(basin_pushdata_type) :: recv_pointer + logical, intent(in) :: accum + + real(r8), intent(in) :: vec_send(:) + real(r8), intent(inout) :: vec_recv(:) + + ! Local Variables + integer :: ndatasend, idest + integer, allocatable :: req_send (:) + real(r8), allocatable :: sendcache(:) + + integer :: ndatarecv, isrc + integer, allocatable :: req_recv (:) + real(r8), allocatable :: recvcache(:) + + integer :: iproc, i, istt, iend, ndata + + IF (p_is_worker) THEN + + IF (send_pointer%nself > 0) THEN + IF (.not. accum) THEN + vec_recv(recv_pointer%iself) = vec_send(send_pointer%iself) + ELSE + DO i = 1, send_pointer%nself + vec_recv(recv_pointer%iself(i)) = & + vec_recv(recv_pointer%iself(i)) + vec_send(send_pointer%iself(i)) + ENDDO + ENDIF + ENDIF + +#ifdef USEMPI + CALL mpi_barrier (p_comm_worker, p_err) + + IF (send_pointer%nproc > 0) THEN + + ndatasend = sum(send_pointer%ndata) + + allocate (sendcache(ndatasend)) + sendcache = vec_send(send_pointer%ipush) + + allocate (req_send(send_pointer%nproc)) + + iend = 0 + DO iproc = 1, send_pointer%nproc + ndata = send_pointer%ndata(iproc) + idest = send_pointer%paddr(iproc) + istt = iend + 1 + iend = iend + ndata + + CALL mpi_isend(sendcache(istt:iend), ndata, MPI_REAL8, & + idest, 101, p_comm_glb, req_send(iproc), p_err) + ENDDO + + ENDIF + + IF (recv_pointer%nproc > 0) THEN + + ndatarecv = sum(recv_pointer%ndata) + + allocate (recvcache(ndatarecv)) + allocate (req_recv (recv_pointer%nproc)) + + iend = 0 + DO iproc = 1, recv_pointer%nproc + ndata = recv_pointer%ndata(iproc) + isrc = recv_pointer%paddr(iproc) + istt = iend + 1 + iend = iend + ndata + + CALL mpi_irecv(recvcache(istt:iend), ndata, MPI_REAL8, & + isrc, 101, p_comm_glb, req_recv(iproc), p_err) + ENDDO + + ENDIF + + IF (recv_pointer%nproc > 0) THEN + + CALL mpi_waitall(recv_pointer%nproc, req_recv, MPI_STATUSES_IGNORE, p_err) + + IF (accum) THEN + DO i = 1, ndatarecv + vec_recv(recv_pointer%ipush(i)) = & + vec_recv(recv_pointer%ipush(i)) + recvcache(i) + ENDDO + ELSE + vec_recv(recv_pointer%ipush) = recvcache + ENDIF + ENDIF + + IF (send_pointer%nproc > 0) THEN + CALL mpi_waitall(send_pointer%nproc, req_send, MPI_STATUSES_IGNORE, p_err) + ENDIF + + IF (allocated(req_send )) deallocate(req_send) + IF (allocated(sendcache)) deallocate(sendcache) + IF (allocated(req_recv )) deallocate(req_recv) + IF (allocated(recvcache)) deallocate(recvcache) + + CALL mpi_barrier (p_comm_worker, p_err) +#endif + + ENDIF + + END SUBROUTINE worker_push_data_real8 + + ! ---------- + SUBROUTINE worker_push_data_int32 (send_pointer, recv_pointer, accum, vec_send, vec_recv) + + USE MOD_Precision + USE MOD_SPMD_Task + IMPLICIT NONE + + type(basin_pushdata_type) :: send_pointer + type(basin_pushdata_type) :: recv_pointer + logical, intent(in) :: accum + + integer, intent(in) :: vec_send(:) + integer, intent(inout) :: vec_recv(:) + + ! Local Variables + integer :: ndatasend, idest + integer, allocatable :: req_send (:) + integer, allocatable :: sendcache(:) + + integer :: ndatarecv, isrc + integer, allocatable :: req_recv (:) + integer, allocatable :: recvcache(:) + + integer :: iproc, i, istt, iend, ndata + + IF (p_is_worker) THEN + + IF (send_pointer%nself > 0) THEN + IF (.not. accum) THEN + vec_recv(recv_pointer%iself) = vec_send(send_pointer%iself) + ELSE + DO i = 1, send_pointer%nself + vec_recv(recv_pointer%iself(i)) = & + vec_recv(recv_pointer%iself(i)) + vec_send(send_pointer%iself(i)) + ENDDO + ENDIF + ENDIF + +#ifdef USEMPI + CALL mpi_barrier (p_comm_worker, p_err) + + IF (send_pointer%nproc > 0) THEN + + ndatasend = sum(send_pointer%ndata) + + allocate (sendcache(ndatasend)) + sendcache = vec_send(send_pointer%ipush) + + allocate (req_send(send_pointer%nproc)) + + iend = 0 + DO iproc = 1, send_pointer%nproc + ndata = send_pointer%ndata(iproc) + idest = send_pointer%paddr(iproc) + istt = iend + 1 + iend = iend + ndata + + CALL mpi_isend(sendcache(istt:iend), ndata, MPI_INTEGER, & + idest, 102, p_comm_glb, req_send(iproc), p_err) + ENDDO + + ENDIF + + IF (recv_pointer%nproc > 0) THEN + + ndatarecv = sum(recv_pointer%ndata) + + allocate (recvcache(ndatarecv)) + allocate (req_recv (recv_pointer%nproc)) + + iend = 0 + DO iproc = 1, recv_pointer%nproc + ndata = recv_pointer%ndata(iproc) + isrc = recv_pointer%paddr(iproc) + istt = iend + 1 + iend = iend + ndata + + CALL mpi_irecv(recvcache(istt:iend), ndata, MPI_INTEGER, & + isrc, 102, p_comm_glb, req_recv(iproc), p_err) + ENDDO + + ENDIF + + IF (recv_pointer%nproc > 0) THEN + + CALL mpi_waitall(recv_pointer%nproc, req_recv, MPI_STATUSES_IGNORE, p_err) + + IF (accum) THEN + DO i = 1, ndatarecv + vec_recv(recv_pointer%ipush(i)) = & + vec_recv(recv_pointer%ipush(i)) + recvcache(i) + ENDDO + ELSE + vec_recv(recv_pointer%ipush) = recvcache + ENDIF + ENDIF + + IF (send_pointer%nproc > 0) THEN + CALL mpi_waitall(send_pointer%nproc, req_send, MPI_STATUSES_IGNORE, p_err) + ENDIF + + IF (allocated(req_send )) deallocate(req_send) + IF (allocated(sendcache)) deallocate(sendcache) + IF (allocated(req_recv )) deallocate(req_recv) + IF (allocated(recvcache)) deallocate(recvcache) + + CALL mpi_barrier (p_comm_worker, p_err) +#endif + + ENDIF + + END SUBROUTINE worker_push_data_int32 + + ! ---------- + SUBROUTINE worker_push_subset_data (send_pointer, recv_pointer, & + subset_send, subset_recv, vec_send, vec_recv) + + USE MOD_Precision + USE MOD_SPMD_Task + IMPLICIT NONE + + type(basin_pushdata_type), intent(in) :: send_pointer + type(basin_pushdata_type), intent(in) :: recv_pointer + + type(subset_type),intent(in) :: subset_send + type(subset_type),intent(in) :: subset_recv + + real(r8), intent(in) :: vec_send(:) + real(r8), intent(inout) :: vec_recv(:) + + ! Local Variables + integer :: ndatasend, idest, isend, istt_send, iend_send, nreq_send + integer, allocatable :: req_send (:) + real(r8), allocatable :: sendcache(:) + + integer :: ndatarecv, isrc, irecv, istt_recv, iend_recv, nreq_recv + integer, allocatable :: req_recv (:) + real(r8), allocatable :: recvcache(:) + + integer :: iproc, i, istt, iend, isup + logical :: has_data + + + IF (p_is_worker) THEN + + DO i = 1, send_pointer%nself + isend = send_pointer%iself(i) + istt_send = subset_send%substt(isend) + iend_send = subset_send%subend(isend) + + IF (istt_send <= iend_send) THEN + irecv = recv_pointer%iself(i) + istt_recv = subset_recv%substt(irecv) + iend_recv = subset_recv%subend(irecv) + + vec_recv(istt_recv:iend_recv) = vec_send(istt_send:iend_send) + ENDIF + ENDDO + +#ifdef USEMPI + CALL mpi_barrier (p_comm_worker, p_err) + + nreq_send = 0 + + IF (send_pointer%nproc > 0) THEN + + ndatasend = 0 + DO i = 1, size(send_pointer%ipush) + isend = send_pointer%ipush(i) + ndatasend = ndatasend + subset_send%subend(isend) - subset_send%substt(isend) + 1 + ENDDO + + IF (ndatasend > 0) THEN + + allocate (sendcache(ndatasend)) + iend = 0 + DO i = 1, size(send_pointer%ipush) + isend = send_pointer%ipush(i) + istt_send = subset_send%substt(isend) + iend_send = subset_send%subend(isend) + IF (istt_send <= iend_send) THEN + istt = iend + 1 + iend = iend + iend_send - istt_send + 1 + sendcache(istt:iend) = vec_send(istt_send:iend_send) + ENDIF + ENDDO + + allocate (req_send(send_pointer%nproc)) + + isup = 0 + iend = 0 + DO iproc = 1, send_pointer%nproc + has_data = .false. + DO i = isup+1, isup+send_pointer%ndata(iproc) + isend = send_pointer%ipush(i) + istt_send = subset_send%substt(isend) + iend_send = subset_send%subend(isend) + IF (istt_send <= iend_send) THEN + IF (.not. has_data) THEN + has_data = .true. + istt = iend + 1 + ENDIF + iend = iend + iend_send - istt_send + 1 + ENDIF + ENDDO + + IF (has_data) THEN + nreq_send = nreq_send + 1 + idest = send_pointer%paddr(iproc) + CALL mpi_isend(sendcache(istt:iend), iend-istt+1, MPI_REAL8, & + idest, 101, p_comm_glb, req_send(nreq_send), p_err) + ENDIF + + isup = isup + send_pointer%ndata(iproc) + ENDDO + + ENDIF + + ENDIF + + nreq_recv = 0 + + IF (recv_pointer%nproc > 0) THEN + + ndatarecv = 0 + DO i = 1, size(recv_pointer%ipush) + irecv = recv_pointer%ipush(i) + ndatarecv = ndatarecv + subset_recv%subend(irecv) - subset_recv%substt(irecv) + 1 + ENDDO + + IF (ndatarecv > 0) THEN + + allocate (recvcache(ndatarecv)) + allocate (req_recv (recv_pointer%nproc)) + + isup = 0 + iend = 0 + DO iproc = 1, recv_pointer%nproc + has_data = .false. + DO i = isup+1, isup+recv_pointer%ndata(iproc) + irecv = recv_pointer%ipush(i) + istt_recv = subset_recv%substt(irecv) + iend_recv = subset_recv%subend(irecv) + IF (istt_recv <= iend_recv) THEN + IF (.not. has_data) THEN + has_data = .true. + istt = iend + 1 + ENDIF + iend = iend + iend_recv - istt_recv + 1 + ENDIF + ENDDO + + IF (has_data) THEN + nreq_recv = nreq_recv + 1 + isrc = recv_pointer%paddr(iproc) + CALL mpi_irecv(recvcache(istt:iend), iend-istt+1, MPI_REAL8, & + isrc, 101, p_comm_glb, req_recv(nreq_recv), p_err) + ENDIF + + isup = isup + recv_pointer%ndata(iproc) + ENDDO + + ENDIF + + ENDIF + + IF (nreq_recv > 0) THEN + + CALL mpi_waitall(nreq_recv, req_recv(1:nreq_recv), MPI_STATUSES_IGNORE, p_err) + + iend = 0 + DO i = 1, size(recv_pointer%ipush) + irecv = recv_pointer%ipush(i) + istt_recv = subset_recv%substt(irecv) + iend_recv = subset_recv%subend(irecv) + IF (istt_recv <= iend_recv) THEN + istt = iend + 1 + iend = iend + iend_recv - istt_recv + 1 + vec_recv(istt_recv:iend_recv) = recvcache(istt:iend) + ENDIF + ENDDO + ENDIF + + IF (nreq_send > 0) THEN + CALL mpi_waitall(nreq_send, req_send(1:nreq_send), MPI_STATUSES_IGNORE, p_err) + ENDIF + + IF (allocated(req_send )) deallocate(req_send ) + IF (allocated(sendcache)) deallocate(sendcache) + IF (allocated(req_recv )) deallocate(req_recv ) + IF (allocated(recvcache)) deallocate(recvcache) + + CALL mpi_barrier (p_comm_worker, p_err) +#endif + + ENDIF + + END SUBROUTINE worker_push_subset_data + + ! --------- + SUBROUTINE basin_pushdata_free_mem (this) + + IMPLICIT NONE + type(basin_pushdata_type) :: this + + IF (allocated(this%iself)) deallocate(this%iself) + IF (allocated(this%paddr)) deallocate(this%paddr) + IF (allocated(this%ndata)) deallocate(this%ndata) + IF (allocated(this%ipush)) deallocate(this%ipush) + + END SUBROUTINE basin_pushdata_free_mem + +END MODULE MOD_Catch_BasinNetwork +#endif diff --git a/main/HYDRO/MOD_Catch_HillslopeFlow.F90 b/main/HYDRO/MOD_Catch_HillslopeFlow.F90 index ab5706b4..975de7ec 100644 --- a/main/HYDRO/MOD_Catch_HillslopeFlow.F90 +++ b/main/HYDRO/MOD_Catch_HillslopeFlow.F90 @@ -33,16 +33,11 @@ MODULE MOD_Catch_HillslopeFlow SUBROUTINE hillslope_flow (dt) USE MOD_SPMD_Task - USE MOD_Mesh - USE MOD_LandElm - USE MOD_LandHRU - USE MOD_LandPatch - USE MOD_Vars_TimeVariables - USE MOD_Vars_1DFluxes - USE MOD_Hydro_Vars_TimeVariables - USE MOD_Hydro_Vars_1DFluxes + USE MOD_Catch_BasinNetwork USE MOD_Catch_HillslopeNetwork USE MOD_Catch_RiverLakeNetwork + USE MOD_Catch_Vars_TimeVariables + USE MOD_Catch_Vars_1DFluxes USE MOD_Const_Physical, only : grav IMPLICIT NONE @@ -50,9 +45,9 @@ SUBROUTINE hillslope_flow (dt) real(r8), intent(in) :: dt ! Local Variables - integer :: numbasin, nhru, hs, he, ibasin, i, j, ps, pe + integer :: nhru, hs, he, ibasin, i, j - type(hillslope_network_info_type), pointer :: hillslope + type(hillslope_network_type), pointer :: hillslope real(r8), allocatable :: wdsrf_h (:) ! [m] real(r8), allocatable :: momen_h (:) ! [m^2/s] @@ -76,25 +71,23 @@ SUBROUTINE hillslope_flow (dt) IF (p_is_worker) THEN - numbasin = numelm - DO ibasin = 1, numbasin hs = basin_hru%substt(ibasin) he = basin_hru%subend(ibasin) IF (lake_id(ibasin) > 0) THEN - veloc_hru(hs:he) = 0 - momen_hru(hs:he) = 0 + veloc_bsnhru(hs:he) = 0 + momen_bsnhru(hs:he) = 0 CYCLE ! skip lakes ELSE DO i = hs, he ! momentum is less or equal than the momentum at last time step. - momen_hru(i) = min(wdsrf_hru_prev(i), wdsrf_hru(i)) * veloc_hru(i) + momen_bsnhru(i) = min(wdsrf_bsnhru_prev(i), wdsrf_bsnhru(i)) * veloc_bsnhru(i) ENDDO ENDIF - hillslope => hillslope_network(ibasin) + hillslope => hillslope_basin(ibasin) nhru = hillslope%nhru @@ -109,8 +102,8 @@ SUBROUTINE hillslope_flow (dt) allocate (xsurf_h (nhru)) DO i = 1, nhru - wdsrf_h(i) = wdsrf_hru(hillslope%ihru(i)) - momen_h(i) = momen_hru(hillslope%ihru(i)) + wdsrf_h(i) = wdsrf_bsnhru(hillslope%ihru(i)) + momen_h(i) = momen_bsnhru(hillslope%ihru(i)) IF (wdsrf_h(i) > 0.) THEN veloc_h(i) = momen_h(i) / wdsrf_h(i) ELSE @@ -281,25 +274,18 @@ SUBROUTINE hillslope_flow (dt) veloc_h(i) = momen_h(i) / wdsrf_h(i) ENDIF - wdsrf_hru_ta(hillslope%ihru(i)) = wdsrf_hru_ta(hillslope%ihru(i)) + wdsrf_h(i) * dt_this - momen_hru_ta(hillslope%ihru(i)) = momen_hru_ta(hillslope%ihru(i)) + momen_h(i) * dt_this + wdsrf_bsnhru_ta(hillslope%ihru(i)) = wdsrf_bsnhru_ta(hillslope%ihru(i)) + wdsrf_h(i) * dt_this + momen_bsnhru_ta(hillslope%ihru(i)) = momen_bsnhru_ta(hillslope%ihru(i)) + momen_h(i) * dt_this ENDDO - IF (hillslope%indx(1) == 0) THEN - ps = elm_patch%substt(ibasin) - pe = elm_patch%subend(ibasin) - ! m/s to mm/s - rsur(ps:pe) = rsur(ps:pe) - sum_hflux_h(1) * dt_this / sum(hillslope%area) * 1.0e3 - ENDIF - dt_res = dt_res - dt_this ENDDO ! SAVE depth of surface water DO i = 1, nhru - wdsrf_hru(hillslope%ihru(i)) = wdsrf_h(i) - veloc_hru(hillslope%ihru(i)) = veloc_h(i) + wdsrf_bsnhru(hillslope%ihru(i)) = wdsrf_h(i) + veloc_bsnhru(hillslope%ihru(i)) = veloc_h(i) ENDDO deallocate (wdsrf_h) @@ -314,7 +300,7 @@ SUBROUTINE hillslope_flow (dt) ENDDO - wdsrf_hru_prev(:) = wdsrf_hru(:) + IF (numbsnhru > 0) wdsrf_bsnhru_prev(:) = wdsrf_bsnhru(:) ENDIF diff --git a/main/HYDRO/MOD_Catch_HillslopeNetwork.F90 b/main/HYDRO/MOD_Catch_HillslopeNetwork.F90 index 7c0bc95a..70b43097 100644 --- a/main/HYDRO/MOD_Catch_HillslopeNetwork.F90 +++ b/main/HYDRO/MOD_Catch_HillslopeNetwork.F90 @@ -14,7 +14,7 @@ MODULE MOD_Catch_HillslopeNetwork IMPLICIT NONE ! -- data type -- - type :: hillslope_network_info_type + type :: hillslope_network_type integer :: nhru integer , pointer :: ihru (:) ! location of HRU in global vector "landhru" integer , pointer :: indx (:) ! index of HRU @@ -25,33 +25,34 @@ MODULE MOD_Catch_HillslopeNetwork real(r8), pointer :: plen (:) ! average drainage path length to downstream HRU [m] real(r8), pointer :: flen (:) ! interface length between this and downstream HRU [m] integer , pointer :: inext(:) ! location of next HRU in this basin - END type hillslope_network_info_type + CONTAINS + final :: hillslope_network_free_mem + END type hillslope_network_type - ! -- Instance -- - type(hillslope_network_info_type), pointer :: hillslope_network (:) - CONTAINS ! ---------- - SUBROUTINE hillslope_network_init () + SUBROUTINE hillslope_network_init (ne, elmindex, hillslope_network) USE MOD_SPMD_Task USE MOD_Namelist USE MOD_NetCDFSerial - USE MOD_Mesh - USE MOD_Pixel - USE MOD_LandHRU - USE MOD_LandPatch - USE MOD_Vars_TimeInvariants, only : patchtype - USE MOD_Utils USE MOD_UserDefFun IMPLICIT NONE + integer, intent(in) :: ne + integer, intent(in) :: elmindex (:) + type(hillslope_network_type), pointer :: hillslope_network(:) + ! Local Variables character(len=256) :: hillslope_network_file - integer :: numbasin, maxnumhru, ibasin, nhru, hs, he, ihru, ipatch, ps, pe, i, j, ipxl + integer :: maxnumhru, ie, nhru, hs, i, j integer :: iworker, mesg(2), nrecv, irecv, isrc, idest + + integer , allocatable :: eid (:) + + integer , allocatable :: nhru_all(:), nhru_in_bsn(:) integer , allocatable :: indxhru (:,:) real(r8), allocatable :: areahru (:,:) @@ -61,7 +62,6 @@ SUBROUTINE hillslope_network_init () real(r8), allocatable :: lfachru (:,:) integer , allocatable :: nexthru (:,:) - integer , allocatable :: basinindex (:) integer , allocatable :: icache (:,:) real(r8), allocatable :: rcache (:,:) @@ -69,13 +69,11 @@ SUBROUTINE hillslope_network_init () CALL mpi_barrier (p_comm_glb, p_err) #endif - numbasin = numelm - - hillslope_network => null() - hillslope_network_file = DEF_CatchmentMesh_data IF (p_is_master) THEN + + CALL ncio_read_serial (hillslope_network_file, 'basin_numhru', nhru_all) CALL ncio_read_serial (hillslope_network_file, 'hydrounit_index', indxhru) CALL ncio_read_serial (hillslope_network_file, 'hydrounit_area', areahru) CALL ncio_read_serial (hillslope_network_file, 'hydrounit_hand', handhru) @@ -83,6 +81,7 @@ SUBROUTINE hillslope_network_init () CALL ncio_read_serial (hillslope_network_file, 'hydrounit_pathlen', plenhru) CALL ncio_read_serial (hillslope_network_file, 'hydrounit_facelen', lfachru) CALL ncio_read_serial (hillslope_network_file, 'hydrounit_downstream', nexthru) + ENDIF IF (p_is_master) maxnumhru = size(indxhru,1) @@ -90,6 +89,8 @@ SUBROUTINE hillslope_network_init () CALL mpi_bcast (maxnumhru, 1, MPI_INTEGER, p_address_master, p_comm_glb, p_err) #endif + hillslope_network => null() + IF (p_is_master) THEN #ifdef USEMPI DO iworker = 1, p_np_worker @@ -100,110 +101,104 @@ SUBROUTINE hillslope_network_init () IF (nrecv > 0) THEN - allocate (basinindex (nrecv)) + allocate (eid (nrecv)) + allocate (nhru_in_bsn (nrecv)) allocate (icache (maxnumhru,nrecv)) allocate (rcache (maxnumhru,nrecv)) - CALL mpi_recv (basinindex, nrecv, MPI_INTEGER, & - isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) + CALL mpi_recv (eid, nrecv, MPI_INTEGER, isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) idest = isrc + nhru_in_bsn = nhru_all(eid) + CALL mpi_send (nhru_in_bsn, nrecv, MPI_INTEGER, idest, mpi_tag_data, p_comm_glb, p_err) + DO irecv = 1, nrecv - icache(:,irecv) = indxhru(:,basinindex(irecv)) + icache(:,irecv) = indxhru(:,eid(irecv)) ENDDO - CALL mpi_send (icache, maxnumhru*nrecv, MPI_INTEGER, & - idest, mpi_tag_data, p_comm_glb, p_err) + CALL mpi_send (icache, maxnumhru*nrecv, MPI_INTEGER, idest, mpi_tag_data, p_comm_glb, p_err) DO irecv = 1, nrecv - rcache(:,irecv) = areahru(:,basinindex(irecv)) + rcache(:,irecv) = areahru(:,eid(irecv)) ENDDO - CALL mpi_send (rcache, maxnumhru*nrecv, MPI_REAL8, & - idest, mpi_tag_data, p_comm_glb, p_err) + CALL mpi_send (rcache, maxnumhru*nrecv, MPI_REAL8, idest, mpi_tag_data, p_comm_glb, p_err) DO irecv = 1, nrecv - rcache(:,irecv) = handhru(:,basinindex(irecv)) + rcache(:,irecv) = handhru(:,eid(irecv)) ENDDO - CALL mpi_send (rcache, maxnumhru*nrecv, MPI_REAL8, & - idest, mpi_tag_data, p_comm_glb, p_err) + CALL mpi_send (rcache, maxnumhru*nrecv, MPI_REAL8, idest, mpi_tag_data, p_comm_glb, p_err) DO irecv = 1, nrecv - rcache(:,irecv) = elvahru(:,basinindex(irecv)) + rcache(:,irecv) = elvahru(:,eid(irecv)) ENDDO - CALL mpi_send (rcache, maxnumhru*nrecv, MPI_REAL8, & - idest, mpi_tag_data, p_comm_glb, p_err) + CALL mpi_send (rcache, maxnumhru*nrecv, MPI_REAL8, idest, mpi_tag_data, p_comm_glb, p_err) DO irecv = 1, nrecv - rcache(:,irecv) = plenhru(:,basinindex(irecv)) + rcache(:,irecv) = plenhru(:,eid(irecv)) ENDDO - CALL mpi_send (rcache, maxnumhru*nrecv, MPI_REAL8, & - idest, mpi_tag_data, p_comm_glb, p_err) + CALL mpi_send (rcache, maxnumhru*nrecv, MPI_REAL8, idest, mpi_tag_data, p_comm_glb, p_err) DO irecv = 1, nrecv - rcache(:,irecv) = lfachru(:,basinindex(irecv)) + rcache(:,irecv) = lfachru(:,eid(irecv)) ENDDO - CALL mpi_send (rcache, maxnumhru*nrecv, MPI_REAL8, & - idest, mpi_tag_data, p_comm_glb, p_err) + CALL mpi_send (rcache, maxnumhru*nrecv, MPI_REAL8, idest, mpi_tag_data, p_comm_glb, p_err) DO irecv = 1, nrecv - icache(:,irecv) = nexthru(:,basinindex(irecv)) + icache(:,irecv) = nexthru(:,eid(irecv)) ENDDO - CALL mpi_send (icache, maxnumhru*nrecv, MPI_INTEGER, & - idest, mpi_tag_data, p_comm_glb, p_err) + CALL mpi_send (icache, maxnumhru*nrecv, MPI_INTEGER, idest, mpi_tag_data, p_comm_glb, p_err) - deallocate (basinindex) + deallocate (eid) + deallocate (nhru_in_bsn) deallocate (icache) deallocate (rcache) ENDIF ENDDO #else - IF (numbasin > 0) THEN + IF (ne > 0) THEN - allocate (basinindex (numbasin)) - allocate (icache (maxnumhru,numbasin)) - allocate (rcache (maxnumhru,numbasin)) - - DO ibasin = 1, numbasin - basinindex(ibasin) = mesh(ibasin)%indx - ENDDO + allocate (nhru_in_bsn (ne)) + allocate (icache (maxnumhru,ne)) + allocate (rcache (maxnumhru,ne)) - DO ibasin = 1, numbasin - icache(:,ibasin) = indxhru(:,basinindex(ibasin)) + nhru_in_bsn = nhru_all(elmindex) + + DO ie = 1, ne + icache(:,ie) = indxhru(:,elmindex(ie)) ENDDO indxhru = icache - DO ibasin = 1, numbasin - rcache(:,ibasin) = areahru(:,basinindex(ibasin)) + DO ie = 1, ne + rcache(:,ie) = areahru(:,elmindex(ie)) ENDDO areahru = rcache - DO ibasin = 1, numbasin - rcache(:,ibasin) = handhru(:,basinindex(ibasin)) + DO ie = 1, ne + rcache(:,ie) = handhru(:,elmindex(ie)) ENDDO handhru = rcache - DO ibasin = 1, numbasin - rcache(:,ibasin) = elvahru(:,basinindex(ibasin)) + DO ie = 1, ne + rcache(:,ie) = elvahru(:,elmindex(ie)) ENDDO elvahru = rcache - DO ibasin = 1, numbasin - rcache(:,ibasin) = plenhru(:,basinindex(ibasin)) + DO ie = 1, ne + rcache(:,ie) = plenhru(:,elmindex(ie)) ENDDO plenhru = rcache - DO ibasin = 1, numbasin - rcache(:,ibasin) = lfachru(:,basinindex(ibasin)) + DO ie = 1, ne + rcache(:,ie) = lfachru(:,elmindex(ie)) ENDDO lfachru = rcache - DO ibasin = 1, numbasin - icache(:,ibasin) = nexthru(:,basinindex(ibasin)) + DO ie = 1, ne + icache(:,ie) = nexthru(:,elmindex(ie)) ENDDO nexthru = icache - deallocate (basinindex) deallocate (icache) deallocate (rcache) @@ -212,122 +207,117 @@ SUBROUTINE hillslope_network_init () ENDIF IF (p_is_worker) THEN - + #ifdef USEMPI - mesg(1:2) = (/p_iam_glb,numbasin/) + mesg(1:2) = (/p_iam_glb, ne/) CALL mpi_send (mesg(1:2), 2, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) - IF (numbasin > 0) THEN - allocate (basinindex (numbasin)) - DO ibasin = 1, numbasin - basinindex(ibasin) = mesh(ibasin)%indx - ENDDO + IF (ne > 0) THEN - CALL mpi_send (basinindex, numbasin, MPI_INTEGER, & + CALL mpi_send (elmindex, ne, MPI_INTEGER, & p_address_master, mpi_tag_data, p_comm_glb, p_err) + + allocate (nhru_in_bsn (ne)) + CALL mpi_recv (nhru_in_bsn, ne, MPI_INTEGER, & + p_address_master, mpi_tag_data, p_comm_glb, p_stat, p_err) - allocate (indxhru (maxnumhru,numbasin)) - CALL mpi_recv (indxhru, maxnumhru*numbasin, MPI_INTEGER, & + allocate (indxhru (maxnumhru,ne)) + CALL mpi_recv (indxhru, maxnumhru*ne, MPI_INTEGER, & p_address_master, mpi_tag_data, p_comm_glb, p_stat, p_err) - allocate (areahru (maxnumhru,numbasin)) - CALL mpi_recv (areahru, maxnumhru*numbasin, MPI_REAL8, & + allocate (areahru (maxnumhru,ne)) + CALL mpi_recv (areahru, maxnumhru*ne, MPI_REAL8, & p_address_master, mpi_tag_data, p_comm_glb, p_stat, p_err) - allocate (handhru (maxnumhru,numbasin)) - CALL mpi_recv (handhru, maxnumhru*numbasin, MPI_REAL8, & + allocate (handhru (maxnumhru,ne)) + CALL mpi_recv (handhru, maxnumhru*ne, MPI_REAL8, & p_address_master, mpi_tag_data, p_comm_glb, p_stat, p_err) - allocate (elvahru (maxnumhru,numbasin)) - CALL mpi_recv (elvahru, maxnumhru*numbasin, MPI_REAL8, & + allocate (elvahru (maxnumhru,ne)) + CALL mpi_recv (elvahru, maxnumhru*ne, MPI_REAL8, & p_address_master, mpi_tag_data, p_comm_glb, p_stat, p_err) - allocate (plenhru (maxnumhru,numbasin)) - CALL mpi_recv (plenhru, maxnumhru*numbasin, MPI_REAL8, & + allocate (plenhru (maxnumhru,ne)) + CALL mpi_recv (plenhru, maxnumhru*ne, MPI_REAL8, & p_address_master, mpi_tag_data, p_comm_glb, p_stat, p_err) - allocate (lfachru (maxnumhru,numbasin)) - CALL mpi_recv (lfachru, maxnumhru*numbasin, MPI_REAL8, & + allocate (lfachru (maxnumhru,ne)) + CALL mpi_recv (lfachru, maxnumhru*ne, MPI_REAL8, & p_address_master, mpi_tag_data, p_comm_glb, p_stat, p_err) - allocate (nexthru (maxnumhru,numbasin)) - CALL mpi_recv (nexthru, maxnumhru*numbasin, MPI_INTEGER, & + allocate (nexthru (maxnumhru,ne)) + CALL mpi_recv (nexthru, maxnumhru*ne, MPI_INTEGER, & p_address_master, mpi_tag_data, p_comm_glb, p_stat, p_err) ENDIF #endif - IF (numbasin > 0) THEN - allocate( hillslope_network (numbasin)) + IF (ne > 0) THEN + allocate( hillslope_network (ne)) ENDIF - DO ibasin = 1, numbasin + hs = 0 + + DO ie = 1, ne - nhru = count(indxhru(:,ibasin) >= 0) - hillslope_network(ibasin)%nhru = nhru + nhru = count(indxhru(:,ie) >= 0) IF (nhru > 0) THEN - - allocate (hillslope_network(ibasin)%ihru (nhru)) - allocate (hillslope_network(ibasin)%indx (nhru)) - allocate (hillslope_network(ibasin)%area (nhru)) - allocate (hillslope_network(ibasin)%agwt (nhru)) - allocate (hillslope_network(ibasin)%hand (nhru)) - allocate (hillslope_network(ibasin)%elva (nhru)) - allocate (hillslope_network(ibasin)%plen (nhru)) - allocate (hillslope_network(ibasin)%flen (nhru)) - allocate (hillslope_network(ibasin)%inext (nhru)) - - hillslope_network(ibasin)%indx = indxhru(1:nhru,ibasin) - hillslope_network(ibasin)%area = areahru(1:nhru,ibasin) * 1.0e6 ! km^2 to m^2 - hillslope_network(ibasin)%hand = handhru(1:nhru,ibasin) ! m - hillslope_network(ibasin)%elva = elvahru(1:nhru,ibasin) ! m - hillslope_network(ibasin)%plen = plenhru(1:nhru,ibasin) * 1.0e3 ! km to m - hillslope_network(ibasin)%flen = lfachru(1:nhru,ibasin) * 1.0e3 ! km to m - - hs = basin_hru%substt(ibasin) - he = basin_hru%subend(ibasin) - hillslope_network(ibasin)%ihru = (/ (i, i = hs, he) /) + + IF (nhru /= nhru_in_bsn(ie)) THEN + write(*,*) 'Warning : numbers of hydro units from file mismatch!' + ENDIF + + allocate (hillslope_network(ie)%ihru (nhru)) + allocate (hillslope_network(ie)%indx (nhru)) + allocate (hillslope_network(ie)%area (nhru)) + allocate (hillslope_network(ie)%agwt (nhru)) + allocate (hillslope_network(ie)%hand (nhru)) + allocate (hillslope_network(ie)%elva (nhru)) + allocate (hillslope_network(ie)%plen (nhru)) + allocate (hillslope_network(ie)%flen (nhru)) + allocate (hillslope_network(ie)%inext (nhru)) + + hillslope_network(ie)%indx = indxhru(1:nhru,ie) + hillslope_network(ie)%area = areahru(1:nhru,ie) * 1.0e6 ! km^2 to m^2 + hillslope_network(ie)%hand = handhru(1:nhru,ie) ! m + hillslope_network(ie)%elva = elvahru(1:nhru,ie) ! m + hillslope_network(ie)%plen = plenhru(1:nhru,ie) * 1.0e3 ! km to m + hillslope_network(ie)%flen = lfachru(1:nhru,ie) * 1.0e3 ! km to m + + hillslope_network(ie)%ihru = (/ (i, i = hs+1, hs+nhru) /) DO i = 1, nhru - IF (nexthru(i,ibasin) >= 0) THEN - j = findloc_ud(indxhru(1:nhru,ibasin) == nexthru(i,ibasin)) - hillslope_network(ibasin)%inext(i) = j + IF (nexthru(i,ie) >= 0) THEN + j = findloc_ud(indxhru(1:nhru,ie) == nexthru(i,ie)) + hillslope_network(ie)%inext(i) = j ELSE - hillslope_network(ibasin)%inext(i) = -1 + hillslope_network(ie)%inext(i) = -1 ENDIF ENDDO - DO i = 1, nhru - hillslope_network(ibasin)%agwt(i) = 0 - ps = hru_patch%substt(i+hs-1) - pe = hru_patch%subend(i+hs-1) - DO ipatch = ps, pe - IF (patchtype(ipatch) <= 2) THEN - DO ipxl = landpatch%ipxstt(ipatch), landpatch%ipxend(ipatch) - hillslope_network(ibasin)%agwt(i) = hillslope_network(ibasin)%agwt(i) & - + 1.0e6 * areaquad ( & - pixel%lat_s(mesh(ibasin)%ilat(ipxl)), pixel%lat_n(mesh(ibasin)%ilat(ipxl)), & - pixel%lon_w(mesh(ibasin)%ilon(ipxl)), pixel%lon_e(mesh(ibasin)%ilon(ipxl)) ) - ENDDO - ENDIF - ENDDO - ENDDO - - ELSE - hillslope_network(ibasin)%ihru => null() - hillslope_network(ibasin)%indx => null() - hillslope_network(ibasin)%area => null() - hillslope_network(ibasin)%agwt => null() - hillslope_network(ibasin)%hand => null() - hillslope_network(ibasin)%elva => null() - hillslope_network(ibasin)%plen => null() - hillslope_network(ibasin)%flen => null() - hillslope_network(ibasin)%inext => null() + ELSE + ! for lake + hillslope_network(ie)%ihru => null() + hillslope_network(ie)%indx => null() + hillslope_network(ie)%area => null() + hillslope_network(ie)%agwt => null() + hillslope_network(ie)%hand => null() + hillslope_network(ie)%elva => null() + hillslope_network(ie)%plen => null() + hillslope_network(ie)%flen => null() + hillslope_network(ie)%inext => null() ENDIF + + hillslope_network(ie)%nhru = nhru_in_bsn(ie) + hs = hs + nhru_in_bsn(ie) + ENDDO ENDIF - + + IF (allocated(nhru_all )) deallocate(nhru_all ) + IF (allocated(nhru_in_bsn)) deallocate(nhru_in_bsn) + IF (allocated(indxhru)) deallocate(indxhru) IF (allocated(areahru)) deallocate(areahru) IF (allocated(handhru)) deallocate(handhru) @@ -338,37 +328,29 @@ SUBROUTINE hillslope_network_init () #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) - IF (p_is_master) write(*,'(A)') 'Read surface network information done.' + IF (p_is_master) write(*,'(A)') 'Read hillslope network information done.' CALL mpi_barrier (p_comm_glb, p_err) #endif END SUBROUTINE hillslope_network_init - ! ---------- - SUBROUTINE hillslope_network_final () + ! --------- + SUBROUTINE hillslope_network_free_mem (this) IMPLICIT NONE - - ! Local Variables - integer :: ibasin - - IF (associated(hillslope_network)) THEN - DO ibasin = 1, size(hillslope_network) - IF (associated(hillslope_network(ibasin)%ihru )) deallocate(hillslope_network(ibasin)%ihru ) - IF (associated(hillslope_network(ibasin)%indx )) deallocate(hillslope_network(ibasin)%indx ) - IF (associated(hillslope_network(ibasin)%area )) deallocate(hillslope_network(ibasin)%area ) - IF (associated(hillslope_network(ibasin)%agwt )) deallocate(hillslope_network(ibasin)%agwt ) - IF (associated(hillslope_network(ibasin)%hand )) deallocate(hillslope_network(ibasin)%hand ) - IF (associated(hillslope_network(ibasin)%elva )) deallocate(hillslope_network(ibasin)%elva ) - IF (associated(hillslope_network(ibasin)%plen )) deallocate(hillslope_network(ibasin)%plen ) - IF (associated(hillslope_network(ibasin)%flen )) deallocate(hillslope_network(ibasin)%flen ) - IF (associated(hillslope_network(ibasin)%inext)) deallocate(hillslope_network(ibasin)%inext) - ENDDO - - deallocate(hillslope_network) - ENDIF - - END SUBROUTINE hillslope_network_final - + type(hillslope_network_type) :: this + + IF (associated(this%ihru )) deallocate(this%ihru ) + IF (associated(this%indx )) deallocate(this%indx ) + IF (associated(this%area )) deallocate(this%area ) + IF (associated(this%agwt )) deallocate(this%agwt ) + IF (associated(this%hand )) deallocate(this%hand ) + IF (associated(this%elva )) deallocate(this%elva ) + IF (associated(this%plen )) deallocate(this%plen ) + IF (associated(this%flen )) deallocate(this%flen ) + IF (associated(this%inext)) deallocate(this%inext) + + END SUBROUTINE hillslope_network_free_mem + END MODULE MOD_Catch_HillslopeNetwork #endif diff --git a/main/HYDRO/MOD_Hydro_Hist.F90 b/main/HYDRO/MOD_Catch_Hist.F90 similarity index 53% rename from main/HYDRO/MOD_Hydro_Hist.F90 rename to main/HYDRO/MOD_Catch_Hist.F90 index aa7a072e..a62e16c4 100644 --- a/main/HYDRO/MOD_Hydro_Hist.F90 +++ b/main/HYDRO/MOD_Catch_Hist.F90 @@ -1,7 +1,7 @@ #include #ifdef CatchLateralFlow -MODULE MOD_Hydro_Hist +MODULE MOD_Catch_Hist !-------------------------------------------------------------------------------- ! DESCRIPTION: ! @@ -13,26 +13,33 @@ MODULE MOD_Hydro_Hist USE MOD_Precision USE MOD_SPMD_Task USE MOD_NetCDFSerial - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only : spval USE MOD_Mesh, only : numelm USE MOD_LandHRU, only : numhru - USE MOD_Hydro_Vars_TimeVariables - USE MOD_Hydro_Vars_1DFluxes - USE MOD_Hydro_IO + USE MOD_Catch_BasinNetwork, only : numbasin, numbsnhru + USE MOD_Catch_Vars_1DFluxes + USE MOD_Catch_IO ! -- ACC Fluxes -- integer :: nac_basin - real(r8), allocatable :: a_wdsrf_hru (:) - real(r8), allocatable :: a_veloc_hru (:) + real(r8), allocatable :: a_wdsrf_bsnhru (:) + real(r8), allocatable :: a_veloc_bsnhru (:) + + real(r8), allocatable :: a_wdsrf_hru (:) + real(r8), allocatable :: a_veloc_hru (:) - real(r8), allocatable :: a_xsubs_bsn (:) - real(r8), allocatable :: a_xsubs_hru (:) + real(r8), allocatable :: a_wdsrf_bsn (:) + real(r8), allocatable :: a_veloc_riv (:) + real(r8), allocatable :: a_discharge (:) - real(r8), allocatable :: a_height_riv (:) - real(r8), allocatable :: a_veloct_riv (:) - real(r8), allocatable :: a_discharge (:) + real(r8), allocatable :: a_wdsrf_elm (:) + real(r8), allocatable :: a_veloc_elm (:) + real(r8), allocatable :: a_dschg_elm (:) + + real(r8), allocatable :: a_xsubs_elm (:) + real(r8), allocatable :: a_xsubs_hru (:) ! -- PUBLIC SUBROUTINEs -- PUBLIC :: hist_basin_init @@ -46,23 +53,20 @@ SUBROUTINE hist_basin_init IMPLICIT NONE - integer :: numbasin - - numbasin = numelm - IF (p_is_worker) THEN - IF (numhru > 0) THEN - allocate ( a_wdsrf_hru (numhru)) - allocate ( a_veloc_hru (numhru)) - allocate ( a_xsubs_hru (numhru)) + IF (numbsnhru > 0) THEN + allocate (a_wdsrf_bsnhru (numbsnhru)) + allocate (a_veloc_bsnhru (numbsnhru)) ENDIF IF (numbasin > 0) THEN - allocate ( a_height_riv (numbasin)) - allocate ( a_veloct_riv (numbasin)) - allocate ( a_discharge (numbasin)) - allocate ( a_xsubs_bsn (numbasin)) + allocate (a_wdsrf_bsn (numbasin)) + allocate (a_veloc_riv (numbasin)) + allocate (a_discharge (numbasin)) ENDIF + + IF (numelm > 0) allocate (a_xsubs_elm (numelm)) + IF (numhru > 0) allocate (a_xsubs_hru (numhru)) ENDIF CALL FLUSH_acc_fluxes_basin () @@ -74,15 +78,15 @@ SUBROUTINE hist_basin_final () IMPLICIT NONE - IF (allocated(a_wdsrf_hru )) deallocate(a_wdsrf_hru ) - IF (allocated(a_veloc_hru )) deallocate(a_veloc_hru ) - - IF (allocated(a_xsubs_bsn )) deallocate(a_xsubs_bsn ) - IF (allocated(a_xsubs_hru )) deallocate(a_xsubs_hru ) + IF (allocated(a_wdsrf_bsnhru)) deallocate(a_wdsrf_bsnhru) + IF (allocated(a_veloc_bsnhru)) deallocate(a_veloc_bsnhru) - IF (allocated(a_height_riv)) deallocate(a_height_riv) - IF (allocated(a_veloct_riv)) deallocate(a_veloct_riv) - IF (allocated(a_discharge )) deallocate(a_discharge ) + IF (allocated(a_wdsrf_bsn)) deallocate(a_wdsrf_bsn) + IF (allocated(a_veloc_riv)) deallocate(a_veloc_riv) + IF (allocated(a_discharge)) deallocate(a_discharge) + + IF (allocated(a_xsubs_elm)) deallocate(a_xsubs_elm) + IF (allocated(a_xsubs_hru)) deallocate(a_xsubs_hru) END SUBROUTINE hist_basin_final @@ -94,6 +98,8 @@ SUBROUTINE hist_basin_out (file_hist, idate) USE MOD_SPMD_Task USE MOD_ElmVector USE MOD_HRUVector + USE MOD_LandHRU + USE MOD_Catch_BasinNetwork IMPLICIT NONE character(len=*), intent(in) :: file_hist @@ -104,7 +110,7 @@ SUBROUTINE hist_basin_out (file_hist, idate) logical :: fexists integer :: itime_in_file logical, allocatable :: filter(:) - integer :: numbasin, i + integer :: i IF (p_is_master) THEN @@ -137,68 +143,97 @@ SUBROUTINE hist_basin_out (file_hist, idate) ENDIF - numbasin = numelm - + IF (p_is_worker) THEN - WHERE(a_height_riv /= spval) - a_height_riv = a_height_riv / nac_basin + IF (numhru > 0) THEN + allocate (a_wdsrf_hru (numhru)) + allocate (a_veloc_hru (numhru)) + ENDIF + + IF (numelm > 0) THEN + allocate (a_wdsrf_elm (numelm)) + allocate (a_veloc_elm (numelm)) + allocate (a_dschg_elm (numelm)) + ENDIF + ENDIF + + ! ----- water depth in basin ----- + IF ((p_is_worker) .and. allocated(a_wdsrf_bsn)) THEN + WHERE(a_wdsrf_bsn /= spval) + a_wdsrf_bsn = a_wdsrf_bsn / nac_basin END WHERE ENDIF + + CALL worker_push_data (iam_bsn, iam_elm, .false., a_wdsrf_bsn, a_wdsrf_elm) CALL vector_write_basin (& - file_hist_basin, a_height_riv, numbasin, totalnumelm, 'wdsrf_bsn', 'basin', elm_data_address, & + file_hist_basin, a_wdsrf_elm, numelm, totalnumelm, 'wdsrf_bsn', 'basin', elm_data_address, & DEF_hist_vars%riv_height, itime_in_file, 'River Height', 'm') - IF (p_is_worker) THEN - WHERE(a_veloct_riv /= spval) - a_veloct_riv = a_veloct_riv / nac_basin + ! ----- water velocity in river ----- + IF ((p_is_worker) .and. allocated(a_veloc_riv)) THEN + WHERE(a_veloc_riv /= spval) + a_veloc_riv = a_veloc_riv / nac_basin END WHERE ENDIF + + CALL worker_push_data (iam_bsn, iam_elm, .false., a_veloc_riv, a_veloc_elm) CALL vector_write_basin (& - file_hist_basin, a_veloct_riv, numbasin, totalnumelm, 'veloc_riv', 'basin', elm_data_address, & + file_hist_basin, a_veloc_elm, numelm, totalnumelm, 'veloc_riv', 'basin', elm_data_address, & DEF_hist_vars%riv_veloct, itime_in_file, 'River Velocity', 'm/s') - IF (p_is_worker) THEN + ! ----- discharge in river ----- + IF ((p_is_worker) .and. allocated(a_discharge)) THEN WHERE(a_discharge /= spval) a_discharge = a_discharge / nac_basin END WHERE ENDIF + + CALL worker_push_data (iam_bsn, iam_elm, .false., a_discharge, a_dschg_elm) CALL vector_write_basin (& - file_hist_basin, a_discharge, numbasin, totalnumelm, 'discharge', 'basin', elm_data_address, & + file_hist_basin, a_dschg_elm, numelm, totalnumelm, 'discharge', 'basin', elm_data_address, & DEF_hist_vars%discharge, itime_in_file, 'River Discharge', 'm^3/s') - IF (p_is_worker) THEN - WHERE(a_wdsrf_hru /= spval) - a_wdsrf_hru = a_wdsrf_hru / nac_basin + ! ----- water depth in hydro unit ----- + IF ((p_is_worker) .and. allocated(a_wdsrf_bsnhru)) THEN + WHERE(a_wdsrf_bsnhru /= spval) + a_wdsrf_bsnhru = a_wdsrf_bsnhru / nac_basin END WHERE ENDIF + + CALL worker_push_subset_data (iam_bsn, iam_elm, basin_hru, elm_hru, a_wdsrf_bsnhru, a_wdsrf_hru) CALL vector_write_basin (& file_hist_basin, a_wdsrf_hru, numhru, totalnumhru, 'wdsrf_hru', 'hydrounit', hru_data_address, & DEF_hist_vars%wdsrf_hru, itime_in_file, 'Depth of Surface Water in Hydro unit', 'm') - IF (p_is_worker) THEN - WHERE(a_veloc_hru /= spval) - a_veloc_hru = a_veloc_hru / nac_basin + ! ----- water velocity in hydro unit ----- + IF ((p_is_worker) .and. allocated(a_veloc_bsnhru)) THEN + WHERE(a_veloc_bsnhru /= spval) + a_veloc_bsnhru = a_veloc_bsnhru / nac_basin END WHERE ENDIF + + CALL worker_push_subset_data (iam_bsn, iam_elm, basin_hru, elm_hru, a_veloc_bsnhru, a_veloc_hru) CALL vector_write_basin (& file_hist_basin, a_veloc_hru, numhru, totalnumhru, 'veloc_hru', 'hydrounit', hru_data_address, & DEF_hist_vars%veloc_hru, itime_in_file, 'Surface Flow Velocity in Hydro unit', 'm/s') + ! ----- subsurface water flow between elements ----- IF (p_is_worker) THEN - WHERE(a_xsubs_bsn /= spval) - a_xsubs_bsn = a_xsubs_bsn / nac_basin + WHERE(a_xsubs_elm /= spval) + a_xsubs_elm = a_xsubs_elm / nac_basin END WHERE ENDIF CALL vector_write_basin (& - file_hist_basin, a_xsubs_bsn, numbasin, totalnumelm, 'xsubs_bsn', 'basin', elm_data_address, & + file_hist_basin, a_xsubs_elm, numelm, totalnumelm, 'xsubs_bsn', 'basin', elm_data_address, & DEF_hist_vars%xsubs_bsn, itime_in_file, 'Subsurface lateral flow between basins', 'm/s') + ! ----- subsurface water flow between hydro units ----- IF (p_is_worker) THEN WHERE(a_xsubs_hru /= spval) a_xsubs_hru = a_xsubs_hru / nac_basin @@ -209,8 +244,16 @@ SUBROUTINE hist_basin_out (file_hist, idate) file_hist_basin, a_xsubs_hru, numhru, totalnumhru, 'xsubs_hru', 'hydrounit', hru_data_address, & DEF_hist_vars%xsubs_hru, itime_in_file, 'SubSurface lateral flow between HRUs', 'm/s') + CALL FLUSH_acc_fluxes_basin () + IF (allocated(a_wdsrf_hru)) deallocate(a_wdsrf_hru) + IF (allocated(a_veloc_hru)) deallocate(a_veloc_hru) + + IF (allocated(a_wdsrf_elm)) deallocate(a_wdsrf_elm) + IF (allocated(a_veloc_elm)) deallocate(a_veloc_elm) + IF (allocated(a_dschg_elm)) deallocate(a_dschg_elm) + END SUBROUTINE hist_basin_out !----------------------- @@ -222,26 +265,24 @@ SUBROUTINE FLUSH_acc_fluxes_basin () USE MOD_Vars_Global, only : spval IMPLICIT NONE - integer :: numbasin - IF (p_is_worker) THEN - numbasin = numelm - nac_basin = 0 IF (numbasin > 0) THEN - a_height_riv(:) = spval - a_veloct_riv(:) = spval - a_discharge (:) = spval - a_xsubs_bsn (:) = spval + a_wdsrf_bsn(:) = spval + a_veloc_riv(:) = spval + a_discharge(:) = spval ENDIF - IF (numhru > 0) THEN - a_wdsrf_hru(:) = spval - a_veloc_hru(:) = spval - a_xsubs_hru(:) = spval + IF (numelm > 0) a_xsubs_elm (:) = spval + + IF (numbsnhru > 0) THEN + a_wdsrf_bsnhru(:) = spval + a_veloc_bsnhru(:) = spval ENDIF + + IF (numhru > 0) a_xsubs_hru(:) = spval ENDIF @@ -252,26 +293,25 @@ SUBROUTINE accumulate_fluxes_basin IMPLICIT NONE - integer :: numbasin - IF (p_is_worker) THEN nac_basin = nac_basin + 1 - numbasin = numelm - IF (numbasin > 0) THEN - CALL acc1d_basin (wdsrf_bsn_ta, a_height_riv) - CALL acc1d_basin (veloc_riv_ta, a_veloct_riv) - CALL acc1d_basin (discharge , a_discharge ) - CALL acc1d_basin (xsubs_bsn , a_xsubs_bsn ) + CALL acc1d_basin (wdsrf_bsn_ta, a_wdsrf_bsn) + CALL acc1d_basin (veloc_riv_ta, a_veloc_riv) + CALL acc1d_basin (discharge_ta, a_discharge ) ENDIF + + IF (numelm > 0) CALL acc1d_basin (xsubs_elm, a_xsubs_elm) - IF (numhru > 0) THEN - CALL acc1d_basin (wdsrf_hru_ta, a_wdsrf_hru) - CALL acc1d_basin (veloc_hru_ta, a_veloc_hru) - CALL acc1d_basin (xsubs_hru , a_xsubs_hru) + IF (numbsnhru > 0) THEN + CALL acc1d_basin (wdsrf_bsnhru_ta, a_wdsrf_bsnhru) + CALL acc1d_basin (veloc_bsnhru_ta, a_veloc_bsnhru) ENDIF + + IF (numhru > 0) CALL acc1d_basin (xsubs_hru, a_xsubs_hru) + ENDIF END SUBROUTINE accumulate_fluxes_basin @@ -301,5 +341,5 @@ SUBROUTINE acc1d_basin (var, s) END SUBROUTINE acc1d_basin -END MODULE MOD_Hydro_Hist +END MODULE MOD_Catch_Hist #endif diff --git a/main/HYDRO/MOD_Hydro_IO.F90 b/main/HYDRO/MOD_Catch_IO.F90 similarity index 71% rename from main/HYDRO/MOD_Hydro_IO.F90 rename to main/HYDRO/MOD_Catch_IO.F90 index fbd9f4a9..e7698d3d 100644 --- a/main/HYDRO/MOD_Hydro_IO.F90 +++ b/main/HYDRO/MOD_Catch_IO.F90 @@ -1,7 +1,7 @@ #include #ifdef CatchLateralFlow -MODULE MOD_Hydro_IO +MODULE MOD_Catch_IO !----------------------------------------------------------------------- ! DESCRIPTION: ! @@ -11,11 +11,7 @@ MODULE MOD_Hydro_IO !----------------------------------------------------------------------- PUBLIC :: vector_write_basin - - INTERFACE vector_read_basin - MODULE procedure vector_read_basin_real8 - MODULE procedure vector_read_basin_int32 - END INTERFACE vector_read_basin + PUBLIC :: vector_read_basin CONTAINS @@ -124,7 +120,7 @@ SUBROUTINE vector_write_basin ( & END SUBROUTINE vector_write_basin ! ----- - SUBROUTINE vector_read_basin_real8 ( & + SUBROUTINE vector_read_basin ( & file_basin, vector, vlen, varname, data_address) USE MOD_Precision @@ -182,68 +178,7 @@ SUBROUTINE vector_read_basin_real8 ( & IF (p_is_master) deallocate(rdata) - END SUBROUTINE vector_read_basin_real8 - - ! ----- - SUBROUTINE vector_read_basin_int32 ( & - file_basin, vector, vlen, varname, data_address) - - USE MOD_Precision - USE MOD_SPMD_Task - USE MOD_DataType - USE MOD_NetCDFSerial - IMPLICIT NONE - - character(len=*), intent(in) :: file_basin - integer, allocatable, intent(inout) :: vector (:) - integer, intent(in) :: vlen - character(len=*), intent(in) :: varname - type(pointer_int32_1d), intent(in) :: data_address (0:) - - ! Local variables - integer :: iwork, ndata - integer, allocatable :: rdata(:), rcache(:) - - IF (p_is_master) THEN - CALL ncio_read_serial (file_basin, varname, rdata) - ENDIF - -#ifdef USEMPI - CALL mpi_barrier (p_comm_glb, p_err) - - IF (p_is_master) THEN - DO iwork = 0, p_np_worker-1 - IF (allocated(data_address(iwork)%val)) THEN - - ndata = size(data_address(iwork)%val) - allocate(rcache (ndata)) - rcache = rdata(data_address(iwork)%val) - - CALL mpi_send (rcache, ndata, MPI_INTEGER4, & - p_address_worker(iwork), mpi_tag_data, p_comm_glb, p_err) - - deallocate (rcache) - ENDIF - ENDDO - ENDIF - - IF (p_is_worker) THEN - IF (vlen > 0) THEN - IF (.not. allocated(vector)) allocate(vector(vlen)) - CALL mpi_recv (vector, vlen, MPI_INTEGER4, p_address_master, & - mpi_tag_data, p_comm_glb, p_stat, p_err) - ENDIF - ENDIF - - CALL mpi_barrier (p_comm_glb, p_err) -#else - IF (.not. allocated(vector)) allocate(vector(vlen)) - vector = rdata(data_address(0)%val) -#endif - - IF (p_is_master) deallocate(rdata) - - END SUBROUTINE vector_read_basin_int32 + END SUBROUTINE vector_read_basin -END MODULE MOD_Hydro_IO +END MODULE MOD_Catch_IO #endif diff --git a/main/HYDRO/MOD_Catch_LateralFlow.F90 b/main/HYDRO/MOD_Catch_LateralFlow.F90 index c3041a29..1ca274d8 100644 --- a/main/HYDRO/MOD_Catch_LateralFlow.F90 +++ b/main/HYDRO/MOD_Catch_LateralFlow.F90 @@ -21,8 +21,9 @@ MODULE MOD_Catch_LateralFlow USE MOD_Precision USE MOD_SPMD_Task - USE MOD_Hydro_Vars_TimeVariables + USE MOD_Catch_Vars_TimeVariables USE MOD_ElementNeighbour + USE MOD_Catch_BasinNetwork USE MOD_Catch_RiverLakeNetwork USE MOD_Catch_HillslopeNetwork USE MOD_Catch_HillslopeFlow @@ -62,10 +63,8 @@ SUBROUTINE lateral_flow_init (lc_year) #endif CALL element_neighbour_init (lc_year) - - CALL hillslope_network_init () CALL river_lake_network_init () - CALL basin_neighbour_init () + CALL subsurface_network_init () #ifdef CoLMDEBUG IF (p_is_worker) THEN @@ -95,16 +94,16 @@ SUBROUTINE lateral_flow (deltime) USE MOD_Namelist, only : DEF_USE_Dynamic_Lake USE MOD_Mesh, only : numelm - USE MOD_LandHRU, only : landhru, numhru, basin_hru + USE MOD_LandHRU, only : landhru, numhru, elm_hru USE MOD_LandPatch, only : numpatch, elm_patch, hru_patch USE MOD_Vars_Global, only : nl_lake USE MOD_Const_Physical, only : tfrz - USE MOD_Vars_1DFluxes, only : rsur, rsub, rnof USE MOD_Vars_TimeVariables, only : wdsrf, t_lake, lake_icefrac, t_soisno USE MOD_Vars_TimeInvariants, only : lakedepth, dz_lake - USE MOD_Hydro_Vars_1DFluxes - USE MOD_Hydro_Vars_TimeVariables + USE MOD_Catch_Vars_1DFluxes + USE MOD_Catch_Vars_TimeVariables + USE MOD_Catch_RiverLakeNetwork USE MOD_Lake, only : adjust_lake_layer @@ -114,7 +113,7 @@ SUBROUTINE lateral_flow (deltime) real(r8), intent(in) :: deltime ! Local Variables - integer :: numbasin, ibasin, ihru, i, j, ps, pe, istep + integer :: i, ps, pe, istep real(r8), allocatable :: wdsrf_p (:) #ifdef CoLMDEBUG real(r8) :: dtolw, toldis @@ -122,13 +121,11 @@ SUBROUTINE lateral_flow (deltime) IF (p_is_worker) THEN - numbasin = numelm - ! a) The smallest unit in surface lateral flow (including hillslope flow and river-lake flow) - ! is HRU and the main prognostic variable is "wdsrf_hru" (surface water depth). - ! b) "wdsrf_hru" is updated by aggregating water depths in patches. + ! is HRU and the main prognostic variable is "wdsrf_bsnhru" (surface water depth). + ! b) "wdsrf_bsnhru" is updated by aggregating water depths in patches. ! c) Water surface in a basin ("wdsrf_bsn", defined as the lowest surface water in the basin) - ! is derived from "wdsrf_hru". + ! is derived from "wdsrf_bsnhru". DO i = 1, numhru ps = hru_patch%substt(i) pe = hru_patch%subend(i) @@ -136,11 +133,6 @@ SUBROUTINE lateral_flow (deltime) wdsrf_hru(i) = wdsrf_hru(i) / 1.0e3 ! mm to m ENDDO - wdsrf_hru_ta(:) = 0 - momen_hru_ta(:) = 0 - wdsrf_bsn_ta(:) = 0 - momen_riv_ta(:) = 0 - IF (numpatch > 0) THEN allocate (wdsrf_p (numpatch)) wdsrf_p = wdsrf @@ -148,8 +140,13 @@ SUBROUTINE lateral_flow (deltime) dt_average = 0. - IF (numpatch > 0) rsur (:) = 0. - IF (numbasin > 0) discharge(:) = 0. + IF (numbasin > 0) wdsrf_bsn_ta (:) = 0. + IF (numbasin > 0) momen_riv_ta (:) = 0. + IF (numbasin > 0) discharge_ta (:) = 0. + IF (numbsnhru > 0) wdsrf_bsnhru_ta (:) = 0. + IF (numbsnhru > 0) momen_bsnhru_ta (:) = 0. + + CALL worker_push_subset_data (iam_elm, iam_bsn, elm_hru, basin_hru, wdsrf_hru, wdsrf_bsnhru) DO istep = 1, nsubstep @@ -163,9 +160,6 @@ SUBROUTINE lateral_flow (deltime) ENDDO - IF (numpatch > 0) rsur = rsur / deltime - IF (numbasin > 0) discharge = discharge / deltime - IF (numbasin > 0) THEN wdsrf_bsn_ta(:) = wdsrf_bsn_ta(:) / deltime momen_riv_ta(:) = momen_riv_ta(:) / deltime @@ -175,20 +169,23 @@ SUBROUTINE lateral_flow (deltime) ELSE WHERE veloc_riv_ta = 0 END WHERE + + discharge_ta = discharge_ta / deltime ENDIF - IF (numhru > 0) THEN - wdsrf_hru_ta(:) = wdsrf_hru_ta(:) / deltime - momen_hru_ta(:) = momen_hru_ta(:) / deltime + IF (numbsnhru > 0) THEN + wdsrf_bsnhru_ta(:) = wdsrf_bsnhru_ta(:) / deltime + momen_bsnhru_ta(:) = momen_bsnhru_ta(:) / deltime - WHERE (wdsrf_hru_ta > 0) - veloc_hru_ta = momen_hru_ta / wdsrf_hru_ta + WHERE (wdsrf_bsnhru_ta > 0) + veloc_bsnhru_ta = momen_bsnhru_ta / wdsrf_bsnhru_ta ELSE WHERE - veloc_hru_ta = 0. + veloc_bsnhru_ta = 0. END WHERE ENDIF ! update surface water depth on patches + CALL worker_push_subset_data (iam_bsn, iam_elm, basin_hru, elm_hru, wdsrf_bsnhru, wdsrf_hru) DO i = 1, numhru ps = hru_patch%substt(i) pe = hru_patch%subend(i) @@ -202,10 +199,6 @@ SUBROUTINE lateral_flow (deltime) ! (3) Subsurface lateral flow. CALL subsurface_flow (deltime) - IF (numpatch > 0) THEN - rnof(:) = rsur(:) + rsub(:) - ENDIF - DO i = 1, numpatch h2osoi(:,i) = wliq_soisno(1:,i)/(dz_soi(1:)*denh2o) + wice_soisno(1:,i)/(dz_soi(1:)*denice) wat(i) = sum(wice_soisno(1:,i)+wliq_soisno(1:,i)) + ldew(i) + scv(i) + wetwat(i) @@ -247,9 +240,9 @@ SUBROUTINE lateral_flow (deltime) CALL check_vector_data ('Basin Water Depth [m] ', wdsrf_bsn) CALL check_vector_data ('River Velocity [m/s]', veloc_riv) - CALL check_vector_data ('HRU Water Depth [m] ', wdsrf_hru) - CALL check_vector_data ('HRU Water Velocity [m/s]', veloc_hru) - CALL check_vector_data ('Subsurface bt basin [m/s]', xsubs_bsn) + CALL check_vector_data ('HRU Water Depth [m] ', wdsrf_bsnhru) + CALL check_vector_data ('HRU Water Velocity [m/s]', veloc_bsnhru) + CALL check_vector_data ('Subsurface bt basin [m/s]', xsubs_elm) CALL check_vector_data ('Subsurface bt HRU [m/s]', xsubs_hru) CALL check_vector_data ('Subsurface bt patch [m/s]', xsubs_pch) @@ -262,8 +255,8 @@ SUBROUTINE lateral_flow (deltime) IF (numpatch > 0) THEN dtolw = sum(patcharea * xwsur) / 1.e3 * deltime ENDIF - IF (numelm > 0) THEN - toldis = sum(discharge*deltime, mask = (riverdown == 0) .or. (riverdown == -3)) + IF (numbasin > 0) THEN + toldis = sum(discharge_ta*deltime, mask = (riverdown == 0) .or. (riverdown == -3)) dtolw = dtolw - toldis ENDIF @@ -296,9 +289,8 @@ SUBROUTINE lateral_flow_final () IMPLICIT NONE - CALL hillslope_network_final () CALL river_lake_network_final () - CALL basin_neighbour_final () + CALL subsurface_network_final () #ifdef CoLMDEBUG IF (allocated(patcharea)) deallocate(patcharea) diff --git a/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 b/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 index cf4e61fc..a93dac1a 100644 --- a/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 +++ b/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 @@ -36,20 +36,17 @@ MODULE MOD_Catch_RiverLakeFlow SUBROUTINE river_lake_flow (dt) USE MOD_SPMD_Task - USE MOD_Mesh - USE MOD_LandHRU - USE MOD_LandPatch - USE MOD_Vars_TimeVariables - USE MOD_Hydro_Vars_1DFluxes + USE MOD_Catch_BasinNetwork USE MOD_Catch_HillslopeNetwork USE MOD_Catch_RiverLakeNetwork + USE MOD_Catch_Vars_TimeVariables + USE MOD_Catch_Vars_1DFluxes USE MOD_Const_Physical, only : grav IMPLICIT NONE real(r8), intent(in) :: dt ! Local Variables - integer :: nbasin integer :: hs, he, i, j real(r8), allocatable :: wdsrf_bsn_ds(:) @@ -74,22 +71,20 @@ SUBROUTINE river_lake_flow (dt) IF (p_is_worker) THEN - nbasin = numelm - ! update water depth in basin by aggregating water depths in patches - DO i = 1, nbasin + DO i = 1, numbasin hs = basin_hru%substt(i) he = basin_hru%subend(i) IF (lake_id(i) <= 0) THEN ! river or lake catchment ! Water surface in a basin is defined as the lowest surface water in the basin - wdsrf_bsn(i) = minval(hillslope_network(i)%hand + wdsrf_hru(hs:he)) - handmin(i) + wdsrf_bsn(i) = minval(hillslope_basin(i)%hand + wdsrf_bsnhru(hs:he)) - handmin(i) ELSEIF (lake_id(i) > 0) THEN ! lake - totalvolume = sum(wdsrf_hru(hs:he) * lakes(i)%area0) - wdsrf_bsn(i) = lakes(i)%surface(totalvolume) + totalvolume = sum(wdsrf_bsnhru(hs:he) * lakeinfo(i)%area0) + wdsrf_bsn(i) = lakeinfo(i)%surface(totalvolume) ENDIF @@ -110,16 +105,16 @@ SUBROUTINE river_lake_flow (dt) ENDDO - IF (nbasin > 0) THEN - allocate (wdsrf_bsn_ds (nbasin)) - allocate (veloc_riv_ds (nbasin)) - allocate (momen_riv_ds (nbasin)) - allocate (hflux_fc (nbasin)) - allocate (mflux_fc (nbasin)) - allocate (zgrad_dn (nbasin)) - allocate (sum_hflux_riv (nbasin)) - allocate (sum_mflux_riv (nbasin)) - allocate (sum_zgrad_riv (nbasin)) + IF (numbasin > 0) THEN + allocate (wdsrf_bsn_ds (numbasin)) + allocate (veloc_riv_ds (numbasin)) + allocate (momen_riv_ds (numbasin)) + allocate (hflux_fc (numbasin)) + allocate (mflux_fc (numbasin)) + allocate (zgrad_dn (numbasin)) + allocate (sum_hflux_riv (numbasin)) + allocate (sum_mflux_riv (numbasin)) + allocate (sum_zgrad_riv (numbasin)) ENDIF ntimestep_riverlake = 0 @@ -128,35 +123,26 @@ SUBROUTINE river_lake_flow (dt) ntimestep_riverlake = ntimestep_riverlake + 1 - DO i = 1, nbasin + DO i = 1, numbasin sum_hflux_riv(i) = 0. sum_mflux_riv(i) = 0. sum_zgrad_riv(i) = 0. - - IF (addrdown(i) > 0) THEN - wdsrf_bsn_ds(i) = wdsrf_bsn(addrdown(i)) - veloc_riv_ds(i) = veloc_riv(addrdown(i)) - momen_riv_ds(i) = momen_riv(addrdown(i)) - ELSE - wdsrf_bsn_ds(i) = 0 - veloc_riv_ds(i) = 0 - momen_riv_ds(i) = 0 - ENDIF ENDDO -#ifdef USEMPI - CALL river_data_exchange (SEND_DATA_DOWN_TO_UP, accum = .false., & - vec_send1 = wdsrf_bsn, vec_recv1 = wdsrf_bsn_ds, & - vec_send2 = veloc_riv, vec_recv2 = veloc_riv_ds, & - vec_send3 = momen_riv, vec_recv3 = momen_riv_ds ) -#endif + + CALL worker_push_data (river_iam_dn, river_iam_up, .false., wdsrf_bsn, wdsrf_bsn_ds) + CALL worker_push_data (river_iam_dn, river_iam_up, .false., veloc_riv, veloc_riv_ds) + CALL worker_push_data (river_iam_dn, river_iam_up, .false., momen_riv, momen_riv_ds) + ! velocity in ocean or inland depression is assumed to be 0. - WHERE (riverdown <= 0) - veloc_riv_ds = 0. - END WHERE + IF (numbasin > 0) THEN + WHERE (riverdown <= 0) + veloc_riv_ds = 0. + END WHERE + ENDIF dt_this = dt_res - DO i = 1, nbasin + DO i = 1, numbasin IF (riverdown(i) >= 0) THEN IF (riverdown(i) > 0) THEN @@ -275,34 +261,28 @@ SUBROUTINE river_lake_flow (dt) IF ((lake_id(i) < 0) .and. (hflux_fc(i) < 0)) THEN hflux_fc(i) = & - max(hflux_fc(i), (height_up-height_dn) / dt_this * sum(hillslope_network(i)%area, & - mask = hillslope_network(i)%hand <= wdsrf_bsn(i) + handmin(i))) + max(hflux_fc(i), (height_up-height_dn) / dt_this * sum(hillslope_basin(i)%area, & + mask = hillslope_basin(i)%hand <= wdsrf_bsn(i) + handmin(i))) ENDIF sum_hflux_riv(i) = sum_hflux_riv(i) + hflux_fc(i) sum_mflux_riv(i) = sum_mflux_riv(i) + mflux_fc(i) - IF (addrdown(i) > 0) THEN - j = addrdown(i) - sum_hflux_riv(j) = sum_hflux_riv(j) - hflux_fc(i) - sum_mflux_riv(j) = sum_mflux_riv(j) - mflux_fc(i) - sum_zgrad_riv(j) = sum_zgrad_riv(j) - zgrad_dn(i) - ENDIF - ENDDO -#ifdef USEMPI - hflux_fc = - hflux_fc; mflux_fc = - mflux_fc; zgrad_dn = - zgrad_dn + IF (numbasin > 0) THEN + hflux_fc = - hflux_fc; mflux_fc = - mflux_fc; zgrad_dn = - zgrad_dn + ENDIF - CALL river_data_exchange (SEND_DATA_UP_TO_DOWN, accum = .true., & - vec_send1 = hflux_fc, vec_recv1 = sum_hflux_riv, & - vec_send2 = mflux_fc, vec_recv2 = sum_mflux_riv, & - vec_send3 = zgrad_dn, vec_recv3 = sum_zgrad_riv) + CALL worker_push_data (river_iam_up, river_iam_dn, .true., hflux_fc, sum_hflux_riv) + CALL worker_push_data (river_iam_up, river_iam_dn, .true., mflux_fc, sum_mflux_riv) + CALL worker_push_data (river_iam_up, river_iam_dn, .true., zgrad_dn, sum_zgrad_riv) - hflux_fc = - hflux_fc; mflux_fc = - mflux_fc; zgrad_dn = - zgrad_dn -#endif + IF (numbasin > 0) THEN + hflux_fc = - hflux_fc; mflux_fc = - mflux_fc; zgrad_dn = - zgrad_dn + ENDIF - DO i = 1, nbasin + DO i = 1, numbasin ! constraint 1: CFL condition (only for rivers) IF (lake_id(i) == 0) THEN IF ((veloc_riv(i) /= 0.) .or. (wdsrf_bsn(i) > 0.)) THEN @@ -314,12 +294,12 @@ SUBROUTINE river_lake_flow (dt) IF (sum_hflux_riv(i) > 0) THEN IF (lake_id(i) <= 0) THEN ! for river or lake catchment - totalvolume = sum((wdsrf_bsn(i) + handmin(i) - hillslope_network(i)%hand) & - * hillslope_network(i)%area, & - mask = wdsrf_bsn(i) + handmin(i) >= hillslope_network(i)%hand) + totalvolume = sum((wdsrf_bsn(i) + handmin(i) - hillslope_basin(i)%hand) & + * hillslope_basin(i)%area, & + mask = wdsrf_bsn(i) + handmin(i) >= hillslope_basin(i)%hand) ELSEIF (lake_id(i) > 0) THEN ! for lake - totalvolume = lakes(i)%volume(wdsrf_bsn(i)) + totalvolume = lakeinfo(i)%volume(wdsrf_bsn(i)) ENDIF dt_this = min(dt_this, totalvolume / sum_hflux_riv(i)) @@ -340,25 +320,25 @@ SUBROUTINE river_lake_flow (dt) CALL mpi_allreduce (MPI_IN_PLACE, dt_this, 1, MPI_REAL8, MPI_MIN, p_comm_worker, p_err) #endif - DO i = 1, nbasin + DO i = 1, numbasin IF (lake_id(i) <= 0) THEN ! rivers or lake catchments hs = basin_hru%substt(i) he = basin_hru%subend(i) - allocate (mask (hillslope_network(i)%nhru)) + allocate (mask (hillslope_basin(i)%nhru)) - totalvolume = sum((wdsrf_bsn(i) + handmin(i) - hillslope_network(i)%hand) & - * hillslope_network(i)%area, & - mask = wdsrf_bsn(i) + handmin(i) >= hillslope_network(i)%hand) + totalvolume = sum((wdsrf_bsn(i) + handmin(i) - hillslope_basin(i)%hand) & + * hillslope_basin(i)%area, & + mask = wdsrf_bsn(i) + handmin(i) >= hillslope_basin(i)%hand) totalvolume = totalvolume - sum_hflux_riv(i) * dt_this IF (totalvolume < VOLUMEMIN) THEN - DO j = 1, hillslope_network(i)%nhru - IF (hillslope_network(i)%hand(j) <= wdsrf_bsn(i) + handmin(i)) THEN - wdsrf_hru(j+hs-1) = wdsrf_hru(j+hs-1) & - - (wdsrf_bsn(i) + handmin(i) - hillslope_network(i)%hand(j)) + DO j = 1, hillslope_basin(i)%nhru + IF (hillslope_basin(i)%hand(j) <= wdsrf_bsn(i) + handmin(i)) THEN + wdsrf_bsnhru(j+hs-1) = wdsrf_bsnhru(j+hs-1) & + - (wdsrf_bsn(i) + handmin(i) - hillslope_basin(i)%hand(j)) ENDIF ENDDO wdsrf_bsn(i) = 0 @@ -367,9 +347,9 @@ SUBROUTINE river_lake_flow (dt) dvol = sum_hflux_riv(i) * dt_this IF (dvol > VOLUMEMIN) THEN DO WHILE (dvol > VOLUMEMIN) - mask = hillslope_network(i)%hand < wdsrf_bsn(i) + handmin(i) - nextl = maxval(hillslope_network(i)%hand, mask = mask) - nexta = sum (hillslope_network(i)%area, mask = mask) + mask = hillslope_basin(i)%hand < wdsrf_bsn(i) + handmin(i) + nextl = maxval(hillslope_basin(i)%hand, mask = mask) + nexta = sum (hillslope_basin(i)%area, mask = mask) nextv = nexta * (wdsrf_bsn(i)+handmin(i)-nextl) IF (nextv > dvol) THEN ddep = dvol/nexta @@ -381,9 +361,9 @@ SUBROUTINE river_lake_flow (dt) wdsrf_bsn(i) = wdsrf_bsn(i) - ddep - DO j = 1, hillslope_network(i)%nhru + DO j = 1, hillslope_basin(i)%nhru IF (mask(j)) THEN - wdsrf_hru(j+hs-1) = wdsrf_hru(j+hs-1) - ddep + wdsrf_bsnhru(j+hs-1) = wdsrf_bsnhru(j+hs-1) - ddep ENDIF ENDDO ENDDO @@ -392,12 +372,12 @@ SUBROUTINE river_lake_flow (dt) nexta = 0. DO WHILE (dvol < -VOLUMEMIN) IF (any(mask)) THEN - j = minloc(hillslope_network(i)%hand + wdsrf_hru(hs:he), 1, mask = mask) - nexta = nexta + hillslope_network(i)%area(j) + j = minloc(hillslope_basin(i)%hand + wdsrf_bsnhru(hs:he), 1, mask = mask) + nexta = nexta + hillslope_basin(i)%area(j) mask(j) = .false. ENDIF IF (any(mask)) THEN - nextl = minval(hillslope_network(i)%hand + wdsrf_hru(hs:he), mask = mask) + nextl = minval(hillslope_basin(i)%hand + wdsrf_bsnhru(hs:he), mask = mask) nextv = nexta*(nextl-(wdsrf_bsn(i)+handmin(i))) IF ((-dvol) > nextv) THEN ddep = nextl - (wdsrf_bsn(i)+handmin(i)) @@ -413,9 +393,9 @@ SUBROUTINE river_lake_flow (dt) wdsrf_bsn(i) = wdsrf_bsn(i) + ddep - DO j = 1, hillslope_network(i)%nhru + DO j = 1, hillslope_basin(i)%nhru IF (.not. mask(j)) THEN - wdsrf_hru(j+hs-1) = wdsrf_hru(j+hs-1) + ddep + wdsrf_bsnhru(j+hs-1) = wdsrf_bsnhru(j+hs-1) + ddep ENDIF ENDDO ENDDO @@ -425,9 +405,9 @@ SUBROUTINE river_lake_flow (dt) deallocate(mask) ELSE - totalvolume = lakes(i)%volume(wdsrf_bsn(i)) + totalvolume = lakeinfo(i)%volume(wdsrf_bsn(i)) totalvolume = totalvolume - sum_hflux_riv(i) * dt_this - wdsrf_bsn(i) = lakes(i)%surface(totalvolume) + wdsrf_bsn(i) = lakeinfo(i)%surface(totalvolume) ENDIF IF ((lake_id(i) /= 0) .or. (wdsrf_bsn(i) < RIVERMIN)) THEN @@ -449,19 +429,19 @@ SUBROUTINE river_lake_flow (dt) ENDDO - IF (nbasin > 0) THEN - wdsrf_bsn_ta(:) = wdsrf_bsn_ta(:) + wdsrf_bsn(:) * dt_this - momen_riv_ta(:) = momen_riv_ta(:) + momen_riv(:) * dt_this - discharge (:) = discharge (:) + hflux_fc (:) * dt_this + IF (numbasin > 0) THEN + wdsrf_bsn_ta (:) = wdsrf_bsn_ta (:) + wdsrf_bsn(:) * dt_this + momen_riv_ta (:) = momen_riv_ta (:) + momen_riv(:) * dt_this + discharge_ta (:) = discharge_ta (:) + hflux_fc (:) * dt_this ENDIF - DO i = 1, nbasin + DO i = 1, numbasin IF (lake_id(i) > 0) THEN ! for lakes hs = basin_hru%substt(i) he = basin_hru%subend(i) DO j = hs, he - wdsrf_hru(j) = max(wdsrf_bsn(i) - (lakes(i)%depth(1) - lakes(i)%depth0(j-hs+1)), 0.) - wdsrf_hru_ta(j) = wdsrf_hru_ta(j) + wdsrf_hru(j) * dt_this + wdsrf_bsnhru(j) = max(wdsrf_bsn(i) - (lakeinfo(i)%depth(1) - lakeinfo(i)%depth0(j-hs+1)), 0.) + wdsrf_bsnhru_ta(j) = wdsrf_bsnhru_ta(j) + wdsrf_bsnhru(j) * dt_this ENDDO ENDIF ENDDO @@ -470,7 +450,7 @@ SUBROUTINE river_lake_flow (dt) ENDDO - wdsrf_bsn_prev(:) = wdsrf_bsn(:) + IF (numbasin > 0) wdsrf_bsn_prev(:) = wdsrf_bsn(:) IF (allocated(wdsrf_bsn_ds )) deallocate(wdsrf_bsn_ds ) IF (allocated(veloc_riv_ds )) deallocate(veloc_riv_ds ) diff --git a/main/HYDRO/MOD_Catch_RiverLakeNetwork.F90 b/main/HYDRO/MOD_Catch_RiverLakeNetwork.F90 index 44cc33e1..07ea5470 100644 --- a/main/HYDRO/MOD_Catch_RiverLakeNetwork.F90 +++ b/main/HYDRO/MOD_Catch_RiverLakeNetwork.F90 @@ -12,6 +12,10 @@ MODULE MOD_Catch_RiverLakeNetwork USE MOD_Precision USE MOD_Vars_Global, only : spval + USE MOD_Pixelset + USE MOD_Catch_BasinNetwork + USE MOD_Catch_HillslopeNetwork + USE MOD_Catch_Vars_TimeVariables IMPLICIT NONE ! -- river parameters -- @@ -30,17 +34,12 @@ MODULE MOD_Catch_RiverLakeNetwork ! index of downstream river ! > 0 : other catchment; 0 : river mouth; -1 : inland depression integer, allocatable :: riverdown (:) - logical, allocatable :: to_lake (:) - - ! address of downstream river - ! > 0 : catchment on this process; 0 : catchment on other processes; - ! -1 : not found, including river mouth, out of domain, inland depression. - integer, allocatable :: addrdown (:) + logical, allocatable :: to_lake (:) - real(r8), allocatable :: riverlen_ds (:) - real(r8), allocatable :: wtsrfelv_ds (:) - real(r8), allocatable :: riverwth_ds (:) - real(r8), allocatable :: bedelv_ds (:) + real(r8), allocatable :: riverlen_ds (:) + real(r8), allocatable :: wtsrfelv_ds (:) + real(r8), allocatable :: riverwth_ds (:) + real(r8), allocatable :: bedelv_ds (:) real(r8), allocatable :: outletwth (:) @@ -57,30 +56,18 @@ MODULE MOD_Catch_RiverLakeNetwork CONTAINS procedure, PUBLIC :: surface => retrieve_lake_surface_from_volume procedure, PUBLIC :: volume => retrieve_lake_volume_from_surface + final :: lake_info_free_mem END type lake_info_type ! -- lake information -- integer, allocatable :: lake_id (:) - type(lake_info_type), allocatable :: lakes (:) - - ! -- communications -- - type :: river_sendrecv_type - integer :: nproc - integer, allocatable :: iproc (:) - integer, allocatable :: wdsp (:) - integer, allocatable :: ndata (:) - integer, allocatable :: ups (:) - integer, allocatable :: down (:) - integer, allocatable :: iloc (:) - CONTAINS - final :: river_sendrecv_free_mem - END type river_sendrecv_type - - type(river_sendrecv_type), target :: river_up - type(river_sendrecv_type), target :: river_dn - - integer, parameter :: SEND_DATA_DOWN_TO_UP = 1 - integer, parameter :: SEND_DATA_UP_TO_DOWN = 2 + type(lake_info_type), allocatable :: lakeinfo (:) + + ! -- information of HRU in basin -- + type(hillslope_network_type), pointer :: hillslope_basin (:) + + type(basin_pushdata_type), target :: river_iam_dn + type(basin_pushdata_type), target :: river_iam_up CONTAINS @@ -93,8 +80,8 @@ SUBROUTINE river_lake_network_init () USE MOD_Mesh USE MOD_Pixel USE MOD_LandElm + USE MOD_LandHRU USE MOD_LandPatch - USE MOD_Catch_HillslopeNetwork USE MOD_ElementNeighbour USE MOD_DataType USE MOD_Utils @@ -106,36 +93,40 @@ SUBROUTINE river_lake_network_init () character(len=256) :: river_file, rivdpt_file logical :: use_calc_rivdpt - integer :: numbasin, ibasin, nbasin, inb + integer :: totalnumbasin, ibasin, inb integer :: iworker, mesg(4), isrc, idest, iproc - integer :: irecv, ifrom, ito, iup, idn, idata - integer :: nrecv, ndata, nup, ndn + integer :: nrecv, irecv, ifrom, ito, iup, idn + integer :: ndata, idata, ip, nup, ndn integer :: iloc, iloc1, iloc2 + integer :: ielm, i, j, ithis, nave - integer , allocatable :: bindex (:) + integer , allocatable :: icache (:) real(r8), allocatable :: rcache (:) logical , allocatable :: lcache (:) - integer , allocatable :: addrbasin (:,:) - integer , allocatable :: ndata_w (:) - - type(pointer_int32_2d), allocatable :: exchange_w (:) - integer, allocatable :: exchange(:,:) - integer, allocatable :: basin_sorted(:), order(:) + type(pointer_int32_2d), allocatable :: datapush_w (:) + integer, allocatable :: datapush(:,:) + integer, allocatable :: bindex(:), addrbasin(:), addrdown(:), nelm_wrk(:), paddr(:), ndata_w(:) + integer, allocatable :: basin_sorted(:), basin_order(:), order (:) + integer, allocatable :: river_up_ups(:), river_up_paddr(:), river_dn_ups(:), river_dn_paddr(:) ! for lakes - integer :: ps, pe, nsublake, i, ipatch, ipxl + integer :: ps, pe, nsublake, hs, he, ihru, ipxl + integer, allocatable :: lake_id_elm (:) + integer , allocatable :: lakedown_id_elm(:), lakedown_id_bsn (:) + real(r8), allocatable :: lakedepth_hru (:), lakedepth_bsnhru(:) + real(r8), allocatable :: lakeoutlet_elm (:), lakeoutlet_bsn (:) + real(r8), allocatable :: lakearea_hru (:), lakearea_bsnhru (:) #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - numbasin = numelm - use_calc_rivdpt = DEF_USE_EstimatedRiverDepth river_file = DEF_CatchmentMesh_data + ! step 1: read in parameters from file. IF (p_is_master) THEN CALL ncio_read_serial (river_file, 'lake_id' , lake_id ) @@ -150,10 +141,10 @@ SUBROUTINE river_lake_network_init () riverlen = riverlen * 1.e3 ! km to m - nbasin = size(riverdown) - allocate (to_lake (nbasin)) + totalnumbasin = size(riverdown) + allocate (to_lake (totalnumbasin)) to_lake = .false. - DO i = 1, nbasin + DO i = 1, totalnumbasin IF (riverdown(i) > 0) THEN to_lake(i) = lake_id(riverdown(i)) > 0 ENDIF @@ -161,20 +152,15 @@ SUBROUTINE river_lake_network_init () ENDIF + ! step 2: Estimate river depth by using runoff data. IF (use_calc_rivdpt) THEN - ! Estimate river depth by using runoff data. CALL calc_riverdepth_from_runoff () ENDIF #ifdef USEMPI IF (p_is_master) THEN - nbasin = size(riverdown) - - allocate (addrbasin (2,nbasin)) - addrbasin(:,:) = -1 - - DO iworker = 1, p_np_worker + DO iworker = 0, p_np_worker-1 CALL mpi_recv (mesg(1:2), 2, MPI_INTEGER, & MPI_ANY_SOURCE, mpi_tag_mesg, p_comm_glb, p_stat, p_err) @@ -188,56 +174,30 @@ SUBROUTINE river_lake_network_init () allocate (rcache (nrecv)) allocate (lcache (nrecv)) - CALL mpi_recv (bindex, nrecv, MPI_INTEGER, & - isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) + CALL mpi_recv (bindex, nrecv, MPI_INTEGER, isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) - DO irecv = 1, nrecv - addrbasin(1,bindex(irecv)) = isrc - ENDDO - idest = isrc - DO irecv = 1, nrecv - icache(irecv) = lake_id(bindex(irecv)) - ENDDO - CALL mpi_send (icache, nrecv, MPI_INTEGER, & - idest, mpi_tag_data, p_comm_glb, p_err) + icache = lake_id(bindex) + CALL mpi_send (icache, nrecv, MPI_INTEGER, idest, mpi_tag_data, p_comm_glb, p_err) - DO irecv = 1, nrecv - icache(irecv) = riverdown(bindex(irecv)) - ENDDO - CALL mpi_send (icache, nrecv, MPI_INTEGER, & - idest, mpi_tag_data, p_comm_glb, p_err) + icache = riverdown(bindex) + CALL mpi_send (icache, nrecv, MPI_INTEGER, idest, mpi_tag_data, p_comm_glb, p_err) - DO irecv = 1, nrecv - lcache(irecv) = to_lake(bindex(irecv)) - ENDDO - CALL mpi_send (lcache, nrecv, MPI_LOGICAL, & - idest, mpi_tag_data, p_comm_glb, p_err) + lcache = to_lake(bindex) + CALL mpi_send (lcache, nrecv, MPI_LOGICAL, idest, mpi_tag_data, p_comm_glb, p_err) - DO irecv = 1, nrecv - rcache(irecv) = riverlen(bindex(irecv)) - ENDDO - CALL mpi_send (rcache, nrecv, MPI_REAL8, & - idest, mpi_tag_data, p_comm_glb, p_err) + rcache = riverlen(bindex) + CALL mpi_send (rcache, nrecv, MPI_REAL8, idest, mpi_tag_data, p_comm_glb, p_err) - DO irecv = 1, nrecv - rcache(irecv) = riverelv(bindex(irecv)) - ENDDO - CALL mpi_send (rcache, nrecv, MPI_REAL8, & - idest, mpi_tag_data, p_comm_glb, p_err) + rcache = riverelv(bindex) + CALL mpi_send (rcache, nrecv, MPI_REAL8, idest, mpi_tag_data, p_comm_glb, p_err) - DO irecv = 1, nrecv - rcache(irecv) = riverdpth(bindex(irecv)) - ENDDO - CALL mpi_send (rcache, nrecv, MPI_REAL8, & - idest, mpi_tag_data, p_comm_glb, p_err) + rcache = riverdpth(bindex) + CALL mpi_send (rcache, nrecv, MPI_REAL8, idest, mpi_tag_data, p_comm_glb, p_err) - DO irecv = 1, nrecv - rcache(irecv) = basinelv(bindex(irecv)) - ENDDO - CALL mpi_send (rcache, nrecv, MPI_REAL8, & - idest, mpi_tag_data, p_comm_glb, p_err) + rcache = basinelv(bindex) + CALL mpi_send (rcache, nrecv, MPI_REAL8, idest, mpi_tag_data, p_comm_glb, p_err) deallocate (bindex) deallocate (icache) @@ -248,23 +208,14 @@ SUBROUTINE river_lake_network_init () ENDDO ENDIF -#endif IF (p_is_worker) THEN - IF (numbasin > 0) THEN - allocate (bindex (numbasin)) - DO ibasin = 1, numbasin - bindex(ibasin) = mesh(ibasin)%indx - ENDDO - ENDIF - -#ifdef USEMPI mesg(1:2) = (/p_iam_glb, numbasin/) CALL mpi_send (mesg(1:2), 2, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) IF (numbasin > 0) THEN - CALL mpi_send (bindex, numbasin, MPI_INTEGER, & + CALL mpi_send (basinindex, numbasin, MPI_INTEGER, & p_address_master, mpi_tag_data, p_comm_glb, p_err) allocate (lake_id (numbasin)) @@ -295,65 +246,102 @@ SUBROUTINE river_lake_network_init () CALL mpi_recv (basinelv, numbasin, MPI_REAL8, & p_address_master, mpi_tag_data, p_comm_glb, p_stat, p_err) ENDIF + + ENDIF + + CALL mpi_barrier (p_comm_glb, p_err) #else - IF (numbasin > 0) THEN + IF (numbasin > 0) THEN - lake_id = lake_id (bindex) - riverdown = riverdown(bindex) - to_lake = to_lake (bindex) - riverlen = riverlen (bindex) - riverelv = riverelv (bindex) - riverdpth = riverdpth(bindex) - basinelv = basinelv (bindex) + lake_id = lake_id (basinindex) + riverdown = riverdown(basinindex) + to_lake = to_lake (basinindex) + riverlen = riverlen (basinindex) + riverelv = riverelv (basinindex) + riverdpth = riverdpth(basinindex) + basinelv = basinelv (basinindex) - ENDIF + ENDIF #endif - ENDIF - #ifdef USEMPI + ! get address of basins + IF (p_is_master) THEN + + allocate (addrbasin (totalnumbasin)); addrbasin(:) = -1 + + DO iworker = 0, p_np_worker-1 + + CALL mpi_recv (mesg(1:2), 2, MPI_INTEGER, & + MPI_ANY_SOURCE, mpi_tag_mesg, p_comm_glb, p_stat, p_err) + isrc = mesg(1) + nrecv = mesg(2) + + IF (nrecv > 0) THEN + allocate (bindex (nrecv)) + + CALL mpi_recv (bindex, nrecv, MPI_INTEGER, isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) + + addrbasin(bindex) = isrc + + deallocate(bindex) + ENDIF + + ENDDO + + ELSEIF (p_is_worker) THEN + + mesg(1:2) = (/p_iam_glb, numbasin/) + CALL mpi_send (mesg(1:2), 2, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) + + IF (numbasin > 0) THEN + CALL mpi_send (basinindex, numbasin, MPI_INTEGER, p_address_master, & + mpi_tag_data, p_comm_glb, p_err) + ENDIF + + ENDIF + CALL mpi_barrier (p_comm_glb, p_err) #endif #ifdef USEMPI IF (p_is_master) THEN + allocate (addrdown (totalnumbasin)) allocate (ndata_w (0:p_np_worker-1)) ndata_w(:) = 0 - DO ibasin = 1, nbasin + DO ibasin = 1, totalnumbasin IF (riverdown(ibasin) >= 1) THEN - addrbasin(2,ibasin) = addrbasin(1,riverdown(ibasin)) - IF ((addrbasin(1,ibasin) /= -1) .and. (addrbasin(2,ibasin) /= -1) & - .and. (addrbasin(1,ibasin) /= addrbasin(2,ibasin))) THEN - ifrom = p_itis_worker(addrbasin(1,ibasin)) - ito = p_itis_worker(addrbasin(2,ibasin)) + addrdown(ibasin) = addrbasin(riverdown(ibasin)) + IF (addrbasin(ibasin) /= addrdown(ibasin)) THEN + ifrom = p_itis_worker(addrbasin(ibasin)) + ito = p_itis_worker(addrdown(ibasin)) ndata_w(ifrom) = ndata_w(ifrom) + 1 ndata_w(ito) = ndata_w(ito) + 1 ENDIF ENDIF ENDDO - allocate (exchange_w (0:p_np_worker-1)) + allocate (datapush_w (0:p_np_worker-1)) DO iworker = 0, p_np_worker-1 IF (ndata_w(iworker) > 0) THEN - allocate (exchange_w(iworker)%val (4,ndata_w(iworker))) + allocate (datapush_w(iworker)%val (4,ndata_w(iworker))) ENDIF ENDDO ndata_w(:) = 0 - DO ibasin = 1, nbasin - IF ((addrbasin(1,ibasin) /= -1) .and. (addrbasin(2,ibasin) /= -1) & - .and. (addrbasin(1,ibasin) /= addrbasin(2,ibasin))) THEN - ifrom = p_itis_worker(addrbasin(1,ibasin)) - ito = p_itis_worker(addrbasin(2,ibasin)) + DO ibasin = 1, totalnumbasin + IF ((riverdown(ibasin) >= 1) .and. (addrbasin(ibasin) /= addrdown(ibasin))) THEN + ifrom = p_itis_worker(addrbasin(ibasin)) + ito = p_itis_worker(addrdown(ibasin)) ndata_w(ifrom) = ndata_w(ifrom) + 1 ndata_w(ito) = ndata_w(ito) + 1 - exchange_w(ifrom)%val(:,ndata_w(ifrom)) = & - (/addrbasin(1,ibasin), ibasin, addrbasin(2,ibasin), riverdown(ibasin)/) - exchange_w(ito)%val(:,ndata_w(ito)) = & - (/addrbasin(1,ibasin), ibasin, addrbasin(2,ibasin), riverdown(ibasin)/) + datapush_w(ifrom)%val(:,ndata_w(ifrom)) = & + (/addrbasin(ibasin), ibasin, addrdown(ibasin), riverdown(ibasin)/) + datapush_w(ito)%val(:,ndata_w(ito)) = & + (/addrbasin(ibasin), ibasin, addrdown(ibasin), riverdown(ibasin)/) ENDIF ENDDO @@ -361,10 +349,15 @@ SUBROUTINE river_lake_network_init () CALL mpi_send (ndata_w(iworker), 1, MPI_INTEGER, & p_address_worker(iworker), mpi_tag_size, p_comm_glb, p_err) IF (ndata_w(iworker) > 0) THEN - CALL mpi_send (exchange_w(iworker)%val, 4*ndata_w(iworker), MPI_INTEGER, & + CALL mpi_send (datapush_w(iworker)%val, 4*ndata_w(iworker), MPI_INTEGER, & p_address_worker(iworker), mpi_tag_data, p_comm_glb, p_err) ENDIF ENDDO + + deallocate (addrdown ) + deallocate (ndata_w ) + deallocate (datapush_w) + ENDIF #endif @@ -372,166 +365,263 @@ SUBROUTINE river_lake_network_init () #ifdef USEMPI CALL mpi_recv (ndata, 1, MPI_INTEGER, p_address_master, mpi_tag_size, p_comm_glb, p_stat, p_err) IF (ndata > 0) THEN - allocate (exchange(4,ndata)) - CALL mpi_recv (exchange, 4*ndata, MPI_INTEGER, & + allocate (datapush(4,ndata)) + CALL mpi_recv (datapush, 4*ndata, MPI_INTEGER, & p_address_master, mpi_tag_data, p_comm_glb, p_stat, p_err) ENDIF #endif IF (numbasin > 0) THEN - allocate (basin_sorted (numbasin)) - allocate (order (numbasin)) - basin_sorted = bindex - order = (/(ibasin, ibasin = 1, numbasin)/) + allocate (basin_order (numbasin)) + basin_sorted = basinindex + basin_order = (/(ibasin, ibasin = 1, numbasin)/) - CALL quicksort (numbasin, basin_sorted, order) + CALL quicksort (numbasin, basin_sorted, basin_order) + ENDIF - allocate (addrdown (numbasin)) - addrdown(:) = -1 + river_iam_up%nself = 0 + river_iam_dn%nself = 0 + river_iam_up%nproc = 0 + river_iam_dn%nproc = 0 + IF (numbasin > 0) THEN + DO ibasin = 1, numbasin IF (riverdown(ibasin) > 0) THEN iloc = find_in_sorted_list1 (riverdown(ibasin), numbasin, basin_sorted) IF (iloc > 0) THEN - addrdown(ibasin) = order(iloc) + river_iam_up%nself = river_iam_up%nself + 1 ENDIF ENDIF ENDDO + + IF (river_iam_up%nself > 0) THEN + + allocate (river_iam_up%iself (river_iam_up%nself)) + + river_iam_dn%nself = river_iam_up%nself + allocate (river_iam_dn%iself (river_iam_dn%nself)) + + idata = 0 + DO ibasin = 1, numbasin + IF (riverdown(ibasin) > 0) THEN + iloc = find_in_sorted_list1 (riverdown(ibasin), numbasin, basin_sorted) + IF (iloc > 0) THEN + idata = idata + 1 + river_iam_up%iself(idata) = ibasin + river_iam_dn%iself(idata) = basin_order(iloc) + ENDIF + ENDIF + ENDDO + + ENDIF #ifdef USEMPI IF (ndata > 0) THEN - nup = count(exchange(3,:) == p_iam_glb) - ndn = count(exchange(1,:) == p_iam_glb) - IF (nup > 0) allocate (river_up%iproc (nup)) - IF (nup > 0) allocate (river_up%ups (nup)) - IF (nup > 0) allocate (river_up%down (nup)) - IF (nup > 0) allocate (river_up%iloc (nup)) - - IF (ndn > 0) allocate (river_dn%iproc (ndn)) - IF (ndn > 0) allocate (river_dn%ups (ndn)) - IF (ndn > 0) allocate (river_dn%down (ndn)) - IF (ndn > 0) allocate (river_dn%iloc (ndn)) + nup = count(datapush(3,:) == p_iam_glb) + ndn = count(datapush(1,:) == p_iam_glb) + + IF (nup > 0) allocate (river_up_paddr (nup)) + IF (nup > 0) allocate (river_up_ups (nup)) + IF (ndn > 0) allocate (river_dn_paddr (ndn)) + IF (ndn > 0) allocate (river_dn_ups (ndn)) iup = 0 idn = 0 DO idata = 1, ndata - IF (exchange(3,idata) == p_iam_glb) THEN - CALL insert_into_sorted_list2 (exchange(2,idata), exchange(1,idata), & - iup, river_up%ups, river_up%iproc, iloc) - ELSEIF (exchange(1,idata) == p_iam_glb) THEN - CALL insert_into_sorted_list2 (exchange(2,idata), exchange(3,idata), & - idn, river_dn%ups, river_dn%iproc, iloc) + IF (datapush(3,idata) == p_iam_glb) THEN + CALL insert_into_sorted_list2 (datapush(2,idata), datapush(1,idata), & + iup, river_up_ups, river_up_paddr, iloc) + ELSEIF (datapush(1,idata) == p_iam_glb) THEN + CALL insert_into_sorted_list2 (datapush(2,idata), datapush(3,idata), & + idn, river_dn_ups, river_dn_paddr, iloc) ENDIF ENDDO + + IF (nup > 0) allocate (river_iam_dn%ipush (nup)) + IF (ndn > 0) allocate (river_iam_up%ipush (ndn)) DO idata = 1, ndata - IF (exchange(3,idata) == p_iam_glb) THEN + IF (datapush(3,idata) == p_iam_glb) THEN - iloc1 = find_in_sorted_list2 (exchange(2,idata), exchange(1,idata), & - nup, river_up%ups, river_up%iproc) - - river_up%down(iloc1) = exchange(4,idata) + iloc1 = find_in_sorted_list2 (datapush(2,idata), datapush(1,idata), & + nup, river_up_ups, river_up_paddr) + iloc2 = find_in_sorted_list1 (datapush(4,idata), numbasin, basin_sorted) - iloc2 = find_in_sorted_list1 (exchange(4,idata), numbasin, basin_sorted) - river_up%iloc(iloc1) = order(iloc2) + river_iam_dn%ipush(iloc1) = basin_order(iloc2) - ELSEIF (exchange(1,idata) == p_iam_glb) THEN + ELSEIF (datapush(1,idata) == p_iam_glb) THEN - iloc1 = find_in_sorted_list2 (exchange(2,idata), exchange(3,idata), & - ndn, river_dn%ups, river_dn%iproc) + iloc1 = find_in_sorted_list2 (datapush(2,idata), datapush(3,idata), & + ndn, river_dn_ups, river_dn_paddr) + iloc2 = find_in_sorted_list1 (datapush(2,idata), numbasin, basin_sorted) - river_dn%down(iloc1) = exchange(4,idata) - - iloc2 = find_in_sorted_list1 (exchange(2,idata), numbasin, basin_sorted) - river_dn%iloc(iloc1) = order(iloc2) + river_iam_up%ipush(iloc1) = basin_order(iloc2) ENDIF ENDDO + IF (nup > 0) THEN - river_up%nproc = 1 - DO iup = 2, nup - IF (river_up%iproc(iup) /= river_up%iproc(iup-1)) THEN - river_up%nproc = river_up%nproc + 1 + DO iup = 1, nup + IF (iup == 1) THEN + river_iam_dn%nproc = 1 + ELSEIF (river_up_paddr(iup) /= river_up_paddr(iup-1)) THEN + river_iam_dn%nproc = river_iam_dn%nproc + 1 ENDIF ENDDO - - allocate (river_up%wdsp (river_up%nproc)) - allocate (river_up%ndata(river_up%nproc)) - - river_up%ndata(:) = 0 - - iproc = 1 - river_up%wdsp (1) = 0 - river_up%ndata(1) = 1 - DO iup = 2, nup - IF (river_up%iproc(iup) /= river_up%iproc(iup-1)) THEN - iproc = iproc + 1 - river_up%wdsp (iproc) = iup - 1 - river_up%ndata(iproc) = 1 + + allocate (river_iam_dn%paddr(river_iam_dn%nproc)) + allocate (river_iam_dn%ndata(river_iam_dn%nproc)) + + DO iup = 1, nup + IF (iup == 1) THEN + ip = 1 + river_iam_dn%paddr(ip) = river_up_paddr(iup) + river_iam_dn%ndata(ip) = 1 + ELSEIF (river_up_paddr(iup) /= river_up_paddr(iup-1)) THEN + ip = ip + 1 + river_iam_dn%paddr(ip) = river_up_paddr(iup) + river_iam_dn%ndata(ip) = 1 ELSE - river_up%ndata(iproc) = river_up%ndata(iproc) + 1 + river_iam_dn%ndata(ip) = river_iam_dn%ndata(ip) + 1 ENDIF ENDDO - ELSE - river_up%nproc = 0 ENDIF + IF (ndn > 0) THEN - river_dn%nproc = 1 - DO idn = 2, ndn - IF (river_dn%iproc(idn) /= river_dn%iproc(idn-1)) THEN - river_dn%nproc = river_dn%nproc + 1 + DO idn = 1, ndn + IF (idn == 1) THEN + river_iam_up%nproc = 1 + ELSEIF (river_dn_paddr(idn) /= river_dn_paddr(idn-1)) THEN + river_iam_up%nproc = river_iam_up%nproc + 1 ENDIF ENDDO - - allocate (river_dn%wdsp (river_dn%nproc)) - allocate (river_dn%ndata(river_dn%nproc)) - - river_dn%ndata(:) = 0 - - iproc = 1 - river_dn%wdsp (1) = 0 - river_dn%ndata(1) = 1 - DO idn = 2, ndn - IF (river_dn%iproc(idn) /= river_dn%iproc(idn-1)) THEN - iproc = iproc + 1 - river_dn%wdsp (iproc) = idn - 1 - river_dn%ndata(iproc) = 1 + + allocate (river_iam_up%paddr(river_iam_up%nproc)) + allocate (river_iam_up%ndata(river_iam_up%nproc)) + + DO idn = 1, ndn + IF (idn == 1) THEN + ip = 1 + river_iam_up%paddr(ip) = river_dn_paddr(idn) + river_iam_up%ndata(ip) = 1 + ELSEIF (river_dn_paddr(idn) /= river_dn_paddr(idn-1)) THEN + ip = ip + 1 + river_iam_up%paddr(ip) = river_dn_paddr(idn) + river_iam_up%ndata(ip) = 1 ELSE - river_dn%ndata(iproc) = river_dn%ndata(iproc) + 1 + river_iam_up%ndata(ip) = river_iam_up%ndata(ip) + 1 ENDIF ENDDO - - addrdown(river_dn%iloc)= 0 - ELSE - river_dn%nproc = 0 ENDIF + + IF (nup > 0) deallocate (river_up_paddr) + IF (nup > 0) deallocate (river_up_ups ) + IF (ndn > 0) deallocate (river_dn_paddr) + IF (ndn > 0) deallocate (river_dn_ups ) + + deallocate(datapush) ENDIF #endif ENDIF ENDIF - IF (allocated(bindex )) deallocate(bindex ) - IF (allocated(addrbasin )) deallocate(addrbasin ) - IF (allocated(ndata_w )) deallocate(ndata_w ) - IF (allocated(exchange_w )) deallocate(exchange_w ) - IF (allocated(exchange )) deallocate(exchange ) - IF (allocated(basin_sorted)) deallocate(basin_sorted) - IF (allocated(order )) deallocate(order ) + IF (allocated(basin_sorted )) deallocate(basin_sorted ) + IF (allocated(basin_order )) deallocate(basin_order ) + + + CALL hillslope_network_init (numbasin, basinindex, hillslope_basin) + + IF (p_is_worker) THEN + + IF (numelm > 0) allocate (lake_id_elm (numelm)) + IF (numhru > 0) allocate (lakedepth_hru (numhru)) + IF (numbsnhru > 0) allocate (lakedepth_bsnhru(numbsnhru)) + IF (numelm > 0) allocate (lakedown_id_elm (numelm)) + IF (numbasin > 0) allocate (lakedown_id_bsn (numbasin)) + IF (numelm > 0) allocate (lakeoutlet_elm (numelm)) + IF (numbasin > 0) allocate (lakeoutlet_bsn (numbasin)) + IF (numhru > 0) allocate (lakearea_hru (numhru)) + IF (numbsnhru > 0) allocate (lakearea_bsnhru (numbsnhru)) + + DO ibasin = 1, numbasin + + lakedown_id_bsn(ibasin) = 0 + + IF ((lake_id(ibasin) /= 0) .and. (to_lake(ibasin))) THEN + ! lake to lake .or. lake catchment to lake + lakedown_id_bsn(ibasin) = riverdown(ibasin) + ENDIF + IF ((lake_id(ibasin) > 0) .and. (riverdown(ibasin) == 0)) THEN + ! lake to ocean + lakedown_id_bsn(ibasin) = -9 ! -9 is ocean + ENDIF + ENDDO + + ENDIF + + CALL worker_push_data (iam_bsn, iam_elm, .false., lake_id, lake_id_elm) + CALL worker_push_data (iam_bsn, iam_elm, .false., lakedown_id_bsn, lakedown_id_elm) + + IF (p_is_worker) THEN + + lakedepth_hru = 0. + lakeoutlet_elm = 0. + lakearea_hru = 0. + + DO ielm = 1, numelm + IF (lake_id_elm(ielm) > 0) THEN + hs = elm_hru%substt(ielm) + he = elm_hru%subend(ielm) + DO ihru = hs, he + ps = hru_patch%substt(ihru) + pe = hru_patch%subend(ihru) + + lakedepth_hru(ihru) = maxval(lakedepth(ps:pe)) + + lakearea_hru(ihru) = 0. + DO ipxl = landhru%ipxstt(ihru), landhru%ipxend(ihru) + lakearea_hru(ihru) = lakearea_hru(ihru) & + + 1.0e6 * areaquad ( & + pixel%lat_s(mesh(ielm)%ilat(ipxl)), pixel%lat_n(mesh(ielm)%ilat(ipxl)), & + pixel%lon_w(mesh(ielm)%ilon(ipxl)), pixel%lon_e(mesh(ielm)%ilon(ipxl)) ) + ENDDO + ENDDO + ENDIF + + IF (lakedown_id_elm(ielm) /= 0) THEN + inb = findloc_ud(elementneighbour(ielm)%glbindex == lakedown_id_elm(ielm)) + IF (inb > 0) lakeoutlet_elm(ielm) = elementneighbour(ielm)%lenbdr(inb) + ENDIF + ENDDO + ENDIF + + CALL worker_push_data (iam_elm, iam_bsn, .false., lakeoutlet_elm, lakeoutlet_bsn) + + CALL worker_push_subset_data (iam_elm, iam_bsn, elm_hru, basin_hru, lakedepth_hru, lakedepth_bsnhru) + CALL worker_push_subset_data (iam_elm, iam_bsn, elm_hru, basin_hru, lakearea_hru, lakearea_bsnhru ) + + IF (allocated (lake_id_elm )) deallocate (lake_id_elm ) + IF (allocated (lakedepth_hru )) deallocate (lakedepth_hru ) + IF (allocated (lakedown_id_elm)) deallocate (lakedown_id_elm) + IF (allocated (lakedown_id_bsn)) deallocate (lakedown_id_bsn) + IF (allocated (lakeoutlet_elm )) deallocate (lakeoutlet_elm ) + IF (allocated (lakearea_hru )) deallocate (lakearea_hru ) IF (p_is_worker) THEN IF (numbasin > 0) THEN - allocate (lakes (numbasin)) + allocate (lakeinfo (numbasin)) allocate (riverarea (numbasin)) allocate (riverwth (numbasin)) allocate (bedelv (numbasin)) @@ -547,13 +637,13 @@ SUBROUTINE river_lake_network_init () IF (lake_id(ibasin) == 0) THEN - riverarea(ibasin) = hillslope_network(ibasin)%area(1) + riverarea(ibasin) = hillslope_basin(ibasin)%area(1) riverwth (ibasin) = riverarea(ibasin) / riverlen(ibasin) ! modify height above nearest drainage data to consider river depth - IF (hillslope_network(ibasin)%nhru > 1) THEN - hillslope_network(ibasin)%hand(2:) = & - hillslope_network(ibasin)%hand(2:) + riverdpth(ibasin) + IF (hillslope_basin(ibasin)%nhru > 1) THEN + hillslope_basin(ibasin)%hand(2:) = & + hillslope_basin(ibasin)%hand(2:) + riverdpth(ibasin) ENDIF wtsrfelv(ibasin) = riverelv(ibasin) @@ -561,57 +651,50 @@ SUBROUTINE river_lake_network_init () ELSEIF (lake_id(ibasin) > 0) THEN - wtsrfelv(ibasin) = basinelv(ibasin) + hs = basin_hru%substt(ibasin) + he = basin_hru%subend(ibasin) - ps = elm_patch%substt(ibasin) - pe = elm_patch%subend(ibasin) + wtsrfelv(ibasin) = basinelv(ibasin) - bedelv(ibasin) = basinelv(ibasin) - maxval(lakedepth(ps:pe)) + bedelv(ibasin) = basinelv(ibasin) - minval(lakedepth_bsnhru(hs:he)) - nsublake = pe - ps + 1 - lakes(ibasin)%nsub = nsublake + nsublake = he - hs + 1 + lakeinfo(ibasin)%nsub = nsublake - allocate (lakes(ibasin)%area0 (nsublake)) - allocate (lakes(ibasin)%area (nsublake)) - allocate (lakes(ibasin)%depth0 (nsublake)) - allocate (lakes(ibasin)%depth (nsublake)) + allocate (lakeinfo(ibasin)%area0 (nsublake)) + allocate (lakeinfo(ibasin)%area (nsublake)) + allocate (lakeinfo(ibasin)%depth0 (nsublake)) + allocate (lakeinfo(ibasin)%depth (nsublake)) - DO i = 1, nsublake - ipatch = i + ps - 1 - lakes(ibasin)%area(i) = 0 - DO ipxl = landpatch%ipxstt(ipatch), landpatch%ipxend(ipatch) - lakes(ibasin)%area(i) = lakes(ibasin)%area(i) & - + 1.0e6 * areaquad ( & - pixel%lat_s(mesh(ibasin)%ilat(ipxl)), pixel%lat_n(mesh(ibasin)%ilat(ipxl)), & - pixel%lon_w(mesh(ibasin)%ilon(ipxl)), pixel%lon_e(mesh(ibasin)%ilon(ipxl)) ) - ENDDO - ENDDO + lakeinfo(ibasin)%area = lakearea_bsnhru (hs:he) + lakeinfo(ibasin)%depth = lakedepth_bsnhru(hs:he) ! area data in HRU order - lakes(ibasin)%area0 = lakes(ibasin)%area + lakeinfo(ibasin)%area0 = lakeinfo(ibasin)%area - lakes(ibasin)%depth = lakedepth(ps:pe) ! depth data in HRU order - lakes(ibasin)%depth0 = lakes(ibasin)%depth + lakeinfo(ibasin)%depth0 = lakeinfo(ibasin)%depth allocate (order (1:nsublake)) order = (/(i, i = 1, nsublake)/) - CALL quicksort (nsublake, lakes(ibasin)%depth, order) + CALL quicksort (nsublake, lakeinfo(ibasin)%depth, order) ! area data in depth order - lakes(ibasin)%area = lakes(ibasin)%area(order) + lakeinfo(ibasin)%area = lakeinfo(ibasin)%area(order) ! adjust to be from deepest to shallowest - lakes(ibasin)%depth = lakes(ibasin)%depth(nsublake:1:-1) - lakes(ibasin)%area = lakes(ibasin)%area (nsublake:1:-1) + lakeinfo(ibasin)%depth = lakeinfo(ibasin)%depth(nsublake:1:-1) + lakeinfo(ibasin)%area = lakeinfo(ibasin)%area (nsublake:1:-1) - allocate (lakes(ibasin)%dep_vol_curve (nsublake)) + allocate (lakeinfo(ibasin)%dep_vol_curve (nsublake)) - lakes(ibasin)%dep_vol_curve(1) = 0 + lakeinfo(ibasin)%dep_vol_curve(1) = 0 DO i = 2, nsublake - lakes(ibasin)%dep_vol_curve(i) = lakes(ibasin)%dep_vol_curve(i-1) & - + sum(lakes(ibasin)%area(1:i-1)) * (lakes(ibasin)%depth(i-1)-lakes(ibasin)%depth(i)) + lakeinfo(ibasin)%dep_vol_curve(i) = & + lakeinfo(ibasin)%dep_vol_curve(i-1) & + + sum(lakeinfo(ibasin)%area(1:i-1)) & + * (lakeinfo(ibasin)%depth(i-1)-lakeinfo(ibasin)%depth(i)) ENDDO riverlen(ibasin) = 0. @@ -621,36 +704,19 @@ SUBROUTINE river_lake_network_init () ENDIF IF (lake_id(ibasin) <= 0) THEN - handmin(ibasin) = minval(hillslope_network(ibasin)%hand) + handmin(ibasin) = minval(hillslope_basin(ibasin)%hand) ENDIF ENDDO ENDIF - DO ibasin = 1, numbasin - IF (addrdown(ibasin) > 0) THEN - riverlen_ds (ibasin) = riverlen (addrdown(ibasin)) - wtsrfelv_ds (ibasin) = wtsrfelv (addrdown(ibasin)) - riverwth_ds (ibasin) = riverwth (addrdown(ibasin)) - bedelv_ds (ibasin) = bedelv (addrdown(ibasin)) - ELSE - riverlen_ds (ibasin) = spval - wtsrfelv_ds (ibasin) = spval - riverwth_ds (ibasin) = spval - bedelv_ds (ibasin) = spval - ENDIF - ENDDO - -#ifdef USEMPI - CALL river_data_exchange (SEND_DATA_DOWN_TO_UP, accum = .false., & - vec_send1 = riverlen, vec_recv1 = riverlen_ds, & - vec_send2 = wtsrfelv, vec_recv2 = wtsrfelv_ds, & - vec_send3 = riverwth, vec_recv3 = riverwth_ds, & - vec_send4 = bedelv , vec_recv4 = bedelv_ds ) -#endif + CALL worker_push_data (river_iam_dn, river_iam_up, .false., riverlen, riverlen_ds) + CALL worker_push_data (river_iam_dn, river_iam_up, .false., wtsrfelv, wtsrfelv_ds) + CALL worker_push_data (river_iam_dn, river_iam_up, .false., riverwth, riverwth_ds) + CALL worker_push_data (river_iam_dn, river_iam_up, .false., bedelv , bedelv_ds ) DO ibasin = 1, numbasin IF (lake_id(ibasin) < 0) THEN - bedelv(ibasin) = wtsrfelv_ds(ibasin) + minval(hillslope_network(ibasin)%hand) + bedelv(ibasin) = wtsrfelv_ds(ibasin) + minval(hillslope_basin(ibasin)%hand) ENDIF ENDDO @@ -672,31 +738,25 @@ SUBROUTINE river_lake_network_init () ! lake is inland depression outletwth(ibasin) = 0 ENDIF - ELSEIF (to_lake(ibasin) .or. (riverdown(ibasin) == 0)) THEN - ! lake to lake .or. lake catchment to lake .or. lake to ocean - IF (riverdown(ibasin) > 0) THEN - inb = findloc_ud(elementneighbour(ibasin)%glbindex == riverdown(ibasin)) - ELSE - inb = findloc_ud(elementneighbour(ibasin)%glbindex == -9) ! -9 is ocean - ENDIF - - IF (inb <= 0) THEN - outletwth(ibasin) = 0 - IF (riverdown(ibasin) > 0) THEN - outletwth(ibasin) = 90. - ENDIF - ELSE - outletwth(ibasin) = elementneighbour(ibasin)%lenbdr(inb) - ENDIF + ELSEIF (to_lake(ibasin)) THEN + ! lake to lake .or. lake catchment to lake + outletwth(ibasin) = lakeoutlet_bsn(ibasin) + ELSEIF (riverdown(ibasin) == 0) THEN + ! lake to ocean + outletwth(ibasin) = lakeoutlet_bsn(ibasin) ENDIF ENDIF ENDDO ENDIF + IF (allocated (lakedepth_bsnhru)) deallocate (lakedepth_bsnhru) + IF (allocated (lakeoutlet_bsn )) deallocate (lakeoutlet_bsn ) + IF (allocated (lakearea_bsnhru )) deallocate (lakearea_bsnhru ) + #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) - IF (p_is_master) write(*,'(A)') 'Read river network information done.' + IF (p_is_master) write(*,'(A)') 'Building river network information done.' CALL mpi_barrier (p_comm_glb, p_err) #endif @@ -708,16 +768,16 @@ SUBROUTINE calc_riverdepth_from_runoff () USE MOD_SPMD_Task USE MOD_Namelist USE MOD_DataType + USE MOD_Utils USE MOD_NetCDFSerial USE MOD_NetCDFBlock + USE MOD_Pixel USE MOD_Block USE MOD_Mesh USE MOD_Grid USE MOD_SpatialMapping USE MOD_LandElm USE MOD_ElmVector - USE MOD_ElementNeighbour - USE MOD_Hydro_IO IMPLICIT NONE ! Local Variables @@ -729,9 +789,10 @@ SUBROUTINE calc_riverdepth_from_runoff () real(r8), allocatable :: bsnrnof(:) , bsndis(:) integer, allocatable :: nups_riv(:), iups_riv(:), b_up2down(:) - integer :: i, j, ithis, ib, jb, iblkme + integer :: i, j, ithis, ib, jb, iblkme, ipxl integer :: iwork, mesg(2), isrc, ndata real(r8), allocatable :: rcache(:) + real(r8) :: myarea real(r8), parameter :: cH_rivdpt = 0.1 real(r8), parameter :: pH_rivdpt = 0.5 @@ -770,8 +831,15 @@ SUBROUTINE calc_riverdepth_from_runoff () IF (numelm > 0) THEN bsnrnof = bsnrnof /24.0/3600.0 ! from m/day to m/s DO i = 1, numelm + myarea = 0. + DO ipxl = landelm%ipxstt(i), landelm%ipxend(i) + myarea = myarea + 1.0e6 * areaquad ( & + pixel%lat_s(mesh(i)%ilat(ipxl)), pixel%lat_n(mesh(i)%ilat(ipxl)), & + pixel%lon_w(mesh(i)%ilon(ipxl)), pixel%lon_e(mesh(i)%ilon(ipxl)) ) + ENDDO + ! total runoff in basin, from m/s to m3/s - bsnrnof(i) = bsnrnof(i) * elementneighbour(i)%myarea + bsnrnof(i) = bsnrnof(i) * myarea ENDDO ENDIF ENDIF @@ -836,27 +904,23 @@ SUBROUTINE calc_riverdepth_from_runoff () ithis = 0 DO i = 1, totalnumelm IF (iups_riv(i) == nups_riv(i)) THEN + ithis = ithis + 1 b_up2down(ithis) = i j = riverdown(i) - IF (j > 0) THEN + DO WHILE (j > 0) + iups_riv(j) = iups_riv(j) + 1 - DO WHILE (iups_riv(j) == nups_riv(j)) - IF (j < i) THEN - ithis = ithis + 1 - b_up2down(ithis) = j - ENDIF + + IF (iups_riv(j) == nups_riv(j)) THEN + ithis = ithis + 1 + b_up2down(ithis) = j j = riverdown(j) - IF (j > 0) THEN - iups_riv(j) = iups_riv(j) + 1 - ELSE - EXIT - ENDIF - ENDDO - ENDIF - ELSE - CYCLE + ELSE + EXIT + ENDIF + ENDDO ENDIF ENDDO @@ -952,242 +1016,6 @@ FUNCTION retrieve_lake_volume_from_surface (this, surface) result(volume) END FUNCTION retrieve_lake_volume_from_surface - - ! ---------- -#ifdef USEMPI - SUBROUTINE river_data_exchange (direction, accum, & - vec_send1, vec_recv1, vec_send2, vec_recv2, & - vec_send3, vec_recv3, vec_send4, vec_recv4 ) - - USE MOD_Precision - USE MOD_SPMD_Task - IMPLICIT NONE - - integer, intent(in) :: direction - logical, intent(in) :: accum - - real(r8), intent(inout) :: vec_send1(:), vec_recv1(:) - real(r8), intent(inout), optional :: vec_send2(:), vec_recv2(:) - real(r8), intent(inout), optional :: vec_send3(:), vec_recv3(:) - real(r8), intent(inout), optional :: vec_send4(:), vec_recv4(:) - - ! Local Variables - type(river_sendrecv_type), pointer :: send_pointer - integer :: nproc_send, ndatasend, idest - integer, allocatable :: req_send(:,:) - real(r8), allocatable :: sendcache1(:) - real(r8), allocatable :: sendcache2(:) - real(r8), allocatable :: sendcache3(:) - real(r8), allocatable :: sendcache4(:) - - type(river_sendrecv_type), pointer :: recv_pointer - integer :: nproc_recv, ndatarecv, isrc - integer, allocatable :: req_recv(:,:) - real(r8), allocatable :: recvcache1(:) - real(r8), allocatable :: recvcache2(:) - real(r8), allocatable :: recvcache3(:) - real(r8), allocatable :: recvcache4(:) - - integer :: nvec, iproc, i, istt, iend, ndata - - IF (p_is_worker) THEN - - CALL mpi_barrier (p_comm_worker, p_err) - - IF (direction == SEND_DATA_DOWN_TO_UP) THEN - send_pointer => river_up - recv_pointer => river_dn - ELSEIF (direction == SEND_DATA_UP_TO_DOWN) THEN - send_pointer => river_dn - recv_pointer => river_up - ENDIF - - nproc_send = send_pointer%nproc - IF (nproc_send > 0) THEN - - ndatasend = sum(send_pointer%ndata) - - nvec = 1 - allocate (sendcache1(ndatasend)) - DO i = 1, ndatasend - sendcache1(i) = vec_send1(send_pointer%iloc(i)) - ENDDO - - IF (present(vec_send2) .and. present(vec_recv2)) THEN - nvec = nvec + 1 - allocate (sendcache2(ndatasend)) - DO i = 1, ndatasend - sendcache2(i) = vec_send2(send_pointer%iloc(i)) - ENDDO - - IF (present(vec_send3) .and. present(vec_recv3)) THEN - nvec = nvec + 1 - allocate (sendcache3(ndatasend)) - DO i = 1, ndatasend - sendcache3(i) = vec_send3(send_pointer%iloc(i)) - ENDDO - - IF (present(vec_send4) .and. present(vec_recv4)) THEN - nvec = nvec + 1 - allocate (sendcache4(ndatasend)) - DO i = 1, ndatasend - sendcache4(i) = vec_send4(send_pointer%iloc(i)) - ENDDO - ENDIF - ENDIF - ENDIF - - allocate (req_send(nvec,nproc_send)) - - DO iproc = 1, nproc_send - ndata = send_pointer%ndata(iproc) - istt = send_pointer%wdsp (iproc) + 1 - iend = send_pointer%wdsp (iproc) + ndata - idest = send_pointer%iproc(istt) - - CALL mpi_isend(sendcache1(istt:iend), ndata, MPI_REAL8, & - idest, 101, p_comm_glb, req_send(1,iproc), p_err) - IF (present(vec_send2) .and. present(vec_recv2)) THEN - CALL mpi_isend(sendcache2(istt:iend), ndata, MPI_REAL8, & - idest, 102, p_comm_glb, req_send(2,iproc), p_err) - IF (present(vec_send3) .and. present(vec_recv3)) THEN - CALL mpi_isend(sendcache3(istt:iend), ndata, MPI_REAL8, & - idest, 103, p_comm_glb, req_send(3,iproc), p_err) - IF (present(vec_send4) .and. present(vec_recv4)) THEN - CALL mpi_isend(sendcache4(istt:iend), ndata, MPI_REAL8, & - idest, 104, p_comm_glb, req_send(4,iproc), p_err) - ENDIF - ENDIF - ENDIF - ENDDO - - ENDIF - - nproc_recv = recv_pointer%nproc - IF (nproc_recv > 0) THEN - - ndatarecv = sum(recv_pointer%ndata) - - nvec = 1 - allocate (recvcache1(ndatarecv)) - IF (present(vec_send2) .and. present(vec_recv2)) THEN - nvec = nvec + 1 - allocate (recvcache2(ndatarecv)) - IF (present(vec_send3) .and. present(vec_recv3)) THEN - nvec = nvec + 1 - allocate (recvcache3(ndatarecv)) - IF (present(vec_send4) .and. present(vec_recv4)) THEN - nvec = nvec + 1 - allocate (recvcache4(ndatarecv)) - ENDIF - ENDIF - ENDIF - - allocate (req_recv(nvec,nproc_recv)) - - DO iproc = 1, nproc_recv - ndata = recv_pointer%ndata(iproc) - istt = recv_pointer%wdsp(iproc) + 1 - iend = recv_pointer%wdsp(iproc) + ndata - isrc = recv_pointer%iproc(istt) - - CALL mpi_irecv(recvcache1(istt:iend), ndata, MPI_REAL8, & - isrc, 101, p_comm_glb, req_recv(1,iproc), p_err) - IF (present(vec_send2) .and. present(vec_recv2)) THEN - CALL mpi_irecv(recvcache2(istt:iend), ndata, MPI_REAL8, & - isrc, 102, p_comm_glb, req_recv(2,iproc), p_err) - IF (present(vec_send3) .and. present(vec_recv3)) THEN - CALL mpi_irecv(recvcache3(istt:iend), ndata, MPI_REAL8, & - isrc, 103, p_comm_glb, req_recv(3,iproc), p_err) - IF (present(vec_send4) .and. present(vec_recv4)) THEN - CALL mpi_irecv(recvcache4(istt:iend), ndata, MPI_REAL8, & - isrc, 104, p_comm_glb, req_recv(4,iproc), p_err) - ENDIF - ENDIF - ENDIF - ENDDO - - ENDIF - - IF (nproc_recv > 0) THEN - - CALL mpi_waitall(nvec*nproc_recv, req_recv, MPI_STATUSES_IGNORE, p_err) - ! write(*,*) 'p error', p_err - - IF (accum) THEN - DO i = 1, ndatarecv - vec_recv1(recv_pointer%iloc(i)) = & - vec_recv1(recv_pointer%iloc(i)) + recvcache1(i) - ENDDO - - IF (present(vec_send2) .and. present(vec_recv2)) THEN - DO i = 1, ndatarecv - vec_recv2(recv_pointer%iloc(i)) = & - vec_recv2(recv_pointer%iloc(i)) + recvcache2(i) - ENDDO - - IF (present(vec_send3) .and. present(vec_recv3)) THEN - DO i = 1, ndatarecv - vec_recv3(recv_pointer%iloc(i)) = & - vec_recv3(recv_pointer%iloc(i)) + recvcache3(i) - ENDDO - - IF (present(vec_send4) .and. present(vec_recv4)) THEN - DO i = 1, ndatarecv - vec_recv4(recv_pointer%iloc(i)) = & - vec_recv4(recv_pointer%iloc(i)) + recvcache4(i) - ENDDO - ENDIF - ENDIF - ENDIF - ELSE - DO i = 1, ndatarecv - vec_recv1(recv_pointer%iloc(i)) = recvcache1(i) - ENDDO - - IF (present(vec_send2) .and. present(vec_recv2)) THEN - DO i = 1, ndatarecv - vec_recv2(recv_pointer%iloc(i)) = recvcache2(i) - ENDDO - - IF (present(vec_send3) .and. present(vec_recv3)) THEN - DO i = 1, ndatarecv - vec_recv3(recv_pointer%iloc(i)) = recvcache3(i) - ENDDO - - IF (present(vec_send4) .and. present(vec_recv4)) THEN - DO i = 1, ndatarecv - vec_recv4(recv_pointer%iloc(i)) = recvcache4(i) - ENDDO - ENDIF - ENDIF - ENDIF - ENDIF - ENDIF - - IF (nproc_send > 0) THEN - CALL mpi_waitall(nvec*nproc_send, req_send, MPI_STATUSES_IGNORE, p_err) - ENDIF - - IF (allocated(req_send )) deallocate(req_send) - IF (allocated(sendcache1)) deallocate(sendcache1) - IF (allocated(sendcache2)) deallocate(sendcache2) - IF (allocated(sendcache3)) deallocate(sendcache3) - IF (allocated(sendcache4)) deallocate(sendcache4) - - IF (allocated(req_recv )) deallocate(req_recv) - IF (allocated(recvcache1)) deallocate(recvcache1) - IF (allocated(recvcache2)) deallocate(recvcache2) - IF (allocated(recvcache3)) deallocate(recvcache3) - IF (allocated(recvcache4)) deallocate(recvcache4) - - CALL mpi_barrier (p_comm_worker, p_err) - - ENDIF - - END SUBROUTINE river_data_exchange -#endif - ! ---------- SUBROUTINE river_lake_network_final () @@ -1207,7 +1035,6 @@ SUBROUTINE river_lake_network_final () IF (allocated(handmin )) deallocate(handmin ) IF (allocated(wtsrfelv )) deallocate(wtsrfelv ) IF (allocated(riverdown)) deallocate(riverdown) - IF (allocated(addrdown )) deallocate(addrdown ) IF (allocated(to_lake )) deallocate(to_lake ) IF (allocated(riverlen_ds)) deallocate(riverlen_ds) @@ -1215,35 +1042,26 @@ SUBROUTINE river_lake_network_final () IF (allocated(riverwth_ds)) deallocate(riverwth_ds) IF (allocated(bedelv_ds )) deallocate(bedelv_ds ) IF (allocated(outletwth )) deallocate(outletwth ) + + IF (allocated(lakeinfo)) deallocate(lakeinfo) - IF (allocated(lakes)) THEN - DO ilake = 1, size(lakes) - IF (allocated(lakes(ilake)%area0 )) deallocate(lakes(ilake)%area0 ) - IF (allocated(lakes(ilake)%area )) deallocate(lakes(ilake)%area ) - IF (allocated(lakes(ilake)%depth0 )) deallocate(lakes(ilake)%depth0 ) - IF (allocated(lakes(ilake)%depth )) deallocate(lakes(ilake)%depth ) - IF (allocated(lakes(ilake)%dep_vol_curve)) deallocate(lakes(ilake)%dep_vol_curve) - ENDDO - - deallocate(lakes) - ENDIF + IF (associated(hillslope_basin)) deallocate(hillslope_basin) END SUBROUTINE river_lake_network_final ! --------- - SUBROUTINE river_sendrecv_free_mem (this) - + SUBROUTINE lake_info_free_mem (this) + IMPLICIT NONE - type(river_sendrecv_type) :: this + type(lake_info_type) :: this - IF (allocated(this%iproc)) deallocate(this%iproc) - IF (allocated(this%wdsp )) deallocate(this%wdsp ) - IF (allocated(this%ndata)) deallocate(this%ndata) - IF (allocated(this%ups )) deallocate(this%ups ) - IF (allocated(this%down )) deallocate(this%down ) - IF (allocated(this%iloc )) deallocate(this%iloc ) + IF (allocated(this%area0 )) deallocate (this%area0 ) + IF (allocated(this%area )) deallocate (this%area ) + IF (allocated(this%depth0)) deallocate (this%depth0) + IF (allocated(this%depth )) deallocate (this%depth ) + IF (allocated(this%dep_vol_curve)) deallocate (this%dep_vol_curve) - END SUBROUTINE river_sendrecv_free_mem + END SUBROUTINE lake_info_free_mem END MODULE MOD_Catch_RiverLakeNetwork #endif diff --git a/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 b/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 index 43b73491..1d20905a 100644 --- a/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 +++ b/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 @@ -8,7 +8,7 @@ MODULE MOD_Catch_SubsurfaceFlow ! Ground water lateral flow. ! ! Ground water fluxes are calculated -! 1. between basins +! 1. between elements ! 2. between hydrological response units ! 3. between patches inside one HRU ! @@ -17,7 +17,16 @@ MODULE MOD_Catch_SubsurfaceFlow USE MOD_Precision USE MOD_DataType + USE MOD_Catch_HillslopeNetwork IMPLICIT NONE + + ! --- information of HRU on hillslope --- + type(hillslope_network_type), pointer :: hillslope_element (:) + + integer, allocatable :: lake_id_elm (:) + real(r8), allocatable :: lakedepth_elm(:) + real(r8), allocatable :: riverdpth_elm(:) + real(r8), allocatable :: wdsrf_elm (:) real(r8), parameter :: e_ice = 6.0 ! soil ice impedance factor @@ -36,63 +45,123 @@ MODULE MOD_Catch_SubsurfaceFlow type(pointer_real8_1d), allocatable :: Kl_nb (:) ! lateral hydraulic conductivity [m/s] type(pointer_real8_1d), allocatable :: wdsrf_nb (:) ! depth of surface water [m] type(pointer_logic_1d), allocatable :: islake_nb (:) ! whether a neighbour is water body + type(pointer_real8_1d), allocatable :: lakedp_nb (:) ! lake depth of neighbour [m] CONTAINS ! ---------- - SUBROUTINE basin_neighbour_init () + SUBROUTINE subsurface_network_init () USE MOD_SPMD_Task + USE MOD_Utils USE MOD_Mesh + USE MOD_Pixel + USE MOD_LandElm + USE MOD_LandPatch USE MOD_ElementNeighbour - USE MOD_Catch_HillslopeNetwork, only : hillslope_network - USE MOD_Catch_RiverLakeNetwork, only : lake_id + USE MOD_Catch_BasinNetwork, only : worker_push_data, iam_bsn, iam_elm + USE MOD_Catch_RiverLakeNetwork, only : lake_id, riverdpth + USE MOD_Vars_TimeInvariants, only : patchtype, lakedepth IMPLICIT NONE - integer :: numbasin, ibasin, inb + integer :: ielm, inb, i, ihru, ps, pe, ipatch, ipxl real(r8), allocatable :: agwt_b(:) real(r8), allocatable :: islake(:) type(pointer_real8_1d), allocatable :: iswat_nb (:) + integer, allocatable :: eindex(:) + #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - numbasin = numelm + IF (p_is_worker) THEN + IF (numelm > 0) THEN + allocate (eindex (numelm)) + eindex = landelm%eindex + ENDIF + ENDIF + + CALL hillslope_network_init (numelm, eindex, hillslope_element) + + IF (allocated(eindex)) deallocate (eindex) IF (p_is_worker) THEN + IF (numelm > 0) allocate (lake_id_elm (numelm)) + IF (numelm > 0) allocate (riverdpth_elm(numelm)) + IF (numelm > 0) allocate (lakedepth_elm(numelm)) + IF (numelm > 0) allocate (wdsrf_elm (numelm)) + + CALL worker_push_data (iam_bsn, iam_elm, .false., lake_id, lake_id_elm ) + CALL worker_push_data (iam_bsn, iam_elm, .false., riverdpth, riverdpth_elm) + + DO ielm = 1, numelm + IF (lake_id_elm(ielm) <= 0) THEN + DO i = 1, hillslope_element(ielm)%nhru + + hillslope_element(ielm)%agwt(i) = 0 + + ihru = hillslope_element(ielm)%ihru(i) + ps = hru_patch%substt(ihru) + pe = hru_patch%subend(ihru) + DO ipatch = ps, pe + IF (patchtype(ipatch) <= 2) THEN + DO ipxl = landpatch%ipxstt(ipatch), landpatch%ipxend(ipatch) + hillslope_element(ielm)%agwt(i) = hillslope_element(ielm)%agwt(i) & + + 1.0e6 * areaquad ( & + pixel%lat_s(mesh(ielm)%ilat(ipxl)), pixel%lat_n(mesh(ielm)%ilat(ipxl)), & + pixel%lon_w(mesh(ielm)%ilon(ipxl)), pixel%lon_e(mesh(ielm)%ilon(ipxl)) ) + ENDDO + ENDIF + ENDDO + + ENDDO + ENDIF + ENDDO + + lakedepth_elm(:) = 0. + DO ielm = 1, numelm + IF (lake_id_elm(ielm) > 0) THEN + ps = elm_patch%substt(ielm) + pe = elm_patch%subend(ielm) + lakedepth_elm(ielm) = sum(lakedepth(ps:pe) * elm_patch%subfrc(ps:pe)) + ENDIF + ENDDO + CALL allocate_neighbour_data (agwt_nb ) CALL allocate_neighbour_data (theta_a_nb) CALL allocate_neighbour_data (zwt_nb ) - CALL allocate_neighbour_data (Kl_nb ) + CALL allocate_neighbour_data (Kl_nb ) CALL allocate_neighbour_data (wdsrf_nb ) CALL allocate_neighbour_data (islake_nb ) - + CALL allocate_neighbour_data (lakedp_nb ) CALL allocate_neighbour_data (iswat_nb ) - IF (numbasin > 0) THEN - allocate (agwt_b(numbasin)) - allocate (islake(numbasin)) - DO ibasin = 1, numbasin - IF (lake_id(ibasin) <= 0) THEN - agwt_b(ibasin) = sum(hillslope_network(ibasin)%agwt) - islake(ibasin) = 0. + IF (numelm > 0) THEN + allocate (agwt_b(numelm)) + allocate (islake(numelm)) + DO ielm = 1, numelm + IF (lake_id_elm(ielm) <= 0) THEN + agwt_b(ielm) = sum(hillslope_element(ielm)%agwt) + islake(ielm) = 0. ELSE - agwt_b(ibasin) = 0. - islake(ibasin) = 1. + agwt_b(ielm) = 0. + islake(ielm) = 1. ENDIF ENDDO ENDIF + CALL retrieve_neighbour_data (lakedepth_elm, lakedp_nb) + CALL retrieve_neighbour_data (agwt_b, agwt_nb ) CALL retrieve_neighbour_data (islake, iswat_nb) - DO ibasin = 1, numbasin - DO inb = 1, elementneighbour(ibasin)%nnb - IF (elementneighbour(ibasin)%glbindex(inb) > 0) THEN ! skip ocean neighbour - islake_nb(ibasin)%val(inb) = (iswat_nb(ibasin)%val(inb) > 0) + DO ielm = 1, numelm + DO inb = 1, elementneighbour(ielm)%nnb + IF (elementneighbour(ielm)%glbindex(inb) > 0) THEN ! skip ocean neighbour + islake_nb(ielm)%val(inb) = (iswat_nb(ielm)%val(inb) > 0) ENDIF ENDDO ENDDO @@ -103,7 +172,7 @@ SUBROUTINE basin_neighbour_init () ENDIF - END SUBROUTINE basin_neighbour_init + END SUBROUTINE subsurface_network_init ! --------- SUBROUTINE subsurface_flow (deltime) @@ -112,12 +181,12 @@ SUBROUTINE subsurface_flow (deltime) USE MOD_UserDefFun USE MOD_Mesh USE MOD_LandElm + USE MOD_LandHRU USE MOD_LandPatch USE MOD_Vars_TimeVariables USE MOD_Vars_TimeInvariants USE MOD_Vars_1DFluxes USE MOD_Catch_HillslopeNetwork - USE MOD_Catch_RiverLakeNetwork USE MOD_ElementNeighbour USE MOD_Const_Physical, only : denice, denh2o USE MOD_Vars_Global, only : pi, nl_soil, zi_soi @@ -128,9 +197,9 @@ SUBROUTINE subsurface_flow (deltime) real(r8), intent(in) :: deltime ! Local Variables - integer :: numbasin, nhru, ibasin, i, i0, j, ihru, ipatch, ps, pe, ilev + integer :: nhru, ielm, i, i0, j, ihru, ipatch, ps, pe, hs, he, ilev - type(hillslope_network_info_type), pointer :: hrus + type(hillslope_network_type), pointer :: hrus real(r8), allocatable :: theta_a_h (:) real(r8), allocatable :: zwt_h (:) @@ -146,9 +215,9 @@ SUBROUTINE subsurface_flow (deltime) real(r8) :: ca, cb real(r8) :: alp - real(r8), allocatable :: theta_a_bsn (:) - real(r8), allocatable :: zwt_bsn (:) - real(r8), allocatable :: Kl_bsn (:) ! [m/s] + real(r8), allocatable :: theta_a_elm (:) + real(r8), allocatable :: zwt_elm (:) + real(r8), allocatable :: Kl_elm (:) ! [m/s] integer :: jnb real(r8) :: zsubs_up, zwt_up, Kl_up, theta_a_up, area_up @@ -179,9 +248,7 @@ SUBROUTINE subsurface_flow (deltime) IF (p_is_worker) THEN - numbasin = numelm - - xsubs_bsn(:) = 0. ! subsurface lateral flow between basins + xsubs_elm(:) = 0. ! subsurface lateral flow between element basins xsubs_hru(:) = 0. ! subsurface lateral flow between hydrological response units xsubs_pch(:) = 0. ! subsurface lateral flow between patches inside one HRU @@ -189,20 +256,20 @@ SUBROUTINE subsurface_flow (deltime) bdamp = 4.8 - IF (numbasin > 0) THEN - allocate (theta_a_bsn (numbasin)); theta_a_bsn = 0. - allocate (zwt_bsn (numbasin)); zwt_bsn = 0. - allocate (Kl_bsn (numbasin)); Kl_bsn = 0. + IF (numelm > 0) THEN + allocate (theta_a_elm (numelm)); theta_a_elm = 0. + allocate (zwt_elm (numelm)); zwt_elm = 0. + allocate (Kl_elm (numelm)); Kl_elm = 0. ENDIF - DO ibasin = 1, numbasin + DO ielm = 1, numelm - hrus => hillslope_network(ibasin) + hrus => hillslope_element(ielm) nhru = hrus%nhru - IF (lake_id(ibasin) > 0) CYCLE ! lake - IF (sum(hrus%agwt) <= 0) CYCLE ! no area of soil, urban or wetland + IF (lake_id_elm(ielm) > 0) CYCLE ! lake + IF (sum(hrus%agwt) <= 0) CYCLE ! no area of soil, urban or wetland allocate (theta_a_h (nhru)); theta_a_h = 0. allocate (zwt_h (nhru)); zwt_h = 0. @@ -303,7 +370,7 @@ SUBROUTINE subsurface_flow (deltime) IF (.not. j_is_river) THEN zsubs_h_dn = hrus%elva(j) - zwt_h(j) ELSE - zsubs_h_dn = hrus%elva(1) - riverdpth(ibasin) + wdsrf_hru(hrus%ihru(1)) + zsubs_h_dn = hrus%elva(1) - riverdpth_elm(ielm) + wdsrf_hru(hrus%ihru(1)) ENDIF IF (.not. j_is_river) THEN @@ -358,8 +425,8 @@ SUBROUTINE subsurface_flow (deltime) IF (hrus%indx(1) == 0) THEN ! xsubs_h(1) is positive = out of soil column - IF (xsubs_h(1)*deltime > wdsrf_bsn(ibasin)) THEN - alp = wdsrf_bsn(ibasin) / (xsubs_h(1)*deltime) + IF (xsubs_h(1)*deltime > wdsrf_hru(hrus%ihru(1))) THEN + alp = wdsrf_hru(hrus%ihru(1)) / (xsubs_h(1)*deltime) xsubs_h(1) = xsubs_h(1) * alp DO i = 2, nhru IF ((hrus%inext(i) == 1) .and. (hrus%agwt(i) > 0.)) THEN @@ -385,7 +452,7 @@ SUBROUTINE subsurface_flow (deltime) IF (hrus%indx(1) == 0) THEN DO ipatch = ps, pe IF (patchtype(ipatch) <= 2) THEN - rsub(ipatch) = - xsubs_h(1) * riverarea(ibasin) / sum(hrus%agwt) * 1.0e3 ! m/s to mm/s + rsub(ipatch) = - xsubs_h(1) * hrus%area(1) / sum(hrus%agwt) * 1.0e3 ! m/s to mm/s ENDIF ENDDO ENDIF @@ -421,9 +488,9 @@ SUBROUTINE subsurface_flow (deltime) sumarea = sum(hrus%agwt) IF (sumarea > 0) THEN - theta_a_bsn (ibasin) = sum(theta_a_h * hrus%agwt) / sumarea - zwt_bsn (ibasin) = sum(zwt_h * hrus%agwt) / sumarea - Kl_bsn (ibasin) = sum(Kl_h * hrus%agwt) / sumarea + theta_a_elm (ielm) = sum(theta_a_h * hrus%agwt) / sumarea + zwt_elm (ielm) = sum(zwt_h * hrus%agwt) / sumarea + Kl_elm (ielm) = sum(Kl_h * hrus%agwt) / sumarea ENDIF deallocate (theta_a_h) @@ -434,49 +501,55 @@ SUBROUTINE subsurface_flow (deltime) ENDDO - CALL retrieve_neighbour_data (theta_a_bsn, theta_a_nb) - CALL retrieve_neighbour_data (zwt_bsn , zwt_nb ) - CALL retrieve_neighbour_data (Kl_bsn , Kl_nb ) - CALL retrieve_neighbour_data (wdsrf_bsn , wdsrf_nb ) + DO ielm = 1, numelm + hs = elm_hru%substt(ielm) + he = elm_hru%subend(ielm) + wdsrf_elm(ielm) = sum(wdsrf_hru(hs:he) * elm_hru%subfrc(hs:he)) + ENDDO + + CALL retrieve_neighbour_data (theta_a_elm, theta_a_nb) + CALL retrieve_neighbour_data (zwt_elm , zwt_nb ) + CALL retrieve_neighbour_data (Kl_elm , Kl_nb ) + CALL retrieve_neighbour_data (wdsrf_elm , wdsrf_nb ) - DO ibasin = 1, numbasin + DO ielm = 1, numelm - hrus => hillslope_network(ibasin) + hrus => hillslope_element(ielm) - iam_lake = (lake_id(ibasin) > 0) + iam_lake = (lake_id_elm(ielm) > 0) - DO jnb = 1, elementneighbour(ibasin)%nnb + DO jnb = 1, elementneighbour(ielm)%nnb - IF (elementneighbour(ibasin)%glbindex(jnb) == -9) CYCLE ! skip ocean neighbour + IF (elementneighbour(ielm)%glbindex(jnb) == -9) CYCLE ! skip ocean neighbour - nb_is_lake = islake_nb(ibasin)%val(jnb) + nb_is_lake = islake_nb(ielm)%val(jnb) IF (iam_lake .and. nb_is_lake) THEN CYCLE ENDIF IF (.not. iam_lake) THEN - Kl_up = Kl_bsn (ibasin) - zwt_up = zwt_bsn (ibasin) - theta_a_up = theta_a_bsn(ibasin) - zsubs_up = elementneighbour(ibasin)%myelva - zwt_up + Kl_up = Kl_elm (ielm) + zwt_up = zwt_elm (ielm) + theta_a_up = theta_a_elm(ielm) + zsubs_up = elementneighbour(ielm)%myelva - zwt_up area_up = sum(hrus%agwt) ELSE theta_a_up = 1. - zsubs_up = elementneighbour(ibasin)%myelva + wdsrf_bsn(ibasin) - area_up = elementneighbour(ibasin)%myarea + zsubs_up = elementneighbour(ielm)%myelva - lakedepth_elm(ielm) + wdsrf_elm(ielm) + area_up = elementneighbour(ielm)%myarea ENDIF IF (.not. nb_is_lake) THEN - Kl_dn = Kl_nb(ibasin)%val(jnb) - zwt_dn = zwt_nb(ibasin)%val(jnb) - theta_a_dn = theta_a_nb(ibasin)%val(jnb) - zsubs_dn = elementneighbour(ibasin)%elva(jnb) - zwt_dn - area_dn = agwt_nb(ibasin)%val(jnb) + Kl_dn = Kl_nb(ielm)%val(jnb) + zwt_dn = zwt_nb(ielm)%val(jnb) + theta_a_dn = theta_a_nb(ielm)%val(jnb) + zsubs_dn = elementneighbour(ielm)%elva(jnb) - zwt_dn + area_dn = agwt_nb(ielm)%val(jnb) ELSE theta_a_dn = 1. - zsubs_dn = elementneighbour(ibasin)%elva(jnb) + wdsrf_nb(ibasin)%val(jnb) - area_dn = elementneighbour(ibasin)%area(jnb) + zsubs_dn = elementneighbour(ielm)%elva(jnb) - lakedp_nb(ielm)%val(jnb) + wdsrf_nb(ielm)%val(jnb) + area_dn = elementneighbour(ielm)%area(jnb) ENDIF IF ((.not. iam_lake) .and. (area_up <= 0)) CYCLE @@ -485,25 +558,25 @@ SUBROUTINE subsurface_flow (deltime) IF ((.not. nb_is_lake) .and. (Kl_dn == 0. )) CYCLE ! water body is dry. - IF (iam_lake .and. (zsubs_up > zsubs_dn) .and. (wdsrf_bsn(ibasin) == 0.)) THEN + IF (iam_lake .and. (zsubs_up > zsubs_dn) .and. (wdsrf_elm(ielm) == 0.)) THEN CYCLE ENDIF - IF (nb_is_lake .and. (zsubs_up < zsubs_dn) .and. (wdsrf_nb(ibasin)%val(jnb) == 0.)) THEN + IF (nb_is_lake .and. (zsubs_up < zsubs_dn) .and. (wdsrf_nb(ielm)%val(jnb) == 0.)) THEN CYCLE ENDIF - lenbdr = elementneighbour(ibasin)%lenbdr(jnb) + lenbdr = elementneighbour(ielm)%lenbdr(jnb) - delp = elementneighbour(ibasin)%dist(jnb) + delp = elementneighbour(ielm)%dist(jnb) IF (iam_lake) THEN - delp = elementneighbour(ibasin)%area(jnb) / lenbdr * 0.5 + delp = elementneighbour(ielm)%area(jnb) / lenbdr * 0.5 ENDIF IF (nb_is_lake) THEN - delp = elementneighbour(ibasin)%myarea / lenbdr * 0.5 + delp = elementneighbour(ielm)%myarea / lenbdr * 0.5 ENDIF ! from Fan et al., JGR 112(D10125) - slope = abs(elementneighbour(ibasin)%slope(jnb)) + slope = abs(elementneighbour(ielm)%slope(jnb)) IF (slope > 0.16) THEN bdamp = 4.8 ELSE @@ -534,27 +607,27 @@ SUBROUTINE subsurface_flow (deltime) IF (.not. iam_lake) THEN xsubs_nb = xsubs_nb / sum(hrus%agwt) ELSE - xsubs_nb = xsubs_nb / elementneighbour(ibasin)%myarea + xsubs_nb = xsubs_nb / elementneighbour(ielm)%myarea ENDIF - xsubs_bsn(ibasin) = xsubs_bsn(ibasin) + xsubs_nb + xsubs_elm(ielm) = xsubs_elm(ielm) + xsubs_nb ENDDO ! Update total subsurface lateral flow (3): Between basins - ps = elm_patch%substt(ibasin) - pe = elm_patch%subend(ibasin) + ps = elm_patch%substt(ielm) + pe = elm_patch%subend(ielm) DO ipatch = ps, pe IF (iam_lake .or. (patchtype(ipatch) <= 2)) THEN - xwsub(ipatch) = xwsub(ipatch) + xsubs_bsn(ibasin) * 1.e3 ! m/s to mm/s + xwsub(ipatch) = xwsub(ipatch) + xsubs_elm(ielm) * 1.e3 ! m/s to mm/s ENDIF ENDDO ENDDO - IF (allocated(theta_a_bsn)) deallocate(theta_a_bsn) - IF (allocated(zwt_bsn )) deallocate(zwt_bsn ) - IF (allocated(Kl_bsn )) deallocate(Kl_bsn ) + IF (allocated(theta_a_elm)) deallocate(theta_a_elm) + IF (allocated(zwt_elm )) deallocate(zwt_elm ) + IF (allocated(Kl_elm )) deallocate(Kl_elm ) ENDIF @@ -713,18 +786,26 @@ SUBROUTINE subsurface_flow (deltime) END SUBROUTINE subsurface_flow ! ---------- - SUBROUTINE basin_neighbour_final () + SUBROUTINE subsurface_network_final () IMPLICIT NONE + IF (allocated(lake_id_elm )) deallocate(lake_id_elm ) + IF (allocated(riverdpth_elm)) deallocate(riverdpth_elm) + IF (allocated(lakedepth_elm)) deallocate(lakedepth_elm) + IF (allocated(wdsrf_elm )) deallocate(wdsrf_elm ) + IF (allocated(theta_a_nb)) deallocate(theta_a_nb) IF (allocated(zwt_nb )) deallocate(zwt_nb ) IF (allocated(Kl_nb )) deallocate(Kl_nb ) IF (allocated(wdsrf_nb )) deallocate(wdsrf_nb ) IF (allocated(agwt_nb )) deallocate(agwt_nb ) IF (allocated(islake_nb )) deallocate(islake_nb ) + IF (allocated(lakedp_nb )) deallocate(lakedp_nb ) + + IF (associated(hillslope_element)) deallocate(hillslope_element) - END SUBROUTINE basin_neighbour_final + END SUBROUTINE subsurface_network_final END MODULE MOD_Catch_SubsurfaceFlow #endif diff --git a/main/HYDRO/MOD_Hydro_Vars_1DFluxes.F90 b/main/HYDRO/MOD_Catch_Vars_1DFluxes.F90 similarity index 56% rename from main/HYDRO/MOD_Hydro_Vars_1DFluxes.F90 rename to main/HYDRO/MOD_Catch_Vars_1DFluxes.F90 index 4dbdd139..e86d29b4 100644 --- a/main/HYDRO/MOD_Hydro_Vars_1DFluxes.F90 +++ b/main/HYDRO/MOD_Catch_Vars_1DFluxes.F90 @@ -1,7 +1,7 @@ #include #ifdef CatchLateralFlow -MODULE MOD_Hydro_Vars_1DFluxes +MODULE MOD_Catch_Vars_1DFluxes !------------------------------------------------------------------------------------- ! DESCRIPTION: ! @@ -14,87 +14,93 @@ MODULE MOD_Hydro_Vars_1DFluxes IMPLICIT NONE ! -- fluxes -- - real(r8), allocatable :: xsubs_bsn (:) ! subsurface lateral flow between basins [m/s] + real(r8), allocatable :: xsubs_elm (:) ! subsurface lateral flow between basins [m/s] real(r8), allocatable :: xsubs_hru (:) ! subsurface lateral flow between hydrological response units [m/s] real(r8), allocatable :: xsubs_pch (:) ! subsurface lateral flow between patches inside one HRU [m/s] real(r8), allocatable :: wdsrf_bsn_ta (:) ! time step average of river height [m] real(r8), allocatable :: momen_riv_ta (:) ! time step average of river momentum [m^2/s] real(r8), allocatable :: veloc_riv_ta (:) ! time step average of river velocity [m/s] + real(r8), allocatable :: discharge_ta (:) ! river discharge [m^3/s] - real(r8), allocatable :: wdsrf_hru_ta (:) ! time step average of surface water depth [m] - real(r8), allocatable :: momen_hru_ta (:) ! time step average of surface water momentum [m^2/s] - real(r8), allocatable :: veloc_hru_ta (:) ! time step average of surface water veloctiy [m/s] + real(r8), allocatable :: wdsrf_bsnhru_ta (:) ! time step average of surface water depth [m] + real(r8), allocatable :: momen_bsnhru_ta (:) ! time step average of surface water momentum [m^2/s] + real(r8), allocatable :: veloc_bsnhru_ta (:) ! time step average of surface water veloctiy [m/s] real(r8), allocatable :: xwsur (:) ! surface water exchange [mm h2o/s] real(r8), allocatable :: xwsub (:) ! subsurface water exchange [mm h2o/s] - real(r8), allocatable :: discharge (:) ! river discharge [m^3/s] - + ! PUBLIC MEMBER FUNCTIONS: - PUBLIC :: allocate_1D_HydroFluxes - PUBLIC :: deallocate_1D_HydroFluxes + PUBLIC :: allocate_1D_CatchFluxes + PUBLIC :: deallocate_1D_CatchFluxes CONTAINS - SUBROUTINE allocate_1D_HydroFluxes + SUBROUTINE allocate_1D_CatchFluxes USE MOD_SPMD_Task USE MOD_Vars_Global, only : spval - USE MOD_Mesh, only : numelm - USE MOD_LandHRU, only : numhru - USE MOD_LandPatch, only : numpatch + USE MOD_Mesh, only : numelm + USE MOD_LandHRU, only : numhru + USE MOD_LandPatch, only : numpatch + USE MOD_Catch_BasinNetwork, only : numbasin, numbsnhru IMPLICIT NONE - integer :: numbasin - - numbasin = numelm - IF (p_is_worker) THEN + IF (numpatch > 0) THEN allocate (xsubs_pch (numpatch)) ; xsubs_pch (:) = spval allocate (xwsur (numpatch)) ; xwsur (:) = spval allocate (xwsub (numpatch)) ; xwsub (:) = spval ENDIF + + IF (numelm > 0) THEN + allocate (xsubs_elm (numelm)) ; xsubs_elm(:) = spval + ENDIF + IF (numbasin > 0) THEN - allocate (xsubs_bsn (numbasin)) ; xsubs_bsn (:) = spval allocate (wdsrf_bsn_ta (numbasin)) ; wdsrf_bsn_ta (:) = spval allocate (momen_riv_ta (numbasin)) ; momen_riv_ta (:) = spval allocate (veloc_riv_ta (numbasin)) ; veloc_riv_ta (:) = spval - allocate (discharge (numbasin)) ; discharge (:) = spval + allocate (discharge_ta (numbasin)) ; discharge_ta (:) = spval ENDIF + IF (numhru > 0) THEN - allocate (xsubs_hru (numhru)) ; xsubs_hru (:) = spval - allocate (wdsrf_hru_ta (numhru)) ; wdsrf_hru_ta (:) = spval - allocate (momen_hru_ta (numhru)) ; momen_hru_ta (:) = spval - allocate (veloc_hru_ta (numhru)) ; veloc_hru_ta (:) = spval + allocate (xsubs_hru (numhru)); xsubs_hru(:) = spval + ENDIF + + IF (numbsnhru > 0) THEN + allocate (wdsrf_bsnhru_ta (numbsnhru)) ; wdsrf_bsnhru_ta (:) = spval + allocate (momen_bsnhru_ta (numbsnhru)) ; momen_bsnhru_ta (:) = spval + allocate (veloc_bsnhru_ta (numbsnhru)) ; veloc_bsnhru_ta (:) = spval ENDIF + ENDIF - END SUBROUTINE allocate_1D_HydroFluxes + END SUBROUTINE allocate_1D_CatchFluxes - SUBROUTINE deallocate_1D_HydroFluxes + SUBROUTINE deallocate_1D_CatchFluxes IMPLICIT NONE - IF (allocated(xsubs_pch)) deallocate(xsubs_pch) + IF (allocated(xsubs_elm)) deallocate(xsubs_elm) IF (allocated(xsubs_hru)) deallocate(xsubs_hru) - IF (allocated(xsubs_bsn)) deallocate(xsubs_bsn) + IF (allocated(xsubs_pch)) deallocate(xsubs_pch) IF (allocated(wdsrf_bsn_ta)) deallocate(wdsrf_bsn_ta) IF (allocated(momen_riv_ta)) deallocate(momen_riv_ta) IF (allocated(veloc_riv_ta)) deallocate(veloc_riv_ta) + IF (allocated(discharge_ta)) deallocate(discharge_ta) - IF (allocated(wdsrf_hru_ta)) deallocate(wdsrf_hru_ta) - IF (allocated(momen_hru_ta)) deallocate(momen_hru_ta) - IF (allocated(veloc_hru_ta)) deallocate(veloc_hru_ta) + IF (allocated(wdsrf_bsnhru_ta)) deallocate(wdsrf_bsnhru_ta) + IF (allocated(momen_bsnhru_ta)) deallocate(momen_bsnhru_ta) + IF (allocated(veloc_bsnhru_ta)) deallocate(veloc_bsnhru_ta) IF (allocated(xwsur)) deallocate(xwsur) IF (allocated(xwsub)) deallocate(xwsub) - IF (allocated(discharge)) deallocate(discharge) - - END SUBROUTINE deallocate_1D_HydroFluxes + END SUBROUTINE deallocate_1D_CatchFluxes -END MODULE MOD_Hydro_Vars_1DFluxes +END MODULE MOD_Catch_Vars_1DFluxes #endif diff --git a/main/HYDRO/MOD_Catch_Vars_TimeVariables.F90 b/main/HYDRO/MOD_Catch_Vars_TimeVariables.F90 new file mode 100644 index 00000000..2a7e20f1 --- /dev/null +++ b/main/HYDRO/MOD_Catch_Vars_TimeVariables.F90 @@ -0,0 +1,177 @@ +#include + +#ifdef CatchLateralFlow +MODULE MOD_Catch_Vars_TimeVariables +!------------------------------------------------------------------------------------- +! DESCRIPTION: +! +! Time Variables in lateral hydrological processes. +! +! Created by Shupeng Zhang, May 2023 +!------------------------------------------------------------------------------------- + + USE MOD_Precision + USE MOD_Catch_BasinNetwork + IMPLICIT NONE + + ! -- state variables (1): necessary for restart -- + real(r8), allocatable :: veloc_elm (:) ! river velocity [m/s] + real(r8), allocatable :: veloc_hru (:) ! surface water velocity [m/s] + real(r8), allocatable :: wdsrf_hru (:) ! surface water depth [m] + + real(r8), allocatable :: wdsrf_elm_prev (:) ! river or lake water depth at previous time step [m] + real(r8), allocatable :: wdsrf_hru_prev (:) ! surface water depth at previous time step [m] + + ! -- state variables (2): only in model -- + real(r8), allocatable :: wdsrf_bsn (:) ! river or lake water depth [m] + real(r8), allocatable :: veloc_riv (:) ! river velocity [m/s] + real(r8), allocatable :: momen_riv (:) ! unit river momentum [m^2/s] + real(r8), allocatable :: wdsrf_bsnhru (:) ! surface water depth [m] + real(r8), allocatable :: veloc_bsnhru (:) ! surface water velocity [m/s] + real(r8), allocatable :: momen_bsnhru (:) ! unit surface water momentum [m^2/s] + + real(r8), allocatable :: wdsrf_bsn_prev (:) ! river or lake water depth at previous time step [m] + real(r8), allocatable :: wdsrf_bsnhru_prev (:) ! surface water depth at previous time step [m] + + ! PUBLIC MEMBER FUNCTIONS: + PUBLIC :: allocate_CatchTimeVariables + PUBLIC :: deallocate_CatchTimeVariables + + PUBLIC :: read_CatchTimeVariables + PUBLIC :: write_CatchTimeVariables + +CONTAINS + + SUBROUTINE allocate_CatchTimeVariables + + USE MOD_SPMD_Task + USE MOD_Mesh, only : numelm + USE MOD_LandHRU, only : numhru + IMPLICIT NONE + + IF (p_is_worker) THEN + + IF (numelm > 0) THEN + allocate (veloc_elm (numelm)) + allocate (wdsrf_elm_prev (numelm)) + ENDIF + + IF (numhru > 0) THEN + allocate (veloc_hru (numhru)) + allocate (wdsrf_hru (numhru)) + allocate (wdsrf_hru_prev (numhru)) + ENDIF + + IF (numbasin > 0) allocate (wdsrf_bsn (numbasin)) + IF (numbasin > 0) allocate (veloc_riv (numbasin)) + IF (numbasin > 0) allocate (momen_riv (numbasin)) + IF (numbasin > 0) allocate (wdsrf_bsn_prev(numbasin)) + + IF (numbsnhru > 0) allocate (wdsrf_bsnhru (numbsnhru)) + IF (numbsnhru > 0) allocate (veloc_bsnhru (numbsnhru)) + IF (numbsnhru > 0) allocate (momen_bsnhru (numbsnhru)) + IF (numbsnhru > 0) allocate (wdsrf_bsnhru_prev (numbsnhru)) + + ENDIF + + END SUBROUTINE allocate_CatchTimeVariables + + SUBROUTINE READ_CatchTimeVariables (file_restart) + + USE MOD_Mesh + USE MOD_LandHRU + USE MOD_Catch_IO + USE MOD_ElmVector + USE MOD_HRUVector + IMPLICIT NONE + + character(len=*), intent(in) :: file_restart + + CALL vector_read_basin (file_restart, veloc_elm, numelm, 'veloc_riv', elm_data_address) + CALL worker_push_data (iam_elm, iam_bsn, .false., veloc_elm, veloc_riv) + + CALL vector_read_basin (file_restart, wdsrf_elm_prev, numelm, 'wdsrf_bsn_prev', elm_data_address) + CALL worker_push_data (iam_elm, iam_bsn, .false., wdsrf_elm_prev, wdsrf_bsn_prev) + + CALL vector_read_basin (file_restart, veloc_hru, numhru, 'veloc_hru', hru_data_address) + CALL worker_push_subset_data (iam_elm, iam_bsn, elm_hru, basin_hru, veloc_hru, veloc_bsnhru) + + CALL vector_read_basin (file_restart, wdsrf_hru_prev, numhru, 'wdsrf_hru_prev', hru_data_address) + CALL worker_push_subset_data (iam_elm, iam_bsn, elm_hru, basin_hru, wdsrf_hru_prev, wdsrf_bsnhru_prev) + + END SUBROUTINE READ_CatchTimeVariables + + SUBROUTINE WRITE_CatchTimeVariables (file_restart) + + USE MOD_SPMD_Task + USE MOD_NetCDFSerial + USE MOD_Mesh + USE MOD_LandHRU + USE MOD_Catch_IO + USE MOD_ElmVector + USE MOD_HRUVector + IMPLICIT NONE + + integer :: iwork + character(len=*), intent(in) :: file_restart + + IF (p_is_master) THEN + CALL ncio_create_file (trim(file_restart)) + CALL ncio_define_dimension(file_restart, 'basin', totalnumelm) + CALL ncio_define_dimension(file_restart, 'hydrounit', totalnumhru) + + CALL ncio_write_serial (file_restart, 'basin', eindex_glb, 'basin') + CALL ncio_put_attr (file_restart, 'basin', 'long_name', 'basin index') + + CALL ncio_write_serial (file_restart, 'bsn_hru', eindx_hru, 'hydrounit') + CALL ncio_put_attr (file_restart, 'bsn_hru', & + 'long_name', 'basin index of hydrological units') + + CALL ncio_write_serial (file_restart, 'hru_type' , htype_hru, 'hydrounit') + CALL ncio_put_attr (file_restart, 'hru_type' , & + 'long_name', 'index of hydrological units inside basin') + ENDIF + + CALL worker_push_data (iam_bsn, iam_elm, .false., veloc_riv, veloc_elm) + CALL vector_write_basin (& + file_restart, veloc_elm, numelm, totalnumelm, 'veloc_riv', 'basin', elm_data_address) + + CALL worker_push_data (iam_bsn, iam_elm, .false., wdsrf_bsn_prev, wdsrf_elm_prev) + CALL vector_write_basin (& + file_restart, wdsrf_elm_prev, numelm, totalnumelm, 'wdsrf_bsn_prev', 'basin', elm_data_address) + + CALL worker_push_subset_data (iam_bsn, iam_elm, basin_hru, elm_hru, veloc_bsnhru, veloc_hru) + CALL vector_write_basin (& + file_restart, veloc_hru, numhru, totalnumhru, 'veloc_hru', 'hydrounit', hru_data_address) + + CALL worker_push_subset_data (iam_bsn, iam_elm, basin_hru, elm_hru, wdsrf_bsnhru_prev, wdsrf_hru_prev) + CALL vector_write_basin (& + file_restart, wdsrf_hru_prev, numhru, totalnumhru, 'wdsrf_hru_prev', 'hydrounit', hru_data_address) + + END SUBROUTINE WRITE_CatchTimeVariables + + SUBROUTINE deallocate_CatchTimeVariables + + IMPLICIT NONE + + IF (allocated(veloc_elm)) deallocate(veloc_elm) + IF (allocated(veloc_hru)) deallocate(veloc_hru) + IF (allocated(wdsrf_hru)) deallocate(wdsrf_hru) + + IF (allocated(wdsrf_elm_prev)) deallocate(wdsrf_elm_prev) + IF (allocated(wdsrf_hru_prev)) deallocate(wdsrf_hru_prev) + + IF (allocated (wdsrf_bsn )) deallocate (wdsrf_bsn ) + IF (allocated (veloc_riv )) deallocate (veloc_riv ) + IF (allocated (momen_riv )) deallocate (momen_riv ) + IF (allocated (wdsrf_bsn_prev)) deallocate (wdsrf_bsn_prev) + + IF (allocated (wdsrf_bsnhru )) deallocate (wdsrf_bsnhru ) + IF (allocated (veloc_bsnhru )) deallocate (veloc_bsnhru ) + IF (allocated (momen_bsnhru )) deallocate (momen_bsnhru ) + IF (allocated (wdsrf_bsnhru_prev)) deallocate (wdsrf_bsnhru_prev) + + END SUBROUTINE deallocate_CatchTimeVariables + +END MODULE MOD_Catch_Vars_TimeVariables +#endif diff --git a/main/HYDRO/MOD_Hydro_Vars_TimeVariables.F90 b/main/HYDRO/MOD_Hydro_Vars_TimeVariables.F90 deleted file mode 100644 index c7e75446..00000000 --- a/main/HYDRO/MOD_Hydro_Vars_TimeVariables.F90 +++ /dev/null @@ -1,160 +0,0 @@ -#include - -#ifdef CatchLateralFlow -MODULE MOD_Hydro_Vars_TimeVariables -!------------------------------------------------------------------------------------- -! DESCRIPTION: -! -! Time Variables in lateral hydrological processes. -! -! Created by Shupeng Zhang, May 2023 -!------------------------------------------------------------------------------------- - - USE MOD_Precision - IMPLICIT NONE - - ! -- state variables -- - real(r8), allocatable :: wdsrf_bsn (:) ! river or lake water depth [m] - real(r8), allocatable :: veloc_riv (:) ! river velocity [m/s] - real(r8), allocatable :: momen_riv (:) ! unit river momentum [m^2/s] - real(r8), allocatable :: wdsrf_hru (:) ! surface water depth [m] - real(r8), allocatable :: veloc_hru (:) ! surface water velocity [m/s] - real(r8), allocatable :: momen_hru (:) ! unit surface water momentum [m^2/s] - - real(r8), allocatable :: wdsrf_bsn_prev (:) ! river or lake water depth at previous time step [m] - real(r8), allocatable :: wdsrf_hru_prev (:) ! surface water depth at previous time step [m] - - ! PUBLIC MEMBER FUNCTIONS: - PUBLIC :: allocate_HydroTimeVariables - PUBLIC :: deallocate_HydroTimeVariables - - PUBLIC :: read_HydroTimeVariables - PUBLIC :: write_HydroTimeVariables - -CONTAINS - - SUBROUTINE allocate_HydroTimeVariables - - USE MOD_SPMD_Task - USE MOD_Mesh, only : numelm - USE MOD_LandHRU, only : numhru - IMPLICIT NONE - - integer :: numbasin - - numbasin = numelm - - IF (p_is_worker) THEN - IF (numbasin > 0) THEN - allocate (wdsrf_bsn (numbasin)) - allocate (veloc_riv (numbasin)) - allocate (momen_riv (numbasin)) - allocate (wdsrf_bsn_prev (numbasin)) - ENDIF - - IF (numhru > 0) THEN - allocate (wdsrf_hru (numhru)) - allocate (veloc_hru (numhru)) - allocate (momen_hru (numhru)) - allocate (wdsrf_hru_prev (numhru)) - ENDIF - ENDIF - - END SUBROUTINE allocate_HydroTimeVariables - - SUBROUTINE READ_HydroTimeVariables (file_restart) - - USE MOD_Mesh - USE MOD_LandHRU - USE MOD_Hydro_IO - USE MOD_ElmVector - USE MOD_HRUVector - IMPLICIT NONE - - integer :: numbasin - character(len=*), intent(in) :: file_restart - - numbasin = numelm - - CALL vector_read_basin (file_restart, wdsrf_bsn, numbasin, 'wdsrf_bsn', elm_data_address) - CALL vector_read_basin (file_restart, veloc_riv, numbasin, 'veloc_riv', elm_data_address) - CALL vector_read_basin (file_restart, wdsrf_bsn_prev, numbasin, 'wdsrf_bsn_prev', elm_data_address) - - CALL vector_read_basin (file_restart, wdsrf_hru, numhru, 'wdsrf_hru', hru_data_address) - CALL vector_read_basin (file_restart, veloc_hru, numhru, 'veloc_hru', hru_data_address) - CALL vector_read_basin (file_restart, wdsrf_hru_prev, numhru, 'wdsrf_hru_prev', hru_data_address) - - END SUBROUTINE READ_HydroTimeVariables - - SUBROUTINE WRITE_HydroTimeVariables (file_restart) - - USE MOD_SPMD_Task - USE MOD_NetCDFSerial - USE MOD_Mesh - USE MOD_LandHRU - USE MOD_Hydro_IO - USE MOD_ElmVector - USE MOD_HRUVector - IMPLICIT NONE - - integer :: numbasin, iwork - character(len=*), intent(in) :: file_restart - - numbasin = numelm - - IF (p_is_master) THEN - CALL ncio_create_file (trim(file_restart)) - CALL ncio_define_dimension(file_restart, 'basin', totalnumelm) - CALL ncio_define_dimension(file_restart, 'hydrounit', totalnumhru) - - CALL ncio_write_serial (file_restart, 'basin', eindex_glb, 'basin') - CALL ncio_put_attr (file_restart, 'basin', 'long_name', 'basin index') - - CALL ncio_write_serial (file_restart, 'bsn_hru', eindx_hru, 'hydrounit') - CALL ncio_put_attr (file_restart, 'bsn_hru', & - 'long_name', 'basin index of hydrological units') - - CALL ncio_write_serial (file_restart, 'hru_type' , htype_hru, 'hydrounit') - CALL ncio_put_attr (file_restart, 'hru_type' , & - 'long_name', 'index of hydrological units inside basin') - ENDIF - - CALL vector_write_basin (& - file_restart, wdsrf_bsn, numbasin, totalnumelm, 'wdsrf_bsn', 'basin', elm_data_address) - - CALL vector_write_basin (& - file_restart, veloc_riv, numbasin, totalnumelm, 'veloc_riv', 'basin', elm_data_address) - - CALL vector_write_basin (& - file_restart, wdsrf_hru, numhru, totalnumhru, 'wdsrf_hru', 'hydrounit', hru_data_address) - - CALL vector_write_basin (& - file_restart, veloc_hru, numhru, totalnumhru, 'veloc_hru', 'hydrounit', hru_data_address) - - CALL vector_write_basin (& - file_restart, wdsrf_bsn_prev, numbasin, totalnumelm, 'wdsrf_bsn_prev', 'basin', elm_data_address) - - CALL vector_write_basin (& - file_restart, wdsrf_hru_prev, numhru, totalnumhru, 'wdsrf_hru_prev', 'hydrounit', hru_data_address) - - END SUBROUTINE WRITE_HydroTimeVariables - - SUBROUTINE deallocate_HydroTimeVariables - - IMPLICIT NONE - - IF (allocated(wdsrf_bsn)) deallocate(wdsrf_bsn) - IF (allocated(veloc_riv)) deallocate(veloc_riv) - IF (allocated(momen_riv)) deallocate(momen_riv) - - IF (allocated(wdsrf_hru)) deallocate(wdsrf_hru) - IF (allocated(veloc_hru)) deallocate(veloc_hru) - IF (allocated(momen_hru)) deallocate(momen_hru) - - IF (allocated(wdsrf_bsn_prev)) deallocate(wdsrf_bsn_prev) - IF (allocated(wdsrf_hru_prev)) deallocate(wdsrf_hru_prev) - - END SUBROUTINE deallocate_HydroTimeVariables - -END MODULE MOD_Hydro_Vars_TimeVariables -#endif diff --git a/main/MOD_Hist.F90 b/main/MOD_Hist.F90 index 7c2e2e49..409fa13b 100644 --- a/main/MOD_Hist.F90 +++ b/main/MOD_Hist.F90 @@ -27,7 +27,7 @@ MODULE MOD_Hist USE MOD_HistSingle #endif #ifdef CatchLateralFlow - USE MOD_Hydro_Hist + USE MOD_Catch_Hist #endif PUBLIC :: hist_init @@ -453,12 +453,12 @@ SUBROUTINE hist_out (idate, deltim, itstamp, etstamp, ptstamp, & a_zerr, file_hist, 'f_zerr', itime_in_file, sumarea, filter, & 'the error of energy balance','W/m2') +#ifndef CatchLateralFlow ! surface runoff [mm/s] CALL write_history_variable_2d ( DEF_hist_vars%rsur, & a_rsur, file_hist, 'f_rsur', itime_in_file, sumarea, filter, & 'surface runoff','mm/s') -#ifndef CatchLateralFlow ! saturation excess surface runoff [mm/s] CALL write_history_variable_2d ( DEF_hist_vars%rsur_se, & a_rsur_se, file_hist, 'f_rsur_se', itime_in_file, sumarea, filter, & @@ -468,7 +468,6 @@ SUBROUTINE hist_out (idate, deltim, itstamp, etstamp, ptstamp, & CALL write_history_variable_2d ( DEF_hist_vars%rsur_ie, & a_rsur_ie, file_hist, 'f_rsur_ie', itime_in_file, sumarea, filter, & 'infiltration excess surface runoff','mm/s') -#endif ! subsurface runoff [mm/s] CALL write_history_variable_2d ( DEF_hist_vars%rsub, & @@ -479,6 +478,7 @@ SUBROUTINE hist_out (idate, deltim, itstamp, etstamp, ptstamp, & CALL write_history_variable_2d ( DEF_hist_vars%rnof, & a_rnof, file_hist, 'f_rnof', itime_in_file, sumarea, filter, & 'total runoff','mm/s') +#endif #ifdef DataAssimilation ! slope factors for runoff [-] diff --git a/main/MOD_Vars_1DAccFluxes.F90 b/main/MOD_Vars_1DAccFluxes.F90 index e676bcd9..ea5847df 100644 --- a/main/MOD_Vars_1DAccFluxes.F90 +++ b/main/MOD_Vars_1DAccFluxes.F90 @@ -1596,8 +1596,8 @@ SUBROUTINE accumulate_fluxes USE MOD_TurbulenceLEddy USE MOD_Vars_Global #ifdef CatchLateralFlow - USE MOD_Hydro_Vars_1DFluxes - USE MOD_Hydro_Hist, only: accumulate_fluxes_basin + USE MOD_Catch_Vars_1DFluxes + USE MOD_Catch_Hist, only: accumulate_fluxes_basin #endif IMPLICIT NONE diff --git a/main/MOD_Vars_1DFluxes.F90 b/main/MOD_Vars_1DFluxes.F90 index 2e66723a..35e3fd98 100644 --- a/main/MOD_Vars_1DFluxes.F90 +++ b/main/MOD_Vars_1DFluxes.F90 @@ -13,7 +13,7 @@ MODULE MOD_Vars_1DFluxes USE MOD_BGC_Vars_1DFluxes #endif #ifdef CatchLateralFlow - USE MOD_Hydro_Vars_1DFluxes + USE MOD_Catch_Vars_1DFluxes #endif #ifdef URBAN_MODEL USE MOD_Urban_Vars_1DFluxes @@ -168,7 +168,7 @@ SUBROUTINE allocate_1D_Fluxes #endif #ifdef CatchLateralFlow - CALL allocate_1D_HydroFluxes + CALL allocate_1D_CatchFluxes #endif #ifdef URBAN_MODEL @@ -252,7 +252,7 @@ SUBROUTINE deallocate_1D_Fluxes () #endif #ifdef CatchLateralFlow - CALL deallocate_1D_HydroFluxes + CALL deallocate_1D_CatchFluxes #endif #ifdef URBAN_MODEL diff --git a/main/MOD_Vars_TimeInvariants.F90 b/main/MOD_Vars_TimeInvariants.F90 index 2cce81a4..048afda9 100644 --- a/main/MOD_Vars_TimeInvariants.F90 +++ b/main/MOD_Vars_TimeInvariants.F90 @@ -857,6 +857,8 @@ SUBROUTINE check_TimeInvariants () IMPLICIT NONE + real(r8), allocatable :: tmpcheck(:,:) + IF (p_is_master) THEN write(*,'(/,A29)') 'Checking Time Invariants ...' ENDIF @@ -923,9 +925,16 @@ SUBROUTINE check_TimeInvariants () #ifdef SinglePoint CALL check_vector_data ('sf_lut [-] ', sf_lut_patches ) ! shadow mask #else - CALL check_vector_data ('1 sf_curve p [-] ', sf_curve_patches(:,1,:)) ! shadow mask - CALL check_vector_data ('2 sf_curve p [-] ', sf_curve_patches(:,2,:)) ! shadow mask - CALL check_vector_data ('3 sf_curve p [-] ', sf_curve_patches(:,3,:)) ! shadow mask + IF (allocated(sf_curve_patches)) allocate(tmpcheck(size(sf_curve_patches,1),size(sf_curve_patches,3))) + + IF (allocated(sf_curve_patches)) tmpcheck = sf_curve_patches(:,1,:) + CALL check_vector_data ('1 sf_curve p [-] ', tmpcheck) ! shadow mask + IF (allocated(sf_curve_patches)) tmpcheck = sf_curve_patches(:,2,:) + CALL check_vector_data ('2 sf_curve p [-] ', tmpcheck) ! shadow mask + IF (allocated(sf_curve_patches)) tmpcheck = sf_curve_patches(:,3,:) + CALL check_vector_data ('3 sf_curve p [-] ', tmpcheck) ! shadow mask + + IF (allocated(tmpcheck)) deallocate(tmpcheck) #endif ENDIF diff --git a/main/MOD_Vars_TimeVariables.F90 b/main/MOD_Vars_TimeVariables.F90 index 8e3be03e..dbd910eb 100644 --- a/main/MOD_Vars_TimeVariables.F90 +++ b/main/MOD_Vars_TimeVariables.F90 @@ -390,7 +390,7 @@ MODULE MOD_Vars_TimeVariables USE MOD_BGC_Vars_TimeVariables #endif #ifdef CatchLateralFlow - USE MOD_Hydro_Vars_TimeVariables + USE MOD_Catch_Vars_TimeVariables #endif #ifdef URBAN_MODEL USE MOD_Urban_Vars_TimeVariables @@ -686,7 +686,7 @@ SUBROUTINE allocate_TimeVariables #endif #ifdef CatchLateralFlow - CALL allocate_HydroTimeVariables + CALL allocate_CatchTimeVariables #endif #ifdef URBAN_MODEL @@ -844,7 +844,7 @@ SUBROUTINE deallocate_TimeVariables () #endif #ifdef CatchLateralFlow - CALL deallocate_HydroTimeVariables + CALL deallocate_CatchTimeVariables #endif #if (defined URBAN_MODEL) @@ -1069,7 +1069,7 @@ SUBROUTINE WRITE_TimeVariables (idate, lc_year, site, dir_restart) #if (defined CatchLateralFlow) file_restart = trim(dir_restart)// '/'//trim(cdate)//'/' // trim(site) //'_restart_basin_'//trim(cdate)//'_lc'//trim(cyear)//'.nc' - CALL WRITE_HydroTimeVariables (file_restart) + CALL WRITE_CatchTimeVariables (file_restart) #endif #if (defined URBAN_MODEL) @@ -1240,7 +1240,7 @@ SUBROUTINE READ_TimeVariables (idate, lc_year, site, dir_restart) #if (defined CatchLateralFlow) file_restart = trim(dir_restart)// '/'//trim(cdate)//'/' // trim(site) //'_restart_basin_'//trim(cdate)//'_lc'//trim(cyear)//'.nc' - CALL READ_HydroTimeVariables (file_restart) + CALL READ_CatchTimeVariables (file_restart) #endif #if (defined URBAN_MODEL) diff --git a/mkinidata/MOD_Initialize.F90 b/mkinidata/MOD_Initialize.F90 index 5acba746..3c1bb16d 100644 --- a/mkinidata/MOD_Initialize.F90 +++ b/mkinidata/MOD_Initialize.F90 @@ -59,13 +59,9 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & #endif USE MOD_SpatialMapping #ifdef CatchLateralFlow - USE MOD_Mesh USE MOD_LandHRU - USE MOD_LandPatch - USE MOD_ElmVector - USE MOD_HRUVector + USE MOD_Catch_BasinNetwork USE MOD_ElementNeighbour - USE MOD_Catch_HillslopeNetwork USE MOD_Catch_RiverLakeNetwork #endif #ifdef CROP @@ -251,6 +247,11 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & !re-arranged BVIC for USDA soil texture class: real(r8), parameter :: BVIC_USDA(0:12) = (/ 1., 0.300, 0.280, 0.250, 0.230, 0.220, 0.200, 0.180, 0.100, 0.090, 0.150, 0.080, 0.050/) + +#ifdef CatchLateralFlow + CALL build_basin_network () +#endif + ! -------------------------------------------------------------------- ! Allocates memory for CoLM 1d [numpatch] variables ! -------------------------------------------------------------------- @@ -1381,30 +1382,51 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & #ifdef CatchLateralFlow CALL element_neighbour_init (lc_year) - CALL hillslope_network_init () CALL river_lake_network_init () IF (p_is_worker) THEN - IF (numpatch > 0) THEN - wdsrf(:) = 0. - ENDIF + ! set variables "veloc_bsnhru", "wdsrf_bsnhru_prev" + DO i = 1, numbasin + hs = basin_hru%substt(i) + he = basin_hru%subend(i) - DO i = 1, numelm - IF (lake_id(i) > 0) THEN - ps = elm_patch%substt(i) - pe = elm_patch%subend(i) - wdsrf(ps:pe) = lakedepth(ps:pe) * 1.0e3 ! m to mm + wdsrf_bsnhru(hs:he) = 0. + IF (lake_id(i) == 0) THEN + wdsrf_bsnhru(hs) = riverdpth(i) + ELSEIF (lake_id(i) > 0) THEN + wdsrf_bsnhru(hs:he) = lakeinfo(i)%depth0 + ENDIF + + veloc_bsnhru(hs:he) = 0. + wdsrf_bsnhru_prev(hs:he) = wdsrf_bsnhru(hs:he) + ENDDO + + ! set variables "veloc_riv", "wdsrf_bsn_prev" + DO i = 1, numbasin + hs = basin_hru%substt(i) + he = basin_hru%subend(i) + IF (lake_id(i) <= 0) THEN + wdsrf_bsn(i) = minval(hillslope_basin(i)%hand + wdsrf_bsnhru(hs:he)) ELSE - IF (hillslope_network(i)%indx(1) == 0) THEN - hs = basin_hru%substt(i) - ps = hru_patch%substt(hs) - pe = hru_patch%subend(hs) - wdsrf(ps:pe) = riverdpth(i) * 1.0e3 ! m to mm - ENDIF + ! lake + totalvolume = sum(wdsrf_bsnhru(hs:he) * lakeinfo(i)%area0) + wdsrf_bsn(i) = lakeinfo(i)%surface(totalvolume) ENDIF + veloc_riv(i) = 0 + wdsrf_bsn_prev(i) = wdsrf_bsn(i) ENDDO + CALL worker_push_subset_data (iam_bsn, iam_elm, basin_hru, elm_hru, wdsrf_bsnhru, wdsrf_hru) + + ! adjust "wdsrf" according to river and lake water depth + DO i = 1, numhru + ps = hru_patch%substt(i) + pe = hru_patch%subend(i) + wdsrf(ps:pe) = wdsrf_hru(i) * 1.0e3 ! m to mm + ENDDO + + ! adjust lake levels "dz_lake" according to lake depth DO i = 1, numpatch IF (wdsrf(i) > 0.) THEN wdsrfm = wdsrf(i)*1.e-3 @@ -1421,33 +1443,6 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & ENDIF ENDDO - IF (numhru > 0) THEN - DO i = 1, numhru - ps = hru_patch%substt(i) - pe = hru_patch%subend(i) - wdsrf_hru(i) = sum(wdsrf(ps:pe) * hru_patch%subfrc(ps:pe)) - wdsrf_hru(i) = wdsrf_hru(i) / 1.0e3 ! mm to m - ENDDO - veloc_hru(:) = 0 - wdsrf_hru_prev(:) = wdsrf_hru(:) - ENDIF - - IF (numelm > 0) THEN - DO i = 1, numelm - hs = basin_hru%substt(i) - he = basin_hru%subend(i) - IF (lake_id(i) <= 0) THEN - wdsrf_bsn(i) = minval(hillslope_network(i)%hand + wdsrf_hru(hs:he)) - ELSE - ! lake - totalvolume = sum(wdsrf_hru(hs:he) * lakes(i)%area0) - wdsrf_bsn(i) = lakes(i)%surface(totalvolume) - ENDIF - ENDDO - veloc_riv(:) = 0 - wdsrf_bsn_prev(:) = wdsrf_bsn(:) - ENDIF - ENDIF #endif diff --git a/mksrfdata/Aggregation_SoilParameters.F90 b/mksrfdata/Aggregation_SoilParameters.F90 index 3cf1631b..ed5dbbcf 100644 --- a/mksrfdata/Aggregation_SoilParameters.F90 +++ b/mksrfdata/Aggregation_SoilParameters.F90 @@ -306,19 +306,15 @@ SUBROUTINE Aggregation_SoilParameters ( & IF (L /= 0) THEN CALL aggregation_request_data (landpatch, ipatch, gland, zip = USE_zip_for_aggregation, area = area_one, & data_r8_2d_in1 = vf_quartz_mineral_s_grid, data_r8_2d_out1 = vf_quartz_mineral_s_one) - CALL fillnan (vf_quartz_mineral_s_one) + CALL fillnan (vf_quartz_mineral_s_one, L == WATERBODY, vf_quartz_mineral_fill_water(nsl)) vf_quartz_mineral_s_patches (ipatch) = sum (vf_quartz_mineral_s_one * (area_one/sum(area_one))) ELSE vf_quartz_mineral_s_patches (ipatch) = -1.0e36_r8 ENDIF IF (isnan_ud(vf_quartz_mineral_s_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - vf_quartz_mineral_s_patches(ipatch) = vf_quartz_mineral_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in vf_quartz_mineral_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in vf_quartz_mineral_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF ENDDO @@ -388,9 +384,9 @@ SUBROUTINE Aggregation_SoilParameters ( & data_r8_2d_in2 = vf_sand_s_grid, data_r8_2d_out2 = vf_sand_s_one, & data_r8_2d_in3 = vf_om_s_grid, data_r8_2d_out3 = vf_om_s_one) - CALL fillnan (vf_gravels_s_one) - CALL fillnan (vf_sand_s_one ) - CALL fillnan (vf_om_s_one ) + CALL fillnan (vf_gravels_s_one, L == WATERBODY, vf_gravels_fill_water(nsl)) + CALL fillnan (vf_sand_s_one , L == WATERBODY, vf_sand_fill_water(nsl) ) + CALL fillnan (vf_om_s_one , L == WATERBODY, vf_om_fill_water(nsl) ) vf_gravels_s_patches (ipatch) = sum (vf_gravels_s_one * (area_one/sum(area_one))) vf_sand_s_patches (ipatch) = sum (vf_sand_s_one * (area_one/sum(area_one))) @@ -427,48 +423,28 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(vf_gravels_s_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - vf_gravels_s_patches(ipatch) = vf_gravels_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in vf_gravels_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in vf_gravels_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF IF (isnan_ud(vf_sand_s_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - vf_sand_s_patches(ipatch) = vf_sand_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in vf_sand_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in vf_sand_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF IF (isnan_ud(vf_om_s_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - vf_om_s_patches(ipatch) = vf_om_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in vf_om_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in vf_om_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF IF (isnan_ud(BA_alpha_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - BA_alpha_patches(ipatch) = BA_alpha_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in BA_alpha_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in BA_alpha_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF IF (isnan_ud(BA_beta_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - BA_beta_patches(ipatch) = BA_beta_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in BA_beta_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in BA_beta_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF ENDDO @@ -594,19 +570,15 @@ SUBROUTINE Aggregation_SoilParameters ( & IF (L /= 0) THEN CALL aggregation_request_data (landpatch, ipatch, gland, zip = USE_zip_for_aggregation, area = area_one, & data_r8_2d_in1 = wf_gravels_s_grid, data_r8_2d_out1 = wf_gravels_s_one) - CALL fillnan (wf_gravels_s_one) + CALL fillnan (wf_gravels_s_one, L == WATERBODY, wf_gravels_fill_water(nsl)) wf_gravels_s_patches (ipatch) = sum (wf_gravels_s_one * (area_one/sum(area_one))) ELSE wf_gravels_s_patches (ipatch) = -1.0e36_r8 ENDIF IF (isnan_ud(wf_gravels_s_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - wf_gravels_s_patches(ipatch) = wf_gravels_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in wf_gravels_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in wf_gravels_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF ENDDO @@ -661,19 +633,15 @@ SUBROUTINE Aggregation_SoilParameters ( & IF (L /= 0) THEN CALL aggregation_request_data (landpatch, ipatch, gland, zip = USE_zip_for_aggregation, area = area_one, & data_r8_2d_in1 = wf_sand_s_grid, data_r8_2d_out1 = wf_sand_s_one) - CALL fillnan (wf_sand_s_one) + CALL fillnan (wf_sand_s_one, L == WATERBODY, wf_sand_fill_water(nsl)) wf_sand_s_patches (ipatch) = sum (wf_sand_s_one * (area_one/sum(area_one))) ELSE wf_sand_s_patches (ipatch) = -1.0e36_r8 ENDIF IF (isnan_ud(wf_sand_s_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - wf_sand_s_patches(ipatch) = wf_sand_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in wf_sand_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in wf_sand_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF ENDDO @@ -765,12 +733,14 @@ SUBROUTINE Aggregation_SoilParameters ( & data_r8_2d_in4 = theta_s_grid, data_r8_2d_out4 = theta_s_one, & data_r8_2d_in5 = k_s_grid, data_r8_2d_out5 = k_s_one, & data_r8_2d_in6 = L_vgm_grid, data_r8_2d_out6 = L_vgm_one ) - CALL fillnan (theta_r_one ) - CALL fillnan (alpha_vgm_one) - CALL fillnan (n_vgm_one ) - CALL fillnan (theta_s_one ) - CALL fillnan (k_s_one ) - CALL fillnan (L_vgm_one ) + + CALL fillnan (theta_r_one , L == WATERBODY, theta_r_fill_water(nsl) ) + CALL fillnan (alpha_vgm_one, L == WATERBODY, alpha_vgm_fill_water(nsl)) + CALL fillnan (n_vgm_one , L == WATERBODY, n_vgm_fill_water(nsl) ) + CALL fillnan (theta_s_one , L == WATERBODY, theta_s_fill_water(nsl) ) + CALL fillnan (k_s_one , L == WATERBODY, k_s_fill_water(nsl) ) + CALL fillnan (L_vgm_one , L == WATERBODY, L_vgm_fill_water(nsl) ) + theta_r_patches (ipatch) = sum (theta_r_one * (area_one/sum(area_one))) alpha_vgm_patches (ipatch) = median (alpha_vgm_one, size(alpha_vgm_one), spval) n_vgm_patches (ipatch) = median (n_vgm_one, size(n_vgm_one), spval) @@ -839,57 +809,33 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(theta_r_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - theta_r_patches(ipatch) = theta_r_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in theta_r_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in theta_r_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF IF (isnan_ud(alpha_vgm_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - alpha_vgm_patches(ipatch) = alpha_vgm_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in alpha_vgm_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in alpha_vgm_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF IF (isnan_ud(n_vgm_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - n_vgm_patches(ipatch) = n_vgm_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in n_vgm_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in n_vgm_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF IF (isnan_ud(theta_s_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - theta_s_patches(ipatch) = theta_s_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in theta_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in theta_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF IF (isnan_ud(k_s_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - k_s_patches(ipatch) = k_s_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in k_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in k_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF IF (isnan_ud(L_vgm_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - L_vgm_patches(ipatch) = L_vgm_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in L_vgm_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in L_vgm_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF ENDDO @@ -1056,10 +1002,12 @@ SUBROUTINE Aggregation_SoilParameters ( & data_r8_2d_in2 = k_s_grid, data_r8_2d_out2 = k_s_one, & data_r8_2d_in3 = psi_s_grid, data_r8_2d_out3 = psi_s_one, & data_r8_2d_in4 = lambda_grid, data_r8_2d_out4 = lambda_one) - CALL fillnan (theta_s_one) - CALL fillnan (k_s_one ) - CALL fillnan (psi_s_one ) - CALL fillnan (lambda_one ) + + CALL fillnan (theta_s_one, L == WATERBODY, theta_s_fill_water(nsl)) + CALL fillnan (k_s_one , L == WATERBODY, k_s_fill_water(nsl) ) + CALL fillnan (psi_s_one , L == WATERBODY, psi_s_fill_water(nsl) ) + CALL fillnan (lambda_one , L == WATERBODY, lambda_fill_water(nsl) ) + theta_s_patches (ipatch) = sum (theta_s_one * (area_one/sum(area_one))) k_s_patches (ipatch) = product(k_s_one**(area_one/sum(area_one))) psi_s_patches (ipatch) = median (psi_s_one, size(psi_s_one), spval) @@ -1117,39 +1065,23 @@ SUBROUTINE Aggregation_SoilParameters ( & ENDIF IF (isnan_ud(theta_s_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - theta_s_patches(ipatch) = theta_s_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in theta_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in theta_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF IF (isnan_ud(k_s_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - k_s_patches(ipatch) = k_s_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in k_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in k_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF IF (isnan_ud(psi_s_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - psi_s_patches(ipatch) = psi_s_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in psi_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in psi_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF IF (isnan_ud(lambda_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - lambda_patches(ipatch) = lambda_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in lambda_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in lambda_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF ENDDO @@ -1258,19 +1190,15 @@ SUBROUTINE Aggregation_SoilParameters ( & IF (L /= 0) THEN CALL aggregation_request_data (landpatch, ipatch, gland, zip = USE_zip_for_aggregation, area = area_one, & data_r8_2d_in1 = csol_grid, data_r8_2d_out1 = csol_one) - CALL fillnan (csol_one) + CALL fillnan (csol_one, L == WATERBODY, csol_fill_water(nsl)) csol_patches (ipatch) = sum(csol_one*(area_one/sum(area_one))) ELSE csol_patches (ipatch) = -1.0e36_r8 ENDIF IF (isnan_ud(csol_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - csol_patches(ipatch) = csol_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in csol_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in csol_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF ENDDO @@ -1323,19 +1251,15 @@ SUBROUTINE Aggregation_SoilParameters ( & IF (L /= 0) THEN CALL aggregation_request_data (landpatch, ipatch, gland, zip = USE_zip_for_aggregation, area = area_one, & data_r8_2d_in1 = tksatu_grid, data_r8_2d_out1 = tksatu_one) - CALL fillnan (tksatu_one) + CALL fillnan (tksatu_one, L == WATERBODY, tksatu_fill_water(nsl)) tksatu_patches (ipatch) = product(tksatu_one**(area_one/sum(area_one))) ELSE tksatu_patches (ipatch) = -1.0e36_r8 ENDIF IF (isnan_ud(tksatu_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - tksatu_patches(ipatch) = tksatu_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in tksatu_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in tksatu_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF ENDDO @@ -1388,19 +1312,15 @@ SUBROUTINE Aggregation_SoilParameters ( & IF (L /= 0) THEN CALL aggregation_request_data (landpatch, ipatch, gland, zip = USE_zip_for_aggregation, area = area_one, & data_r8_2d_in1 = tksatf_grid, data_r8_2d_out1 = tksatf_one) - CALL fillnan (tksatf_one) + CALL fillnan (tksatf_one, L == WATERBODY, tksatf_fill_water(nsl)) tksatf_patches (ipatch) = product(tksatf_one**(area_one/sum(area_one))) ELSE tksatf_patches (ipatch) = -1.0e36_r8 ENDIF IF (isnan_ud(tksatf_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - tksatf_patches(ipatch) = tksatf_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in tksatf_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in tksatf_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF ENDDO @@ -1453,19 +1373,15 @@ SUBROUTINE Aggregation_SoilParameters ( & IF (L /= 0) THEN CALL aggregation_request_data (landpatch, ipatch, gland, zip = USE_zip_for_aggregation, area = area_one, & data_r8_2d_in1 = tkdry_grid, data_r8_2d_out1 = tkdry_one) - CALL fillnan (tkdry_one) + CALL fillnan (tkdry_one, L == WATERBODY, tkdry_fill_water(nsl)) tkdry_patches (ipatch) = product(tkdry_one**(area_one/sum(area_one))) ELSE tkdry_patches (ipatch) = -1.0e36_r8 ENDIF IF (isnan_ud(tkdry_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - tkdry_patches(ipatch) = tkdry_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in tkdry_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in tkdry_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF ENDDO @@ -1518,19 +1434,15 @@ SUBROUTINE Aggregation_SoilParameters ( & IF (L /= 0) THEN CALL aggregation_request_data (landpatch, ipatch, gland, zip = USE_zip_for_aggregation, area = area_one, & data_r8_2d_in1 = k_solids_grid, data_r8_2d_out1 = k_solids_one) - CALL fillnan (k_solids_one) + CALL fillnan (k_solids_one, L == WATERBODY, k_solids_fill_water(nsl)) k_solids_patches (ipatch) = product(k_solids_one**(area_one/sum(area_one))) ELSE k_solids_patches (ipatch) = -1.0e36_r8 ENDIF IF (isnan_ud(k_solids_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - k_solids_patches(ipatch) = k_solids_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in k_solids_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in k_solids_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF ENDDO @@ -1584,19 +1496,15 @@ SUBROUTINE Aggregation_SoilParameters ( & IF (L /= 0) THEN CALL aggregation_request_data (landpatch, ipatch, gland, zip = USE_zip_for_aggregation, area = area_one, & data_r8_2d_in1 = OM_density_s_grid, data_r8_2d_out1 = OM_density_s_one) - CALL fillnan (OM_density_s_one) + CALL fillnan (OM_density_s_one, L == WATERBODY, OM_density_fill_water(nsl)) OM_density_s_patches (ipatch) = sum (OM_density_s_one * (area_one/sum(area_one))) ELSE OM_density_s_patches (ipatch) = -1.0e36_r8 ENDIF IF (isnan_ud(OM_density_s_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - OM_density_s_patches(ipatch) = OM_density_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in OM_density_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in OM_density_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF ENDDO @@ -1650,19 +1558,15 @@ SUBROUTINE Aggregation_SoilParameters ( & IF (L /= 0) THEN CALL aggregation_request_data (landpatch, ipatch, gland, zip = USE_zip_for_aggregation, area = area_one, & data_r8_2d_in1 = BD_all_s_grid, data_r8_2d_out1 = BD_all_s_one) - CALL fillnan (BD_all_s_one) + CALL fillnan (BD_all_s_one, L == WATERBODY, BD_all_fill_water(nsl)) BD_all_s_patches (ipatch) = sum (BD_all_s_one * (area_one/sum(area_one))) ELSE BD_all_s_patches (ipatch) = -1.0e36_r8 ENDIF IF (isnan_ud(BD_all_s_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - BD_all_s_patches(ipatch) = BD_all_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in BD_all_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in BD_all_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF ENDDO @@ -1851,6 +1755,11 @@ SUBROUTINE SW_VG_dist ( m, n, x, fvec, fjac, ldfjac, iflag, xdat, npoint, ydatv, RETURN ENDIF + IF (log10(1+x(2)*maxval(xdat))+x(3) > 300.) THEN + isiter = 0 + RETURN + ENDIF + DO i = 1, m fvec(i) = sum(((x(1) + (phi - x(1))*(1+(x(2)*xdat(i))**x(3))**(1.0/x(3)-1) - ydatv(:,i))/phi)**2) & + sum(((log10(x(4)) + (1.0/x(3)-1)*L_vgm*log10(1+(x(2)*xdat(i))**x(3)) + & diff --git a/mksrfdata/MOD_AggregationRequestData.F90 b/mksrfdata/MOD_AggregationRequestData.F90 index 030de100..66a51002 100644 --- a/mksrfdata/MOD_AggregationRequestData.F90 +++ b/mksrfdata/MOD_AggregationRequestData.F90 @@ -662,13 +662,15 @@ END SUBROUTINE aggregation_worker_done #endif - SUBROUTINE fillnan (vec) + SUBROUTINE fillnan (vec, fill, defval) USE MOD_Precision USE MOD_UserDefFun, only : isnan_ud IMPLICIT NONE real(r8), intent(inout) :: vec(:) + logical, intent(in) :: fill + real(r8), intent(in) :: defval ! local variables integer :: i, n @@ -690,6 +692,10 @@ SUBROUTINE fillnan (vec) ENDDO ENDIF + IF ((n == 0) .and. fill) THEN + vec(:) = defval + ENDIF + END SUBROUTINE fillnan END MODULE MOD_AggregationRequestData diff --git a/mksrfdata/MOD_HRUVector.F90 b/mksrfdata/MOD_HRUVector.F90 index 2f0fb675..a94a73b7 100644 --- a/mksrfdata/MOD_HRUVector.F90 +++ b/mksrfdata/MOD_HRUVector.F90 @@ -56,13 +56,13 @@ SUBROUTINE hru_vector_init IF (p_is_worker) THEN - CALL basin_hru%build (landelm, landhru, use_frac = .true.) + CALL elm_hru%build (landelm, landhru, use_frac = .true.) CALL hru_patch%build (landhru, landpatch, use_frac = .true.) IF (numelm > 0) THEN allocate (nhru_bsn (numelm)) - nhru_bsn = basin_hru%subend - basin_hru%substt + 1 + nhru_bsn = elm_hru%subend - elm_hru%substt + 1 ENDIF #ifdef USEMPI diff --git a/mksrfdata/MOD_LandHRU.F90 b/mksrfdata/MOD_LandHRU.F90 index 91fe4d5f..7ada836c 100644 --- a/mksrfdata/MOD_LandHRU.F90 +++ b/mksrfdata/MOD_LandHRU.F90 @@ -32,7 +32,7 @@ MODULE MOD_LandHRU type(grid_type) :: ghru type(pixelset_type) :: landhru - type(subset_type) :: basin_hru + type(subset_type) :: elm_hru CONTAINS diff --git a/share/MOD_RangeCheck.F90 b/share/MOD_RangeCheck.F90 index c29c4358..59eab042 100644 --- a/share/MOD_RangeCheck.F90 +++ b/share/MOD_RangeCheck.F90 @@ -168,8 +168,9 @@ SUBROUTINE check_vector_data_real8_1d (varname, vdata, spv_in, limits) USE MOD_Vars_Global, only : spval IMPLICIT NONE - character(len=*), intent(in) :: varname - real(r8), intent(in) :: vdata(:) + character(len=*), intent(in) :: varname + real(r8), allocatable, intent(in) :: vdata(:) + real(r8), intent(in), optional :: spv_in real(r8), intent(in), optional :: limits(2) @@ -188,19 +189,24 @@ SUBROUTINE check_vector_data_real8_1d (varname, vdata, spv_in, limits) spv = spval ENDIF - IF (any(vdata /= spv)) THEN - vmin = minval(vdata, mask = vdata /= spv) - vmax = maxval(vdata, mask = vdata /= spv) + IF (allocated(vdata)) THEN + IF (any(vdata /= spv)) THEN + vmin = minval(vdata, mask = vdata /= spv) + vmax = maxval(vdata, mask = vdata /= spv) + ELSE + vmin = spv + vmax = spv + ENDIF + + has_nan = .false. + DO i = lbound(vdata,1), ubound(vdata,1) + has_nan = has_nan .or. isnan_ud(vdata(i)) + ENDDO ELSE - vmin = spv - vmax = spv + vmin = spv; vmax = spv + has_nan = .false. ENDIF - has_nan = .false. - DO i = 1, size(vdata) - has_nan = has_nan .or. isnan_ud(vdata(i)) - ENDDO - #ifdef USEMPI IF (p_iam_worker == p_root) THEN allocate (vmin_all (0:p_np_worker-1)) @@ -269,8 +275,9 @@ SUBROUTINE check_vector_data_real8_2d (varname, vdata, spv_in, limits) USE MOD_Vars_Global, only : spval IMPLICIT NONE - character(len=*), intent(in) :: varname - real(r8), intent(in) :: vdata(:,:) + character(len=*), intent(in) :: varname + real(r8), allocatable, intent(in) :: vdata(:,:) + real(r8), intent(in), optional :: spv_in real(r8), intent(in), optional :: limits(2) @@ -289,20 +296,25 @@ SUBROUTINE check_vector_data_real8_2d (varname, vdata, spv_in, limits) spv = spval ENDIF - IF (any(vdata /= spv)) THEN - vmin = minval(vdata, mask = vdata /= spv) - vmax = maxval(vdata, mask = vdata /= spv) - ELSE - vmin = spv - vmax = spv - ENDIF + IF (allocated(vdata)) THEN + IF (any(vdata /= spv)) THEN + vmin = minval(vdata, mask = vdata /= spv) + vmax = maxval(vdata, mask = vdata /= spv) + ELSE + vmin = spv + vmax = spv + ENDIF - has_nan = .false. - DO j = 1, size(vdata,2) - DO i = 1, size(vdata,1) - has_nan = has_nan .or. isnan_ud(vdata(i,j)) + has_nan = .false. + DO j = lbound(vdata,2), ubound(vdata,2) + DO i = lbound(vdata,1), ubound(vdata,1) + has_nan = has_nan .or. isnan_ud(vdata(i,j)) + ENDDO ENDDO - ENDDO + ELSE + vmin = spv; vmax = spv + has_nan = .false. + ENDIF #ifdef USEMPI IF (p_iam_worker == p_root) THEN @@ -372,8 +384,9 @@ SUBROUTINE check_vector_data_real8_3d (varname, vdata, spv_in, limits) USE MOD_Vars_Global, only : spval IMPLICIT NONE - character(len=*), intent(in) :: varname - real(r8), intent(in) :: vdata(:,:,:) + character(len=*), intent(in) :: varname + real(r8), allocatable, intent(in) :: vdata(:,:,:) + real(r8), intent(in), optional :: spv_in real(r8), intent(in), optional :: limits(2) @@ -392,22 +405,27 @@ SUBROUTINE check_vector_data_real8_3d (varname, vdata, spv_in, limits) spv = spval ENDIF - IF (any(vdata /= spv)) THEN - vmin = minval(vdata, mask = vdata /= spv) - vmax = maxval(vdata, mask = vdata /= spv) - ELSE - vmin = spv - vmax = spv - ENDIF + IF (allocated(vdata)) THEN + IF (any(vdata /= spv)) THEN + vmin = minval(vdata, mask = vdata /= spv) + vmax = maxval(vdata, mask = vdata /= spv) + ELSE + vmin = spv + vmax = spv + ENDIF - has_nan = .false. - DO k = 1, size(vdata,3) - DO j = 1, size(vdata,2) - DO i = 1, size(vdata,1) - has_nan = has_nan .or. isnan_ud(vdata(i,j,k)) + has_nan = .false. + DO k = lbound(vdata,3), ubound(vdata,3) + DO j = lbound(vdata,2), ubound(vdata,2) + DO i = lbound(vdata,1), ubound(vdata,1) + has_nan = has_nan .or. isnan_ud(vdata(i,j,k)) + ENDDO ENDDO ENDDO - ENDDO + ELSE + vmin = spv; vmax = spv + has_nan = .false. + ENDIF #ifdef USEMPI IF (p_iam_worker == p_root) THEN @@ -478,8 +496,9 @@ SUBROUTINE check_vector_data_real8_4d (varname, vdata, spv_in, limits) USE MOD_Vars_Global, only : spval IMPLICIT NONE - character(len=*), intent(in) :: varname - real(r8), intent(in) :: vdata(:,:,:,:) + character(len=*), intent(in) :: varname + real(r8), allocatable, intent(in) :: vdata(:,:,:,:) + real(r8), intent(in), optional :: spv_in real(r8), intent(in), optional :: limits(2) @@ -498,24 +517,29 @@ SUBROUTINE check_vector_data_real8_4d (varname, vdata, spv_in, limits) spv = spval ENDIF - IF (any(vdata /= spv)) THEN - vmin = minval(vdata, mask = vdata /= spv) - vmax = maxval(vdata, mask = vdata /= spv) - ELSE - vmin = spv - vmax = spv - ENDIF + IF (allocated(vdata)) THEN + IF (any(vdata /= spv)) THEN + vmin = minval(vdata, mask = vdata /= spv) + vmax = maxval(vdata, mask = vdata /= spv) + ELSE + vmin = spv + vmax = spv + ENDIF - has_nan = .false. - DO l = 1, size(vdata,4) - DO k = 1, size(vdata,3) - DO j = 1, size(vdata,2) - DO i = 1, size(vdata,1) - has_nan = has_nan .or. isnan_ud(vdata(i,j,k,l)) + has_nan = .false. + DO l = lbound(vdata,4), ubound(vdata,4) + DO k = lbound(vdata,3), ubound(vdata,3) + DO j = lbound(vdata,2), ubound(vdata,2) + DO i = lbound(vdata,1), ubound(vdata,1) + has_nan = has_nan .or. isnan_ud(vdata(i,j,k,l)) + ENDDO ENDDO ENDDO ENDDO - ENDDO + ELSE + vmin = spv; vmax = spv + has_nan = .false. + ENDIF #ifdef USEMPI IF (p_iam_worker == p_root) THEN @@ -585,59 +609,60 @@ SUBROUTINE check_vector_data_int32_1d (varname, vdata, spv_in) USE MOD_SPMD_Task IMPLICIT NONE - character(len=*), intent(in) :: varname - integer, intent(in) :: vdata(:) + character(len=*), intent(in) :: varname + integer, allocatable, intent(in) :: vdata(:) + integer, intent(in), optional :: spv_in ! Local variables integer :: vmin, vmax + logical :: isnull + logical, allocatable :: null_all(:) integer, allocatable :: vmin_all(:), vmax_all(:) character(len=256) :: wfmt IF (p_is_worker) THEN - IF (present(spv_in)) THEN - IF (any(vdata /= spv_in)) THEN - vmin = minval(vdata, mask = vdata /= spv_in) - vmax = maxval(vdata, mask = vdata /= spv_in) + isnull = .not. allocated(vdata) + + IF (.not. isnull) THEN + IF (present(spv_in)) THEN + IF (any(vdata /= spv_in)) THEN + vmin = minval(vdata, mask = vdata /= spv_in) + vmax = maxval(vdata, mask = vdata /= spv_in) + ELSE + vmin = spv_in + vmax = spv_in + ENDIF ELSE - vmin = spv_in - vmax = spv_in + vmin = minval(vdata) + vmax = maxval(vdata) ENDIF - ELSE - vmin = minval(vdata) - vmax = maxval(vdata) ENDIF #ifdef USEMPI IF (p_iam_worker == p_root) THEN + allocate (null_all (0:p_np_worker-1)) allocate (vmin_all (0:p_np_worker-1)) allocate (vmax_all (0:p_np_worker-1)) - CALL mpi_gather (vmin, 1, MPI_INTEGER, vmin_all, 1, MPI_INTEGER, p_root, p_comm_worker, p_err) - CALL mpi_gather (vmax, 1, MPI_INTEGER, vmax_all, 1, MPI_INTEGER, p_root, p_comm_worker, p_err) + CALL mpi_gather (isnull, 1, MPI_LOGICAL, null_all, 1, MPI_LOGICAL, p_root, p_comm_worker, p_err) + CALL mpi_gather (vmin, 1, MPI_INTEGER, vmin_all, 1, MPI_INTEGER, p_root, p_comm_worker, p_err) + CALL mpi_gather (vmax, 1, MPI_INTEGER, vmax_all, 1, MPI_INTEGER, p_root, p_comm_worker, p_err) ELSE - CALL mpi_gather (vmin, 1, MPI_INTEGER, MPI_INULL_P, 1, MPI_INTEGER, p_root, p_comm_worker, p_err) - CALL mpi_gather (vmax, 1, MPI_INTEGER, MPI_INULL_P, 1, MPI_INTEGER, p_root, p_comm_worker, p_err) + CALL mpi_gather (isnull, 1, MPI_LOGICAL, MPI_LNULL_P, 1, MPI_LOGICAL, p_root, p_comm_worker, p_err) + CALL mpi_gather (vmin, 1, MPI_INTEGER, MPI_INULL_P, 1, MPI_INTEGER, p_root, p_comm_worker, p_err) + CALL mpi_gather (vmax, 1, MPI_INTEGER, MPI_INULL_P, 1, MPI_INTEGER, p_root, p_comm_worker, p_err) ENDIF IF (p_iam_worker == p_root) THEN IF (present(spv_in)) THEN - IF (any(vmin_all /= spv_in)) THEN - vmin = minval(vmin_all, mask = (vmin_all /= spv_in)) - ELSE - vmin = spv_in - ENDIF - - IF (any(vmax_all /= spv_in)) THEN - vmax = maxval(vmax_all, mask = (vmax_all /= spv_in)) - ELSE - vmax = spv_in - ENDIF - ELSE - vmin = minval(vmin_all) - vmax = maxval(vmax_all) + null_all = null_all .and. (vmin_all == spv_in) ENDIF + vmin = minval(vmin_all, mask = .not. null_all) + vmax = maxval(vmax_all, mask = .not. null_all) + + deallocate (null_all) deallocate (vmin_all) deallocate (vmax_all) ENDIF diff --git a/share/MOD_SPMD_Task.F90 b/share/MOD_SPMD_Task.F90 index bccebac0..b6b2ad15 100644 --- a/share/MOD_SPMD_Task.F90 +++ b/share/MOD_SPMD_Task.F90 @@ -103,6 +103,7 @@ MODULE MOD_SPMD_Task integer, PUBLIC, parameter :: mpi_tag_data = 3 integer :: MPI_INULL_P(1) + logical :: MPI_LNULL_P(1) real(r8) :: MPI_RNULL_P(1) integer, parameter :: MesgMaxSize = 4194304 ! 4MB From 2ecf4c578ff5b3e8923a8eedc1acc485fcabac0c Mon Sep 17 00:00:00 2001 From: weinan123 Date: Sun, 9 Feb 2025 20:26:34 +0800 Subject: [PATCH 31/43] fix a bug in Fitting algorithm --- mksrfdata/Aggregation_SoilParameters.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mksrfdata/Aggregation_SoilParameters.F90 b/mksrfdata/Aggregation_SoilParameters.F90 index be4e950a..885fd9b0 100644 --- a/mksrfdata/Aggregation_SoilParameters.F90 +++ b/mksrfdata/Aggregation_SoilParameters.F90 @@ -1919,7 +1919,7 @@ SUBROUTINE SW_VG_dist ( m, n, x, fvec, fjac, ldfjac, iflag, xdat, npoint, ydatv, ELSEIF ( iflag == 1 ) THEN - IF (x(2) <= 0.0 .or. x(3) <= 0.1 .or. x(3) >= 1000. .or. x(4) <= 0.0) THEN + IF (x(2) <= 0.0 .or. x(3) <= 0.1 .or. x(3) >= 100. .or. x(4) <= 0.0) THEN isiter = 0 RETURN ENDIF @@ -1932,7 +1932,7 @@ SUBROUTINE SW_VG_dist ( m, n, x, fvec, fjac, ldfjac, iflag, xdat, npoint, ydatv, ELSEIF ( iflag == 2 ) THEN - IF (x(2) <= 0.0 .or. x(3) <= 0.1 .or. x(3) >= 1000. .or. x(4) <= 0.0) THEN + IF (x(2) <= 0.0 .or. x(3) <= 0.1 .or. x(3) >= 100. .or. x(4) <= 0.0) THEN isiter = 0 RETURN ENDIF From affd0cbaf0d2aaa33b100266922cd84011a284c4 Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Sun, 9 Feb 2025 20:33:15 +0800 Subject: [PATCH 32/43] restore constraints in Aggregation_SoilParameters --- mksrfdata/Aggregation_SoilParameters.F90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/mksrfdata/Aggregation_SoilParameters.F90 b/mksrfdata/Aggregation_SoilParameters.F90 index ed5dbbcf..7dc21800 100644 --- a/mksrfdata/Aggregation_SoilParameters.F90 +++ b/mksrfdata/Aggregation_SoilParameters.F90 @@ -1755,11 +1755,6 @@ SUBROUTINE SW_VG_dist ( m, n, x, fvec, fjac, ldfjac, iflag, xdat, npoint, ydatv, RETURN ENDIF - IF (log10(1+x(2)*maxval(xdat))+x(3) > 300.) THEN - isiter = 0 - RETURN - ENDIF - DO i = 1, m fvec(i) = sum(((x(1) + (phi - x(1))*(1+(x(2)*xdat(i))**x(3))**(1.0/x(3)-1) - ydatv(:,i))/phi)**2) & + sum(((log10(x(4)) + (1.0/x(3)-1)*L_vgm*log10(1+(x(2)*xdat(i))**x(3)) + & From 09f3365e3d2b9658aff80a4fed4f0f1942781a46 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Mon, 10 Feb 2025 21:38:16 +0800 Subject: [PATCH 33/43] Revised leaf snow properties. -mod(MOD_3DCanopyRadiation.F90,MOD_Albedo.F90): single scattering albedo of vis from 0.6 to 0.8. --- main/MOD_3DCanopyRadiation.F90 | 2 +- main/MOD_Albedo.F90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/main/MOD_3DCanopyRadiation.F90 b/main/MOD_3DCanopyRadiation.F90 index 91538647..e604e1dd 100644 --- a/main/MOD_3DCanopyRadiation.F90 +++ b/main/MOD_3DCanopyRadiation.F90 @@ -100,7 +100,7 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) ! vegetation snow optical properties, 1:vis, 2:nir real(r8) :: rho_sno(2), tau_sno(2) - data rho_sno(1), rho_sno(2) /0.3, 0.2/ + data rho_sno(1), rho_sno(2) /0.5, 0.2/ data tau_sno(1), tau_sno(2) /0.3, 0.2/ ! get patch PFT index diff --git a/main/MOD_Albedo.F90 b/main/MOD_Albedo.F90 index db701c85..f8fd1316 100644 --- a/main/MOD_Albedo.F90 +++ b/main/MOD_Albedo.F90 @@ -569,7 +569,7 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, fwet_snow, & real(r8) :: upscat_sno = 0.5 !upscat parameter for snow real(r8) :: beta0_sno = 0.5 !beta0 parameter for snow real(r8) :: scat_sno(2) !snow single scattering albedo - data scat_sno(1), scat_sno(2) /0.6, 0.4/ ! 1:vis, 2: nir + data scat_sno(1), scat_sno(2) /0.8, 0.4/ ! 1:vis, 2: nir integer iw ! band iterator @@ -902,7 +902,7 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, fwet_snow, & real(r8) :: upscat_sno = 0.5 !upscat parameter for snow real(r8) :: beta0_sno = 0.5 !beta0 parameter for snow real(r8) :: scat_sno(2) !snow single scattering albedo - data scat_sno(1), scat_sno(2) /0.6, 0.4/ ! 1:vis, 2: nir + data scat_sno(1), scat_sno(2) /0.8, 0.4/ ! 1:vis, 2: nir integer iw ! band loop index integer ic ! direct/diffuse loop index From c1c4e0dd326c79724cd566162f9296ab960a4b3f Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Tue, 11 Feb 2025 10:17:00 +0800 Subject: [PATCH 34/43] modification to basin network. --- main/HYDRO/MOD_Catch_BasinNetwork.F90 | 44 +++++++++------------------ 1 file changed, 14 insertions(+), 30 deletions(-) diff --git a/main/HYDRO/MOD_Catch_BasinNetwork.F90 b/main/HYDRO/MOD_Catch_BasinNetwork.F90 index f16abd96..2a97d386 100644 --- a/main/HYDRO/MOD_Catch_BasinNetwork.F90 +++ b/main/HYDRO/MOD_Catch_BasinNetwork.F90 @@ -58,13 +58,14 @@ SUBROUTINE build_basin_network () ! Local Variables character(len=256) :: basin_file - integer, allocatable :: basindown(:), lakeid(:), nhru_all(:), nhru_in_bsn(:) + integer, allocatable :: basindown(:), nhru_all(:), nhru_in_bsn(:) integer :: totalnumbasin, ibasin, nbasin - integer :: iworker, mesg(2), isrc, nrecv, idata, ndatall, ip, iloc, ielm, i, j, ithis, nave + integer :: iworker, mesg(2), isrc, nrecv, idata, ndatall + integer :: ip, iloc, ielm, i, j, ithis, nave, nups - integer, allocatable :: eindex (:), bindex (:), addrelm (:), addrbasin(:) - integer, allocatable :: nups_nst(:), iups_nst(:), nups_all(:), b_up2down(:), orderbsn(:) + integer, allocatable :: eindex (:), bindex (:), addrelm (:), addrbasin(:), orderbsn(:) + integer, allocatable :: nups_nst(:), iups_nst(:), nups_all(:), b_up2down(:) integer, allocatable :: nelm_wrk(:), paddr (:), icache (:) integer, allocatable :: basin_sorted(:), element_sorted(:) @@ -79,7 +80,6 @@ SUBROUTINE build_basin_network () ! step 1: read in parameters from file. IF (p_is_master) THEN CALL ncio_read_serial (basin_file, 'basin_downstream', basindown) - CALL ncio_read_serial (basin_file, 'lake_id', lakeid) CALL ncio_read_serial (basin_file, 'basin_numhru', nhru_all ) totalnumbasin = size(basindown) ENDIF @@ -169,11 +169,7 @@ SUBROUTINE build_basin_network () deallocate (nups_nst) deallocate (iups_nst) - allocate (nups_all (totalnumbasin)); - nups_all(:) = 1 - ! WHERE (lakeid == -1) - ! nups_all(:) = 0 - ! ENDWHERE + allocate (nups_all (totalnumbasin)); nups_all(:) = 1 DO i = 1, totalnumbasin j = basindown(b_up2down(i)) @@ -194,8 +190,9 @@ SUBROUTINE build_basin_network () allocate (addrbasin (totalnumbasin)) addrbasin(:) = -1 - - ithis = totalnumbasin + + ithis = totalnumbasin + iworker = p_np_worker-1 DO WHILE (ithis > 0) i = b_up2down(ithis) @@ -214,20 +211,15 @@ SUBROUTINE build_basin_network () ENDIF ENDIF - ! IF (lakeid(i) == -1) THEN - ! ithis = ithis - 1 - ! CYCLE - ! ENDIF - - IF (nups_all(i) <= nave) THEN - iworker = p_itis_worker(addrelm(i)) - IF (nelm_wrk(iworker) >= nave) THEN - iworker = minloc(nelm_wrk,1) - 1 - ENDIF + IF (nups_all(i) <= nave-nelm_wrk(iworker)) THEN addrbasin(i) = p_address_worker(iworker) nelm_wrk(iworker) = nelm_wrk(iworker) + nups_all(i) + IF (nelm_wrk(iworker) == nave) THEN + iworker = iworker - 1 + ENDIF + j = basindown(i) DO WHILE (j > 0) nups_all(j) = nups_all(j) - nups_all(i) @@ -239,13 +231,6 @@ SUBROUTINE build_basin_network () ENDIF ENDDO - DO i = totalnumbasin, 1, -1 - j = b_up2down(i) - IF ((addrbasin(j) == -1) .and. (lakeid(j) == -1)) THEN - addrbasin(j) = addrbasin(basindown(j)) - ENDIF - ENDDO - deallocate (b_up2down) deallocate (nups_all ) deallocate (orderbsn ) @@ -596,7 +581,6 @@ SUBROUTINE build_basin_network () IF (allocated(addrbasin )) deallocate(addrbasin ) IF (allocated(addrelm )) deallocate(addrelm ) IF (allocated(basindown )) deallocate(basindown ) - IF (allocated(lakeid )) deallocate(lakeid ) IF (allocated(nhru_all )) deallocate(nhru_all ) IF (allocated(nhru_in_bsn )) deallocate(nhru_in_bsn ) IF (allocated(basin_sorted )) deallocate(basin_sorted ) From e368ab7398875af144ae399b624767dcf294c1fd Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 11 Feb 2025 10:49:17 +0800 Subject: [PATCH 35/43] Code format for MOD_OrbCoszen.F90. --- main/MOD_OrbCoszen.F90 | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/main/MOD_OrbCoszen.F90 b/main/MOD_OrbCoszen.F90 index 6859b469..ab8ced75 100644 --- a/main/MOD_OrbCoszen.F90 +++ b/main/MOD_OrbCoszen.F90 @@ -20,15 +20,19 @@ MODULE MOD_OrbCoszen FUNCTION orb_coszen(calday,dlon,dlat) !----------------------------------------------------------------------- -! FUNCTION to return the cosine of the solar zenith angle. Assumes 365.0 -! days/year. Compute earth/orbit parameters using formula suggested by -! Duane Thresher. Use formulas from Berger, Andre 1978: Long-Term -! Variations of Daily Insolation and Quaternary Climatic Changes. J. of -! the Atmo. Sci. 35:2362-2367. +! !DESCRIPTION: +! FUNCTION to return the cosine of the solar zenith angle. Assumes +! 365.0 days/year. Compute earth/orbit parameters using formula +! suggested by Duane Thresher. Use formulas from Berger, Andre 1978: +! Long-Term Variations of Daily Insolation and Quaternary Climatic +! Changes. J. of the Atmo. Sci. 35:2362-2367. +! +! Original version: Erik Kluzek, Oct/1997, Brian Kauffman, Jan/98 +! CCSM2.0 standard +! Yongjiu Dai (07/23/2002) +! +! !REVISIONS: ! -! Original version: Erik Kluzek, Oct/1997, Brian Kauffman, Jan/98 -! CCSM2.0 standard -! Yongjiu Dai (07/23/2002) !----------------------------------------------------------------------- USE MOD_Precision From a3553c166d0d589c2112a1f7486d60837bab2106 Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Tue, 11 Feb 2025 13:35:47 +0800 Subject: [PATCH 36/43] modification to soil parameter aggregation --- mksrfdata/Aggregation_SoilParameters.F90 | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/mksrfdata/Aggregation_SoilParameters.F90 b/mksrfdata/Aggregation_SoilParameters.F90 index d98c0fdb..c5dc5856 100644 --- a/mksrfdata/Aggregation_SoilParameters.F90 +++ b/mksrfdata/Aggregation_SoilParameters.F90 @@ -1626,19 +1626,15 @@ SUBROUTINE Aggregation_SoilParameters ( & IF (L /= 0) THEN CALL aggregation_request_data (landpatch, ipatch, gland, zip = USE_zip_for_aggregation, area = area_one, & data_r8_2d_in1 = vf_clay_s_grid, data_r8_2d_out1 = vf_clay_s_one) - CALL fillnan (vf_clay_s_one) + CALL fillnan (vf_clay_s_one, L == WATERBODY, vf_clay_fill_water(nsl)) vf_clay_s_patches (ipatch) = sum (vf_clay_s_one * (area_one/sum(area_one))) ELSE vf_clay_s_patches (ipatch) = -1.0e36_r8 ENDIF IF (isnan_ud(vf_clay_s_patches(ipatch))) THEN - IF (L == WATERBODY) THEN - vf_clay_s_patches(ipatch) = vf_clay_fill_water(nsl) - ELSE - write(*,*) "Warning: NAN appears in vf_clay_s_patches." - write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) - ENDIF + write(*,*) "Warning: NAN appears in vf_clay_s_patches." + write(*,*) landpatch%eindex(ipatch), landpatch%settyp(ipatch) ENDIF ENDDO From 6cf0044f9f064d37c49973bea2f9245b6012b49e Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Tue, 11 Feb 2025 14:16:26 +0800 Subject: [PATCH 37/43] constrain river velocity. --- main/HYDRO/MOD_Catch_RiverLakeFlow.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 b/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 index a93dac1a..bc4c97ad 100644 --- a/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 +++ b/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 @@ -427,6 +427,9 @@ SUBROUTINE river_lake_flow (dt) veloc_riv(i) = min(0., veloc_riv(i)) ENDIF + veloc_riv(i) = min(veloc_riv(i), 20.) + veloc_riv(i) = max(veloc_riv(i), -20.) + ENDDO IF (numbasin > 0) THEN From 0c55922b11c4fd7230755bfd66caffdc14abafcd Mon Sep 17 00:00:00 2001 From: weinan123 Date: Tue, 11 Feb 2025 23:55:25 +0800 Subject: [PATCH 38/43] Set default value of vf_clay as 0.1 when the data is missing --- mkinidata/MOD_SoilParametersReadin.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mkinidata/MOD_SoilParametersReadin.F90 b/mkinidata/MOD_SoilParametersReadin.F90 index deac6b8f..98fa4ae9 100644 --- a/mkinidata/MOD_SoilParametersReadin.F90 +++ b/mkinidata/MOD_SoilParametersReadin.F90 @@ -250,7 +250,7 @@ SUBROUTINE soil_parameters_readin (dir_landdata, lc_year) ! (24) read in the volumetric fraction of clay lndname = trim(landdir)//'/vf_clay_s_l'//trim(c)//'_patches.nc' - CALL ncio_read_vector (lndname, 'vf_clay_s_l'//trim(c)//'_patches', landpatch, soil_vf_clay_s_l) + CALL ncio_read_vector (lndname, 'vf_clay_s_l'//trim(c)//'_patches', landpatch, soil_vf_clay_s_l, defval = 0.1) #endif From 3294571a64acb207213a786917c0cbcad38b4d38 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 12 Feb 2025 14:40:11 +0800 Subject: [PATCH 39/43] Add initial value for oroflag. -mod(MOD_Vars_1DFluxes.F90): initialization for oroflag. --- main/MOD_Vars_1DFluxes.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/main/MOD_Vars_1DFluxes.F90 b/main/MOD_Vars_1DFluxes.F90 index 35e3fd98..37df916b 100644 --- a/main/MOD_Vars_1DFluxes.F90 +++ b/main/MOD_Vars_1DFluxes.F90 @@ -72,10 +72,10 @@ MODULE MOD_Vars_1DFluxes real(r8), allocatable :: qcharge(:) !groundwater recharge [mm/s] - integer, allocatable :: oroflag(:) - + real(r8), allocatable :: oroflag(:) !/ocean(0)/seaice(2) flag + integer, parameter :: nsensor = 1 - real(r8), allocatable :: sensors(:,:) + real(r8), allocatable :: sensors(:,:) ! PUBLIC MEMBER FUNCTIONS: PUBLIC :: allocate_1D_Fluxes @@ -152,8 +152,8 @@ SUBROUTINE allocate_1D_Fluxes allocate ( qcharge(numpatch) ) ; qcharge(:) = spval ! groundwater recharge [mm/s] - allocate ( oroflag(numpatch) ) ; oroflag(:) = spval_i4 ! - + allocate ( oroflag(numpatch) ) ; oroflag(:) = 1.0 ! /ocean(0)/seaice(2) flag + allocate ( sensors(nsensor,numpatch) ); sensors(:,:) = spval ! ENDIF @@ -237,7 +237,7 @@ SUBROUTINE deallocate_1D_Fluxes () deallocate ( qcharge ) ! groundwater recharge [mm/s] deallocate ( oroflag ) ! - + deallocate ( sensors ) ! ENDIF From 51831d80015d179981e4b9dcd263334d934e503d Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 12 Feb 2025 15:40:22 +0800 Subject: [PATCH 40/43] Resolve conflicts before merge. --- main/HYDRO/MOD_Catch_RiverLakeFlow.F90 | 263 ++++++++--------- main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 | 367 +++++++++++++++--------- main/HYDRO/MOD_Catch_Vars_1DFluxes.F90 | 106 +++++++ main/MOD_Vars_1DFluxes.F90 | 22 +- mksrfdata/MOD_HRUVector.F90 | 46 +-- 5 files changed, 487 insertions(+), 317 deletions(-) create mode 100644 main/HYDRO/MOD_Catch_Vars_1DFluxes.F90 diff --git a/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 b/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 index 50d2989a..bc4c97ad 100644 --- a/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 +++ b/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 @@ -4,17 +4,17 @@ MODULE MOD_Catch_RiverLakeFlow !------------------------------------------------------------------------------------- ! DESCRIPTION: -! +! ! Shallow water equation solver in rivers. ! ! References -! [1] Toro EF. Shock-capturing methods for free-surface shallow flows. +! [1] Toro EF. Shock-capturing methods for free-surface shallow flows. ! Chichester: John Wiley & Sons; 2001. -! [2] Liang, Q., Borthwick, A. G. L. (2009). Adaptive quadtree simulation of shallow -! flows with wet-dry fronts over complex topography. +! [2] Liang, Q., Borthwick, A. G. L. (2009). Adaptive quadtree simulation of shallow +! flows with wet-dry fronts over complex topography. ! Computers and Fluids, 38(2), 221–234. -! [3] Audusse, E., Bouchut, F., Bristeau, M.-O., Klein, R., Perthame, B. (2004). -! A Fast and Stable Well-Balanced Scheme with Hydrostatic Reconstruction for +! [3] Audusse, E., Bouchut, F., Bristeau, M.-O., Klein, R., Perthame, B. (2004). +! A Fast and Stable Well-Balanced Scheme with Hydrostatic Reconstruction for ! Shallow Water Flows. SIAM Journal on Scientific Computing, 25(6), 2050–2065. ! ! Created by Shupeng Zhang, May 2023 @@ -22,36 +22,33 @@ MODULE MOD_Catch_RiverLakeFlow USE MOD_Precision IMPLICIT NONE - + real(r8), parameter :: nmanning_riv = 0.03 - - real(r8), parameter :: RIVERMIN = 1.e-5_r8 + + real(r8), parameter :: RIVERMIN = 1.e-5_r8 real(r8), parameter :: VOLUMEMIN = 1.e-5_r8 integer :: ntimestep_riverlake - + CONTAINS - + ! --------- SUBROUTINE river_lake_flow (dt) USE MOD_SPMD_Task - USE MOD_Mesh - USE MOD_LandHRU - USE MOD_LandPatch - USE MOD_Vars_TimeVariables - USE MOD_Hydro_Vars_1DFluxes + USE MOD_Catch_BasinNetwork USE MOD_Catch_HillslopeNetwork USE MOD_Catch_RiverLakeNetwork + USE MOD_Catch_Vars_TimeVariables + USE MOD_Catch_Vars_1DFluxes USE MOD_Const_Physical, only : grav IMPLICIT NONE real(r8), intent(in) :: dt ! Local Variables - integer :: nbasin integer :: hs, he, i, j - + real(r8), allocatable :: wdsrf_bsn_ds(:) real(r8), allocatable :: veloc_riv_ds(:) real(r8), allocatable :: momen_riv_ds(:) @@ -59,11 +56,11 @@ SUBROUTINE river_lake_flow (dt) real(r8), allocatable :: hflux_fc(:) real(r8), allocatable :: mflux_fc(:) real(r8), allocatable :: zgrad_dn(:) - + real(r8), allocatable :: sum_hflux_riv(:) real(r8), allocatable :: sum_mflux_riv(:) real(r8), allocatable :: sum_zgrad_riv(:) - + real(r8) :: veloct_fc, height_fc, momen_fc, zsurf_fc real(r8) :: bedelv_fc, height_up, height_dn real(r8) :: vwave_up, vwave_dn, hflux_up, hflux_dn, mflux_up, mflux_dn @@ -71,25 +68,23 @@ SUBROUTINE river_lake_flow (dt) real(r8) :: dt_res, dt_this logical, allocatable :: mask(:) - + IF (p_is_worker) THEN - - nbasin = numelm - + ! update water depth in basin by aggregating water depths in patches - DO i = 1, nbasin + DO i = 1, numbasin hs = basin_hru%substt(i) he = basin_hru%subend(i) IF (lake_id(i) <= 0) THEN ! river or lake catchment ! Water surface in a basin is defined as the lowest surface water in the basin - wdsrf_bsn(i) = minval(hillslope_network(i)%hand + wdsrf_hru(hs:he)) - handmin(i) + wdsrf_bsn(i) = minval(hillslope_basin(i)%hand + wdsrf_bsnhru(hs:he)) - handmin(i) ELSEIF (lake_id(i) > 0) THEN - ! lake - totalvolume = sum(wdsrf_hru(hs:he) * lakes(i)%area0) - wdsrf_bsn(i) = lakes(i)%surface(totalvolume) + ! lake + totalvolume = sum(wdsrf_bsnhru(hs:he) * lakeinfo(i)%area0) + wdsrf_bsn(i) = lakeinfo(i)%surface(totalvolume) ENDIF @@ -102,7 +97,7 @@ SUBROUTINE river_lake_flow (dt) momen_riv(i) = wdsrf_bsn(i) * veloc_riv(i) ENDIF ELSE - ! water in lake or lake catchment is assumed to be stationary. + ! water in lake or lake catchment is assumued to be stationary. ! TODO: lake dynamics momen_riv(i) = 0 veloc_riv(i) = 0 @@ -110,16 +105,16 @@ SUBROUTINE river_lake_flow (dt) ENDDO - IF (nbasin > 0) THEN - allocate (wdsrf_bsn_ds (nbasin)) - allocate (veloc_riv_ds (nbasin)) - allocate (momen_riv_ds (nbasin)) - allocate (hflux_fc (nbasin)) - allocate (mflux_fc (nbasin)) - allocate (zgrad_dn (nbasin)) - allocate (sum_hflux_riv (nbasin)) - allocate (sum_mflux_riv (nbasin)) - allocate (sum_zgrad_riv (nbasin)) + IF (numbasin > 0) THEN + allocate (wdsrf_bsn_ds (numbasin)) + allocate (veloc_riv_ds (numbasin)) + allocate (momen_riv_ds (numbasin)) + allocate (hflux_fc (numbasin)) + allocate (mflux_fc (numbasin)) + allocate (zgrad_dn (numbasin)) + allocate (sum_hflux_riv (numbasin)) + allocate (sum_mflux_riv (numbasin)) + allocate (sum_zgrad_riv (numbasin)) ENDIF ntimestep_riverlake = 0 @@ -127,38 +122,29 @@ SUBROUTINE river_lake_flow (dt) DO WHILE (dt_res > 0) ntimestep_riverlake = ntimestep_riverlake + 1 - - DO i = 1, nbasin + + DO i = 1, numbasin sum_hflux_riv(i) = 0. sum_mflux_riv(i) = 0. sum_zgrad_riv(i) = 0. + ENDDO + + CALL worker_push_data (river_iam_dn, river_iam_up, .false., wdsrf_bsn, wdsrf_bsn_ds) + CALL worker_push_data (river_iam_dn, river_iam_up, .false., veloc_riv, veloc_riv_ds) + CALL worker_push_data (river_iam_dn, river_iam_up, .false., momen_riv, momen_riv_ds) - IF (addrdown(i) > 0) THEN - wdsrf_bsn_ds(i) = wdsrf_bsn(addrdown(i)) - veloc_riv_ds(i) = veloc_riv(addrdown(i)) - momen_riv_ds(i) = momen_riv(addrdown(i)) - ELSE - wdsrf_bsn_ds(i) = 0 - veloc_riv_ds(i) = 0 - momen_riv_ds(i) = 0 - ENDIF - ENDDO -#ifdef USEMPI - CALL river_data_exchange (SEND_DATA_DOWN_TO_UP, accum = .false., & - vec_send1 = wdsrf_bsn, vec_recv1 = wdsrf_bsn_ds, & - vec_send2 = veloc_riv, vec_recv2 = veloc_riv_ds, & - vec_send3 = momen_riv, vec_recv3 = momen_riv_ds ) -#endif ! velocity in ocean or inland depression is assumed to be 0. - WHERE (riverdown <= 0) - veloc_riv_ds = 0. - END WHERE + IF (numbasin > 0) THEN + WHERE (riverdown <= 0) + veloc_riv_ds = 0. + END WHERE + ENDIF dt_this = dt_res - DO i = 1, nbasin + DO i = 1, numbasin IF (riverdown(i) >= 0) THEN - + IF (riverdown(i) > 0) THEN ! both elements are dry. IF ((wdsrf_bsn(i) < RIVERMIN) .and. (wdsrf_bsn_ds(i) < RIVERMIN)) THEN @@ -172,17 +158,17 @@ SUBROUTINE river_lake_flow (dt) ! reconstruction of height of water near interface IF (riverdown(i) > 0) THEN bedelv_fc = max(bedelv(i), bedelv_ds(i)) - height_up = max(0., wdsrf_bsn(i) +bedelv(i) -bedelv_fc) - height_dn = max(0., wdsrf_bsn_ds(i)+bedelv_ds(i)-bedelv_fc) + height_up = max(0., wdsrf_bsn(i) +bedelv(i) -bedelv_fc) + height_dn = max(0., wdsrf_bsn_ds(i)+bedelv_ds(i)-bedelv_fc) ELSEIF (riverdown(i) == 0) THEN ! for river mouth bedelv_fc = bedelv(i) - height_up = wdsrf_bsn(i) + height_up = wdsrf_bsn(i) ! sea level is assumed to be 0. and sea bed is assumed to be negative infinity. - height_dn = max(0., - bedelv_fc) + height_dn = max(0., - bedelv_fc) ENDIF ! velocity at river downstream face (middle region in Riemann problem) - veloct_fc = 0.5 * (veloc_riv(i) + veloc_riv_ds(i)) & + veloct_fc = 0.5 * (veloc_riv(i) + veloc_riv_ds(i)) & + sqrt(grav * height_up) - sqrt(grav * height_dn) ! height of water at downstream face (middle region in Riemann problem) @@ -203,8 +189,8 @@ SUBROUTINE river_lake_flow (dt) hflux_up = veloc_riv(i) * height_up hflux_dn = veloc_riv_ds(i) * height_dn - mflux_up = veloc_riv(i)**2 * height_up + 0.5*grav * height_up**2 - mflux_dn = veloc_riv_ds(i)**2 * height_dn + 0.5*grav * height_dn**2 + mflux_up = veloc_riv(i)**2 * height_up + 0.5*grav * height_up**2 + mflux_dn = veloc_riv_ds(i)**2 * height_dn + 0.5*grav * height_dn**2 IF (vwave_up >= 0.) THEN hflux_fc(i) = outletwth(i) * hflux_up @@ -218,23 +204,23 @@ SUBROUTINE river_lake_flow (dt) mflux_fc(i) = outletwth(i) * (vwave_dn*mflux_up - vwave_up*mflux_dn & + vwave_up*vwave_dn*(hflux_dn-hflux_up)) / (vwave_dn-vwave_up) ENDIF - + sum_zgrad_riv(i) = sum_zgrad_riv(i) + outletwth(i) * 0.5*grav * height_up**2 zgrad_dn(i) = outletwth(i) * 0.5*grav * height_dn**2 - - ELSEIF (riverdown(i) == -3) THEN + + ELSEIF (riverdown(i) == -3) THEN ! downstream is not in model region. ! assume: 1. downstream river bed is equal to this river bed. ! 2. downstream water surface is equal to this river depth. ! 3. downstream water velocity is equal to this velocity. - + veloc_riv(i) = max(veloc_riv(i), 0.) IF (wdsrf_bsn(i) > riverdpth(i)) THEN ! reconstruction of height of water near interface - height_up = wdsrf_bsn(i) + height_up = wdsrf_bsn(i) height_dn = riverdpth(i) veloct_fc = veloc_riv(i) + sqrt(grav * height_up) - sqrt(grav * height_dn) @@ -245,8 +231,8 @@ SUBROUTINE river_lake_flow (dt) hflux_up = veloc_riv(i) * height_up hflux_dn = veloc_riv(i) * height_dn - mflux_up = veloc_riv(i)**2 * height_up + 0.5*grav * height_up**2 - mflux_dn = veloc_riv(i)**2 * height_dn + 0.5*grav * height_dn**2 + mflux_up = veloc_riv(i)**2 * height_up + 0.5*grav * height_up**2 + mflux_dn = veloc_riv(i)**2 * height_dn + 0.5*grav * height_dn**2 IF (vwave_up >= 0.) THEN hflux_fc(i) = outletwth(i) * hflux_up @@ -275,34 +261,28 @@ SUBROUTINE river_lake_flow (dt) IF ((lake_id(i) < 0) .and. (hflux_fc(i) < 0)) THEN hflux_fc(i) = & - max(hflux_fc(i), (height_up-height_dn) / dt_this * sum(hillslope_network(i)%area, & - mask = hillslope_network(i)%hand <= wdsrf_bsn(i) + handmin(i))) + max(hflux_fc(i), (height_up-height_dn) / dt_this * sum(hillslope_basin(i)%area, & + mask = hillslope_basin(i)%hand <= wdsrf_bsn(i) + handmin(i))) ENDIF sum_hflux_riv(i) = sum_hflux_riv(i) + hflux_fc(i) sum_mflux_riv(i) = sum_mflux_riv(i) + mflux_fc(i) - IF (addrdown(i) > 0) THEN - j = addrdown(i) - sum_hflux_riv(j) = sum_hflux_riv(j) - hflux_fc(i) - sum_mflux_riv(j) = sum_mflux_riv(j) - mflux_fc(i) - sum_zgrad_riv(j) = sum_zgrad_riv(j) - zgrad_dn(i) - ENDIF - ENDDO + + IF (numbasin > 0) THEN + hflux_fc = - hflux_fc; mflux_fc = - mflux_fc; zgrad_dn = - zgrad_dn + ENDIF -#ifdef USEMPI - hflux_fc = - hflux_fc; mflux_fc = - mflux_fc; zgrad_dn = - zgrad_dn - - CALL river_data_exchange (SEND_DATA_UP_TO_DOWN, accum = .true., & - vec_send1 = hflux_fc, vec_recv1 = sum_hflux_riv, & - vec_send2 = mflux_fc, vec_recv2 = sum_mflux_riv, & - vec_send3 = zgrad_dn, vec_recv3 = sum_zgrad_riv) - - hflux_fc = - hflux_fc; mflux_fc = - mflux_fc; zgrad_dn = - zgrad_dn -#endif + CALL worker_push_data (river_iam_up, river_iam_dn, .true., hflux_fc, sum_hflux_riv) + CALL worker_push_data (river_iam_up, river_iam_dn, .true., mflux_fc, sum_mflux_riv) + CALL worker_push_data (river_iam_up, river_iam_dn, .true., zgrad_dn, sum_zgrad_riv) + + IF (numbasin > 0) THEN + hflux_fc = - hflux_fc; mflux_fc = - mflux_fc; zgrad_dn = - zgrad_dn + ENDIF - DO i = 1, nbasin + DO i = 1, numbasin ! constraint 1: CFL condition (only for rivers) IF (lake_id(i) == 0) THEN IF ((veloc_riv(i) /= 0.) .or. (wdsrf_bsn(i) > 0.)) THEN @@ -314,18 +294,18 @@ SUBROUTINE river_lake_flow (dt) IF (sum_hflux_riv(i) > 0) THEN IF (lake_id(i) <= 0) THEN ! for river or lake catchment - totalvolume = sum((wdsrf_bsn(i) + handmin(i) - hillslope_network(i)%hand) & - * hillslope_network(i)%area, & - mask = wdsrf_bsn(i) + handmin(i) >= hillslope_network(i)%hand) + totalvolume = sum((wdsrf_bsn(i) + handmin(i) - hillslope_basin(i)%hand) & + * hillslope_basin(i)%area, & + mask = wdsrf_bsn(i) + handmin(i) >= hillslope_basin(i)%hand) ELSEIF (lake_id(i) > 0) THEN ! for lake - totalvolume = lakes(i)%volume(wdsrf_bsn(i)) + totalvolume = lakeinfo(i)%volume(wdsrf_bsn(i)) ENDIF - + dt_this = min(dt_this, totalvolume / sum_hflux_riv(i)) - + ENDIF - + ! constraint 3: Avoid change of flow direction (only for rivers) IF (lake_id(i) == 0) THEN IF ((abs(veloc_riv(i)) > 0.1) & @@ -334,31 +314,31 @@ SUBROUTINE river_lake_flow (dt) abs(momen_riv(i) * riverarea(i) / (sum_mflux_riv(i)-sum_zgrad_riv(i)))) ENDIF ENDIF - ENDDO + ENDDO #ifdef USEMPI CALL mpi_allreduce (MPI_IN_PLACE, dt_this, 1, MPI_REAL8, MPI_MIN, p_comm_worker, p_err) #endif - DO i = 1, nbasin + DO i = 1, numbasin IF (lake_id(i) <= 0) THEN ! rivers or lake catchments hs = basin_hru%substt(i) he = basin_hru%subend(i) - allocate (mask (hillslope_network(i)%nhru)) - - totalvolume = sum((wdsrf_bsn(i) + handmin(i) - hillslope_network(i)%hand) & - * hillslope_network(i)%area, & - mask = wdsrf_bsn(i) + handmin(i) >= hillslope_network(i)%hand) + allocate (mask (hillslope_basin(i)%nhru)) + + totalvolume = sum((wdsrf_bsn(i) + handmin(i) - hillslope_basin(i)%hand) & + * hillslope_basin(i)%area, & + mask = wdsrf_bsn(i) + handmin(i) >= hillslope_basin(i)%hand) totalvolume = totalvolume - sum_hflux_riv(i) * dt_this - + IF (totalvolume < VOLUMEMIN) THEN - DO j = 1, hillslope_network(i)%nhru - IF (hillslope_network(i)%hand(j) <= wdsrf_bsn(i) + handmin(i)) THEN - wdsrf_hru(j+hs-1) = wdsrf_hru(j+hs-1) & - - (wdsrf_bsn(i) + handmin(i) - hillslope_network(i)%hand(j)) + DO j = 1, hillslope_basin(i)%nhru + IF (hillslope_basin(i)%hand(j) <= wdsrf_bsn(i) + handmin(i)) THEN + wdsrf_bsnhru(j+hs-1) = wdsrf_bsnhru(j+hs-1) & + - (wdsrf_bsn(i) + handmin(i) - hillslope_basin(i)%hand(j)) ENDIF ENDDO wdsrf_bsn(i) = 0 @@ -367,9 +347,9 @@ SUBROUTINE river_lake_flow (dt) dvol = sum_hflux_riv(i) * dt_this IF (dvol > VOLUMEMIN) THEN DO WHILE (dvol > VOLUMEMIN) - mask = hillslope_network(i)%hand < wdsrf_bsn(i) + handmin(i) - nextl = maxval(hillslope_network(i)%hand, mask = mask) - nexta = sum (hillslope_network(i)%area, mask = mask) + mask = hillslope_basin(i)%hand < wdsrf_bsn(i) + handmin(i) + nextl = maxval(hillslope_basin(i)%hand, mask = mask) + nexta = sum (hillslope_basin(i)%area, mask = mask) nextv = nexta * (wdsrf_bsn(i)+handmin(i)-nextl) IF (nextv > dvol) THEN ddep = dvol/nexta @@ -381,9 +361,9 @@ SUBROUTINE river_lake_flow (dt) wdsrf_bsn(i) = wdsrf_bsn(i) - ddep - DO j = 1, hillslope_network(i)%nhru + DO j = 1, hillslope_basin(i)%nhru IF (mask(j)) THEN - wdsrf_hru(j+hs-1) = wdsrf_hru(j+hs-1) - ddep + wdsrf_bsnhru(j+hs-1) = wdsrf_bsnhru(j+hs-1) - ddep ENDIF ENDDO ENDDO @@ -392,12 +372,12 @@ SUBROUTINE river_lake_flow (dt) nexta = 0. DO WHILE (dvol < -VOLUMEMIN) IF (any(mask)) THEN - j = minloc(hillslope_network(i)%hand + wdsrf_hru(hs:he), 1, mask = mask) - nexta = nexta + hillslope_network(i)%area(j) + j = minloc(hillslope_basin(i)%hand + wdsrf_bsnhru(hs:he), 1, mask = mask) + nexta = nexta + hillslope_basin(i)%area(j) mask(j) = .false. ENDIF IF (any(mask)) THEN - nextl = minval(hillslope_network(i)%hand + wdsrf_hru(hs:he), mask = mask) + nextl = minval(hillslope_basin(i)%hand + wdsrf_bsnhru(hs:he), mask = mask) nextv = nexta*(nextl-(wdsrf_bsn(i)+handmin(i))) IF ((-dvol) > nextv) THEN ddep = nextl - (wdsrf_bsn(i)+handmin(i)) @@ -413,21 +393,21 @@ SUBROUTINE river_lake_flow (dt) wdsrf_bsn(i) = wdsrf_bsn(i) + ddep - DO j = 1, hillslope_network(i)%nhru + DO j = 1, hillslope_basin(i)%nhru IF (.not. mask(j)) THEN - wdsrf_hru(j+hs-1) = wdsrf_hru(j+hs-1) + ddep + wdsrf_bsnhru(j+hs-1) = wdsrf_bsnhru(j+hs-1) + ddep ENDIF ENDDO ENDDO ENDIF - + ENDIF deallocate(mask) ELSE - totalvolume = lakes(i)%volume(wdsrf_bsn(i)) + totalvolume = lakeinfo(i)%volume(wdsrf_bsn(i)) totalvolume = totalvolume - sum_hflux_riv(i) * dt_this - wdsrf_bsn(i) = lakes(i)%surface(totalvolume) + wdsrf_bsn(i) = lakeinfo(i)%surface(totalvolume) ENDIF IF ((lake_id(i) /= 0) .or. (wdsrf_bsn(i) < RIVERMIN)) THEN @@ -437,31 +417,34 @@ SUBROUTINE river_lake_flow (dt) friction = grav * nmanning_riv**2 / wdsrf_bsn(i)**(7.0/3.0) * abs(momen_riv(i)) momen_riv(i) = (momen_riv(i) & - (sum_mflux_riv(i) - sum_zgrad_riv(i)) / riverarea(i) * dt_this) & - / (1 + friction * dt_this) + / (1 + friction * dt_this) veloc_riv(i) = momen_riv(i) / wdsrf_bsn(i) ENDIF - + ! inland depression river IF ((lake_id(i) == 0) .and. (riverdown(i) == -1)) THEN momen_riv(i) = min(0., momen_riv(i)) veloc_riv(i) = min(0., veloc_riv(i)) ENDIF + veloc_riv(i) = min(veloc_riv(i), 20.) + veloc_riv(i) = max(veloc_riv(i), -20.) + ENDDO - IF (nbasin > 0) THEN - wdsrf_bsn_ta(:) = wdsrf_bsn_ta(:) + wdsrf_bsn(:) * dt_this - momen_riv_ta(:) = momen_riv_ta(:) + momen_riv(:) * dt_this - discharge (:) = discharge (:) + hflux_fc (:) * dt_this + IF (numbasin > 0) THEN + wdsrf_bsn_ta (:) = wdsrf_bsn_ta (:) + wdsrf_bsn(:) * dt_this + momen_riv_ta (:) = momen_riv_ta (:) + momen_riv(:) * dt_this + discharge_ta (:) = discharge_ta (:) + hflux_fc (:) * dt_this ENDIF - - DO i = 1, nbasin + + DO i = 1, numbasin IF (lake_id(i) > 0) THEN ! for lakes hs = basin_hru%substt(i) he = basin_hru%subend(i) DO j = hs, he - wdsrf_hru(j) = max(wdsrf_bsn(i) - (lakes(i)%depth(1) - lakes(i)%depth0(j-hs+1)), 0.) - wdsrf_hru_ta(j) = wdsrf_hru_ta(j) + wdsrf_hru(j) * dt_this + wdsrf_bsnhru(j) = max(wdsrf_bsn(i) - (lakeinfo(i)%depth(1) - lakeinfo(i)%depth0(j-hs+1)), 0.) + wdsrf_bsnhru_ta(j) = wdsrf_bsnhru_ta(j) + wdsrf_bsnhru(j) * dt_this ENDDO ENDIF ENDDO @@ -470,7 +453,7 @@ SUBROUTINE river_lake_flow (dt) ENDDO - wdsrf_bsn_prev(:) = wdsrf_bsn(:) + IF (numbasin > 0) wdsrf_bsn_prev(:) = wdsrf_bsn(:) IF (allocated(wdsrf_bsn_ds )) deallocate(wdsrf_bsn_ds ) IF (allocated(veloc_riv_ds )) deallocate(veloc_riv_ds ) diff --git a/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 b/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 index e7d2c15e..1d20905a 100644 --- a/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 +++ b/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 @@ -4,31 +4,40 @@ MODULE MOD_Catch_SubsurfaceFlow !------------------------------------------------------------------------------------- ! DESCRIPTION: -! +! ! Ground water lateral flow. ! ! Ground water fluxes are calculated -! 1. between basins +! 1. between elements ! 2. between hydrological response units -! 3. between patches inside one HRU +! 3. between patches inside one HRU ! ! Created by Shupeng Zhang, May 2023 !------------------------------------------------------------------------------------- USE MOD_Precision USE MOD_DataType + USE MOD_Catch_HillslopeNetwork IMPLICIT NONE - real(r8), parameter :: e_ice = 6.0 ! soil ice impedance factor + ! --- information of HRU on hillslope --- + type(hillslope_network_type), pointer :: hillslope_element (:) + integer, allocatable :: lake_id_elm (:) + real(r8), allocatable :: lakedepth_elm(:) + real(r8), allocatable :: riverdpth_elm(:) + real(r8), allocatable :: wdsrf_elm (:) + + real(r8), parameter :: e_ice = 6.0 ! soil ice impedance factor + ! anisotropy ratio of lateral/vertical hydraulic conductivity (unitless) ! for USDA soil texture class: ! 0: undefined - ! 1: clay; 2: silty clay; 3: sandy clay; 4: clay loam; 5: silty clay loam; 6: sandy clay loam; & + ! 1: clay; 2: silty clay; 3: sandy clay; 4: clay loam; 5: silty clay loam; 6: sandy clay loam; & ! 7: loam; 8: silty loam; 9: sandy loam; 10: silt; 11: loamy sand; 12: sand real(r8), parameter :: raniso(0:12) = (/ 1., & 48., 40., 28., 24., 20., 14., 12., 10., 4., 2., 3., 2. /) - + ! -- neighbour variables -- type(pointer_real8_1d), allocatable :: agwt_nb (:) ! ground water area (for patchtype <= 2) of neighbours [m^2] type(pointer_real8_1d), allocatable :: theta_a_nb (:) ! saturated volume content [-] @@ -36,104 +45,164 @@ MODULE MOD_Catch_SubsurfaceFlow type(pointer_real8_1d), allocatable :: Kl_nb (:) ! lateral hydraulic conductivity [m/s] type(pointer_real8_1d), allocatable :: wdsrf_nb (:) ! depth of surface water [m] type(pointer_logic_1d), allocatable :: islake_nb (:) ! whether a neighbour is water body + type(pointer_real8_1d), allocatable :: lakedp_nb (:) ! lake depth of neighbour [m] CONTAINS - + ! ---------- - SUBROUTINE basin_neighbour_init () + SUBROUTINE subsurface_network_init () USE MOD_SPMD_Task + USE MOD_Utils USE MOD_Mesh + USE MOD_Pixel + USE MOD_LandElm + USE MOD_LandPatch USE MOD_ElementNeighbour - USE MOD_Catch_HillslopeNetwork, only : hillslope_network - USE MOD_Catch_RiverLakeNetwork, only : lake_id + USE MOD_Catch_BasinNetwork, only : worker_push_data, iam_bsn, iam_elm + USE MOD_Catch_RiverLakeNetwork, only : lake_id, riverdpth + USE MOD_Vars_TimeInvariants, only : patchtype, lakedepth IMPLICIT NONE - - integer :: numbasin, ibasin, inb - + + integer :: ielm, inb, i, ihru, ps, pe, ipatch, ipxl + real(r8), allocatable :: agwt_b(:) real(r8), allocatable :: islake(:) - type(pointer_real8_1d), allocatable :: iswat_nb (:) + type(pointer_real8_1d), allocatable :: iswat_nb (:) + + integer, allocatable :: eindex(:) #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - numbasin = numelm + IF (p_is_worker) THEN + IF (numelm > 0) THEN + allocate (eindex (numelm)) + eindex = landelm%eindex + ENDIF + ENDIF + + CALL hillslope_network_init (numelm, eindex, hillslope_element) + + IF (allocated(eindex)) deallocate (eindex) IF (p_is_worker) THEN + + IF (numelm > 0) allocate (lake_id_elm (numelm)) + IF (numelm > 0) allocate (riverdpth_elm(numelm)) + IF (numelm > 0) allocate (lakedepth_elm(numelm)) + IF (numelm > 0) allocate (wdsrf_elm (numelm)) + + CALL worker_push_data (iam_bsn, iam_elm, .false., lake_id, lake_id_elm ) + CALL worker_push_data (iam_bsn, iam_elm, .false., riverdpth, riverdpth_elm) + + DO ielm = 1, numelm + IF (lake_id_elm(ielm) <= 0) THEN + DO i = 1, hillslope_element(ielm)%nhru + hillslope_element(ielm)%agwt(i) = 0 + + ihru = hillslope_element(ielm)%ihru(i) + ps = hru_patch%substt(ihru) + pe = hru_patch%subend(ihru) + DO ipatch = ps, pe + IF (patchtype(ipatch) <= 2) THEN + DO ipxl = landpatch%ipxstt(ipatch), landpatch%ipxend(ipatch) + hillslope_element(ielm)%agwt(i) = hillslope_element(ielm)%agwt(i) & + + 1.0e6 * areaquad ( & + pixel%lat_s(mesh(ielm)%ilat(ipxl)), pixel%lat_n(mesh(ielm)%ilat(ipxl)), & + pixel%lon_w(mesh(ielm)%ilon(ipxl)), pixel%lon_e(mesh(ielm)%ilon(ipxl)) ) + ENDDO + ENDIF + ENDDO + + ENDDO + ENDIF + ENDDO + + lakedepth_elm(:) = 0. + DO ielm = 1, numelm + IF (lake_id_elm(ielm) > 0) THEN + ps = elm_patch%substt(ielm) + pe = elm_patch%subend(ielm) + lakedepth_elm(ielm) = sum(lakedepth(ps:pe) * elm_patch%subfrc(ps:pe)) + ENDIF + ENDDO + CALL allocate_neighbour_data (agwt_nb ) CALL allocate_neighbour_data (theta_a_nb) CALL allocate_neighbour_data (zwt_nb ) - CALL allocate_neighbour_data (Kl_nb ) + CALL allocate_neighbour_data (Kl_nb ) CALL allocate_neighbour_data (wdsrf_nb ) CALL allocate_neighbour_data (islake_nb ) - + CALL allocate_neighbour_data (lakedp_nb ) CALL allocate_neighbour_data (iswat_nb ) - IF (numbasin > 0) THEN - allocate (agwt_b(numbasin)) - allocate (islake(numbasin)) - DO ibasin = 1, numbasin - IF (lake_id(ibasin) <= 0) THEN - agwt_b(ibasin) = sum(hillslope_network(ibasin)%agwt) - islake(ibasin) = 0. + IF (numelm > 0) THEN + allocate (agwt_b(numelm)) + allocate (islake(numelm)) + DO ielm = 1, numelm + IF (lake_id_elm(ielm) <= 0) THEN + agwt_b(ielm) = sum(hillslope_element(ielm)%agwt) + islake(ielm) = 0. ELSE - agwt_b(ibasin) = 0. - islake(ibasin) = 1. + agwt_b(ielm) = 0. + islake(ielm) = 1. ENDIF ENDDO ENDIF - + + CALL retrieve_neighbour_data (lakedepth_elm, lakedp_nb) + CALL retrieve_neighbour_data (agwt_b, agwt_nb ) CALL retrieve_neighbour_data (islake, iswat_nb) - - DO ibasin = 1, numbasin - DO inb = 1, elementneighbour(ibasin)%nnb - IF (elementneighbour(ibasin)%glbindex(inb) > 0) THEN ! skip ocean neighbour - islake_nb(ibasin)%val(inb) = (iswat_nb(ibasin)%val(inb) > 0) + + DO ielm = 1, numelm + DO inb = 1, elementneighbour(ielm)%nnb + IF (elementneighbour(ielm)%glbindex(inb) > 0) THEN ! skip ocean neighbour + islake_nb(ielm)%val(inb) = (iswat_nb(ielm)%val(inb) > 0) ENDIF ENDDO ENDDO - + IF (allocated(agwt_b )) deallocate(agwt_b ) IF (allocated(islake )) deallocate(islake ) IF (allocated(iswat_nb)) deallocate(iswat_nb) - + ENDIF - END SUBROUTINE basin_neighbour_init + END SUBROUTINE subsurface_network_init ! --------- SUBROUTINE subsurface_flow (deltime) - + USE MOD_SPMD_Task USE MOD_UserDefFun USE MOD_Mesh USE MOD_LandElm + USE MOD_LandHRU USE MOD_LandPatch USE MOD_Vars_TimeVariables USE MOD_Vars_TimeInvariants USE MOD_Vars_1DFluxes USE MOD_Catch_HillslopeNetwork - USE MOD_Catch_RiverLakeNetwork USE MOD_ElementNeighbour USE MOD_Const_Physical, only : denice, denh2o USE MOD_Vars_Global, only : pi, nl_soil, zi_soi USE MOD_Hydro_SoilWater, only : soilwater_aquifer_exchange IMPLICIT NONE - + real(r8), intent(in) :: deltime ! Local Variables - integer :: numbasin, nhru, ibasin, i, i0, j, ihru, ipatch, ps, pe, ilev + integer :: nhru, ielm, i, i0, j, ihru, ipatch, ps, pe, hs, he, ilev - type(hillslope_network_info_type), pointer :: hrus + type(hillslope_network_type), pointer :: hrus - real(r8), allocatable :: theta_a_h (:) - real(r8), allocatable :: zwt_h (:) + real(r8), allocatable :: theta_a_h (:) + real(r8), allocatable :: zwt_h (:) real(r8), allocatable :: Kl_h (:) ! [m/s] real(r8), allocatable :: xsubs_h (:) ! [m/s] real(r8), allocatable :: xsubs_fc (:) ! [m/s] @@ -146,9 +215,9 @@ SUBROUTINE subsurface_flow (deltime) real(r8) :: ca, cb real(r8) :: alp - real(r8), allocatable :: theta_a_bsn (:) - real(r8), allocatable :: zwt_bsn (:) - real(r8), allocatable :: Kl_bsn (:) ! [m/s] + real(r8), allocatable :: theta_a_elm (:) + real(r8), allocatable :: zwt_elm (:) + real(r8), allocatable :: Kl_elm (:) ! [m/s] integer :: jnb real(r8) :: zsubs_up, zwt_up, Kl_up, theta_a_up, area_up @@ -179,37 +248,35 @@ SUBROUTINE subsurface_flow (deltime) IF (p_is_worker) THEN - numbasin = numelm - - xsubs_bsn(:) = 0. ! subsurface lateral flow between basins + xsubs_elm(:) = 0. ! subsurface lateral flow between element basins xsubs_hru(:) = 0. ! subsurface lateral flow between hydrological response units - xsubs_pch(:) = 0. ! subsurface lateral flow between patches inside one HRU + xsubs_pch(:) = 0. ! subsurface lateral flow between patches inside one HRU xwsub(:) = 0. ! total recharge/discharge from subsurface lateral flow bdamp = 4.8 - IF (numbasin > 0) THEN - allocate (theta_a_bsn (numbasin)); theta_a_bsn = 0. - allocate (zwt_bsn (numbasin)); zwt_bsn = 0. - allocate (Kl_bsn (numbasin)); Kl_bsn = 0. + IF (numelm > 0) THEN + allocate (theta_a_elm (numelm)); theta_a_elm = 0. + allocate (zwt_elm (numelm)); zwt_elm = 0. + allocate (Kl_elm (numelm)); Kl_elm = 0. ENDIF - DO ibasin = 1, numbasin + DO ielm = 1, numelm - hrus => hillslope_network(ibasin) + hrus => hillslope_element(ielm) nhru = hrus%nhru - IF (lake_id(ibasin) > 0) CYCLE ! lake - IF (sum(hrus%agwt) <= 0) CYCLE ! no area of soil, urban or wetland - + IF (lake_id_elm(ielm) > 0) CYCLE ! lake + IF (sum(hrus%agwt) <= 0) CYCLE ! no area of soil, urban or wetland + allocate (theta_a_h (nhru)); theta_a_h = 0. allocate (zwt_h (nhru)); zwt_h = 0. allocate (Kl_h (nhru)); Kl_h = 0. DO i = 1, nhru - + IF (hrus%indx(i) == 0) CYCLE ! river IF (hrus%agwt(i) == 0) CYCLE ! no area of soil, urban or wetland @@ -222,14 +289,14 @@ SUBROUTINE subsurface_flow (deltime) IF (patchtype(ipatch) <= 2) THEN theta_s_h = theta_s_h + hru_patch%subfrc(ipatch) & * sum(porsl(1:nl_soil,ipatch) * dz_soi(1:nl_soil) & - - wice_soisno(1:nl_soil,ipatch)/denice) / sum(dz_soi(1:nl_soil)) + - wice_soisno(1:nl_soil,ipatch)/denice) / sum(dz_soi(1:nl_soil)) sumwt = sumwt + hru_patch%subfrc(ipatch) - ENDIF + ENDIF ENDDO IF (sumwt > 0) theta_s_h = theta_s_h / sumwt IF (theta_s_h > 0.) THEN - + air_h = 0. zwt_h(i) = 0. sumwt = 0. @@ -240,9 +307,9 @@ SUBROUTINE subsurface_flow (deltime) - wliq_soisno(1:nl_soil,ipatch)/denh2o & - wice_soisno(1:nl_soil,ipatch)/denice ) - wa(ipatch)/1.0e3) air_h = max(0., air_h) - + zwt_h(i) = zwt_h(i) + zwt(ipatch) * hru_patch%subfrc(ipatch) - + sumwt = sumwt + hru_patch%subfrc(ipatch) ENDIF ENDDO @@ -268,7 +335,7 @@ SUBROUTINE subsurface_flow (deltime) icefrac = min(1., wice_soisno(ilev,ipatch)/denice/dz_soi(ilev)/porsl(ilev,ipatch)) imped = 10.**(-e_ice*icefrac) Kl_h(i) = Kl_h(i) + hru_patch%subfrc(ipatch) * raniso(soiltext(ipatch)) & - * hksati(ilev,ipatch)/1.0e3 * imped * dz_soi(ilev)/zi_soi(nl_soil) + * hksati(ilev,ipatch)/1.0e3 * imped * dz_soi(ilev)/zi_soi(nl_soil) ENDDO sumwt = sumwt + hru_patch%subfrc(ipatch) ENDIF @@ -280,7 +347,7 @@ SUBROUTINE subsurface_flow (deltime) ENDIF ENDDO - + allocate (xsubs_h (nhru)) allocate (xsubs_fc (nhru)) @@ -288,22 +355,22 @@ SUBROUTINE subsurface_flow (deltime) xsubs_fc(:) = 0. DO i = 1, nhru - + j = hrus%inext(i) IF (j <= 0) CYCLE ! downstream is out of catchment IF (Kl_h(i) == 0.) CYCLE ! this HRU is frozen - + j_is_river = (hrus%indx(j) == 0) IF ((.not. j_is_river) .and. (Kl_h(j) == 0.)) CYCLE ! non-river downstream HRU is frozen - + zsubs_h_up = hrus%elva(i) - zwt_h(i) IF (.not. j_is_river) THEN zsubs_h_dn = hrus%elva(j) - zwt_h(j) ELSE - zsubs_h_dn = hrus%elva(1) - riverdpth(ibasin) + wdsrf_hru(hrus%ihru(1)) + zsubs_h_dn = hrus%elva(1) - riverdpth_elm(ielm) + wdsrf_hru(hrus%ihru(1)) ENDIF IF (.not. j_is_river) THEN @@ -343,7 +410,7 @@ SUBROUTINE subsurface_flow (deltime) ELSE cb = hrus%flen(i) * Kl_fc / delp / hrus%area(j) * deltime ENDIF - + xsubs_fc(i) = (zsubs_h_up - zsubs_h_dn) * hrus%flen(i) * Kl_fc / (1+ca+cb) / delp xsubs_h(i) = xsubs_h(i) + xsubs_fc(i) / hrus%agwt(i) @@ -353,13 +420,13 @@ SUBROUTINE subsurface_flow (deltime) ELSE xsubs_h(j) = xsubs_h(j) - xsubs_fc(i) / hrus%agwt(j) ENDIF - + ENDDO - + IF (hrus%indx(1) == 0) THEN ! xsubs_h(1) is positive = out of soil column - IF (xsubs_h(1)*deltime > wdsrf_bsn(ibasin)) THEN - alp = wdsrf_bsn(ibasin) / (xsubs_h(1)*deltime) + IF (xsubs_h(1)*deltime > wdsrf_hru(hrus%ihru(1))) THEN + alp = wdsrf_hru(hrus%ihru(1)) / (xsubs_h(1)*deltime) xsubs_h(1) = xsubs_h(1) * alp DO i = 2, nhru IF ((hrus%inext(i) == 1) .and. (hrus%agwt(i) > 0.)) THEN @@ -368,33 +435,33 @@ SUBROUTINE subsurface_flow (deltime) ENDDO ENDIF ENDIF - + ! Update total subsurface lateral flow (1): Between hydrological units ! for soil, urban, wetland or river patches DO i = 1, nhru xsubs_hru(hrus%ihru(i)) = xsubs_h(i) - + ps = hru_patch%substt(hrus%ihru(i)) pe = hru_patch%subend(hrus%ihru(i)) DO ipatch = ps, pe - IF ((patchtype(ipatch) <= 2) .or. (hrus%indx(i) == 0)) THEN - xwsub(ipatch) = xwsub(ipatch) + xsubs_h(i) * 1.e3 ! (positive = out of soil column) + IF ((patchtype(ipatch) <= 2) .or. (hrus%indx(i) == 0)) THEN + xwsub(ipatch) = xwsub(ipatch) + xsubs_h(i) * 1.e3 ! (positive = out of soil column) ENDIF ENDDO IF (hrus%indx(1) == 0) THEN DO ipatch = ps, pe - IF (patchtype(ipatch) <= 2) THEN - rsub(ipatch) = - xsubs_h(1) * riverarea(ibasin) / sum(hrus%agwt) * 1.0e3 ! m/s to mm/s + IF (patchtype(ipatch) <= 2) THEN + rsub(ipatch) = - xsubs_h(1) * hrus%area(1) / sum(hrus%agwt) * 1.0e3 ! m/s to mm/s ENDIF ENDDO ENDIF ENDDO - + DO i = 1, nhru ! Inside hydrological units IF (hrus%agwt(i) > 0) THEN - + IF (zwt_h(i) > 1.5) THEN ! from Fan et al., JGR 112(D10125) Kl_in = Kl_h(i) * bdamp * exp(-(zwt_h(i)-1.5)/bdamp) @@ -421,9 +488,9 @@ SUBROUTINE subsurface_flow (deltime) sumarea = sum(hrus%agwt) IF (sumarea > 0) THEN - theta_a_bsn (ibasin) = sum(theta_a_h * hrus%agwt) / sumarea - zwt_bsn (ibasin) = sum(zwt_h * hrus%agwt) / sumarea - Kl_bsn (ibasin) = sum(Kl_h * hrus%agwt) / sumarea + theta_a_elm (ielm) = sum(theta_a_h * hrus%agwt) / sumarea + zwt_elm (ielm) = sum(zwt_h * hrus%agwt) / sumarea + Kl_elm (ielm) = sum(Kl_h * hrus%agwt) / sumarea ENDIF deallocate (theta_a_h) @@ -434,76 +501,82 @@ SUBROUTINE subsurface_flow (deltime) ENDDO - CALL retrieve_neighbour_data (theta_a_bsn, theta_a_nb) - CALL retrieve_neighbour_data (zwt_bsn , zwt_nb ) - CALL retrieve_neighbour_data (Kl_bsn , Kl_nb ) - CALL retrieve_neighbour_data (wdsrf_bsn , wdsrf_nb ) - - DO ibasin = 1, numbasin - - hrus => hillslope_network(ibasin) + DO ielm = 1, numelm + hs = elm_hru%substt(ielm) + he = elm_hru%subend(ielm) + wdsrf_elm(ielm) = sum(wdsrf_hru(hs:he) * elm_hru%subfrc(hs:he)) + ENDDO - iam_lake = (lake_id(ibasin) > 0) + CALL retrieve_neighbour_data (theta_a_elm, theta_a_nb) + CALL retrieve_neighbour_data (zwt_elm , zwt_nb ) + CALL retrieve_neighbour_data (Kl_elm , Kl_nb ) + CALL retrieve_neighbour_data (wdsrf_elm , wdsrf_nb ) - DO jnb = 1, elementneighbour(ibasin)%nnb + DO ielm = 1, numelm + + hrus => hillslope_element(ielm) + + iam_lake = (lake_id_elm(ielm) > 0) + + DO jnb = 1, elementneighbour(ielm)%nnb - IF (elementneighbour(ibasin)%glbindex(jnb) == -9) CYCLE ! skip ocean neighbour + IF (elementneighbour(ielm)%glbindex(jnb) == -9) CYCLE ! skip ocean neighbour - nb_is_lake = islake_nb(ibasin)%val(jnb) + nb_is_lake = islake_nb(ielm)%val(jnb) IF (iam_lake .and. nb_is_lake) THEN CYCLE ENDIF - + IF (.not. iam_lake) THEN - Kl_up = Kl_bsn (ibasin) - zwt_up = zwt_bsn (ibasin) - theta_a_up = theta_a_bsn(ibasin) - zsubs_up = elementneighbour(ibasin)%myelva - zwt_up + Kl_up = Kl_elm (ielm) + zwt_up = zwt_elm (ielm) + theta_a_up = theta_a_elm(ielm) + zsubs_up = elementneighbour(ielm)%myelva - zwt_up area_up = sum(hrus%agwt) ELSE theta_a_up = 1. - zsubs_up = elementneighbour(ibasin)%myelva + wdsrf_bsn(ibasin) - area_up = elementneighbour(ibasin)%myarea + zsubs_up = elementneighbour(ielm)%myelva - lakedepth_elm(ielm) + wdsrf_elm(ielm) + area_up = elementneighbour(ielm)%myarea ENDIF IF (.not. nb_is_lake) THEN - Kl_dn = Kl_nb(ibasin)%val(jnb) - zwt_dn = zwt_nb(ibasin)%val(jnb) - theta_a_dn = theta_a_nb(ibasin)%val(jnb) - zsubs_dn = elementneighbour(ibasin)%elva(jnb) - zwt_dn - area_dn = agwt_nb(ibasin)%val(jnb) + Kl_dn = Kl_nb(ielm)%val(jnb) + zwt_dn = zwt_nb(ielm)%val(jnb) + theta_a_dn = theta_a_nb(ielm)%val(jnb) + zsubs_dn = elementneighbour(ielm)%elva(jnb) - zwt_dn + area_dn = agwt_nb(ielm)%val(jnb) ELSE theta_a_dn = 1. - zsubs_dn = elementneighbour(ibasin)%elva(jnb) + wdsrf_nb(ibasin)%val(jnb) - area_dn = elementneighbour(ibasin)%area(jnb) + zsubs_dn = elementneighbour(ielm)%elva(jnb) - lakedp_nb(ielm)%val(jnb) + wdsrf_nb(ielm)%val(jnb) + area_dn = elementneighbour(ielm)%area(jnb) ENDIF IF ((.not. iam_lake) .and. (area_up <= 0)) CYCLE IF ((.not. nb_is_lake) .and. (area_dn <= 0)) CYCLE - IF ((.not. iam_lake) .and. (Kl_up == 0. )) CYCLE + IF ((.not. iam_lake) .and. (Kl_up == 0. )) CYCLE IF ((.not. nb_is_lake) .and. (Kl_dn == 0. )) CYCLE ! water body is dry. - IF (iam_lake .and. (zsubs_up > zsubs_dn) .and. (wdsrf_bsn(ibasin) == 0.)) THEN + IF (iam_lake .and. (zsubs_up > zsubs_dn) .and. (wdsrf_elm(ielm) == 0.)) THEN CYCLE ENDIF - IF (nb_is_lake .and. (zsubs_up < zsubs_dn) .and. (wdsrf_nb(ibasin)%val(jnb) == 0.)) THEN + IF (nb_is_lake .and. (zsubs_up < zsubs_dn) .and. (wdsrf_nb(ielm)%val(jnb) == 0.)) THEN CYCLE ENDIF + + lenbdr = elementneighbour(ielm)%lenbdr(jnb) - lenbdr = elementneighbour(ibasin)%lenbdr(jnb) - - delp = elementneighbour(ibasin)%dist(jnb) + delp = elementneighbour(ielm)%dist(jnb) IF (iam_lake) THEN - delp = elementneighbour(ibasin)%area(jnb) / lenbdr * 0.5 + delp = elementneighbour(ielm)%area(jnb) / lenbdr * 0.5 ENDIF IF (nb_is_lake) THEN - delp = elementneighbour(ibasin)%myarea / lenbdr * 0.5 + delp = elementneighbour(ielm)%myarea / lenbdr * 0.5 ENDIF ! from Fan et al., JGR 112(D10125) - slope = abs(elementneighbour(ibasin)%slope(jnb)) + slope = abs(elementneighbour(ielm)%slope(jnb)) IF (slope > 0.16) THEN bdamp = 4.8 ELSE @@ -534,41 +607,41 @@ SUBROUTINE subsurface_flow (deltime) IF (.not. iam_lake) THEN xsubs_nb = xsubs_nb / sum(hrus%agwt) ELSE - xsubs_nb = xsubs_nb / elementneighbour(ibasin)%myarea + xsubs_nb = xsubs_nb / elementneighbour(ielm)%myarea ENDIF - - xsubs_bsn(ibasin) = xsubs_bsn(ibasin) + xsubs_nb + + xsubs_elm(ielm) = xsubs_elm(ielm) + xsubs_nb ENDDO ! Update total subsurface lateral flow (3): Between basins - ps = elm_patch%substt(ibasin) - pe = elm_patch%subend(ibasin) + ps = elm_patch%substt(ielm) + pe = elm_patch%subend(ielm) DO ipatch = ps, pe IF (iam_lake .or. (patchtype(ipatch) <= 2)) THEN - xwsub(ipatch) = xwsub(ipatch) + xsubs_bsn(ibasin) * 1.e3 ! m/s to mm/s + xwsub(ipatch) = xwsub(ipatch) + xsubs_elm(ielm) * 1.e3 ! m/s to mm/s ENDIF ENDDO ENDDO - IF (allocated(theta_a_bsn)) deallocate(theta_a_bsn) - IF (allocated(zwt_bsn )) deallocate(zwt_bsn ) - IF (allocated(Kl_bsn )) deallocate(Kl_bsn ) + IF (allocated(theta_a_elm)) deallocate(theta_a_elm) + IF (allocated(zwt_elm )) deallocate(zwt_elm ) + IF (allocated(Kl_elm )) deallocate(Kl_elm ) ENDIF ! Exchange between soil water and aquifer. IF (p_is_worker) THEN - + sp_zi(0) = 0. sp_zi(1:nl_soil) = zi_soi(1:nl_soil) * 1000.0 ! from meter to mm sp_dz(1:nl_soil) = sp_zi(1:nl_soil) - sp_zi(0:nl_soil-1) - + DO ipatch = 1, numpatch #if(defined CoLMDEBUG) - ! For water balance check, the sum of water in soil column before the calculation + ! For water balance check, the sum of water in soil column before the calcultion w_sum_before = sum(wliq_soisno(1:nl_soil,ipatch)) + sum(wice_soisno(1:nl_soil,ipatch)) & + wa(ipatch) + wdsrf(ipatch) + wetwat(ipatch) #endif @@ -579,7 +652,7 @@ SUBROUTINE subsurface_flow (deltime) is_dry_lake = .false. ENDIF - IF ((patchtype(ipatch) <= 1) .or. is_dry_lake) THEN + IF ((patchtype(ipatch) <= 1) .or. is_dry_lake) THEN exwater = xwsub(ipatch) * deltime @@ -611,10 +684,10 @@ SUBROUTINE subsurface_flow (deltime) wresi(ilev) = 0. ENDIF ENDDO - + zwtmm = zwt(ipatch) * 1000. ! m -> mm - ! check consistency between water table location and liquid water content + ! check consistancy between water table location and liquid water content DO ilev = 1, nl_soil IF ((vol_liq(ilev) < eff_porosity(ilev)-1.e-8) .and. (zwtmm <= sp_zi(ilev-1))) THEN zwtmm = sp_zi(ilev) @@ -643,7 +716,7 @@ SUBROUTINE subsurface_flow (deltime) nl_soil, exwater, sp_zi, is_permeable, eff_porosity, vl_r, psi0(:,ipatch), & hksati(:,ipatch), nprms, prms, porsl(nl_soil,ipatch), wdsrf(ipatch), & vol_liq, zwtmm, wa(ipatch), izwt) - + ! update the mass of liquid water DO ilev = nl_soil, 1, -1 IF (is_permeable(ilev)) THEN @@ -682,11 +755,11 @@ SUBROUTINE subsurface_flow (deltime) ENDIF ELSEIF (patchtype(ipatch) == 4) THEN ! land water bodies - + wdsrf(ipatch) = wa(ipatch) + wdsrf(ipatch) - xwsub(ipatch)*deltime IF (wdsrf(ipatch) < 0) THEN - wa (ipatch) = wdsrf(ipatch) + wa (ipatch) = wdsrf(ipatch) wdsrf(ipatch) = 0 ELSE wa(ipatch) = 0 @@ -695,7 +768,7 @@ SUBROUTINE subsurface_flow (deltime) ENDIF #if(defined CoLMDEBUG) - ! For water balance check, the sum of water in soil column after the calculation + ! For water balance check, the sum of water in soil column after the calcultion w_sum_after = sum(wliq_soisno(1:nl_soil,ipatch)) + sum(wice_soisno(1:nl_soil,ipatch)) & + wa(ipatch) + wdsrf(ipatch) + wetwat(ipatch) errblc = w_sum_after - w_sum_before + xwsub(ipatch)*deltime @@ -713,18 +786,26 @@ SUBROUTINE subsurface_flow (deltime) END SUBROUTINE subsurface_flow ! ---------- - SUBROUTINE basin_neighbour_final () + SUBROUTINE subsurface_network_final () IMPLICIT NONE + IF (allocated(lake_id_elm )) deallocate(lake_id_elm ) + IF (allocated(riverdpth_elm)) deallocate(riverdpth_elm) + IF (allocated(lakedepth_elm)) deallocate(lakedepth_elm) + IF (allocated(wdsrf_elm )) deallocate(wdsrf_elm ) + IF (allocated(theta_a_nb)) deallocate(theta_a_nb) IF (allocated(zwt_nb )) deallocate(zwt_nb ) IF (allocated(Kl_nb )) deallocate(Kl_nb ) IF (allocated(wdsrf_nb )) deallocate(wdsrf_nb ) IF (allocated(agwt_nb )) deallocate(agwt_nb ) IF (allocated(islake_nb )) deallocate(islake_nb ) - - END SUBROUTINE basin_neighbour_final + IF (allocated(lakedp_nb )) deallocate(lakedp_nb ) + + IF (associated(hillslope_element)) deallocate(hillslope_element) + + END SUBROUTINE subsurface_network_final END MODULE MOD_Catch_SubsurfaceFlow #endif diff --git a/main/HYDRO/MOD_Catch_Vars_1DFluxes.F90 b/main/HYDRO/MOD_Catch_Vars_1DFluxes.F90 new file mode 100644 index 00000000..e86d29b4 --- /dev/null +++ b/main/HYDRO/MOD_Catch_Vars_1DFluxes.F90 @@ -0,0 +1,106 @@ +#include + +#ifdef CatchLateralFlow +MODULE MOD_Catch_Vars_1DFluxes +!------------------------------------------------------------------------------------- +! DESCRIPTION: +! +! 1D fluxes in lateral hydrological processes. +! +! Created by Shupeng Zhang, May 2023 +!------------------------------------------------------------------------------------- + + USE MOD_Precision + IMPLICIT NONE + + ! -- fluxes -- + real(r8), allocatable :: xsubs_elm (:) ! subsurface lateral flow between basins [m/s] + real(r8), allocatable :: xsubs_hru (:) ! subsurface lateral flow between hydrological response units [m/s] + real(r8), allocatable :: xsubs_pch (:) ! subsurface lateral flow between patches inside one HRU [m/s] + + real(r8), allocatable :: wdsrf_bsn_ta (:) ! time step average of river height [m] + real(r8), allocatable :: momen_riv_ta (:) ! time step average of river momentum [m^2/s] + real(r8), allocatable :: veloc_riv_ta (:) ! time step average of river velocity [m/s] + real(r8), allocatable :: discharge_ta (:) ! river discharge [m^3/s] + + real(r8), allocatable :: wdsrf_bsnhru_ta (:) ! time step average of surface water depth [m] + real(r8), allocatable :: momen_bsnhru_ta (:) ! time step average of surface water momentum [m^2/s] + real(r8), allocatable :: veloc_bsnhru_ta (:) ! time step average of surface water veloctiy [m/s] + + real(r8), allocatable :: xwsur (:) ! surface water exchange [mm h2o/s] + real(r8), allocatable :: xwsub (:) ! subsurface water exchange [mm h2o/s] + + + ! PUBLIC MEMBER FUNCTIONS: + PUBLIC :: allocate_1D_CatchFluxes + PUBLIC :: deallocate_1D_CatchFluxes + +CONTAINS + + SUBROUTINE allocate_1D_CatchFluxes + + USE MOD_SPMD_Task + USE MOD_Vars_Global, only : spval + USE MOD_Mesh, only : numelm + USE MOD_LandHRU, only : numhru + USE MOD_LandPatch, only : numpatch + USE MOD_Catch_BasinNetwork, only : numbasin, numbsnhru + IMPLICIT NONE + + IF (p_is_worker) THEN + + IF (numpatch > 0) THEN + allocate (xsubs_pch (numpatch)) ; xsubs_pch (:) = spval + allocate (xwsur (numpatch)) ; xwsur (:) = spval + allocate (xwsub (numpatch)) ; xwsub (:) = spval + ENDIF + + IF (numelm > 0) THEN + allocate (xsubs_elm (numelm)) ; xsubs_elm(:) = spval + ENDIF + + IF (numbasin > 0) THEN + allocate (wdsrf_bsn_ta (numbasin)) ; wdsrf_bsn_ta (:) = spval + allocate (momen_riv_ta (numbasin)) ; momen_riv_ta (:) = spval + allocate (veloc_riv_ta (numbasin)) ; veloc_riv_ta (:) = spval + allocate (discharge_ta (numbasin)) ; discharge_ta (:) = spval + ENDIF + + IF (numhru > 0) THEN + allocate (xsubs_hru (numhru)); xsubs_hru(:) = spval + ENDIF + + IF (numbsnhru > 0) THEN + allocate (wdsrf_bsnhru_ta (numbsnhru)) ; wdsrf_bsnhru_ta (:) = spval + allocate (momen_bsnhru_ta (numbsnhru)) ; momen_bsnhru_ta (:) = spval + allocate (veloc_bsnhru_ta (numbsnhru)) ; veloc_bsnhru_ta (:) = spval + ENDIF + + ENDIF + + END SUBROUTINE allocate_1D_CatchFluxes + + SUBROUTINE deallocate_1D_CatchFluxes + + IMPLICIT NONE + + IF (allocated(xsubs_elm)) deallocate(xsubs_elm) + IF (allocated(xsubs_hru)) deallocate(xsubs_hru) + IF (allocated(xsubs_pch)) deallocate(xsubs_pch) + + IF (allocated(wdsrf_bsn_ta)) deallocate(wdsrf_bsn_ta) + IF (allocated(momen_riv_ta)) deallocate(momen_riv_ta) + IF (allocated(veloc_riv_ta)) deallocate(veloc_riv_ta) + IF (allocated(discharge_ta)) deallocate(discharge_ta) + + IF (allocated(wdsrf_bsnhru_ta)) deallocate(wdsrf_bsnhru_ta) + IF (allocated(momen_bsnhru_ta)) deallocate(momen_bsnhru_ta) + IF (allocated(veloc_bsnhru_ta)) deallocate(veloc_bsnhru_ta) + + IF (allocated(xwsur)) deallocate(xwsur) + IF (allocated(xwsub)) deallocate(xwsub) + + END SUBROUTINE deallocate_1D_CatchFluxes + +END MODULE MOD_Catch_Vars_1DFluxes +#endif diff --git a/main/MOD_Vars_1DFluxes.F90 b/main/MOD_Vars_1DFluxes.F90 index a2ba5e26..37df916b 100644 --- a/main/MOD_Vars_1DFluxes.F90 +++ b/main/MOD_Vars_1DFluxes.F90 @@ -13,7 +13,7 @@ MODULE MOD_Vars_1DFluxes USE MOD_BGC_Vars_1DFluxes #endif #ifdef CatchLateralFlow - USE MOD_Hydro_Vars_1DFluxes + USE MOD_Catch_Vars_1DFluxes #endif #ifdef URBAN_MODEL USE MOD_Urban_Vars_1DFluxes @@ -57,7 +57,7 @@ MODULE MOD_Vars_1DFluxes real(r8), allocatable :: srniln (:) !reflected diffuse beam nir solar radiation at local noon (W/m2) real(r8), allocatable :: olrg (:) !outgoing long-wave radiation from ground+canopy [W/m2] real(r8), allocatable :: rnet (:) !net radiation by surface [W/m2] - real(r8), allocatable :: xerr (:) !the error of water balance [mm/s] + real(r8), allocatable :: xerr (:) !the error of water banace [mm/s] real(r8), allocatable :: zerr (:) !the error of energy balance [W/m2] real(r8), allocatable :: rsur (:) !surface runoff (mm h2o/s) real(r8), allocatable :: rsur_se(:) !saturation excess surface runoff (mm h2o/s) @@ -65,14 +65,14 @@ MODULE MOD_Vars_1DFluxes real(r8), allocatable :: rsub (:) !subsurface runoff (mm h2o/s) real(r8), allocatable :: rnof (:) !total runoff (mm h2o/s) real(r8), allocatable :: qintr (:) !interception (mm h2o/s) - real(r8), allocatable :: qinfl (:) !infiltration (mm h2o/s) + real(r8), allocatable :: qinfl (:) !inflitration (mm h2o/s) real(r8), allocatable :: qdrip (:) !throughfall (mm h2o/s) real(r8), allocatable :: assim (:) !canopy assimilation rate (mol m-2 s-1) real(r8), allocatable :: respc (:) !canopy respiration (mol m-2 s-1) real(r8), allocatable :: qcharge(:) !groundwater recharge [mm/s] - integer, allocatable :: oroflag(:) + real(r8), allocatable :: oroflag(:) !/ocean(0)/seaice(2) flag integer, parameter :: nsensor = 1 real(r8), allocatable :: sensors(:,:) @@ -136,7 +136,7 @@ SUBROUTINE allocate_1D_Fluxes allocate ( srniln (numpatch) ) ; srniln (:) = spval ! reflected diffuse beam nir solar radiation at local noon(W/m2) allocate ( olrg (numpatch) ) ; olrg (:) = spval ! outgoing long-wave radiation from ground+canopy [W/m2] allocate ( rnet (numpatch) ) ; rnet (:) = spval ! net radiation by surface [W/m2] - allocate ( xerr (numpatch) ) ; xerr (:) = spval ! the error of water balance [mm/s] + allocate ( xerr (numpatch) ) ; xerr (:) = spval ! the error of water banace [mm/s] allocate ( zerr (numpatch) ) ; zerr (:) = spval ! the error of energy balance [W/m2] allocate ( rsur (numpatch) ) ; rsur (:) = spval ! surface runoff (mm h2o/s) @@ -145,14 +145,14 @@ SUBROUTINE allocate_1D_Fluxes allocate ( rsub (numpatch) ) ; rsub (:) = spval ! subsurface runoff (mm h2o/s) allocate ( rnof (numpatch) ) ; rnof (:) = spval ! total runoff (mm h2o/s) allocate ( qintr (numpatch) ) ; qintr (:) = spval ! interception (mm h2o/s) - allocate ( qinfl (numpatch) ) ; qinfl (:) = spval ! infiltration (mm h2o/s) + allocate ( qinfl (numpatch) ) ; qinfl (:) = spval ! inflitration (mm h2o/s) allocate ( qdrip (numpatch) ) ; qdrip (:) = spval ! throughfall (mm h2o/s) allocate ( assim (numpatch) ) ; assim (:) = spval ! canopy assimilation rate (mol m-2 s-1) allocate ( respc (numpatch) ) ; respc (:) = spval ! canopy respiration (mol m-2 s-1) allocate ( qcharge(numpatch) ) ; qcharge(:) = spval ! groundwater recharge [mm/s] - allocate ( oroflag(numpatch) ) ; oroflag(:) = spval_i4 ! + allocate ( oroflag(numpatch) ) ; oroflag(:) = 1.0 ! /ocean(0)/seaice(2) flag allocate ( sensors(nsensor,numpatch) ); sensors(:,:) = spval ! @@ -168,7 +168,7 @@ SUBROUTINE allocate_1D_Fluxes #endif #ifdef CatchLateralFlow - CALL allocate_1D_HydroFluxes + CALL allocate_1D_CatchFluxes #endif #ifdef URBAN_MODEL @@ -221,7 +221,7 @@ SUBROUTINE deallocate_1D_Fluxes () deallocate ( srniln ) ! reflected diffuse beam nir solar radiation at local noon(W/m2) deallocate ( olrg ) ! outgoing long-wave radiation from ground+canopy [W/m2] deallocate ( rnet ) ! net radiation by surface [W/m2] - deallocate ( xerr ) ! the error of water balance [mm/s] + deallocate ( xerr ) ! the error of water banace [mm/s] deallocate ( zerr ) ! the error of energy balance [W/m2] deallocate ( rsur ) ! surface runoff (mm h2o/s) deallocate ( rsur_se ) ! saturation excess surface runoff (mm h2o/s) @@ -229,7 +229,7 @@ SUBROUTINE deallocate_1D_Fluxes () deallocate ( rsub ) ! subsurface runoff (mm h2o/s) deallocate ( rnof ) ! total runoff (mm h2o/s) deallocate ( qintr ) ! interception (mm h2o/s) - deallocate ( qinfl ) ! infiltration (mm h2o/s) + deallocate ( qinfl ) ! inflitration (mm h2o/s) deallocate ( qdrip ) ! throughfall (mm h2o/s) deallocate ( assim ) ! canopy assimilation rate (mol m-2 s-1) deallocate ( respc ) ! canopy respiration (mol m-2 s-1) @@ -252,7 +252,7 @@ SUBROUTINE deallocate_1D_Fluxes () #endif #ifdef CatchLateralFlow - CALL deallocate_1D_HydroFluxes + CALL deallocate_1D_CatchFluxes #endif #ifdef URBAN_MODEL diff --git a/mksrfdata/MOD_HRUVector.F90 b/mksrfdata/MOD_HRUVector.F90 index 1c46370d..a94a73b7 100644 --- a/mksrfdata/MOD_HRUVector.F90 +++ b/mksrfdata/MOD_HRUVector.F90 @@ -1,11 +1,11 @@ #include -#if (defined CATCHMENT) +#if (defined CATCHMENT) MODULE MOD_HRUVector !------------------------------------------------------------------------------------ ! DESCRIPTION: -! +! ! Address of Data associated with HRU. ! ! To output a vector, Data is gathered from worker processes directly to master. @@ -18,17 +18,17 @@ MODULE MOD_HRUVector USE MOD_Precision USE MOD_DataType IMPLICIT NONE - + integer :: totalnumhru type(pointer_int32_1d), allocatable :: hru_data_address (:) integer*8, allocatable :: eindx_hru (:) integer, allocatable :: htype_hru (:) - + CONTAINS - + ! -------- - SUBROUTINE hru_vector_init + SUBROUTINE hru_vector_init USE MOD_SPMD_Task USE MOD_Utils @@ -53,23 +53,23 @@ SUBROUTINE hru_vector_init integer :: ielm, i, ielm_glb integer :: nhru, nelm, hru_dsp_loc - + IF (p_is_worker) THEN - - CALL basin_hru%build (landelm, landhru, use_frac = .true.) + + CALL elm_hru%build (landelm, landhru, use_frac = .true.) CALL hru_patch%build (landhru, landpatch, use_frac = .true.) IF (numelm > 0) THEN allocate (nhru_bsn (numelm)) - nhru_bsn = basin_hru%subend - basin_hru%substt + 1 + nhru_bsn = elm_hru%subend - elm_hru%substt + 1 ENDIF #ifdef USEMPI mesg = (/p_iam_glb, numelm/) - CALL mpi_send (mesg, 2, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) + CALL mpi_send (mesg, 2, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) IF (numelm > 0) THEN - CALL mpi_send (nhru_bsn, numelm, MPI_INTEGER, p_address_master, mpi_tag_data, p_comm_glb, p_err) + CALL mpi_send (nhru_bsn, numelm, MPI_INTEGER, p_address_master, mpi_tag_data, p_comm_glb, p_err) ENDIF #endif ENDIF @@ -94,7 +94,7 @@ SUBROUTINE hru_vector_init mpi_tag_data, p_comm_glb, p_stat, p_err) nhru_bsn_glb(elm_data_address(p_itis_worker(isrc))%val) = rbuff - + IF (sum(rbuff) > 0) THEN allocate(hru_data_address(p_itis_worker(isrc))%val (sum(rbuff))) ENDIF @@ -117,7 +117,7 @@ SUBROUTINE hru_vector_init IF (p_is_master) THEN totalnumhru = sum(nhru_bsn_glb) - + allocate (hru_dsp_glb (totalnumelm)) hru_dsp_glb(1) = 0 DO ielm = 2, totalnumelm @@ -137,19 +137,19 @@ SUBROUTINE hru_vector_init hru_dsp_loc = hru_dsp_loc + nhru ENDIF ENDDO - ENDIF + ENDIF ENDDO ENDIF #ifdef USEMPI CALL mpi_bcast (totalnumhru, 1, MPI_INTEGER, p_address_master, p_comm_glb, p_err) #endif - + #ifdef USEMPI IF (p_is_worker) THEN mesg = (/p_iam_glb, numhru/) - CALL mpi_send (mesg, 2, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) + CALL mpi_send (mesg, 2, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) IF (numhru > 0) THEN - CALL mpi_send (landhru%settyp, numhru, MPI_INTEGER, p_address_master, mpi_tag_data, p_comm_glb, p_err) + CALL mpi_send (landhru%settyp, numhru, MPI_INTEGER, p_address_master, mpi_tag_data, p_comm_glb, p_err) ENDIF ENDIF #endif @@ -178,7 +178,7 @@ SUBROUTINE hru_vector_init CALL mpi_recv (rbuff, ndata, MPI_INTEGER, isrc, & mpi_tag_data, p_comm_glb, p_stat, p_err) htype_hru(hru_data_address(p_itis_worker(isrc))%val) = rbuff - + deallocate(rbuff) ENDIF ENDDO @@ -186,8 +186,8 @@ SUBROUTINE hru_vector_init htype_hru(hru_data_address(0)%val) = landhru%settyp #endif - ! To distinguish between lake HRUs and hillslopes, the program sets the - ! type of lake HRUs as a negative number. + ! To distinguish between lake HRUs and hillslopes, the program sets the + ! type of lake HRUs as a negative number. ! Set it as a positive number for output. htype_hru = abs(htype_hru) @@ -197,7 +197,7 @@ SUBROUTINE hru_vector_init CALL mpi_bcast (totalnumhru, 1, MPI_INTEGER, p_address_master, p_comm_glb, p_err) #endif - END SUBROUTINE hru_vector_init + END SUBROUTINE hru_vector_init ! ---------- SUBROUTINE hru_vector_final () @@ -207,7 +207,7 @@ SUBROUTINE hru_vector_final () IF (allocated(hru_data_address)) deallocate (hru_data_address) IF (allocated(eindx_hru)) deallocate (eindx_hru) IF (allocated(htype_hru)) deallocate (htype_hru) - + END SUBROUTINE hru_vector_final END MODULE MOD_HRUVector From 76a3923904e2dc867c0b29cbc534ac9fe42d4b74 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 12 Feb 2025 15:47:01 +0800 Subject: [PATCH 41/43] Type error fix for MOD_Vars_1DFluxes.F90. --- main/MOD_Vars_1DFluxes.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/main/MOD_Vars_1DFluxes.F90 b/main/MOD_Vars_1DFluxes.F90 index 37df916b..2d496fb6 100644 --- a/main/MOD_Vars_1DFluxes.F90 +++ b/main/MOD_Vars_1DFluxes.F90 @@ -57,7 +57,7 @@ MODULE MOD_Vars_1DFluxes real(r8), allocatable :: srniln (:) !reflected diffuse beam nir solar radiation at local noon (W/m2) real(r8), allocatable :: olrg (:) !outgoing long-wave radiation from ground+canopy [W/m2] real(r8), allocatable :: rnet (:) !net radiation by surface [W/m2] - real(r8), allocatable :: xerr (:) !the error of water banace [mm/s] + real(r8), allocatable :: xerr (:) !the error of water balance [mm/s] real(r8), allocatable :: zerr (:) !the error of energy balance [W/m2] real(r8), allocatable :: rsur (:) !surface runoff (mm h2o/s) real(r8), allocatable :: rsur_se(:) !saturation excess surface runoff (mm h2o/s) @@ -65,7 +65,7 @@ MODULE MOD_Vars_1DFluxes real(r8), allocatable :: rsub (:) !subsurface runoff (mm h2o/s) real(r8), allocatable :: rnof (:) !total runoff (mm h2o/s) real(r8), allocatable :: qintr (:) !interception (mm h2o/s) - real(r8), allocatable :: qinfl (:) !inflitration (mm h2o/s) + real(r8), allocatable :: qinfl (:) !infiltration (mm h2o/s) real(r8), allocatable :: qdrip (:) !throughfall (mm h2o/s) real(r8), allocatable :: assim (:) !canopy assimilation rate (mol m-2 s-1) real(r8), allocatable :: respc (:) !canopy respiration (mol m-2 s-1) @@ -136,7 +136,7 @@ SUBROUTINE allocate_1D_Fluxes allocate ( srniln (numpatch) ) ; srniln (:) = spval ! reflected diffuse beam nir solar radiation at local noon(W/m2) allocate ( olrg (numpatch) ) ; olrg (:) = spval ! outgoing long-wave radiation from ground+canopy [W/m2] allocate ( rnet (numpatch) ) ; rnet (:) = spval ! net radiation by surface [W/m2] - allocate ( xerr (numpatch) ) ; xerr (:) = spval ! the error of water banace [mm/s] + allocate ( xerr (numpatch) ) ; xerr (:) = spval ! the error of water balance [mm/s] allocate ( zerr (numpatch) ) ; zerr (:) = spval ! the error of energy balance [W/m2] allocate ( rsur (numpatch) ) ; rsur (:) = spval ! surface runoff (mm h2o/s) @@ -145,7 +145,7 @@ SUBROUTINE allocate_1D_Fluxes allocate ( rsub (numpatch) ) ; rsub (:) = spval ! subsurface runoff (mm h2o/s) allocate ( rnof (numpatch) ) ; rnof (:) = spval ! total runoff (mm h2o/s) allocate ( qintr (numpatch) ) ; qintr (:) = spval ! interception (mm h2o/s) - allocate ( qinfl (numpatch) ) ; qinfl (:) = spval ! inflitration (mm h2o/s) + allocate ( qinfl (numpatch) ) ; qinfl (:) = spval ! infiltration (mm h2o/s) allocate ( qdrip (numpatch) ) ; qdrip (:) = spval ! throughfall (mm h2o/s) allocate ( assim (numpatch) ) ; assim (:) = spval ! canopy assimilation rate (mol m-2 s-1) allocate ( respc (numpatch) ) ; respc (:) = spval ! canopy respiration (mol m-2 s-1) @@ -221,7 +221,7 @@ SUBROUTINE deallocate_1D_Fluxes () deallocate ( srniln ) ! reflected diffuse beam nir solar radiation at local noon(W/m2) deallocate ( olrg ) ! outgoing long-wave radiation from ground+canopy [W/m2] deallocate ( rnet ) ! net radiation by surface [W/m2] - deallocate ( xerr ) ! the error of water banace [mm/s] + deallocate ( xerr ) ! the error of water balance [mm/s] deallocate ( zerr ) ! the error of energy balance [W/m2] deallocate ( rsur ) ! surface runoff (mm h2o/s) deallocate ( rsur_se ) ! saturation excess surface runoff (mm h2o/s) @@ -229,7 +229,7 @@ SUBROUTINE deallocate_1D_Fluxes () deallocate ( rsub ) ! subsurface runoff (mm h2o/s) deallocate ( rnof ) ! total runoff (mm h2o/s) deallocate ( qintr ) ! interception (mm h2o/s) - deallocate ( qinfl ) ! inflitration (mm h2o/s) + deallocate ( qinfl ) ! infiltration (mm h2o/s) deallocate ( qdrip ) ! throughfall (mm h2o/s) deallocate ( assim ) ! canopy assimilation rate (mol m-2 s-1) deallocate ( respc ) ! canopy respiration (mol m-2 s-1) From d41cd66c24df8382a8dfb0b9ed0dc9c8b70a72c7 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Thu, 13 Feb 2025 11:32:31 +0800 Subject: [PATCH 42/43] Unify annotation Dummy Arguments. --- main/MOD_Qsadv.F90 | 2 +- main/MOD_RainSnowTemp.F90 | 2 +- main/MOD_Runoff.F90 | 4 ++-- main/MOD_SimpleOcean.F90 | 6 +++--- main/MOD_SnowFraction.F90 | 4 ++-- main/MOD_SnowLayersCombineDivide.F90 | 12 ++++++------ main/MOD_SoilSnowHydrology.F90 | 12 ++++++------ main/MOD_SoilSurfaceResistance.F90 | 2 +- main/MOD_Thermal.F90 | 2 +- main/MOD_TurbulenceLEddy.F90 | 2 +- 10 files changed, 24 insertions(+), 24 deletions(-) diff --git a/main/MOD_Qsadv.F90 b/main/MOD_Qsadv.F90 index 8ebb555b..d96405d8 100644 --- a/main/MOD_Qsadv.F90 +++ b/main/MOD_Qsadv.F90 @@ -32,7 +32,7 @@ SUBROUTINE qsadv(T,p,es,esdT,qs,qsdT) USE MOD_Precision IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: T ! temperature (K) real(r8), intent(in) :: p ! surface atmospheric pressure (pa) diff --git a/main/MOD_RainSnowTemp.F90 b/main/MOD_RainSnowTemp.F90 index 85a268b7..061fc61c 100644 --- a/main/MOD_RainSnowTemp.F90 +++ b/main/MOD_RainSnowTemp.F90 @@ -34,7 +34,7 @@ SUBROUTINE rain_snow_temp (patchtype,& IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: patchtype ! land patch type (3=glaciers) real(r8), intent(in) :: forc_t ! temperature at agcm reference height [kelvin] diff --git a/main/MOD_Runoff.F90 b/main/MOD_Runoff.F90 index 83a3ffdf..b352a607 100644 --- a/main/MOD_Runoff.F90 +++ b/main/MOD_Runoff.F90 @@ -36,7 +36,7 @@ SUBROUTINE SurfaceRunoff_SIMTOP (nl_soil,wimp,porsl,psi0,hksati,& IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: nl_soil ! number of soil layers real(r8), intent(in) :: & @@ -95,7 +95,7 @@ SUBROUTINE SubsurfaceRunoff_SIMTOP (nl_soil, icefrac, dz_soisno, zi_soisno, zwt, IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: nl_soil ! real(r8), intent(in) :: icefrac(1:nl_soil) ! ice fraction (-) diff --git a/main/MOD_SimpleOcean.F90 b/main/MOD_SimpleOcean.F90 index e2caac1c..8d5810ad 100644 --- a/main/MOD_SimpleOcean.F90 +++ b/main/MOD_SimpleOcean.F90 @@ -39,7 +39,7 @@ SUBROUTINE socean (dosst,deltim,oro,hu,ht,hq,& USE MOD_Const_Physical, only : tfrz, hvap, hsub, stefnc, vonkar IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, parameter :: psrfty=7 ! Number of surface types integer, parameter :: plsice=4 ! number of seaice levels @@ -199,7 +199,7 @@ SUBROUTINE seafluxes (oro,hu,ht,hq,& USE MOD_Qsadv IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: & oro, &! ocean(0)/seaice(2)/ flag @@ -440,7 +440,7 @@ SUBROUTINE srftsb(isrfty,deltim,fnt,dfntdt,snowh,tsbsf) USE MOD_Utils IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, parameter :: psrfty = 7 ! Number of surface types integer, parameter :: plsice = 4 ! number of seaice levels diff --git a/main/MOD_SnowFraction.F90 b/main/MOD_SnowFraction.F90 index eecbd9af..ff4b8f2c 100644 --- a/main/MOD_SnowFraction.F90 +++ b/main/MOD_SnowFraction.F90 @@ -37,7 +37,7 @@ SUBROUTINE snowfraction (lai,sai,z0m,zlnd,scv,snowdp,wt,sigf,fsno) USE MOD_Precision IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: scv ! snow water equivalent [mm or kg/m3] real(r8), intent(in) :: snowdp ! snow depth [m] real(r8), intent(in) :: z0m ! aerodynamic roughness length [m] @@ -102,7 +102,7 @@ SUBROUTINE snowfraction_pftwrap (ipatch,zlnd,scv,snowdp,wt,sigf,fsno) USE MOD_Vars_PFTimeVariables IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: ipatch ! patch index real(r8), intent(in) :: zlnd ! aerodynamic roughness length over soil surface [m] diff --git a/main/MOD_SnowLayersCombineDivide.F90 b/main/MOD_SnowLayersCombineDivide.F90 index 8767640e..2c9a5dfe 100644 --- a/main/MOD_SnowLayersCombineDivide.F90 +++ b/main/MOD_SnowLayersCombineDivide.F90 @@ -49,7 +49,7 @@ SUBROUTINE snowcompaction (lb,deltim,imelt,fiold,& USE MOD_Const_Physical, only : denice, denh2o, tfrz IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: lb ! lower bound of array real(r8), intent(in) :: deltim ! seconds i a time step [second] @@ -257,7 +257,7 @@ SUBROUTINE snowlayerscombine (lb,snl, & USE MOD_Precision IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: lb ! lower bound of array ! numbering from 1 (bottom) mss (surface) @@ -431,7 +431,7 @@ SUBROUTINE snowlayersdivide (lb,snl,z_soisno,dz_soisno,zi_soisno,wliq_soisno,wic USE MOD_Precision IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: lb ! lower bound of array integer, intent(inout) :: snl ! Number of snow @@ -637,7 +637,7 @@ SUBROUTINE combo ( dz_soisno, wliq_soisno, wice_soisno, t, & USE MOD_Const_Physical, only : cpice, cpliq, hfus, tfrz IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: dz2 ! nodal thickness of 2 elements being combined [m] real(r8), intent(in) :: wliq2 ! liquid water of element 2 [kg/m2] @@ -707,7 +707,7 @@ SUBROUTINE SnowLayersCombine_snicar (lb,snl, & IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: lb ! lower bound of array ! numbering from 1 (bottom) mss (surface) @@ -973,7 +973,7 @@ SUBROUTINE SnowLayersDivide_snicar (lb,snl,z_soisno,dz_soisno,zi_soisno,& IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: lb ! lower bound of array integer, intent(inout) :: snl ! Number of snow diff --git a/main/MOD_SoilSnowHydrology.F90 b/main/MOD_SoilSnowHydrology.F90 index 9ef2f30e..8bbe7afc 100644 --- a/main/MOD_SoilSnowHydrology.F90 +++ b/main/MOD_SoilSnowHydrology.F90 @@ -81,7 +81,7 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & ipatch ,&! patch index patchtype ! land patch type (0=soil, 1=urban or built-up, 2=wetland, @@ -533,7 +533,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & ipatch ,& ! patch index patchtype ! land patch type (0=soil, 1=urban or built-up, 2=wetland, @@ -1158,7 +1158,7 @@ SUBROUTINE snowwater (lb,deltim,ssi,wimp, & USE MOD_Const_Physical, only : denice, denh2o ! physical constant IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & lb ! lower bound of array @@ -1284,7 +1284,7 @@ SUBROUTINE SnowWater_snicar (lb,deltim,ssi,wimp, & real(r8), parameter :: denice = 917.0_r8 ! density of ice [kg/m3] real(r8), parameter :: denh2o = 1000.0_r8 ! density of liquid water [kg/m3] -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & lb ! lower bound of array @@ -1773,7 +1773,7 @@ SUBROUTINE soilwater(patchtype,nl_soil,deltim,wimp,smpmin,& IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer , intent(in) :: patchtype ! land patch type integer , intent(in) :: nl_soil ! number of soil layers real(r8), intent(in) :: deltim ! land model time step (sec) @@ -2072,7 +2072,7 @@ SUBROUTINE groundwater (nl_soil,deltim,pondmx,& USE MOD_Const_Physical, only : tfrz IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer , intent(in) :: nl_soil ! real(r8), intent(in) :: deltim ! land model time step (sec) real(r8), intent(in) :: pondmx ! diff --git a/main/MOD_SoilSurfaceResistance.F90 b/main/MOD_SoilSurfaceResistance.F90 index f523ebeb..db9ef205 100644 --- a/main/MOD_SoilSurfaceResistance.F90 +++ b/main/MOD_SoilSurfaceResistance.F90 @@ -65,7 +65,7 @@ SUBROUTINE SoilSurfaceResistance (nl_soil,forc_rhoair,hksati,porsl,psi0, & USE MOD_Hydro_SoilFunction IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & nl_soil ! upper bound of array diff --git a/main/MOD_Thermal.F90 b/main/MOD_Thermal.F90 index c2b3fc3d..3f72fca4 100644 --- a/main/MOD_Thermal.F90 +++ b/main/MOD_Thermal.F90 @@ -133,7 +133,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- integer, intent(in) :: & ipatch, &! patch index diff --git a/main/MOD_TurbulenceLEddy.F90 b/main/MOD_TurbulenceLEddy.F90 index c9557006..6e809dce 100644 --- a/main/MOD_TurbulenceLEddy.F90 +++ b/main/MOD_TurbulenceLEddy.F90 @@ -46,7 +46,7 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & USE MOD_Const_Physical, only : vonkar IMPLICIT NONE -! ------------------------- Dummy Arguments ---------------------------- +!-------------------------- Dummy Arguments ---------------------------- real(r8), intent(in) :: hu ! observational height of wind [m] real(r8), intent(in) :: ht ! observational height of temperature [m] From cdc20dbcd50313375b194b696aefd52d629bf926 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Thu, 13 Feb 2025 23:09:57 +0800 Subject: [PATCH 43/43] Code indent for MOD_Initialize.F90. --- mkinidata/MOD_Initialize.F90 | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/mkinidata/MOD_Initialize.F90 b/mkinidata/MOD_Initialize.F90 index ab6417dd..48c69ddb 100644 --- a/mkinidata/MOD_Initialize.F90 +++ b/mkinidata/MOD_Initialize.F90 @@ -412,25 +412,25 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & ! ................................ ! 1.6 Initialize TUNABLE constants ! ................................ - zlnd = 0.01 !Roughness length for soil [m] - zsno = 0.0024 !Roughness length for snow [m] - csoilc = 0.004 !Drag coefficient for soil under canopy [-] - dewmx = 0.1 !maximum dew + zlnd = 0.01 !Roughness length for soil [m] + zsno = 0.0024 !Roughness length for snow [m] + csoilc = 0.004 !Drag coefficient for soil under canopy [-] + dewmx = 0.1 !maximum dew ! 'wtfact' is updated to gridded 'fsatmax' data. (by Shupeng Zhang) - ! wtfact = 0.38 !Maximum saturated fraction (global mean; see Niu et al., 2005) - - capr = 0.34 !Tuning factor to turn first layer T into surface T - cnfac = 0.5 !Crank Nicholson factor between 0 and 1 - ssi = 0.033 !Irreducible water saturation of snow - wimp = 0.05 !Water impremeable if porosity less than wimp - pondmx = 10.0 !Ponding depth (mm) - smpmax = -1.5e5 !Wilting point potential in mm - smpmin = -1.e8 !Restriction for min of soil poten. (mm) - smpmax_hr = -2.e2 !Wilting point potential in mm - smpmin_hr = -2.e5 !Restriction for min of soil poten. (mm) - trsmx0 = 2.e-4 !Max transpiration for moist soil+100% veg. [mm/s] - tcrit = 2.5 !critical temp. to determine rain or snow + ! wtfact = 0.38 !Maximum saturated fraction (global mean; see Niu et al., 2005) + + capr = 0.34 !Tuning factor to turn first layer T into surface T + cnfac = 0.5 !Crank Nicholson factor between 0 and 1 + ssi = 0.033 !Irreducible water saturation of snow + wimp = 0.05 !Water impremeable if porosity less than wimp + pondmx = 10.0 !Ponding depth (mm) + smpmax = -1.5e5 !Wilting point potential in mm + smpmin = -1.e8 !Restriction for min of soil poten. (mm) + smpmax_hr = -2.e2 !Wilting point potential in mm + smpmin_hr = -2.e5 !Restriction for min of soil poten. (mm) + trsmx0 = 2.e-4 !Max transpiration for moist soil+100% veg. [mm/s] + tcrit = 2.5 !critical temp. to determine rain or snow wetwatmax = 200.0 !maximum wetland water (mm) ! for SIMTOP model: read saturated fraction parameter data from files. @@ -1397,7 +1397,7 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & ELSEIF (lake_id(i) > 0) THEN wdsrf_bsnhru(hs:he) = lakeinfo(i)%depth0 ENDIF - + veloc_bsnhru(hs:he) = 0. wdsrf_bsnhru_prev(hs:he) = wdsrf_bsnhru(hs:he) ENDDO