diff --git a/CaMa/src/MOD_CaMa_Vars.F90 b/CaMa/src/MOD_CaMa_Vars.F90 index 371c3421..da6d83c7 100644 --- a/CaMa/src/MOD_CaMa_Vars.F90 +++ b/CaMa/src/MOD_CaMa_Vars.F90 @@ -131,7 +131,7 @@ SUBROUTINE allocate_acc_cama_fluxes USE MOD_SPMD_Task !spmd_task - USE MOD_LandPatch, only : numpatch + USE MOD_LandPatch, only: numpatch USE MOD_Vars_Global IMPLICIT NONE @@ -160,7 +160,7 @@ SUBROUTINE deallocate_acc_cama_fluxes() ! 2020.10.21 Zhongwang Wei @ SYSU USE MOD_SPMD_Task - USE MOD_LandPatch, only : numpatch + USE MOD_LandPatch, only: numpatch IMPLICIT NONE @@ -220,8 +220,8 @@ SUBROUTINE accumulate_cama_fluxes USE MOD_Precision USE MOD_SPMD_Task - USE MOD_Vars_1DFluxes, only : rnof - USE MOD_LandPatch, only : numpatch + USE MOD_Vars_1DFluxes, only: rnof + USE MOD_LandPatch, only: numpatch IMPLICIT NONE @@ -564,8 +564,8 @@ SUBROUTINE colm2cama_real8 (WorkerVar, IOVar, MasterVar) USE MOD_Block USE MOD_DataType USE MOD_LandPatch - USE MOD_Vars_TimeInvariants, only : patchtype - USE MOD_Forcing, only : forcmask_pch + USE MOD_Vars_TimeInvariants, only: patchtype + USE MOD_Forcing, only: forcmask_pch IMPLICIT NONE @@ -706,7 +706,7 @@ SUBROUTINE cama2colm_real8 (MasterVar, IOVar, WorkerVar) USE MOD_Block USE MOD_DataType USE MOD_LandPatch - USE MOD_Vars_TimeInvariants, only : patchtype + USE MOD_Vars_TimeInvariants, only: patchtype USE MOD_Grid IMPLICIT NONE diff --git a/CaMa/src/MOD_CaMa_colmCaMa.F90 b/CaMa/src/MOD_CaMa_colmCaMa.F90 index 28ece200..ed58a93d 100644 --- a/CaMa/src/MOD_CaMa_colmCaMa.F90 +++ b/CaMa/src/MOD_CaMa_colmCaMa.F90 @@ -453,7 +453,7 @@ SUBROUTINE get_fldevp (hu,ht,hq,us,vs,tm,qm,rhoair,psrf,tssea,& ! 2002.08.30 Yongjiu Dai @ BNU ! 1999.09.15 Yongjiu Dai @ BNU USE MOD_Precision - USE MOD_Const_Physical, only : cpair,rgas,vonkar,grav + USE MOD_Const_Physical, only: cpair,rgas,vonkar,grav USE MOD_FrictionVelocity USE MOD_TurbulenceLEddy IMPLICIT NONE diff --git a/main/BGC/MOD_BGC_CNAnnualUpdate.F90 b/main/BGC/MOD_BGC_CNAnnualUpdate.F90 index 3ac542ac..456915e9 100644 --- a/main/BGC/MOD_BGC_CNAnnualUpdate.F90 +++ b/main/BGC/MOD_BGC_CNAnnualUpdate.F90 @@ -16,7 +16,7 @@ MODULE MOD_BGC_CNAnnualUpdate ! !ORIGINAL: ! The Community Land Model version 5.0 (CLM5.0) -! !REFERENCE: +! !REFERENCES: ! Lawrence, D.M., Fisher, R.A., Koven, C.D., Oleson, K.W., Swenson, S.C., Bonan, G., Collier, N., ! Ghimire, B., van Kampenhout, L., Kennedy, D. and Kluzek, E., 2019. ! The Community Land Model version 5: Description of new features, benchmarking, diff --git a/main/BGC/MOD_BGC_CNBalanceCheck.F90 b/main/BGC/MOD_BGC_CNBalanceCheck.F90 index 02a3c6dd..eddf5596 100644 --- a/main/BGC/MOD_BGC_CNBalanceCheck.F90 +++ b/main/BGC/MOD_BGC_CNBalanceCheck.F90 @@ -15,7 +15,7 @@ MODULE MOD_BGC_CNBalanceCheck ! Xingjie Lu, 2022, modify original CLM5 to be compatible with CoLM code structure. USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_NITRIF + USE MOD_Namelist, only: DEF_USE_NITRIF USE MOD_BGC_Vars_TimeVariables, only: & sminn, col_endcb, col_begcb, totcolc, col_endnb, col_begnb, totcoln, & col_vegbegcb, totvegc, ctrunc_veg, col_vegbegnb, totvegn, ntrunc_veg, & diff --git a/main/BGC/MOD_BGC_CNCStateUpdate1.F90 b/main/BGC/MOD_BGC_CNCStateUpdate1.F90 index 5434dc90..24f7bd67 100644 --- a/main/BGC/MOD_BGC_CNCStateUpdate1.F90 +++ b/main/BGC/MOD_BGC_CNCStateUpdate1.F90 @@ -19,7 +19,7 @@ MODULE MOD_BGC_CNCStateUpdate1 ! 3) Record the accumulated decomposition-associated C transfer for soil C semi-analytic spinup USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_SASU, DEF_USE_DiagMatrix + USE MOD_Namelist, only: DEF_USE_SASU, DEF_USE_DiagMatrix USE MOD_Vars_PFTimeInvariants, only: pftclass, pftfrac USE MOD_Const_PFT, only: woody USE MOD_BGC_Vars_TimeInvariants, only: & diff --git a/main/BGC/MOD_BGC_CNCStateUpdate2.F90 b/main/BGC/MOD_BGC_CNCStateUpdate2.F90 index 7ba10fd6..25fee8e9 100644 --- a/main/BGC/MOD_BGC_CNCStateUpdate2.F90 +++ b/main/BGC/MOD_BGC_CNCStateUpdate2.F90 @@ -17,7 +17,7 @@ MODULE MOD_BGC_CNCStateUpdate2 ! 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_Namelist, only: DEF_USE_SASU, DEF_USE_DiagMatrix USE MOD_Vars_TimeInvariants, only: & i_met_lit,i_cel_lit,i_lig_lit ,i_cwd USE MOD_Vars_TimeVariables, only: & diff --git a/main/BGC/MOD_BGC_CNNStateUpdate1.F90 b/main/BGC/MOD_BGC_CNNStateUpdate1.F90 index 989a982e..ed3f03d9 100644 --- a/main/BGC/MOD_BGC_CNNStateUpdate1.F90 +++ b/main/BGC/MOD_BGC_CNNStateUpdate1.F90 @@ -20,7 +20,7 @@ MODULE MOD_BGC_CNNStateUpdate1 USE MOD_Precision USE MOD_Vars_PFTimeInvariants, only: pftclass USE MOD_Const_PFT, only: woody - USE MOD_Namelist, only : DEF_USE_SASU + USE MOD_Namelist, only: DEF_USE_SASU 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 diff --git a/main/BGC/MOD_BGC_CNNStateUpdate2.F90 b/main/BGC/MOD_BGC_CNNStateUpdate2.F90 index f8876112..d44a47e0 100644 --- a/main/BGC/MOD_BGC_CNNStateUpdate2.F90 +++ b/main/BGC/MOD_BGC_CNNStateUpdate2.F90 @@ -16,7 +16,7 @@ MODULE MOD_BGC_CNNStateUpdate2 ! 2) Record the accumulated gap-mortality-associated N transfers for veg and soil N semi-analytic spinup USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_SASU, DEF_USE_DiagMatrix + USE MOD_Namelist, only: DEF_USE_SASU, DEF_USE_DiagMatrix USE MOD_BGC_Vars_TimeInvariants, only: & i_met_lit,i_cel_lit,i_lig_lit ,i_cwd, i_soil1, i_soil2,i_soil3 USE MOD_BGC_Vars_TimeVariables, only: & diff --git a/main/BGC/MOD_BGC_CNNStateUpdate3.F90 b/main/BGC/MOD_BGC_CNNStateUpdate3.F90 index df531571..eff81d74 100644 --- a/main/BGC/MOD_BGC_CNNStateUpdate3.F90 +++ b/main/BGC/MOD_BGC_CNNStateUpdate3.F90 @@ -17,7 +17,7 @@ MODULE MOD_BGC_CNNStateUpdate3 ! 2) Record accumulated fire-associated N transfers for veg and soil N semi-analytic spinup USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_NITRIF, DEF_USE_FIRE + USE MOD_Namelist, only: DEF_USE_NITRIF, DEF_USE_FIRE USE MOD_BGC_Vars_TimeInvariants, only: & i_met_lit,i_cel_lit,i_lig_lit ,i_cwd, i_soil1, i_soil2, i_soil3 USE MOD_BGC_Vars_TimeVariables, only: & diff --git a/main/BGC/MOD_BGC_CNSASU.F90 b/main/BGC/MOD_BGC_CNSASU.F90 index cdf1f735..8ff1a7e0 100644 --- a/main/BGC/MOD_BGC_CNSASU.F90 +++ b/main/BGC/MOD_BGC_CNSASU.F90 @@ -19,7 +19,7 @@ MODULE MOD_BGC_CNSASU ! !ORIGINAL: ! The Community Land Model version 5.1 (CLM5.1) unreleased version developed by Xingjie Lu ! -! !REFERENCE: +! !REFERENCES: ! Lu, X., Du, Z., Huang, Y., Lawrence, D., Kluzek, E., Collier, N., Lombardozzi, D., Sobhani, N., Schuur, E.A. and Luo, Y., 2020. ! Full implementation of matrix approach to biogeochemistry MODULE of CLM5. Journal of Advances in Modeling Earth Systems, 12(11), e2020MS002105. ! Liao, C., Lu, X., Huang Y., Tao F., Lawrence, D., Koven C., Oleson, K., Wieder, W., Kluzek, E., Huang, X., Luo, Y. (in submission) @@ -30,7 +30,7 @@ MODULE MOD_BGC_CNSASU ! USE accumulated transfer fluxes to calculate the matrix. USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_SASU, DEF_USE_DiagMatrix + USE MOD_Namelist, only: DEF_USE_SASU, DEF_USE_DiagMatrix USE MOD_BGC_Vars_TimeInvariants, only: & i_met_lit, i_cel_lit, i_lig_lit, i_cwd, i_soil1, i_soil2, i_soil3, floating_cn_ratio diff --git a/main/BGC/MOD_BGC_CNSummary.F90 b/main/BGC/MOD_BGC_CNSummary.F90 index 96ed2b45..0e251615 100644 --- a/main/BGC/MOD_BGC_CNSummary.F90 +++ b/main/BGC/MOD_BGC_CNSummary.F90 @@ -16,9 +16,9 @@ MODULE MOD_BGC_CNSummary ! Xingjie Lu, 2022, modify original CLM5 to be compatible with CoLM code structure. USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_NITRIF, DEF_USE_DiagMatrix + USE MOD_Namelist, only: DEF_USE_NITRIF, DEF_USE_DiagMatrix USE MOD_Vars_PFTimeInvariants, only: pftclass - USE MOD_Vars_PFTimeVariables, only :irrig_method_p + USE MOD_Vars_PFTimeVariables, only:irrig_method_p USE MOD_BGC_Vars_TimeVariables, only: & totlitc, totsomc, totcwdc, decomp_cpools, decomp_cpools_vr, ctrunc_soil,ctrunc_veg, ctrunc_vr, & totlitn, totsomn, totcwdn, decomp_npools, decomp_npools_vr, ntrunc_soil,ntrunc_veg, ntrunc_vr, & @@ -114,8 +114,8 @@ MODULE MOD_BGC_CNSummary USE MOD_Vars_TimeVariables, only: & irrig_method_corn , irrig_method_swheat, irrig_method_wwheat, irrig_method_soybean , & irrig_method_cotton, irrig_method_rice1 , irrig_method_rice2 , irrig_method_sugarcane - USE MOD_Vars_TimeInvariants, only : patchclass - USE MOD_Vars_Global, only : spval + USE MOD_Vars_TimeInvariants, only: patchclass + USE MOD_Vars_Global, only: spval USE MOD_SPMD_Task IMPLICIT NONE diff --git a/main/BGC/MOD_BGC_CNZeroFluxes.F90 b/main/BGC/MOD_BGC_CNZeroFluxes.F90 index eeb56b66..92ab2292 100644 --- a/main/BGC/MOD_BGC_CNZeroFluxes.F90 +++ b/main/BGC/MOD_BGC_CNZeroFluxes.F90 @@ -14,7 +14,7 @@ MODULE MOD_BGC_CNZeroFluxes ! Xingjie Lu, 2022, modify original CLM5 to be compatible with CoLM code structure. USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_NITRIF + USE MOD_Namelist, only: DEF_USE_NITRIF USE MOD_BGC_Vars_1DPFTFluxes, only: & m_leafc_to_litter_p , & diff --git a/main/BGC/MOD_BGC_Soil_BiogeochemCompetition.F90 b/main/BGC/MOD_BGC_Soil_BiogeochemCompetition.F90 index 294bd468..cc58b73a 100644 --- a/main/BGC/MOD_BGC_Soil_BiogeochemCompetition.F90 +++ b/main/BGC/MOD_BGC_Soil_BiogeochemCompetition.F90 @@ -14,7 +14,7 @@ MODULE MOD_BGC_Soil_BiogeochemCompetition ! Xingjie Lu, 2022, modify original CLM5 to be compatible with CoLM code structure. USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_NITRIF + USE MOD_Namelist, only: DEF_USE_NITRIF USE MOD_BGC_Vars_1DFluxes, only: & pot_f_nit_vr, potential_immob_vr, sminn_to_plant_vr, sminn_to_denit_excess_vr, plant_ndemand, & actual_immob_vr, sminn_to_plant, pot_f_nit_vr, actual_immob_nh4_vr, f_nit_vr, & diff --git a/main/BGC/MOD_BGC_Soil_BiogeochemDecomp.F90 b/main/BGC/MOD_BGC_Soil_BiogeochemDecomp.F90 index 1f6438b5..0ba34efc 100644 --- a/main/BGC/MOD_BGC_Soil_BiogeochemDecomp.F90 +++ b/main/BGC/MOD_BGC_Soil_BiogeochemDecomp.F90 @@ -16,7 +16,7 @@ MODULE MOD_BGC_Soil_BiogeochemDecomp ! Xingjie Lu, 2021, revised original CLM5 code to be compatible with CoLM code structure. USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_NITRIF + 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 diff --git a/main/BGC/MOD_BGC_Soil_BiogeochemDecompCascadeBGC.F90 b/main/BGC/MOD_BGC_Soil_BiogeochemDecompCascadeBGC.F90 index bfef9dde..43f09cb3 100644 --- a/main/BGC/MOD_BGC_Soil_BiogeochemDecompCascadeBGC.F90 +++ b/main/BGC/MOD_BGC_Soil_BiogeochemDecompCascadeBGC.F90 @@ -6,7 +6,7 @@ MODULE MOD_BGC_Soil_BiogeochemDecompCascadeBGC ! !DESCRIPTION: ! Calculate the soil decomposition rate according to soil temperature, soil matric potential, and depth ! -! !REFERENCE: +! !REFERENCES: ! 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. diff --git a/main/BGC/MOD_BGC_Soil_BiogeochemLittVertTransp.F90 b/main/BGC/MOD_BGC_Soil_BiogeochemLittVertTransp.F90 index 1491c460..95ad0f4b 100644 --- a/main/BGC/MOD_BGC_Soil_BiogeochemLittVertTransp.F90 +++ b/main/BGC/MOD_BGC_Soil_BiogeochemLittVertTransp.F90 @@ -7,7 +7,7 @@ MODULE MOD_BGC_Soil_BiogeochemLittVertTransp ! 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: +! !REFERENCES: ! 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. @@ -24,7 +24,7 @@ MODULE MOD_BGC_Soil_BiogeochemLittVertTransp ! 2) Record accumulated organic CN vertical transfer rates for semi-analytic spin-up. USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_SASU, DEF_USE_DiagMatrix + USE MOD_Namelist, only: DEF_USE_SASU, DEF_USE_DiagMatrix USE MOD_BGC_Vars_TimeInvariants, only: & is_cwd, som_adv_flux, som_diffus, cryoturb_diffusion_k, max_altdepth_cryoturbation, max_depth_cryoturb USE MOD_BGC_Vars_TimeVariables, only: & diff --git a/main/BGC/MOD_BGC_Soil_BiogeochemNLeaching.F90 b/main/BGC/MOD_BGC_Soil_BiogeochemNLeaching.F90 index 96555f91..28da6444 100644 --- a/main/BGC/MOD_BGC_Soil_BiogeochemNLeaching.F90 +++ b/main/BGC/MOD_BGC_Soil_BiogeochemNLeaching.F90 @@ -15,7 +15,7 @@ MODULE MOD_BGC_Soil_BiogeochemNLeaching ! Xingjie Lu, 2021, revised original CLM5 code to be compatible with CoLM code structure. USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_NITRIF + USE MOD_Namelist, only: DEF_USE_NITRIF USE MOD_BGC_Vars_TimeInvariants, only: sf, sf_no3 USE MOD_Vars_TimeVariables, only: wliq_soisno USE MOD_BGC_Vars_TimeVariables, only: sminn_vr, smin_no3_vr diff --git a/main/BGC/MOD_BGC_Soil_BiogeochemNStateUpdate1.F90 b/main/BGC/MOD_BGC_Soil_BiogeochemNStateUpdate1.F90 index 5161f5e0..aa07e6c7 100644 --- a/main/BGC/MOD_BGC_Soil_BiogeochemNStateUpdate1.F90 +++ b/main/BGC/MOD_BGC_Soil_BiogeochemNStateUpdate1.F90 @@ -19,7 +19,7 @@ MODULE MOD_BGC_Soil_BiogeochemNStateUpdate1 ! 2) Record accumulated nitrogen transfer network for semi-analytic spinup USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_SASU, DEF_USE_DiagMatrix, DEF_USE_NITRIF, DEF_USE_CNSOYFIXN + USE MOD_Namelist, only: DEF_USE_SASU, DEF_USE_DiagMatrix, DEF_USE_NITRIF, DEF_USE_CNSOYFIXN USE MOD_BGC_Vars_TimeInvariants, only: & ! bgc constants i_met_lit, i_cel_lit, i_lig_lit, i_cwd, i_soil1, i_soil2, i_soil3 diff --git a/main/BGC/MOD_BGC_Soil_BiogeochemNitrifDenitrif.F90 b/main/BGC/MOD_BGC_Soil_BiogeochemNitrifDenitrif.F90 index eba27c6d..d308a4ab 100644 --- a/main/BGC/MOD_BGC_Soil_BiogeochemNitrifDenitrif.F90 +++ b/main/BGC/MOD_BGC_Soil_BiogeochemNitrifDenitrif.F90 @@ -6,7 +6,7 @@ MODULE MOD_BGC_Soil_BiogeochemNitrifDenitrif ! !DESCRIPTION: ! Calculate the potential nitrification and dentrification rate. ! -! !REFERENCE: +! !REFERENCES: ! Parton, W. et al. 1996. Generalized model for N2 and N2O production from nitrification and ! denitrification. Global Biogeochemical Cycles 10(3):401-412. ! Parton, W.J. et al. 2001. Generalized model for NOx and N2O emissions from soils. J. Geophys. Res. @@ -19,8 +19,8 @@ MODULE MOD_BGC_Soil_BiogeochemNitrifDenitrif ! Xingjie Lu, 2021, revised original CLM5 code to be compatible with CoLM code structure. USE MOD_Precision - USE MOD_Const_Physical, only : denice, denh2o, tfrz - USE MOD_Vars_TimeVariables, only : t_soisno, wliq_soisno, wice_soisno, t_scalar, w_scalar, smp + USE MOD_Const_Physical, only: denice, denh2o, tfrz + USE MOD_Vars_TimeVariables, only: t_soisno, wliq_soisno, wice_soisno, t_scalar, w_scalar, smp USE MOD_Vars_TimeInvariants, only: & porsl, wfc, bsw, BD_all, OM_density diff --git a/main/BGC/MOD_BGC_Soil_BiogeochemPotential.F90 b/main/BGC/MOD_BGC_Soil_BiogeochemPotential.F90 index 9865e363..e65bdc21 100644 --- a/main/BGC/MOD_BGC_Soil_BiogeochemPotential.F90 +++ b/main/BGC/MOD_BGC_Soil_BiogeochemPotential.F90 @@ -11,7 +11,7 @@ MODULE MOD_BGC_Soil_BiogeochemPotential ! 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: +! !REFERENCES: ! 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. diff --git a/main/BGC/MOD_BGC_Vars_PFTimeVariables.F90 b/main/BGC/MOD_BGC_Vars_PFTimeVariables.F90 index d087050e..2b3de4b5 100644 --- a/main/BGC/MOD_BGC_Vars_PFTimeVariables.F90 +++ b/main/BGC/MOD_BGC_Vars_PFTimeVariables.F90 @@ -15,7 +15,7 @@ MODULE MOD_BGC_Vars_PFTimeVariables #ifdef BGC USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_SASU, DEF_USE_DiagMatrix + USE MOD_Namelist, only: DEF_USE_SASU, DEF_USE_DiagMatrix USE MOD_TimeManager IMPLICIT NONE @@ -1245,7 +1245,7 @@ END SUBROUTINE READ_BGCPFTimeVariables SUBROUTINE WRITE_BGCPFTimeVariables (file_restart) - USE MOD_Namelist, only : DEF_REST_CompressLevel + USE MOD_Namelist, only: DEF_REST_CompressLevel USE MOD_LandPFT USE MOD_NetCDFVector USE MOD_Vars_Global diff --git a/main/BGC/MOD_BGC_Vars_TimeInvariants.F90 b/main/BGC/MOD_BGC_Vars_TimeInvariants.F90 index 8c1c1dfe..589e4b99 100644 --- a/main/BGC/MOD_BGC_Vars_TimeInvariants.F90 +++ b/main/BGC/MOD_BGC_Vars_TimeInvariants.F90 @@ -144,7 +144,7 @@ SUBROUTINE allocate_BGCTimeInvariants () USE MOD_Precision USE MOD_Vars_Global, only: nl_soil, ndecomp_transitions, ndecomp_pools, spval_i4, spval USE MOD_SPMD_Task - USE MOD_LandPatch, only : numpatch + USE MOD_LandPatch, only: numpatch IMPLICIT NONE IF (p_is_worker) THEN @@ -311,7 +311,7 @@ SUBROUTINE WRITE_BGCTimeInvariants (file_restart) ! Original version: Yongjiu Dai, September 15, 1999, 03/2014 !======================================================================= - USE MOD_Namelist, only : DEF_REST_CompressLevel + USE MOD_Namelist, only: DEF_REST_CompressLevel USE MOD_SPMD_Task USE MOD_NetCDFSerial USE MOD_NetCDFVector @@ -457,7 +457,7 @@ END SUBROUTINE WRITE_BGCTimeInvariants SUBROUTINE deallocate_BGCTimeInvariants () USE MOD_SPMD_Task - USE MOD_LandPatch, only : numpatch + USE MOD_LandPatch, only: numpatch IMPLICIT NONE ! -------------------------------------------------- diff --git a/main/BGC/MOD_BGC_Vars_TimeVariables.F90 b/main/BGC/MOD_BGC_Vars_TimeVariables.F90 index d7a2996a..cd24fa07 100644 --- a/main/BGC/MOD_BGC_Vars_TimeVariables.F90 +++ b/main/BGC/MOD_BGC_Vars_TimeVariables.F90 @@ -11,7 +11,7 @@ MODULE MOD_BGC_Vars_TimeVariables ! Xingjie Lu, 2022, created the original version USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_SASU, DEF_USE_DiagMatrix + USE MOD_Namelist, only: DEF_USE_SASU, DEF_USE_DiagMatrix USE MOD_TimeManager IMPLICIT NONE SAVE @@ -317,7 +317,7 @@ SUBROUTINE allocate_BGCTimeVariables USE MOD_Precision USE MOD_Vars_Global USE MOD_SPMD_Task - USE MOD_LandPatch, only : numpatch + USE MOD_LandPatch, only: numpatch IMPLICIT NONE @@ -608,7 +608,7 @@ END SUBROUTINE allocate_BGCTimeVariables SUBROUTINE deallocate_BGCTimeVariables () USE MOD_SPMD_Task - USE MOD_LandPatch, only : numpatch + USE MOD_LandPatch, only: numpatch IMPLICIT NONE ! -------------------------------------------------- @@ -904,7 +904,7 @@ SUBROUTINE WRITE_BGCTimeVariables (file_restart) ! Original version: Yongjiu Dai, September 15, 1999, 03/2014 !======================================================================= - USE MOD_Namelist, only : DEF_REST_CompressLevel, DEF_USE_NITRIF + USE MOD_Namelist, only: DEF_REST_CompressLevel, DEF_USE_NITRIF USE MOD_LandPatch USE MOD_NetCDFVector USE MOD_Vars_Global @@ -1232,7 +1232,7 @@ SUBROUTINE check_BGCTimeVariables () USE MOD_SPMD_Task USE MOD_RangeCheck - USE MOD_Namelist, only : DEF_USE_NITRIF, DEF_USE_SASU, DEF_USE_DiagMatrix + USE MOD_Namelist, only: DEF_USE_NITRIF, DEF_USE_SASU, DEF_USE_DiagMatrix IMPLICIT NONE diff --git a/main/BGC/MOD_BGC_Veg_CNFireBase.F90 b/main/BGC/MOD_BGC_Veg_CNFireBase.F90 index 9cbdbbad..019addf7 100644 --- a/main/BGC/MOD_BGC_Veg_CNFireBase.F90 +++ b/main/BGC/MOD_BGC_Veg_CNFireBase.F90 @@ -7,7 +7,7 @@ MODULE MOD_BGC_Veg_CNFireBase ! 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: +! !REFERENCES: ! Li, F., Levis, S., and Ward, D. S. 2013a. Quantifying the role of fire in the Earth system – Part 1: Improved global fire ! modeling in the Community Earth System Model (CESM1). Biogeosciences 10:2293-2314. ! Li, F., and Lawrence, D. 2017. Role of fire in the global land water budget during the 20th century through changing diff --git a/main/BGC/MOD_BGC_Veg_CNFireLi2016.F90 b/main/BGC/MOD_BGC_Veg_CNFireLi2016.F90 index d458cf15..aba820a8 100644 --- a/main/BGC/MOD_BGC_Veg_CNFireLi2016.F90 +++ b/main/BGC/MOD_BGC_Veg_CNFireLi2016.F90 @@ -7,7 +7,7 @@ MODULE MOD_BGC_Veg_CNFireLi2016 ! This module calculate burned area of each fire. The burned area is used to calculate fire induced CN loss rates ! in bgc_veg_CNFireBaseMod.F90 ! -! !REFERENCE: +! !REFERENCES: ! Li, F., Levis, S., and Ward, D. S. 2013a. Quantifying the role of fire in the Earth system – Part 1: Improved global fire ! modeling in the Community Earth System Model (CESM1). Biogeosciences 10:2293-2314. ! Li, F., and Lawrence, D. 2017. Role of fire in the global land water budget during the 20th century through changing diff --git a/main/BGC/MOD_BGC_Veg_CNGResp.F90 b/main/BGC/MOD_BGC_Veg_CNGResp.F90 index 4623f5d0..d2a044b4 100644 --- a/main/BGC/MOD_BGC_Veg_CNGResp.F90 +++ b/main/BGC/MOD_BGC_Veg_CNGResp.F90 @@ -6,7 +6,7 @@ MODULE MOD_BGC_Veg_CNGResp ! !DESCRIPTION: ! This module calculate growth respiration rate. ! -! !REFERENCE: +! !REFERENCES: ! 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. diff --git a/main/BGC/MOD_BGC_Veg_CNMResp.F90 b/main/BGC/MOD_BGC_Veg_CNMResp.F90 index 302ae098..bf4a939c 100644 --- a/main/BGC/MOD_BGC_Veg_CNMResp.F90 +++ b/main/BGC/MOD_BGC_Veg_CNMResp.F90 @@ -6,7 +6,7 @@ MODULE MOD_BGC_Veg_CNMResp ! !DESCRIPTION: ! This module calculates plant maintenance respiration ! -! !REFERENCE: +! !REFERENCES: ! Atkin OK, Bloomfield KJ, Reich PB, Tjoelker MG, Asner GP, Bonal D et al (2015) Global variability in leaf respiration ! in relation to climate, plant functional types and leaf traits. New Phytologist 206:614–636 ! diff --git a/main/BGC/MOD_BGC_Veg_CNNDynamics.F90 b/main/BGC/MOD_BGC_Veg_CNNDynamics.F90 index 9f3c3fec..a880144b 100644 --- a/main/BGC/MOD_BGC_Veg_CNNDynamics.F90 +++ b/main/BGC/MOD_BGC_Veg_CNNDynamics.F90 @@ -7,7 +7,7 @@ MODULE MOD_BGC_Veg_CNNDynamics ! 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: +! !REFERENCES: ! Cleveland, C.C., Townsend, A.R., Schimel, D.S., Fisher, H., Howarth, R.W., Hedin, L.O., Perakis, S.S., Latty, E.F., ! Von Fischer, J.C., Elseroad, A., and Wasson, M.F. 1999. Global patterns of terrestrial biological nitrogen (N2) fixation ! in natural ecosystems. Global Biogeochem. Cycles 13:623-645. diff --git a/main/BGC/MOD_BGC_Veg_CNPhenology.F90 b/main/BGC/MOD_BGC_Veg_CNPhenology.F90 index 220c603c..a400bf90 100644 --- a/main/BGC/MOD_BGC_Veg_CNPhenology.F90 +++ b/main/BGC/MOD_BGC_Veg_CNPhenology.F90 @@ -129,7 +129,7 @@ MODULE MOD_BGC_Veg_CNPhenology USE MOD_TimeManager USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_FERT + USE MOD_Namelist, only: DEF_USE_FERT USE MOD_BGC_Daylength, only: daylength USE MOD_SPMD_Task diff --git a/main/BGC/MOD_BGC_Veg_CNVegStructUpdate.F90 b/main/BGC/MOD_BGC_Veg_CNVegStructUpdate.F90 index 54c22971..a29b96ae 100644 --- a/main/BGC/MOD_BGC_Veg_CNVegStructUpdate.F90 +++ b/main/BGC/MOD_BGC_Veg_CNVegStructUpdate.F90 @@ -28,7 +28,7 @@ MODULE MOD_BGC_Veg_CNVegStructUpdate #endif USE MOD_Vars_PFTimeInvariants, only: pftclass, pftfrac USE MOD_BGC_Vars_TimeVariables, only: farea_burned - USE MOD_Const_PFT, only : dsladlai, slatop, laimx, woody + USE MOD_Const_PFT, only: dsladlai, slatop, laimx, woody !CLM5 PUBLIC :: CNVegStructUpdate !----------------------------------------------------------------------- diff --git a/main/BGC/MOD_BGC_driver.F90 b/main/BGC/MOD_BGC_driver.F90 index dcc393e8..c37c207e 100644 --- a/main/BGC/MOD_BGC_driver.F90 +++ b/main/BGC/MOD_BGC_driver.F90 @@ -13,7 +13,7 @@ SUBROUTINE bgc_driver (i,idate,deltim,dlat,dlon) ! !ORIGINAL: ! The Community Land Model version 5.0 (CLM5.0) ! -! !REFERENCE: +! !REFERENCES: ! Lawrence, D.M., Fisher, R.A., Koven, C.D., Oleson, K.W., Swenson, S.C., Bonan, G., Collier, N., ! Ghimire, B., van Kampenhout, L., Kennedy, D. and Kluzek, E., 2019. ! The Community Land Model version 5: Description of new features, benchmarking, @@ -24,8 +24,8 @@ SUBROUTINE bgc_driver (i,idate,deltim,dlat,dlon) USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_SASU, DEF_USE_DiagMatrix, DEF_USE_NITRIF, DEF_USE_CNSOYFIXN, DEF_USE_FIRE, DEF_USE_IRRIGATION - USE MOD_Const_Physical, only : tfrz, denh2o, denice + USE MOD_Namelist, only: DEF_USE_SASU, DEF_USE_DiagMatrix, DEF_USE_NITRIF, DEF_USE_CNSOYFIXN, DEF_USE_FIRE, DEF_USE_IRRIGATION + USE MOD_Const_Physical, only: tfrz, denh2o, denice USE MOD_Vars_PFTimeInvariants, only: pftfrac USE MOD_LandPFT, only: patch_pft_s, patch_pft_e USE MOD_BGC_Vars_1DFluxes, only: plant_ndemand, ndep_to_sminn diff --git a/main/CoLM.F90 b/main/CoLM.F90 index 925a1095..62ce573b 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 Group 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. ! @@ -212,8 +212,8 @@ PROGRAM CoLM pdate(1) = p_year; pdate(2) = p_julian; pdate(3) = p_seconds CALL Init_GlobalVars - CAll Init_LC_Const - CAll Init_PFT_Const + CALL Init_LC_Const + CALL Init_PFT_Const CALL pixel%load_from_file (dir_landdata) CALL gblock%load_from_file (dir_landdata) @@ -435,7 +435,7 @@ PROGRAM CoLM #endif - ! Call colm driver + ! Call CoLM driver ! ---------------------------------------------------------------------- IF (p_is_worker) THEN CALL CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oroflag) @@ -460,7 +460,7 @@ PROGRAM CoLM CALL CheckEquilibrium (idate, deltim, itstamp, dir_hist, casename) - ! DO land USE and land cover change simulation + ! DO land use and land cover change simulation ! ---------------------------------------------------------------------- #ifdef LULCC IF ( isendofyear(idate, deltim) ) THEN @@ -472,8 +472,7 @@ PROGRAM CoLM CALL hist_final () ! Call LULCC driver - CALL LulccDriver (casename,dir_landdata,dir_restart,& - idate,greenwich) + CALL LulccDriver (casename,dir_landdata,dir_restart,idate,greenwich) ! Allocate Forcing and Fluxes variable of next year CALL allocate_1D_Forcing @@ -541,9 +540,11 @@ PROGRAM CoLM ENDIF #endif ENDIF + #ifdef RangeCheck CALL check_TimeVariables () #endif + #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif @@ -554,7 +555,6 @@ PROGRAM CoLM ENDIF #endif - IF (p_is_master) THEN CALL system_clock (end_time, count_rate = c_per_sec) time_used = (end_time - start_time) / c_per_sec diff --git a/main/CoLMDRIVER.F90 b/main/CoLMDRIVER.F90 index fdf59671..373d8988 100644 --- a/main/CoLMDRIVER.F90 +++ b/main/CoLMDRIVER.F90 @@ -27,9 +27,9 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) USE MOD_Forcing, only: forcmask_pch USE omp_lib #ifdef CaMa_Flood - ! get flood variables: inundation depth[mm], inundation fraction [0-1], - ! inundation evaporation [mm/s], inundation re-infiltration[mm/s] - USE MOD_CaMa_Vars, only : flddepth_cama,fldfrc_cama,fevpg_fld,finfg_fld + ! get flood variables: inundation depth[mm], inundation fraction [0-1], + ! inundation evaporation [mm/s], inundation re-infiltration[mm/s] + USE MOD_CaMa_Vars, only: flddepth_cama,fldfrc_cama,fevpg_fld,finfg_fld #endif IMPLICIT NONE @@ -79,7 +79,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) DO k = 1, steps_in_one_deltim ! ***** Call CoLM main program ***** ! - CALL CoLMMAIN (i,idate, coszen(i), deltim_phy, & + CALL CoLMMAIN ( i,idate, coszen(i), deltim_phy, & patchlonr(i), patchlatr(i), patchclass(i), patchtype(i), & doalb, dolai, dosst, oro(i), & @@ -98,7 +98,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) 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), & + flddepth_cama(i),fldfrc_cama(i), fevpg_fld(i), finfg_fld(i), & #endif ! VEGETATION INFORMATION @@ -106,10 +106,9 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) effcon(m), vmax25(m), & kmax_sun(m), kmax_sha(m), kmax_xyl(m), kmax_root(m), & psi50_sun(m), psi50_sha(m), psi50_xyl(m), psi50_root(m), & - ck(m), & - slti(m), hlti(m), & - shti(m), hhti(m), trda(m), trdm(m), & - trop(m), g1(m), g0(m),gradm(m), binter(m), & + ck(m), slti(m), hlti(m), shti(m), & + hhti(m), trda(m), trdm(m), trop(m), & + g1(m), g0(m), gradm(m), binter(m), & extkn(m), chil(m), rho(1:,1:,m), tau(1:,1:,m), & ! ATMOSPHERIC FORCING @@ -136,7 +135,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) thermk(i), extkb(i), extkd(i), vegwp(1:,i), & gs0sun(i), gs0sha(i), & ! Ozone Stress Variables - lai_old(i), o3uptakesun(i), o3uptakesha(i) ,forc_ozone(i), & + lai_old(i), o3uptakesun(i), o3uptakesha(i), forc_ozone(i), & ! End ozone stress variables ! WUE stomata model parameter lambda(m), & @@ -150,32 +149,31 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) mss_dst1(:,i), mss_dst2(:,i), mss_dst3(:,i), mss_dst4(:,i), & ! additional diagnostic variables for output - laisun(i), laisha(i), rootr(1:,i),rootflux(1:,i),rss(i),& + laisun(i), laisha(i), rootr(1:,i), rootflux(1:,i), & rstfacsun_out(i),rstfacsha_out(i),gssun_out(i), gssha_out(i), & assimsun_out(i), etrsun_out(i), assimsha_out(i), etrsha_out(i), & - h2osoi(1:,i), wat(i), & + h2osoi(1:,i), wat(i), rss(i), & ! FLUXES taux(i), tauy(i), fsena(i), fevpa(i), & lfevpa(i), fsenl(i), fevpl(i), etr(i), & fseng(i), fevpg(i), olrg(i), fgrnd(i), & - trad(i), tref(i), qref(i), & - rsur(i), rsur_se(i), rsur_ie(i), rnof(i), & - qintr(i), qinfl(i), qdrip(i), & - rst(i), assim(i), respc(i), sabvsun(i), & - sabvsha(i), sabg(i), sr(i), solvd(i), & - solvi(i), solnd(i), solni(i), srvd(i), & - srvi(i), srnd(i), srni(i), solvdln(i), & - solviln(i), solndln(i), solniln(i), srvdln(i), & - srviln(i), srndln(i), srniln(i), qcharge(i), & - xerr(i), zerr(i), & + trad(i), tref(i), qref(i), rsur(i), & + rsur_se(i), rsur_ie(i), rnof(i), qintr(i), & + qinfl(i), qdrip(i), rst(i), assim(i), & + respc(i), sabvsun(i), sabvsha(i), sabg(i), & + sr(i), solvd(i), solvi(i), solnd(i), & + solni(i), srvd(i), srvi(i), srnd(i), & + srni(i), solvdln(i), solviln(i), solndln(i), & + solniln(i), srvdln(i), srviln(i), srndln(i), & + srniln(i), qcharge(i), xerr(i), zerr(i), & ! TUNABLE modle constants zlnd, zsno, csoilc, dewmx, & ! 'wtfact' is updated to gridded 'fsatmax' data. - capr, cnfac, ssi, & - wimp, pondmx, smpmax, smpmin, & - trsmx0, tcrit, & + capr, cnfac, ssi, wimp, & + pondmx, smpmax, smpmin, trsmx0, & + tcrit, & ! additional variables required by coupling with WRF model emis(i), z0m(i), zol(i), rib(i), & @@ -189,7 +187,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) #if(defined BGC) IF(patchtype(i) .eq. 0)THEN ! - ! ***** Call CoLM BGC model ***** + ! ***** Call CoLM BGC model ***** ! CALL bgc_driver (i,idate(1:3),deltim, patchlatr(i)*180/PI,patchlonr(i)*180/PI) ENDIF @@ -201,8 +199,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) IF (DEF_URBAN_RUN .and. m.eq.URBAN) THEN u = patch2urban(i) - !print *, "patch:", i, "urban:", u !fortest only - + ! ! ***** Call CoLM urban model ***** ! CALL CoLMMAIN_Urban ( & @@ -215,8 +212,8 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) fgper(u) ,em_roof(u) ,em_wall(u) ,em_gimp(u) ,& 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) ,& + z_wall(:,u) ,dz_roof(:,u) ,dz_wall(:,u) ,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) ,& @@ -228,9 +225,9 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) 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) ,& + sc_vgm(1:,i) ,fc_vgm(1:,i) ,& #endif - hksati(1:,i) ,csol(1:,i) ,k_solids(1:,i), dksatu(1:,i) ,& + 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) ,& alb_roof(:,:,u) ,alb_wall(:,:,u) ,alb_gimp(:,:,u) ,alb_gper(:,:,u) ,& @@ -238,8 +235,9 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) htop(i) ,hbot(i) ,sqrtdi(m) ,chil(m) ,& effcon(m) ,vmax25(m) ,slti(m) ,hlti(m) ,& shti(m) ,hhti(m) ,trda(m) ,trdm(m) ,& - trop(m) ,g1(m) ,g0(m),gradm(m) ,binter(m) ,& - extkn(m) ,rho(1:,1:,m) ,tau(1:,1:,m) ,rootfr(1:,m) ,& + trop(m) ,g1(m) ,g0(m) ,gradm(m) ,& + binter(m) ,extkn(m) ,rho(1:,1:,m) ,tau(1:,1:,m) ,& + rootfr(1:,m) ,& ! WUE model parameter lambda(m) ,& ! END WUE model parameter @@ -290,7 +288,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) t_lake(1:,i) ,lake_icefrac(1:,i), savedtke1(i) ,& ! SNICAR snow model related - snw_rds(:,i) ,ssno_lyr(:,:,:,i),& + snw_rds(:,i) ,ssno_lyr(:,:,:,i) ,& mss_bcpho(:,i) ,mss_bcphi(:,i) ,mss_ocpho(:,i) ,mss_ocphi(:,i) ,& mss_dst1(:,i) ,mss_dst2(:,i) ,mss_dst3(:,i) ,mss_dst4(:,i) ,& @@ -323,9 +321,9 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) ! TUNABLE model constants zlnd ,zsno ,csoilc ,dewmx ,& ! 'wtfact' is updated to gridded 'fsatmax' data. - capr ,cnfac ,ssi ,& - wimp ,pondmx ,smpmax ,smpmin ,& - trsmx0 ,tcrit ,& + capr ,cnfac ,ssi ,wimp ,& + pondmx ,smpmax ,smpmin ,trsmx0 ,& + tcrit ,& ! additional variables required by coupling with WRF model emis(i) ,z0m(i) ,zol(i) ,rib(i) ,& diff --git a/main/CoLMMAIN.F90 b/main/CoLMMAIN.F90 index 5cdb14bc..372602f8 100644 --- a/main/CoLMMAIN.F90 +++ b/main/CoLMMAIN.F90 @@ -68,36 +68,35 @@ SUBROUTINE CoLMMAIN ( & ! SNICAR snow model related snw_rds, ssno_lyr, & - mss_bcpho, mss_bcphi, mss_ocpho, mss_ocphi, & - mss_dst1, mss_dst2, mss_dst3, mss_dst4, & + mss_bcpho, mss_bcphi, mss_ocpho, mss_ocphi, & + mss_dst1, mss_dst2, mss_dst3, mss_dst4, & ! additional diagnostic variables for output - laisun, laisha, rootr,rootflux,rss, & + laisun, laisha, rootr, rootflux, & rstfacsun_out,rstfacsha_out,gssun_out, gssha_out, & assimsun_out, etrsun_out, assimsha_out, etrsha_out, & - h2osoi, wat, & + h2osoi, wat, rss, & ! FLUXES taux, tauy, fsena, fevpa, & lfevpa, fsenl, fevpl, etr, & fseng, fevpg, olrg, fgrnd, & - trad, tref, qref, & - rsur, rsur_se, rsur_ie, rnof, & - qintr, qinfl, qdrip, & - rst, assim, respc, sabvsun, & - sabvsha, sabg, sr, solvd, & - solvi, solnd, solni, srvd, & - srvi, srnd, srni, solvdln, & - solviln, solndln, solniln, srvdln, & - srviln, srndln, srniln, qcharge, & - xerr, zerr, & + trad, tref, qref, rsur, & + rsur_se, rsur_ie, rnof, qintr, & + qinfl, qdrip, rst, assim, & + respc, sabvsun, sabvsha, sabg, & + sr, solvd, solvi, solnd, & + solni, srvd, srvi, srnd, & + srni, solvdln, solviln, solndln, & + solniln, srvdln, srviln, srndln, & + srniln, qcharge, xerr, zerr, & ! TUNABLE model constants zlnd, zsno, csoilc, dewmx, & ! 'wtfact' is updated to gridded 'fsatmax' data. - capr, cnfac, ssi, & - wimp, pondmx, smpmax, smpmin, & - trsmx0, tcrit, & + capr, cnfac, ssi, wimp, & + pondmx, smpmax, smpmin, trsmx0, & + tcrit, & ! additional variables required by coupling with WRF model emis, z0m, zol, rib, & @@ -145,7 +144,7 @@ SUBROUTINE CoLMMAIN ( & USE MOD_Const_Physical, only: tfrz, denh2o, denice, cpliq, cpice USE MOD_Vars_TimeVariables, only: tlai, tsai, irrig_rate #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) - USE MOD_LandPFT, only : patch_pft_s, patch_pft_e + USE MOD_LandPFT, only: patch_pft_s, patch_pft_e USE MOD_Vars_PFTimeInvariants USE MOD_Vars_PFTimeVariables #endif @@ -595,9 +594,9 @@ SUBROUTINE CoLMMAIN ( & CALL netsolar (ipatch,idate,deltim,patchlonr,patchtype,& forc_sols,forc_soll,forc_solsd,forc_solld,& - alb,ssun,ssha,lai,sai,rho,tau,ssoi,ssno,ssno_lyr,& - parsun,parsha,sabvsun,sabvsha,sabg,sabg_soil,sabg_snow,fsno,sabg_snow_lyr,sr,& - solvd,solvi,solnd,solni,srvd,srvi,srnd,srni,& + alb,ssun,ssha,lai,sai,rho,tau,ssoi,ssno,ssno_lyr,fsno,& + parsun,parsha,sabvsun,sabvsha,sabg,sabg_soil,sabg_snow,sabg_snow_lyr,& + sr,solvd,solvi,solnd,solni,srvd,srvi,srnd,srni,& solvdln,solviln,solndln,solniln,srvdln,srviln,srndln,srniln) CALL rain_snow_temp (patchtype, & @@ -691,7 +690,7 @@ SUBROUTINE CoLMMAIN ( & !---------------------------------------------------------------------- ! [4] Energy and Water balance !---------------------------------------------------------------------- - lb = snl + 1 !lower bound of array + lb = snl + 1 !lower bound of array lbsn = min(lb,0) CALL THERMAL (ipatch,patchtype,is_dry_lake,lb ,deltim ,& @@ -707,12 +706,11 @@ SUBROUTINE CoLMMAIN ( & sc_vgm ,fc_vgm ,& #endif k_solids ,dksatu ,dksatf ,dkdry ,& - BA_alpha ,BA_beta ,& - lai ,laisun ,laisha ,sai ,& - htop ,hbot ,sqrtdi ,rootfr ,& - rstfacsun_out ,rstfacsha_out ,rss ,gssun_out ,& - gssha_out ,assimsun_out ,etrsun_out ,assimsha_out ,& - etrsha_out ,& + BA_alpha ,BA_beta ,lai ,laisun ,& + laisha ,sai ,htop ,hbot ,& + sqrtdi ,rootfr ,rstfacsun_out ,rstfacsha_out ,& + rss ,gssun_out ,gssha_out ,assimsun_out ,& + etrsun_out ,assimsha_out ,etrsha_out ,& effcon ,vmax25 ,hksati ,smp ,hk ,& kmax_sun ,kmax_sha ,kmax_xyl ,kmax_root ,& @@ -740,17 +738,16 @@ SUBROUTINE CoLMMAIN ( & taux ,tauy ,fsena ,fevpa ,& lfevpa ,fsenl ,fevpl ,etr ,& fseng ,fevpg ,olrg ,fgrnd ,& - rootr ,rootflux ,& - qseva ,qsdew ,qsubl ,qfros ,& - qseva_soil ,qsdew_soil ,qsubl_soil ,qfros_soil ,& - qseva_snow ,qsdew_snow ,qsubl_snow ,qfros_snow ,& - sm ,tref ,qref ,& - trad ,rst ,assim ,respc ,& - errore ,emis ,z0m ,zol ,& - rib ,ustar ,qstar ,tstar ,& - fm ,fh ,fq ,pg_rain ,& - pg_snow ,t_precip ,qintr_rain ,qintr_snow ,& - snofrz(lbsn:0) ,sabg_snow_lyr(lb:1) ) + rootr ,rootflux ,qseva ,qsdew ,& + qsubl ,qfros ,qseva_soil ,qsdew_soil ,& + qsubl_soil ,qfros_soil ,qseva_snow ,qsdew_snow ,& + qsubl_snow ,qfros_snow ,sm ,tref ,& + qref ,trad ,rst ,assim ,& + respc ,errore ,emis ,z0m ,& + zol ,rib ,ustar ,qstar ,& + tstar ,fm ,fh ,fq ,& + pg_rain ,pg_snow ,t_precip ,qintr_rain ,& + qintr_snow ,snofrz(lbsn:0) ,sabg_snow_lyr(lb:1) ) IF (.not. DEF_USE_VariablySaturatedFlow) THEN @@ -758,14 +755,13 @@ SUBROUTINE CoLMMAIN ( & deltim ,z_soisno(lb:) ,dz_soisno(lb:) ,zi_soisno(lb-1:) ,& bsw ,porsl ,psi0 ,hksati ,& theta_r ,fsatmax ,fsatdcf ,topostd ,& - BVIC ,& - rootr ,rootflux ,t_soisno(lb:) ,wliq_soisno(lb:) ,& - wice_soisno(lb:) ,smp ,hk ,pg_rain ,& - sm ,etr ,qseva ,qsdew ,& - qsubl ,qfros ,qseva_soil ,qsdew_soil ,& - qsubl_soil ,qfros_soil ,qseva_snow ,qsdew_snow ,& - qsubl_snow ,qfros_snow ,fsno ,rsur ,& - rnof ,qinfl ,pondmx ,& + BVIC ,rootr ,rootflux ,t_soisno(lb:) ,& + wliq_soisno(lb:) ,wice_soisno(lb:) ,smp ,hk ,& + pg_rain ,sm ,etr ,qseva ,& + qsdew ,qsubl ,qfros ,qseva_soil ,& + qsdew_soil ,qsubl_soil ,qfros_soil ,qseva_snow ,& + qsdew_snow ,qsubl_snow ,qfros_snow ,fsno ,& + rsur ,rnof ,qinfl ,pondmx ,& ssi ,wimp ,smpmin ,zwt ,& wa ,qcharge ,& @@ -779,7 +775,7 @@ SUBROUTINE CoLMMAIN ( & mss_dst1(lbsn:0) ,mss_dst2(lbsn:0) ,mss_dst3(lbsn:0) ,mss_dst4(lbsn:0) ) ELSE - CALL WATER_VSF (ipatch, patchtype,is_dry_lake, lb ,nl_soil ,& + CALL WATER_VSF (ipatch ,patchtype,is_dry_lake, lb ,nl_soil ,& deltim ,z_soisno(lb:) ,dz_soisno(lb:) ,zi_soisno(lb-1:) ,& bsw ,theta_r ,fsatmax ,fsatdcf ,& topostd ,BVIC ,& @@ -794,9 +790,9 @@ SUBROUTINE CoLMMAIN ( & qfros ,qseva_soil ,qsdew_soil ,qsubl_soil ,& qfros_soil ,qseva_snow ,qsdew_snow ,qsubl_snow ,& qfros_snow ,fsno ,rsur ,rsur_se ,& - rsur_ie ,rnof ,qinfl ,& - ssi ,pondmx ,wimp ,zwt ,& - wdsrf ,wa ,wetwat ,& + rsur_ie ,rnof ,qinfl ,ssi ,& + pondmx ,wimp ,zwt ,wdsrf ,& + wa ,wetwat ,& #if(defined CaMa_Flood) !add variables for flood depth [mm], flood fraction [0-1] and re-infiltration [mm/s] calculation. flddepth ,fldfrc ,qinfl_fld ,& @@ -906,7 +902,7 @@ SUBROUTINE CoLMMAIN ( & #ifndef CatchLateralFlow errorw=(endwb-totwb)-(forc_prc+forc_prl-fevpa-rnof)*deltim #else - ! for lateral flow, "rsur" is considered in HYDRO/MOD_Hydro_SurfaceFlow.F90 + ! for lateral flow, "rsur" is considered in HYDRO/MOD_Hydro_SurfaceFlow.F90 errorw=(endwb-totwb)-(forc_prc+forc_prl-fevpa)*deltim #endif @@ -937,7 +933,7 @@ SUBROUTINE CoLMMAIN ( & !====================================================================== - ELSE IF(patchtype == 3)THEN ! <=== is LAND ICE (glacier/ice sheet) (patchtype = 3) + ELSEIF (patchtype == 3) THEN ! <=== is LAND ICE (glacier/ice sheet) (patchtype = 3) !====================================================================== ! initial set @@ -1006,10 +1002,10 @@ SUBROUTINE CoLMMAIN ( & !---------------------------------------------------------------- ! Energy and Water balance !---------------------------------------------------------------- - lb = snl + 1 !lower bound of array + lb = snl + 1 !lower bound of array lbsn = min(lb,0) - CALL GLACIER_TEMP (patchtype, lb ,nl_soil ,deltim ,& + CALL GLACIER_TEMP (patchtype,lb ,nl_soil ,deltim ,& zlnd ,zsno ,capr ,cnfac ,& forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& forc_vs ,forc_t ,forc_q ,forc_hpbl ,& @@ -1035,8 +1031,8 @@ SUBROUTINE CoLMMAIN ( & wliq_soisno ,wice_soisno ,pg_rain ,pg_snow ,& sm ,scv ,snowdp ,imelt ,& fiold ,snl ,qseva ,qsdew ,& - qsubl ,qfros ,gwat ,& - ssi ,wimp ,forc_us ,forc_vs ,& + qsubl ,qfros ,gwat ,ssi ,& + wimp ,forc_us ,forc_vs ,& ! SNICAR forc_aer ,& mss_bcpho ,mss_bcphi ,mss_ocpho ,mss_ocphi ,& @@ -1047,8 +1043,8 @@ SUBROUTINE CoLMMAIN ( & wliq_soisno ,wice_soisno ,pg_rain ,pg_snow ,& sm ,scv ,snowdp ,imelt ,& fiold ,snl ,qseva ,qsdew ,& - qsubl ,qfros ,gwat ,& - ssi ,wimp ,forc_us ,forc_vs ) + qsubl ,qfros ,gwat ,ssi ,& + wimp ,forc_us ,forc_vs ) ENDIF IF (.not. DEF_USE_VariablySaturatedFlow) THEN @@ -1112,7 +1108,7 @@ SUBROUTINE CoLMMAIN ( & !====================================================================== - ELSE IF(patchtype == 4) THEN ! <=== is LAND WATER BODIES (lake, reservoir and river) (patchtype = 4) + ELSEIF (patchtype == 4) THEN ! <=== is LAND WATER BODIES (lake, reservoir and river) (patchtype = 4) !====================================================================== @@ -1361,7 +1357,7 @@ SUBROUTINE CoLMMAIN ( & IF (patchtype <= 5) THEN !LAND #if(defined DYN_PHENOLOGY) - ! need to update lai and sai, fveg, green, they are done once in a day only + ! need to update lai and sai, fveg, green, they are done once in a day only IF (dolai) THEN CALL LAI_empirical(patchclass,nl_soil,rootfr,t_soisno(1:),lai,sai,fveg,green) ENDIF @@ -1429,7 +1425,7 @@ SUBROUTINE CoLMMAIN ( & dz_soisno_(:1) = dz_soisno(:1) t_soisno_ (:1) = t_soisno (:1) - IF ((patchtype == 4) .and. (.not. is_dry_lake)) THEN + IF ((patchtype == 4) .and. (.not. is_dry_lake)) THEN dz_soisno_(1) = dz_lake(1) t_soisno_ (1) = t_lake (1) ENDIF @@ -1439,7 +1435,7 @@ SUBROUTINE CoLMMAIN ( & ! we supposed CALL it every time-step, because ! other vegetation related parameters are needed to create IF (doalb) THEN - CALL albland (ipatch, patchtype,deltim,& + CALL albland (ipatch,patchtype,deltim,& soil_s_v_alb,soil_d_v_alb,soil_s_n_alb,soil_d_n_alb,& chil,rho,tau,fveg,green,lai,sai,fwet_snow,coszen,& wt,fsno,scv,scvold,sag,ssw,pg_snow,forc_t,t_grnd,t_soisno_,dz_soisno_,& diff --git a/main/DA/MOD_DA_GRACE.F90 b/main/DA/MOD_DA_GRACE.F90 index 776c159a..a76e9c0f 100644 --- a/main/DA/MOD_DA_GRACE.F90 +++ b/main/DA/MOD_DA_GRACE.F90 @@ -58,18 +58,18 @@ MODULE MOD_DA_GRACE SUBROUTINE init_DA_GRACE () USE MOD_Spmd_Task - USE MOD_Namelist, only : DEF_DA_obsdir + USE MOD_Namelist, only: DEF_DA_obsdir USE MOD_Grid USE MOD_NetCDFSerial - USE MOD_Mesh, only : numelm - USE MOD_LandElm, only : landelm + USE MOD_Mesh, only: numelm + USE MOD_LandElm, only: landelm USE MOD_LandPatch #ifdef CROP USE MOD_LandCrop #endif USE MOD_Pixelset - USE MOD_Vars_TimeInvariants, only : patchtype - USE MOD_Forcing, only : forcmask_pch + USE MOD_Vars_TimeInvariants, only: patchtype + USE MOD_Forcing, only: forcmask_pch USE MOD_RangeCheck IMPLICIT NONE @@ -171,8 +171,8 @@ SUBROUTINE do_DA_GRACE (idate, deltim) USE MOD_Mesh USE MOD_LandElm USE MOD_LandPatch - USE MOD_Vars_1DFluxes, only : rnof, rsur - USE MOD_Vars_TimeVariables, only : wat, wa, wdsrf, zwt + USE MOD_Vars_1DFluxes, only: rnof, rsur + USE MOD_Vars_TimeVariables, only: wat, wa, wdsrf, zwt USE MOD_RangeCheck USE MOD_UserDefFun IMPLICIT NONE diff --git a/main/HYDRO/MOD_Catch_HillslopeFlow.F90 b/main/HYDRO/MOD_Catch_HillslopeFlow.F90 index 975de7ec..982ac393 100644 --- a/main/HYDRO/MOD_Catch_HillslopeFlow.F90 +++ b/main/HYDRO/MOD_Catch_HillslopeFlow.F90 @@ -38,7 +38,7 @@ SUBROUTINE hillslope_flow (dt) USE MOD_Catch_RiverLakeNetwork USE MOD_Catch_Vars_TimeVariables USE MOD_Catch_Vars_1DFluxes - USE MOD_Const_Physical, only : grav + USE MOD_Const_Physical, only: grav IMPLICIT NONE diff --git a/main/HYDRO/MOD_Catch_Hist.F90 b/main/HYDRO/MOD_Catch_Hist.F90 index 2853d1aa..2a4386a1 100644 --- a/main/HYDRO/MOD_Catch_Hist.F90 +++ b/main/HYDRO/MOD_Catch_Hist.F90 @@ -13,11 +13,11 @@ MODULE MOD_Catch_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_Catch_BasinNetwork, only : numbasin, numbsnhru + USE MOD_Mesh, only: numelm + USE MOD_LandHRU, only: numhru + USE MOD_Catch_BasinNetwork, only: numbasin, numbsnhru USE MOD_Catch_Vars_1DFluxes USE MOD_Catch_IO @@ -260,9 +260,9 @@ END SUBROUTINE hist_basin_out SUBROUTINE FLUSH_acc_fluxes_basin () USE MOD_SPMD_Task - USE MOD_Mesh, only : numelm - USE MOD_LandHRU, only : numhru - USE MOD_Vars_Global, only : spval + USE MOD_Mesh, only: numelm + USE MOD_LandHRU, only: numhru + USE MOD_Vars_Global, only: spval IMPLICIT NONE IF (p_is_worker) THEN diff --git a/main/HYDRO/MOD_Catch_LateralFlow.F90 b/main/HYDRO/MOD_Catch_LateralFlow.F90 index e1418297..70d7e0db 100644 --- a/main/HYDRO/MOD_Catch_LateralFlow.F90 +++ b/main/HYDRO/MOD_Catch_LateralFlow.F90 @@ -30,8 +30,8 @@ MODULE MOD_Catch_LateralFlow USE MOD_Catch_SubsurfaceFlow USE MOD_Catch_RiverLakeFlow USE MOD_Vars_TimeVariables - USE MOD_Vars_Global, only : dz_soi - USE MOD_Const_Physical, only : denice, denh2o + USE MOD_Vars_Global, only: dz_soi + USE MOD_Const_Physical, only: denice, denh2o IMPLICIT NONE integer, parameter :: nsubstep = 20 @@ -92,20 +92,20 @@ END SUBROUTINE lateral_flow_init ! ---------- SUBROUTINE lateral_flow (deltime) - USE MOD_Namelist, only : DEF_USE_Dynamic_Lake - USE MOD_Mesh, only : numelm - USE MOD_LandHRU, only : landhru, numhru, elm_hru - USE MOD_LandPatch, only : numpatch, elm_patch, hru_patch + USE MOD_Namelist, only: DEF_USE_Dynamic_Lake + USE MOD_Mesh, only: numelm + 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_TimeVariables, only : wdsrf, t_lake, lake_icefrac, t_soisno - USE MOD_Vars_TimeInvariants, only : lakedepth, dz_lake + USE MOD_Vars_Global, only: nl_lake + USE MOD_Const_Physical, only: tfrz + USE MOD_Vars_TimeVariables, only: wdsrf, t_lake, lake_icefrac, t_soisno + USE MOD_Vars_TimeInvariants, only: lakedepth, dz_lake USE MOD_Catch_Vars_1DFluxes USE MOD_Catch_Vars_TimeVariables USE MOD_Catch_RiverLakeNetwork - USE MOD_Lake, only : adjust_lake_layer + USE MOD_Lake, only: adjust_lake_layer USE MOD_RangeCheck IMPLICIT NONE diff --git a/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 b/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 index e4c9439d..2d02384c 100644 --- a/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 +++ b/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 @@ -42,7 +42,7 @@ SUBROUTINE river_lake_flow (dt) USE MOD_Catch_RiverLakeNetwork USE MOD_Catch_Vars_TimeVariables USE MOD_Catch_Vars_1DFluxes - USE MOD_Const_Physical, only : grav + USE MOD_Const_Physical, only: grav IMPLICIT NONE real(r8), intent(in) :: dt diff --git a/main/HYDRO/MOD_Catch_RiverLakeNetwork.F90 b/main/HYDRO/MOD_Catch_RiverLakeNetwork.F90 index e23ab0ca..3839fdcd 100644 --- a/main/HYDRO/MOD_Catch_RiverLakeNetwork.F90 +++ b/main/HYDRO/MOD_Catch_RiverLakeNetwork.F90 @@ -11,7 +11,7 @@ MODULE MOD_Catch_RiverLakeNetwork !-------------------------------------------------------------------------------- USE MOD_Precision - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval USE MOD_Pixelset USE MOD_Catch_BasinNetwork USE MOD_Catch_HillslopeNetwork @@ -105,7 +105,7 @@ SUBROUTINE river_lake_network_init () USE MOD_DataType USE MOD_Utils USE MOD_UserDefFun - USE MOD_Vars_TimeInvariants, only : lakedepth + USE MOD_Vars_TimeInvariants, only: lakedepth IMPLICIT NONE ! Local Variables diff --git a/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 b/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 index 613017e6..dd9bbad5 100644 --- a/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 +++ b/main/HYDRO/MOD_Catch_SubsurfaceFlow.F90 @@ -59,9 +59,9 @@ SUBROUTINE subsurface_network_init () USE MOD_LandElm USE MOD_LandPatch USE MOD_ElementNeighbour - 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 + 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 :: ielm, inb, i, ihru, ps, pe, ipatch, ipxl @@ -188,9 +188,9 @@ SUBROUTINE subsurface_flow (deltime) USE MOD_Vars_1DFluxes USE MOD_Catch_HillslopeNetwork 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 + 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 diff --git a/main/HYDRO/MOD_Catch_Vars_1DFluxes.F90 b/main/HYDRO/MOD_Catch_Vars_1DFluxes.F90 index e86d29b4..beba588e 100644 --- a/main/HYDRO/MOD_Catch_Vars_1DFluxes.F90 +++ b/main/HYDRO/MOD_Catch_Vars_1DFluxes.F90 @@ -40,11 +40,11 @@ MODULE MOD_Catch_Vars_1DFluxes 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 + 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 diff --git a/main/HYDRO/MOD_Catch_Vars_TimeVariables.F90 b/main/HYDRO/MOD_Catch_Vars_TimeVariables.F90 index 0d0943f5..42695e34 100644 --- a/main/HYDRO/MOD_Catch_Vars_TimeVariables.F90 +++ b/main/HYDRO/MOD_Catch_Vars_TimeVariables.F90 @@ -45,8 +45,8 @@ MODULE MOD_Catch_Vars_TimeVariables SUBROUTINE allocate_CatchTimeVariables USE MOD_SPMD_Task - USE MOD_Mesh, only : numelm - USE MOD_LandHRU, only : numhru + USE MOD_Mesh, only: numelm + USE MOD_LandHRU, only: numhru IMPLICIT NONE IF (p_is_worker) THEN diff --git a/main/HYDRO/MOD_ElementNeighbour.F90 b/main/HYDRO/MOD_ElementNeighbour.F90 index 13fb30eb..88a5f509 100644 --- a/main/HYDRO/MOD_ElementNeighbour.F90 +++ b/main/HYDRO/MOD_ElementNeighbour.F90 @@ -540,7 +540,7 @@ SUBROUTINE retrieve_neighbour_data (vec_in, nbdata) USE MOD_Precision USE MOD_SPMD_Task - USE MOD_Mesh, only : numelm + USE MOD_Mesh, only: numelm IMPLICIT NONE real(r8), intent(inout) :: vec_in (:) @@ -637,7 +637,7 @@ END SUBROUTINE retrieve_neighbour_data ! --- SUBROUTINE allocate_neighbour_data_real8 (nbdata) - USE MOD_Mesh, only : numelm + USE MOD_Mesh, only: numelm IMPLICIT NONE type(pointer_real8_1d), allocatable :: nbdata(:) @@ -657,7 +657,7 @@ END SUBROUTINE allocate_neighbour_data_real8 ! --- SUBROUTINE allocate_neighbour_data_logic (nbdata) - USE MOD_Mesh, only : numelm + USE MOD_Mesh, only: numelm IMPLICIT NONE type(pointer_logic_1d), allocatable :: nbdata(:) diff --git a/main/HYDRO/MOD_Hydro_SoilWater.F90 b/main/HYDRO/MOD_Hydro_SoilWater.F90 index b7b70a0c..e48f2cec 100644 --- a/main/HYDRO/MOD_Hydro_SoilWater.F90 +++ b/main/HYDRO/MOD_Hydro_SoilWater.F90 @@ -18,7 +18,7 @@ MODULE MOD_Hydro_SoilWater USE MOD_Precision USE MOD_Hydro_SoilFunction USE MOD_Namelist, only: DEF_USE_PLANTHYDRAULICS - USE MOD_UserDefFun, only : findloc_ud + USE MOD_UserDefFun, only: findloc_ud IMPLICIT NONE @@ -171,7 +171,7 @@ SUBROUTINE soil_water_vertical_movement ( & ! soil water movement !======================================================================= - USE MOD_Const_Physical, only : tfrz + USE MOD_Const_Physical, only: tfrz IMPLICIT NONE diff --git a/main/HYDRO/MOD_Hydro_VIC.F90 b/main/HYDRO/MOD_Hydro_VIC.F90 index 766f0dfa..cbc90062 100644 --- a/main/HYDRO/MOD_Hydro_VIC.F90 +++ b/main/HYDRO/MOD_Hydro_VIC.F90 @@ -1,18 +1,18 @@ -module MOD_Hydro_VIC - use MOD_Hydro_VIC_Variables - implicit none +MODULE MOD_Hydro_VIC + USE MOD_Hydro_VIC_Variables + IMPLICIT NONE - public :: compute_vic_runoff + PUBLIC :: compute_vic_runoff - private :: compute_runoff_and_asat - private :: calc_Q12 - private :: compute_zwt - private :: wrap_compute_zwt + PRIVATE :: compute_runoff_and_asat + PRIVATE :: calc_Q12 + PRIVATE :: compute_zwt + PRIVATE :: wrap_compute_zwt - contains + CONTAINS ! ****************************************************************************** - subroutine Runoff_VIC(deltim, porsl, theta_r, hksati, bsw, & + SUBROUTINE Runoff_VIC(deltim, porsl, theta_r, hksati, bsw, & wice_soisno, wliq_soisno, fevpg, rootflux, ppt, & b_infilt, Dsmax, Ds, Ws, c, & rsur,rsubst,wliq_soisno_tmp) @@ -20,7 +20,7 @@ subroutine Runoff_VIC(deltim, porsl, theta_r, hksati, bsw, & USE MOD_Namelist USE MOD_Precision USE MOD_Vars_Global - implicit none + IMPLICIT NONE !-----------------------Arguments--------------------------------------- type(soil_con_struct) :: soil_con @@ -44,37 +44,37 @@ subroutine Runoff_VIC(deltim, porsl, theta_r, hksati, bsw, & real(r8) :: vic_tmp(Nlayer), vic_tmp_(Nlayer) !-----------------------Arguments--------------------------------------- - call vic_para(porsl, theta_r, hksati, bsw, wice_soisno(1:nl_soil), wliq_soisno(1:nl_soil), fevpg, rootflux, & + CALL vic_para(porsl, theta_r, hksati, bsw, wice_soisno(1:nl_soil), wliq_soisno(1:nl_soil), fevpg, rootflux, & b_infilt, Dsmax, Ds, Ws, c, & soil_con, cell) - call compute_vic_runoff(soil_con, ppt*deltim, soil_con%frost_fract, cell) + CALL compute_vic_runoff(soil_con, ppt*deltim, soil_con%frost_fract, cell) DO ilay = 1, Nlayer vic_tmp(ilay) = cell%layer(ilay)%moist ENDDO wliq_soisno_tmp = 0. - call VIC2CoLM(wliq_soisno_tmp, vic_tmp) + CALL VIC2CoLM(wliq_soisno_tmp, vic_tmp) DO ilay = 1, Nlayer vic_tmp_(ilay) = sum(cell%layer(ilay)%ice) ENDDO - ! call VIC2CoLM(wice_soisno(1:nl_soil), vic_tmp_) + ! CALL VIC2CoLM(wice_soisno(1:nl_soil), vic_tmp_) - if (ppt > 0.) rsur = cell%runoff/deltim + IF (ppt > 0.) rsur = cell%runoff/deltim rsubst = cell%baseflow/deltim - end subroutine Runoff_VIC + END SUBROUTINE Runoff_VIC ! /****************************************************************************** ! * @brief Calculate infiltration and runoff from the surface, gravity driven ! * drainage between all soil layers, and generates baseflow from the ! * bottom layer. ! ******************************************************************************/ - subroutine compute_vic_runoff(soil_con, ppt, frost_fract, cell) - use MOD_Hydro_VIC_Variables + SUBROUTINE compute_vic_runoff(soil_con, ppt, frost_fract, cell) + USE MOD_Hydro_VIC_Variables USE MOD_Namelist - implicit none + IMPLICIT NONE !-----------------------Arguments--------------------------------------- type(soil_con_struct), intent(in) :: soil_con @@ -90,7 +90,7 @@ subroutine compute_vic_runoff(soil_con, ppt, frost_fract, cell) real(r8) :: tmp_runoff real(r8) :: inflow real(r8) :: resid_moist(MAX_LAYERS) ! residual moisture (mm) - real(r8) :: org_moist(MAX_LAYERS) ! total soil moisture (liquid and frozen) at beginning of this function (mm) + real(r8) :: org_moist(MAX_LAYERS) ! total soil moisture (liquid and frozen) at beginning of this FUNCTION (mm) real(r8) :: avail_liq(MAX_LAYERS, MAX_FROST_AREAS) ! liquid soil moisture available for evap/drainage (mm) real(r8) :: liq(MAX_LAYERS) real(r8) :: ice(MAX_LAYERS) @@ -128,11 +128,11 @@ subroutine compute_vic_runoff(soil_con, ppt, frost_fract, cell) model_steps_per_day = 86400/dltime ! /** Set Temporary Variables **/ - do lindex = 1, Nlayer + DO lindex = 1, Nlayer resid_moist(lindex) = soil_con%resid_moist(lindex) max_moist(lindex) = soil_con%max_moist(lindex) Ksat(lindex) = soil_con%Ksat(lindex) / runoff_steps_per_day - end do + ENDDO ! /** Allocate and Set Values for Soil Sublayers **/ layer = cell%layer @@ -143,74 +143,74 @@ subroutine compute_vic_runoff(soil_con, ppt, frost_fract, cell) runoff_steps_per_dt = runoff_steps_per_day / model_steps_per_day ! initialize baseflow - do fidx = 1, Nfrost + DO fidx = 1, Nfrost baseflow(fidx) = 0.0 - end do + ENDDO - do lindex = 1, Nlayer + DO lindex = 1, Nlayer evap(lindex, 1) = layer(lindex)%evap / real(runoff_steps_per_dt) org_moist(lindex) = layer(lindex)%moist layer(lindex)%moist = 0.0 ! if there is positive evaporation - if (evap(lindex, 1) > 0.0) then + IF (evap(lindex, 1) > 0.0) THEN sum_liq = 0.0 ! compute available soil moisture for each frost sub area - do fidx = 1, Nfrost + DO fidx = 1, Nfrost avail_liq(lindex, fidx) = org_moist(lindex) - layer(lindex)%ice(fidx) - resid_moist(lindex) !avail_liq(lindex, fidx) = org_moist(lindex) - resid_moist(lindex) - if (avail_liq(lindex, fidx) < 0.0) then + IF (avail_liq(lindex, fidx) < 0.0) THEN avail_liq(lindex, fidx) = 0.0 - end if + ENDIF sum_liq = sum_liq + avail_liq(lindex, fidx) * frost_fract(fidx) - end do + ENDDO ! compute fraction of available soil moisture that is evaporated - if (sum_liq > 0.0) then + IF (sum_liq > 0.0) THEN evap_fraction = evap(lindex, 1) / sum_liq - else + ELSE evap_fraction = 1.0 - end if + ENDIF ! distribute evaporation between frost sub areas by percentage evap_sum = evap(lindex, 1) - do fidx = Nfrost, 1, -1 + DO fidx = Nfrost, 1, -1 evap(lindex, fidx) = avail_liq(lindex, fidx) * evap_fraction avail_liq(lindex, fidx) = avail_liq(lindex, fidx) - evap(lindex, fidx) evap_sum = evap_sum - evap(lindex, fidx) * frost_fract(fidx) - end do - else + ENDDO + ELSE ! if no evaporation - do fidx = Nfrost, 2, -1 + DO fidx = Nfrost, 2, -1 evap(lindex, fidx) = evap(lindex, 1) - end do - end if - end do + ENDDO + ENDIF + ENDDO - do fidx = 1, Nfrost + DO fidx = 1, Nfrost ! ppt = amount of liquid water coming to the surface inflow = ppt ! /************************************************** ! Initialize Variables ! **************************************************/ - do lindex = 1, Nlayer + DO lindex = 1, Nlayer ! Set Layer Liquid Moisture Content liq(lindex) = org_moist(lindex) - layer(lindex)%ice(fidx) ! Set Layer Frozen Moisture Content ice(lindex) = layer(lindex)%ice(fidx) - end do + ENDDO ! /****************************************************** ! Runoff Based on Soil Moisture Level of Upper Layers ! ******************************************************/ - do lindex = 1, Nlayer + DO lindex = 1, Nlayer tmp_moist_for_runoff(lindex) = liq(lindex) + ice(lindex) - end do + ENDDO - call compute_runoff_and_asat(soil_con, tmp_moist_for_runoff, inflow, A, runoff(fidx)) + CALL compute_runoff_and_asat(soil_con, tmp_moist_for_runoff, inflow, A, runoff(fidx)) ! Save dt_runoff based on initial runoff estimate tmp_dt_runoff(fidx) = runoff(fidx) / real(runoff_steps_per_dt, kind=r8) @@ -222,38 +222,38 @@ subroutine compute_vic_runoff(soil_con, ppt, frost_fract, cell) Dsmax = soil_con%Dsmax / runoff_steps_per_day - do time_step = 1, runoff_steps_per_dt + DO time_step = 1, runoff_steps_per_dt inflow = dt_inflow ! /************************************* ! Compute Drainage between Sublayers ! *************************************/ - do lindex = 1, Nlayer - 1 + DO lindex = 1, Nlayer - 1 ! Brooks & Corey relation for hydraulic conductivity tmp_liq = liq(lindex) - evap(lindex, fidx) ! Assume evap is a 2D array now, adjusted indexing - if (tmp_liq < resid_moist(lindex)) then + IF (tmp_liq < resid_moist(lindex)) THEN tmp_liq = resid_moist(lindex) - end if + ENDIF - if (tmp_liq > resid_moist(lindex)) then - call calc_Q12(Ksat(lindex), tmp_liq, resid_moist(lindex), max_moist(lindex), soil_con%expt(lindex),Q12(lindex)) - else + IF (tmp_liq > resid_moist(lindex)) THEN + CALL calc_Q12(Ksat(lindex), tmp_liq, resid_moist(lindex), max_moist(lindex), soil_con%expt(lindex),Q12(lindex)) + ELSE Q12(lindex) = 0.0 - end if - end do + ENDIF + ENDDO ! /************************************************** ! Solve for Current Soil Layer Moisture, and ! Check Versus Maximum and Minimum Moisture Contents. ! **************************************************/ last_index = 0 - do lindex = 1, Nlayer - 1 - if (lindex == 1) then + DO lindex = 1, Nlayer - 1 + IF (lindex == 1) THEN dt_runoff = tmp_dt_runoff(fidx) - else + ELSE dt_runoff = 0.0 - endif + ENDIF ! transport moisture for all sublayers tmp_inflow = 0.0 @@ -262,53 +262,53 @@ subroutine compute_vic_runoff(soil_con, ppt, frost_fract, cell) liq(lindex) = liq(lindex) + (inflow - dt_runoff) - (Q12(lindex) + evap(lindex, fidx)) ! Verify that soil layer moisture is less than maximum - if ((liq(lindex) + ice(lindex)) > max_moist(lindex)) then + IF ((liq(lindex) + ice(lindex)) > max_moist(lindex)) THEN tmp_inflow = (liq(lindex) + ice(lindex)) - max_moist(lindex) liq(lindex) = max_moist(lindex) - ice(lindex) - if (lindex == 1) then + IF (lindex == 1) THEN Q12(lindex) = Q12(lindex) + tmp_inflow tmp_inflow = 0.0 - else + ELSE tmplayer = lindex - do while (tmp_inflow > 0) + DO WHILE (tmp_inflow > 0) tmplayer = tmplayer - 1 - if (tmplayer < 1) then + IF (tmplayer < 1) THEN ! If top layer saturated, add to runoff runoff(fidx) = runoff(fidx) + tmp_inflow tmp_inflow = 0.0 - else + ELSE ! else add excess soil moisture to next higher layer liq(tmplayer) = liq(tmplayer) + tmp_inflow - if ((liq(tmplayer) + ice(tmplayer)) > max_moist(tmplayer)) then + IF ((liq(tmplayer) + ice(tmplayer)) > max_moist(tmplayer)) THEN tmp_inflow = (liq(tmplayer) + ice(tmplayer)) - max_moist(tmplayer) liq(tmplayer) = max_moist(tmplayer) - ice(tmplayer) - else + ELSE tmp_inflow = 0.0 - endif - endif - end do - endif ! /** end trapped excess moisture **/ - endif ! /** end check if excess moisture in top layer **/ + ENDIF + ENDIF + ENDDO + ENDIF ! /** END trapped excess moisture **/ + ENDIF ! /** END check if excess moisture in top layer **/ ! verify that current layer moisture is greater than minimum - if (liq(lindex) < 0.0) then + IF (liq(lindex) < 0.0) THEN ! liquid cannot fall below 0 Q12(lindex) = Q12(lindex) + liq(lindex) liq(lindex) = 0.0 - endif + ENDIF - if ((liq(lindex) + ice(lindex)) < resid_moist(lindex)) then + IF ((liq(lindex) + ice(lindex)) < resid_moist(lindex)) THEN ! moisture cannot fall below minimum Q12(lindex) = Q12(lindex) + (liq(lindex) + ice(lindex)) - resid_moist(lindex) liq(lindex) = resid_moist(lindex) - ice(lindex) - endif + ENDIF inflow = Q12(lindex) + tmp_inflow Q12(lindex) = Q12(lindex) + tmp_inflow last_index = last_index + 1 - end do ! /* end loop through soil layers */ + ENDDO ! /* END loop through soil layers */ ! /************************************************** ! Compute Baseflow @@ -322,19 +322,19 @@ subroutine compute_vic_runoff(soil_con, ppt, frost_fract, cell) rel_moist = (liq(lindex) - resid_moist(lindex)) / & (max_moist(lindex) - resid_moist(lindex)) - ! Compute baseflow as function of relative moisture + ! Compute baseflow as FUNCTION of relative moisture frac = Dsmax * soil_con%Ds / soil_con%Ws dt_baseflow = frac * rel_moist - if (rel_moist > soil_con%Ws) then + IF (rel_moist > soil_con%Ws) THEN frac = (rel_moist - soil_con%Ws) / (1 - soil_con%Ws) dt_baseflow = dt_baseflow + Dsmax * (1 - soil_con%Ds / soil_con%Ws) * & frac ** soil_con%c - endif + ENDIF ! Make sure baseflow isn't negative - if (dt_baseflow < 0) then + IF (dt_baseflow < 0) THEN dt_baseflow = 0.0 - endif + ENDIF ! Extract baseflow from the bottom soil layer liq(lindex) = liq(lindex) + Q12(lindex - 1) - (evap(lindex, fidx) + dt_baseflow) @@ -346,41 +346,41 @@ subroutine compute_vic_runoff(soil_con, ppt, frost_fract, cell) ! * of baseflow and add back to soil to make up the difference ! * Note: this may lead to negative baseflow, in which case we will ! * reduce evap to make up for it */ - if ((liq(lindex) + ice(lindex)) < resid_moist(lindex)) then + IF ((liq(lindex) + ice(lindex)) < resid_moist(lindex)) THEN dt_baseflow = dt_baseflow + & (liq(lindex) + ice(lindex)) - resid_moist(lindex) liq(lindex) = resid_moist(lindex) - ice(lindex) - endif + ENDIF - if ((liq(lindex) + ice(lindex)) > max_moist(lindex)) then + IF ((liq(lindex) + ice(lindex)) > max_moist(lindex)) THEN ! soil moisture above maximum tmp_moist = (liq(lindex) + ice(lindex)) - max_moist(lindex) liq(lindex) = max_moist(lindex) - ice(lindex) tmplayer = lindex - do while (tmp_moist > 0) + DO WHILE (tmp_moist > 0) tmplayer = tmplayer - 1 - if (tmplayer < 1) then + IF (tmplayer < 1) THEN ! If top layer saturated, add to runoff runoff(fidx) = runoff(fidx) + tmp_moist tmp_moist = 0.0 - else + ELSE ! else if sublayer exists, add excess soil moisture liq(tmplayer) = liq(tmplayer) + tmp_moist - if ((liq(tmplayer) + ice(tmplayer)) > max_moist(tmplayer)) then + IF ((liq(tmplayer) + ice(tmplayer)) > max_moist(tmplayer)) THEN tmp_moist = (liq(tmplayer) + ice(tmplayer)) - max_moist(tmplayer) liq(tmplayer) = max_moist(tmplayer) - ice(tmplayer) - else + ELSE tmp_moist = 0.0 - endif - endif - end do - endif + ENDIF + ENDIF + ENDDO + ENDIF baseflow(fidx) = baseflow(fidx) + dt_baseflow - end do ! /* end of sub-dt time step loop */ + ENDDO ! /* END of sub-dt time step loop */ ! If negative baseflow, reduce evap accordingly - if (baseflow(fidx) < 0.0) then + IF (baseflow(fidx) < 0.0) THEN ! layer(lindex)%evap = layer(lindex)%evap + baseflow(fidx) !!!! need check baseflow(fidx) = 0.0 endif @@ -388,33 +388,33 @@ subroutine compute_vic_runoff(soil_con, ppt, frost_fract, cell) ! Recompute Asat based on final moisture level of upper layers do lindex = 1, Nlayer tmp_moist_for_runoff(lindex) = (liq(lindex) + ice(lindex)) - end do + enddo - call compute_runoff_and_asat(soil_con, tmp_moist_for_runoff, real(0.0, kind=r8), A, tmp_runoff) + CALL compute_runoff_and_asat(soil_con, tmp_moist_for_runoff, real(0.0, kind=r8), A, tmp_runoff) ! Store tile-wide values do lindex = 1, Nlayer layer(lindex)%moist = layer(lindex)%moist + & ((liq(lindex) + ice(lindex)) * frost_fract(fidx)) - end do + enddo cell%asat = cell%asat + A * frost_fract(fidx) cell%runoff = cell%runoff + runoff(fidx) * frost_fract(fidx) cell%baseflow = cell%baseflow + baseflow(fidx) * frost_fract(fidx) ! ! /** Compute water table depth **/ - ! call wrap_compute_zwt(soil_con, cell) + ! CALL wrap_compute_zwt(soil_con, cell) - end do + enddo - end subroutine compute_vic_runoff + END SUBROUTINE compute_vic_runoff ! ****************************************************************************** ! * @brief Calculate the saturated area and runoff ! ****************************************************************************** - subroutine compute_runoff_and_asat(soil_con, moist, inflow, A, runoff) + SUBROUTINE compute_runoff_and_asat(soil_con, moist, inflow, A, runoff) USE MOD_Hydro_VIC_Variables, only: soil_con_struct, Nlayer - implicit none + IMPLICIT NONE !-----------------------Arguments--------------------------------------- type(soil_con_struct), intent(in) :: soil_con real(r8), intent(in) :: moist(Nlayer) @@ -433,7 +433,7 @@ subroutine compute_runoff_and_asat(soil_con, moist, inflow, A, runoff) do lindex = 1, Nlayer - 1 top_moist = top_moist + moist(lindex) top_max_moist = top_max_moist + soil_con%max_moist(lindex) - end do + enddo if (top_moist > top_max_moist) then top_moist = top_max_moist endif @@ -461,30 +461,30 @@ subroutine compute_runoff_and_asat(soil_con, moist, inflow, A, runoff) if (runoff < 0.0) then runoff = 0.0 endif - end subroutine compute_runoff_and_asat + END SUBROUTINE compute_runoff_and_asat ! ****************************************************************************** ! * @brief Calculate drainage between two layers ! ****************************************************************************** - subroutine calc_Q12(Ksat, init_moist, resid_moist, max_moist, expt, Q12) - implicit none + SUBROUTINE calc_Q12(Ksat, init_moist, resid_moist, max_moist, expt, Q12) + IMPLICIT NONE real(r8), intent(in) :: Ksat, init_moist, resid_moist, max_moist, expt real(r8), intent(out) :: Q12 Q12 = init_moist - ((init_moist - resid_moist)**(1.0d0 - expt) - Ksat / & (max_moist - resid_moist)**expt * (1.0d0 - expt))**(1.0d0 / (1.0d0 - expt)) - resid_moist - end subroutine calc_Q12 + END SUBROUTINE calc_Q12 ! /****************************************************************************** ! * @brief Compute spatial average water table position (zwt). Water table ! * position is measured in cm and is negative below the soil surface. ! *****************************************************************************/ - subroutine compute_zwt(soil_con,lindex, moist, zwt) - use MOD_Hydro_VIC_Variables - implicit none + SUBROUTINE compute_zwt(soil_con,lindex, moist, zwt) + USE MOD_Hydro_VIC_Variables + IMPLICIT NONE !-----------------------Arguments--------------------------------------- type(soil_con_struct), intent(in) :: soil_con integer, intent(in) :: lindex @@ -501,21 +501,21 @@ subroutine compute_zwt(soil_con,lindex, moist, zwt) i = MAX_ZWTVMOIST - 1 do while (i >= 1 .and. moist > soil_con%zwtvmoist_moist(lindex, i)) i = i - 1 - end do + enddo if (i == MAX_ZWTVMOIST - 1) then if (moist < soil_con%zwtvmoist_moist(lindex, i)) then zwt = 999.0 ! 999 indicates water table not present in this layer else if (moist == soil_con%zwtvmoist_moist(lindex, i)) then zwt = soil_con%zwtvmoist_zwt(lindex, i) ! Just barely enough water for a water table - end if + endif else zwt = soil_con%zwtvmoist_zwt(lindex, i+1) + & (soil_con%zwtvmoist_zwt(lindex, i) - soil_con%zwtvmoist_zwt(lindex, i+1)) * & (moist - soil_con%zwtvmoist_moist(lindex, i+1)) / & (soil_con%zwtvmoist_moist(lindex, i) - soil_con%zwtvmoist_moist(lindex, i+1)) - end if - end subroutine compute_zwt + endif + END SUBROUTINE compute_zwt ! /****************************************************************************** @@ -524,9 +524,9 @@ end subroutine compute_zwt ! * Water table position is measured in cm and is negative below the ! * soil surface. ! *****************************************************************************/ - subroutine wrap_compute_zwt(soil_con, cell) - use MOD_Hydro_VIC_Variables - implicit none + SUBROUTINE wrap_compute_zwt(soil_con, cell) + USE MOD_Hydro_VIC_Variables + IMPLICIT NONE !-----------------------Arguments--------------------------------------- type(soil_con_struct), intent(in) :: soil_con @@ -545,15 +545,15 @@ subroutine wrap_compute_zwt(soil_con, cell) total_depth = 0.0 do lindex = 1, Nlayer total_depth = total_depth + soil_con%depth(lindex) - end do + enddo ! /** Compute each layer's zwt using soil moisture v zwt curve **/ do lindex = 1, Nlayer - call compute_zwt(soil_con, lindex, cell%layer(lindex)%moist, cell%layer(lindex)%zwt) - end do + CALL compute_zwt(soil_con, lindex, cell%layer(lindex)%moist, cell%layer(lindex)%zwt) + enddo if (cell%layer(Nlayer)%zwt == 999) then cell%layer(Nlayer)%zwt = -total_depth * CM_PER_M - end if + endif ! /** Compute total soil column's zwt; this will be the zwt of the lowest layer that isn't completely saturated **/ idx = Nlayer @@ -561,7 +561,7 @@ subroutine wrap_compute_zwt(soil_con, cell) do while (idx >= 1 .and. soil_con%max_moist(idx) - cell%layer(idx)%moist <= DBL_EPSILON) tmp_depth = tmp_depth - soil_con%depth(idx) idx = idx - 1 - end do + enddo if (idx < 1) then cell%zwt = 0.0 else if (idx < Nlayer) then @@ -569,20 +569,20 @@ subroutine wrap_compute_zwt(soil_con, cell) cell%zwt = cell%layer(idx)%zwt else cell%zwt = -tmp_depth * CM_PER_M - end if + endif else cell%zwt = cell%layer(idx)%zwt - end if + endif ! /** Compute total soil column's zwt_lumped; this will be the zwt of all N layers lumped together. **/ tmp_moist = 0.0 do lindex = 1, Nlayer tmp_moist = tmp_moist + cell%layer(lindex)%moist - end do - call compute_zwt(soil_con, Nlayer + 1, tmp_moist, cell%zwt_lumped) + enddo + CALL compute_zwt(soil_con, Nlayer + 1, tmp_moist, cell%zwt_lumped) if (cell%zwt_lumped == 999) then cell%zwt_lumped = -total_depth * CM_PER_M ! // in cm; - end if - end subroutine wrap_compute_zwt -end module MOD_Hydro_VIC + endif + END SUBROUTINE wrap_compute_zwt +END MODULE MOD_Hydro_VIC diff --git a/main/HYDRO/MOD_Hydro_VIC_Variables.F90 b/main/HYDRO/MOD_Hydro_VIC_Variables.F90 index 39f2acb5..85454f07 100644 --- a/main/HYDRO/MOD_Hydro_VIC_Variables.F90 +++ b/main/HYDRO/MOD_Hydro_VIC_Variables.F90 @@ -1,6 +1,6 @@ -module MOD_Hydro_VIC_Variables +MODULE MOD_Hydro_VIC_Variables USE MOD_Precision - implicit none + IMPLICIT NONE ! /***** Define the number of layers used in VIC *****/ integer, parameter :: Nlayer = 3 !/**< Number of soil moisture layers in model */ @@ -23,7 +23,7 @@ module MOD_Hydro_VIC_Variables real(r8) :: moist ! /**< moisture content of the unfrozen sublayer (mm) */ real(r8) :: evap ! /**< evapotranspiration from soil layer (mm) */ real(r8) :: zwt ! /**< water table position relative to soil surface within the layer (cm) */ - end type layer_data_struct + END type layer_data_struct ! /****************************************************************************** ! * @brief This structure stores soil variables for the complete soil column @@ -37,7 +37,7 @@ module MOD_Hydro_VIC_Variables !!! for zwt calcaulation, not used real(r8) :: zwt ! /**< average water table position [cm] - using lowest unsaturated layer */ real(r8) :: zwt_lumped ! /**< average water table position [cm] - lumping all layers' moisture together */ - end type cell_data_struct + END type cell_data_struct ! /****************************************************************************** ! * @brief This structure stores the soil parameters for a grid cell. @@ -59,18 +59,18 @@ module MOD_Hydro_VIC_Variables 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 */ - end type soil_con_struct + END type soil_con_struct -contains +CONTAINS - subroutine vic_para(porsl, theta_r, hksati, bsw, wice_soisno, wliq_soisno, fevpg, rootflux, & + SUBROUTINE vic_para(porsl, theta_r, hksati, bsw, wice_soisno, wliq_soisno, fevpg, rootflux, & b_infilt, Dsmax, Ds, Ws, c, & soil_con, cell) USE MOD_Precision USE MOD_Vars_Global - implicit none + IMPLICIT NONE type(soil_con_struct) , intent(inout) :: soil_con type(cell_data_struct), intent(inout) :: cell @@ -85,26 +85,26 @@ subroutine vic_para(porsl, theta_r, hksati, bsw, wice_soisno, wliq_soisno, fevpg integer :: lb, lp, k, ilay real(r8) :: dltime !int(DEF_simulation_time%timestep) - !-----------------------End Variable List------------------------------- + !-----------------------END Variable List------------------------------- dltime = DEF_simulation_time%timestep - call CoLM2VIC(dz_soi, soil_tmp) + CALL CoLM2VIC(dz_soi, soil_tmp) soil_con%depth = soil_tmp - call CoLM2VIC_weight(porsl, soil_tmp) + CALL CoLM2VIC_weight(porsl, soil_tmp) ! convert - to mm soil_con%max_moist = soil_tmp*soil_con%depth*1000 - call CoLM2VIC_weight(theta_r, soil_tmp) + CALL CoLM2VIC_weight(theta_r, soil_tmp) ! convert - to mm soil_con%resid_moist = soil_tmp*soil_con%depth*1000 - call CoLM2VIC_weight(hksati, soil_tmp) + CALL CoLM2VIC_weight(hksati, soil_tmp) ! convert mm/s to mm/day soil_con%Ksat = soil_tmp*86400 - call CoLM2VIC_weight(bsw, soil_tmp) + CALL CoLM2VIC_weight(bsw, soil_tmp) ! 2*lambda+3 soil_con%expt = soil_tmp*2+3 @@ -115,62 +115,62 @@ subroutine vic_para(porsl, theta_r, hksati, bsw, wice_soisno, wliq_soisno, fevpg soil_con%c = c soil_con%frost_fract = 1 - if (sum(wice_soisno)>0) THEN + IF (sum(wice_soisno)>0) THEN Nfrost = 3 - do k = 1, Nfrost - if (Nfrost == 1) then + DO k = 1, Nfrost + IF (Nfrost == 1) THEN soil_con%frost_fract(k) = 1.0 - else if (Nfrost == 2) then + ELSEIF (Nfrost == 2) THEN soil_con%frost_fract(k) = 0.5 - else + ELSE soil_con%frost_fract(k) = 1.0 / real(Nfrost - 1, kind=8) - if (k == 1 .or. k == Nfrost) then + IF (k == 1 .or. k == Nfrost) THEN soil_con%frost_fract(k) = soil_con%frost_fract(k) / 2.0 - endif - endif - end do - endif + ENDIF + ENDIF + ENDDO + ENDIF - call CoLM2VIC(wliq_soisno, soil_tmp) - do ilay = 1, Nlayer + CALL CoLM2VIC(wliq_soisno, soil_tmp) + DO ilay = 1, Nlayer ! mm cell%layer(ilay)%moist = soil_tmp(ilay) - enddo + ENDDO - do ilay=1, Nlayer + DO ilay=1, Nlayer cell%layer(ilay)%ice(:) = 0 - enddo + ENDDO - if (sum(wice_soisno)>0) THEN - do ilay = 1, Nlayer + IF (sum(wice_soisno)>0) THEN + DO ilay = 1, Nlayer lp = colm2vic_lay(ilay) - if (ilay==1) THEN + IF (ilay==1) THEN lb = 1 - else + ELSE lb = colm2vic_lay(ilay-1)+1 - endif - call VIC_IceLay(lb, lp, wice_soisno(lb:lp), ice_tmp) + ENDIF + CALL VIC_IceLay(lb, lp, wice_soisno(lb:lp), ice_tmp) cell%layer(ilay)%ice(:) = ice_tmp - enddo - ! else - ! do ilay = 1, Nlayer + ENDDO + ! ELSE + ! DO ilay = 1, Nlayer ! cell%layer(ilay)%ice(:) = 0 - ! enddo - endif + ! ENDDO + ENDIF - call CoLM2VIC(rootflux, soil_tmp) + CALL CoLM2VIC(rootflux, soil_tmp) ! mm/s*dltime to convert to mm - do ilay = 1, Nlayer + DO ilay = 1, Nlayer cell%layer(ilay)%evap = soil_tmp(ilay)*dltime - enddo + ENDDO cell%layer(1)%evap = cell%layer(1)%evap + fevpg*dltime - end subroutine vic_para + END SUBROUTINE vic_para - subroutine VIC_IceLay(lb, lp, colm_ice, vic_ice) + SUBROUTINE VIC_IceLay(lb, lp, colm_ice, vic_ice) - implicit none + IMPLICIT NONE !-----------------------Arguments--------------------------------------- integer , intent(in ) :: lb integer , intent(in ) :: lp @@ -182,114 +182,114 @@ subroutine VIC_IceLay(lb, lp, colm_ice, vic_ice) real(kind=8) :: multiplier real(kind=8) :: ice_tmp(lp-lb+1) integer :: vic_lay=3 - !-----------------------End Variable List------------------------------- + !-----------------------END Variable List------------------------------- colm_lay = lp - lb + 1 ice_tmp = colm_ice totalSum = sum(ice_tmp) - if (colm_lay == 1) THEN + IF (colm_lay == 1) THEN vic_ice = totalSum / vic_lay - elseif (colm_lay == 2) THEN + ELSEIF (colm_lay == 2) THEN vic_ice(1) = ice_tmp(1) * 2.0 / vic_lay vic_ice(3) = ice_tmp(2) * 2.0 / vic_lay - elseif (colm_lay == 3) THEN + ELSEIF (colm_lay == 3) THEN vic_ice = ice_tmp - else - do idx = 1, min(int((colm_lay-1)/vic_lay), vic_lay) + ELSE + DO idx = 1, min(int((colm_lay-1)/vic_lay), vic_lay) multiplier = merge(1.0, 0.0, colm_lay > idx*vic_lay) vic_ice(1) = vic_ice(1) + ice_tmp(idx) * multiplier vic_ice(3) = vic_ice(3) + ice_tmp(colm_lay-idx+1) * multiplier - enddo + ENDDO multiplier = merge((colm_lay-idx*vic_lay)/vic_lay, 0, colm_lay <= (idx+1)*vic_lay) vic_ice(1) = vic_ice(1) + ice_tmp(idx+1) * multiplier vic_ice(3) = vic_ice(3) + ice_tmp(colm_lay-idx) * multiplier - endif + ENDIF vic_ice(2) = totalSum - vic_ice(1) - vic_ice(3) - end subroutine VIC_Icelay + END SUBROUTINE VIC_Icelay - subroutine CoLM2VIC(colm_water, vic_water) + SUBROUTINE CoLM2VIC(colm_water, vic_water) USE MOD_Vars_Global - implicit none + IMPLICIT NONE !-----------------------Arguments--------------------------------------- real, intent(in ) :: colm_water(1:nl_soil) real, intent(out) :: vic_water(Nlayer) !-----------------------Local variables--------------------------------- integer :: i_colm, i_vic - !-----------------------End Variable List------------------------------- + !-----------------------END Variable List------------------------------- - do i_vic = 1, Nlayer + DO i_vic = 1, Nlayer vic_water(i_vic) = 0 - if (i_vic == 1) then - do i_colm = 1, colm2vic_lay(i_vic) + IF (i_vic == 1) THEN + DO i_colm = 1, colm2vic_lay(i_vic) vic_water(i_vic) = vic_water(i_vic) + colm_water(i_colm) - end do - else - do i_colm = colm2vic_lay(i_vic-1)+1, colm2vic_lay(i_vic) + ENDDO + ELSE + DO i_colm = colm2vic_lay(i_vic-1)+1, colm2vic_lay(i_vic) vic_water(i_vic) = vic_water(i_vic) + colm_water(i_colm) - end do - endif - end do + ENDDO + ENDIF + ENDDO - end subroutine CoLM2VIC + END SUBROUTINE CoLM2VIC - subroutine CoLM2VIC_weight(colm_water, vic_water) + SUBROUTINE CoLM2VIC_weight(colm_water, vic_water) USE MOD_Vars_Global - implicit none + IMPLICIT NONE !-----------------------Arguments--------------------------------------- real, intent(in ) :: colm_water(1:nl_soil) real, intent(out) :: vic_water(Nlayer) !-----------------------Local variables--------------------------------- integer :: i_colm, i_vic - !-----------------------End Variable List------------------------------- + !-----------------------END Variable List------------------------------- - do i_vic = 1, Nlayer + DO i_vic = 1, Nlayer vic_water(i_vic) = 0 - if (i_vic == 1) then - do i_colm = 1, colm2vic_lay(i_vic) + IF (i_vic == 1) THEN + DO i_colm = 1, colm2vic_lay(i_vic) vic_water(i_vic) = vic_water(i_vic) + colm_water(i_colm)*dz_soi(i_colm) - end do + ENDDO vic_water(i_vic) = vic_water(i_vic)/sum(dz_soi(1:colm2vic_lay(i_vic))) - else - do i_colm = colm2vic_lay(i_vic-1)+1, colm2vic_lay(i_vic) + ELSE + DO i_colm = colm2vic_lay(i_vic-1)+1, colm2vic_lay(i_vic) vic_water(i_vic) = vic_water(i_vic) + colm_water(i_colm)*dz_soi(i_colm) - end do + ENDDO vic_water(i_vic) = vic_water(i_vic)/sum(dz_soi(colm2vic_lay(i_vic-1)+1:colm2vic_lay(i_vic))) - endif - end do + ENDIF + ENDDO - end subroutine CoLM2VIC_weight + END SUBROUTINE CoLM2VIC_weight - subroutine VIC2CoLM(colm_water, vic_water) + SUBROUTINE VIC2CoLM(colm_water, vic_water) USE MOD_Vars_Global - implicit none + IMPLICIT NONE !-----------------------Arguments--------------------------------------- real, intent(in ) :: vic_water(Nlayer) real, intent(inout) :: colm_water(1:nl_soil) !-----------------------Local variables--------------------------------- integer :: i_colm, i_vic - !-----------------------End Variable List------------------------------- + !-----------------------END Variable List------------------------------- - do i_vic = 1, Nlayer - if (i_vic == 1) then - do i_colm = 1, colm2vic_lay(i_vic) + DO i_vic = 1, Nlayer + IF (i_vic == 1) THEN + DO i_colm = 1, colm2vic_lay(i_vic) colm_water(i_colm) = vic_water(i_vic)*(dz_soi(i_colm)/sum(dz_soi(1:colm2vic_lay(i_vic)))) - end do - else - do i_colm = colm2vic_lay(i_vic-1)+1, colm2vic_lay(i_vic) + ENDDO + ELSE + DO i_colm = colm2vic_lay(i_vic-1)+1, colm2vic_lay(i_vic) colm_water(i_colm) = vic_water(i_vic)*(dz_soi(i_colm)/sum(dz_soi(colm2vic_lay(i_vic-1)+1:colm2vic_lay(i_vic)))) - end do - endif - end do + ENDDO + ENDIF + ENDDO - end subroutine VIC2CoLM + END SUBROUTINE VIC2CoLM -end module MOD_Hydro_VIC_Variables +END MODULE MOD_Hydro_VIC_Variables diff --git a/main/LULCC/MOD_Lulcc_Driver.F90 b/main/LULCC/MOD_Lulcc_Driver.F90 index 7c9eabff..e6980e32 100644 --- a/main/LULCC/MOD_Lulcc_Driver.F90 +++ b/main/LULCC/MOD_Lulcc_Driver.F90 @@ -28,7 +28,10 @@ SUBROUTINE LulccDriver (casename,dir_landdata,dir_restart,& ! 08/2023, Wanyi Lin: add interface for Mass&Energy conserved scheme. ! !----------------------------------------------------------------------- -! Extra processes when adding a new variable and #define LULCC: +! +! ***** For Development ***** +! +! 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: diff --git a/main/LULCC/MOD_Lulcc_Initialize.F90 b/main/LULCC/MOD_Lulcc_Initialize.F90 index 662e45cd..a852a68c 100644 --- a/main/LULCC/MOD_Lulcc_Initialize.F90 +++ b/main/LULCC/MOD_Lulcc_Initialize.F90 @@ -47,7 +47,7 @@ SUBROUTINE LulccInitialize (casename,dir_landdata,dir_restart,& USE MOD_Vars_TimeVariables USE MOD_Initialize #ifdef SrfdataDiag - USE MOD_SrfdataDiag, only : gdiag, srfdata_diag_init + USE MOD_SrfdataDiag, only: gdiag, srfdata_diag_init #endif IMPLICIT NONE diff --git a/main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90 b/main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90 index 65306ba4..ef50692c 100644 --- a/main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90 +++ b/main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90 @@ -132,8 +132,8 @@ SUBROUTINE SAVE_LulccTimeInvariants IF (p_is_worker) THEN IF (numpatch > 0) THEN - CALL copy_pixelset(landpatch, landpatch_) - CALL copy_pixelset(landelm , landelm_ ) + CALL copy_pixelset (landpatch, landpatch_ ) + CALL copy_pixelset (landelm , landelm_ ) numpatch_ = numpatch numelm_ = numelm patchclass_ (:) = patchclass (:) diff --git a/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 b/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 index 7765c747..24689933 100644 --- a/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 +++ b/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 @@ -6,9 +6,7 @@ MODULE MOD_Lulcc_Vars_TimeVariables ! ! Created by Hua Yuan, 04/2022 ! -! ! !REVISIONS: -! ! 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 @@ -1000,11 +998,11 @@ SUBROUTINE REST_LulccTimeVariables ENDIF IF (p_is_worker) THEN - IF (allocated(grid_patch_s )) deallocate(grid_patch_s ) - IF (allocated(grid_patch_e )) deallocate(grid_patch_e ) - IF (allocated(grid_patch_s_)) deallocate(grid_patch_s_) - IF (allocated(grid_patch_e_)) deallocate(grid_patch_e_) - IF (allocated(locpxl )) deallocate(locpxl ) + IF (allocated(grid_patch_s )) deallocate (grid_patch_s ) + IF (allocated(grid_patch_e )) deallocate (grid_patch_e ) + IF (allocated(grid_patch_s_)) deallocate (grid_patch_s_ ) + IF (allocated(grid_patch_e_)) deallocate (grid_patch_e_ ) + IF (allocated(locpxl )) deallocate (locpxl ) ENDIF END SUBROUTINE REST_LulccTimeVariables @@ -1019,180 +1017,180 @@ SUBROUTINE deallocate_LulccTimeVariables ! -------------------------------------------------- IF (p_is_worker) THEN IF (numpatch_ > 0) THEN - deallocate (z_sno_ ) - deallocate (dz_sno_ ) - deallocate (t_soisno_ ) - deallocate (wliq_soisno_ ) - deallocate (wice_soisno_ ) - deallocate (smp_ ) - deallocate (hk_ ) - deallocate (t_grnd_ ) - deallocate (tleaf_ ) - deallocate (ldew_ ) - deallocate (ldew_rain_ ) - deallocate (ldew_snow_ ) - deallocate (fwet_snow_ ) - deallocate (sag_ ) - deallocate (scv_ ) - deallocate (snowdp_ ) - deallocate (fsno_ ) - deallocate (sigf_ ) - deallocate (zwt_ ) - deallocate (wa_ ) - deallocate (wdsrf_ ) - deallocate (rss_ ) - - deallocate (t_lake_ ) - deallocate (lake_icefrac_ ) - deallocate (savedtke1_ ) + deallocate (z_sno_ ) + deallocate (dz_sno_ ) + deallocate (t_soisno_ ) + deallocate (wliq_soisno_ ) + deallocate (wice_soisno_ ) + deallocate (smp_ ) + deallocate (hk_ ) + deallocate (t_grnd_ ) + deallocate (tleaf_ ) + deallocate (ldew_ ) + deallocate (ldew_rain_ ) + deallocate (ldew_snow_ ) + deallocate (fwet_snow_ ) + deallocate (sag_ ) + deallocate (scv_ ) + deallocate (snowdp_ ) + deallocate (fsno_ ) + deallocate (sigf_ ) + deallocate (zwt_ ) + deallocate (wa_ ) + deallocate (wdsrf_ ) + deallocate (rss_ ) + + deallocate (t_lake_ ) + deallocate (lake_icefrac_ ) + deallocate (savedtke1_ ) !Plant Hydraulic variables - deallocate (vegwp_ ) - deallocate (gs0sun_ ) - deallocate (gs0sha_ ) + deallocate (vegwp_ ) + deallocate (gs0sun_ ) + deallocate (gs0sha_ ) !END plant hydraulic variables !Ozone Stress variables - deallocate (lai_old_ ) - deallocate (o3uptakesun_ ) - deallocate (o3uptakesha_ ) + deallocate (lai_old_ ) + deallocate (o3uptakesun_ ) + deallocate (o3uptakesha_ ) !End ozone stress variables - deallocate (snw_rds_ ) - deallocate (mss_bcpho_ ) - deallocate (mss_bcphi_ ) - deallocate (mss_ocpho_ ) - deallocate (mss_ocphi_ ) - deallocate (mss_dst1_ ) - deallocate (mss_dst2_ ) - deallocate (mss_dst3_ ) - deallocate (mss_dst4_ ) - deallocate (ssno_lyr_ ) - - deallocate (trad_ ) - deallocate (tref_ ) - deallocate (qref_ ) - deallocate (rst_ ) - deallocate (emis_ ) - deallocate (z0m_ ) - deallocate (zol_ ) - deallocate (rib_ ) - deallocate (ustar_ ) - deallocate (qstar_ ) - deallocate (tstar_ ) - deallocate (fm_ ) - deallocate (fh_ ) - deallocate (fq_ ) - - deallocate (sum_irrig_ ) - deallocate (sum_irrig_count_) + deallocate (snw_rds_ ) + deallocate (mss_bcpho_ ) + deallocate (mss_bcphi_ ) + deallocate (mss_ocpho_ ) + deallocate (mss_ocphi_ ) + deallocate (mss_dst1_ ) + deallocate (mss_dst2_ ) + deallocate (mss_dst3_ ) + deallocate (mss_dst4_ ) + deallocate (ssno_lyr_ ) + + deallocate (trad_ ) + deallocate (tref_ ) + deallocate (qref_ ) + deallocate (rst_ ) + deallocate (emis_ ) + deallocate (z0m_ ) + deallocate (zol_ ) + deallocate (rib_ ) + deallocate (ustar_ ) + deallocate (qstar_ ) + deallocate (tstar_ ) + deallocate (fm_ ) + deallocate (fh_ ) + deallocate (fq_ ) + + deallocate (sum_irrig_ ) + deallocate (sum_irrig_count_ ) ENDIF #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) IF (numpft_ > 0) THEN - deallocate (tleaf_p_ ) - deallocate (ldew_p_ ) - deallocate (ldew_rain_p_ ) - deallocate (ldew_snow_p_ ) - deallocate (fwet_snow_p_ ) - deallocate (sigf_p_ ) - deallocate (tref_p_ ) - deallocate (qref_p_ ) - deallocate (rst_p_ ) - deallocate (z0m_p_ ) + deallocate (tleaf_p_ ) + deallocate (ldew_p_ ) + deallocate (ldew_rain_p_ ) + deallocate (ldew_snow_p_ ) + deallocate (fwet_snow_p_ ) + deallocate (sigf_p_ ) + deallocate (tref_p_ ) + deallocate (qref_p_ ) + deallocate (rst_p_ ) + deallocate (z0m_p_ ) ! Plant Hydraulic variables - deallocate (vegwp_p_ ) - deallocate (gs0sun_p_ ) - deallocate (gs0sha_p_ ) + deallocate (vegwp_p_ ) + deallocate (gs0sun_p_ ) + deallocate (gs0sha_p_ ) ! end plant hydraulic variables ! Allocate Ozone Stress Variables - deallocate (lai_old_p_ ) - deallocate (o3uptakesun_p_) - deallocate (o3uptakesha_p_) + deallocate (lai_old_p_ ) + deallocate (o3uptakesun_p_ ) + deallocate (o3uptakesha_p_ ) ! End allocate Ozone Stress Variables ENDIF #endif #ifdef URBAN_MODEL IF (numurban_ > 0) THEN - deallocate (fwsun_ ) - deallocate (dfwsun_ ) - - deallocate (sroof_ ) - deallocate (swsun_ ) - deallocate (swsha_ ) - deallocate (sgimp_ ) - deallocate (sgper_ ) - deallocate (slake_ ) - - deallocate (lwsun_ ) - deallocate (lwsha_ ) - deallocate (lgimp_ ) - deallocate (lgper_ ) - deallocate (lveg_ ) - - deallocate (z_sno_roof_ ) - deallocate (z_sno_gimp_ ) - deallocate (z_sno_gper_ ) - deallocate (z_sno_lake_ ) - - deallocate (dz_sno_roof_ ) - deallocate (dz_sno_gimp_ ) - deallocate (dz_sno_gper_ ) - deallocate (dz_sno_lake_ ) - - deallocate (t_roofsno_ ) - deallocate (t_wallsun_ ) - deallocate (t_wallsha_ ) - deallocate (t_gimpsno_ ) - deallocate (t_gpersno_ ) - deallocate (t_lakesno_ ) - - deallocate (troof_inner_ ) - deallocate (twsun_inner_ ) - deallocate (twsha_inner_ ) - - deallocate (wliq_roofsno_ ) - deallocate (wice_roofsno_ ) - deallocate (wliq_gimpsno_ ) - deallocate (wice_gimpsno_ ) - deallocate (wliq_gpersno_ ) - deallocate (wice_gpersno_ ) - deallocate (wliq_lakesno_ ) - deallocate (wice_lakesno_ ) - - deallocate (sag_roof_ ) - deallocate (sag_gimp_ ) - deallocate (sag_gper_ ) - deallocate (sag_lake_ ) - deallocate (scv_roof_ ) - deallocate (scv_gimp_ ) - deallocate (scv_gper_ ) - deallocate (scv_lake_ ) - deallocate (fsno_roof_ ) - deallocate (fsno_gimp_ ) - deallocate (fsno_gper_ ) - deallocate (fsno_lake_ ) - deallocate (snowdp_roof_ ) - deallocate (snowdp_gimp_ ) - deallocate (snowdp_gper_ ) - deallocate (snowdp_lake_ ) - - deallocate (Fhac_ ) - deallocate (Fwst_ ) - deallocate (Fach_ ) - deallocate (Fahe_ ) - deallocate (Fhah_ ) - deallocate (vehc_ ) - deallocate (meta_ ) - deallocate (t_room_ ) - deallocate (t_roof_ ) - deallocate (t_wall_ ) - deallocate (tafu_ ) - deallocate (urb_green_ ) + deallocate (fwsun_ ) + deallocate (dfwsun_ ) + + deallocate (sroof_ ) + deallocate (swsun_ ) + deallocate (swsha_ ) + deallocate (sgimp_ ) + deallocate (sgper_ ) + deallocate (slake_ ) + + deallocate (lwsun_ ) + deallocate (lwsha_ ) + deallocate (lgimp_ ) + deallocate (lgper_ ) + deallocate (lveg_ ) + + deallocate (z_sno_roof_ ) + deallocate (z_sno_gimp_ ) + deallocate (z_sno_gper_ ) + deallocate (z_sno_lake_ ) + + deallocate (dz_sno_roof_ ) + deallocate (dz_sno_gimp_ ) + deallocate (dz_sno_gper_ ) + deallocate (dz_sno_lake_ ) + + deallocate (t_roofsno_ ) + deallocate (t_wallsun_ ) + deallocate (t_wallsha_ ) + deallocate (t_gimpsno_ ) + deallocate (t_gpersno_ ) + deallocate (t_lakesno_ ) + + deallocate (troof_inner_ ) + deallocate (twsun_inner_ ) + deallocate (twsha_inner_ ) + + deallocate (wliq_roofsno_ ) + deallocate (wice_roofsno_ ) + deallocate (wliq_gimpsno_ ) + deallocate (wice_gimpsno_ ) + deallocate (wliq_gpersno_ ) + deallocate (wice_gpersno_ ) + deallocate (wliq_lakesno_ ) + deallocate (wice_lakesno_ ) + + deallocate (sag_roof_ ) + deallocate (sag_gimp_ ) + deallocate (sag_gper_ ) + deallocate (sag_lake_ ) + deallocate (scv_roof_ ) + deallocate (scv_gimp_ ) + deallocate (scv_gper_ ) + deallocate (scv_lake_ ) + deallocate (fsno_roof_ ) + deallocate (fsno_gimp_ ) + deallocate (fsno_gper_ ) + deallocate (fsno_lake_ ) + deallocate (snowdp_roof_ ) + deallocate (snowdp_gimp_ ) + deallocate (snowdp_gper_ ) + deallocate (snowdp_lake_ ) + + deallocate (Fhac_ ) + deallocate (Fwst_ ) + deallocate (Fach_ ) + deallocate (Fahe_ ) + deallocate (Fhah_ ) + deallocate (vehc_ ) + deallocate (meta_ ) + deallocate (t_room_ ) + deallocate (t_roof_ ) + deallocate (t_wall_ ) + deallocate (tafu_ ) + deallocate (urb_green_ ) ENDIF #endif ENDIF diff --git a/main/MOD_3DCanopyRadiation.F90 b/main/MOD_3DCanopyRadiation.F90 index 322c6bf9..8f2e9b57 100644 --- a/main/MOD_3DCanopyRadiation.F90 +++ b/main/MOD_3DCanopyRadiation.F90 @@ -52,7 +52,7 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) ! ! Created by Hua Yuan, 08/2019 ! -! !REFERENCE: +! !REFERENCES: ! Yuan, H., R. E. Dickinson, Y. Dai, M. J. Shaikh, L. Zhou, W. Shangguan, ! and D. Ji, 2014: A 3D canopy radiative transfer model for global climate ! modeling: Description, validation, and application. Journal of Climate, @@ -280,7 +280,7 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & ! Before 2013: Robert E. Dickinson proposed the initial idea. Dickinson and ! Muhammad J. Shake contributed to the code writing. ! -! !REFERENCE: +! !REFERENCES: ! Yuan, H., R. E. Dickinson, Y. Dai, M. J. Shaikh, L. Zhou, W. Shangguan, ! and D. Ji, 2014: A 3D canopy radiative transfer model for global climate ! modeling: Description, validation, and application. Journal of Climate, @@ -487,7 +487,7 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & IF ( lsai(ip)>1.e-6_r8 .and. fcover(ip)>D0 ) THEN soilveg(ip) = .true. - nsoilveg = nsoilveg + 1 + nsoilveg = nsoilveg + 1 clev = canlay(ip) fc0(clev) = fc0(clev) + fcover(ip) diff --git a/main/MOD_Albedo.F90 b/main/MOD_Albedo.F90 index 70866e3b..0d214e69 100644 --- a/main/MOD_Albedo.F90 +++ b/main/MOD_Albedo.F90 @@ -27,7 +27,7 @@ MODULE MOD_Albedo !----------------------------------------------------------------------- - SUBROUTINE albland (ipatch, patchtype, deltim,& + SUBROUTINE albland (ipatch,patchtype,deltim,& soil_s_v_alb,soil_d_v_alb,soil_s_n_alb,soil_d_n_alb,& chil,rho,tau,fveg,green,lai,sai,fwet_snow,coszen,& wt,fsno,scv,scvold,sag,ssw,pg_snow,forc_t,t_grnd,t_soisno,dz_soisno,& @@ -57,7 +57,7 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& ! 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 +! 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 @@ -287,13 +287,12 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& ! microphysics and albedo evolution, JGR, and Brun (1989), Investigation of ! wet-snow metamorphism in respect of liquid-water content, Ann. Glacial. - CALL SnowAge_grain( deltim ,snl ,dz_soisno(:1) ,& - pg_snow ,snwcp_ice ,snofrz ,& + CALL SnowAge_grain( deltim ,snl ,dz_soisno(:1) ,& + pg_snow ,snwcp_ice ,snofrz ,& - do_capsnow ,fsno ,scv ,& - wliq_soisno (:0),wice_soisno(:0),& - t_soisno (:1),t_grnd ,& - forc_t ,snw_rds ) + do_capsnow ,fsno ,scv ,& + wliq_soisno(:0),wice_soisno(:0),t_soisno(:1) ,& + t_grnd ,forc_t ,snw_rds ) ENDIF ! ---------------------------------------------------------------------- @@ -315,12 +314,12 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& albg(:,2) = albg(:,1) !diffused albedos setting ! 2.2 albedos for permanent ice sheet. - ELSE IF(patchtype == 3) THEN !permanent ice sheet + ELSEIF (patchtype == 3) THEN !permanent ice sheet albg(1,:) = 0.8 albg(2,:) = 0.55 ! 2.3 albedo for inland water - ELSE IF(patchtype >= 4) THEN + ELSEIF (patchtype >= 4) THEN albg0 = 0.05/(czen+0.15) albg(:,1) = albg0 albg(:,2) = 0.1 !Subin (2012) @@ -471,10 +470,10 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, fwet_snow, & !----------------------------------------------------------------------- ! -! calculation of canopy albedos via two stream approximation (direct -! and diffuse ) and partition of incident solar +! calculation of canopy albedos via two stream approximation (direct +! and diffuse ) and partition of incident solar ! -! Original author: Yongjiu Dai, June 11, 2001 +! Original author: Yongjiu Dai, June 11, 2001 ! !----------------------------------------------------------------------- @@ -589,9 +588,9 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, fwet_snow, & IF (abs(phi1).gt.1.e-6 .and. abs(phi2).gt.1.e-6) THEN zmu = 1. / phi2 * ( 1. - phi1 / phi2 * log ( ( phi1 + phi2 ) / phi1 ) ) - ELSE IF (abs(phi1).le.1.e-6) THEN + ELSEIF (abs(phi1).le.1.e-6) THEN zmu = 1./0.877 - ELSE IF (abs(phi2).le.1.e-6) THEN + ELSEIF (abs(phi2).le.1.e-6) THEN zmu = 1./(2.*phi1) ENDIF zmu2 = zmu * zmu @@ -801,14 +800,15 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, fwet_snow, & ! !DESCRIPTION: ! An improved two stream approximation ! -! Original author: Yongjiu Dai, June 11, 2001 +! Original author: Yongjiu Dai, June 11, 2001 ! Hua Yuan, 03/2020 ! -! REFERENCES: -! 1) Yuan, H., Dai, Y., Dickinson, R. E., Pinty, B., Shangguan, W., Zhang, S., -! et al. (2017). Reexamination and further development of two-stream canopy -! radiative transfer models for global land modeling. Journal of Advances in -! Modeling Earth Systems, 9(1), 113–129. https://doi.org/10.1002/2016MS000773 +! !REFERENCES: +! 1) Yuan, H., Dai, Y., Dickinson, R. E., Pinty, B., Shangguan, W., +! Zhang, S., et al. (2017). Reexamination and further development of +! two-stream canopy radiative transfer models for global land modeling. +! Journal of Advances in Modeling Earth Systems, 9(1), 113–129. +! https://doi.org/10.1002/2016MS000773 ! !----------------------------------------------------------------------- @@ -925,9 +925,9 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, fwet_snow, & IF (abs(phi1).gt.1.e-6 .and. abs(phi2).gt.1.e-6) THEN zmu = 1. / phi2 * ( 1. - phi1 / phi2 * log ( ( phi1 + phi2 ) / phi1 ) ) - ELSE IF (abs(phi1).le.1.e-6) THEN + ELSEIF (abs(phi1).le.1.e-6) THEN zmu = 1./0.877 - ELSE IF (abs(phi2).le.1.e-6) THEN + ELSEIF (abs(phi2).le.1.e-6) THEN zmu = 1./(2.*phi1) ENDIF zmu2 = zmu * zmu @@ -1170,7 +1170,7 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, fwet_snow, & ENDDO !ic - End DO !iw + ENDDO !iw ! restore extkb extkb = extkbd @@ -1186,9 +1186,9 @@ SUBROUTINE twostream_wrap ( ipatch, coszen, albg, & !----------------------------------------------------------------------- ! ! !DESCRIPTION: -! A Wrap subroutine to calculate PFT radiation using two-stream model +! A Wrap subroutine to calculate PFT radiation using two-stream model ! -! Created by Hua Yuan, 03/2020 +! Created by Hua Yuan, 03/2020 ! !----------------------------------------------------------------------- USE MOD_Precision @@ -1287,7 +1287,7 @@ SUBROUTINE snowage ( deltim,tg,scv,scvold,sag ) !======================================================================= USE MOD_Precision - USE MOD_Const_Physical, only : tfrz + USE MOD_Const_Physical, only: tfrz IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- @@ -1315,7 +1315,7 @@ SUBROUTINE snowage ( deltim,tg,scv,scvold,sag ) ! ! Over Antarctica ! - ELSE IF (scv > 800.) THEN + ELSEIF (scv > 800.) THEN sag = 0. ! ! Away from Antarctica @@ -1935,7 +1935,7 @@ SUBROUTINE SnowAlbedo( use_snicar_frc,use_snicar_ad ,coszen_col ,& ((1.-frac_sno)*(1-albsod(ib))*(flx_absd_snw(i,ib)/(1.-albsnd(ib)))) flx_absiv(i) = flx_absi_snw(i,ib)*frac_sno + & ((1.-frac_sno)*(1-albsoi(ib))*(flx_absi_snw(i,ib)/(1.-albsni(ib)))) - elseif (ib == 2) THEN + ELSEIF (ib == 2) THEN flx_absdn(i) = flx_absd_snw(i,ib)*frac_sno + & ((1.-frac_sno)*(1-albsod(ib))*(flx_absd_snw(i,ib)/(1.-albsnd(ib)))) flx_absin(i) = flx_absi_snw(i,ib)*frac_sno + & @@ -1945,7 +1945,7 @@ SUBROUTINE SnowAlbedo( use_snicar_frc,use_snicar_ad ,coszen_col ,& IF (ib == 1) THEN flx_absdv(i) = flx_absd_snw(i,ib)!*(1.-albsnd(ib)) flx_absiv(i) = flx_absi_snw(i,ib)!*(1.-albsni(ib)) - elseif (ib == 2) THEN + ELSEIF (ib == 2) THEN flx_absdn(i) = flx_absd_snw(i,ib)!*(1.-albsnd(ib)) flx_absin(i) = flx_absi_snw(i,ib)!*(1.-albsni(ib)) ENDIF diff --git a/main/MOD_AssimStomataConductance.F90 b/main/MOD_AssimStomataConductance.F90 index ea74e6b2..923a86df 100644 --- a/main/MOD_AssimStomataConductance.F90 +++ b/main/MOD_AssimStomataConductance.F90 @@ -26,52 +26,53 @@ MODULE MOD_AssimStomataConductance SUBROUTINE stomata (vmax25,effcon,slti,hlti,shti, & hhti,trda,trdm,trop,g1,g0,gradm,binter,tm, & - psrf,po2m,pco2m,pco2a,ea,ei,tlef,par & + psrf,po2m,pco2m,pco2a,ea,ei,tlef,par, & !Ozone stress variables - ,o3coefv,o3coefg & + o3coefv,o3coefg, & !End ozone stress variables !WUE stomata model parameter - ,lambda & + lambda, & !End WUE stomata model parameter - ,rb,ra,rstfac,cint,assim,respc,rst & - ) + rb,ra,rstfac,cint,assim,respc,rst ) !======================================================================= ! -! ! DESCRIPTION: -! calculation of canopy photosynthetic rate using the integrated -! model relating assimilation and stomatal conductance. +! !DESCRIPTION: +! calculation of canopy photosynthetic rate using the integrated +! model relating assimilation and stomatal conductance. ! -! Original author: Yongjiu Dai, 08/11/2001 +! Original author: Yongjiu Dai, 08/11/2001 ! -! Revision author: Xingjie Lu, 2021 +! !REFERENCES: +! Dai et al., 2004: A two-big-leaf model for canopy temperature, +! photosynthesis and stomatal conductance. J. Climate, 17: 2281-2299. ! -! Reference: Dai et al., 2004: A two-big-leaf model for canopy temperature, -! photosynthesis and stomatal conductance. J. Climate, 17: 2281-2299. ! +! units are converted from mks to biological units in this routine. ! -! units are converted from mks to biological units in this routine. +! units +! ------- ! -! units -! ------- +! pco2m, pco2a, pco2i, po2m : pascals +! co2a, co2s, co2i, h2oa, h2os, h2oa : mol mol-1 +! vmax25, respcp, assim, gs, gb, ga : mol m-2 s-1 +! effcon : mol co2 mol quanta-1 +! 1/rb, 1/ra, 1/rst : m s-1 ! -! pco2m, pco2a, pco2i, po2m : pascals -! co2a, co2s, co2i, h2oa, h2os, h2oa : mol mol-1 -! vmax25, respcp, assim, gs, gb, ga : mol m-2 s-1 -! effcon : mol co2 mol quanta-1 -! 1/rb, 1/ra, 1/rst : m s-1 +! conversions +! ------------- ! -! conversions -! ------------- +! 1 mol h2o = 0.018 kg +! 1 mol co2 = 0.044 kg +! h2o (mol mol-1) = ea / psrf ( pa pa-1 ) +! h2o (mol mol-1) = q*mm/(q*mm + 1) +! gs (co2) = gs (h2o) * 1./1.6 +! gs (mol m-2 s-1 ) = gs (m s-1) * 44.6*tf/t*p/po +! par (mol m-2 s-1 ) = par(w m-2) * 4.6*1.e-6 +! mm (molair/molh2o) = 1.611 ! -! 1 mol h2o = 0.018 kg -! 1 mol co2 = 0.044 kg -! h2o (mol mol-1) = ea / psrf ( pa pa-1 ) -! h2o (mol mol-1) = q*mm/(q*mm + 1) -! gs (co2) = gs (h2o) * 1./1.6 -! gs (mol m-2 s-1 ) = gs (m s-1) * 44.6*tf/t*p/po -! par (mol m-2 s-1 ) = par(w m-2) * 4.6*1.e-6 -! mm (molair/molh2o) = 1.611 +! !REVISIONS: +! 2021, Xingjie Lu: Add ozone stree and WUE model ! !---------------------------------------------------------------------- @@ -214,7 +215,7 @@ SUBROUTINE stomata (vmax25,effcon,slti,hlti,shti, & pco2i_c = pco2i pco2i_e = pco2i ELSE - call WUE_solver(gammas, lambda, co2a, ei, ea, psrf, pco2i_c, pco2i_e) + CALL WUE_solver(gammas, lambda, co2a, ei, ea, psrf, pco2i_c, pco2i_e) ENDIF !----------------------------------------------------------------------- diff --git a/main/MOD_CanopyLayerProfile.F90 b/main/MOD_CanopyLayerProfile.F90 index 64d61fc8..414149f8 100644 --- a/main/MOD_CanopyLayerProfile.F90 +++ b/main/MOD_CanopyLayerProfile.F90 @@ -358,7 +358,7 @@ RECURSIVE SUBROUTINE ufindroots(ztop,zbot,zmid, & ENDIF roots(rootn) = zmid ENDIF - ELSE IF (udiff_ub*udiff_lb < 0) THEN + ELSEIF (udiff_ub*udiff_lb < 0) THEN IF (ztop-zmid < 0.01) THEN rootn = rootn + 1 !root found IF (rootn > 2) THEN @@ -384,7 +384,7 @@ RECURSIVE SUBROUTINE ufindroots(ztop,zbot,zmid, & ENDIF roots(rootn) = zmid ENDIF - ELSE IF (udiff_ub*udiff_lb < 0) THEN + ELSEIF (udiff_ub*udiff_lb < 0) THEN IF (zmid-zbot < 0.01) THEN rootn = rootn + 1 !root found IF (rootn > 2) THEN @@ -596,7 +596,7 @@ RECURSIVE SUBROUTINE kfindroots(ztop,zbot,zmid, & ENDIF roots(rootn) = zmid ENDIF - ELSE IF (kdiff_ub*kdiff_lb < 0) THEN + ELSEIF (kdiff_ub*kdiff_lb < 0) THEN IF (ztop-zmid < 0.01) THEN rootn = rootn + 1 !root found IF (rootn > 2) THEN @@ -622,7 +622,7 @@ RECURSIVE SUBROUTINE kfindroots(ztop,zbot,zmid, & ENDIF roots(rootn) = zmid ENDIF - ELSE IF (kdiff_ub*kdiff_lb < 0) THEN + ELSEIF (kdiff_ub*kdiff_lb < 0) THEN IF (zmid-zbot < 0.01) THEN rootn = rootn + 1 !root found IF (rootn > 2) THEN diff --git a/main/MOD_CheckEquilibrium.F90 b/main/MOD_CheckEquilibrium.F90 index fced42a8..e4902eec 100644 --- a/main/MOD_CheckEquilibrium.F90 +++ b/main/MOD_CheckEquilibrium.F90 @@ -15,8 +15,8 @@ MODULE MOD_CheckEquilibrium USE netcdf USE MOD_NetCDFSerial USE MOD_SpatialMapping - USE MOD_Vars_Global, only : spval - USE MOD_Namelist, only : DEF_CheckEquilibrium + USE MOD_Vars_Global, only: spval + USE MOD_Namelist, only: DEF_CheckEquilibrium ! ----- Variables ----- integer :: numcheck @@ -43,14 +43,14 @@ MODULE MOD_CheckEquilibrium !--------------------------------------- SUBROUTINE CheckEqb_init () - USE MOD_Forcing, only : gforc - USE MOD_LandPatch, only : numpatch, landpatch + USE MOD_Forcing, only: gforc + USE MOD_LandPatch, only: numpatch, landpatch IMPLICIT NONE - IF (.not. DEF_CheckEquilibrium) return + IF (.not. DEF_CheckEquilibrium) RETURN numcheck = -1 - + IF (p_is_worker) THEN IF (numpatch > 0) THEN @@ -77,7 +77,7 @@ SUBROUTINE CheckEqb_final () IMPLICIT NONE - IF (.not. DEF_CheckEquilibrium) return + IF (.not. DEF_CheckEquilibrium) RETURN IF (allocated(tws_last)) deallocate(tws_last) IF (allocated(tws_this)) deallocate(tws_this) @@ -93,8 +93,8 @@ SUBROUTINE CheckEquilibrium (idate, deltim, itstamp, dir_out, casename) USE MOD_TimeManager USE MOD_DataType USE MOD_LandPatch - USE MOD_Vars_1DForcing, only : forc_prc, forc_prl - USE MOD_Vars_TimeVariables, only : wa, wat, wdsrf + USE MOD_Vars_1DForcing, only: forc_prc, forc_prl + USE MOD_Vars_TimeVariables, only: wa, wat, wdsrf IMPLICIT NONE @@ -115,7 +115,7 @@ SUBROUTINE CheckEquilibrium (idate, deltim, itstamp, dir_out, casename) type(block_data_real8_2d) :: sumarea - IF (.not. DEF_CheckEquilibrium) return + IF (.not. DEF_CheckEquilibrium) RETURN IF (p_is_worker) THEN IF (numpatch > 0) THEN @@ -123,27 +123,27 @@ SUBROUTINE CheckEquilibrium (idate, deltim, itstamp, dir_out, casename) CALL add_spv (forc_prl, prcp_acc, deltim) ENDIF ENDIF - + docheck = isendofyear (idate, deltim) IF (docheck) THEN IF ((p_is_worker) .and. (numpatch > 0)) THEN - tws_this = wat + tws_this = wat CALL add_spv (wdsrf, tws_this) IF (DEF_USE_VariablySaturatedFlow) THEN CALL add_spv (wa, tws_this) ENDIF ENDIF - + numcheck = numcheck + 1 IF (numcheck >= 1) THEN - + IF ((p_is_worker) .and. (numpatch > 0)) THEN - + allocate (filter (numpatch)) filter(:) = (tws_last /= spval) .and. (tws_this /= spval) .and. (prcp_acc > 0.) @@ -152,18 +152,18 @@ SUBROUTINE CheckEquilibrium (idate, deltim, itstamp, dir_out, casename) pct_dtws = (tws_this - tws_last) / prcp_acc ELSEWHERE pct_dtws = spval - END WHERE + END WHERE ENDIF - + IF (p_is_master) THEN - + filename = trim(dir_out) // '/' // trim(casename) //'_check_equilibrium.nc' IF (numcheck == 1) THEN CALL ncio_create_file (trim(filename)) - + CALL ncio_define_dimension(filename, 'year', 0) CALL nccheck( nf90_open(trim(filename), NF90_WRITE, ncid) ) CALL nccheck( nf90_inq_dimid(ncid, 'year', time_id) ) @@ -218,7 +218,7 @@ SUBROUTINE CheckEquilibrium (idate, deltim, itstamp, dir_out, casename) CALL ncio_put_attr (filename, 'relative_tws_change', 'units', '-') CALL ncio_put_attr (filename, 'relative_tws_change', 'missing_value', spval) ENDIF - + CALL ncio_write_serial_time (filename, 'total_precipitation', numcheck, prcp_acc, 'patch', 'year') IF (numcheck == 1) THEN CALL ncio_put_attr (filename, 'total_precipitation', 'long_name', & @@ -227,7 +227,7 @@ SUBROUTINE CheckEquilibrium (idate, deltim, itstamp, dir_out, casename) CALL ncio_put_attr (filename, 'total_precipitation', 'missing_value', spval) ENDIF #endif - + ENDIF IF ((p_is_worker) .and. (numpatch > 0)) THEN @@ -398,7 +398,7 @@ SUBROUTINE map_and_write_check_var ( & CALL mpi_barrier (p_comm_glb, p_err) #endif - END SUBROUTINE map_and_write_check_var + END SUBROUTINE map_and_write_check_var #endif !------ diff --git a/main/MOD_Const_LC.F90 b/main/MOD_Const_LC.F90 index b8cf01bd..c5e4ef8d 100644 --- a/main/MOD_Const_LC.F90 +++ b/main/MOD_Const_LC.F90 @@ -4,19 +4,19 @@ MODULE MOD_Const_LC !----------------------------------------------------------------------- ! !DESCRIPTION: -! Constant values set for land cover types +! Constant values set for land cover types ! -! Created by Hua Yuan, 08/2019 +! Created by Hua Yuan, 08/2019 ! ! !REVISIONS: -! 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 +! 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 USE MOD_Vars_Global - USE MOD_Namelist, only : DEF_USE_PLANTHYDRAULICS + USE MOD_Namelist, only: DEF_USE_PLANTHYDRAULICS IMPLICIT NONE SAVE diff --git a/main/MOD_Const_PFT.F90 b/main/MOD_Const_PFT.F90 index c24177de..78060189 100644 --- a/main/MOD_Const_PFT.F90 +++ b/main/MOD_Const_PFT.F90 @@ -5,12 +5,12 @@ MODULE MOD_Const_PFT !----------------------------------------------------------------------- ! ! !DESCRIPTION: -! Set constants for plant functional types (PFTs) +! Set constants for plant functional types (PFTs) ! -! Created by Hua Yuan, 08/2019 +! Created by Hua Yuan, 08/2019 ! -! REVISIONS: -! 10/2021, Xingjie Lu: added for crop PFTs +! !REVISIONS: +! 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 8f51a760..2a9e8e5b 100644 --- a/main/MOD_Const_Physical.F90 +++ b/main/MOD_Const_Physical.F90 @@ -1,7 +1,7 @@ MODULE MOD_Const_Physical !======================================================================= -! physical constants +! physical constants !======================================================================= USE MOD_Precision diff --git a/main/MOD_CropReadin.F90 b/main/MOD_CropReadin.F90 index 9447dfb6..270f03d2 100644 --- a/main/MOD_CropReadin.F90 +++ b/main/MOD_CropReadin.F90 @@ -14,13 +14,14 @@ MODULE MOD_CropReadin CONTAINS SUBROUTINE CROP_readin () - ! =========================================================== - ! ! DESCRIPTION: - ! Read in crop planting date from data, and fertilization from data. - ! Save these data in patch vector. - ! - ! Original: Shupeng Zhang, Zhongwang Wei, and Xingjie Lu, 2022 - ! =========================================================== +!----------------------------------------------------------------------- +! !DESCRIPTION: +! Read in crop planting date from data, and fertilization from data. +! Save these data in patch vector. +! +! Original: Shupeng Zhang, Zhongwang Wei, and Xingjie Lu, 2022 +! +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Namelist @@ -185,7 +186,7 @@ SUBROUTINE CROP_readin () #endif ! (4) Read in irrigation method -! file_irrig = trim(DEF_dir_runtime) // '/crop/surfdata_irrigation_method.nc' + !file_irrig = trim(DEF_dir_runtime) // '/crop/surfdata_irrigation_method.nc' file_irrig = trim(DEF_dir_runtime) // '/crop/surfdata_irrigation_method_96x144.nc' CALL ncio_read_bcast_serial (file_irrig, 'lat', lat) diff --git a/main/MOD_Eroot.F90 b/main/MOD_Eroot.F90 index 322af477..23592d8e 100644 --- a/main/MOD_Eroot.F90 +++ b/main/MOD_Eroot.F90 @@ -31,17 +31,17 @@ SUBROUTINE eroot (nl_soil,trsmx0,porsl, & ! !DESCRIPTION: ! effective root fraction and maximum possible transpiration rate ! -! Original author : Yongjiu Dai, 08/30/2002 +! Original author: Yongjiu Dai, 08/30/2002 ! -! !HISTORY: +! !REVISIONS: ! 09/2021, Shupeng Zhang and Xingjie Lu: add vanGenuchten scheme to ! calculate soil water potential. !======================================================================= USE MOD_Precision - USE MOD_Const_Physical, only : tfrz + USE MOD_Const_Physical, only: tfrz #ifdef vanGenuchten_Mualem_SOIL_MODEL - USE MOD_Hydro_SoilFunction, only : soil_psi_from_vliq + USE MOD_Hydro_SoilFunction, only: soil_psi_from_vliq #endif IMPLICIT NONE diff --git a/main/MOD_FireData.F90 b/main/MOD_FireData.F90 index 69da8611..d3dcd3ed 100644 --- a/main/MOD_FireData.F90 +++ b/main/MOD_FireData.F90 @@ -4,10 +4,10 @@ MODULE MOD_FireData !----------------------------------------------------------------------- ! !DESCRIPTION: -! This module read in fire data. +! This module read in fire data. ! -! !ORIGINAL: -! Lu Xingjie and Zhang Shupeng, 2023, prepare the original version of the fire data module. +! Original: +! Lu Xingjie and Zhang Shupeng, 2023, prepare the original version of the fire data module. USE MOD_Grid USE MOD_SpatialMapping @@ -25,10 +25,10 @@ MODULE MOD_FireData ! ---------- SUBROUTINE init_fire_data (YY) - !---------------------- - ! DESCRIPTION: - ! open fire netcdf file from DEF_dir_runtime, read latitude and longitude info. - ! Initialize fire data read in. +!---------------------- +! !DESCRIPTION: +! open fire netcdf file from DEF_dir_runtime, read latitude and longitude info. +! Initialize fire data read in. USE MOD_SPMD_Task USE MOD_Namelist @@ -92,16 +92,15 @@ SUBROUTINE init_fire_data (YY) END SUBROUTINE init_fire_data - ! ---------- SUBROUTINE update_hdm_data (YY) - ! ====================================================================================================== - ! - ! !DESCRIPTION: - ! Read in the Fire data from CLM5 dataset (month when crop fire peak (abm), GDP, peatland fraction (peatf), - ! and population density - ! - ! !ORIGINAL: Xingjie Lu and Shupeng Zhang, 2022 - ! ====================================================================================================== +! ====================================================================================================== +! +! !DESCRIPTION: +! Read in the Fire data from CLM5 dataset (month when crop fire peak (abm), GDP, peatland fraction (peatf), +! and population density +! +! Original: Xingjie Lu and Shupeng Zhang, 2022 +! ====================================================================================================== USE MOD_SPMD_Task USE MOD_DataType diff --git a/main/MOD_Forcing.F90 b/main/MOD_Forcing.F90 index f453f080..146daf40 100644 --- a/main/MOD_Forcing.F90 +++ b/main/MOD_Forcing.F90 @@ -1,21 +1,22 @@ #include -!----------------------------------------------------------------------- MODULE MOD_Forcing -! DESCRIPTION: -! read in the atmospheric forcing using user defined interpolation method -! or downscaling forcing +!----------------------------------------------------------------------- +! !DESCRIPTION: +! read in the atmospheric forcing using user defined interpolation method or +! downscaling forcing ! -! REVISIONS: -! Yongjiu Dai and Hua Yuan, 04/2014: initial code from CoLM2014 (metdata.F90, -! GETMET.F90 and rd_forcing.F90 +! !REVISIONS: +! Yongjiu Dai and Hua Yuan, 04/2014: initial code from CoLM2014 (metdata.F90, +! GETMET.F90 and rd_forcing.F90 ! -! Shupeng Zhang, 05/2023: 1) porting codes to MPI parallel version -! 2) codes for dealing with missing forcing value -! 3) interface for downscaling +! Shupeng Zhang, 05/2023: 1) porting codes to MPI parallel version +! 2) codes for dealing with missing forcing value +! 3) interface for downscaling ! -! TODO...(need complement) +! !TODO...(need complement) +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Namelist @@ -25,7 +26,7 @@ MODULE MOD_Forcing USE MOD_TimeManager USE MOD_SPMD_Task USE MOD_MonthlyinSituCO2MaunaLoa - USE MOD_Vars_Global, only : pi + USE MOD_Vars_Global, only: pi USE MOD_OrbCoszen USE MOD_UserDefFun @@ -101,7 +102,7 @@ MODULE MOD_Forcing CONTAINS - !-------------------------------- +!----------------------------------------------------------------------- SUBROUTINE forcing_init (dir_forcing, deltatime, ststamp, lc_year, etstamp, lulcc_call) USE MOD_SPMD_Task @@ -321,7 +322,7 @@ END SUBROUTINE forcing_init ! ---- forcing finalize ---- SUBROUTINE forcing_final () - USE MOD_LandPatch, only : numpatch + USE MOD_LandPatch, only: numpatch IMPLICIT NONE IF (allocated(forcmask_pch)) deallocate(forcmask_pch) @@ -376,7 +377,8 @@ SUBROUTINE forcing_reset () END SUBROUTINE forcing_reset - !-------------------------------- + +!----------------------------------------------------------------------- SUBROUTINE read_forcing (idate, dir_forcing) USE MOD_OrbCosazi USE MOD_Precision @@ -393,7 +395,7 @@ SUBROUTINE read_forcing (idate, dir_forcing) USE MOD_LandPatch USE MOD_RangeCheck USE MOD_UserSpecifiedForcing - USE MOD_ForcingDownscaling, only : rair, cpair, downscale_forcings, downscale_wind + USE MOD_ForcingDownscaling, only: rair, cpair, downscale_forcings, downscale_wind USE MOD_NetCDFVector IMPLICIT NONE @@ -415,7 +417,7 @@ SUBROUTINE read_forcing (idate, dir_forcing) type(timestamp) :: mtstamp integer :: dtLB, dtUB real(r8) :: cosz, coszen(numpatch), cosa, cosazi(numpatch), balb - INTEGER :: year, month, mday + integer :: year, month, mday logical :: has_u,has_v real solar, frl, prcp, tm, us, vs, pres, qm real(r8) :: pco2m @@ -600,7 +602,7 @@ SUBROUTINE read_forcing (idate, dir_forcing) cloud = 0. ELSE cloud = (1160.*sunang-a)/(963.*sunang) - END IF + ENDIF cloud = max(cloud,0.) cloud = min(cloud,1.) cloud = max(0.58,cloud) @@ -932,15 +934,15 @@ SUBROUTINE read_forcing (idate, dir_forcing) END SUBROUTINE read_forcing - ! ------------------------------------------------------------ - ! - ! !DESCRIPTION: - ! read lower and upper boundary forcing data, a major interface of - ! this MODULE - ! - ! REVISIONS: - ! Hua Yuan, 04/2014: initial code - ! ------------------------------------------------------------ +!----------------------------------------------------------------------- +! !DESCRIPTION: +! read lower and upper boundary forcing data, a major interface of this +! MODULE +! +! !REVISIONS: +! 04/2014, Hua Yuan: initial code +! +!----------------------------------------------------------------------- SUBROUTINE metreadLBUB (idate, dir_forcing) USE MOD_UserSpecifiedForcing @@ -1073,7 +1075,7 @@ SUBROUTINE metreadLBUB (idate, dir_forcing) END SUBROUTINE metreadLBUB - !------------------------------------------------- +!----------------------------------------------------------------------- SUBROUTINE metread_latlon (dir_forcing, idate) USE MOD_SPMD_Task @@ -1137,7 +1139,7 @@ SUBROUTINE metread_latlon (dir_forcing, idate) END SUBROUTINE metread_latlon - !------------------------------------------------- +!----------------------------------------------------------------------- SUBROUTINE metread_time (dir_forcing, ststamp, etstamp, deltime) USE MOD_SPMD_Task @@ -1256,8 +1258,7 @@ SUBROUTINE metread_time (dir_forcing, ststamp, etstamp, deltime) END SUBROUTINE metread_time -! ------------------------------------------------------------ -! +!----------------------------------------------------------------------- ! !DESCRIPTION: ! set the lower boundary time stamp and record information, ! a KEY FUNCTION of this MODULE @@ -1269,9 +1270,10 @@ END SUBROUTINE metread_time ! o leap year ! o required data just beyond the first record ! -! REVISIONS: -! Hua Yuan, 04/2014: initial code -! ------------------------------------------------------------ +! !REVISIONS: +! 04/2014, Hua Yuan: initial code +! +!----------------------------------------------------------------------- SUBROUTINE setstampLB(mtstamp, var_i, year, month, mday, time_i) IMPLICIT NONE @@ -1402,7 +1404,7 @@ SUBROUTINE setstampLB(mtstamp, var_i, year, month, mday, time_i) ENDIF ! set record info (year, month, time_i) - IF ( sec<0 .or. (sec==0 .and. offset(var_i).NE.0) ) THEN + IF ( sec<0 .or. (sec==0 .and. offset(var_i).ne.0) ) THEN ! IF just behind the first record -> set to first record IF ( year==startyr .and. month==startmo .and. mday==1 ) THEN @@ -1491,15 +1493,15 @@ SUBROUTINE setstampLB(mtstamp, var_i, year, month, mday, time_i) END SUBROUTINE setstampLB -! ------------------------------------------------------------ -! +!----------------------------------------------------------------------- ! !DESCRIPTION: ! set the upper boundary time stamp and record information, ! a KEY FUNCTION of this MODULE ! -! REVISIONS: -! Hua Yuan, 04/2014: initial code -! ------------------------------------------------------------ +! !REVISIONS: +! 04/2014, Hua Yuan: initial code +! +!----------------------------------------------------------------------- SUBROUTINE setstampUB(var_i, year, month, mday, time_i) IMPLICIT NONE @@ -1651,13 +1653,14 @@ SUBROUTINE setstampUB(var_i, year, month, mday, time_i) END SUBROUTINE setstampUB -! ------------------------------------------------------------ +!----------------------------------------------------------------------- ! !DESCRIPTION: -! calculate time average coszen value between [LB, UB] +! calculate time average coszen value between [LB, UB] +! +! !REVISIONS: +! 04/2014, Hua Yuan: this method is adapted from CLM ! -! REVISIONS: -! 04/2014, yuan: this method is adapted from CLM -! ------------------------------------------------------------ +!----------------------------------------------------------------------- SUBROUTINE calavgcos(idate) USE MOD_Block diff --git a/main/MOD_ForcingDownscaling.F90 b/main/MOD_ForcingDownscaling.F90 index 3e5f3bb0..c9622c7b 100644 --- a/main/MOD_ForcingDownscaling.F90 +++ b/main/MOD_ForcingDownscaling.F90 @@ -3,16 +3,16 @@ MODULE MOD_ForcingDownscaling !----------------------------------------------------------------------------- -! DESCRIPTION: -! Downscaling meteorological forcings +! !DESCRIPTION: +! Downscaling meteorological forcings ! -! INITIAL: -! The Community Land Model version 5.0 (CLM5.0) +! !INITIAL: +! The Community Land Model version 5.0 (CLM5.0) ! -! REVISIONS: -! Updated by Yongjiu Dai, January 16, 2023 -! Revised by Lu Li, January 24, 2024 -! Revised by Sisi Chen, Lu Li, June, 2024 +! !REVISIONS: +! Updated by Yongjiu Dai, January 16, 2023 +! Revised by Lu Li, January 24, 2024 +! Revised by Sisi Chen, Lu Li, June, 2024 !----------------------------------------------------------------------------- USE MOD_Precision @@ -110,16 +110,17 @@ SUBROUTINE downscale_forcings (& forc_us_c ,forc_vs_c) !----------------------------------------------------------------------------- -! DESCRIPTION: -! Downscale atmospheric forcing fields. +! !DESCRIPTION: +! 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 -! forcings are valid). +! 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 forcings are valid). ! -! Note that the downscaling procedure can result in changes in grid cell mean values -! compared to what was provided by the atmosphere. We conserve fluxes of mass and -! energy, but allow states such as temperature to differ. +! Note that the downscaling procedure can result in changes in grid +! cell mean values compared to what was provided by the atmosphere. We +! conserve fluxes of mass and energy, but allow states such as +! temperature to differ. !----------------------------------------------------------------------------- IMPLICIT NONE @@ -289,17 +290,17 @@ SUBROUTINE downscale_forcings (& delta_prl_c = forc_prl_g *1.0*0.27*(forc_topo_c - forc_topo_g) & /(1.0 - 0.27*(forc_topo_c - forc_topo_g)) forc_prl_c = forc_prl_g + delta_prl_c ! large scale precipitation [mm/s] - END IF + ENDIF IF (forc_prl_c < 0) THEN write(*,*) 'negative prl', forc_prl_g, forc_maxelv_g, forc_topo_c, forc_topo_g forc_prl_c = 0. - END IF + ENDIF IF (forc_prc_c < 0) THEN write(*,*) 'negative prc', forc_prc_g, forc_maxelv_g, forc_topo_c, forc_topo_g forc_prc_c = 0. - END IF + ENDIF END SUBROUTINE downscale_forcings @@ -309,11 +310,12 @@ SUBROUTINE downscale_wind(forc_us_g, forc_vs_g, & slp_type_c, asp_type_c, area_type_c, cur_c) !----------------------------------------------------------------------------- -! DESCRIPTION: -! Downscale wind speed +! !DESCRIPTION: +! Downscale wind speed ! -! Liston, G. E. and Elder, K.: A meteorological distribution system -! for high-resolution terrestrial modeling (MicroMet), J. Hydrometeorol., 7, 217-234, 2006. +! Liston, G. E. and Elder, K.: A meteorological distribution system for +! high-resolution terrestrial modeling (MicroMet), J. Hydrometeorol., +! 7, 217-234, 2006. !----------------------------------------------------------------------------- IMPLICIT NONE @@ -359,7 +361,7 @@ SUBROUTINE downscale_wind(forc_us_g, forc_vs_g, & ! Limiting the scope of proportionality adjustments IF (scale_factor>1.5) THEN scale_factor = 1.5 - ELSE IF (scale_factor<-1.5) THEN + ELSEIF (scale_factor<-1.5) THEN scale_factor = -1.5 ENDIF ws_c_type(i) = ws_g *scale_factor*area_type_c(i) @@ -379,8 +381,8 @@ SUBROUTINE downscale_longwave (glaciers, & forc_topo_c, forc_t_c, forc_q_c, forc_pbot_c, forc_lwrad_c) !----------------------------------------------------------------------------- -! DESCRIPTION: -! Downscale longwave radiation +! !DESCRIPTION: +! Downscale longwave radiation !----------------------------------------------------------------------------- IMPLICIT NONE @@ -485,17 +487,18 @@ SUBROUTINE downscale_shortwave( & area_type_c) !----------------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! -! 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 +! 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 -! Hyper-Resolution Land Surface Modeling. Authorea. April 25, 2024. -! DOI: 10.22541/au.171403656.68476353/v1 +! 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 ! -! Must be done after downscaling of surface pressure +! Must be done after downscaling of surface pressure !----------------------------------------------------------------------------- IMPLICIT NONE @@ -579,7 +582,7 @@ SUBROUTINE downscale_shortwave( & IF (zen_rad <= zenith_segment) THEN sf_c = 1. - ELSE IF (a1<=1e-10) THEN + ELSEIF (a1<=1e-10) THEN sf_c = 1. ELSE sf_c = exp(-1*exp(min(a1*zen_rad+a2,3.5))) diff --git a/main/MOD_FrictionVelocity.F90 b/main/MOD_FrictionVelocity.F90 index 45672ebd..d7ba57c9 100644 --- a/main/MOD_FrictionVelocity.F90 +++ b/main/MOD_FrictionVelocity.F90 @@ -24,7 +24,7 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& ustar,fh2m,fq2m,fm10m,fm,fh,fq) ! ====================================================================== -! Original author : Yongjiu Dai, September 15, 1999 +! Original author: Yongjiu Dai, September 15, 1999 ! ! calculation of friction velocity, relation for potential temperature ! and humidity profiles of surface boundary layer. @@ -35,7 +35,7 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& ! ====================================================================== USE MOD_Precision - USE MOD_Const_Physical, only : vonkar + USE MOD_Const_Physical, only: vonkar IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- @@ -77,10 +77,10 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& fm = log(-zetam*obu/z0m) - psi(1,-zetam) & + psi(1,z0m/obu) + 1.14*((-zeta)**0.333-(zetam)**0.333) ustar = vonkar*um / fm - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (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 <= zeta <= 1 + ELSEIF (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 @@ -95,9 +95,9 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& IF(zeta < -zetam)THEN ! zeta < -1 fm10m = log(-zetam*obu/z0m) - psi(1,-zetam) & + psi(1,z0m/obu) + 1.14*((-zeta)**0.333-(zetam)**0.333) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fm10m = log(zldis/z0m) - psi(1,zeta) + psi(1,z0m/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -110,9 +110,9 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& IF(zeta < -zetat)THEN ! zeta < -1 fh = log(-zetat*obu/z0h)-psi(2,-zetat) & + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fh = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -125,9 +125,9 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& IF(zeta < -zetat)THEN ! zeta < -1 fh2m = log(-zetat*obu/z0h)-psi(2,-zetat) & + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fh2m = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -140,9 +140,9 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& IF(zeta < -zetat)THEN ! zeta < -1 fq = log(-zetat*obu/z0q) - psi(2,-zetat) & + psi(2,z0q/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fq = log(zldis/z0q) - psi(2,zeta) + psi(2,z0q/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -157,7 +157,7 @@ SUBROUTINE moninobuk(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,& + psi(2,z0q/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) ELSEIF (zeta < 0.) THEN ! -1 <= zeta < 0 fq2m = log(zldis/z0q)-psi(2,zeta)+psi(2,z0q/obu) - ELSE IF (zeta <= 1.) THEN ! 0 <= zeta <= 1 + ELSEIF (zeta <= 1.) THEN ! 0 <= zeta <= 1 fq2m = log(zldis/z0q)+5.*zeta-5.*z0q/obu ELSE ! 1 < zeta, phi=5+zeta fq2m = log(obu/z0q)+5.-5.*z0q/obu+(5.*log(zeta)+zeta-1.) @@ -173,23 +173,22 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& ! ! !DESCRIPTION: ! +! Original author: Yongjiu Dai, September 15, 1999 ! -! 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 ! -! 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: -! 09/2017, Hua Yuan: adapted from moninobuk FUNCTION to calculate canopy -! top fm, fq and phih for roughness sublayer u/k profile -! calculation. +! !REVISIONS: +! 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 - USE MOD_Const_Physical, only : vonkar + USE MOD_Const_Physical, only: vonkar IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- @@ -237,10 +236,10 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& fm = log(-zetam*obu/z0m) - psi(1,-zetam) & + psi(1,z0m/obu) + 1.14*((-zeta)**0.333-(zetam)**0.333) ustar = vonkar*um / fm - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (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 <= zeta <= 1 + ELSEIF (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,9 +255,9 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& IF(zeta < -zetam)THEN ! zeta < -1 fmtop = log(-zetam*obu/z0m) - psi(1,-zetam) & + psi(1,z0m/obu) + 1.14*((-zeta)**0.333-(zetam)**0.333) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fmtop = log(zldis/z0m) - psi(1,zeta) + psi(1,z0m/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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,9 +270,9 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& IF(zeta < -zetat)THEN ! zeta < -1 fh = log(-zetat*obu/z0h)-psi(2,-zetat) & + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fh = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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,9 +285,9 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& IF(zeta < -zetat)THEN ! zeta < -1 fh2m = log(-zetat*obu/z0h)-psi(2,-zetat) & + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fh2m = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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,9 +300,9 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& IF(zeta < -zetat)THEN ! zeta < -1 fht = log(-zetat*obu/z0h)-psi(2,-zetat) & + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fht = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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,9 +315,9 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& zetat=0.465 IF(zeta < -zetat)THEN ! zeta < -1 phih = 0.9*vonkar**(1.333)*(-zeta)**(-0.333) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 phih = (1. - 16.*zeta)**(-0.5) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (zeta <= 1.)THEN ! 0 <= zeta <= 1 phih = 1. + 5.*zeta ELSE ! 1 < zeta, phi=5+zeta phih = 5. + zeta @@ -331,9 +330,9 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& IF(zeta < -zetat)THEN ! zeta < -1 fq = log(-zetat*obu/z0q) - psi(2,-zetat) & + psi(2,z0q/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fq = log(zldis/z0q) - psi(2,zeta) + psi(2,z0q/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -348,7 +347,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)) ELSEIF (zeta < 0.) THEN ! -1 <= zeta < 0 fq2m = log(zldis/z0q)-psi(2,zeta)+psi(2,z0q/obu) - ELSE IF (zeta <= 1.) THEN ! 0 <= zeta <= 1 + ELSEIF (zeta <= 1.) THEN ! 0 <= zeta <= 1 fq2m = log(zldis/z0q)+5.*zeta-5.*z0q/obu ELSE ! 1 < zeta, phi=5+zeta fq2m = log(obu/z0q)+5.-5.*z0q/obu+(5.*log(zeta)+zeta-1.) @@ -363,7 +362,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)) ELSEIF (zeta < 0.) THEN ! -1 <= zeta < 0 fqt = log(zldis/z0q)-psi(2,zeta)+psi(2,z0q/obu) - ELSE IF (zeta <= 1.) THEN ! 0 <= zeta <= 1 + ELSEIF (zeta <= 1.) THEN ! 0 <= zeta <= 1 fqt = log(zldis/z0q)+5.*zeta-5.*z0q/obu ELSE ! 1 < zeta, phi=5+zeta fqt = log(obu/z0q)+5.-5.*z0q/obu+(5.*log(zeta)+zeta-1.) @@ -371,16 +370,16 @@ SUBROUTINE moninobukm(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt,& END SUBROUTINE moninobukm -!----------------------------------------------------------------------- real(r8) FUNCTION kmoninobuk(displa,obu,ustar,z) -! +!----------------------------------------------------------------------- ! !DESCRIPTION: -! k profile calculation for bare ground case +! k profile calculation for bare ground case ! -! Created by Hua Yuan, 09/2017 +! Created by Hua Yuan, 09/2017 ! +!----------------------------------------------------------------------- USE MOD_Precision - USE MOD_Const_Physical, only : vonkar + USE MOD_Const_Physical, only: vonkar IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- @@ -411,9 +410,9 @@ real(r8) FUNCTION kmoninobuk(displa,obu,ustar,z) zetat=0.465 IF(zeta < -zetat)THEN ! zeta < -1 phih = 0.9*vonkar**(1.333)*(-zeta)**(-0.333) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 phih = (1. - 16.*zeta)**(-0.5) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (zeta <= 1.)THEN ! 0 <= zeta <= 1 phih = 1. + 5.*zeta ELSE ! 1 < zeta, phi=5+zeta phih = 5. + zeta @@ -423,17 +422,17 @@ real(r8) FUNCTION kmoninobuk(displa,obu,ustar,z) END FUNCTION kmoninobuk -!----------------------------------------------------------------------- real(r8) FUNCTION kintmoninobuk(displa,z0h,obu,ustar,ztop,zbot) -! +!----------------------------------------------------------------------- ! !DESCRIPTION: -! k profile integration for bare ground case +! k profile integration for bare ground case ! -! Created by Hua Yuan, 09/2017 +! Created by Hua Yuan, 09/2017 ! +!----------------------------------------------------------------------- USE MOD_Precision - USE MOD_Const_Physical, only : vonkar + USE MOD_Const_Physical, only: vonkar IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- @@ -462,9 +461,9 @@ real(r8) FUNCTION kintmoninobuk(displa,z0h,obu,ustar,ztop,zbot) IF(zeta < -zetat)THEN ! zeta < -1 fh_top = log(-zetat*obu/z0h)-psi(2,-zetat) & + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fh_top = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -476,9 +475,9 @@ real(r8) FUNCTION kintmoninobuk(displa,z0h,obu,ustar,ztop,zbot) IF(zeta < -zetat)THEN ! zeta < -1 fh_bot = log(-zetat*obu/z0h)-psi(2,-zetat) & + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fh_bot = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -492,7 +491,7 @@ END FUNCTION kintmoninobuk SUBROUTINE moninobukini(ur,th,thm,thv,dth,dqh,dthv,zldis,z0m,um,obu) ! ====================================================================== -! Original author : Yongjiu Dai, September 15, 1999 +! Original author: Yongjiu Dai, September 15, 1999 ! ! initialization of Monin-Obukhov length, ! the scheme is based on the work of Zeng et al. (1998): @@ -502,7 +501,7 @@ SUBROUTINE moninobukini(ur,th,thm,thv,dth,dqh,dthv,zldis,z0m,um,obu) ! ====================================================================== USE MOD_Precision - USE MOD_Const_Physical, only : grav, vonkar + USE MOD_Const_Physical, only: grav, vonkar IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- diff --git a/main/MOD_Glacier.F90 b/main/MOD_Glacier.F90 index c700896b..2bad5a30 100644 --- a/main/MOD_Glacier.F90 +++ b/main/MOD_Glacier.F90 @@ -3,17 +3,17 @@ MODULE MOD_Glacier !----------------------------------------------------------------------- -! Energy and Mass Balance Model of LAND ICE (GLACIER / ICE SHEET) +! Energy and Mass Balance Model of LAND ICE (GLACIER / ICE SHEET) ! -! Original author: Yongjiu Dai, /05/2014/ +! Original author: Yongjiu Dai, /05/2014/ ! -! REVISIONS: -! 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()] +! !REVISIONS: +! 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()] ! -! 01/2023, Hua Yuan: added snow layer absorption in GLACIER_TEMP() +! 01/2023, Hua Yuan: added snow layer absorption in GLACIER_TEMP() !----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE @@ -37,11 +37,10 @@ MODULE MOD_Glacier !----------------------------------------------------------------------- - SUBROUTINE GLACIER_TEMP (patchtype, lb ,nl_ice ,deltim ,& + SUBROUTINE GLACIER_TEMP (patchtype,lb ,nl_ice ,deltim ,& zlnd ,zsno ,capr ,cnfac ,& - forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,& - forc_us ,forc_vs ,forc_t ,forc_q ,& - forc_hpbl ,& + forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& + forc_vs ,forc_t ,forc_q ,forc_hpbl ,& forc_rhoair ,forc_psrf ,coszen ,sabg ,& forc_frl ,fsno ,dz_icesno ,z_icesno ,& zi_icesno ,t_icesno ,wice_icesno ,wliq_icesno ,& @@ -59,7 +58,7 @@ SUBROUTINE GLACIER_TEMP (patchtype, lb ,nl_ice ,deltim ,& ! 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/ +! Original author: Yongjiu Dai and Nan Wei, /05/2014/ ! Modified by Nan Wei, 07/2017/ interaction btw prec and land ice ! FLOW DIAGRAM FOR GLACIER_TEMP.F90 ! @@ -344,18 +343,18 @@ SUBROUTINE groundfluxes_glacier (zlnd,zsno,hu,ht,hq,& z0m,zol,rib,ustar,qstar,tstar,fm,fh,fq) !======================================================================= -! this is the main SUBROUTINE to execute the calculation of thermal processes -! and surface fluxes of land ice (glacier and ice sheet) +! this is the main SUBROUTINE to execute the calculation of thermal processes +! and surface fluxes of land ice (glacier and ice sheet) ! -! Original author : Yongjiu Dai and Nan Wei, /05/2014/ +! Original author: Yongjiu Dai and Nan Wei, /05/2014/ ! -! REVISIONS: -! 05/2023, Shaofeng Liu: add option to CALL moninobuk_leddy, the LargeEddy -! surface turbulence scheme (LZD2022); make a proper update of um. +! !REVISIONS: +! 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 - USE MOD_Const_Physical, only : cpair,vonkar,grav + USE MOD_Const_Physical, only: cpair,vonkar,grav USE MOD_FrictionVelocity USE MOD_Namelist, only: DEF_USE_CBL_HEIGHT USE MOD_TurbulenceLEddy @@ -570,34 +569,34 @@ SUBROUTINE groundtem_glacier (patchtype,lb,nl_ice,deltim,& imelt,snofrz,sm,xmf,fact,pg_rain,pg_snow,t_precip) !======================================================================= -! 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 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. +! 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 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. ! -! Phase change (see meltf.F90) +! Phase change (see meltf.F90) ! -! Original author : Yongjiu Dai, /05/2014/ +! Original author: Yongjiu Dai, /05/2014/ ! -! REVISIONS: -! 01/2023, Hua Yuan: account for snow layer absorption (SNICAR) in -! ground heat flux, temperature and melt calculation. +! !REVISIONS: +! 01/2023, Hua Yuan: account for snow layer absorption (SNICAR) in +! ground heat flux, temperature and melt calculation. !======================================================================= USE MOD_Precision USE MOD_Namelist, only: DEF_USE_SNICAR - USE MOD_Const_Physical, only : stefnc,cpice,cpliq,denh2o,denice,tfrz,tkwat,tkice,tkair + USE MOD_Const_Physical, only: stefnc,cpice,cpliq,denh2o,denice,tfrz,tkwat,tkice,tkair USE MOD_PhaseChange USE MOD_Utils @@ -790,7 +789,7 @@ SUBROUTINE groundtem_glacier (patchtype,lb,nl_ice,deltim,& bt(j) = 1.+ (1.-cnfac)*fact(j)*(tk(j)/dzp + tk(j-1)/dzm) ct(j) = - (1.-cnfac)*fact(j)* tk(j)/dzp rt(j) = t_icesno(j) + cnfac*fact(j)*( fn(j) - fn(j-1) ) - END DO + ENDDO j = nl_ice dzm = (z_icesno(j)-z_icesno(j-1)) @@ -870,17 +869,17 @@ END SUBROUTINE groundtem_glacier - SUBROUTINE GLACIER_WATER ( nl_ice,maxsnl,deltim,& - z_icesno ,dz_icesno ,zi_icesno ,t_icesno,& - wliq_icesno ,wice_icesno ,pg_rain ,pg_snow ,& - sm ,scv ,snowdp ,imelt ,& - fiold ,snl ,qseva ,qsdew ,& - qsubl ,qfros ,gwat , & - ssi ,wimp ,forc_us ,forc_vs ) + SUBROUTINE GLACIER_WATER ( nl_ice ,maxsnl ,deltim ,& + z_icesno ,dz_icesno ,zi_icesno ,t_icesno ,& + wliq_icesno ,wice_icesno ,pg_rain ,pg_snow ,& + sm ,scv ,snowdp ,imelt ,& + fiold ,snl ,qseva ,qsdew ,& + qsubl ,qfros ,gwat ,ssi ,& + wimp ,forc_us ,forc_vs ) !======================================================================= USE MOD_Precision - USE MOD_Const_Physical, only : denice, denh2o, tfrz + USE MOD_Const_Physical, only: denice, denh2o, tfrz USE MOD_SnowLayersCombineDivide USE MOD_SoilSnowHydrology @@ -917,8 +916,8 @@ SUBROUTINE GLACIER_WATER ( nl_ice,maxsnl,deltim,& t_icesno (maxsnl+1:nl_ice) , &! snow/ice skin temperature (K) wice_icesno(maxsnl+1:nl_ice) , &! ice lens (kg/m2) wliq_icesno(maxsnl+1:nl_ice) , &! liquid water (kg/m2) - scv , &! snow mass (kg/m2) - snowdp ! snow depth (m) + scv , &! snow mass (kg/m2) + snowdp ! snow depth (m) real(r8), intent(out) :: & gwat ! net water input from top (mm/s) @@ -991,21 +990,21 @@ SUBROUTINE GLACIER_WATER ( nl_ice,maxsnl,deltim,& END SUBROUTINE GLACIER_WATER - SUBROUTINE GLACIER_WATER_snicar ( nl_ice,maxsnl,deltim,& - z_icesno ,dz_icesno ,zi_icesno ,t_icesno,& - wliq_icesno ,wice_icesno ,pg_rain ,pg_snow ,& - sm ,scv ,snowdp ,imelt ,& - fiold ,snl ,qseva ,qsdew ,& - qsubl ,qfros ,gwat , & - ssi ,wimp ,forc_us ,forc_vs ,& + SUBROUTINE GLACIER_WATER_snicar ( nl_ice ,maxsnl ,deltim ,& + z_icesno ,dz_icesno ,zi_icesno ,t_icesno ,& + wliq_icesno ,wice_icesno ,pg_rain ,pg_snow ,& + sm ,scv ,snowdp ,imelt ,& + fiold ,snl ,qseva ,qsdew ,& + qsubl ,qfros ,gwat ,ssi ,& + wimp ,forc_us ,forc_vs ,& ! SNICAR forc_aer ,& - mss_bcpho ,mss_bcphi ,mss_ocpho,mss_ocphi,& - mss_dst1 ,mss_dst2 ,mss_dst3 ,mss_dst4 ) + mss_bcpho ,mss_bcphi ,mss_ocpho ,mss_ocphi ,& + mss_dst1 ,mss_dst2 ,mss_dst3 ,mss_dst4 ) !======================================================================= USE MOD_Precision - USE MOD_Const_Physical, only : denice, denh2o, tfrz + USE MOD_Const_Physical, only: denice, denh2o, tfrz USE MOD_SnowLayersCombineDivide USE MOD_SoilSnowHydrology @@ -1038,11 +1037,11 @@ SUBROUTINE GLACIER_WATER_snicar ( nl_ice,maxsnl,deltim,& t_icesno (maxsnl+1:nl_ice) , &! snow/ice skin temperature (K) wice_icesno(maxsnl+1:nl_ice) , &! ice lens (kg/m2) wliq_icesno(maxsnl+1:nl_ice) , &! liquid water (kg/m2) - scv , &! snow mass (kg/m2) - snowdp ! snow depth (m) + scv , &! snow mass (kg/m2) + snowdp ! snow depth (m) real(r8), intent(out) :: & - gwat ! net water input from top (mm/s) + gwat ! net water input from top (mm/s) real(r8), intent(in) :: forc_us real(r8), intent(in) :: forc_vs @@ -1066,16 +1065,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. +! 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. !======================================================================= lb = snl + 1 @@ -1091,7 +1090,7 @@ SUBROUTINE GLACIER_WATER_snicar ( nl_ice,maxsnl,deltim,& ENDIF !======================================================================= -! [2] surface runoff and infiltration +! [2] surface runoff and infiltration !======================================================================= IF(snl<0)THEN diff --git a/main/MOD_GroundFluxes.F90 b/main/MOD_GroundFluxes.F90 index 248006f5..3fd57d00 100644 --- a/main/MOD_GroundFluxes.F90 +++ b/main/MOD_GroundFluxes.F90 @@ -26,17 +26,17 @@ 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 +! Original author: Yongjiu Dai, 09/15/1999; 08/30/2002 ! -! REVISIONS: -! 09/2019, Hua Yuan: removed sigf to be consistent with PFT runs, removed -! fsena, fevpa, renamed z0ma to z0m. +! !REVISIONS: +! 09/2019, Hua Yuan: removed sigf to be consistent with PFT runs, removed +! fsena, fevpa, renamed z0ma to z0m. ! -! 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. ! !======================================================================= @@ -174,7 +174,7 @@ SUBROUTINE GroundFluxes (zlnd, zsno, hu, ht, hq, hpbl, & !---------------------------------------------------------------- displax = 0. IF (DEF_USE_CBL_HEIGHT) THEN - CALL moninobuk_leddy(hu,ht,hq,displax,z0mg,z0hg,z0qg,obu,um, hpbl, & + CALL moninobuk_leddy(hu,ht,hq,displax,z0mg,z0hg,z0qg,obu,um,hpbl, & ustar,fh2m,fq2m,fm10m,fm,fh,fq) ELSE CALL moninobuk(hu,ht,hq,displax,z0mg,z0hg,z0qg,obu,um,& diff --git a/main/MOD_GroundTemperature.F90 b/main/MOD_GroundTemperature.F90 index 5823d592..7c793425 100644 --- a/main/MOD_GroundTemperature.F90 +++ b/main/MOD_GroundTemperature.F90 @@ -37,33 +37,33 @@ SUBROUTINE GroundTemperature (patchtype,is_dry_lake,lb,nl_soil,deltim,& imelt,snofrz,sm,xmf,fact,pg_rain,pg_snow,t_precip) !======================================================================= -! Snow and soil 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 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). -! o Boundary conditions: -! F = Rnet - Hg - LEg + Hpr(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. +! Snow and soil 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 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). +! o Boundary conditions: +! F = Rnet - Hg - LEg + Hpr(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. ! -! Phase change (see meltf.F90) +! Phase change (see meltf.F90) ! -! Original author : Yongjiu Dai, 09/15/1999; 08/30/2002; 05/2018 +! Original author: Yongjiu Dai, 09/15/1999; 08/30/2002; 05/2018 ! -! REVISIONS: -! 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 +! !REVISIONS: +! 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 cac04b14..243ca862 100644 --- a/main/MOD_Hist.F90 +++ b/main/MOD_Hist.F90 @@ -3,20 +3,20 @@ MODULE MOD_Hist !---------------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! Write out gridded model results to history files. ! -! Original version: Yongjiu Dai, September 15, 1999, 03/2014 +! Original version: Yongjiu Dai, September 15, 1999, 03/2014 ! -! REVISIONS: -! Shupeng Zhang, 05/2023: 1) porting codes to MPI parallel version +! !REVISIONS: +! Shupeng Zhang, 05/2023: 1) porting codes to MPI parallel version ! -! TODO...(need complement) +! TODO...(need complement) !---------------------------------------------------------------------------- USE MOD_Vars_1DAccFluxes - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval USE MOD_NetCDFSerial USE MOD_HistGridded @@ -99,17 +99,17 @@ END SUBROUTINE hist_final SUBROUTINE hist_out (idate, deltim, itstamp, etstamp, ptstamp, & dir_hist, site) - !======================================================================= - ! Original version: Yongjiu Dai, September 15, 1999, 03/2014 - !======================================================================= +!======================================================================= +! Original version: Yongjiu Dai, September 15, 1999, 03/2014 +!======================================================================= USE MOD_Precision USE MOD_Namelist USE MOD_TimeManager USE MOD_SPMD_Task USE MOD_Vars_1DAccFluxes - USE MOD_Vars_1DFluxes, only : nsensor - USE MOD_Vars_TimeVariables, only : wa, wat, wetwat, wdsrf + USE MOD_Vars_1DFluxes, only: nsensor + USE MOD_Vars_TimeVariables, only: wa, wat, wetwat, wdsrf USE MOD_Block USE MOD_DataType USE MOD_LandPatch @@ -127,7 +127,7 @@ SUBROUTINE hist_out (idate, deltim, itstamp, etstamp, ptstamp, & #endif USE MOD_Forcing, only: forcmask_pch #ifdef DataAssimilation - USE MOD_DA_GRACE, only : fslp_k_mon + USE MOD_DA_GRACE, only: fslp_k_mon #endif IMPLICIT NONE diff --git a/main/MOD_HistGridded.F90 b/main/MOD_HistGridded.F90 index dc19cb03..e8fb0cf5 100644 --- a/main/MOD_HistGridded.F90 +++ b/main/MOD_HistGridded.F90 @@ -3,16 +3,16 @@ MODULE MOD_HistGridded !---------------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! Write out gridded model results to history files. ! -! Original version: Yongjiu Dai, September 15, 1999, 03/2014 +! Original version: Yongjiu Dai, September 15, 1999, 03/2014 ! -! REVISIONS: -! Shupeng Zhang, 05/2023: 1) porting codes to MPI parallel version +! !REVISIONS: +! Shupeng Zhang, 05/2023: 1) porting codes to MPI parallel version ! -! TODO...(need complement) +! TODO...(need complement) !---------------------------------------------------------------------------- USE MOD_Precision @@ -51,7 +51,7 @@ SUBROUTINE hist_gridded_init (dir_hist, lulcc_call) USE MOD_LandUrban #endif USE MOD_Vars_1DAccFluxes - USE MOD_Forcing, only : gforc + USE MOD_Forcing, only: gforc #ifdef SinglePoint USE MOD_SingleSrfData #endif diff --git a/main/MOD_HistSingle.F90 b/main/MOD_HistSingle.F90 index 74356fff..270f0956 100644 --- a/main/MOD_HistSingle.F90 +++ b/main/MOD_HistSingle.F90 @@ -1,20 +1,20 @@ #include #ifdef SinglePoint -module MOD_HistSingle +MODULE MOD_HistSingle !---------------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! Write out model results at sites to history files. ! -! Created by Shupeng Zhang, July 2023 +! Created by Shupeng Zhang, July 2023 ! -! TODO...(need complement) +! TODO...(need complement) !---------------------------------------------------------------------------- USE MOD_Precision USE MOD_NetCDFSerial - USE MOD_Namelist, only : USE_SITE_HistWriteBack + USE MOD_Namelist, only: USE_SITE_HistWriteBack USE MOD_SPMD_Task logical :: memory_to_disk @@ -35,7 +35,7 @@ module MOD_HistSingle type(hist_memory_type), target :: hist_memory type(hist_memory_type), pointer :: thisvar, nextvar -contains +CONTAINS ! ----- subroutines ------ ! -- initialize history IO -- @@ -49,26 +49,26 @@ SUBROUTINE hist_single_init () IF (USE_SITE_HistWriteBack) THEN - IF ( trim(DEF_HIST_groupby) == 'YEAR' ) then + IF ( trim(DEF_HIST_groupby) == 'YEAR' ) THEN secs_group = 366*24*3600 - ELSEIF ( trim(DEF_HIST_groupby) == 'MONTH' ) then + ELSEIF ( trim(DEF_HIST_groupby) == 'MONTH' ) THEN secs_group = 31*24*3600 - ELSEIF ( trim(DEF_HIST_groupby) == 'DAY' ) then + ELSEIF ( trim(DEF_HIST_groupby) == 'DAY' ) THEN secs_group = 24*3600 ENDIF - select case (trim(adjustl(DEF_HIST_FREQ))) - case ('TIMESTEP') + select CASE (trim(adjustl(DEF_HIST_FREQ))) + CASE ('TIMESTEP') secs_write = DEF_simulation_time%timestep - case ('HOURLY') + CASE ('HOURLY') secs_write = 3600 - case ('DAILY') + CASE ('DAILY') secs_write = 24*3600 - case ('MONTHLY') + CASE ('MONTHLY') secs_write = 31*24*3600 - case ('YEARLY') + CASE ('YEARLY') secs_write = 366*31*24*3600 - end select + END select ntime_mem = ceiling(secs_group / secs_write) + 2 @@ -109,17 +109,17 @@ SUBROUTINE hist_single_final () END SUBROUTINE hist_single_final ! -- write history time -- - subroutine hist_single_write_time (filename, dataname, time, itime) + SUBROUTINE hist_single_write_time (filename, dataname, time, itime) - use MOD_Namelist + USE MOD_Namelist USE MOD_TimeManager USE MOD_SingleSrfData USE MOD_NetCDFSerial - USE MOD_Landpatch, only : numpatch + USE MOD_Landpatch, only: numpatch #ifdef URBAN_MODEL - USE MOD_Landurban, only : numurban + USE MOD_Landurban, only: numurban #endif - implicit none + IMPLICIT NONE character (len=*), intent(in) :: filename character (len=*), intent(in) :: dataname @@ -132,18 +132,18 @@ subroutine hist_single_write_time (filename, dataname, time, itime) logical :: fexists inquire (file=filename, exist=fexists) - if (.not. fexists) then - call ncio_create_file (trim(filename)) - call ncio_define_dimension(filename, 'patch', numpatch) + IF (.not. fexists) THEN + CALL ncio_create_file (trim(filename)) + CALL ncio_define_dimension(filename, 'patch', numpatch) #ifdef URBAN_MODEL - call ncio_define_dimension(filename, 'urban', numurban) + CALL ncio_define_dimension(filename, 'urban', numurban) #endif - call ncio_write_serial (filename, 'lat', SITE_lat_location) + CALL ncio_write_serial (filename, 'lat', SITE_lat_location) CALL ncio_put_attr (filename, 'lat', 'long_name', 'latitude') CALL ncio_put_attr (filename, 'lat', 'units', 'degrees_north') - call ncio_write_serial (filename, 'lon', SITE_lon_location) + CALL ncio_write_serial (filename, 'lon', SITE_lon_location) CALL ncio_put_attr (filename, 'lon', 'long_name', 'longitude') CALL ncio_put_attr (filename, 'lon', 'units', 'degrees_east') @@ -153,20 +153,20 @@ subroutine hist_single_write_time (filename, dataname, time, itime) CALL ncio_define_dimension(filename, 'time', 0) ENDIF - endif + 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') + select CASE (trim(adjustl(DEF_HIST_FREQ))) + CASE ('HOURLY') minutes = minutes - 30 - case ('DAILY') + CASE ('DAILY') minutes = minutes - 720 - case ('MONTHLY') + CASE ('MONTHLY') minutes = minutes - 21600 - case ('YEARLY') + CASE ('YEARLY') minutes = minutes - 262800 END select @@ -175,7 +175,7 @@ subroutine hist_single_write_time (filename, dataname, time, itime) IF (memory_to_disk) THEN CALL ncio_define_dimension(filename, 'time', itime_mem) - call ncio_write_serial (filename, dataname, time_memory(1:itime_mem), 'time') + CALL ncio_write_serial (filename, dataname, time_memory(1:itime_mem), 'time') CALL ncio_put_attr (filename, dataname, 'long_name', 'time') CALL ncio_put_attr (filename, dataname, 'units', 'minutes since 1900-1-1 0:0:0') ENDIF @@ -183,7 +183,7 @@ subroutine hist_single_write_time (filename, dataname, time, itime) thisvar => hist_memory ELSE - call ncio_write_time (filename, dataname, time, itime, DEF_HIST_FREQ) + CALL ncio_write_time (filename, dataname, time, itime, DEF_HIST_FREQ) ENDIF END SUBROUTINE hist_single_write_time @@ -192,9 +192,9 @@ END SUBROUTINE hist_single_write_time 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 + USE MOD_Vars_1DAccFluxes, only: nac + USE MOD_Vars_Global, only: spval + IMPLICIT NONE real(r8), intent(inout) :: acc_vec(:) character(len=*), intent(in) :: file_hist @@ -203,7 +203,7 @@ SUBROUTINE single_write_2d ( & character(len=*), intent(in) :: longname character(len=*), intent(in) :: units - where (acc_vec /= spval) acc_vec = acc_vec / nac + WHERE (acc_vec /= spval) acc_vec = acc_vec / nac IF (USE_SITE_HistWriteBack) THEN @@ -237,7 +237,7 @@ SUBROUTINE single_write_2d ( & ELSE CALL ncio_write_serial_time (file_hist, varname, itime_in_file, acc_vec, & 'patch', 'time') - IF (itime_in_file == 1) then + IF (itime_in_file == 1) THEN CALL ncio_put_attr (file_hist, varname, 'long_name', longname) CALL ncio_put_attr (file_hist, varname, 'units', units) CALL ncio_put_attr (file_hist, varname, 'missing_value', spval) @@ -250,9 +250,9 @@ END SUBROUTINE single_write_2d 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 + USE MOD_Vars_1DAccFluxes, only: nac + USE MOD_Vars_Global, only: spval + IMPLICIT NONE real(r8), intent(inout) :: acc_vec(:) character(len=*), intent(in) :: file_hist @@ -261,7 +261,7 @@ SUBROUTINE single_write_urb_2d ( & character(len=*), intent(in) :: longname character(len=*), intent(in) :: units - where (acc_vec /= spval) acc_vec = acc_vec / nac + WHERE (acc_vec /= spval) acc_vec = acc_vec / nac IF (USE_SITE_HistWriteBack) THEN @@ -295,7 +295,7 @@ SUBROUTINE single_write_urb_2d ( & ELSE CALL ncio_write_serial_time (file_hist, varname, itime_in_file, acc_vec, & 'urban', 'time') - IF (itime_in_file == 1) then + IF (itime_in_file == 1) THEN CALL ncio_put_attr (file_hist, varname, 'long_name', longname) CALL ncio_put_attr (file_hist, varname, 'units', units) CALL ncio_put_attr (file_hist, varname, 'missing_value', spval) @@ -308,9 +308,9 @@ END SUBROUTINE single_write_urb_2d 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 + USE MOD_Vars_1DAccFluxes, only: nac_ln + USE MOD_Vars_Global, only: spval + IMPLICIT NONE real(r8), intent(inout) :: acc_vec(:) character(len=*), intent(in) :: file_hist @@ -319,7 +319,7 @@ SUBROUTINE single_write_ln ( & character(len=*), intent(in) :: longname character(len=*), intent(in) :: units - where ((acc_vec /= spval) .and. (nac_ln > 0)) + WHERE ((acc_vec /= spval) .and. (nac_ln > 0)) acc_vec = acc_vec / nac_ln END WHERE @@ -355,7 +355,7 @@ SUBROUTINE single_write_ln ( & ELSE CALL ncio_write_serial_time (file_hist, varname, itime_in_file, acc_vec, & 'patch', 'time') - IF (itime_in_file == 1) then + IF (itime_in_file == 1) THEN CALL ncio_put_attr (file_hist, varname, 'long_name', longname) CALL ncio_put_attr (file_hist, varname, 'units', units) CALL ncio_put_attr (file_hist, varname, 'missing_value', spval) @@ -368,9 +368,9 @@ END SUBROUTINE single_write_ln 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 + USE MOD_Vars_1DAccFluxes, only: nac + USE MOD_Vars_Global, only: spval + IMPLICIT NONE real(r8), intent(inout) :: acc_vec(:,:) character(len=*), intent(in) :: file_hist @@ -381,7 +381,7 @@ SUBROUTINE single_write_3d ( & character(len=*), intent(in) :: longname character(len=*), intent(in) :: units - where (acc_vec /= spval) acc_vec = acc_vec / nac + WHERE (acc_vec /= spval) acc_vec = acc_vec / nac IF (USE_SITE_HistWriteBack) THEN @@ -405,7 +405,7 @@ SUBROUTINE single_write_3d ( & thisvar%v3d(:,:,itime_mem) = acc_vec IF (memory_to_disk) THEN - call ncio_define_dimension (file_hist, dim1name, ndim1) + CALL ncio_define_dimension (file_hist, dim1name, ndim1) CALL ncio_write_serial (file_hist, varname, thisvar%v3d(:,:,1:itime_mem), & dim1name, 'patch', 'time') CALL ncio_put_attr (file_hist, varname, 'long_name', longname) @@ -414,10 +414,10 @@ SUBROUTINE single_write_3d ( & ENDIF ELSE - call ncio_define_dimension (file_hist, dim1name, ndim1) + CALL ncio_define_dimension (file_hist, dim1name, ndim1) CALL ncio_write_serial_time (file_hist, varname, itime_in_file, acc_vec, & dim1name, 'patch', 'time') - IF (itime_in_file == 1) then + IF (itime_in_file == 1) THEN CALL ncio_put_attr (file_hist, varname, 'long_name', longname) CALL ncio_put_attr (file_hist, varname, 'units', units) CALL ncio_put_attr (file_hist, varname, 'missing_value', spval) @@ -431,9 +431,9 @@ 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 + USE MOD_Vars_1DAccFluxes, only: nac + USE MOD_Vars_Global, only: spval + IMPLICIT NONE real(r8), intent(inout) :: acc_vec(:,:,:) character(len=*), intent(in) :: file_hist @@ -446,7 +446,7 @@ SUBROUTINE single_write_4d ( & character(len=*), intent(in) :: longname character(len=*), intent(in) :: units - where (acc_vec /= spval) acc_vec = acc_vec / nac + WHERE (acc_vec /= spval) acc_vec = acc_vec / nac IF (USE_SITE_HistWriteBack) THEN @@ -470,8 +470,8 @@ SUBROUTINE single_write_4d ( & thisvar%v4d(:,:,:,itime_mem) = acc_vec IF (memory_to_disk) THEN - call ncio_define_dimension (file_hist, dim1name, ndim1) - call ncio_define_dimension (file_hist, dim2name, ndim2) + CALL ncio_define_dimension (file_hist, dim1name, ndim1) + CALL ncio_define_dimension (file_hist, dim2name, ndim2) CALL ncio_write_serial (file_hist, varname, thisvar%v4d(:,:,:,1:itime_mem), & dim1name, dim2name, 'patch', 'time') CALL ncio_put_attr (file_hist, varname, 'long_name', longname) @@ -480,11 +480,11 @@ SUBROUTINE single_write_4d ( & ENDIF ELSE - call ncio_define_dimension (file_hist, dim1name, ndim1) - call ncio_define_dimension (file_hist, dim2name, ndim2) + CALL ncio_define_dimension (file_hist, dim1name, ndim1) + CALL ncio_define_dimension (file_hist, dim2name, ndim2) CALL ncio_write_serial_time (file_hist, varname, itime_in_file, acc_vec, & dim1name, dim2name, 'patch', 'time') - IF (itime_in_file == 1) then + IF (itime_in_file == 1) THEN CALL ncio_put_attr (file_hist, varname, 'long_name', longname) CALL ncio_put_attr (file_hist, varname, 'units', units) CALL ncio_put_attr (file_hist, varname, 'missing_value', spval) @@ -493,5 +493,5 @@ SUBROUTINE single_write_4d ( & END SUBROUTINE single_write_4d -end module MOD_HistSingle +END MODULE MOD_HistSingle #endif diff --git a/main/MOD_HistVector.F90 b/main/MOD_HistVector.F90 index 3073f5c8..865415b0 100644 --- a/main/MOD_HistVector.F90 +++ b/main/MOD_HistVector.F90 @@ -4,19 +4,19 @@ MODULE MOD_HistVector !---------------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! Write out vectorized model results to history files. ! -! Created by Shupeng Zhang, May 2023 +! Created by Shupeng Zhang, May 2023 ! -! TODO...(need complement) +! TODO...(need complement) !---------------------------------------------------------------------------- USE MOD_Precision USE MOD_SPMD_Task USE MOD_Namelist - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval USE MOD_Mesh USE MOD_LandElm #ifdef CATCHMENT diff --git a/main/MOD_HistWriteBack.F90 b/main/MOD_HistWriteBack.F90 index 4120a984..866d8345 100644 --- a/main/MOD_HistWriteBack.F90 +++ b/main/MOD_HistWriteBack.F90 @@ -3,11 +3,11 @@ #ifdef USEMPI MODULE MOD_HistWriteBack !---------------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! Write out data to history files by a dedicated process. ! -! Author: Shupeng Zhang, 11/2023 +! Author: Shupeng Zhang, 11/2023 !---------------------------------------------------------------------------- USE MOD_Precision @@ -80,7 +80,7 @@ MODULE MOD_HistWriteBack ! ----- SUBROUTINE hist_writeback_daemon () - USE MOD_Namelist, only : DEF_HIST_FREQ + USE MOD_Namelist, only: DEF_HIST_FREQ USE MOD_Vars_Global, only: spval IMPLICIT NONE diff --git a/main/MOD_Irrigation.F90 b/main/MOD_Irrigation.F90 index ea2bc5f2..d43cf2bd 100644 --- a/main/MOD_Irrigation.F90 +++ b/main/MOD_Irrigation.F90 @@ -17,7 +17,7 @@ MODULE MOD_Irrigation theta_r, alpha_vgm, n_vgm, L_vgm, fc_vgm, sc_vgm,& #endif porsl, psi0, bsw - USE MOD_Vars_TimeVariables, only : tref, t_soisno, wliq_soisno, irrig_rate, deficit_irrig, sum_irrig, sum_irrig_count, n_irrig_steps_left, & + USE MOD_Vars_TimeVariables, only: tref, t_soisno, wliq_soisno, irrig_rate, deficit_irrig, sum_irrig, sum_irrig_count, n_irrig_steps_left, & tairday, usday, vsday, pairday, rnetday, fgrndday, potential_evapotranspiration USE MOD_Vars_PFTimeInvariants, only: pftclass USE MOD_Vars_PFTimeVariables, only: irrig_method_p diff --git a/main/MOD_LAIEmpirical.F90 b/main/MOD_LAIEmpirical.F90 index e18df316..f963fd7f 100644 --- a/main/MOD_LAIEmpirical.F90 +++ b/main/MOD_LAIEmpirical.F90 @@ -21,23 +21,23 @@ MODULE MOD_LAIEmpirical SUBROUTINE LAI_empirical(ivt,nl_soil,rootfr,t,lai,sai,fveg,green) !----------------------------------------------------------------------- -! provides leaf and stem area parameters -! Original author : Yongjiu Dai, 08/31/2002 +! provides leaf and stem area parameters +! Original author: Yongjiu Dai, 08/31/2002 !----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- - integer, intent(in) :: ivt !land cover type - integer, intent(in) :: nl_soil !number of soil layers + 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 - real(r8), intent(out) :: lai !leaf area index - real(r8), intent(out) :: sai !Stem area index - real(r8), intent(out) :: fveg !fractional cover of vegetation - real(r8), intent(out) :: green !greenness + real(r8), intent(in) :: rootfr(1:nl_soil) !root fraction + real(r8), intent(in) :: t(1:nl_soil) !soil temperature + real(r8), intent(out) :: lai !leaf area index + real(r8), intent(out) :: sai !Stem area index + real(r8), intent(out) :: fveg !fractional cover of vegetation + real(r8), intent(out) :: green !greenness !-------------------------- Local Variables ---------------------------- real(r8) f ! @@ -73,7 +73,7 @@ SUBROUTINE LAI_empirical(ivt,nl_soil,rootfr,t,lai,sai,fveg,green) real(r8), dimension(11), parameter :: & vegc=(/1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 0.0, 0.0/) real(r8), dimension(11), parameter :: & - xla=(/4.8, 3.9, 5.6, 5.5, 4.6, 1.7, 1.3, 2.1, 3.6, 0.0, 0.0/) + xla =(/4.8, 3.9, 5.6, 5.5, 4.6, 1.7, 1.3, 2.1, 3.6, 0.0, 0.0/) real(r8), dimension(11), parameter :: & xla0=(/4.0, 0.6, 0.5, 5.0, 0.5, 0.3, 0.6, 0.4, 0.2, 0.0, 0.0/) real(r8), dimension(11), parameter :: & @@ -83,8 +83,8 @@ SUBROUTINE LAI_empirical(ivt,nl_soil,rootfr,t,lai,sai,fveg,green) vegc=(/1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 0.0, 1.0, 1.0,& 1.0, 0.0, 1.0, 0.0, 0.0, 1.0, 1.0, 1.0, 1.0/) real(r8), dimension(19), parameter :: & - xla=(/5.1, 1.6, 4.8, 4.8, 4.8, 5.4, 4.8, 0.0, 3.6, 4.8,& - 0.6, 0.0, 4.8, 0.0, 0.0, 4.8, 4.8, 4.8, 4.8/) + xla =(/5.1, 1.6, 4.8, 4.8, 4.8, 5.4, 4.8, 0.0, 3.6, 4.8,& + 0.6, 0.0, 4.8, 0.0, 0.0, 4.8, 4.8, 4.8, 4.8/) real(r8), dimension(19), parameter :: & xla0=(/0.425, 0.4, 4.0, 0.8, 0.8, 4.5, 0.4, 0.0, 0.3, 0.4,& 0.05, 0.0, 0.4, 0.0, 0.0, 4.0, 0.8, 2.4, 2.4/) @@ -99,8 +99,8 @@ SUBROUTINE LAI_empirical(ivt,nl_soil,rootfr,t,lai,sai,fveg,green) vegc=(/1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0,& 1.0, 1.0, 1.0, 1.0, 0.0, 1.0, 0.0/) real(r8), dimension(17), parameter :: & - xla=(/4.8, 5.4, 4.8, 4.8, 4.7, 4.7, 1.6, 4.7, 4.8, 1.7,& - 4.6, 4.9, 3.8, 4.8, 0.0, 0.06, 0.0/) + xla =(/4.8, 5.4, 4.8, 4.8, 4.7, 4.7, 1.6, 4.7, 4.8, 1.7,& + 4.6, 4.9, 3.8, 4.8, 0.0, 0.06, 0.0/) real(r8), dimension(17), parameter :: & xla0=(/4.0, 4.5, 0.8, 0.8, 2.2, 1.6, 0.15, 1.8, 0.9, 0.4,& 0.4, 0.4, 0.9, 2.0, 0.0, 0.006, 0.0/) diff --git a/main/MOD_LAIReadin.F90 b/main/MOD_LAIReadin.F90 index 77cb80dd..d63ec8d6 100644 --- a/main/MOD_LAIReadin.F90 +++ b/main/MOD_LAIReadin.F90 @@ -19,12 +19,12 @@ MODULE MOD_LAIReadin SUBROUTINE LAI_readin (year, time, dir_landdata) - ! =========================================================== - ! Read in the LAI, the LAI dataset was created by Yuan et al. (2011) - ! http://globalchange.bnu.edu.cn - ! - ! Created by Yongjiu Dai, March, 2014 - ! =========================================================== +! =========================================================== +! Read in the LAI, the LAI dataset was created by Yuan et al. (2011) +! http://globalchange.bnu.edu.cn +! +! Created by Yongjiu Dai, March, 2014 +! =========================================================== USE MOD_Precision USE MOD_Namelist diff --git a/main/MOD_Lake.F90 b/main/MOD_Lake.F90 index c1a7142a..cdf3db83 100644 --- a/main/MOD_Lake.F90 +++ b/main/MOD_Lake.F90 @@ -3,19 +3,19 @@ MODULE MOD_Lake !----------------------------------------------------------------------- -! DESCRIPTION: -! Simulating energy balance processes of land water body +! !DESCRIPTION: +! Simulating energy balance processes of land water body ! -! REFERENCE: -! Dai et al, 2018, The lake scheme of the common land model and its performance evaluation. -! Chinese Science Bulletin, 63(28-29), 3002–3021, https://doi.org/10.1360/N972018-00609 +! !REFERENCES: +! Dai et al, 2018, The lake scheme of the common land model and its performance evaluation. +! Chinese Science Bulletin, 63(28-29), 3002–3021, https://doi.org/10.1360/N972018-00609 ! -! Original author: Yongjiu Dai 04/2014/ +! Original author: Yongjiu Dai 04/2014/ ! -! Revisions: -! Nan Wei, 01/2018: interaction btw prec and lake surface including phase change of prec and water body -! Nan Wei, 06/2018: update heat conductivity of water body and soil below and snow hydrology -! Hua Yuan, 01/2023: added snow layer absorption in melting calculation +! !REVISIONS: +! Nan Wei, 01/2018: interaction btw prec and lake surface including phase change of prec and water body +! Nan Wei, 06/2018: update heat conductivity of water body and soil below and snow hydrology +! Hua Yuan, 01/2023: added snow layer absorption in melting calculation !----------------------------------------------------------------------- USE MOD_Precision @@ -49,23 +49,24 @@ SUBROUTINE newsnow_lake ( USE_Dynamic_Lake, & ! "inout" arguments ! ------------------ - t_lake , zi_soisno , z_soisno ,& + t_lake , zi_soisno , z_soisno ,& dz_soisno , t_soisno , wliq_soisno , wice_soisno ,& fiold , snl , sag , scv ,& snowdp , lake_icefrac ) !----------------------------------------------------------------------- -! DESCRIPTION: -! Add new snow nodes and interaction btw prec and lake surface including phase change of prec and water body +! !DESCRIPTION: +! Add new snow nodes and interaction btw prec and lake surface including phase +! change of prec and water body ! -! Original author : Yongjiu Dai, 04/2014 +! Original author: Yongjiu Dai, 04/2014 ! -! Revisions: -! Nan Wei, 01/2018: update interaction btw prec and lake surface +! !REVISIONS: +! Nan Wei, 01/2018: update interaction btw prec and lake surface !----------------------------------------------------------------------- USE MOD_Precision - USE MOD_Const_Physical, only : tfrz, denh2o, cpliq, cpice, hfus + USE MOD_Const_Physical, only: tfrz, denh2o, cpliq, cpice, hfus IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- @@ -87,10 +88,10 @@ 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) @@ -309,63 +310,64 @@ SUBROUTINE laketem (& urban_call) ! ------------------------ code history --------------------------- -! purpose: lake temperature and snow on frozen lake -! initial Yongjiu Dai, 2000 -! Zack Subin, 2009 -! Yongjiu Dai, /12/2012/, /04/2014/, 06/2018 -! Nan Wei, /06/2018/ +! purpose: lake temperature and snow on frozen lake +! initial Yongjiu Dai, 2000 +! Zack Subin, 2009 +! Yongjiu Dai, /12/2012/, /04/2014/, 06/2018 +! Nan Wei, /06/2018/ ! ! ------------------------ notes ---------------------------------- -! Lakes have variable depth, possible snow layers above, freezing & thawing of lake water, -! and soil layers with active temperature and gas diffusion below. +! Lakes have variable depth, possible snow layers above, freezing & +! thawing of lake water, and soil layers with active temperature and +! gas diffusion below. ! -! Calculates temperatures in the 25-30 layer column of (possible) snow, -! lake water, soil, and bedrock beneath lake. -! Snow and soil temperatures are determined as in SoilTemperature, except -! for appropriate boundary conditions at the top of the snow (the flux is fixed -! to be the ground heat flux), the bottom of the snow (adjacent to top lake layer), -! and the top of the soil (adjacent to the bottom lake layer). -! Also, the soil is kept fully saturated. -! The whole column is solved simultaneously as one tridiagonal matrix. +! Calculates temperatures in the 25-30 layer column of (possible) snow, +! lake water, soil, and bedrock beneath lake. Snow and soil +! temperatures are determined as in SoilTemperature, except for +! appropriate boundary conditions at the top of the snow (the flux is +! fixed to be the ground heat flux), the bottom of the snow (adjacent +! to top lake layer), and the top of the soil (adjacent to the bottom +! lake layer). Also, the soil is kept fully saturated. The whole +! column is solved simultaneously as one tridiagonal matrix. ! -! calculate lake temperatures from one-dimensional thermal -! stratification model based on eddy diffusion concepts to -! represent vertical mixing of heat +! calculate lake temperatures from one-dimensional thermal +! stratification model based on eddy diffusion concepts to represent +! vertical mixing of heat ! -! d ts d d ts 1 ds -! ---- = -- [(km + ke) ----] + -- -- -! dt dz dz cw dz -! where: ts = temperature (kelvin) -! t = time (s) -! z = depth (m) -! km = molecular diffusion coefficient (m**2/s) -! ke = eddy diffusion coefficient (m**2/s) -! cw = heat capacity (j/m**3/kelvin) -! s = heat source term (w/m**2) +! d ts d d ts 1 ds +! ---- = -- [(km + ke) ----] + -- -- +! dt dz dz cw dz +! where: ts = temperature (kelvin) +! t = time (s) +! z = depth (m) +! km = molecular diffusion coefficient (m**2/s) +! ke = eddy diffusion coefficient (m**2/s) +! cw = heat capacity (j/m**3/kelvin) +! s = heat source term (w/m**2) ! -! use crank-nicholson method to set up tridiagonal system of equations to -! solve for ts at time n+1, where the temperature equation for layer i is -! r_i = a_i [ts_i-1] n+1 + b_i [ts_i] n+1 + c_i [ts_i+1] n+1 -! the solution conserves energy as -! cw*([ts( 1)] n+1 - [ts( 1)] n)*dz( 1)/dt + ... + -! cw*([ts(nl_lake)] n+1 - [ts(nl_lake)] n)*dz(nl_lake)/dt = fin -! where -! [ts] n = old temperature (kelvin) -! [ts] n+1 = new temperature (kelvin) -! fin = heat flux into lake (w/m**2) -! = beta*sabg_snow_lyr(1)+forc_frl-olrg-fsena-lfevpa-hm + phi(1) + ... + phi(nl_lake) +! use crank-nicholson method to set up tridiagonal system of equations to +! solve for ts at time n+1, where the temperature equation for layer i is +! r_i = a_i [ts_i-1] n+1 + b_i [ts_i] n+1 + c_i [ts_i+1] n+1 +! the solution conserves energy as +! cw*([ts( 1)] n+1 - [ts( 1)] n)*dz( 1)/dt + ... + +! cw*([ts(nl_lake)] n+1 - [ts(nl_lake)] n)*dz(nl_lake)/dt = fin +! where +! [ts] n = old temperature (kelvin) +! [ts] n+1 = new temperature (kelvin) +! fin = heat flux into lake (w/m**2) +! = beta*sabg_snow_lyr(1)+forc_frl-olrg-fsena-lfevpa-hm + phi(1) + ... + phi(nl_lake) ! -! REVISIONS: -! Yongjiu Dai and Hua Yuan, 01/2023: added SNICAR for layer solar absorption, ground heat -! flux, temperature and freezing mass calculations -! Shaofeng Liu, 05/2023: add option to call moninobuk_leddy, the LargeEddy -! surface turbulence scheme (LZD2022); -! make a proper update of um. +! !REVISIONS: +! Yongjiu Dai and Hua Yuan, 01/2023: added SNICAR for layer solar absorption, ground heat +! flux, temperature and freezing mass calculations +! Shaofeng Liu, 05/2023: add option to call moninobuk_leddy, the LargeEddy +! surface turbulence scheme (LZD2022); +! make a proper update of um. ! ! ----------------------------------------------------------------- USE MOD_Precision - USE MOD_Const_Physical, only : tfrz,hvap,hfus,hsub,tkwat,tkice,tkair,stefnc,& - vonkar,grav,cpliq,cpice,cpair,denh2o,denice,rgas + USE MOD_Const_Physical, only: tfrz,hvap,hfus,hsub,tkwat,tkice,tkair,stefnc,& + vonkar,grav,cpliq,cpice,cpair,denh2o,denice,rgas USE MOD_FrictionVelocity USE MOD_Namelist, only: DEF_USE_CBL_HEIGHT, DEF_USE_SNICAR USE MOD_TurbulenceLEddy @@ -568,8 +570,8 @@ SUBROUTINE laketem (& real(r8) tk_lake(1:nl_lake) ! thermal conductivity at layer node [W/(m K)] real(r8) cv_soisno(maxsnl+1:nl_soil) ! heat capacity of soil/snow [J/(m2 K)] real(r8) tk_soisno(maxsnl+1:nl_soil) ! thermal conductivity of soil/snow [W/(m K)] (at interface below, except for j=0) - real(r8) hcap(1:nl_soil) ! J/(m3 K) - real(r8) thk(maxsnl+1:nl_soil) ! W/(m K) + real(r8) hcap(1:nl_soil) ! J/(m3 K) + real(r8) thk(maxsnl+1:nl_soil) ! W/(m K) real(r8) tktopsoil ! thermal conductivity of the top soil layer [W/(m K)] real(r8) t_soisno_bef(maxsnl+1:nl_soil) ! beginning soil/snow temp for E cons. check [K] @@ -629,8 +631,8 @@ SUBROUTINE laketem (& real(r8) tmp ! real(r8) h_fin ! real(r8) h_finDT ! - real(r8) del_T_grnd ! -! real(r8) savedtke1 + real(r8) del_T_grnd! + !real(r8) savedtke1 integer iter ! iteration index integer convernum ! number of time when del_T_grnd < 0.01 @@ -1569,26 +1571,27 @@ SUBROUTINE snowwater_lake ( USE_Dynamic_Lake, & urban_call ) !----------------------------------------------------------------------------------------------- -! Calculation of Lake Hydrology. Lake water mass is kept constant. The soil is simply maintained at -! volumetric saturation if ice melting frees up pore space. +! Calculation of Lake Hydrology. Lake water mass is kept constant. The +! soil is simply maintained at volumetric saturation if ice melting +! frees up pore space. ! -! Called: -! -> snowwater: change of snow mass and snow water onto soil -! -> snowcompaction: compaction of snow layers -! -> combinesnowlayers: combine snow layers that are thinner than minimum -! -> dividesnowlayers: subdivide snow layers that are thicker than maximum +! Called: +! -> snowwater: change of snow mass and snow water onto soil +! -> snowcompaction: compaction of snow layers +! -> combinesnowlayers: combine snow layers that are thinner than minimum +! -> dividesnowlayers: subdivide snow layers that are thicker than maximum ! -! Initial: Yongjiu Dai, December, 2012 -! April, 2014 -! REVISIONS: -! Nan Wei, 06/2018: update snow hydrology above lake -! Yongjiu Dai, 01/2023: added for SNICAR model effects for snowwater, -! combinesnowlayers, dividesnowlayers processes by calling snowwater_snicar(), -! SnowLayersCombine_snicar, SnowLayersDivide_snicar() +! Initial: Yongjiu Dai, December, 2012 +! April, 2014 +! !REVISIONS: +! Nan Wei, 06/2018: update snow hydrology above lake +! Yongjiu Dai, 01/2023: added for SNICAR model effects for snowwater, +! combinesnowlayers, dividesnowlayers processes by calling snowwater_snicar(), +! SnowLayersCombine_snicar, SnowLayersDivide_snicar() !----------------------------------------------------------------------------------------------- USE MOD_Precision - USE MOD_Const_Physical, only : denh2o, denice, hfus, tfrz, cpliq, cpice + USE MOD_Const_Physical, only: denh2o, denice, hfus, tfrz, cpliq, cpice USE MOD_SoilSnowHydrology USE MOD_SnowLayersCombineDivide @@ -1624,9 +1627,9 @@ SUBROUTINE snowwater_lake ( USE_Dynamic_Lake, & real(r8), intent(inout) :: t_soisno (maxsnl+1:nl_soil) ! snow temperature (Kelvin) real(r8), intent(inout) :: wice_soisno(maxsnl+1:nl_soil) ! ice lens (kg/m2) real(r8), intent(inout) :: wliq_soisno(maxsnl+1:nl_soil) ! liquid water (kg/m2) - real(r8), intent(inout) :: t_lake (1:nl_lake) ! lake temperature (Kelvin) - real(r8), intent(inout) :: lake_icefrac(1:nl_lake) ! mass fraction of lake layer that is frozen - real(r8), intent(inout) :: qout_snowb ! rate of water out of snow bottom (mm/s) + real(r8), intent(inout) :: t_lake (1:nl_lake) ! lake temperature (Kelvin) + real(r8), intent(inout) :: lake_icefrac(1:nl_lake) ! mass fraction of lake layer that is frozen + real(r8), intent(inout) :: qout_snowb ! rate of water out of snow bottom (mm/s) real(r8), intent(inout) :: fseng ! total sensible heat flux (W/m**2) [+ to atm] real(r8), intent(inout) :: fgrnd ! heat flux into snow / lake (W/m**2) [+ = into soil] @@ -1783,7 +1786,7 @@ SUBROUTINE snowwater_lake ( USE_Dynamic_Lake, & sumsnowice = sumsnowice + wice_soisno(j) sumsnowliq = sumsnowliq + wliq_soisno(j) heatsum = heatsum + wice_soisno(j)*cpice*(tfrz-t_soisno(j)) & - + wliq_soisno(j)*cpliq*(tfrz-t_soisno(j)) + + wliq_soisno(j)*cpliq*(tfrz-t_soisno(j)) ENDIF ENDDO @@ -1903,41 +1906,41 @@ SUBROUTINE roughness_lake (snl,t_grnd,t_lake,lake_icefrac,forc_psrf,& cur,ustar,z0mg,z0hg,z0qg) !----------------------------------------------------------------------- -! DESCRIPTION: -! Calculate lake surface roughness +! !DESCRIPTION: +! Calculate lake surface roughness ! -! Original: -! The Community Land Model version 4.5 (CLM4.5) +! Original: +! The Community Land Model version 4.5 (CLM4.5) ! -! Revisions: -! Yongjiu Dai, Nan Wei, 01/2018 +! !REVISIONS: +! Yongjiu Dai, Nan Wei, 01/2018 !----------------------------------------------------------------------- USE MOD_Precision - USE MOD_Const_Physical, only : tfrz,vonkar,grav + USE MOD_Const_Physical, only: tfrz,vonkar,grav IMPLICIT NONE - integer, intent(in) :: snl ! number of snow layers - real(r8), intent(in) :: t_grnd ! ground temperature - real(r8), intent(in) :: t_lake(1) ! surface lake layer temperature [K] + integer, intent(in) :: snl ! number of snow layers + real(r8), intent(in) :: t_grnd ! ground temperature + real(r8), intent(in) :: t_lake(1) ! surface lake layer temperature [K] real(r8), intent(in) :: lake_icefrac(1) ! surface lake layer ice mass fraction [0-1] - real(r8), intent(in) :: forc_psrf ! atmosphere pressure at the surface [pa] + real(r8), intent(in) :: forc_psrf ! atmosphere pressure at the surface [pa] - real(r8), intent(in) :: cur ! Charnock parameter (-) - real(r8), intent(in) :: ustar ! u* in similarity theory [m/s] + real(r8), intent(in) :: cur ! Charnock parameter (-) + real(r8), intent(in) :: ustar ! u* in similarity theory [m/s] - real(r8), intent(out) :: z0mg ! roughness length over ground, momentum [m] - real(r8), intent(out) :: z0hg ! roughness length over ground, sensible heat [m] - real(r8), intent(out) :: z0qg ! roughness length over ground, latent heat [m] + real(r8), intent(out) :: z0mg ! roughness length over ground, momentum [m] + real(r8), intent(out) :: z0hg ! roughness length over ground, sensible heat [m] + real(r8), intent(out) :: z0qg ! roughness length over ground, latent heat [m] - real(r8), parameter :: cus = 0.1 ! empirical constant for roughness under smooth flow - real(r8), parameter :: kva0 = 1.51e-5 ! kinematic viscosity of air (m^2/s) at 20C and 1.013e5 Pa - real(r8), parameter :: prn = 0.713 ! Prandtl # for air at neutral stability - real(r8), parameter :: sch = 0.66 ! Schmidt # for water in air at neutral stability + real(r8), parameter :: cus = 0.1 ! empirical constant for roughness under smooth flow + real(r8), parameter :: kva0 = 1.51e-5 ! kinematic viscosity of air (m^2/s) at 20C and 1.013e5 Pa + real(r8), parameter :: prn = 0.713 ! Prandtl # for air at neutral stability + real(r8), parameter :: sch = 0.66 ! Schmidt # for water in air at neutral stability - real(r8) kva ! kinematic viscosity of air at ground temperature and forcing pressure - real(r8) sqre0 ! root of roughness Reynolds number + 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 @@ -1972,8 +1975,8 @@ SUBROUTINE hConductivity_lake(nl_lake,snl,t_grnd,& ! ------------------------------------------------------------------------- USE MOD_Precision - USE MOD_Const_Physical, only : tfrz,tkwat,tkice,tkair,& - vonkar,grav,cpliq,cpice,cpair,denh2o,denice + USE MOD_Const_Physical, only: tfrz,tkwat,tkice,tkair,& + vonkar,grav,cpliq,cpice,cpair,denh2o,denice IMPLICIT NONE diff --git a/main/MOD_LeafInterception.F90 b/main/MOD_LeafInterception.F90 index f654b46b..0dce05a9 100644 --- a/main/MOD_LeafInterception.F90 +++ b/main/MOD_LeafInterception.F90 @@ -1394,7 +1394,7 @@ SUBROUTINE LEAF_interception_VIC (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai MaxInt=0.1*lsai IF (tair>-272.15) THEN Lr=4.0 - ELSE IF (tair<=-272.15 .and. tair>=-270.15) THEN + ELSEIF (tair<=-272.15 .and. tair>=-270.15) THEN Lr=1.5*(tair-273.15)+5.5 ELSE Lr=1.0 @@ -1924,7 +1924,7 @@ SUBROUTINE LEAF_interception_pftwrap (ipatch,deltim,dewmx,forc_us,forc_vs,forc_t pg_rain_tmp = pg_rain_tmp + pg_rain*pftfrac(i) pg_snow_tmp = pg_snow_tmp + pg_snow*pftfrac(i) ENDDO - ELSE IF (DEF_Interception_scheme==2) THEN + ELSEIF (DEF_Interception_scheme==2) THEN DO i = ps, pe p = pftclass(i) CALL LEAF_interception_clm4 (deltim,dewmx,forc_us,forc_vs,chil_p(p),sigf_p(i),lai_p(i),sai_p(i),forc_t,tleaf_p(i),& @@ -1933,7 +1933,7 @@ SUBROUTINE LEAF_interception_pftwrap (ipatch,deltim,dewmx,forc_us,forc_vs,forc_t pg_rain_tmp = pg_rain_tmp + pg_rain*pftfrac(i) pg_snow_tmp = pg_snow_tmp + pg_snow*pftfrac(i) ENDDO - ELSE IF (DEF_Interception_scheme==3) THEN + ELSEIF (DEF_Interception_scheme==3) THEN DO i = ps, pe p = pftclass(i) CALL LEAF_interception_clm5 (deltim,dewmx,forc_us,forc_vs,chil_p(p),sigf_p(i),lai_p(i),sai_p(i),forc_t,tleaf_p(i),& @@ -1942,7 +1942,7 @@ SUBROUTINE LEAF_interception_pftwrap (ipatch,deltim,dewmx,forc_us,forc_vs,forc_t pg_rain_tmp = pg_rain_tmp + pg_rain*pftfrac(i) pg_snow_tmp = pg_snow_tmp + pg_snow*pftfrac(i) ENDDO - ELSE IF (DEF_Interception_scheme==4) THEN + ELSEIF (DEF_Interception_scheme==4) THEN DO i = ps, pe p = pftclass(i) CALL LEAF_interception_clm5 (deltim,dewmx,forc_us,forc_vs,chil_p(p),sigf_p(i),lai_p(i),sai_p(i),forc_t,tleaf_p(i),& @@ -1951,7 +1951,7 @@ SUBROUTINE LEAF_interception_pftwrap (ipatch,deltim,dewmx,forc_us,forc_vs,forc_t pg_rain_tmp = pg_rain_tmp + pg_rain*pftfrac(i) pg_snow_tmp = pg_snow_tmp + pg_snow*pftfrac(i) ENDDO - ELSE IF (DEF_Interception_scheme==5) THEN + ELSEIF (DEF_Interception_scheme==5) THEN DO i = ps, pe p = pftclass(i) CALL LEAF_interception_MATSIRO (deltim,dewmx,forc_us,forc_vs,chil_p(p),sigf_p(i),lai_p(i),sai_p(i),forc_t,tleaf_p(i),& @@ -1960,7 +1960,7 @@ SUBROUTINE LEAF_interception_pftwrap (ipatch,deltim,dewmx,forc_us,forc_vs,forc_t pg_rain_tmp = pg_rain_tmp + pg_rain*pftfrac(i) pg_snow_tmp = pg_snow_tmp + pg_snow*pftfrac(i) ENDDO - ELSE IF (DEF_Interception_scheme==6) THEN + ELSEIF (DEF_Interception_scheme==6) THEN DO i = ps, pe p = pftclass(i) CALL LEAF_interception_VIC (deltim,dewmx,forc_us,forc_vs,chil_p(p),sigf_p(i),lai_p(i),sai_p(i),forc_t,tleaf_p(i),& @@ -1969,7 +1969,7 @@ SUBROUTINE LEAF_interception_pftwrap (ipatch,deltim,dewmx,forc_us,forc_vs,forc_t pg_rain_tmp = pg_rain_tmp + pg_rain*pftfrac(i) pg_snow_tmp = pg_snow_tmp + pg_snow*pftfrac(i) ENDDO - ELSE IF (DEF_Interception_scheme==7) THEN + ELSEIF (DEF_Interception_scheme==7) THEN DO i = ps, pe p = pftclass(i) CALL LEAF_interception_JULES (deltim,dewmx,forc_us,forc_vs,chil_p(p),sigf_p(i),lai_p(i),sai_p(i),forc_t,tleaf_p(i),& @@ -1978,7 +1978,7 @@ SUBROUTINE LEAF_interception_pftwrap (ipatch,deltim,dewmx,forc_us,forc_vs,forc_t pg_rain_tmp = pg_rain_tmp + pg_rain*pftfrac(i) pg_snow_tmp = pg_snow_tmp + pg_snow*pftfrac(i) ENDDO - ELSE IF (DEF_Interception_scheme==8) THEN + ELSEIF (DEF_Interception_scheme==8) THEN DO i = ps, pe p = pftclass(i) CALL LEAF_interception_CoLM202x (deltim,dewmx,forc_us,forc_vs,chil_p(p),sigf_p(i),lai_p(i),sai_p(i),forc_t,tleaf_p(i),& diff --git a/main/MOD_LeafTemperature.F90 b/main/MOD_LeafTemperature.F90 index 44904e89..031133aa 100644 --- a/main/MOD_LeafTemperature.F90 +++ b/main/MOD_LeafTemperature.F90 @@ -69,7 +69,7 @@ SUBROUTINE LeafTemperature ( & ! ground is linked by the equations: ! Ha = Hf + Hg and Ea = Ef + Eg ! -! Original author : Yongjiu Dai, August 15, 2001 +! Original author: Yongjiu Dai, August 15, 2001 ! ! !REVISIONS: ! @@ -112,7 +112,7 @@ SUBROUTINE LeafTemperature ( & USE MOD_UserSpecifiedForcing, only: HEIGHT_mode USE MOD_Vars_TimeInvariants, only: patchclass USE MOD_Const_LC, only: z0mr, displar - USE MOD_PlantHydraulic, only :PlantHydraulicStress_twoleaf, getvegwp_twoleaf + USE MOD_PlantHydraulic, only:PlantHydraulicStress_twoleaf, getvegwp_twoleaf USE MOD_Ozone, only: CalcOzoneStress USE MOD_Qsadv diff --git a/main/MOD_LeafTemperaturePC.F90 b/main/MOD_LeafTemperaturePC.F90 index 7865b1f5..3227c344 100644 --- a/main/MOD_LeafTemperaturePC.F90 +++ b/main/MOD_LeafTemperaturePC.F90 @@ -82,7 +82,7 @@ SUBROUTINE LeafTemperaturePC ( & ! ground is linked by the equations: ! Ha = Hf + Hg and Ea = Ef + Eg ! -! Original author : Hua Yuan and Yongjiu Dai, September, 2017 +! Original author: Hua Yuan and Yongjiu Dai, September, 2017 ! ! ! !REFERENCES: @@ -2025,16 +2025,14 @@ END SUBROUTINE LeafTemperaturePC SUBROUTINE dewfraction (sigf,lai,sai,dewmx,ldew,ldew_rain,ldew_snow,fwet,fdry) !======================================================================= -! Original author: Yongjiu Dai, September 15, 1999 +! Original author: Yongjiu Dai, September 15, 1999 ! -! determine fraction of foliage covered by water and -! fraction of foliage that is dry and transpiring +! determine fraction of foliage covered by water and +! fraction of foliage that is dry and transpiring ! -! -! REVISIONS: -! -! 2024.04.16 Hua Yuan: add option to account for vegetation snow process -! 2018.06 Hua Yuan: remove sigf, to compatible with PFT +! !REVISIONS: +! 2024.04.16, Hua Yuan: add option to account for vegetation snow process +! 2018.06 , Hua Yuan: remove sigf, to compatible with PFT !======================================================================= USE MOD_Precision diff --git a/main/MOD_LightningData.F90 b/main/MOD_LightningData.F90 index 9ae66921..a74518dd 100644 --- a/main/MOD_LightningData.F90 +++ b/main/MOD_LightningData.F90 @@ -4,10 +4,10 @@ MODULE MOD_LightningData !----------------------------------------------------------------------- ! !DESCRIPTION: -! This module read in lightning data for fire subroutine +! This module read in lightning data for fire subroutine ! ! !ORIGINAL: -! Zhang Shupeng, 2022, prepare the original version of the lightning data module. +! Zhang Shupeng, 2022, prepare the original version of the lightning data module. USE MOD_Grid diff --git a/main/MOD_MonthlyinSituCO2MaunaLoa.F90 b/main/MOD_MonthlyinSituCO2MaunaLoa.F90 index b8f8b464..565553bf 100644 --- a/main/MOD_MonthlyinSituCO2MaunaLoa.F90 +++ b/main/MOD_MonthlyinSituCO2MaunaLoa.F90 @@ -42,14 +42,14 @@ MODULE MOD_MonthlyinSituCO2MaunaLoa ! ------------------------------- ! ! !DESCRIPTION: -! Monthly atmospheric CO2 concentrations (ppm) for model input derived from -! in situ air measurements at Mauna Loa, Observatory, Hawaii +! Monthly atmospheric CO2 concentrations (ppm) for model input derived from +! in situ air measurements at Mauna Loa, Observatory, Hawaii ! -! Created by Hua Yuan, 05/2022 +! Created by Hua Yuan, 05/2022 ! -! REVISIONS: -! !---2023.02.23 Zhongwang Wei @ SYSU: Added CO2 data (TODO:details?@zhongwang) in init_monthly_co2_mlo() -! !---2022.12.12 Zhongwang Wei @ SYSU: Added history and SSP CO2 data in init_monthly_co2_mlo() +! !REVISIONS: +! !---2023.02.23 Zhongwang Wei @ SYSU: Added CO2 data (TODO:details?@zhongwang) in init_monthly_co2_mlo() +! !---2022.12.12 Zhongwang Wei @ SYSU: Added history and SSP CO2 data in init_monthly_co2_mlo() ! ------------------------------- USE MOD_Precision diff --git a/main/MOD_NdepData.F90 b/main/MOD_NdepData.F90 index c03d6115..0aca9f5e 100644 --- a/main/MOD_NdepData.F90 +++ b/main/MOD_NdepData.F90 @@ -11,7 +11,7 @@ MODULE MOD_NdepData USE MOD_Grid USE MOD_SpatialMapping - USE MOD_BGC_Vars_TimeVariables, only : ndep + USE MOD_BGC_Vars_TimeVariables, only: ndep USE MOD_BGC_Vars_1DFluxes, only: ndep_to_sminn IMPLICIT NONE @@ -101,7 +101,7 @@ SUBROUTINE update_ndep_data_annually (YY, iswrite) ! !DESCRIPTION: ! Read in the Nitrogen deposition data from CLM5. ! -! !REFERENCE: +! !REFERENCES: ! Galloway, J.N., et al. 2004. Nitrogen cycles: past, present, and future. Biogeochem. 70:153-226. ! ! !ORIGINAL: @@ -109,7 +109,7 @@ SUBROUTINE update_ndep_data_annually (YY, iswrite) ! =========================================================== USE MOD_SPMD_Task - USE MOD_Namelist, only : DEF_USE_PN + USE MOD_Namelist, only: DEF_USE_PN USE MOD_DataType USE MOD_NetCDFBlock USE MOD_LandPatch @@ -164,7 +164,7 @@ SUBROUTINE update_ndep_data_monthly (YY, MM, iswrite) !sf_add ! !DESCRIPTION: ! Read in the Nitrogen deposition data from CLM5. ! -! !REFERENCE: +! !REFERENCES: ! Galloway, J.N., et al. 2004. Nitrogen cycles: past, present, and future. Biogeochem. 70:153-226. ! ! !ORIGINAL: @@ -172,7 +172,7 @@ SUBROUTINE update_ndep_data_monthly (YY, MM, iswrite) !sf_add ! =========================================================== USE MOD_SPMD_Task - USE MOD_Namelist, only : DEF_USE_PN + USE MOD_Namelist, only: DEF_USE_PN USE MOD_DataType USE MOD_NetCDFBlock USE MOD_LandPatch diff --git a/main/MOD_NetSolar.F90 b/main/MOD_NetSolar.F90 index 5e85454e..1ffd8bc1 100644 --- a/main/MOD_NetSolar.F90 +++ b/main/MOD_NetSolar.F90 @@ -20,25 +20,25 @@ MODULE MOD_NetSolar SUBROUTINE netsolar (ipatch,idate,deltim,dlon,patchtype,& forc_sols,forc_soll,forc_solsd,forc_solld,& - alb,ssun,ssha,lai,sai,rho,tau,ssoi,ssno,ssno_lyr,& - parsun,parsha,sabvsun,sabvsha,sabg,sabg_soil,sabg_snow,fsno,sabg_snow_lyr,sr,& - solvd,solvi,solnd,solni,srvd,srvi,srnd,srni,& + alb,ssun,ssha,lai,sai,rho,tau,ssoi,ssno,ssno_lyr,fsno,& + parsun,parsha,sabvsun,sabvsha,sabg,sabg_soil,sabg_snow,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 +! Net solar absorbed by surface ! -! Original author : Yongjiu Dai, 09/15/1999; 09/11/2001 +! Original author: Yongjiu Dai, 09/15/1999; 09/11/2001 ! -! REVISIONS: -! Hua Yuan, 05/2014: added for solar radiation output [vars: so*, sr*] +! !REVISIONS: +! 05/2014, Hua Yuan: added for solar radiation output [vars: so*, sr*] ! -! Hua Yuan, 08/2014: added for local noon calculation +! 08/2014, Hua Yuan: added for local noon calculation ! -! Hua Yuan, 08/2020: added for PFT and PC calculation +! 08/2020, Hua Yuan: added for PFT and PC calculation ! -! Hua Yuan, 12/2022: calculated snow layer absorption by SNICAR model +! 12/2022, Hua Yuan: calculated snow layer absorption by SNICAR model ! !----------------------------------------------------------------------- ! !USES: @@ -87,6 +87,9 @@ SUBROUTINE netsolar (ipatch,idate,deltim,dlon,patchtype,& rho(2,2), &! leaf reflectance (iw=iband, il=life and dead) tau(2,2) ! leaf transmittance (iw=iband, il=life and dead) + real(r8), intent(in) :: & + fsno ! snow fractional cover + real(r8), intent(out) :: & parsun, &! PAR absorbed by sunlit vegetation [W/m2] parsha, &! PAR absorbed by shaded vegetation [W/m2] @@ -96,7 +99,6 @@ SUBROUTINE netsolar (ipatch,idate,deltim,dlon,patchtype,& ! 03/06/2020, yuan: sabg_soil, &! solar absorbed by ground soil [W/m2] sabg_snow, &! solar absorbed by ground snow [W/m2] - fsno, &! snow fractional cover sr, &! total reflected solar radiation (W/m2) solvd, &! incident direct beam vis solar radiation (W/m2) solvi, &! incident diffuse beam vis solar radiation (W/m2) diff --git a/main/MOD_NewSnow.F90 b/main/MOD_NewSnow.F90 index 9050ce1a..bef6d9ed 100644 --- a/main/MOD_NewSnow.F90 +++ b/main/MOD_NewSnow.F90 @@ -21,13 +21,13 @@ SUBROUTINE newsnow (patchtype,maxsnl,deltim,t_grnd,pg_rain,pg_snow,bifall,& wliq_soisno,wice_soisno,fiold,snl,sag,scv,snowdp,fsno,wetwat) !======================================================================= -! add new snow nodes. -! Original author : Yongjiu Dai, 09/15/1999; 08/31/2002, 07/2013, 04/2014 +! add new snow nodes. +! Original author: Yongjiu Dai, 09/15/1999; 08/31/2002, 07/2013, 04/2014 !======================================================================= ! USE MOD_Precision - USE MOD_Namelist, only : DEF_USE_VariablySaturatedFlow - USE MOD_Const_Physical, only : tfrz, cpliq, cpice + USE MOD_Namelist, only: DEF_USE_VariablySaturatedFlow + USE MOD_Const_Physical, only: tfrz, cpliq, cpice IMPLICIT NONE @@ -49,14 +49,14 @@ SUBROUTINE newsnow (patchtype,maxsnl,deltim,t_grnd,pg_rain,pg_snow,bifall,& real(r8), intent(inout) :: t_soisno(maxsnl+1:0) ! soil + snow layer temperature [K] real(r8), intent(inout) :: wliq_soisno(maxsnl+1:0) ! liquid water (kg/m2) real(r8), intent(inout) :: wice_soisno(maxsnl+1:0) ! 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) - real(r8), intent(inout) :: fsno ! fraction of soil covered by snow [-] - - real(r8), intent(inout), optional :: wetwat ! wetland water [mm] + 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) + real(r8), intent(inout) :: fsno ! fraction of soil covered by snow [-] + + real(r8), intent(inout), optional :: wetwat ! wetland water [mm] !-------------------------- Local Variables ---------------------------- diff --git a/main/MOD_NitrifData.F90 b/main/MOD_NitrifData.F90 index a67afd49..f048822f 100644 --- a/main/MOD_NitrifData.F90 +++ b/main/MOD_NitrifData.F90 @@ -11,7 +11,7 @@ MODULE MOD_NitrifData USE MOD_Grid USE MOD_SpatialMapping - USE MOD_BGC_Vars_TimeVariables, only : tCONC_O2_UNSAT, tO2_DECOMP_DEPTH_UNSAT + USE MOD_BGC_Vars_TimeVariables, only: tCONC_O2_UNSAT, tO2_DECOMP_DEPTH_UNSAT IMPLICIT NONE type(grid_type) :: grid_nitrif diff --git a/main/MOD_Ozone.F90 b/main/MOD_Ozone.F90 index d650a1d5..b2fb1040 100644 --- a/main/MOD_Ozone.F90 +++ b/main/MOD_Ozone.F90 @@ -8,13 +8,12 @@ Module MOD_Ozone ! including vcmax response and stomata response. Ozone concentration ! can be either readin through Mod_OzoneData module or set to constant. ! -! !ORIGINAL: +! Original: ! The Community Land Model version 5.0 (CLM5.0) ! -! !REVISION: +! !REVISIONS: ! Xingjie Lu 2022, revised the CLM5 code to be compatible with CoLM code structure. - - +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Const_Physical, only: rgas diff --git a/main/MOD_PhaseChange.F90 b/main/MOD_PhaseChange.F90 index 7465ad14..1282e51e 100644 --- a/main/MOD_PhaseChange.F90 +++ b/main/MOD_PhaseChange.F90 @@ -354,7 +354,7 @@ SUBROUTINE meltf_snicar (patchtype,is_dry_lake,lb,nl_soil,deltim, & USE MOD_Precision USE MOD_SPMD_Task USE MOD_Hydro_SoilFunction - USE MOD_Const_Physical, only : tfrz, hfus, grav + USE MOD_Const_Physical, only: tfrz, hfus, grav USE MOD_Namelist IMPLICIT NONE @@ -652,7 +652,7 @@ SUBROUTINE meltf_urban (lb,nl_soil,deltim, & USE MOD_Precision USE MOD_SPMD_Task - USE MOD_Const_Physical, only : tfrz, hfus + USE MOD_Const_Physical, only: tfrz, hfus IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- diff --git a/main/MOD_PlantHydraulic.F90 b/main/MOD_PlantHydraulic.F90 index ba8014b5..8d82fbb7 100644 --- a/main/MOD_PlantHydraulic.F90 +++ b/main/MOD_PlantHydraulic.F90 @@ -522,7 +522,7 @@ SUBROUTINE getvegwp_twoleaf(x, nvegwcs, nl_soil, z_soi, gb_mol, gs_mol_sun, gs_m ! ! !USES: ! calls getqflx - USE MOD_Const_Physical, only : tfrz + USE MOD_Const_Physical, only: tfrz IMPLICIT NONE ! ! !ARGUMENTS: diff --git a/main/MOD_Qsadv.F90 b/main/MOD_Qsadv.F90 index d96405d8..84012d23 100644 --- a/main/MOD_Qsadv.F90 +++ b/main/MOD_Qsadv.F90 @@ -19,7 +19,7 @@ MODULE MOD_Qsadv SUBROUTINE qsadv(T,p,es,esdT,qs,qsdT) !======================================================================= -! Original author : Yongjiu Dai, September 15, 1999 +! Original author: Yongjiu Dai, September 15, 1999 ! ! Description: computes saturation mixing ratio and change in saturation ! mixing ratio with respect to temperature diff --git a/main/MOD_RainSnowTemp.F90 b/main/MOD_RainSnowTemp.F90 index 061fc61c..06fc3345 100644 --- a/main/MOD_RainSnowTemp.F90 +++ b/main/MOD_RainSnowTemp.F90 @@ -24,12 +24,12 @@ SUBROUTINE rain_snow_temp (patchtype,& prc_rain,prc_snow,prl_rain,prl_snow,t_precip,bifall) !======================================================================= -! define the rate of rainfall and snowfall and precipitation water temp -! Original author : Yongjiu Dai, 09/1999; 08/31/2002, 04/2014, 01/2023 +! define the rate of rainfall and snowfall and precipitation water temp +! Original author: Yongjiu Dai, 09/1999; 08/31/2002, 04/2014, 01/2023 !======================================================================= ! USE MOD_Precision - USE MOD_Const_Physical, only : tfrz + USE MOD_Const_Physical, only: tfrz USE MOD_WetBulb IMPLICIT NONE @@ -82,7 +82,7 @@ SUBROUTINE rain_snow_temp (patchtype,& IF(t_precip - tfrz > 3.0)THEN flfall = 1.0 ! fraction of liquid water within falling precip - ELSE IF (t_precip - tfrz >= -2.0)THEN + ELSEIF (t_precip - tfrz >= -2.0)THEN flfall = max(0.0, 1.0 - 1.0/(1.0+5.00e-5*exp(2.0*(t_precip-tfrz+4.)))) !Figure 5c of Behrangi et al. (2018) !* flfall = max(0.0, 1.0 - 1.0/(1.0+6.99e-5*exp(2.0*(t_precip-tfrz+3.97)))) !Equation 1 of Wang et al. (2019) ELSE @@ -117,7 +117,7 @@ SUBROUTINE rain_snow_temp (patchtype,& IF(t_hydro > 3.0)THEN flfall = 1.0 ! fraction of liquid water within falling precip - ELSE IF ((t_hydro >= -3.0).and.(t_hydro <= 3.0))THEN + ELSEIF ((t_hydro >= -3.0).and.(t_hydro <= 3.0))THEN flfall = max(0.0, 1.0/(1.0+2.50286*0.125006**t_hydro)) ELSE flfall = 0.0 @@ -162,12 +162,12 @@ END SUBROUTINE rain_snow_temp SUBROUTINE NewSnowBulkDensity(forc_t,forc_us,forc_vs,bifall) - !======================================================================= - ! Scheme for bulk density of newly fallen dry snow - !======================================================================= - ! +!======================================================================= +! Scheme for bulk density of newly fallen dry snow +!======================================================================= + USE MOD_Precision - USE MOD_Const_Physical, only : tfrz + USE MOD_Const_Physical, only: tfrz real(r8), intent(in) :: forc_t ! temperature at agcm reference height [kelvin] real(r8), intent(in) :: forc_us ! wind speed in eastward direction [m/s] @@ -182,7 +182,7 @@ SUBROUTINE NewSnowBulkDensity(forc_t,forc_us,forc_vs,bifall) IF (forc_t > tfrz + 2.0) THEN bifall = 50.0 + 1.7*(17.0)**1.5 - ELSE IF (forc_t > tfrz - 15.0) THEN + ELSEIF (forc_t > tfrz - 15.0) THEN bifall = 50.0 + 1.7*(forc_t - tfrz + 15.0)**1.5 ELSE ! Andrew Slater: A temp of about -15C gives the nicest @@ -209,26 +209,24 @@ END SUBROUTINE NewSnowBulkDensity !!============================================== - !----------------------------------------------------------------------------- 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 +!----------------------------------------------------------------------------- +! !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 +! !REVISIONS: +! 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) @@ -257,7 +255,7 @@ SUBROUTINE hydromet_temp(ppa, pta, pqa, pti) ELSE zl = 1000.0 * (2501.0 - (2.361 * pta)) - END IF + ENDIF ! 4. Compute density of dry air [kg m^-3] zrhoda = ppa / (287.04 * (pta + 273.15)) @@ -267,7 +265,7 @@ SUBROUTINE hydromet_temp(ppa, pta, pqa, pti) evsat = 611.0 * EXP(17.27 * pta / (pta + 237.3)) ELSE evsat = 611.0 * EXP(21.87 * pta / (pta + 265.5)) - END IF + ENDIF ! 6. Solve iteratively to get Ti in Harder and Pomeroy (2013) using a Newton-Raphson approach ! Set the first guess to pta @@ -281,7 +279,7 @@ SUBROUTINE hydromet_temp(ppa, pta, pqa, pti) esat = 611.0 * EXP(17.27 * zt / (zt + 237.3)) ELSE esat = 611.0 * EXP(21.87 * zt / (zt + 265.5)) - END IF + ENDIF rho_vast = esat / (461.5 * (zt + 273.15)) ! Saturated water vapour density @@ -293,12 +291,12 @@ SUBROUTINE hydromet_temp(ppa, pta, pqa, pti) ELSE 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 + ENDIF zfdiff = 1 + zd * zl / zlambda * rho_vast_diff zt = ztint - zf / zfdiff - IF (ABS(zt - ztint) .LT. 0.01) EXIT - END DO + IF (ABS(zt - ztint) .lt. 0.01) EXIT + ENDDO pti = zt diff --git a/main/MOD_Runoff.F90 b/main/MOD_Runoff.F90 index b352a607..ee6b1902 100644 --- a/main/MOD_Runoff.F90 +++ b/main/MOD_Runoff.F90 @@ -24,14 +24,14 @@ 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 +! Author : Yongjiu Dai, 07/29/2002, Guoyue Niu, 06/2012 !======================================================================= IMPLICIT NONE diff --git a/main/MOD_SimpleOcean.F90 b/main/MOD_SimpleOcean.F90 index 8d5810ad..85c9ac54 100644 --- a/main/MOD_SimpleOcean.F90 +++ b/main/MOD_SimpleOcean.F90 @@ -28,15 +28,15 @@ SUBROUTINE socean (dosst,deltim,oro,hu,ht,hq,& taux,tauy,fsena,fevpa,lfevpa,fseng,fevpg,tref,qref,& z0m,zol,rib,ustar,qstar,tstar,fm,fh,fq,emis,olrg) !----------------------------------------------------------------------- -! Simple Ocean Model -! 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) +! Simple Ocean Model +! 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) !----------------------------------------------------------------------- USE MOD_Precision - USE MOD_Const_Physical, only : tfrz, hvap, hsub, stefnc, vonkar + USE MOD_Const_Physical, only: tfrz, hvap, hsub, stefnc, vonkar IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- @@ -120,7 +120,7 @@ SUBROUTINE socean (dosst,deltim,oro,hu,ht,hq,& DO j = 1,plsice tssub(j) = tssea ENDDO - ELSE IF(nint(oro).eq.0 .and. tssea.le.tsice) THEN + ELSEIF(nint(oro).eq.0 .and. tssea.le.tsice) THEN oro = 2.0 ! new sea ice formed snowh = snsice scv = snowh*1000. @@ -144,7 +144,7 @@ SUBROUTINE socean (dosst,deltim,oro,hu,ht,hq,& olrg = stefnc*emisw*tssea**4 + (1.-emisw)*frl emis = emisw - ELSE IF(nint(oro).eq.2)THEN ! sea ice + ELSEIF(nint(oro).eq.2)THEN ! sea ice lfevpa = fevpa*hsub ! net surface flux and derivate at current surface temperature @@ -187,14 +187,14 @@ SUBROUTINE seafluxes (oro,hu,ht,hq,& z0m,zol,rib,ustar,qstar,tstar,fm,fh,fq,cgrndl,cgrnds) !======================================================================= -! 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 +! Original author: Yongjiu Dai, 09/15/1999; 08/30/2002 !======================================================================= USE MOD_Precision - USE MOD_Const_Physical, only : cpair,rgas,vonkar,grav + USE MOD_Const_Physical, only: cpair,rgas,vonkar,grav USE MOD_FrictionVelocity USE MOD_Qsadv IMPLICIT NONE @@ -329,7 +329,7 @@ SUBROUTINE seafluxes (oro,hu,ht,hq,& ustar=vonkar*um/log(zldis/z0mg) ENDDO - ELSE IF(nint(oro).eq.2)THEN ! sea ice + ELSEIF(nint(oro).eq.2)THEN ! sea ice z0mg = zsice z0qg = z0mg z0hg = z0mg @@ -419,19 +419,19 @@ END SUBROUTINE seafluxes SUBROUTINE srftsb(isrfty,deltim,fnt,dfntdt,snowh,tsbsf) !----------------------------------------------------------------------- -! Compute surface and subsurface temperatures over sea-ice surfaces. +! Compute surface and subsurface temperatures over sea-ice surfaces. ! -! Sea ice temperatures are specified in 'plsice' layers of fixed -! thickness and thermal properties. The forecast temperatures are -! determined from a backward/IMPLICIT diffusion calculation using -! linearized sensible/latent heat fluxes. The bottom ocean temperature -! is fixed at -2C, allowing heat flux exchange with underlying ocean. +! Sea ice temperatures are specified in 'plsice' layers of fixed +! thickness and thermal properties. The forecast temperatures are +! determined from a backward/IMPLICIT diffusion calculation using +! linearized sensible/latent heat fluxes. The bottom ocean temperature +! is fixed at -2C, allowing heat flux exchange with underlying ocean. ! -! Sub-surface layers are indexed 1 at the surface, increasing downwards -! to plsice. Layers have mid-points and interfaces between layers. +! Sub-surface layers are indexed 1 at the surface, increasing downwards +! to plsice. Layers have mid-points and interfaces between layers. ! -! Temperatures are defined at mid-points, WHILE fluxes between layers -! and the top/bottom media are defined at layer interfaces. +! Temperatures are defined at mid-points, WHILE fluxes between layers +! and the top/bottom media are defined at layer interfaces. ! !----------------------------------------------------------------------- @@ -619,7 +619,7 @@ SUBROUTINE srftsb(isrfty,deltim,fnt,dfntdt,snowh,tsbsf) rhs(1) = diag(1)*tin(1) + fnt*rztop - fbt*rztop + htsrc(1) ! more than one layer: top layer first - ELSE IF (plsice.gt.1) THEN + ELSEIF (plsice.gt.1) THEN crt = cmass(1)*rho(1)*rdtime ztop = z(1) - z(0) diff --git a/main/MOD_SnowLayersCombineDivide.F90 b/main/MOD_SnowLayersCombineDivide.F90 index 2c9a5dfe..48e8ce16 100644 --- a/main/MOD_SnowLayersCombineDivide.F90 +++ b/main/MOD_SnowLayersCombineDivide.F90 @@ -32,35 +32,36 @@ SUBROUTINE snowcompaction (lb,deltim,imelt,fiold,& t_soisno,wliq_soisno,wice_soisno,forc_us,forc_vs,dz_soisno) !======================================================================= -! Original author: Yongjiu Dai, September 15, 1999 -! Revision: Yongjiu Dai, /07/31/2023 +! 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 compaction and the drifting 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). ! !======================================================================= USE MOD_Precision - USE MOD_Const_Physical, only : denice, denh2o, tfrz + USE MOD_Const_Physical, only: denice, denh2o, tfrz IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- - 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) :: 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] - real(r8), intent(in) :: forc_us ! wind speed in eastward direction [m/s] - real(r8), intent(in) :: forc_vs ! wind speed in northward direction [m/s] + 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) :: 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] + real(r8), intent(in) :: forc_us ! wind speed in eastward direction [m/s] + real(r8), intent(in) :: forc_vs ! wind speed in northward direction [m/s] real(r8), intent(inout) :: dz_soisno(lb:0) ! layer thickness [m] @@ -171,18 +172,20 @@ END SUBROUTINE snowcompaction SUBROUTINE winddriftcompaction(bi,forc_wind,dz,zpseudo,mobile,compaction_rate) !======================================================================= -! Original author: Yongjiu Dai, September 15, 1999 -! Revision: Yongjiu Dai, /07/31/2023 +! Original author: Yongjiu Dai, September 15, 1999 ! -! 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. +! 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. +! +! !REVISIONS: Yongjiu Dai, /07/31/2023 ! ! !USES: USE MOD_Precision @@ -245,12 +248,13 @@ SUBROUTINE snowlayerscombine (lb,snl, & z_soisno,dz_soisno,zi_soisno,wliq_soisno,wice_soisno,t_soisno,scv,snowdp) !======================================================================= -! Original author : Yongjiu Dai, September 15, 1999 +! Original author: Yongjiu Dai, September 15, 1999 ! -! checks for elements which are below prescribed minimum for thickness or mass. -! If snow element thickness or mass is less than a prescribed minimum, -! it is combined with neighboring element to be best combine with, -! and executes the combination of mass and energy in clm_combo.f90 +! checks for elements which are below prescribed minimum for thickness +! or mass. If snow element thickness or mass is less than a prescribed +! minimum, it is combined with neighboring element to be best combine +! with, and executes the combination of mass and energy in +! clm_combo.f90 ! !======================================================================= @@ -258,7 +262,7 @@ SUBROUTINE snowlayerscombine (lb,snl, & IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- - integer, intent(in) :: lb ! lower bound of array + integer, intent(in) :: lb ! lower bound of array ! numbering from 1 (bottom) mss (surface) real(r8), intent(inout) :: wice_soisno(lb:1) ! ice lens [kg/m2] @@ -267,9 +271,9 @@ SUBROUTINE snowlayerscombine (lb,snl, & 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] - real(r8), intent(inout) :: snowdp ! snow depth [m] - real(r8), intent(inout) :: scv ! snow mass - water equivalent [kg/m2] - integer, intent(inout) :: snl ! Number of snow + real(r8), intent(inout) :: snowdp ! snow depth [m] + real(r8), intent(inout) :: scv ! snow mass - water equivalent [kg/m2] + integer, intent(inout) :: snl ! Number of snow !-------------------------- Local Variables ---------------------------- real(r8) :: drr ! thickness of the combined [m] @@ -359,7 +363,7 @@ SUBROUTINE snowlayerscombine (lb,snl, & neibor = i + 1 ! If the bottom neighbor is not snow, combine with the top neighbor - ELSE IF(i == 0)THEN + ELSEIF(i == 0)THEN neibor = i - 1 ! If NONE of the above special cases apply, combine with the thinnest neighbor @@ -423,9 +427,9 @@ END SUBROUTINE snowlayerscombine SUBROUTINE snowlayersdivide (lb,snl,z_soisno,dz_soisno,zi_soisno,wliq_soisno,wice_soisno,t_soisno) !======================================================================= -! Original author : Yongjiu Dai, September 15, 1999 +! Original author: Yongjiu Dai, September 15, 1999 ! -! subdivides snow layer when its thickness exceed the prescribed maximum +! subdivides snow layer when its thickness exceed the prescribed maximum !======================================================================= USE MOD_Precision @@ -433,8 +437,8 @@ SUBROUTINE snowlayersdivide (lb,snl,z_soisno,dz_soisno,zi_soisno,wliq_soisno,wic !-------------------------- Dummy Arguments ---------------------------- - integer, intent(in) :: lb ! lower bound of array - integer, intent(inout) :: snl ! Number of snow + integer, intent(in) :: lb ! lower bound of array + 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) ! Node temperature [K] @@ -624,17 +628,17 @@ SUBROUTINE combo ( dz_soisno, wliq_soisno, wice_soisno, t, & dz2, wliq2, wice2, t2 ) !======================================================================= -! Original author: Yongjiu Dai, September 15, 1999 +! Original author: Yongjiu Dai, September 15, 1999 ! -! combines two elements and returns the following combined -! variabless: dz_soisno, t, wliq_soisno, wice_soisno. -! the combined temperature is based on the equation: -! the sum of the enthalpies of the two elements = that of the combined element. +! combines two elements and returns the following combined +! variabless: dz_soisno, t, wliq_soisno, wice_soisno. +! the combined temperature is based on the equation: +! the sum of the enthalpies of the two elements = that of the combined element. ! !======================================================================= USE MOD_Precision - USE MOD_Const_Physical, only : cpice, cpliq, hfus, tfrz + USE MOD_Const_Physical, only: cpice, cpliq, hfus, tfrz IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- @@ -647,7 +651,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 ! node temperature of elment 1 [K] + real(r8), intent(inout) :: t ! node temperature of elment 1 [K] !-------------------------- Local Variables ---------------------------- @@ -670,7 +674,7 @@ SUBROUTINE combo ( dz_soisno, wliq_soisno, wice_soisno, t, & hc = h + h2 IF(hc < 0.)THEN tc = tfrz + hc/(cpice*wicec+cpliq*wliqc) - ELSE IF(hc.le.hfus*wliqc)THEN + ELSEIF(hc.le.hfus*wliqc)THEN tc = tfrz ELSE tc = tfrz + (hc - hfus*wliqc)/(cpice*wicec+cpliq*wliqc) @@ -694,21 +698,21 @@ SUBROUTINE SnowLayersCombine_snicar (lb,snl, & !======================================================================= -! Original author : Yongjiu Dai, September 15, 1999; January 07, 2023 +! Original author: Yongjiu Dai, September 15, 1999; January 07, 2023 ! -! checks for elements which are below prescribed minimum for thickness or mass. -! If snow element thickness or mass is less than a prescribed minimum, -! it is combined with neighboring element to be best combine with, -! and executes the combination of mass and energy in clm_combo.f90 +! checks for elements which are below prescribed minimum for thickness or mass. +! If snow element thickness or mass is less than a prescribed minimum, +! it is combined with neighboring element to be best combine with, +! and executes the combination of mass and energy in clm_combo.f90 ! -! REVISIONS: -! Yongjiu Dai, 01/2023: added Aerosol fluxes from SNICAR model +! !REVISIONS: +! Yongjiu Dai, 01/2023: added Aerosol fluxes from SNICAR model !======================================================================= IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- - integer, intent(in) :: lb ! lower bound of array + integer, intent(in) :: lb ! lower bound of array ! numbering from 1 (bottom) mss (surface) real(r8), intent(inout) :: wice_soisno(lb:1) ! ice lens [kg/m2] @@ -869,7 +873,7 @@ SUBROUTINE SnowLayersCombine_snicar (lb,snl, & neibor = i + 1 ! If the bottom neighbor is not snow, combine with the top neighbor - ELSE IF(i == 0)THEN + ELSEIF(i == 0)THEN neibor = i - 1 ! If NONE of the above special cases apply, combine with the thinnest neighbor @@ -963,20 +967,20 @@ SUBROUTINE SnowLayersDivide_snicar (lb,snl,z_soisno,dz_soisno,zi_soisno,& !======================================================================= -! Original author : Yongjiu Dai, September 15, 1999, January 07, 2023 +! Original author: Yongjiu Dai, September 15, 1999, January 07, 2023 ! -! subdivides snow layer when its thickness exceed the prescribed maximum +! subdivides snow layer when its thickness exceed the prescribed maximum ! -! REVISIONS: -! Yongjiu Dai, 01/2023: added Aerosol fluxes from SNICAR model +! !REVISIONS: +! Yongjiu Dai, 01/2023: added Aerosol fluxes from SNICAR model !======================================================================= IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- - integer, intent(in) :: lb ! lower bound of array - integer, intent(inout) :: snl ! Number of snow + integer, intent(in) :: lb ! lower bound of array + 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) ! Node temperature [K] diff --git a/main/MOD_SnowSnicar.F90 b/main/MOD_SnowSnicar.F90 index 93695663..ec68daf4 100644 --- a/main/MOD_SnowSnicar.F90 +++ b/main/MOD_SnowSnicar.F90 @@ -3,26 +3,26 @@ !------------------------------------------------------------------------- MODULE MOD_SnowSnicar - !----------------------------------------------------------------------- - ! DESCRIPTION: - ! Calculate albedo of snow containing impurities - ! and the evolution of snow effective radius - ! - ! ORIGINAL: - ! 1) The Community Land Model version 5.0 (CLM5.0) - ! 2) Energy Exascale Earth System Model version 2.0 (E3SM v2.0) Land Model (ELM v2.0) - ! - ! REFERENCES: - ! 1) Flanner et al, 2021, SNICAR-ADv3: a community tool for modeling spectral snow albedo. - ! Geosci. Model Dev., 14, 7673–7704, https://doi.org/10.5194/gmd-14-7673-2021 - ! 2) Hao et al., 2023, Improving snow albedo modeling in the E3SM land model (version 2.0) - ! and assessing its impacts on snow and surface fluxes over the Tibetan Plateau. - ! Geosci. Model Dev., 16, 75–94, https://doi.org/10.5194/gmd-16-75-2023 - ! - ! REVISIONS: - ! Yongjiu Dai, and Hua Yuan, December, 2022 : ASSEMBLING and FITTING - ! - ! !USES: +!----------------------------------------------------------------------- +! !DESCRIPTION: +! Calculate albedo of snow containing impurities +! and the evolution of snow effective radius +! +! Original: +! 1) The Community Land Model version 5.0 (CLM5.0) +! 2) Energy Exascale Earth System Model version 2.0 (E3SM v2.0) Land Model (ELM v2.0) +! +! !REFERENCES: +! 1) Flanner et al, 2021, SNICAR-ADv3: a community tool for modeling spectral snow albedo. +! Geosci. Model Dev., 14, 7673–7704, https://doi.org/10.5194/gmd-14-7673-2021 +! 2) Hao et al., 2023, Improving snow albedo modeling in the E3SM land model (version 2.0) +! and assessing its impacts on snow and surface fluxes over the Tibetan Plateau. +! Geosci. Model Dev., 16, 75–94, https://doi.org/10.5194/gmd-16-75-2023 +! +! !REVISIONS: +! Yongjiu Dai, and Hua Yuan, December, 2022 : ASSEMBLING and FITTING +! +! !USES: USE MOD_Precision USE MOD_Vars_Global, only: maxsnl USE MOD_SPMD_Task @@ -231,33 +231,33 @@ MODULE MOD_SnowSnicar CONTAINS - !----------------------------------------------------------------------- SUBROUTINE SNICAR_RT (flg_snw_ice, flg_slr_in, & coszen, snl, h2osno, frac_sno, & h2osno_liq, h2osno_ice, snw_rds, & mss_cnc_aer_in, albsfc, albout, flx_abs) - ! - ! !DESCRIPTION: - ! Determine reflectance of, and vertically-resolved solar absorption in, - ! snow with impurities. - ! - ! Original references on physical models of snow reflectance include: - ! Wiscombe and Warren [1980] and Warren and Wiscombe [1980], - ! Journal of Atmospheric Sciences, 37, - ! - ! The multi-layer solution for multiple-scattering used here is from: - ! Toon et al. [1989], Rapid calculation of radiative heating rates - ! and photodissociation rates in inhomogeneous multiple scattering atmospheres, - ! J. Geophys. Res., 94, D13, 16287-16301 - ! - ! The implementation of the SNICAR model in CLM/CSIM is described in: - ! Flanner, M., C. Zender, J. Randerson, and P. Rasch [2007], - ! Present-day climate forcing and response from black carbon in snow, - ! J. Geophys. Res., 112, D11202, doi: 10.1029/2006JD008003 - ! - ! !USES: - ! - ! !ARGUMENTS: +!----------------------------------------------------------------------- +! !DESCRIPTION: +! Determine reflectance of, and vertically-resolved solar absorption in, +! snow with impurities. +! +! Original references on physical models of snow reflectance include: +! Wiscombe and Warren [1980] and Warren and Wiscombe [1980], +! Journal of Atmospheric Sciences, 37, +! +! The multi-layer solution for multiple-scattering used here is from: +! Toon et al. [1989], Rapid calculation of radiative heating rates +! and photodissociation rates in inhomogeneous multiple scattering atmospheres, +! J. Geophys. Res., 94, D13, 16287-16301 +! +! The implementation of the SNICAR model in CLM/CSIM is described in: +! Flanner, M., C. Zender, J. Randerson, and P. Rasch [2007], +! Present-day climate forcing and response from black carbon in snow, +! J. Geophys. Res., 112, D11202, doi: 10.1029/2006JD008003 +! +! !USES: +! +!----------------------------------------------------------------------- +! !ARGUMENTS: IMPLICIT NONE @@ -1135,32 +1135,33 @@ SUBROUTINE SNICAR_AD_RT (flg_snw_ice, flg_slr_in, & coszen, snl, h2osno, frac_sno, & h2osno_liq, h2osno_ice, snw_rds, & mss_cnc_aer_in, albsfc, albout, flx_abs) - ! - ! !DESCRIPTION: - ! Determine reflectance of, and vertically-resolved solar absorption in, - ! snow with impurities, with updated shortwave scheme - ! - ! The multi-layer solution for multiple-scattering used here is from: - ! Briegleb, P. and Light, B.: A Delta-Eddington mutiple scattering - ! parameterization for solar radiation in the sea ice component of the - ! community climate system model, 2007. - ! - ! The implementation of the SNICAR-AD model in ELM is described in: - ! Dang et al., Inter-comparison and improvement of 2-stream shortwave - ! radiative transfer models for unified treatment of cryospheric surfaces - ! in ESMs, in review, 2019 - ! - ! To USE this subtroutine, set use_snicar_ad = true in ELM - ! - ! IF config_use_snicar_ad = true in MPAS-seaice - ! Snow on land and snow on sea ice will be treated - ! with the same model for their solar radiative properties. - ! - ! The inputs and outputs are the same to SUBROUTINE SNICAR_RT - ! - ! !USES: - ! - ! !ARGUMENTS: +!----------------------------------------------------------------------- +! +! !DESCRIPTION: +! Determine reflectance of, and vertically-resolved solar absorption in, +! snow with impurities, with updated shortwave scheme +! +! The multi-layer solution for multiple-scattering used here is from: +! Briegleb, P. and Light, B.: A Delta-Eddington mutiple scattering +! parameterization for solar radiation in the sea ice component of the +! community climate system model, 2007. +! +! The implementation of the SNICAR-AD model in ELM is described in: +! Dang et al., Inter-comparison and improvement of 2-stream shortwave +! radiative transfer models for unified treatment of cryospheric surfaces +! in ESMs, in review, 2019 +! +! To USE this subtroutine, set use_snicar_ad = true in ELM +! +! IF config_use_snicar_ad = true in MPAS-seaice +! Snow on land and snow on sea ice will be treated +! with the same model for their solar radiative properties. +! +! The inputs and outputs are the same to SUBROUTINE SNICAR_RT +! +! !USES: +!----------------------------------------------------------------------- +! !ARGUMENTS: IMPLICIT NONE @@ -2395,51 +2396,51 @@ END SUBROUTINE SNICAR_AD_RT !----------------------------------------------------------------------- - SUBROUTINE SnowAge_grain( dtime , snl , dz , & - qflx_snow_grnd , qflx_snwcp_ice , qflx_snofrz_lyr , & - do_capsnow , frac_sno , h2osno , & - h2osno_liq , h2osno_ice , & - t_soisno , t_grnd , & - forc_t , snw_rds ) - ! - ! !DESCRIPTION: - ! Updates the snow effective grain size (radius). - ! Contributions to grain size evolution are from: - ! 1. vapor redistribution (dry snow) - ! 2. liquid water redistribution (wet snow) - ! 3. re-freezing of liquid water - ! - ! Vapor redistribution: Method is to retrieve 3 best-bit parameters that - ! depend on snow temperature, temperature gradient, and density, - ! that are derived from the microphysical model described in: - ! Flanner and Zender (2006), Linking snowpack microphysics and albedo - ! evolution, J. Geophys. Res., 111, D12208, doi:10.1029/2005JD006834. - ! The parametric equation has the form: - ! dr/dt = drdt_0*(tau/(dr_fresh+tau))^(1/kappa), WHERE: - ! r is the effective radius, - ! tau and kappa are best-fit parameters, - ! drdt_0 is the initial rate of change of effective radius, and - ! dr_fresh is the difference between the current and fresh snow states - ! (r_current - r_fresh). - ! - ! Liquid water redistribution: Apply the grain growth FUNCTION from: - ! Brun, E. (1989), Investigation of wet-snow metamorphism in respect of - ! liquid-water content, Annals of Glaciology, 13, 22-26. - ! There are two parameters that describe the grain growth rate as - ! a FUNCTION of snow liquid water content (LWC). The "LWC=0" parameter - ! is zeroed here because we are accounting for dry snowing with a - ! different representation - ! - ! Re-freezing of liquid water: Assume that re-frozen liquid water clumps - ! into an arbitrarily large effective grain size (snw_rds_refrz). - ! The phenomenon is observed (Grenfell), but so far unquantified, as far as - ! I am aware. - ! - ! !USES: - ! - ! DAI, Dec. 29, 2022 - !----------------------------------------------------------------------- - ! !ARGUMENTS: + SUBROUTINE SnowAge_grain( dtime , snl , dz ,& + qflx_snow_grnd , qflx_snwcp_ice , qflx_snofrz_lyr ,& + do_capsnow , frac_sno , h2osno ,& + h2osno_liq , h2osno_ice , t_soisno ,& + t_grnd , forc_t , snw_rds ) +!----------------------------------------------------------------------- +! +! !DESCRIPTION: +! Updates the snow effective grain size (radius). +! Contributions to grain size evolution are from: +! 1. vapor redistribution (dry snow) +! 2. liquid water redistribution (wet snow) +! 3. re-freezing of liquid water +! +! Vapor redistribution: Method is to retrieve 3 best-bit parameters that +! depend on snow temperature, temperature gradient, and density, +! that are derived from the microphysical model described in: +! Flanner and Zender (2006), Linking snowpack microphysics and albedo +! evolution, J. Geophys. Res., 111, D12208, doi:10.1029/2005JD006834. +! The parametric equation has the form: +! dr/dt = drdt_0*(tau/(dr_fresh+tau))^(1/kappa), WHERE: +! r is the effective radius, +! tau and kappa are best-fit parameters, +! drdt_0 is the initial rate of change of effective radius, and +! dr_fresh is the difference between the current and fresh snow states +! (r_current - r_fresh). +! +! Liquid water redistribution: Apply the grain growth FUNCTION from: +! Brun, E. (1989), Investigation of wet-snow metamorphism in respect of +! liquid-water content, Annals of Glaciology, 13, 22-26. +! There are two parameters that describe the grain growth rate as +! a FUNCTION of snow liquid water content (LWC). The "LWC=0" parameter +! is zeroed here because we are accounting for dry snowing with a +! different representation +! +! Re-freezing of liquid water: Assume that re-frozen liquid water clumps +! into an arbitrarily large effective grain size (snw_rds_refrz). +! The phenomenon is observed (Grenfell), but so far unquantified, as far as +! I am aware. +! +! !USES: +! +! DAI, Dec. 29, 2022 +!----------------------------------------------------------------------- +! !ARGUMENTS: IMPLICIT NONE @@ -2948,19 +2949,20 @@ END SUBROUTINE SnowAge_init real(r8) FUNCTION FreshSnowRadius (forc_t) - ! - ! !DESCRIPTION: - ! Returns fresh snow grain radius, which is linearly dependent on temperature. - ! This is implemented to remedy an outstanding bias that SNICAR has in initial - ! grain size. See e.g. Sandells et al, 2017 for a discussion (10.5194/tc-11-229-2017). - ! - ! Yang et al. (2017), 10.1016/j.jqsrt.2016.03.033 - ! discusses grain size observations, which suggest a temperature dependence. - ! - ! !REVISION HISTORY: - ! Author: Leo VanKampenhout - ! - ! !USES: +!----------------------------------------------------------------------- +! !DESCRIPTION: +! Returns fresh snow grain radius, which is linearly dependent on temperature. +! This is implemented to remedy an outstanding bias that SNICAR has in initial +! grain size. See e.g. Sandells et al, 2017 for a discussion (10.5194/tc-11-229-2017). +! +! Yang et al. (2017), 10.1016/j.jqsrt.2016.03.033 +! discusses grain size observations, which suggest a temperature dependence. +! +! !REVISION HISTORY: +! Author: Leo VanKampenhout +! +!----------------------------------------------------------------------- +! !USES: USE MOD_Const_Physical, only: tfrz USE MOD_Aerosol, only: fresh_snw_rds_max diff --git a/main/MOD_SoilSnowHydrology.F90 b/main/MOD_SoilSnowHydrology.F90 index 8bbe7afc..c63e2c95 100644 --- a/main/MOD_SoilSnowHydrology.F90 +++ b/main/MOD_SoilSnowHydrology.F90 @@ -60,24 +60,24 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& mss_dst1 ,mss_dst2 ,mss_dst3 ,mss_dst4 ) !======================================================================= -! this is the main SUBROUTINE to execute the calculation of -! hydrological processes +! this is the main SUBROUTINE to execute the calculation of +! hydrological processes ! -! Original author : Yongjiu Dai, /09/1999/, /08/2002/, /04/2014/ +! Original author: Yongjiu Dai, /09/1999/, /08/2002/, /04/2014/ ! -! FLOW DIAGRAM FOR WATER_2014.F90 +! FLOW DIAGRAM FOR WATER_2014.F90 ! -! WATER_2014 ===> snowwater -! SurfaceRunoff_SIMTOP -! soilwater -! SubsurfaceRunoff_SIMTOP +! WATER_2014 ===> snowwater +! SurfaceRunoff_SIMTOP +! soilwater +! SubsurfaceRunoff_SIMTOP ! !======================================================================= USE MOD_Precision - USE MOD_Const_Physical, only : denice, denh2o, tfrz - USE MOD_Vars_TimeInvariants, only : vic_b_infilt, vic_Dsmax, vic_Ds, vic_Ws, vic_c - USE MOD_Vars_1DFluxes, only : fevpg + USE MOD_Const_Physical, only: denice, denh2o, tfrz + USE MOD_Vars_TimeInvariants, only: vic_b_infilt, vic_Dsmax, vic_Ds, vic_Ws, vic_c + USE MOD_Vars_1DFluxes, only: fevpg IMPLICIT NONE @@ -483,22 +483,19 @@ END SUBROUTINE WATER_2014 !----------------------------------------------------------------------- SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& - z_soisno ,dz_soisno ,zi_soisno ,& - bsw ,theta_r ,fsatmax ,fsatdcf ,topostd ,& - BVIC ,& + z_soisno ,dz_soisno ,zi_soisno ,bsw ,theta_r ,& + fsatmax ,fsatdcf ,topostd ,BVIC ,& #ifdef vanGenuchten_Mualem_SOIL_MODEL alpha_vgm ,n_vgm ,L_vgm ,sc_vgm ,fc_vgm ,& #endif porsl ,psi0 ,hksati ,rootr ,rootflux ,& t_soisno ,wliq_soisno ,wice_soisno ,smp ,hk ,& - pg_rain ,sm ,& - etr ,qseva ,qsdew ,qsubl ,qfros ,& - qseva_soil ,qsdew_soil ,qsubl_soil ,qfros_soil ,& - qseva_snow ,qsdew_snow ,qsubl_snow ,qfros_snow ,& - fsno ,& - rsur ,rsur_se ,rsur_ie ,rnof ,& - qinfl ,ssi ,pondmx ,& - wimp ,zwt ,wdsrf ,wa ,wetwat ,& + pg_rain ,sm ,etr ,qseva ,qsdew ,& + qsubl ,qfros ,qseva_soil ,qsdew_soil ,qsubl_soil ,& + qfros_soil ,qseva_snow ,qsdew_snow ,qsubl_snow ,qfros_snow ,& + fsno ,rsur ,rsur_se ,rsur_ie ,rnof ,& + qinfl ,ssi ,pondmx ,wimp ,zwt ,& + wdsrf ,wa ,wetwat ,& #if(defined CaMa_Flood) flddepth ,fldfrc ,qinfl_fld ,& #endif @@ -508,27 +505,27 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& mss_dst1 ,mss_dst2 ,mss_dst3 ,mss_dst4 ) !=================================================================================== -! this is the main SUBROUTINE to execute the calculation of soil water processes +! this is the main SUBROUTINE to execute the calculation of soil water processes ! -! Original author : Yongjiu Dai, /09/1999/, /08/2002/, /04/2014/ +! Original author: Yongjiu Dai, /09/1999/, /08/2002/, /04/2014/ ! -! Modified by Shupeng Zhang /07/2023/ to USE Variably Saturated Flow algorithm -! Reference : -! Dai, Y., Zhang, S., Yuan, H., & Wei, N. (2019). -! Modeling Variably Saturated Flow in Stratified Soils -! With Explicit Tracking of Wetting Front and Water Table Locations. -! Water Resources Research. doi:10.1029/2019wr025368 +! Modified by Shupeng Zhang /07/2023/ to USE Variably Saturated Flow algorithm +! Reference : +! Dai, Y., Zhang, S., Yuan, H., & Wei, N. (2019). +! Modeling Variably Saturated Flow in Stratified Soils +! With Explicit Tracking of Wetting Front and Water Table Locations. +! Water Resources Research. doi:10.1029/2019wr025368 ! !=================================================================================== USE MOD_Precision USE MOD_Hydro_SoilWater - USE MOD_Vars_TimeInvariants, only : wetwatmax - USE MOD_Const_Physical, only : denice, denh2o, tfrz - USE MOD_Vars_TimeInvariants, only : vic_b_infilt, vic_Dsmax, vic_Ds, vic_Ws, vic_c - USE MOD_Vars_1DFluxes, only : fevpg + USE MOD_Vars_TimeInvariants, only: wetwatmax + USE MOD_Const_Physical, only: denice, denh2o, tfrz + USE MOD_Vars_TimeInvariants, only: vic_b_infilt, vic_Dsmax, vic_Ds, vic_Ws, vic_c + USE MOD_Vars_1DFluxes, only: fevpg #ifdef DataAssimilation - USE MOD_DA_GRACE, only : fslp_k + USE MOD_DA_GRACE, only: fslp_k #endif IMPLICIT NONE @@ -1142,20 +1139,20 @@ SUBROUTINE snowwater (lb,deltim,ssi,wimp, & dz_soisno,wice_soisno,wliq_soisno,qout_snowb) !----------------------------------------------------------------------- -! Original author : Yongjiu Dai, /09/1999; /04/2014 +! Original author: Yongjiu Dai, /09/1999; /04/2014 ! -! 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. +! 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. ! !----------------------------------------------------------------------- USE MOD_Precision - USE MOD_Const_Physical, only : denice, denh2o ! physical constant + USE MOD_Const_Physical, only: denice, denh2o ! physical constant IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- @@ -1265,18 +1262,18 @@ SUBROUTINE SnowWater_snicar (lb,deltim,ssi,wimp, & !----------------------------------------------------------------------- -! Original author : Yongjiu Dai, /09/1999, /04/2014, /01/2023/ +! Original author: Yongjiu Dai, /09/1999, /04/2014, /01/2023/ ! -! 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. +! 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 +! !REVISIONS: +! Yongjiu Dai, 01/2023: added Aerosol fluxes from SNICAR model !----------------------------------------------------------------------- IMPLICIT NONE @@ -1703,68 +1700,68 @@ SUBROUTINE soilwater(patchtype,nl_soil,deltim,wimp,smpmin,& zwt,dwat,qcharge) !----------------------------------------------------------------------- -! Original author : Yongjiu Dai, 09/1999, 04/2014, 07/2014 +! Original author: Yongjiu Dai, 09/1999, 04/2014, 07/2014 ! -! some new parameterization are added, which are based on CLM4.5 +! some new parameterization are added, which are based on CLM4.5 ! -! Soil moisture is predicted from a 10-layer model (as with soil -! temperature), in which the vertical soil moisture transport is governed -! by infiltration, runoff, gradient diffusion, gravity, and root -! extraction through canopy transpiration. The net water applied to the -! surface layer is the snowmelt plus precipitation plus the throughfall -! of canopy dew minus surface runoff and evaporation. +! Soil moisture is predicted from a 10-layer model (as with soil +! temperature), in which the vertical soil moisture transport is governed +! by infiltration, runoff, gradient diffusion, gravity, and root +! extraction through canopy transpiration. The net water applied to the +! surface layer is the snowmelt plus precipitation plus the throughfall +! of canopy dew minus surface runoff and evaporation. ! -! The vertical water flow in an unsaturated porous media is described by -! Darcy's law, and the hydraulic conductivity and the soil negative -! potential vary with soil water content and soil texture based on the work -! of Clapp and Hornberger (1978) and Cosby et al. (1984). The equation is -! integrated over the layer thickness, in which the time rate of change in -! water mass must equal the net flow across the bounding interface, plus the -! rate of internal source or sink. The terms of water flow across the layer -! interfaces are linearly expanded by using first-order Taylor expansion. -! The equations result in a tridiagonal system equation. +! The vertical water flow in an unsaturated porous media is described by +! Darcy's law, and the hydraulic conductivity and the soil negative +! potential vary with soil water content and soil texture based on the work +! of Clapp and Hornberger (1978) and Cosby et al. (1984). The equation is +! integrated over the layer thickness, in which the time rate of change in +! water mass must equal the net flow across the bounding interface, plus the +! rate of internal source or sink. The terms of water flow across the layer +! interfaces are linearly expanded by using first-order Taylor expansion. +! The equations result in a tridiagonal system equation. ! -! Note: length units here are all millimeter -! (in temperature SUBROUTINE uses same soil layer -! structure required but lengths are m) +! Note: length units here are all millimeter +! (in temperature SUBROUTINE uses same soil layer +! structure required but lengths are m) ! -! Richards equation: +! Richards equation: ! -! d wat d d psi -! ----- = -- [ k(----- - 1) ] + S -! dt dz dz +! d wat d d psi +! ----- = -- [ k(----- - 1) ] + S +! dt dz dz ! -! where: wat = volume of water per volume of soil (mm**3/mm**3) -! psi = soil matrix potential (mm) -! dt = time step (s) -! z = depth (mm) (positive downward) -! dz = thickness (mm) -! qin = inflow at top (mm h2o /s) -! qout= outflow at bottom (mm h2o /s) -! s = source/sink flux (mm h2o /s) -! k = hydraulic conductivity (mm h2o /s) +! where: wat = volume of water per volume of soil (mm**3/mm**3) +! psi = soil matrix potential (mm) +! dt = time step (s) +! z = depth (mm) (positive downward) +! dz = thickness (mm) +! qin = inflow at top (mm h2o /s) +! qout= outflow at bottom (mm h2o /s) +! s = source/sink flux (mm h2o /s) +! k = hydraulic conductivity (mm h2o /s) ! -! d qin d qin -! qin[n+1] = qin[n] + -------- d wat(j-1) + --------- d wat(j) -! d wat(j-1) d wat(j) -! ==================|================= -! < qin +! d qin d qin +! qin[n+1] = qin[n] + -------- d wat(j-1) + --------- d wat(j) +! d wat(j-1) d wat(j) +! ==================|================= +! < qin ! -! d wat(j)/dt * dz = qin[n+1] - qout[n+1] + S(j) +! d wat(j)/dt * dz = qin[n+1] - qout[n+1] + S(j) ! -! > qout -! ==================|================= -! d qout d qout -! qout[n+1] = qout[n] + --------- d wat(j) + --------- d wat(j+1) -! d wat(j) d wat(j+1) +! > qout +! ==================|================= +! d qout d qout +! qout[n+1] = qout[n] + --------- d wat(j) + --------- d wat(j+1) +! d wat(j) d wat(j+1) ! ! -! Solution: linearize k and psi about d wat and use tridiagonal -! system of equations to solve for d wat, -! where for layer j +! Solution: linearize k and psi about d wat and use tridiagonal +! system of equations to solve for d wat, +! where for layer j ! ! -! r_j = a_j [d wat_j-1] + b_j [d wat_j] + c_j [d wat_j+1] +! r_j = a_j [d wat_j-1] + b_j [d wat_j] + c_j [d wat_j+1] ! !----------------------------------------------------------------------- USE MOD_Precision @@ -2069,7 +2066,7 @@ SUBROUTINE groundwater (nl_soil,deltim,pondmx,& USE MOD_Precision - USE MOD_Const_Physical, only : tfrz + USE MOD_Const_Physical, only: tfrz IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- diff --git a/main/MOD_SoilSurfaceResistance.F90 b/main/MOD_SoilSurfaceResistance.F90 index db9ef205..e0fe35df 100644 --- a/main/MOD_SoilSurfaceResistance.F90 +++ b/main/MOD_SoilSurfaceResistance.F90 @@ -3,10 +3,10 @@ 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 +! Created by Zhuo Liu and Hua Yuan, 06/2023 ! ! !REVISIONS: ! diff --git a/main/MOD_SoilThermalParameters.F90 b/main/MOD_SoilThermalParameters.F90 index 2232627b..2856e6d5 100644 --- a/main/MOD_SoilThermalParameters.F90 +++ b/main/MOD_SoilThermalParameters.F90 @@ -27,24 +27,23 @@ SUBROUTINE hCapacity (patchtype,lb,nl_soil,csol,porsl,wice_soisno,wliq_soisno,sc !----------------------------------------------------------------------- -! Original author : Yongjiu Dai, September 15, 1999 +! 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. -! 08/16/2014, Nan Wei: recalculate the heat capacity of soil layers -! underneath the lake +! !REVISIONS: +! 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 ! !----------------------------------------------------------------------- USE MOD_Precision - USE MOD_Const_Physical, only : cpice,cpliq + USE MOD_Const_Physical, only: cpice,cpliq IMPLICIT NONE integer, intent(in) :: lb ! lower bound of array @@ -80,29 +79,29 @@ SUBROUTINE hConductivity (patchtype,lb,nl_soil,& dkdry,dksatu,porsl,dz_soisno,z_soisno,zi_soisno,t_soisno,wice_soisno,wliq_soisno,tk,tktopsoil) !----------------------------------------------------------------------- -! Original author : Yongjiu Dai, September 15, 1999 +! 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. -! 08/16/2014, Nan Wei: recalculate the heat conductivity of soil layers -! underneath the lake +! Only used in urban model. TODO: merge with subroutine soil_hcap_cond +! +! !REVISIONS: +! 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 !----------------------------------------------------------------------- USE MOD_Precision - USE MOD_Const_Physical, only : denh2o,denice,tfrz,tkwat,tkice,tkair + USE MOD_Const_Physical, only: denh2o,denice,tfrz,tkwat,tkice,tkair IMPLICIT NONE integer, intent(in) :: lb ! lower bound of array @@ -238,14 +237,14 @@ SUBROUTINE soil_hcap_cond(vf_gravels_s,vf_om_s,vf_sand_s,vf_pores_s,& ! 8 optional schemes The default soil thermal conductivity scheme is ! the fourth one (Balland V. and P. A. Arp, 2005) ! -! !Reference: +! !REFERENCES: ! 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/ ! -! !Revisions: +! !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) diff --git a/main/MOD_Thermal.F90 b/main/MOD_Thermal.F90 index 3f72fca4..3105cf01 100644 --- a/main/MOD_Thermal.F90 +++ b/main/MOD_Thermal.F90 @@ -24,19 +24,18 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , vf_gravels ,vf_om ,vf_sand ,wf_gravels ,& wf_sand ,csol ,porsl ,psi0 ,& #ifdef Campbell_SOIL_MODEL - bsw , & + bsw ,& #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL theta_r ,alpha_vgm ,n_vgm ,L_vgm ,& sc_vgm ,fc_vgm , & #endif k_solids ,dksatu ,dksatf ,dkdry ,& - BA_alpha ,BA_beta ,& - lai ,laisun ,laisha ,sai ,& - htop ,hbot ,sqrtdi ,rootfr ,& - rstfacsun_out ,rstfacsha_out ,rss ,gssun_out ,& - gssha_out ,assimsun_out ,etrsun_out ,assimsha_out ,& - etrsha_out ,& + BA_alpha ,BA_beta ,lai ,laisun ,& + laisha ,sai ,htop ,hbot ,& + sqrtdi ,rootfr ,rstfacsun_out ,rstfacsha_out ,& + rss ,gssun_out ,gssha_out ,assimsun_out ,& + etrsun_out ,assimsha_out ,etrsha_out ,& !photosynthesis and plant hydraulic variables effcon ,vmax25 ,hksati ,smp ,hk ,& kmax_sun ,kmax_sha ,kmax_xyl ,kmax_root ,& @@ -64,44 +63,43 @@ SUBROUTINE THERMAL (ipatch ,patchtype,is_dry_lake,lb ,deltim , taux ,tauy ,fsena ,fevpa ,& lfevpa ,fsenl ,fevpl ,etr ,& fseng ,fevpg ,olrg ,fgrnd ,& - rootr ,rootflux ,& - qseva ,qsdew ,qsubl ,qfros ,& - qseva_soil ,qsdew_soil ,qsubl_soil ,qfros_soil ,& - qseva_snow ,qsdew_snow ,qsubl_snow ,qfros_snow ,& - sm ,tref ,qref ,& - trad ,rst ,assim ,respc ,& - errore ,emis ,z0m ,zol ,& - rib ,ustar ,qstar ,tstar ,& - fm ,fh ,fq ,pg_rain ,& - pg_snow ,t_precip ,qintr_rain ,qintr_snow ,& - snofrz ,sabg_snow_lyr ) + rootr ,rootflux ,qseva ,qsdew ,& + qsubl ,qfros ,qseva_soil ,qsdew_soil ,& + qsubl_soil ,qfros_soil ,qseva_snow ,qsdew_snow ,& + qsubl_snow ,qfros_snow ,sm ,tref ,& + qref ,trad ,rst ,assim ,& + respc ,errore ,emis ,z0m ,& + zol ,rib ,ustar ,qstar ,& + tstar ,fm ,fh ,fq ,& + pg_rain ,pg_snow ,t_precip ,qintr_rain ,& + qintr_snow ,snofrz ,sabg_snow_lyr ) !======================================================================= -! 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 +! Original author: Yongjiu Dai, 09/15/1999; 08/30/2002 ! -! FLOW DIAGRAM FOR THERMAL.F90 +! FLOW DIAGRAM FOR THERMAL.F90 ! -! THERMAL ===> qsadv -! GroundFluxes -! eroot |dewfraction -! LeafTemperature | |qsadv -! LeafTemperaturePC | ----------> |moninobukini -! |moninobuk -! |MOD_AssimStomataConductance +! THERMAL ===> qsadv +! GroundFluxes +! eroot |dewfraction +! LeafTemperature | |qsadv +! LeafTemperaturePC | ----------> |moninobukini +! |moninobuk +! |MOD_AssimStomataConductance ! -! GroundTemperature ----------> meltf +! GroundTemperature ----------> meltf ! ! -! REVISIONS: -! 08/2019, Hua Yuan: added initial codes for PFT and Plant Community -! (PC) vegetation classification processes +! !REVISIONS: +! 08/2019, Hua Yuan: added initial codes for PFT and Plant Community +! (PC) vegetation classification processes ! -! 01/2021, Nan Wei: 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 diff --git a/main/MOD_TurbulenceLEddy.F90 b/main/MOD_TurbulenceLEddy.F90 index 6e809dce..624a8d07 100644 --- a/main/MOD_TurbulenceLEddy.F90 +++ b/main/MOD_TurbulenceLEddy.F90 @@ -25,25 +25,25 @@ 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. -! [2] Liu et al., 2022: A surface flux estimation scheme accounting for -! large-eddy effects for land surface modeling. GRL, 49, -! e2022GL101754. +! !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. +! [2] Liu et al., 2022: A surface flux estimation scheme accounting for +! large-eddy effects for land surface modeling. GRL, 49, +! e2022GL101754. ! -! Created by Shaofeng Liu, May 5, 2023 +! Created by Shaofeng Liu, May 5, 2023 ! ! ====================================================================== USE MOD_Precision - USE MOD_Const_Physical, only : vonkar + USE MOD_Const_Physical, only: vonkar IMPLICIT NONE !-------------------------- Dummy Arguments ---------------------------- @@ -107,10 +107,10 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & ! ! End: Shaofeng Liu, 2023.05.05 ! - ELSE IF(zeta < 0.)THEN ! zetam2 <= zeta < 0 + ELSEIF (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 <= zeta <= 1 + ELSEIF (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 @@ -130,9 +130,9 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & ! ! End: Shaofeng Liu, 2023.05.18 ! - ELSE IF(zeta < 0.)THEN ! zetam2 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! zetam2 <= zeta < 0 fm10m = log(zldis/z0m) - psi(1,zeta) + psi(1,z0m/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -145,9 +145,9 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & IF(zeta < -zetat)THEN ! zeta < -1 fh = log(-zetat*obu/z0h)-psi(2,-zetat) & + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fh = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -160,9 +160,9 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & IF(zeta < -zetat)THEN ! zeta < -1 fh2m = log(-zetat*obu/z0h)-psi(2,-zetat) & + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fh2m = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -175,9 +175,9 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & IF(zeta < -zetat)THEN ! zeta < -1 fq = log(-zetat*obu/z0q) - psi(2,-zetat) & + psi(2,z0q/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fq = log(zldis/z0q) - psi(2,zeta) + psi(2,z0q/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -190,9 +190,9 @@ SUBROUTINE moninobuk_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um, hpbl, & IF(zeta < -zetat)THEN ! zeta < -1 fq2m = log(-zetat*obu/z0q)-psi(2,-zetat) & + psi(2,z0q/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF (zeta < 0.) THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.) THEN ! -1 <= zeta < 0 fq2m = log(zldis/z0q)-psi(2,zeta)+psi(2,z0q/obu) - ELSE IF (zeta <= 1.) THEN ! 0 <= zeta <= 1 + ELSEIF (zeta <= 1.) THEN ! 0 <= zeta <= 1 fq2m = log(zldis/z0q)+5.*zeta-5.*z0q/obu ELSE ! 1 < zeta, phi=5+zeta fq2m = log(obu/z0q)+5.-5.*z0q/obu+(5.*log(zeta)+zeta-1.) @@ -209,24 +209,24 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb ! !DESCRIPTION: ! ! -! Original author : Yongjiu Dai, September 15, 1999 +! 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 +! 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. +! !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. ! ====================================================================== USE MOD_Precision - USE MOD_Const_Physical, only : vonkar + USE MOD_Const_Physical, only: vonkar IMPLICIT NONE ! ---------------------- dummy argument -------------------------------- @@ -297,10 +297,10 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb ! ! End: Shaofeng Liu, 2023.05.05 ! - ELSE IF(zeta < 0.)THEN ! zetam2 <= zeta < 0 + ELSEIF (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 <= zeta <= 1 + ELSEIF (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 @@ -322,9 +322,9 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb ! ! End: Shaofeng Liu, 2023.05.18 ! - ELSE IF(zeta < 0.)THEN ! zetam2 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! zetam2 <= zeta < 0 fmtop = log(zldis/z0m) - psi(1,zeta) + psi(1,z0m/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -337,9 +337,9 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb IF(zeta < -zetat)THEN ! zeta < -1 fh = log(-zetat*obu/z0h)-psi(2,-zetat) & + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fh = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -352,9 +352,9 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb IF(zeta < -zetat)THEN ! zeta < -1 fh2m = log(-zetat*obu/z0h)-psi(2,-zetat) & + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fh2m = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -367,9 +367,9 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb IF(zeta < -zetat)THEN ! zeta < -1 fht = log(-zetat*obu/z0h)-psi(2,-zetat) & + psi(2,z0h/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fht = log(zldis/z0h) - psi(2,zeta) + psi(2,z0h/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -382,9 +382,9 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb zetat=0.465 IF(zeta < -zetat)THEN ! zeta < -1 phih = 0.9*vonkar**(1.333)*(-zeta)**(-0.333) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 phih = (1. - 16.*zeta)**(-0.5) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (zeta <= 1.)THEN ! 0 <= zeta <= 1 phih = 1. + 5.*zeta ELSE ! 1 < zeta, phi=5+zeta phih = 5. + zeta @@ -397,9 +397,9 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb IF(zeta < -zetat)THEN ! zeta < -1 fq = log(-zetat*obu/z0q) - psi(2,-zetat) & + psi(2,z0q/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF(zeta < 0.)THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.)THEN ! -1 <= zeta < 0 fq = log(zldis/z0q) - psi(2,zeta) + psi(2,z0q/obu) - ELSE IF(zeta <= 1.)THEN ! 0 <= zeta <= 1 + ELSEIF (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.) @@ -412,9 +412,9 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb IF(zeta < -zetat)THEN ! zeta < -1 fq2m = log(-zetat*obu/z0q)-psi(2,-zetat) & + psi(2,z0q/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF (zeta < 0.) THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.) THEN ! -1 <= zeta < 0 fq2m = log(zldis/z0q)-psi(2,zeta)+psi(2,z0q/obu) - ELSE IF (zeta <= 1.) THEN ! 0 <= zeta <= 1 + ELSEIF (zeta <= 1.) THEN ! 0 <= zeta <= 1 fq2m = log(zldis/z0q)+5.*zeta-5.*z0q/obu ELSE ! 1 < zeta, phi=5+zeta fq2m = log(obu/z0q)+5.-5.*z0q/obu+(5.*log(zeta)+zeta-1.) @@ -427,9 +427,9 @@ SUBROUTINE moninobukm_leddy(hu,ht,hq,displa,z0m,z0h,z0q,obu,um,displat,z0mt, hpb IF(zeta < -zetat)THEN ! zeta < -1 fqt = log(-zetat*obu/z0q)-psi(2,-zetat) & + psi(2,z0q/obu) + 0.8*((zetat)**(-0.333)-(-zeta)**(-0.333)) - ELSE IF (zeta < 0.) THEN ! -1 <= zeta < 0 + ELSEIF (zeta < 0.) THEN ! -1 <= zeta < 0 fqt = log(zldis/z0q)-psi(2,zeta)+psi(2,z0q/obu) - ELSE IF (zeta <= 1.) THEN ! 0 <= zeta <= 1 + ELSEIF (zeta <= 1.) THEN ! 0 <= zeta <= 1 fqt = log(zldis/z0q)+5.*zeta-5.*z0q/obu ELSE ! 1 < zeta, phi=5+zeta fqt = log(obu/z0q)+5.-5.*z0q/obu+(5.*log(zeta)+zeta-1.) diff --git a/main/MOD_UserSpecifiedForcing.F90 b/main/MOD_UserSpecifiedForcing.F90 index 074dabec..d04bd739 100644 --- a/main/MOD_UserSpecifiedForcing.F90 +++ b/main/MOD_UserSpecifiedForcing.F90 @@ -139,7 +139,7 @@ SUBROUTINE init_user_specified_forcing vname (ivar) = DEF_forcing%vname(ivar) ! variable name timelog (ivar) = DEF_forcing%timelog(ivar) ! variable name tintalgo(ivar) = DEF_forcing%tintalgo(ivar) ! interpolation algorithm - END DO + ENDDO IF (DEF_USE_CBL_HEIGHT) THEN fprefix (NVAR) = DEF_forcing%CBL_fprefix vname (NVAR) = DEF_forcing%CBL_vname @@ -860,10 +860,10 @@ SUBROUTINE metpreprocess(grid, forcn) IF (forcn(4)%blk(ib,jb)%val(i,j) < 0.0) forcn(4)%blk(ib,jb)%val(i,j) = 0.0 END select - END DO - END DO - END DO - END IF + ENDDO + ENDDO + ENDDO + ENDIF END SUBROUTINE metpreprocess diff --git a/main/MOD_Vars_1DAccFluxes.F90 b/main/MOD_Vars_1DAccFluxes.F90 index 2783ca84..186cffe6 100644 --- a/main/MOD_Vars_1DAccFluxes.F90 +++ b/main/MOD_Vars_1DAccFluxes.F90 @@ -788,8 +788,8 @@ END SUBROUTINE allocate_acc_fluxes SUBROUTINE deallocate_acc_fluxes () USE MOD_SPMD_Task - USE MOD_LandPatch, only : numpatch - USE MOD_LandUrban, only : numurban + USE MOD_LandPatch, only: numpatch + USE MOD_LandUrban, only: numurban IMPLICIT NONE IF (p_is_worker) THEN @@ -1180,9 +1180,9 @@ END SUBROUTINE deallocate_acc_fluxes SUBROUTINE FLUSH_acc_fluxes () USE MOD_SPMD_Task - USE MOD_LandPatch, only : numpatch - USE MOD_LandUrban, only : numurban - USE MOD_Vars_Global, only : spval + USE MOD_LandPatch, only: numpatch + USE MOD_LandUrban, only: numurban + USE MOD_Vars_Global, only: spval IMPLICIT NONE IF (p_is_worker) THEN @@ -1192,81 +1192,81 @@ SUBROUTINE FLUSH_acc_fluxes () IF (numpatch > 0) THEN ! flush the Fluxes for accumulation - a_us (:) = spval - a_vs (:) = spval - a_t (:) = spval - a_q (:) = spval - a_prc (:) = spval - a_prl (:) = spval - a_pbot (:) = spval - a_frl (:) = spval - a_solarin(:) = spval - a_hpbl (:) = spval - - a_taux (:) = spval - a_tauy (:) = spval - a_fsena (:) = spval - a_lfevpa (:) = spval - a_fevpa (:) = spval - a_fsenl (:) = spval - a_fevpl (:) = spval - a_etr (:) = spval - a_fseng (:) = spval - a_fevpg (:) = spval - a_fgrnd (:) = spval - a_sabvsun (:) = spval - a_sabvsha (:) = spval - a_sabg (:) = spval - a_olrg (:) = spval - a_rnet (:) = spval - a_xerr (:) = spval - a_zerr (:) = spval - a_rsur (:) = spval - a_rsur_se (:) = spval - a_rsur_ie (:) = spval - a_rsub (:) = spval - a_rnof (:) = spval + a_us (:) = spval + a_vs (:) = spval + a_t (:) = spval + a_q (:) = spval + a_prc (:) = spval + a_prl (:) = spval + a_pbot (:) = spval + a_frl (:) = spval + a_solarin (:) = spval + a_hpbl (:) = spval + + a_taux (:) = spval + a_tauy (:) = spval + a_fsena (:) = spval + a_lfevpa (:) = spval + a_fevpa (:) = spval + a_fsenl (:) = spval + a_fevpl (:) = spval + a_etr (:) = spval + a_fseng (:) = spval + a_fevpg (:) = spval + a_fgrnd (:) = spval + a_sabvsun (:) = spval + a_sabvsha (:) = spval + a_sabg (:) = spval + a_olrg (:) = spval + a_rnet (:) = spval + a_xerr (:) = spval + a_zerr (:) = spval + a_rsur (:) = spval + a_rsur_se (:) = spval + a_rsur_ie (:) = spval + a_rsub (:) = spval + a_rnof (:) = spval #ifdef CatchLateralFlow - a_xwsur (:) = spval - a_xwsub (:) = spval + a_xwsur (:) = spval + a_xwsub (:) = spval #endif - a_qintr (:) = spval - a_qinfl (:) = spval - a_qdrip (:) = spval - a_rstfacsun(:) = spval - a_rstfacsha(:) = spval - a_gssun (:) = spval - a_gssha (:) = spval - a_rss (:) = spval - - a_wdsrf (:) = spval - a_zwt (:) = spval - a_wa (:) = spval - a_wat (:) = spval - a_wetwat (:) = spval - a_assim (:) = spval - a_respc (:) = spval - a_assimsun(:) = spval !1 - a_assimsha(:) = spval !1 - a_etrsun (:) = spval !1 - a_etrsha (:) = spval !1 - - a_qcharge (:) = spval - - a_t_grnd (:) = spval - a_tleaf (:) = spval - a_ldew_rain(:) = spval - a_ldew_snow(:) = spval - a_ldew (:) = spval - a_scv (:) = spval - a_snowdp (:) = spval - a_fsno (:) = spval - a_sigf (:) = spval - a_green (:) = spval - a_lai (:) = spval - a_laisun (:) = spval - a_laisha (:) = spval - a_sai (:) = spval + a_qintr (:) = spval + a_qinfl (:) = spval + a_qdrip (:) = spval + a_rstfacsun (:) = spval + a_rstfacsha (:) = spval + a_gssun (:) = spval + a_gssha (:) = spval + a_rss (:) = spval + + a_wdsrf (:) = spval + a_zwt (:) = spval + a_wa (:) = spval + a_wat (:) = spval + a_wetwat (:) = spval + a_assim (:) = spval + a_respc (:) = spval + a_assimsun (:) = spval + a_assimsha (:) = spval + a_etrsun (:) = spval + a_etrsha (:) = spval + + a_qcharge (:) = spval + + a_t_grnd (:) = spval + a_tleaf (:) = spval + a_ldew_rain (:) = spval + a_ldew_snow (:) = spval + a_ldew (:) = spval + a_scv (:) = spval + a_snowdp (:) = spval + a_fsno (:) = spval + a_sigf (:) = spval + a_green (:) = spval + a_lai (:) = spval + a_laisun (:) = spval + a_laisha (:) = spval + a_sai (:) = spval a_alb (:,:,:) = spval @@ -1477,7 +1477,7 @@ SUBROUTINE FLUSH_acc_fluxes () a_deadcrootn_storageCap(:) = spval a_deadcrootn_xferCap (:) = spval #endif - a_ozone (:) = spval + a_ozone (:) = spval a_t_soisno (:,:) = spval a_wliq_soisno (:,:) = spval @@ -1572,12 +1572,12 @@ SUBROUTINE FLUSH_acc_fluxes () END SUBROUTINE FLUSH_acc_fluxes SUBROUTINE accumulate_fluxes - ! ---------------------------------------------------------------------- - ! perfrom the grid average mapping: average a subgrid input 1d vector - ! of length numpatch to a output 2d array of length [ghist%xcnt,ghist%ycnt] - ! - ! Created by Yongjiu Dai, 03/2014 - !--------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! perfrom the grid average mapping: average a subgrid input 1d vector +! of length numpatch to a output 2d array of length [ghist%xcnt,ghist%ycnt] +! +! Created by Yongjiu Dai, 03/2014 +!--------------------------------------------------------------------- USE MOD_Precision USE MOD_SPMD_Task @@ -1914,10 +1914,10 @@ SUBROUTINE accumulate_fluxes CALL acc1d (grainc_to_seed , a_grainc_to_seed ) CALL acc1d (fert_to_sminn , a_fert_to_sminn ) - ! CALL acc1d (irrig_rate , a_irrig_rate ) - ! CALL acc1d (deficit_irrig , a_deficit_irrig ) - ! CALL acc1d (sum_irrig , a_sum_irrig ) - ! CALL acc1d (sum_irrig_count , a_sum_irrig_count ) + !CALL acc1d (irrig_rate , a_irrig_rate ) + !CALL acc1d (deficit_irrig , a_deficit_irrig ) + !CALL acc1d (sum_irrig , a_sum_irrig ) + !CALL acc1d (sum_irrig_count , a_sum_irrig_count ) CALL acc1d (irrig_rate , a_irrig_rate ) CALL acc1d (deficit_irrig , a_deficit_irrig ) a_sum_irrig = sum_irrig diff --git a/main/MOD_Vars_1DPFTFluxes.F90 b/main/MOD_Vars_1DPFTFluxes.F90 index f7048e95..0f4cdba5 100644 --- a/main/MOD_Vars_1DPFTFluxes.F90 +++ b/main/MOD_Vars_1DPFTFluxes.F90 @@ -5,9 +5,9 @@ MODULE MOD_Vars_1DPFTFluxes ! ----------------------------------------------------------------- ! !DESCRIPTION: -! Define PFT flux variables +! Define PFT flux variables ! -! Created by Hua Yuan, 08/2019 +! Created by Hua Yuan, 08/2019 ! ----------------------------------------------------------------- USE MOD_Precision diff --git a/main/MOD_Vars_Global.F90 b/main/MOD_Vars_Global.F90 index 8e10bdc2..ec14bb45 100644 --- a/main/MOD_Vars_Global.F90 +++ b/main/MOD_Vars_Global.F90 @@ -4,11 +4,11 @@ MODULE MOD_Vars_Global !----------------------------------------------------------------------- ! ! !DESCRIPTION: -! Define some global variables +! Define some global variables ! -! REVISIONS: -! Hua Yuan, 08/2019: initial version partly adapted from CoLM2014 -! TODO ... +! !REVISIONS: +! Hua Yuan, 08/2019: initial version partly adapted from CoLM2014 +! TODO ... ! ! !USES: USE MOD_Precision diff --git a/main/MOD_Vars_TimeInvariants.F90 b/main/MOD_Vars_TimeInvariants.F90 index 8c6fed1c..20b80b88 100644 --- a/main/MOD_Vars_TimeInvariants.F90 +++ b/main/MOD_Vars_TimeInvariants.F90 @@ -8,9 +8,9 @@ MODULE MOD_Vars_PFTimeInvariants ! ----------------------------------------------------------------- ! !DESCRIPTION: -! Define PFT time invariables +! Define PFT time invariables ! -! Added by Hua Yuan, 08/2019 +! Added by Hua Yuan, 08/2019 ! ----------------------------------------------------------------- USE MOD_Precision @@ -50,8 +50,8 @@ SUBROUTINE allocate_PFTimeInvariants ! -------------------------------------------------------------------- USE MOD_SPMD_Task - USE MOD_LandPatch, only : numpatch - USE MOD_LandPFT, only : numpft + USE MOD_LandPatch, only: numpatch + USE MOD_LandPFT, only: numpft USE MOD_Precision IMPLICIT NONE @@ -568,7 +568,7 @@ SUBROUTINE WRITE_TimeInvariants (lc_year, casename, dir_restart) ! Original version: Yongjiu Dai, September 15, 1999, 03/2014 !======================================================================= - USE MOD_Namelist, only : DEF_REST_CompressLevel, DEF_USE_BEDROCK + USE MOD_Namelist, only: DEF_REST_CompressLevel, DEF_USE_BEDROCK USE MOD_SPMD_Task USE MOD_NetCDFSerial USE MOD_NetCDFVector @@ -726,7 +726,7 @@ SUBROUTINE WRITE_TimeInvariants (lc_year, casename, dir_restart) 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 + ENDIF #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) @@ -866,7 +866,7 @@ SUBROUTINE check_TimeInvariants () USE MOD_SPMD_Task USE MOD_RangeCheck - USE MOD_Namelist, only : DEF_USE_BEDROCK, DEF_USE_Forcing_Downscaling + USE MOD_Namelist, only: DEF_USE_BEDROCK, DEF_USE_Forcing_Downscaling IMPLICIT NONE @@ -940,14 +940,14 @@ SUBROUTINE check_TimeInvariants () CALL check_vector_data ('sf_lut [-] ', sf_lut_patches ) ! shadow mask #else 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 e40f5c89..33e95455 100644 --- a/main/MOD_Vars_TimeVariables.F90 +++ b/main/MOD_Vars_TimeVariables.F90 @@ -8,9 +8,9 @@ MODULE MOD_Vars_PFTimeVariables ! ----------------------------------------------------------------- ! !DESCRIPTION: -! Define PFT time variables +! Define PFT time variables ! -! Added by Hua Yuan, 08/2019 +! Added by Hua Yuan, 08/2019 ! ----------------------------------------------------------------- USE MOD_Precision @@ -197,8 +197,8 @@ END SUBROUTINE READ_PFTimeVariables SUBROUTINE WRITE_PFTimeVariables (file_restart) - USE MOD_Namelist, only : DEF_REST_CompressLevel, DEF_USE_PLANTHYDRAULICS, DEF_USE_OZONESTRESS, & - DEF_USE_IRRIGATION + USE MOD_Namelist, only: DEF_REST_CompressLevel, DEF_USE_PLANTHYDRAULICS, DEF_USE_OZONESTRESS, & + DEF_USE_IRRIGATION USE MOD_LandPFT USE MOD_NetCDFVector USE MOD_Vars_Global @@ -321,7 +321,7 @@ END SUBROUTINE deallocate_PFTimeVariables SUBROUTINE check_PFTimeVariables USE MOD_RangeCheck - USE MOD_Namelist, only : DEF_USE_PLANTHYDRAULICS, DEF_USE_OZONESTRESS, DEF_USE_IRRIGATION + USE MOD_Namelist, only: DEF_USE_PLANTHYDRAULICS, DEF_USE_OZONESTRESS, DEF_USE_IRRIGATION IMPLICIT NONE @@ -899,12 +899,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, SITE_landtype + USE MOD_Namelist, only: DEF_REST_CompressLevel, DEF_USE_PLANTHYDRAULICS, DEF_USE_OZONESTRESS, & + 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_Vars_TimeInvariants, only: dz_lake USE MOD_Const_LC, only: patchtypes IMPLICIT NONE @@ -1101,7 +1101,7 @@ SUBROUTINE READ_TimeVariables (idate, lc_year, site, dir_restart) #endif USE MOD_LandPatch USE MOD_Vars_Global - USE MOD_Vars_TimeInvariants, only : dz_lake + USE MOD_Vars_TimeInvariants, only: dz_lake USE MOD_Const_LC, only: patchtypes IMPLICIT NONE @@ -1282,7 +1282,7 @@ SUBROUTINE check_TimeVariables () USE MOD_RangeCheck USE MOD_Namelist, only: DEF_USE_PLANTHYDRAULICS, DEF_USE_OZONESTRESS, DEF_USE_IRRIGATION, & DEF_USE_SNICAR, DEF_USE_Dynamic_Lake - USE MOD_Vars_TimeInvariants, only : dz_lake + USE MOD_Vars_TimeInvariants, only: dz_lake IMPLICIT NONE diff --git a/main/MOD_WetBulb.F90 b/main/MOD_WetBulb.F90 index 36ebf0a3..ca93a950 100644 --- a/main/MOD_WetBulb.F90 +++ b/main/MOD_WetBulb.F90 @@ -19,13 +19,13 @@ MODULE MOD_WetBulb SUBROUTINE wetbulb(t,p,q,twc) !======================================================================= -! Wet-bulb temperature +! Wet-bulb temperature ! -! Yongjiu Dai, 07/2013 +! Yongjiu Dai, 07/2013 !======================================================================= USE MOD_Precision - USE MOD_Const_Physical, only : tfrz, hvap, cpair + USE MOD_Const_Physical, only: tfrz, hvap, cpair USE MOD_Qsadv IMPLICIT NONE diff --git a/main/URBAN/CoLMMAIN_Urban.F90 b/main/URBAN/CoLMMAIN_Urban.F90 index 81e0ccb6..fbfd0cec 100644 --- a/main/URBAN/CoLMMAIN_Urban.F90 +++ b/main/URBAN/CoLMMAIN_Urban.F90 @@ -68,8 +68,8 @@ SUBROUTINE CoLMMAIN_Urban ( & fgper ,em_roof ,em_wall ,em_gimp ,& em_gper ,cv_roof ,cv_wall ,cv_gimp ,& tk_roof ,tk_wall ,tk_gimp ,z_roof ,& - z_wall ,dz_roof ,dz_wall ,& - lakedepth ,dz_lake ,topostd ,BVIC ,& + z_wall ,dz_roof ,dz_wall ,lakedepth ,& + dz_lake ,topostd ,BVIC ,& ! LUCY model input parameters fix_holiday ,week_holiday ,hum_prof ,pop_den ,& @@ -84,8 +84,7 @@ SUBROUTINE CoLMMAIN_Urban ( & sc_vgm ,fc_vgm ,& #endif hksati ,csol ,k_solids ,dksatu ,& - dksatf ,dkdry ,& - BA_alpha ,BA_beta ,& + dksatf ,dkdry ,BA_alpha ,BA_beta ,& alb_roof ,alb_wall ,alb_gimp ,alb_gper ,& ! vegetation information @@ -167,9 +166,9 @@ SUBROUTINE CoLMMAIN_Urban ( & ! TUNABLE model constants zlnd ,zsno ,csoilc ,dewmx ,& - capr ,cnfac ,ssi ,& - wimp ,pondmx ,smpmax ,smpmin ,& - trsmx0 ,tcrit ,& + capr ,cnfac ,ssi ,wimp ,& + pondmx ,smpmax ,smpmin ,trsmx0 ,& + tcrit ,& ! additional variables required by coupling with WRF model emis ,z0m ,zol ,rib ,& @@ -1058,9 +1057,9 @@ SUBROUTINE CoLMMAIN_Urban ( & pg_rain ,pgper_rain ,pgimp_rain ,pg_snow ,& pg_rain_lake ,pg_snow_lake ,& froof ,fgper ,flake ,bsw ,& - porsl ,psi0 ,hksati ,& - pondmx ,ssi ,wimp ,smpmin ,& - theta_r ,fsatmax,fsatdcf ,topostd ,BVIC ,& + porsl ,psi0 ,hksati ,pondmx ,& + ssi ,wimp ,smpmin ,theta_r ,& + fsatmax ,fsatdcf ,topostd ,BVIC ,& rootr,rootflux ,etrgper ,fseng ,fgrnd ,& t_gpersno(lbp:) ,t_lakesno(:) ,t_lake ,dz_lake ,& z_gpersno(lbp:) ,z_lakesno(:) ,zi_gpersno(lbp-1:) ,zi_lakesno(:) ,& diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 696e033f..25d25723 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -2522,16 +2522,15 @@ END SUBROUTINE UrbanVegFlux SUBROUTINE dewfraction (sigf,lai,sai,dewmx,ldew,ldew_rain,ldew_snow,fwet,fdry) !======================================================================= -! Original author: Yongjiu Dai, September 15, 1999 +! Original author: Yongjiu Dai, September 15, 1999 ! -! determine fraction of foliage covered by water and -! fraction of foliage that is dry and transpiring +! determine fraction of foliage covered by water and +! fraction of foliage that is dry and transpiring ! +! !REVISIONS: ! -! REVISIONS: -! -! 2024.04.16 Hua Yuan: add option to account for vegetation snow process -! 2018.06 Hua Yuan: remove sigf, to compatible with PFT +! 2024.04.16, Hua Yuan: add option to account for vegetation snow process +! 2018.06 , Hua Yuan: remove sigf, to compatible with PFT !======================================================================= USE MOD_Precision diff --git a/main/URBAN/MOD_Urban_GroundFlux.F90 b/main/URBAN/MOD_Urban_GroundFlux.F90 index b2d34953..53a5cba0 100644 --- a/main/URBAN/MOD_Urban_GroundFlux.F90 +++ b/main/URBAN/MOD_Urban_GroundFlux.F90 @@ -17,6 +17,7 @@ SUBROUTINE UrbanGroundFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & z0m, z0hg, zol, ustar, qstar, tstar, fm, fh, fq) !======================================================================= +! ! !DESCRIPTION: ! This is the main subroutine to execute the calculation ! of bare ground fluxes @@ -24,7 +25,6 @@ SUBROUTINE UrbanGroundFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & ! Created by Hua Yuan, 09/2021 ! ! !REVISIONS: -! ! 07/2022, Hua Yuan: Urban 2m T/q -> above bare ground 2m. ! !======================================================================= diff --git a/main/URBAN/MOD_Urban_Hydrology.F90 b/main/URBAN/MOD_Urban_Hydrology.F90 index 8f224560..55e478d8 100644 --- a/main/URBAN/MOD_Urban_Hydrology.F90 +++ b/main/URBAN/MOD_Urban_Hydrology.F90 @@ -46,10 +46,9 @@ SUBROUTINE UrbanHydrology ( & pg_rain_lake ,pg_snow_lake ,& ! surface parameters or status froof ,fgper ,flake ,bsw ,& - porsl ,psi0 ,hksati ,& - pondmx ,ssi ,wimp ,smpmin ,& - theta_r ,fsatmax ,fsatdcf ,topostd ,& - BVIC ,& + porsl ,psi0 ,hksati ,pondmx ,& + ssi ,wimp ,smpmin ,theta_r ,& + fsatmax ,fsatdcf ,topostd ,BVIC ,& rootr,rootflux ,etr ,fseng ,fgrnd ,& t_gpersno ,t_lakesno ,t_lake ,dz_lake ,& z_gpersno ,z_lakesno ,zi_gpersno ,zi_lakesno ,& @@ -271,9 +270,8 @@ SUBROUTINE UrbanHydrology ( & qseva_gper ,qsdew_gper ,qsubl_gper ,qfros_gper ,& qseva_gper ,qsdew_gper ,qsubl_gper ,qfros_gper ,& 0. ,& ! fsno, not active - rsur_gper ,rnof_gper ,qinfl ,& - pondmx ,ssi ,wimp ,smpmin ,& - zwt ,wa ,qcharge ,& + rsur_gper ,rnof_gper ,qinfl ,pondmx ,ssi ,& + wimp ,smpmin ,zwt ,wa ,qcharge ,& #if(defined CaMa_Flood) flddepth ,fldfrc ,qinfl_fld ,& #endif diff --git a/main/URBAN/MOD_Urban_ImperviousTemperature.F90 b/main/URBAN/MOD_Urban_ImperviousTemperature.F90 index 8bf54bd0..c3515a89 100644 --- a/main/URBAN/MOD_Urban_ImperviousTemperature.F90 +++ b/main/URBAN/MOD_Urban_ImperviousTemperature.F90 @@ -37,27 +37,27 @@ SUBROUTINE UrbanImperviousTem (patchtype,lb,deltim, & imelt,sm,xmf,fact) !======================================================================= -! Snow and impervious road 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 road soil is computed from -! 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. +! Snow and impervious road 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 road soil is computed from +! 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. ! -! Phase change (see MOD_PhaseChange.F90) +! Phase change (see MOD_PhaseChange.F90) ! -! Original author : Yongjiu Dai, 09/15/1999; 08/30/2002; 05/2020 +! Original author: Yongjiu Dai, 09/15/1999; 08/30/2002; 05/2020 !======================================================================= USE MOD_Precision diff --git a/main/URBAN/MOD_Urban_LAIReadin.F90 b/main/URBAN/MOD_Urban_LAIReadin.F90 index 015849e9..11ca8b7c 100644 --- a/main/URBAN/MOD_Urban_LAIReadin.F90 +++ b/main/URBAN/MOD_Urban_LAIReadin.F90 @@ -15,14 +15,12 @@ SUBROUTINE UrbanLAI_readin (year, time, dir_landdata) !----------------------------------------------------------------------- ! ! !DESCRIPTION: -! ! Read in urban LAI, SAI and urban tree cover data. ! ! Create by Hua Yuan, 11/2021 ! ! ! !REVISIONS: -! ! 08/2023, Wenzong Dong: add codes to read urban tree LAI. ! !----------------------------------------------------------------------- diff --git a/main/URBAN/MOD_Urban_LUCY.F90 b/main/URBAN/MOD_Urban_LUCY.F90 index 9d2003f4..4d4c6238 100644 --- a/main/URBAN/MOD_Urban_LUCY.F90 +++ b/main/URBAN/MOD_Urban_LUCY.F90 @@ -5,8 +5,7 @@ MODULE MOD_Urban_LUCY ! !DESCRIPTION: ! Anthropogenic model to calculate anthropogenic heat flux for the rest ! -! !ORIGINAL: -! Wenzong Dong, May, 2022 +! Original: Wenzong Dong, May, 2022 ! ! ----------------------------------------------------------------------- ! !USE @@ -22,11 +21,11 @@ MODULE MOD_Urban_LUCY CONTAINS -! ----------------------------------------------------------------------- SUBROUTINE LUCY( idate , deltim , patchlonr, fix_holiday, & week_holiday, hum_prof, wdh_prof , weh_prof , pop_den, & vehicle , Fahe , vehc , meta ) +! ----------------------------------------------------------------------- ! !DESCRIPTION: ! Anthropogenic heat fluxes other than building heat were calculated ! diff --git a/main/URBAN/MOD_Urban_PerviousTemperature.F90 b/main/URBAN/MOD_Urban_PerviousTemperature.F90 index 89e3b4e0..d73345f1 100644 --- a/main/URBAN/MOD_Urban_PerviousTemperature.F90 +++ b/main/URBAN/MOD_Urban_PerviousTemperature.F90 @@ -43,27 +43,27 @@ SUBROUTINE UrbanPerviousTem (patchtype,lb,deltim, & imelt,sm,xmf,fact) !======================================================================= -! Snow and pervious road 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 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). -! 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. +! Snow and pervious road 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 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). +! 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. ! -! Phase change (see MOD_PhaseChange.F90) +! Phase change (see MOD_PhaseChange.F90) ! -! Original author : Yongjiu Dai, 09/15/1999; 08/30/2002; 05/2020 +! Original author: Yongjiu Dai, 09/15/1999; 08/30/2002; 05/2020 !======================================================================= USE MOD_Precision diff --git a/main/URBAN/MOD_Urban_RoofTemperature.F90 b/main/URBAN/MOD_Urban_RoofTemperature.F90 index 1d123021..51469814 100644 --- a/main/URBAN/MOD_Urban_RoofTemperature.F90 +++ b/main/URBAN/MOD_Urban_RoofTemperature.F90 @@ -34,29 +34,29 @@ SUBROUTINE UrbanRoofTem (lb,deltim,capr,cnfac,& imelt_roof,sm_roof,xmf_roof,fact,tkdz_roof) !======================================================================= -! Snow and roof 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 roof is given by LOOK-UP table, and of -! snow is from the formulation used in SNTHERM (Jordan 1991). -! o Boundary conditions: -! F = Rnet - Hg - LEg (top), -! For urban sunwall, shadewall, and roof 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_roof_inner (at the roof inner surface). -! o Roof / snow temperature is predicted from heat conduction -! in N roof 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. +! Snow and roof 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 roof is given by LOOK-UP table, and of +! snow is from the formulation used in SNTHERM (Jordan 1991). +! o Boundary conditions: +! F = Rnet - Hg - LEg (top), +! For urban sunwall, shadewall, and roof 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_roof_inner (at the roof inner surface). +! o Roof / snow temperature is predicted from heat conduction +! in N roof 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) +! Phase change (see MOD_PhaseChange.F90) ! -! Original author : Yongjiu Dai, 05/2020 +! Original author: Yongjiu Dai, 05/2020 !======================================================================= USE MOD_Precision diff --git a/main/URBAN/MOD_Urban_Shortwave.F90 b/main/URBAN/MOD_Urban_Shortwave.F90 index 0a3946b2..0b7d9852 100644 --- a/main/URBAN/MOD_Urban_Shortwave.F90 +++ b/main/URBAN/MOD_Urban_Shortwave.F90 @@ -42,6 +42,7 @@ SUBROUTINE UrbanOnlyShortwave ( theta, HL, fb, fgper, H, & ! |++++++| impervious/pervious ground ! __________|++++++|____________________________________ ! +! ! !DESCRIPTION: ! ! Calculate the ground shadow area, the area of the sunny and shady @@ -52,7 +53,6 @@ SUBROUTINE UrbanOnlyShortwave ( theta, HL, fb, fgper, H, & ! the radiation transfer balance equation for both incident direct ! and diffuse radiation cases for solving. ! -! ! Created by Hua Yuan, 09/2021 ! ! !REVISIONS: @@ -280,6 +280,7 @@ SUBROUTINE UrbanVegShortwave ( theta, HL, fb, fgper, H, & ! |++++++| impervious/pervious ground ! __________|++++++|____________________________________ ! +! ! !DESCRIPTION: ! ! The process of shortwave radiation transfer in a city considering diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index fcfc90ef..89a238b8 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -125,7 +125,7 @@ SUBROUTINE UrbanTHERMAL ( & USE MOD_Urban_LUCY, only: LUCY USE MOD_Eroot, only: eroot #ifdef vanGenuchten_Mualem_SOIL_MODEL - USE MOD_Hydro_SoilFunction, only : soil_psi_from_vliq + USE MOD_Hydro_SoilFunction, only: soil_psi_from_vliq #endif IMPLICIT NONE diff --git a/main/URBAN/MOD_Urban_Vars_1DFluxes.F90 b/main/URBAN/MOD_Urban_Vars_1DFluxes.F90 index 4f32d360..1774342d 100644 --- a/main/URBAN/MOD_Urban_Vars_1DFluxes.F90 +++ b/main/URBAN/MOD_Urban_Vars_1DFluxes.F90 @@ -57,7 +57,7 @@ SUBROUTINE allocate_1D_UrbanFluxes USE MOD_Precision USE MOD_SPMD_Task USE MOD_LandUrban - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE IF (p_is_worker) THEN diff --git a/main/URBAN/MOD_Urban_Vars_TimeInvariants.F90 b/main/URBAN/MOD_Urban_Vars_TimeInvariants.F90 index 5f6d4abd..f63ba795 100644 --- a/main/URBAN/MOD_Urban_Vars_TimeInvariants.F90 +++ b/main/URBAN/MOD_Urban_Vars_TimeInvariants.F90 @@ -160,25 +160,25 @@ SUBROUTINE READ_UrbanTimeInvariants (file_restart) CALL ncio_read_vector (file_restart, 'PCT_Water' , landurban, flake ) ! LUCY paras !TODO: variable name can be optimized - CALL ncio_read_vector (file_restart, 'POP_DEN' , landurban, pop_den ) - CALL ncio_read_vector (file_restart, 'VEHC_NUM' , 3 , landurban, vehicle ) - CALL ncio_read_vector (file_restart, 'week_holiday', 7 , landurban, week_holiday) - CALL ncio_read_vector (file_restart, 'weekendhour' , 24 , landurban, weh_prof ) - CALL ncio_read_vector (file_restart, 'weekdayhour' , 24 , landurban, wdh_prof ) - CALL ncio_read_vector (file_restart, 'metabolism' , 24 , landurban, hum_prof ) - CALL ncio_read_vector (file_restart, 'holiday' , 365, landurban, fix_holiday ) + CALL ncio_read_vector (file_restart, 'POP_DEN' , landurban, pop_den ) + CALL ncio_read_vector (file_restart, 'VEHC_NUM' , 3 , landurban, vehicle ) + CALL ncio_read_vector (file_restart, 'week_holiday', 7 , landurban, week_holiday ) + CALL ncio_read_vector (file_restart, 'weekendhour' , 24 , landurban, weh_prof ) + CALL ncio_read_vector (file_restart, 'weekdayhour' , 24 , landurban, wdh_prof ) + CALL ncio_read_vector (file_restart, 'metabolism' , 24 , landurban, hum_prof ) + CALL ncio_read_vector (file_restart, 'holiday' , 365, landurban, fix_holiday ) ! morphological paras - CALL ncio_read_vector (file_restart, 'WT_ROOF' , landurban, froof ) - CALL ncio_read_vector (file_restart, 'HT_ROOF' , landurban, hroof ) - CALL ncio_read_vector (file_restart, 'BUILDING_HLR' , landurban, hlr ) - CALL ncio_read_vector (file_restart, 'WTROAD_PERV' , landurban, fgper ) - CALL ncio_read_vector (file_restart, 'EM_ROOF' , landurban, em_roof ) - CALL ncio_read_vector (file_restart, 'EM_WALL' , landurban, em_wall ) - CALL ncio_read_vector (file_restart, 'EM_IMPROAD' , landurban, em_gimp ) - CALL ncio_read_vector (file_restart, 'EM_PERROAD' , landurban, em_gper ) - CALL ncio_read_vector (file_restart, 'T_BUILDING_MIN', landurban, t_roommin) - CALL ncio_read_vector (file_restart, 'T_BUILDING_MAX', landurban, t_roommax) + CALL ncio_read_vector (file_restart, 'WT_ROOF' , landurban, froof ) + CALL ncio_read_vector (file_restart, 'HT_ROOF' , landurban, hroof ) + CALL ncio_read_vector (file_restart, 'BUILDING_HLR' , landurban, hlr ) + CALL ncio_read_vector (file_restart, 'WTROAD_PERV' , landurban, fgper ) + CALL ncio_read_vector (file_restart, 'EM_ROOF' , landurban, em_roof ) + CALL ncio_read_vector (file_restart, 'EM_WALL' , landurban, em_wall ) + CALL ncio_read_vector (file_restart, 'EM_IMPROAD' , landurban, em_gimp ) + CALL ncio_read_vector (file_restart, 'EM_PERROAD' , landurban, em_gper ) + CALL ncio_read_vector (file_restart, 'T_BUILDING_MIN', landurban, t_roommin ) + CALL ncio_read_vector (file_restart, 'T_BUILDING_MAX', landurban, t_roommax ) CALL ncio_read_vector (file_restart, 'ROOF_DEPTH_L' , ulev, landurban, z_roof ) CALL ncio_read_vector (file_restart, 'ROOF_THICK_L' , ulev, landurban, dz_roof ) @@ -186,12 +186,12 @@ SUBROUTINE READ_UrbanTimeInvariants (file_restart) CALL ncio_read_vector (file_restart, 'WALL_THICK_L' , ulev, landurban, dz_wall ) ! thermal paras - CALL ncio_read_vector (file_restart, 'CV_ROOF' , ulev, landurban, cv_roof) - CALL ncio_read_vector (file_restart, 'CV_WALL' , ulev, landurban, cv_wall) - CALL ncio_read_vector (file_restart, 'TK_ROOF' , ulev, landurban, tk_roof) - CALL ncio_read_vector (file_restart, 'TK_WALL' , ulev, landurban, tk_wall) - CALL ncio_read_vector (file_restart, 'TK_IMPROAD', ulev, landurban, tk_gimp) - CALL ncio_read_vector (file_restart, 'CV_IMPROAD', ulev, landurban, cv_gimp) + CALL ncio_read_vector (file_restart, 'CV_ROOF' , ulev, landurban, cv_roof ) + CALL ncio_read_vector (file_restart, 'CV_WALL' , ulev, landurban, cv_wall ) + CALL ncio_read_vector (file_restart, 'TK_ROOF' , ulev, landurban, tk_roof ) + CALL ncio_read_vector (file_restart, 'TK_WALL' , ulev, landurban, tk_wall ) + CALL ncio_read_vector (file_restart, 'TK_IMPROAD', ulev, landurban, tk_gimp ) + CALL ncio_read_vector (file_restart, 'CV_IMPROAD', ulev, landurban, cv_gimp ) CALL ncio_read_vector (file_restart, 'ALB_ROOF' , ns, nr, landurban, alb_roof ) CALL ncio_read_vector (file_restart, 'ALB_WALL' , ns, nr, landurban, alb_wall ) diff --git a/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 b/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 index 3133f29f..2297a5e5 100644 --- a/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 +++ b/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 @@ -304,7 +304,7 @@ END SUBROUTINE READ_UrbanTimeVariables SUBROUTINE WRITE_UrbanTimeVariables (file_restart) - USE MOD_Namelist, only : DEF_REST_CompressLevel + USE MOD_Namelist, only: DEF_REST_CompressLevel USE MOD_LandUrban USE MOD_NetCDFVector USE MOD_Vars_Global diff --git a/main/URBAN/MOD_Urban_WallTemperature.F90 b/main/URBAN/MOD_Urban_WallTemperature.F90 index 9b3e0f11..d7bb26fa 100644 --- a/main/URBAN/MOD_Urban_WallTemperature.F90 +++ b/main/URBAN/MOD_Urban_WallTemperature.F90 @@ -40,25 +40,25 @@ SUBROUTINE UrbanWallTem (deltim,capr,cnfac,& twall_inner,lwall,clwall,sabwall,fsenwall,cwalls,tkdz_wall) !======================================================================= -! 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). +! 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. +! 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 +! o no Phase change ! -! Original author : Yongjiu Dai, 05/2020 +! Original author: Yongjiu Dai, 05/2020 !======================================================================= USE MOD_Precision diff --git a/mkinidata/CoLMINI.F90 b/mkinidata/CoLMINI.F90 index 57b9da79..fb56f6ad 100644 --- a/mkinidata/CoLMINI.F90 +++ b/mkinidata/CoLMINI.F90 @@ -5,7 +5,7 @@ PROGRAM CoLMINI ! ====================================================================== ! Initialization of Land Characteristic Parameters and Initial State Variables ! -! Reference: +! References: ! [1] Dai et al., 2003: The Common Land Model (CoLM). ! Bull. of Amer. Meter. Soc., 84: 1013-1023 ! [2] Dai et al., 2004: A two-big-leaf model for canopy temperature, @@ -52,7 +52,7 @@ PROGRAM CoLMINI USE MOD_SnowSnicar, only: SnowAge_init, SnowOptics_init IMPLICIT NONE - ! ----------------local variables --------------------------------- +!-------------------------- Local Variables ---------------------------- character(len=256) :: nlfile character(len=256) :: casename ! case name character(len=256) :: dir_landdata diff --git a/mkinidata/MOD_DBedrockReadin.F90 b/mkinidata/MOD_DBedrockReadin.F90 index 9ff6d078..2c991240 100644 --- a/mkinidata/MOD_DBedrockReadin.F90 +++ b/mkinidata/MOD_DBedrockReadin.F90 @@ -19,8 +19,8 @@ SUBROUTINE dbedrock_readin (dir_landdata) USE MOD_UserDefFun USE MOD_LandPatch USE MOD_NetCDFVector - USE MOD_Vars_Global, only : nl_soil, dz_soi - USE MOD_Vars_TimeInvariants, only : dbedrock, ibedrock + USE MOD_Vars_Global, only: nl_soil, dz_soi + USE MOD_Vars_TimeInvariants, only: dbedrock, ibedrock #ifdef SinglePoint USE MOD_SingleSrfdata #endif @@ -68,4 +68,3 @@ SUBROUTINE dbedrock_readin (dir_landdata) END SUBROUTINE dbedrock_readin END MODULE MOD_DBedrockReadin - diff --git a/mkinidata/MOD_IniTimeVariable.F90 b/mkinidata/MOD_IniTimeVariable.F90 index 10745e69..89c8dc7f 100644 --- a/mkinidata/MOD_IniTimeVariable.F90 +++ b/mkinidata/MOD_IniTimeVariable.F90 @@ -72,9 +72,9 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& USE MOD_Const_Physical, only: tfrz, denh2o, denice USE MOD_Vars_TimeVariables, only: tlai, tsai USE MOD_Const_PFT, only: isevg, woody, leafcn, frootcn, livewdcn, deadwdcn, slatop - USE MOD_Vars_TimeInvariants, only : ibedrock, dbedrock + USE MOD_Vars_TimeInvariants, only: ibedrock, dbedrock #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) - USE MOD_LandPFT, only : patch_pft_s, patch_pft_e + USE MOD_LandPFT, only: patch_pft_s, patch_pft_e USE MOD_Vars_PFTimeInvariants USE MOD_Vars_PFTimeVariables #endif @@ -176,7 +176,7 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& real(r8), intent(inout) :: &! zwt ! the depth to water table [m] - real(r8), intent(out) :: &! + real(r8), intent(out) :: &! snw_rds ( maxsnl+1:0 ), &! effective grain radius (col,lyr) [microns, m-6] mss_bcphi( maxsnl+1:0 ), &! mass concentration of hydrophilic BC (col,lyr) [kg/kg] mss_bcpho( maxsnl+1:0 ), &! mass concentration of hydrophobic BC (col,lyr) [kg/kg] @@ -655,7 +655,7 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& col_soilendnb = 0.0 col_soilbegnb = 0.0 IF(.not. use_cnini)THEN - decomp_cpools_vr (:,:) = 0.0 + decomp_cpools_vr (:,:) = 0.0 ENDIF decomp_cpools (:) = 0.0 ctrunc_vr (:) = 0.0 @@ -666,16 +666,16 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& altmax_lastyear_indx = 10 lag_npp = 0.0 IF(.not. use_cnini)THEN - decomp_npools_vr (:,:) = 0.0 + decomp_npools_vr (:,:) = 0.0 ENDIF decomp_npools (:) = 0.0 ntrunc_vr (:) = 0.0 ntrunc_veg = 0.0 ntrunc_soil = 0.0 IF(.not. use_cnini)THEN - smin_no3_vr (:) = 5.0 - smin_nh4_vr (:) = 5.0 - sminn_vr (:) = 10.0 + smin_no3_vr (:) = 5.0 + smin_nh4_vr (:) = 5.0 + sminn_vr (:) = 10.0 ENDIF sminn = 0.0 DO j = 1, nl_soil @@ -816,8 +816,8 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& ! totvegn = totvegn + (leafn_p(m) + leafn_storage_p(m) + deadstemn_p(m))* pftfrac(m) ENDDO IF(DEF_USE_OZONESTRESS)THEN - o3uptakesun_p (ps:pe) = 0._r8 - o3uptakesha_p (ps:pe) = 0._r8 + o3uptakesun_p (ps:pe) = 0._r8 + o3uptakesha_p (ps:pe) = 0._r8 ENDIF leafc_xfer_p (ps:pe) = 0.0 frootc_xfer_p (ps:pe) = 0.0 @@ -1201,9 +1201,9 @@ SUBROUTINE snow_ini(patchtype,maxsnl,snowdp,snl,z_soisno,dz_soisno) USE MOD_Precision IMPLICIT NONE - integer, intent(in) :: maxsnl !maximum of snow layers - integer, intent(in) :: patchtype !index for land cover type [-] - real(r8), intent(in) :: snowdp !snow depth [m] + integer, intent(in) :: maxsnl !maximum of snow layers + integer, intent(in) :: patchtype !index for land cover type [-] + real(r8), intent(in) :: snowdp !snow depth [m] real(r8), intent(out) :: z_soisno (maxsnl+1:0) !node depth [m] real(r8), intent(out) :: dz_soisno(maxsnl+1:0) !layer thickness [m] integer, intent(out) :: snl !number of snow layer diff --git a/mkinidata/MOD_LakeDepthReadin.F90 b/mkinidata/MOD_LakeDepthReadin.F90 index 8b5af3de..4c8ad8c1 100644 --- a/mkinidata/MOD_LakeDepthReadin.F90 +++ b/mkinidata/MOD_LakeDepthReadin.F90 @@ -3,10 +3,10 @@ MODULE MOD_LakeDepthReadin !------------------------------------------------------------------------------------------ -! DESCRIPTION: -! Read in lakedepth and assign lake thickness of each layer. +! !DESCRIPTION: +! Read in lakedepth and assign lake thickness of each layer. ! -! Original author: Yongjiu Dai, 03/2018 +! Original author: Yongjiu Dai, 03/2018 !------------------------------------------------------------------------------------------ USE MOD_Precision @@ -23,11 +23,11 @@ MODULE MOD_LakeDepthReadin SUBROUTINE lakedepth_readin (dir_landdata, lc_year) USE MOD_Precision - USE MOD_Vars_Global, only : nl_lake + USE MOD_Vars_Global, only: nl_lake USE MOD_SPMD_Task USE MOD_LandPatch USE MOD_NetCDFVector - USE MOD_Vars_TimeInvariants, only : lakedepth, dz_lake + USE MOD_Vars_TimeInvariants, only: lakedepth, dz_lake #ifdef SinglePoint USE MOD_SingleSrfdata #endif diff --git a/mkinidata/MOD_SoilColorRefl.F90 b/mkinidata/MOD_SoilColorRefl.F90 index e1768288..5a5d3b1b 100644 --- a/mkinidata/MOD_SoilColorRefl.F90 +++ b/mkinidata/MOD_SoilColorRefl.F90 @@ -3,9 +3,9 @@ MODULE MOD_SoilColorRefl ! ====================================================================== -! Guess the soil color (reflectance) based on the land cover types +! Guess the soil color (reflectance) based on the land cover types ! -! Created by Yongjiu Dai, 03/2014 +! Created by Yongjiu Dai, 03/2014 ! ====================================================================== USE MOD_Precision diff --git a/mkinidata/MOD_SoilParametersReadin.F90 b/mkinidata/MOD_SoilParametersReadin.F90 index 8f5ce24e..6920627f 100644 --- a/mkinidata/MOD_SoilParametersReadin.F90 +++ b/mkinidata/MOD_SoilParametersReadin.F90 @@ -3,15 +3,15 @@ MODULE MOD_SoilParametersReadin !------------------------------------------------------------------------------------------ -! DESCRIPTION: -! Read in soil parameters; make unit conversion for soil physical process modeling; -! soil parameters 8 layers => 10 layers +! !DESCRIPTION: +! Read in soil parameters; make unit conversion for soil physical process modeling; +! soil parameters 8 layers => 10 layers ! -! Original author: Yongjiu Dai, 03/2014 +! Original author: Yongjiu Dai, 03/2014 ! -! Revisions: -! Nan Wei, 01/2019: read more parameters from mksrfdata results -! Shupeng Zhang and Nan Wei, 01/2022: porting codes to parallel version +! !REVISIONS: +! Nan Wei, 01/2019: read more parameters from mksrfdata results +! Shupeng Zhang and Nan Wei, 01/2022: porting codes to parallel version !------------------------------------------------------------------------------------------ USE MOD_Precision diff --git a/mkinidata/MOD_SoilTextureReadin.F90 b/mkinidata/MOD_SoilTextureReadin.F90 index db2462e6..f15c48f8 100644 --- a/mkinidata/MOD_SoilTextureReadin.F90 +++ b/mkinidata/MOD_SoilTextureReadin.F90 @@ -19,7 +19,7 @@ SUBROUTINE soiltext_readin (dir_landdata, lc_year) USE MOD_UserDefFun USE MOD_LandPatch USE MOD_NetCDFVector - USE MOD_Vars_TimeInvariants, only : soiltext + USE MOD_Vars_TimeInvariants, only: soiltext #ifdef SinglePoint USE MOD_SingleSrfdata #endif diff --git a/mkinidata/MOD_UrbanIniTimeVariable.F90 b/mkinidata/MOD_UrbanIniTimeVariable.F90 index ae658e55..173f2cf4 100644 --- a/mkinidata/MOD_UrbanIniTimeVariable.F90 +++ b/mkinidata/MOD_UrbanIniTimeVariable.F90 @@ -6,13 +6,11 @@ MODULE MOD_UrbanIniTimeVariable !----------------------------------------------------------------------- ! ! !DESCRIPTION: -! ! Initialize urban model time variables. ! ! Created by Hua Yuan, 09/16/2021 ! ! !REVISIONS: -! ! 05/2023, Wenzong Dong, Hua Yuan: porting codes to MPI parallel version. ! !----------------------------------------------------------------------- diff --git a/mkinidata/MOD_UrbanReadin.F90 b/mkinidata/MOD_UrbanReadin.F90 index c070312d..51eda213 100644 --- a/mkinidata/MOD_UrbanReadin.F90 +++ b/mkinidata/MOD_UrbanReadin.F90 @@ -12,7 +12,6 @@ MODULE MOD_UrbanReadin ! Created by Hua Yuan, 11/26/2021 ! ! !REVISIONS: -! ! 05/2023, Wenzong Dong, Hua Yuan: porting codes to MPI parallel version. !----------------------------------------------------------------------- diff --git a/mksrfdata/Aggregation_DBedrock.F90 b/mksrfdata/Aggregation_DBedrock.F90 index fe496f3e..2439b305 100644 --- a/mksrfdata/Aggregation_DBedrock.F90 +++ b/mksrfdata/Aggregation_DBedrock.F90 @@ -4,13 +4,13 @@ SUBROUTINE Aggregation_DBedrock ( & gland, dir_rawdata, dir_model_landdata) ! --------------------------------------------------------------------------- -! Depth to bedrock +! Depth to bedrock ! ! Shangguan, W., Hengl, T., Mendes de Jesus, J., Yuan, H., Dai, Y. (2017). ! Mapping the global depth to bedrock for land surface modeling. ! Journal of Advances in Modeling Earth Systems, 9(1), 65–88. ! -! Created by Shupeng Zhang, 05/2023 +! Created by Shupeng Zhang, 05/2023 ! ---------------------------------------------------------------------- USE MOD_Precision @@ -126,4 +126,3 @@ SUBROUTINE Aggregation_DBedrock ( & ENDIF END SUBROUTINE Aggregation_DBedrock - diff --git a/mksrfdata/Aggregation_ForestHeight.F90 b/mksrfdata/Aggregation_ForestHeight.F90 index 864c2593..e9d9db3e 100644 --- a/mksrfdata/Aggregation_ForestHeight.F90 +++ b/mksrfdata/Aggregation_ForestHeight.F90 @@ -4,17 +4,17 @@ SUBROUTINE Aggregation_ForestHeight ( & gland, dir_rawdata, dir_model_landdata, lc_year) ! ---------------------------------------------------------------------- -! Global Forest Height -! (http://lidarradar.jpl.nasa.gov/) -! Simard, M., N. Pinto, J. B. Fisher, and A. Baccini, 2011: Mapping -! forest canopy height globally with spaceborne lidar. -! J. Geophys. Res., 116, G04021. +! Global Forest Height +! (http://lidarradar.jpl.nasa.gov/) +! Simard, M., N. Pinto, J. B. Fisher, and A. Baccini, 2011: Mapping +! forest canopy height globally with spaceborne lidar. +! J. Geophys. Res., 116, G04021. ! -! Created by Yongjiu Dai, 02/2014 +! Created by Yongjiu Dai, 02/2014 ! -! REVISIONS: -! Hua Yuan, ?/2020 : for land cover land use classifications -! Shupeng Zhang, 01/2022: porting codes to MPI parallel version +! !REVISIONS: +! Hua Yuan, ?/2020 : for land cover land use classifications +! Shupeng Zhang, 01/2022: porting codes to MPI parallel version ! ---------------------------------------------------------------------- USE MOD_Precision diff --git a/mksrfdata/Aggregation_LAI.F90 b/mksrfdata/Aggregation_LAI.F90 index d448d2e7..d76f5e59 100644 --- a/mksrfdata/Aggregation_LAI.F90 +++ b/mksrfdata/Aggregation_LAI.F90 @@ -2,18 +2,18 @@ SUBROUTINE Aggregation_LAI (gridlai, dir_rawdata, dir_model_landdata, lc_year) ! ---------------------------------------------------------------------- -! 1. Global Plant Leaf Area Index -! (http://globalchange.bnu.edu.cn) -! Yuan H., et al., 2011: -! Reprocessing the MODIS Leaf Area Index products for land surface -! and climate modelling. Remote Sensing of Environment, 115: 1171-1187. +! 1. Global Plant Leaf Area Index +! (http://globalchange.bnu.edu.cn) +! Yuan H., et al., 2011: +! Reprocessing the MODIS Leaf Area Index products for land surface +! and climate modelling. Remote Sensing of Environment, 115: 1171-1187. ! -! Created by Yongjiu Dai, 02/2014 +! Created by Yongjiu Dai, 02/2014 ! -! REVISIONS: -! Hua Yuan, ?/2020 : for land cover land use classifications -! Shupeng Zhang, 01/2022: porting codes to MPI parallel version -! Hua Yuan, 05/2023: TODO +! !REVISIONS: +! Hua Yuan, ?/2020 : for land cover land use classifications +! Shupeng Zhang, 01/2022: porting codes to MPI parallel version +! Hua Yuan, 05/2023: TODO ! ---------------------------------------------------------------------- USE MOD_Precision @@ -428,7 +428,7 @@ SUBROUTINE Aggregation_LAI (gridlai, dir_rawdata, dir_model_landdata, lc_year) write(cyear,'(i4.4)') iy suffix = 'MOD'//trim(cyear) CALL system('mkdir -p ' // trim(landdir) // trim(cyear)) - + IF (p_is_master) THEN write(*,'(A,I4)') 'Aggregate LAI : ', iy ENDIF diff --git a/mksrfdata/Aggregation_LakeDepth.F90 b/mksrfdata/Aggregation_LakeDepth.F90 index 7065a023..f81c352c 100644 --- a/mksrfdata/Aggregation_LakeDepth.F90 +++ b/mksrfdata/Aggregation_LakeDepth.F90 @@ -3,31 +3,31 @@ SUBROUTINE Aggregation_LakeDepth ( & gland, dir_rawdata, dir_model_landdata, lc_year) -! ---------------------------------------------------------------------- -! DESCRIPTION: -! Aggregate lake depth of multiple pixels within a lake patch based on Global land cover types -! (updated with the specific dataset) +!----------------------------------------------------------------------- +! DESCRIPTION: +! Aggregate lake depth of multiple pixels within a lake patch based on +! Global land cover types (updated with the specific dataset) ! -! Global Lake Coverage and Lake Depth (1km resolution) -! (http://nwpi.krc.karelia.run/flake/) -! Lake depth data legend -! Value Description -! 0 no lake indicated in this pixel -! 1 no any information about this lake and set the default value of 10 m -! 2 no information about depth for this lake and set the default value of 10 m -! 3 have the information about lake depth in this pixel -! 4 this is the river pixel according to our map, set the default value of 3 m +! Global Lake Coverage and Lake Depth (1km resolution) +! (http://nwpi.krc.karelia.run/flake/) +! Lake depth data legend +! Value Description +! 0 no lake indicated in this pixel +! 1 no any information about this lake and set the default value of 10 m +! 2 no information about depth for this lake and set the default value of 10 m +! 3 have the information about lake depth in this pixel +! 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. +! !REFERENCES: +! 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 +! Created by Yongjiu Dai, 02/2014 ! -! REVISIONS: -! Shupeng Zhang, 01/2022: porting codes to MPI parallel version -! ---------------------------------------------------------------------- +! !REVISIONS: +! Shupeng Zhang, 01/2022: porting codes to MPI parallel version +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Namelist diff --git a/mksrfdata/Aggregation_PercentagesPFT.F90 b/mksrfdata/Aggregation_PercentagesPFT.F90 index d24f2fc9..c0abda27 100644 --- a/mksrfdata/Aggregation_PercentagesPFT.F90 +++ b/mksrfdata/Aggregation_PercentagesPFT.F90 @@ -2,15 +2,15 @@ SUBROUTINE Aggregation_PercentagesPFT (gland, dir_rawdata, dir_model_landdata, lc_year) -! ---------------------------------------------------------------------- -! Percentage of Plant Function Types +!----------------------------------------------------------------------- +! Percentage of Plant Function Types ! -! Original from Hua Yuan's OpenMP version. +! Original from Hua Yuan's OpenMP version. ! -! REVISIONS: -! Hua Yuan, ?/2020 : for land cover land use classifications -! Shupeng Zhang, 01/2022: porting codes to MPI parallel version -! ---------------------------------------------------------------------- +! !REVISIONS: +! Hua Yuan, ?/2020 : for land cover land use classifications +! Shupeng Zhang, 01/2022: porting codes to MPI parallel version +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Vars_Global diff --git a/mksrfdata/Aggregation_SoilBrightness.F90 b/mksrfdata/Aggregation_SoilBrightness.F90 index fda9fe43..652462ea 100644 --- a/mksrfdata/Aggregation_SoilBrightness.F90 +++ b/mksrfdata/Aggregation_SoilBrightness.F90 @@ -2,15 +2,15 @@ SUBROUTINE Aggregation_SoilBrightness ( & gland, dir_rawdata, dir_model_landdata, lc_year) -! ---------------------------------------------------------------------- -! Creates land model surface dataset from original "raw" data files - -! data with 30 arc seconds resolution +!----------------------------------------------------------------------- +! Creates land model surface dataset from original "raw" data files - +! data with 30 arc seconds resolution ! -! Created by Yongjiu Dai, 03/2014 +! Created by Yongjiu Dai, 03/2014 ! -! REVISIONS: -! Shupeng Zhang, 01/2022: porting codes to MPI parallel version. -! ---------------------------------------------------------------------- +! !REVISIONS: +! Shupeng Zhang, 01/2022: porting codes to MPI parallel version. +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Namelist diff --git a/mksrfdata/Aggregation_SoilParameters.F90 b/mksrfdata/Aggregation_SoilParameters.F90 index c5dc5856..8a816609 100644 --- a/mksrfdata/Aggregation_SoilParameters.F90 +++ b/mksrfdata/Aggregation_SoilParameters.F90 @@ -3,24 +3,33 @@ SUBROUTINE Aggregation_SoilParameters ( & gland, dir_rawdata, dir_model_landdata, lc_year) -!-------------------------------------------------------------------------------------------------------------------------------------- -! DESCRIPTION: -! Create soil hydraulic and thermal parameters for the modeling reolustion +!----------------------------------------------------------------------- +! !DESCRIPTION: +! Create soil hydraulic and thermal parameters for the modeling reolustion +! +! !REFERENCES: +! 1)Dai, Y., Q. Xin, N. Wei, Y. Zhang, W. Shangguan, H. Yuan, S. Zhang, S. +! Liu, X. Lu, 2019. A global high-resolution dataset of soil hydraulic and +! thermal properties for land surface modeling. Journal of Advances in +! Modeling Earth Systems,11, 2996-3023. ! -! REFERENCES: -! 1)Dai, Y., Q. Xin, N. Wei, Y. Zhang, W. Shangguan, H. Yuan, S. Zhang, S. Liu, X. Lu, 2019. A global high-resolution dataset of -! soil hydraulic and thermal properties for land surface modeling. Journal of Advances in Modeling Earth Systems,11, 2996-3023. -! 2)Dai, Y., N. Wei, H. Yuan, S. Zhang, W. Shangguan, S. Liu, and X. Lu, 2019. Evaluation of soil thermal conductivity schemes -! for use in land surface modelling, Journal of Advances in Modeling Earth Systems, 11, 3454-3473. -! 3)Dai, Y., W. Shangguan, Q. Duan, B. Liu, S. Fu, and G. Niu, 2013. Development of a China dataset of soil hydraulic parameters -! using pedotransfer functions for land surface modeling. Journal of Hydrometeorology 14, 869–887 +! 2)Dai, Y., N. Wei, H. Yuan, S. Zhang, W. Shangguan, S. Liu, and X. Lu, 2019. +! Evaluation of soil thermal conductivity schemes for use in land surface +! modelling, Journal of Advances in Modeling Earth Systems, 11, 3454-3473. ! -! Original author: Yongjiu Dai and Wei Shangguan, 02/2014 +! 3)Dai, Y., W. Shangguan, Q. Duan, B. Liu, S. Fu, and G. Niu, 2013. +! Development of a China dataset of soil hydraulic parameters using +! pedotransfer functions for land surface modeling. Journal of +! Hydrometeorology 14, 869–887 ! -! REVISIONS: -! Nan Wei, 06/2019: add algorithms of fitting soil water retention curves to aggregate soil hydraulic parameters from pixels to a patch. -! Shupeng Zhang and Nan Wei, 01/2022: porting codes to MPI parallel version -! ------------------------------------------------------------------------------------------------------------------------------------- +! Original author: Yongjiu Dai and Wei Shangguan, 02/2014 +! +! !REVISIONS: +! 06/2019, Nan Wei: add algorithms of fitting soil water retention curves to +! aggregate soil hydraulic parameters from pixels to a patch. +! +! 01/2022, Shupeng Zhang and Nan Wei: porting codes to MPI parallel version. +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Vars_Global diff --git a/mksrfdata/Aggregation_SoilTexture.F90 b/mksrfdata/Aggregation_SoilTexture.F90 index 88f12a0a..a196daa9 100644 --- a/mksrfdata/Aggregation_SoilTexture.F90 +++ b/mksrfdata/Aggregation_SoilTexture.F90 @@ -3,17 +3,17 @@ SUBROUTINE Aggregation_SoilTexture ( & gland, dir_rawdata, dir_model_landdata, lc_year) -! ---------------------------------------------------------------------- -! DESCRIPTION: -! Aggregate soil texture class within a patch. +!----------------------------------------------------------------------- +! !DESCRIPTION: +! Aggregate soil texture class within a patch. ! -! Use the USDA soil texture triangle (using the amount of sand, clay, and -! silt contents) to identify the soil texture in fine grid resolution and -! then finding the major soil type in a patch by counting number of fine -! grids with each type of soil and adopting the major one. +! Use the USDA soil texture triangle (using the amount of sand, clay, and +! silt contents) to identify the soil texture in fine grid resolution and +! then finding the major soil type in a patch by counting number of fine +! grids with each type of soil and adopting the major one. ! -! Created by Shupeng Zhang, 01/2025 -! ---------------------------------------------------------------------- +! Created by Shupeng Zhang, 01/2025 +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Namelist diff --git a/mksrfdata/Aggregation_Topography.F90 b/mksrfdata/Aggregation_Topography.F90 index 810b7e80..7194f764 100644 --- a/mksrfdata/Aggregation_Topography.F90 +++ b/mksrfdata/Aggregation_Topography.F90 @@ -2,16 +2,16 @@ SUBROUTINE Aggregation_Topography ( & gtopo, dir_rawdata, dir_model_landdata, lc_year) -! ---------------------------------------------------------------------- -! Global Topography data +!----------------------------------------------------------------------- +! Global Topography data ! ! Yamazaki, D., Ikeshima, D., Sosa, J.,Bates, P. D., Allen, G. H., ! Pavelsky, T. M. (2019). ! MERIT Hydro: ahigh‐resolution global hydrographymap based on ! latest topography dataset.Water Resources Research, 55, 5053–5073. ! -! Created by Shupeng Zhang, 05/2023 -! ---------------------------------------------------------------------- +! Created by Shupeng Zhang, 05/2023 +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Namelist @@ -27,7 +27,7 @@ SUBROUTINE Aggregation_Topography ( & USE MOD_Utils #ifdef SrfdataDiag - USE MOD_Mesh, only : numelm + USE MOD_Mesh, only: numelm USE MOD_LandElm USE MOD_SrfdataDiag #endif diff --git a/mksrfdata/Aggregation_TopographyFactors.F90 b/mksrfdata/Aggregation_TopographyFactors.F90 index 99fbfb73..b156c49e 100644 --- a/mksrfdata/Aggregation_TopographyFactors.F90 +++ b/mksrfdata/Aggregation_TopographyFactors.F90 @@ -2,11 +2,11 @@ SUBROUTINE Aggregation_TopographyFactors ( & grid_topo_factor , dir_topodata, dir_model_landdata, lc_year) - ! ---------------------------------------------------------------------- - ! Global topography-based factors data - ! - ! Created by Sisi Chen, Lu Li, 06/2024 - ! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! Global topography-based factors data +! +! Created by Sisi Chen, Lu Li, 06/2024 +! ---------------------------------------------------------------------- USE MOD_Precision USE MOD_Namelist USE MOD_SPMD_Task @@ -20,7 +20,7 @@ SUBROUTINE Aggregation_TopographyFactors ( & USE MOD_AggregationRequestData USE MOD_Utils #ifdef SrfdataDiag - USE MOD_Mesh, only : numelm + USE MOD_Mesh, only: numelm USE MOD_LandElm USE MOD_SrfdataDiag #endif @@ -309,13 +309,13 @@ SUBROUTINE Aggregation_TopographyFactors ( & type = 4 ELSE ! missing value=-9999 cycle - END IF + ENDIF IF ((area_one(i)>0).and.(area_one(i)<=sum_area_one)) THEN ! quality control area_type_one(type,i) = area_one(i) asp_type_one (type,i) = asp_one(i)*area_one(i) slp_type_one (type,i) = slp_one(i)*area_one(i) - END IF + ENDIF ENDDO ! assign value to four types at patches diff --git a/mksrfdata/Aggregation_Urban.F90 b/mksrfdata/Aggregation_Urban.F90 index 76e41656..8aacb86f 100644 --- a/mksrfdata/Aggregation_Urban.F90 +++ b/mksrfdata/Aggregation_Urban.F90 @@ -3,16 +3,13 @@ !----------------------------------------------------------------------- ! ! !DESCRIPTION: -! ! 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. ! -! ! !REVISIONS: -! ! 05/2023, Wenzong Dong, Hua Yuan, Shupeng Zhang: porting codes to MPI ! parallel version. ! diff --git a/mksrfdata/MKSRFDATA.F90 b/mksrfdata/MKSRFDATA.F90 index abb71114..d56c180c 100644 --- a/mksrfdata/MKSRFDATA.F90 +++ b/mksrfdata/MKSRFDATA.F90 @@ -2,49 +2,49 @@ PROGRAM MKSRFDATA -! ====================================================================== -! Surface grid edges: -! The model domain was defined with the north, east, south, west edges: -! edgen: northern edge of grid : > -90 and <= 90 (degrees) -! edgee: eastern edge of grid : > western edge and <= 180 -! edges: southern edge of grid : >= -90 and < 90 -! edgew: western edge of grid : >= -180 and < 180 +!======================================================================= +! Surface grid edges: +! The model domain was defined with the north, east, south, west edges: +! edgen: northern edge of grid : > -90 and <= 90 (degrees) +! edgee: eastern edge of grid : > western edge and <= 180 +! edges: southern edge of grid : >= -90 and < 90 +! edgew: western edge of grid : >= -180 and < 180 ! -! Region (global) latitude grid goes from: -! NORTHERN edge (POLE) to SOUTHERN edge (POLE) -! Region (global) longitude grid starts at: -! WESTERN edge (DATELINE with western edge) -! West of Greenwich defined negative for global grids, -! the western edge of the longitude grid starts at the dateline +! Region (global) latitude grid goes from: +! NORTHERN edge (POLE) to SOUTHERN edge (POLE) +! Region (global) longitude grid starts at: +! WESTERN edge (DATELINE with western edge) +! West of Greenwich defined negative for global grids, +! the western edge of the longitude grid starts at the dateline ! -! Land characteristics at the 30 arc-seconds grid resolution (RAW DATA): -! 1. Global Terrain Dataset (elevation height, topography-based factors) -! 2. Global Land Cover Characteristics (land cover type, plant leaf area index, Forest Height, ...) -! 3. Global Lakes and Wetlands Characteristics (lake and wetlands types, lake coverage and lake depth) -! 4. Global Glacier Characteristics -! 5. Global Urban Characteristics (urban extent, ...) -! 6. Global Soil Characteristics (...) -! 7. Global Cultural Characteristics (ON-GONG PROJECT) +! Land characteristics at the 30 arc-seconds grid resolution (RAW DATA): +! 1. Global Terrain Dataset (elevation height, topography-based factors) +! 2. Global Land Cover Characteristics (land cover type, plant leaf area index, Forest Height, ...) +! 3. Global Lakes and Wetlands Characteristics (lake and wetlands types, lake coverage and lake depth) +! 4. Global Glacier Characteristics +! 5. Global Urban Characteristics (urban extent, ...) +! 6. Global Soil Characteristics (...) +! 7. Global Cultural Characteristics (ON-GONG PROJECT) ! -! 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) -! 2.2 Fraction of wetland -! 2.3 Fraction of glacier -! 2.4 Fraction of urban and built-up -! ...... -! 3. Plant leaf area index -! 4. Tree height -! 5. Lake depth -! 6. Soil thermal and hydraulic parameters +! 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) +! 2.2 Fraction of wetland +! 2.3 Fraction of glacier +! 2.4 Fraction of urban and built-up +! ...... +! 3. Plant leaf area index +! 4. Tree height +! 5. Lake depth +! 6. Soil thermal and hydraulic parameters ! -! Created by Yongjiu Dai, 02/2014 +! Created by Yongjiu Dai, 02/2014 ! -! REVISIONS: -! Shupeng Zhang, 01/2022: porting codes to MPI parallel version +! !REVISIONS: +! Shupeng Zhang, 01/2022: porting codes to MPI parallel version ! -! ====================================================================== +!======================================================================= USE MOD_Precision USE MOD_SPMD_Task @@ -72,7 +72,7 @@ PROGRAM MKSRFDATA #endif USE MOD_RegionClip #ifdef SrfdataDiag - USE MOD_SrfdataDiag, only : gdiag, srfdata_diag_init + USE MOD_SrfdataDiag, only: gdiag, srfdata_diag_init #endif USE MOD_RegionClip diff --git a/mksrfdata/MOD_AggregationRequestData.F90 b/mksrfdata/MOD_AggregationRequestData.F90 index 66a51002..311a976d 100644 --- a/mksrfdata/MOD_AggregationRequestData.F90 +++ b/mksrfdata/MOD_AggregationRequestData.F90 @@ -2,18 +2,18 @@ MODULE MOD_AggregationRequestData -!------------------------------------------------------------- -! DESCRIPTION: +!----------------------------------------------------------------------- +! !DESCRIPTION: ! ! Aggregation Utilities. -! -! On IO processes, a data daemon is running to provide data +! +! On IO processes, a data daemon is running to provide data ! at fine resolutions for worker processes. -! On worker processes, request is sent to IO processes and -! data is returned from IO processes. +! On worker processes, request is sent to IO processes and +! data is returned from IO processes. ! -! Created by Shupeng Zhang, May 2023 -!------------------------------------------------------------- +! Created by Shupeng Zhang, May 2023 +!----------------------------------------------------------------------- IMPLICIT NONE @@ -26,7 +26,7 @@ MODULE MOD_AggregationRequestData ! ---- subroutines ---- CONTAINS - + #ifdef USEMPI SUBROUTINE aggregation_data_daemon (grid_in, & data_r8_2d_in1, data_r8_2d_in2, data_r8_2d_in3, data_r8_2d_in4, & @@ -42,7 +42,7 @@ SUBROUTINE aggregation_data_daemon (grid_in, & IMPLICIT NONE type (grid_type), intent(in) :: grid_in - + ! 2D REAL data type (block_data_real8_2d), intent(in), optional :: data_r8_2d_in1 type (block_data_real8_2d), intent(in), optional :: data_r8_2d_in2 @@ -54,14 +54,14 @@ SUBROUTINE aggregation_data_daemon (grid_in, & ! 3D REAL data integer, intent(in), optional :: n1_r8_3d_in1 type (block_data_real8_3d), intent(in), optional :: data_r8_3d_in1 - + integer, intent(in), optional :: n1_r8_3d_in2 type (block_data_real8_3d), intent(in), optional :: data_r8_3d_in2 - + ! 2D INTEGER data type (block_data_int32_2d), intent(in), optional :: data_i4_2d_in1 type (block_data_int32_2d), intent(in), optional :: data_i4_2d_in2 - + ! Local Variables integer :: nreq, ireq, rmesg(2), isrc, idest integer :: xblk, yblk, xloc, yloc @@ -73,7 +73,7 @@ SUBROUTINE aggregation_data_daemon (grid_in, & logical, allocatable :: worker_done (:) IF (p_is_io) THEN - + allocate (worker_done (0:p_np_worker-1)) worker_done(:) = .false. @@ -94,9 +94,9 @@ SUBROUTINE aggregation_data_daemon (grid_in, & isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) CALL mpi_recv (ylist, nreq, MPI_INTEGER, & isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) - + idest = isrc - + allocate (sbuf_r8_1d (nreq)) IF (present(data_r8_2d_in1)) THEN @@ -154,7 +154,7 @@ SUBROUTINE aggregation_data_daemon (grid_in, & CALL mpi_send (sbuf_r8_1d, nreq, MPI_REAL8, & idest, mpi_tag_data, p_comm_glb, p_err) ENDIF - + IF (present(data_r8_2d_in5)) THEN DO ireq = 1, nreq xblk = grid_in%xblk(xlist(ireq)) @@ -265,7 +265,7 @@ SUBROUTINE aggregation_data_daemon (grid_in, & deallocate (worker_done) - ENDIF + ENDIF END SUBROUTINE aggregation_data_daemon @@ -303,7 +303,7 @@ SUBROUTINE aggregation_request_data ( & type (grid_type), intent(in) :: grid_in logical, intent(in) :: zip - + real(r8), allocatable, intent(out), optional :: area(:) type (block_data_real8_2d), intent(in), optional :: data_r8_2d_in1 @@ -331,7 +331,7 @@ SUBROUTINE aggregation_request_data ( & integer, intent(in), optional :: n1_r8_3d_in2, lb1_r8_3d_in2 type (block_data_real8_3d), intent(in), optional :: data_r8_3d_in2 real(r8), allocatable, intent(out), optional :: data_r8_3d_out2 (:,:) - + type (block_data_int32_2d), intent(in), optional :: data_i4_2d_in1 integer, allocatable, intent(out), optional :: data_i4_2d_out1 (:) @@ -366,10 +366,10 @@ SUBROUTINE aggregation_request_data ( & ygrdthis = grid_in%ygrd(mesh(ie)%ilat(ipxl)) CALL insert_into_sorted_list1 (xgrdthis, nx, xsorted, iloc) CALL insert_into_sorted_list1 (ygrdthis, ny, ysorted, iloc) - ENDDO + ENDDO allocate (xy2d (nx,ny)); xy2d(:,:) = 0 - + IF (present(area)) THEN allocate(area2d(nx,ny)); area2d(:,:) = 0. ENDIF @@ -377,7 +377,7 @@ SUBROUTINE aggregation_request_data ( & DO ipxl = ipxstt, ipxend xgrdthis = grid_in%xgrd(mesh(ie)%ilon(ipxl)) ygrdthis = grid_in%ygrd(mesh(ie)%ilat(ipxl)) - + ix = find_in_sorted_list1(xgrdthis, nx, xsorted) iy = find_in_sorted_list1(ygrdthis, ny, ysorted) @@ -396,7 +396,7 @@ SUBROUTINE aggregation_request_data ( & allocate (ylist (totalreq)) IF (present(area)) allocate(area(totalreq)) - + ig = 0 DO ix = 1, nx DO iy = 1, ny @@ -413,12 +413,12 @@ SUBROUTINE aggregation_request_data ( & IF (present(area)) deallocate (area2d) ELSE - + allocate(xlist (npxl)) allocate(ylist (npxl)) IF (present(area)) allocate (area (npxl)) - + totalreq = npxl DO ipxl = ipxstt, ipxend xlist(ipxl-ipxstt+1) = grid_in%xgrd(mesh(ie)%ilon(ipxl)) @@ -430,7 +430,7 @@ SUBROUTINE aggregation_request_data ( & ENDIF ENDDO - ENDIF + ENDIF IF (present(data_r8_2d_in1) .and. present(data_r8_2d_out1)) allocate (data_r8_2d_out1 (totalreq)) IF (present(data_r8_2d_in2) .and. present(data_r8_2d_out2)) allocate (data_r8_2d_out2 (totalreq)) @@ -503,7 +503,7 @@ SUBROUTINE aggregation_request_data ( & CALL mpi_send (ibuf, nreq, MPI_INTEGER, idest, mpi_tag_data, p_comm_glb, p_err) isrc = idest - + allocate (rbuf_r8_1d (nreq)) IF (present(data_r8_2d_in1) .and. present(data_r8_2d_out1)) THEN @@ -529,19 +529,19 @@ SUBROUTINE aggregation_request_data ( & isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) CALL unpack_inplace (rbuf_r8_1d, msk, data_r8_2d_out4) ENDIF - + IF (present(data_r8_2d_in5) .and. present(data_r8_2d_out5)) THEN CALL mpi_recv (rbuf_r8_1d, nreq, MPI_REAL8, & isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) CALL unpack_inplace (rbuf_r8_1d, msk, data_r8_2d_out5) ENDIF - + IF (present(data_r8_2d_in6) .and. present(data_r8_2d_out6)) THEN CALL mpi_recv (rbuf_r8_1d, nreq, MPI_REAL8, & isrc, mpi_tag_data, p_comm_glb, p_stat, p_err) CALL unpack_inplace (rbuf_r8_1d, msk, data_r8_2d_out6) ENDIF - + deallocate (rbuf_r8_1d) IF (present(data_r8_3d_in1) .and. present(data_r8_3d_out1) .and. present(n1_r8_3d_in1)) THEN @@ -585,7 +585,7 @@ SUBROUTINE aggregation_request_data ( & deallocate (msk ) #else - + DO ireq = 1, totalreq xblk = grid_in%xblk(xlist(ireq)) @@ -634,7 +634,7 @@ SUBROUTINE aggregation_request_data ( & ENDIF ENDDO - + #endif END SUBROUTINE aggregation_request_data @@ -645,11 +645,11 @@ SUBROUTINE aggregation_worker_done () USE MOD_SPMD_Task - IMPLICIT NONE + IMPLICIT NONE integer :: smesg(2), iproc, idest - - IF (p_is_worker) THEN + + IF (p_is_worker) THEN DO iproc = 0, p_np_io-1 smesg = (/p_iam_glb, -1/) idest = p_address_io(iproc) @@ -665,7 +665,7 @@ END SUBROUTINE aggregation_worker_done SUBROUTINE fillnan (vec, fill, defval) USE MOD_Precision - USE MOD_UserDefFun, only : isnan_ud + USE MOD_UserDefFun, only: isnan_ud IMPLICIT NONE real(r8), intent(inout) :: vec(:) @@ -675,7 +675,7 @@ SUBROUTINE fillnan (vec, fill, defval) ! local variables integer :: i, n real(r8) :: s - + n = 0 s = 0. DO i = lbound(vec,1), ubound(vec,1) diff --git a/mksrfdata/MOD_ElmVector.F90 b/mksrfdata/MOD_ElmVector.F90 index a67d70c7..00a96729 100644 --- a/mksrfdata/MOD_ElmVector.F90 +++ b/mksrfdata/MOD_ElmVector.F90 @@ -3,17 +3,17 @@ #if (defined UNSTRUCTURED || defined CATCHMENT) MODULE MOD_ElmVector -!------------------------------------------------------------------------------------ -! DESCRIPTION: +!----------------------------------------------------------------------- +! !DESCRIPTION: ! ! Address of Data associated with land element. ! -! To output a vector, Data is gathered from worker processes directly to master. -! "elm_data_address" stores information on how to reorganize data gathered. -! The output data in vector is sorted by global element index. +! To output a vector, Data is gathered from worker processes directly to +! master. "elm_data_address" stores information on how to reorganize data +! gathered. The output data in vector is sorted by global element index. ! -! Created by Shupeng Zhang, May 2023 -!------------------------------------------------------------------------------------ +! Created by Shupeng Zhang, May 2023 +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_DataType diff --git a/mksrfdata/MOD_HRUVector.F90 b/mksrfdata/MOD_HRUVector.F90 index a94a73b7..cb71887b 100644 --- a/mksrfdata/MOD_HRUVector.F90 +++ b/mksrfdata/MOD_HRUVector.F90 @@ -1,34 +1,35 @@ #include -#if (defined CATCHMENT) +#if (defined CATCHMENT) MODULE MOD_HRUVector -!------------------------------------------------------------------------------------ -! DESCRIPTION: -! +!----------------------------------------------------------------------- +! !DESCRIPTION: +! ! Address of Data associated with HRU. ! -! To output a vector, Data is gathered from worker processes directly to master. -! "hru_data_address" stores information on how to reorganize data gathered. -! The output data in vector is sorted by global element index (i.e. catchment index) +! To output a vector, Data is gathered from worker processes directly to +! master. "hru_data_address" stores information on how to reorganize data +! gathered. The output data in vector is sorted by global element index +! (i.e. catchment index) ! -! Created by Shupeng Zhang, May 2023 -!------------------------------------------------------------------------------------ +! Created by Shupeng Zhang, May 2023 +!----------------------------------------------------------------------- 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 +54,9 @@ SUBROUTINE hru_vector_init integer :: ielm, i, ielm_glb integer :: nhru, nelm, hru_dsp_loc - + IF (p_is_worker) THEN - + CALL elm_hru%build (landelm, landhru, use_frac = .true.) CALL hru_patch%build (landhru, landpatch, use_frac = .true.) @@ -67,9 +68,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 +95,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 +118,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 +138,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 +179,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 +187,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 +198,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 +208,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_LandCrop.F90 b/mksrfdata/MOD_LandCrop.F90 index 7a874815..c7e93507 100644 --- a/mksrfdata/MOD_LandCrop.F90 +++ b/mksrfdata/MOD_LandCrop.F90 @@ -3,14 +3,14 @@ #ifdef CROP MODULE MOD_LandCrop -!------------------------------------------------------------------------------------ -! DESCRIPTION: +!----------------------------------------------------------------------- +! !DESCRIPTION: ! ! Build crop patches. ! -! Created by Shupeng Zhang, Sep 2023 +! Created by Shupeng Zhang, Sep 2023 ! porting codes from Hua Yuan's OpenMP version to MPI parallel version. -!------------------------------------------------------------------------------------ +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Grid @@ -91,7 +91,7 @@ SUBROUTINE landcrop_build (lc_year) landpatch%ipxstt(:) = 1 landpatch%ipxend(:) = 1 landpatch%settyp(:) = CROPLAND - + landpatch%has_shared = .true. allocate (landpatch%pctshared(numpatch)) landpatch%pctshared = pctshrpch @@ -114,7 +114,7 @@ SUBROUTINE landcrop_build (lc_year) CALL allocate_block_data (gpatch, pctcrop_xy) CALL read_5x5_data (dir_5x5, suffix, gpatch, 'PCT_CROP', pctcrop_xy) - + CALL allocate_block_data (gpatch, pctshared_xy, 2) DO iblkme = 1, gblock%nblkme ib = gblock%xblkme(iblkme) @@ -123,7 +123,7 @@ SUBROUTINE landcrop_build (lc_year) pctshared_xy%blk(ib,jb)%val(2,:,:) = pctcrop_xy%blk(ib,jb)%val/100. ENDDO ENDIF - + sharedfilter = (/ 1 /) IF (landpatch%has_shared) then @@ -147,12 +147,12 @@ SUBROUTINE landcrop_build (lc_year) ENDIF cropfilter = (/ CROPLAND /) - + CALL pixelsetshared_build (landpatch, gcrop, cropdata, N_CFT, cropfilter, & pctshrpch, cropclass, fracin = pctshared) cropclass = cropclass + N_PFT - 1 - + numpatch = landpatch%nset landpatch%has_shared = .true. @@ -189,7 +189,7 @@ SUBROUTINE landcrop_build (lc_year) #endif CALL write_patchfrac (DEF_dir_landdata, lc_year) - + END SUBROUTINE landcrop_build END MODULE MOD_LandCrop diff --git a/mksrfdata/MOD_LandElm.F90 b/mksrfdata/MOD_LandElm.F90 index 3cdedebb..290039b7 100644 --- a/mksrfdata/MOD_LandElm.F90 +++ b/mksrfdata/MOD_LandElm.F90 @@ -2,8 +2,8 @@ MODULE MOD_LandElm -!------------------------------------------------------------------------------------ -! DESCRIPTION: +!----------------------------------------------------------------------- +! !DESCRIPTION: ! ! Build pixelset "landelm". ! @@ -14,11 +14,11 @@ MODULE MOD_LandElm ! ELEMENT >>> HRU >>> PATCH ! If Plant Function Type classification is used, PATCH is further divided into PFT. ! If Plant Community classification is used, PATCH is further divided into PC. -! +! ! "landelm" refers to pixelset ELEMENT. ! -! Created by Shupeng Zhang, May 2023 -!------------------------------------------------------------------------------------ +! Created by Shupeng Zhang, May 2023 +!----------------------------------------------------------------------- USE MOD_Pixelset IMPLICIT NONE diff --git a/mksrfdata/MOD_LandHRU.F90 b/mksrfdata/MOD_LandHRU.F90 index 7ada836c..45a922c1 100644 --- a/mksrfdata/MOD_LandHRU.F90 +++ b/mksrfdata/MOD_LandHRU.F90 @@ -1,11 +1,11 @@ #include -#ifdef CATCHMENT +#ifdef CATCHMENT MODULE MOD_LandHRU -!------------------------------------------------------------------------------------ -! DESCRIPTION: +!----------------------------------------------------------------------- +! !DESCRIPTION: ! ! Build pixelset "landhru". ! @@ -16,11 +16,11 @@ MODULE MOD_LandHRU ! ELEMENT >>> HRU >>> PATCH ! If Plant Function Type classification is used, PATCH is further divided into PFT. ! If Plant Community classification is used, PATCH is further divided into PC. -! +! ! "landhru" refers to pixelset HRU. ! -! Created by Shupeng Zhang, May 2023 -!------------------------------------------------------------------------------------ +! Created by Shupeng Zhang, May 2023 +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Pixelset @@ -31,7 +31,7 @@ MODULE MOD_LandHRU integer :: numhru type(grid_type) :: ghru type(pixelset_type) :: landhru - + type(subset_type) :: elm_hru CONTAINS @@ -69,7 +69,7 @@ SUBROUTINE landhru_build () IF (p_is_master) THEN write(*,'(A)') 'Making land hydro units :' ENDIF - + IF (p_is_master) THEN CALL ncio_read_serial (DEF_CatchmentMesh_data, 'basin_numhru', numhru_all_g) CALL ncio_read_serial (DEF_CatchmentMesh_data, 'lake_id', lakeid) @@ -91,11 +91,11 @@ SUBROUTINE landhru_build () nhru = sum(numhru_all_g(catnum)) CALL mpi_send (nhru, 1, MPI_INTEGER4, & - p_address_worker(iwork), mpi_tag_size, p_comm_glb, p_err) + p_address_worker(iwork), mpi_tag_size, p_comm_glb, p_err) ibuff = lakeid(catnum) CALL mpi_send (ibuff, ncat, MPI_INTEGER4, & - p_address_worker(iwork), mpi_tag_data, p_comm_glb, p_err) + p_address_worker(iwork), mpi_tag_data, p_comm_glb, p_err) deallocate(catnum) deallocate(ibuff ) @@ -104,10 +104,10 @@ SUBROUTINE landhru_build () ENDIF IF (p_is_worker) THEN - CALL mpi_send (numelm, 1, MPI_INTEGER4, p_address_master, mpi_tag_size, p_comm_glb, p_err) + CALL mpi_send (numelm, 1, MPI_INTEGER4, p_address_master, mpi_tag_size, p_comm_glb, p_err) IF (numelm > 0) THEN allocate (lakeid (numelm)) - CALL mpi_send (landelm%eindex, numelm, MPI_INTEGER8, p_address_master, mpi_tag_data, p_comm_glb, p_err) + CALL mpi_send (landelm%eindex, numelm, MPI_INTEGER8, p_address_master, mpi_tag_data, p_comm_glb, p_err) CALL mpi_recv (numhru, 1, MPI_INTEGER4, p_address_master, mpi_tag_size, p_comm_glb, p_stat, p_err) CALL mpi_recv (lakeid, numelm, MPI_INTEGER4, p_address_master, mpi_tag_data, p_comm_glb, p_stat, p_err) ELSE @@ -151,26 +151,26 @@ SUBROUTINE landhru_build () typsgn = 1 ENDIF - npxl = mesh(ie)%npxl - + npxl = mesh(ie)%npxl + allocate (types (1:npxl)) CALL aggregation_request_data (landelm, ie, ghru, zip = .false., & data_i4_2d_in1 = hrudata, data_i4_2d_out1 = ibuff) types = ibuff - + allocate (order (1:npxl)) order = (/ (ipxl, ipxl = 1, npxl) /) CALL quicksort (npxl, types, order) - + mesh(ie)%ilon(1:npxl) = mesh(ie)%ilon(order) mesh(ie)%ilat(1:npxl) = mesh(ie)%ilat(order) - + DO ipxl = 1, npxl IF (ipxl == 1) THEN - numhru = numhru + 1 + numhru = numhru + 1 landhru%eindex (numhru) = mesh(ie)%indx landhru%settyp (numhru) = types(ipxl) * typsgn landhru%ipxstt (numhru) = ipxl @@ -186,7 +186,7 @@ SUBROUTINE landhru_build () ENDIF ENDDO landhru%ipxend(numhru) = npxl - + deallocate (ibuff) deallocate (types) deallocate (order) @@ -199,8 +199,8 @@ SUBROUTINE landhru_build () ENDIF landhru%nset = numhru - CALL landhru%set_vecgs - + CALL landhru%set_vecgs + #ifdef USEMPI IF (p_is_worker) THEN CALL mpi_reduce (numhru, nhru_glb, 1, MPI_INTEGER, MPI_SUM, p_root, p_comm_worker, p_err) @@ -217,6 +217,6 @@ SUBROUTINE landhru_build () IF (allocated(lakeid)) deallocate(lakeid) END SUBROUTINE landhru_build - + END MODULE MOD_LandHRU #endif diff --git a/mksrfdata/MOD_LandPFT.F90 b/mksrfdata/MOD_LandPFT.F90 index 740bd84f..4d02d075 100644 --- a/mksrfdata/MOD_LandPFT.F90 +++ b/mksrfdata/MOD_LandPFT.F90 @@ -4,8 +4,8 @@ MODULE MOD_LandPFT -!------------------------------------------------------------------------------------ -! DESCRIPTION: +!----------------------------------------------------------------------- +! !DESCRIPTION: ! ! Build pixelset "landpft" (Plant Function Type). ! @@ -19,9 +19,9 @@ MODULE MOD_LandPFT ! ! "landpft" refers to pixelset PFT. ! -! Created by Shupeng Zhang, May 2023 +! Created by Shupeng Zhang, May 2023 ! porting codes from Hua Yuan's OpenMP version to MPI parallel version. -!------------------------------------------------------------------------------------ +!----------------------------------------------------------------------- USE MOD_Namelist USE MOD_Pixelset diff --git a/mksrfdata/MOD_LandPatch.F90 b/mksrfdata/MOD_LandPatch.F90 index 97269686..0477ca9c 100644 --- a/mksrfdata/MOD_LandPatch.F90 +++ b/mksrfdata/MOD_LandPatch.F90 @@ -2,8 +2,8 @@ MODULE MOD_LandPatch -!------------------------------------------------------------------------------------ -! DESCRIPTION: +!----------------------------------------------------------------------- +! !DESCRIPTION: ! ! Build pixelset "landpatch". ! @@ -17,9 +17,9 @@ MODULE MOD_LandPatch ! ! "landpatch" refers to pixelset PATCH. ! -! Created by Shupeng Zhang, May 2023 +! Created by Shupeng Zhang, May 2023 ! porting codes from Hua Yuan's OpenMP version to MPI parallel version. -!------------------------------------------------------------------------------------ +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Grid @@ -178,7 +178,7 @@ SUBROUTINE landpatch_build (lc_year) deallocate (ibuff) #ifdef SinglePoint - SITE_landtype = types(1) + SITE_landtype = types(1) #endif #ifdef CATCHMENT diff --git a/mksrfdata/MOD_LandUrban.F90 b/mksrfdata/MOD_LandUrban.F90 index 3778d58e..ecacf5e7 100644 --- a/mksrfdata/MOD_LandUrban.F90 +++ b/mksrfdata/MOD_LandUrban.F90 @@ -4,14 +4,12 @@ MODULE MOD_LandUrban !----------------------------------------------------------------------- ! ! !DESCRIPTION: -! ! Build pixelset "landurban". ! ! Original authors: Hua Yuan and Wenzong Dong, 2021, OpenMP version. ! ! ! !REVISIONS: -! ! 05/2023, Wenzong Dong, Hua Yuan, Shupeng Zhang: porting codes to MPI ! parallel version. ! diff --git a/mksrfdata/MOD_MeshFilter.F90 b/mksrfdata/MOD_MeshFilter.F90 index 9a8e1ae1..6ba1cc22 100644 --- a/mksrfdata/MOD_MeshFilter.F90 +++ b/mksrfdata/MOD_MeshFilter.F90 @@ -2,14 +2,14 @@ MODULE MOD_MeshFilter -!------------------------------------------------------------------------------------ -! DESCRIPTION: +!----------------------------------------------------------------------- +! !DESCRIPTION: ! ! Mesh filter. ! Mesh filter can be used to mask part of region or globe as needed. ! -! Created by Shupeng Zhang, May 2023 -!------------------------------------------------------------------------------------ +! Created by Shupeng Zhang, May 2023 +!----------------------------------------------------------------------- USE MOD_Grid IMPLICIT NONE diff --git a/mksrfdata/MOD_PixelsetShared.F90 b/mksrfdata/MOD_PixelsetShared.F90 index dbc8c054..b6de6c5b 100644 --- a/mksrfdata/MOD_PixelsetShared.F90 +++ b/mksrfdata/MOD_PixelsetShared.F90 @@ -1,13 +1,13 @@ #include MODULE MOD_PixelsetShared -!---------------------------------------------------------------------------------------- -! DESCRIPTION: +!----------------------------------------------------------------------- +! !DESCRIPTION: ! ! Shared pixelset refer to two or more pixelsets sharing the same geographic area. -! +! ! For example, for patch of crops, multiple crops can be planted on a piece of land. -! When planting these crops, different irrigation schemes may be used. Thus the water +! When planting these crops, different irrigation schemes may be used. Thus the water ! and energy processes have difference in crops and should be modeled independently. ! By using shared pixelset, crop patch is splitted to two or more shared patches. ! Each shared patch is assigned with a percentage of area and has its own states. @@ -15,13 +15,13 @@ MODULE MOD_PixelsetShared ! Example of shared pixelsets ! |<------------------- ELEMENT ------------------>| <-- level 1 ! | subset 1 | subset 2 | subset 3 | <-- level 2 -! | subset 2 shared 1 50% | +! | subset 2 shared 1 50% | ! | subset 2 shared 2 20% | <-- subset 2 shares -! | subset 2 shared 3 30% | +! | subset 2 shared 3 30% | ! ! -! Created by Shupeng Zhang, May 2023 -!---------------------------------------------------------------------------------------- +! Created by Shupeng Zhang, May 2023 +!----------------------------------------------------------------------- IMPLICIT NONE @@ -61,13 +61,13 @@ SUBROUTINE pixelsetshared_build (pixelset, gshared, datashared, nmaxshared, typf #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - + #ifdef USEMPI IF (p_is_io) THEN CALL aggregation_data_daemon (gshared, data_r8_3d_in1 = datashared, n1_r8_3d_in1 = nmaxshared) ENDIF #endif - + IF (p_is_worker) THEN nsetshared = 0 @@ -80,7 +80,7 @@ SUBROUTINE pixelsetshared_build (pixelset, gshared, datashared, nmaxshared, typf ie = pixelset%ielm (ipset) ipxstt = pixelset%ipxstt(ipset) ipxend = pixelset%ipxend(ipset) - + allocate (datashared1d (nmaxshared, ipxstt:ipxend)) CALL aggregation_request_data (pixelset, ipset, gshared, zip = .false., & @@ -111,7 +111,7 @@ SUBROUTINE pixelsetshared_build (pixelset, gshared, datashared, nmaxshared, typf ELSE nsetshared = nsetshared + 1 ENDIF - + ENDDO #ifdef USEMPI @@ -120,7 +120,7 @@ SUBROUTINE pixelsetshared_build (pixelset, gshared, datashared, nmaxshared, typf ENDIF IF (p_is_worker) THEN - + IF (pixelset%nset > 0) THEN allocate (eindex1(pixelset%nset)) @@ -205,7 +205,7 @@ SUBROUTINE pixelsetshared_build (pixelset, gshared, datashared, nmaxshared, typf ENDIF ENDIF - + CALL pixelset%set_vecgs END SUBROUTINE pixelsetshared_build diff --git a/mksrfdata/MOD_RegionClip.F90 b/mksrfdata/MOD_RegionClip.F90 index 37f441ca..ad09fe07 100644 --- a/mksrfdata/MOD_RegionClip.F90 +++ b/mksrfdata/MOD_RegionClip.F90 @@ -1,16 +1,17 @@ #include MODULE MOD_RegionClip -!----------------------------------------------------------------------------------------- -! DESCRIPTION: +!----------------------------------------------------------------------- +! !DESCRIPTION: ! -! This module includes subroutines to clip surface data from an existing data -! in a larger region. +! This module includes subroutines to clip surface data from an existing +! data in a larger region. ! -! Please use namelist variable "USE_srfdata_from_larger_region" to call these subroutines. +! Please use namelist variable "USE_srfdata_from_larger_region" to call +! these subroutines. ! -! Created by Shupeng Zhang, May 2023 -!----------------------------------------------------------------------------------------- +! Created by Shupeng Zhang, May 2023 +!----------------------------------------------------------------------- CONTAINS @@ -627,7 +628,7 @@ SUBROUTINE clip_vector (file_in, file_out, iblk, jblk, varname, vecmask) integer, allocatable :: data_i4_out1 (:) integer, allocatable :: data_i4_out2 (:,:) integer, allocatable :: data_i4_out3 (:,:,:) - + integer*8, allocatable :: data_i8_in1 (:) integer*8, allocatable :: data_i8_out1 (:) diff --git a/mksrfdata/MOD_SingleSrfdata.F90 b/mksrfdata/MOD_SingleSrfdata.F90 index e1e070fe..783be05f 100644 --- a/mksrfdata/MOD_SingleSrfdata.F90 +++ b/mksrfdata/MOD_SingleSrfdata.F90 @@ -2,13 +2,14 @@ #ifdef SinglePoint MODULE MOD_SingleSrfdata -!----------------------------------------------------------------------------------------- -! DESCRIPTION: +!----------------------------------------------------------------------- +! !DESCRIPTION: ! -! This module includes subroutines to read or write surface data for "SinglePoint". +! This module includes subroutines to read or write surface data for +! "SinglePoint". ! -! Created by Shupeng Zhang, May 2023 -!----------------------------------------------------------------------------------------- +! Created by Shupeng Zhang, May 2023 +!----------------------------------------------------------------------- USE MOD_Precision, only: r8 USE MOD_Vars_Global @@ -138,7 +139,7 @@ SUBROUTINE read_surface_data_single (fsrfdata, mksrfdata) USE MOD_NetCDFSerial USE MOD_Namelist USE MOD_Utils - USE MOD_Vars_Global, only : PI + USE MOD_Vars_Global, only: PI IMPLICIT NONE character(len=*), intent(in) :: fsrfdata diff --git a/mksrfdata/MOD_SrfdataDiag.F90 b/mksrfdata/MOD_SrfdataDiag.F90 index 6337f47b..ee29f91c 100644 --- a/mksrfdata/MOD_SrfdataDiag.F90 +++ b/mksrfdata/MOD_SrfdataDiag.F90 @@ -2,23 +2,25 @@ #ifdef SrfdataDiag MODULE MOD_SrfdataDiag -!----------------------------------------------------------------------------------------- -! DESCRIPTION: +!----------------------------------------------------------------------- +! !DESCRIPTION: ! -! This module includes subroutines for checking the results of making surface data. +! This module includes subroutines for checking the results of making +! surface data. ! -! The surface data in vector form is mapped to gridded data with last -! three dimensions of [type,longitude,latitude], which can be viewed by other softwares. +! The surface data in vector form is mapped to gridded data with last three +! dimensions of [type,longitude,latitude], which can be viewed by other +! softwares. ! -! In GRIDBASED, the grid of gridded data is just the grid of the mesh. -! In UNSTRUCTURED or CATCHMENT, the grid is user defined and the mapping uses area -! weighted scheme. +! In GRIDBASED, the grid of gridded data is just the grid of the mesh. In +! UNSTRUCTURED or CATCHMENT, the grid is user defined and the mapping uses +! area weighted scheme. ! -! Created by Shupeng Zhang, May 2023 +! Created by Shupeng Zhang, May 2023 ! -! Revisions: +! !REVISIONS: ! TODO -!----------------------------------------------------------------------------------------- +!----------------------------------------------------------------------- USE MOD_Grid USE MOD_SpatialMapping @@ -27,7 +29,7 @@ MODULE MOD_SrfdataDiag ! PUBLIC variables and subroutines type(grid_type) :: gdiag - + type(spatial_mapping_type) :: m_elm2diag type(spatial_mapping_type) :: m_patch2diag @@ -79,7 +81,7 @@ SUBROUTINE srfdata_diag_init (dir_landdata) ENDIF CALL srf_concat%set (gdiag) - + CALL m_elm2diag%build_arealweighted (gdiag, landelm) CALL m_patch2diag%build_arealweighted (gdiag, landpatch) @@ -101,7 +103,7 @@ SUBROUTINE srfdata_diag_init (dir_landdata) landname = trim(dir_landdata)//'/diag/element.nc' CALL srfdata_map_and_write (elmid_r8, landelm%settyp, (/0/), m_elm2diag, & -1.0e36_r8, landname, 'element', compress = 1, write_mode = 'one') - + IF (p_is_worker) deallocate (elmid_r8) typindex = (/(ityp, ityp = 0, N_land_classification)/) diff --git a/mksrfdata/MOD_SrfdataRestart.F90 b/mksrfdata/MOD_SrfdataRestart.F90 index 6ae8b3c6..9e791d13 100644 --- a/mksrfdata/MOD_SrfdataRestart.F90 +++ b/mksrfdata/MOD_SrfdataRestart.F90 @@ -1,13 +1,13 @@ #include MODULE MOD_SrfdataRestart -!------------------------------------------------------------------------------------ -! DESCRIPTION: +!----------------------------------------------------------------------- +! !DESCRIPTION: ! ! This module includes subroutines to read/write data of mesh and pixelsets. ! -! Created by Shupeng Zhang, May 2023 -!------------------------------------------------------------------------------------ +! Created by Shupeng Zhang, May 2023 +!----------------------------------------------------------------------- IMPLICIT NONE diff --git a/postprocess/MOD_Concatenate.F90 b/postprocess/MOD_Concatenate.F90 index c5b40282..3d6faf84 100644 --- a/postprocess/MOD_Concatenate.F90 +++ b/postprocess/MOD_Concatenate.F90 @@ -7,7 +7,7 @@ MODULE mod_concatenate USE MOD_Block USE MOD_NetCDFSerial USE netcdf - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE type :: segment_type diff --git a/postprocess/MOD_Vector2Grid.F90 b/postprocess/MOD_Vector2Grid.F90 index 59fdbe9f..23da8e2a 100644 --- a/postprocess/MOD_Vector2Grid.F90 +++ b/postprocess/MOD_Vector2Grid.F90 @@ -6,7 +6,7 @@ MODULE mod_vector2grid USE MOD_Precision USE MOD_NetCDFSerial USE netcdf - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE integer :: ndim1out, ndim2out diff --git a/preprocess/aggregation_landtypes.F90 b/preprocess/aggregation_landtypes.F90 index 2af9367d..23f4ce2f 100644 --- a/preprocess/aggregation_landtypes.F90 +++ b/preprocess/aggregation_landtypes.F90 @@ -8,15 +8,15 @@ SUBROUTINE aggregation_landtypes ( dir_rawdata,dir_model_landdata, & sinn,sins,lonw_rad,lone_rad,sinn_i,sins_i,lonw_rad_i,lone_rad_i,& READ_row_UB,READ_row_LB,READ_col_UB,READ_col_LB) ! ---------------------------------------------------------------------- -! Creates land model surface dataset from original "raw" data files - +! Creates land model surface dataset from original "raw" data files - ! data with 30 arc seconds resolution ! -! Created by Yongjiu Dai, 02/2014 -! ________________ -! REVISION HISTORY: -! /07/2014, Siguang Zhu & Xiangxiang Zhang: weight average considering -! partial overlap between fine grid and model grid for a user -! defined domain file. +! Created by Yongjiu Dai, 02/2014 +! +! !REVISIONS: +! /07/2014, Siguang Zhu & Xiangxiang Zhang: weight average considering +! partial overlap between fine grid and model grid for a user +! defined domain file. ! ! ---------------------------------------------------------------------- use MOD_Precision diff --git a/preprocess/rawdata_soil_hydraulic_parameters.F90 b/preprocess/rawdata_soil_hydraulic_parameters.F90 index 18574062..ca7e042b 100644 --- a/preprocess/rawdata_soil_hydraulic_parameters.F90 +++ b/preprocess/rawdata_soil_hydraulic_parameters.F90 @@ -4,37 +4,39 @@ SUBROUTINE soil_hydraulic_parameters(BD,SAND,CLAY,SOC,SOILDEPTH,& VGM_theta_r_Rose,VGM_alpha_Rose,VGM_n_Rose,k_s_Rose) !----------------------------------------------------------------------- -! DESCRIPTION: -! Calculate soil hydraulic parameters of soil water retension models (Brooks and Corey, 1964 & van Genuchten, 1980) -! and soil saturated hydraulic conductivity with multiple soil Pedotransfer functions by using the rawdata soil properties. -! -! REFERENCES: -! (1) Dai et al.,2013: Development of a China Dataset of Soil -! Hydraulic Parameters Using Pedotransfer Functions for Land Surface Modeling. -! J. of Hydrometeorology, 14: 869-887. DOI: 10.1175/JHM-D-12-0149.1 -! (2) Dai et al.,2019: A Global High-Resolution Data Set of Soil Hydraulic and Thermal Properties -! for Land Surface Modeling. J. of Advances in Modeling Earth Systems, DOI: 10.1029/2019MS001784 -! -! Original author: Yongjiu Dai, Wei Shangguan, 12/2013/ -! -! Revisions: -! Yongjiu Dai, Nan Wei and Yonggen Zhang, -! 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 +! !DESCRIPTION: +! Calculate soil hydraulic parameters of soil water retension models +! (Brooks and Corey, 1964 & van Genuchten, 1980) and soil saturated +! hydraulic conductivity with multiple soil Pedotransfer functions by +! using the rawdata soil properties. +! +! !REFERENCES: +! (1) Dai et al.,2013: Development of a China Dataset of Soil +! Hydraulic Parameters Using Pedotransfer Functions for Land Surface Modeling. +! J. of Hydrometeorology, 14: 869-887. DOI: 10.1175/JHM-D-12-0149.1 +! (2) Dai et al.,2019: A Global High-Resolution Data Set of Soil Hydraulic and Thermal Properties +! for Land Surface Modeling. J. of Advances in Modeling Earth Systems, DOI: 10.1029/2019MS001784 +! +! Original author: Yongjiu Dai, Wei Shangguan, 12/2013/ +! +! !REVISIONS: +! Yongjiu Dai, Nan Wei and Yonggen Zhang, +! 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 ! ---------------------------------------------------------------------- use MOD_Precision IMPLICIT NONE -real(r8), intent(in) :: SAND ! percent sand particle-size distribution (%, weight) -real(r8), intent(in) :: CLAY ! percent clay particle-size distribution (%, weight) -real(r8), intent(in) :: SOC ! soil organic carbon concentration (%, weight) -real(r8), intent(in) :: BD ! bulk density (g cm-3) -real(r8), intent(in) :: SOILDEPTH ! soil depth (cm) -real(r8), intent(in) :: vf_gravels_ss! volumetric fraction of gravels -real(r8), intent(in) :: phi ! saturated water content (cm3/cm3) +real(r8), intent(in) :: SAND ! percent sand particle-size distribution (%, weight) +real(r8), intent(in) :: CLAY ! percent clay particle-size distribution (%, weight) +real(r8), intent(in) :: SOC ! soil organic carbon concentration (%, weight) +real(r8), intent(in) :: BD ! bulk density (g cm-3) +real(r8), intent(in) :: SOILDEPTH ! soil depth (cm) +real(r8), intent(in) :: vf_gravels_ss ! volumetric fraction of gravels +real(r8), intent(in) :: phi ! saturated water content (cm3/cm3) real(r8), intent(in) :: VGM_theta_r_Rose ! residual moisture content by Rosetta H3 real(r8), intent(in) :: VGM_alpha_Rose ! a parameter corresponding approximately to the inverse of the air-entry value by Rosetta H3 real(r8), intent(in) :: VGM_n_Rose ! a shape parameter by Rosetta H3 @@ -43,12 +45,12 @@ SUBROUTINE soil_hydraulic_parameters(BD,SAND,CLAY,SOC,SOILDEPTH,& real(r8), intent(out) :: CampBC_psi_s ! matric potential at saturation (cm) real(r8), intent(out) :: CampBC_lambda_s ! pore size distribution index (dimensionless) -real(r8), intent(out) :: k_s ! saturated hydraulic conductivity (cm/day) +real(r8), intent(out) :: k_s ! saturated hydraulic conductivity (cm/day) -real(r8), intent(out) :: VGM_theta_r ! residual moisture content -real(r8), intent(out) :: VGM_alpha ! a parameter corresponding approximately to the inverse of the air-entry value -real(r8), intent(out) :: VGM_n ! a shape parameter -real(r8), intent(out) :: VGM_L ! pore-connectivity parameter +real(r8), intent(out) :: VGM_theta_r ! residual moisture content +real(r8), intent(out) :: VGM_alpha ! a parameter corresponding approximately to the inverse of the air-entry value +real(r8), intent(out) :: VGM_n ! a shape parameter +real(r8), intent(out) :: VGM_L ! pore-connectivity parameter real(r8) SOM, TOPSOIL, BD_om, BD_minerals,a,vf_gravels_s @@ -310,11 +312,11 @@ SUBROUTINE CampBC(BD,SAND,CLAY,SOM,SOC,phi,psi_s,lambda_s) if(lambda(i) > 1. .or. lambda(i) <= 0.) then lambda(i)=-1.0e36 ydatc(i,:)=-1.0e36 - end if + endif if(psi(i) < -300. .or. psi(i) >= 0.) then psi(i)=-1.0e36 ydatc(i,:)=-1.0e36 - end if + endif enddo m = 0 @@ -322,7 +324,7 @@ SUBROUTINE CampBC(BD,SAND,CLAY,SOM,SOC,phi,psi_s,lambda_s) if(abs(ydatc(i,1)) < 1.0e10) then m = m+1 ydatc(m,:) = ydatc(i,:) - end if + endif enddo ldfjac = npoint @@ -353,7 +355,7 @@ SUBROUTINE CampBC(BD,SAND,CLAY,SOM,SOC,phi,psi_s,lambda_s) if( x(1) >= -300. .and. x(1) < 0.0 .and. x(2) > 0.0 .and. x(2) <= 1.0 .and. isiter == 1)then psi_s = x(1) lambda_s = x(2) - end if + endif deallocate(fjac) deallocate(fvec) @@ -603,7 +605,7 @@ SUBROUTINE VGM(BD,sand,clay,SOM,SOC,TOPSOIL,phi,theta_r_l,alpha_l,n_l,L_l,& ydatv(6,:) = -1.0e36 else ydatv(6,:) = theta_r(6)+(phi - theta_r(6))*(1+(alpha(6)*xdat)**n(6))**(1.0/n(6)-1) - end if + endif ! ------------------------------------------ ! 7) Gupta, S.C., and W.E. Larson. 1979. Estimating soil water retention characteristics from @@ -687,15 +689,15 @@ SUBROUTINE VGM(BD,sand,clay,SOM,SOC,TOPSOIL,phi,theta_r_l,alpha_l,n_l,L_l,& if(theta_r(i) > phi .or. theta_r(i) < 0.0) then theta_r(i)=-1.0e36 ydatv(i,:)=-1.0e36 - end if + endif if(alpha(i) < 1.0e-5 .or. alpha(i) > 1.0) then alpha(i) =-1.0e36 ydatv(i,:)=-1.0e36 - end if + endif if(n(i) < 1.1 .or. n(i) > 10.0) then n(i) =-1.0e36 ydatv(i,:)=-1.0e36 - end if + endif enddo m = 0 @@ -703,7 +705,7 @@ SUBROUTINE VGM(BD,sand,clay,SOM,SOC,TOPSOIL,phi,theta_r_l,alpha_l,n_l,L_l,& if(abs(ydatv(i,1)) < 1.0e10) then m = m+1 ydatv(m,:) = ydatv(i,:) - end if + endif enddo ldfjac = npoint @@ -739,7 +741,7 @@ SUBROUTINE VGM(BD,sand,clay,SOM,SOC,TOPSOIL,phi,theta_r_l,alpha_l,n_l,L_l,& theta_r_l = x(1) alpha_l = x(2) n_l = x(3) - end if + endif deallocate(fjac) deallocate(fvec) @@ -1545,7 +1547,7 @@ SUBROUTINE Rajkai(Clay,Sand,BD,OC,Theta) End select Theta(i)=(b(1,i)+b(2,i)*X1+b(3,i)*X2+b(4,i)*X1*X2+b(5,i)*X1*X1 & +b(6,i)*X2*X2)/100. - end do + enddo END SUBROUTINE Rajkai SUBROUTINE Rawls82(Clay,Silt,Sand,OC,Theta) @@ -1833,7 +1835,7 @@ SUBROUTINE model(b,np,y,nob,x) if(b(4) .lt. 1.1) b(4) = 1.1 do i = 1,nob y(i)=b(1)+(b(2)-b(1))/(1+(b(3)*x(i))**b(4))**(1.-1/b(4)) - end do + enddo END SUBROUTINE model @@ -1863,27 +1865,27 @@ subroutine SW_CB_dist ( m, n, x, fvec, fjac, ldfjac, iflag, xdat, npoint, ydatc, if (x(1) >= 0.0) then isiter = 0 return - end if + endif do i = 1, m fvec(i) = sum(((-1.0*xdat(i)/x(1))**(-1.0*x(2)) * phi - ydatc(:,i))**2) - end do + enddo else if ( iflag == 2 ) then if (x(1) >= 0.0) then isiter = 0 return - end if + endif do i = 1, m fjac(i,1) = sum(2.0*((-1.0*xdat(i)/x(1))**(-1.0*x(2)) * phi - ydatc(:,i))*& phi * x(2) * (-1.0*xdat(i)/x(1))**(-1.0*x(2)) / x(1)) fjac(i,2) = sum(-2.0*((-1.0*xdat(i)/x(1))**(-1.0*x(2)) * phi - ydatc(:,i))*& phi * (-1.0*xdat(i)/x(1))**(-1.0*x(2)) * log(-1.0*xdat(i)/x(1))) - end do + enddo - end if + endif end subroutine SW_CB_dist @@ -1913,18 +1915,18 @@ subroutine SW_VG_dist ( m, n, x, fvec, fjac, ldfjac, iflag, xdat, npoint, ydatv, if (x(2) <= 0.0 .or. x(3) <= 0.1) then isiter = 0 return - end if + 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))**2) - end do + enddo else if ( iflag == 2 ) then if (x(2) <= 0.0 .or. x(3) <= 0.1) then isiter = 0 return - end if + endif do i = 1, m fjac(i,1) = sum(2*(x(1) + (phi - x(1))*(1+(x(2)*xdat(i))**x(3))**(1.0/x(3)-1) - ydatv(:,i))*& @@ -1935,8 +1937,8 @@ subroutine SW_VG_dist ( m, n, x, fvec, fjac, ldfjac, iflag, xdat, npoint, ydatv, (phi - x(1)) * (1+(x(2)*xdat(i))**x(3))**(1.0/x(3)-1) *& ((1.0-x(3))*(x(2)*xdat(i))**x(3)*log(x(2)*xdat(i))/(x(3)*(1+(x(2)*xdat(i))**x(3))) & - log(1+(x(2)*xdat(i))**x(3))/x(3)**2)) - end do + enddo - end if + endif end subroutine SW_VG_dist diff --git a/preprocess/rawdata_soil_solids_fractions.F90 b/preprocess/rawdata_soil_solids_fractions.F90 index b4308ef2..c7b05477 100644 --- a/preprocess/rawdata_soil_solids_fractions.F90 +++ b/preprocess/rawdata_soil_solids_fractions.F90 @@ -5,19 +5,19 @@ SUBROUTINE soil_solids_fractions(BD,gravels,SOC,SAND,CLAY,& vf_quartz_mineral_s,BD_mineral_s,OM_density,BD_ave) !------------------------------------------------------------------------------- -! DESCRIPTION: -! Calculate soil porocity and The volumetric fractions of soil solids needed for soil parameter estimations. -! Theta = 1 - BD/PD +! !DESCRIPTION: +! Calculate soil porocity and The volumetric fractions of soil solids needed for soil parameter estimations. +! Theta = 1 - BD/PD ! -! REFERENCE: -! Dai et al.,2019: A Global High-Resolution Data Set of Soil Hydraulic and Thermal Properties -! for Land Surface Modeling. J. of Advances in Modeling Earth Systems, DOI: 10.1029/2019MS001784 +! !REFERENCE: +! Dai et al.,2019: A Global High-Resolution Data Set of Soil Hydraulic and Thermal Properties +! for Land Surface Modeling. J. of Advances in Modeling Earth Systems, DOI: 10.1029/2019MS001784 ! -! Original author: Yongjiu Dai, 01/2018 +! Original author: Yongjiu Dai, 01/2018 ! -! Revisions: -! Nan Wei, 06/2018: add to CoLM/mksrfdata -! Nan Wei, 01/2020: update paticle size of soil solids and gravel porosity +! !REVISIONS: +! Nan Wei, 06/2018: add to CoLM/mksrfdata +! Nan Wei, 01/2020: update paticle size of soil solids and gravel porosity !------------------------------------------------------------------------------- use MOD_Precision @@ -109,7 +109,7 @@ SUBROUTINE soil_solids_fractions(BD,gravels,SOC,SAND,CLAY,& if(vf_pores_s <= 0.0) then write(6,*)"Error: negative soil porosity. BD, PD = ",BD_ave,BD_particle stop - end if + endif ! Bulk density of mineral soil BD_mineral_s = (BD_ave - vf_om_s*BD_om - vf_gravels_s*BD_gravels) & @@ -181,7 +181,7 @@ SUBROUTINE vf_quartz(sand,clay,vf_quartz_s) if(sand<0. .or. silt<0. .or. clay<0.)then print*,'Each of the 3 variables should be >= 0: check the data' call abort - end if + endif CALL USDA_soil_classes(silt,clay,c) @@ -268,10 +268,10 @@ SUBROUTINE USDA_soil_classes(x,y,c) do j = 1, PONUM(i) xpol(j) = xpos(points(i,j)) ypol(j) = ypos(points(i,j)) - end do + enddo call pointinpolygon(x,y,xpol(1:PONUM(i)),ypol(1:PONUM(i)),PONUM(i),c(i)) - end do + enddo END SUBROUTINE USDA_soil_classes @@ -312,7 +312,7 @@ SUBROUTINE pointinpolygon(xp,yp,xpol,ypol,ponum,c) if(( xpol(i) - xp )==0 .AND. ( ypol(i) - yp )==0 )then c2 = 'v' exit - end if + endif i1 = mod(( i-2 + ponum ), ponum) + 1 ! if e "straddles" the x-axis... @@ -323,8 +323,8 @@ SUBROUTINE pointinpolygon(xp,yp,xpol,ypol,ponum,c) ! crosses ray if strictly positive intersection. if(x > 0)then Rcross=Rcross+1 - end if - end if + endif + endif ! if e straddles the x-axis when reversed... if( (( ypol(i) - yp ) < 0 ) .NEQV. (( ypol(i1) - yp ) < 0 ) )then @@ -334,10 +334,10 @@ SUBROUTINE pointinpolygon(xp,yp,xpol,ypol,ponum,c) ! crosses ray if strictly positive intersection. if(x < 0)then Lcross=Lcross+1 - end if - end if + endif + endif - end do + enddo ! q on the edge if left and right cross are not the same parity / if(c2=='v')then @@ -352,6 +352,6 @@ SUBROUTINE pointinpolygon(xp,yp,xpol,ypol,ponum,c) else c = .false. c2 = 'o' - end if + endif END SUBROUTINE pointinpolygon diff --git a/preprocess/rawdata_soil_thermal_parameters.F90 b/preprocess/rawdata_soil_thermal_parameters.F90 index 9f60839c..46360db5 100644 --- a/preprocess/rawdata_soil_thermal_parameters.F90 +++ b/preprocess/rawdata_soil_thermal_parameters.F90 @@ -6,21 +6,21 @@ SUBROUTINE soil_thermal_parameters(wf_gravels_s,wf_sand_s,wf_clay_s,& csol,kdry,ksat_u,ksat_f) !------------------------------------------------------------------------------------------ -! DESCRIPTION: -! Calculate volumetric soil heat capacity and soil thermal conductivity with 8 optional schemes by using the rawdata soil properties. -! The default soil thermal conductivity scheme is the fourth one (Balland V. and P. A. Arp, 2005) +! !DESCRIPTION: +! Calculate volumetric soil heat capacity and soil thermal conductivity with 8 optional schemes by using the rawdata soil properties. +! 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/mksrfdata -! Nan Wei, 01/2020: update thermal conductivity of gravels -! Nan Wei, 09/2022: add soil thermal conductivity of Hailong He (Yan & He et al., 2019) -! ----------------------------------------------------------------------------------------- +! !REVISIONS: +! Nan Wei, 06/2018: add to CoLM/mksrfdata +! Nan Wei, 01/2020: update thermal conductivity of gravels +! Nan Wei, 09/2022: add soil thermal conductivity of Hailong He (Yan & He et al., 2019) +!------------------------------------------------------------------------------------------ use MOD_Precision USE MOD_Namelist diff --git a/preprocess/rawdata_to_hdf5.F90 b/preprocess/rawdata_to_hdf5.F90 index b174cd34..1f7495bd 100644 --- a/preprocess/rawdata_to_hdf5.F90 +++ b/preprocess/rawdata_to_hdf5.F90 @@ -1,4 +1,4 @@ -program bin_to_hdf5 +program bin_to_hdf5 use MOD_Precision use colm_io_serial @@ -6,7 +6,7 @@ program bin_to_hdf5 integer, parameter :: nlat = 21600 integer, parameter :: nlon = 43200 - + integer, parameter :: nxblk = 5 integer, parameter :: nyblk = 5 @@ -37,10 +37,10 @@ program bin_to_hdf5 allocate (a_chr1 (nlon,nlat)) iunit = 100 inquire (iolength=length) a_chr1 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_chr1 (:,irow) - end do + enddo close (iunit) allocate (a_int8 (nlon, nlat)) @@ -55,30 +55,30 @@ program bin_to_hdf5 deallocate (a_chr1) deallocate (a_int8) - + !------------------------------- lndname = trim(bindir) // 'glacier/glacier.bin' allocate (a_int16 (nlon,nlat)) iunit = 100 inquire (iolength=length) a_int16 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_int16 (:,irow) - end do + enddo close (iunit) lndname = trim(h5dir) // 'glacier.h5' call colm_create_file (lndname) - call colm_write_serial (lndname, '/glacier', a_int16, & + call colm_write_serial (lndname, '/glacier', a_int16, & compress, chunk = (/ nlon/nxblk, nlat/nyblk /)) write(*,*) 'Glacier done' deallocate (a_int16) - + !------------------------------- - + allocate (a_chr1 (nlon,nlat)) allocate (a_int8 (nlon, nlat)) @@ -92,10 +92,10 @@ program bin_to_hdf5 iunit = 100 inquire (iolength=length) a_chr1 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_chr1 (:,irow) - end do + enddo close (iunit) a_int8 = ichar(a_chr1) @@ -106,7 +106,7 @@ program bin_to_hdf5 compress, chunk = (/ nlon/nxblk, nlat/nyblk /)) write(*,*) 'lai ' // trim(c) // ' done' - end do + enddo deallocate (a_chr1) deallocate (a_int8) @@ -117,10 +117,10 @@ program bin_to_hdf5 allocate (a_int16 (nlon,nlat)) iunit = 100 inquire (iolength=length) a_int16 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_int16 (:,irow) - end do + enddo close (iunit) lndname = trim(h5dir) // 'lake_depth.h5' @@ -138,10 +138,10 @@ program bin_to_hdf5 allocate (a_chr1 (nlon,nlat)) iunit = 100 inquire (iolength=length) a_chr1 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_chr1 (:,irow) - end do + enddo close (iunit) allocate (a_int8 (nlon, nlat)) @@ -149,24 +149,24 @@ program bin_to_hdf5 lndname = trim(h5dir) // 'lake_wetland.h5' call colm_create_file (lndname) - call colm_write_serial (lndname, '/lake_wetland', a_int8, & + call colm_write_serial (lndname, '/lake_wetland', a_int8, & compress, chunk = (/ nlon/nxblk, nlat/nyblk /)) write(*,*) 'Lake wetland done' deallocate (a_chr1) deallocate (a_int8) - + !------------------------------- lndname = trim(bindir) // 'RAW_DATA_updated/landtypes_usgs_update.bin' allocate (a_chr1 (nlon,nlat)) iunit = 100 inquire (iolength=length) a_chr1 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_chr1 (:,irow) - end do + enddo close (iunit) allocate (a_int8 (nlon, nlat)) @@ -181,17 +181,17 @@ program bin_to_hdf5 deallocate (a_chr1) deallocate (a_int8) - + !------------------------------- lndname = trim(bindir) // 'soil_brightness/soilcol_clm_30s.bin' allocate (a_chr1 (nlon,nlat)) iunit = 100 inquire (iolength=length) a_chr1 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_chr1 (:,irow) - end do + enddo close (iunit) allocate (a_int8 (nlon, nlat)) @@ -199,17 +199,17 @@ program bin_to_hdf5 lndname = trim(h5dir) // 'soil_brightness.h5' call colm_create_file (lndname) - call colm_write_serial (lndname, '/soil_brightness', a_int8, & + call colm_write_serial (lndname, '/soil_brightness', a_int8, & compress, chunk = (/ nlon/nxblk, nlat/nyblk /)) write(*,*) 'Soil brightness done' deallocate (a_chr1) deallocate (a_int8) - + !------------------------------- allocate (a_real8 (nlon,nlat)) - + call execute_command_line ('mkdir -p ' // trim(h5dir) // '/soil') lndname = trim(h5dir) // 'soil/theta_s.h5' @@ -217,7 +217,7 @@ program bin_to_hdf5 lndname = trim(h5dir) // 'soil/psi_s.h5' call colm_create_file (lndname) - + lndname = trim(h5dir) // 'soil/lambda.h5' call colm_create_file (lndname) @@ -237,14 +237,14 @@ program bin_to_hdf5 write(c,'(i1)') n8 ! (1) Read in the saturated water content [cm3/cm3] - lndname = trim(bindir) // 'RAW_DATA_updated/theta_s_l'//trim(c) + lndname = trim(bindir) // 'RAW_DATA_updated/theta_s_l'//trim(c) iunit = 100 inquire (iolength=length) a_real8 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_real8 (:,irow) - end do + enddo close (iunit) lndname = trim(h5dir) // 'soil/theta_s.h5' @@ -254,31 +254,31 @@ program bin_to_hdf5 write(*,*) 'Theta_s_l' // trim(c) // ' done' ! (2) Read in the matric potential at saturation [cm] - lndname = trim(bindir) // 'RAW_DATA_updated/psi_s_l'//trim(c) + lndname = trim(bindir) // 'RAW_DATA_updated/psi_s_l'//trim(c) iunit = 100 inquire (iolength=length) a_real8 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_real8 (:,irow) - end do + enddo close (iunit) lndname = trim(h5dir) // 'soil/psi_s.h5' - call colm_write_serial (lndname, 'psi_s_l'//trim(c), a_real8, & + call colm_write_serial (lndname, 'psi_s_l'//trim(c), a_real8, & compress, chunk = (/ nlon/nxblk, nlat/nyblk /)) write(*,*) 'psi_s_l' // trim(c) // ' done' ! (3) Read in the pore size distribution index [dimensionless] - lndname = trim(bindir) // 'RAW_DATA_updated/lambda_l'//trim(c) + lndname = trim(bindir) // 'RAW_DATA_updated/lambda_l'//trim(c) iunit = 100 inquire (iolength=length) a_real8 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_real8 (:,irow) - end do + enddo close (iunit) lndname = trim(h5dir) // 'soil/lambda.h5' @@ -288,14 +288,14 @@ program bin_to_hdf5 write(*,*) 'lambda_l' // trim(c) // ' done' ! (4) Read in the saturated hydraulic conductivity [cm/day] - lndname = trim(bindir) // 'RAW_DATA_updated/k_s_l'//trim(c) + lndname = trim(bindir) // 'RAW_DATA_updated/k_s_l'//trim(c) iunit = 100 inquire (iolength=length) a_real8 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_real8 (:,irow) - end do + enddo close (iunit) lndname = trim(h5dir) // 'soil/k_s.h5' @@ -305,14 +305,14 @@ program bin_to_hdf5 write(*,*) 'k_s_l' // trim(c) // ' done' ! (5) Read in the heat capacity of soil solids [J/(m3 K)] - lndname = trim(bindir) // 'RAW_DATA_updated/csol_l'//trim(c) + lndname = trim(bindir) // 'RAW_DATA_updated/csol_l'//trim(c) iunit = 100 inquire (iolength=length) a_real8 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_real8 (:,irow) - end do + enddo close (iunit) lndname = trim(h5dir) // 'soil/csol.h5' @@ -322,14 +322,14 @@ program bin_to_hdf5 write(*,*) 'csol_l' // trim(c) // ' done' ! (6) Read in the thermal conductivity of saturated soil [W/m-K] - lndname = trim(bindir) // 'RAW_DATA_updated/tksatu_l'//trim(c) + lndname = trim(bindir) // 'RAW_DATA_updated/tksatu_l'//trim(c) iunit = 100 inquire (iolength=length) a_real8 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_real8 (:,irow) - end do + enddo close (iunit) lndname = trim(h5dir) // 'soil/tksatu.h5' @@ -339,14 +339,14 @@ program bin_to_hdf5 write(*,*) 'tksatu_l' // trim(c) // ' done' ! (7) Read in the thermal conductivity for dry soil [W/(m-K)] - lndname = trim(bindir) // 'RAW_DATA_updated/tkdry_l'//trim(c) + lndname = trim(bindir) // 'RAW_DATA_updated/tkdry_l'//trim(c) iunit = 100 inquire (iolength=length) a_real8 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_real8 (:,irow) - end do + enddo close (iunit) lndname = trim(h5dir) // 'soil/tkdry.h5' @@ -355,7 +355,7 @@ program bin_to_hdf5 write(*,*) 'tkdry_l' // trim(c) // ' done' - end do + enddo deallocate (a_real8) diff --git a/preprocess/rawdata_to_nc.F90 b/preprocess/rawdata_to_nc.F90 index 7e74012c..6885988f 100644 --- a/preprocess/rawdata_to_nc.F90 +++ b/preprocess/rawdata_to_nc.F90 @@ -6,7 +6,7 @@ program rawdata_to_nc integer, parameter :: nlat = 21600 integer, parameter :: nlon = 43200 - + integer, parameter :: nxblk = 5 integer, parameter :: nyblk = 5 @@ -27,14 +27,14 @@ program rawdata_to_nc character(len=256) :: c integer, parameter :: compress = 1 - + INTEGER :: ilat, ilon REAL(r8) :: del_lat, del_lon REAL(r8) :: lat_s(nlat), lat_n(nlat), lon_w(nlon), lon_e(nlon) call getarg (1, bindir) call getarg (2, ncdir) - + del_lat = 180.0_r8 / nlat DO ilat = 1, nlat lat_s(ilat) = 90.0_r8 - del_lat * ilat @@ -53,10 +53,10 @@ program rawdata_to_nc allocate (a_chr1 (nlon,nlat)) iunit = 100 inquire (iolength=length) a_chr1 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_chr1 (:,irow) - end do + enddo close (iunit) allocate (a_int8 (nlon, nlat)) @@ -74,32 +74,32 @@ program rawdata_to_nc deallocate (a_chr1) deallocate (a_int8) - + !------------------------------- lndname = trim(bindir) // '/glacier/glacier.bin' allocate (a_int16 (nlon,nlat)) iunit = 100 inquire (iolength=length) a_int16 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_int16 (:,irow) - end do + enddo close (iunit) lndname = trim(ncdir) // '/glacier.nc' call ncio_create_file (lndname) CALL ncio_define_dimension (lndname, 'latitude', nlat) CALL ncio_define_dimension (lndname, 'longitude', nlon) - call ncio_write_serial (lndname, 'glacier', a_int16, & + call ncio_write_serial (lndname, 'glacier', a_int16, & 'longitude', 'latitude', compress) write(*,*) 'Glacier done' deallocate (a_int16) - + !------------------------------- - + allocate (a_chr1 (nlon,nlat)) allocate (a_int8 (nlon, nlat)) @@ -113,10 +113,10 @@ program rawdata_to_nc iunit = 100 inquire (iolength=length) a_chr1 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_chr1 (:,irow) - end do + enddo close (iunit) a_int8 = ichar(a_chr1) @@ -129,7 +129,7 @@ program rawdata_to_nc 'longitude', 'latitude', compress) write(*,*) 'lai ' // trim(c) // ' done' - end do + enddo deallocate (a_chr1) deallocate (a_int8) @@ -140,10 +140,10 @@ program rawdata_to_nc allocate (a_int16 (nlon,nlat)) iunit = 100 inquire (iolength=length) a_int16 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_int16 (:,irow) - end do + enddo close (iunit) lndname = trim(ncdir) // '/lake_depth.nc' @@ -163,10 +163,10 @@ program rawdata_to_nc allocate (a_chr1 (nlon,nlat)) iunit = 100 inquire (iolength=length) a_chr1 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_chr1 (:,irow) - end do + enddo close (iunit) allocate (a_int8 (nlon, nlat)) @@ -176,24 +176,24 @@ program rawdata_to_nc call ncio_create_file (lndname) CALL ncio_define_dimension (lndname, 'latitude', nlat) CALL ncio_define_dimension (lndname, 'longitude', nlon) - call ncio_write_serial (lndname, 'lake_wetland', a_int8, & + call ncio_write_serial (lndname, 'lake_wetland', a_int8, & 'longitude', 'latitude', compress) write(*,*) 'Lake wetland done' deallocate (a_chr1) deallocate (a_int8) - + !------------------------------- lndname = trim(bindir) // '/RAW_DATA_updated/landtypes_usgs_update.bin' allocate (a_chr1 (nlon,nlat)) iunit = 100 inquire (iolength=length) a_chr1 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_chr1 (:,irow) - end do + enddo close (iunit) allocate (a_int8 (nlon, nlat)) @@ -210,17 +210,17 @@ program rawdata_to_nc deallocate (a_chr1) deallocate (a_int8) - + !------------------------------- lndname = trim(bindir) // '/soil_brightness/soilcol_clm_30s.bin' allocate (a_chr1 (nlon,nlat)) iunit = 100 inquire (iolength=length) a_chr1 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_chr1 (:,irow) - end do + enddo close (iunit) allocate (a_int8 (nlon, nlat)) @@ -230,17 +230,17 @@ program rawdata_to_nc call ncio_create_file (lndname) CALL ncio_define_dimension (lndname, 'latitude', nlat) CALL ncio_define_dimension (lndname, 'longitude', nlon) - call ncio_write_serial (lndname, 'soil_brightness', a_int8, & + call ncio_write_serial (lndname, 'soil_brightness', a_int8, & 'longitude', 'latitude', compress) write(*,*) 'Soil brightness done' deallocate (a_chr1) deallocate (a_int8) - + !------------------------------- allocate (a_real8 (nlon,nlat)) - + call execute_command_line ('mkdir -p ' // trim(ncdir) // '/soil') lndname = trim(ncdir) // '/soil/theta_s.nc' @@ -252,7 +252,7 @@ program rawdata_to_nc call ncio_create_file (lndname) CALL ncio_define_dimension (lndname, 'latitude', nlat) CALL ncio_define_dimension (lndname, 'longitude', nlon) - + lndname = trim(ncdir) // '/soil/lambda.nc' call ncio_create_file (lndname) CALL ncio_define_dimension (lndname, 'latitude', nlat) @@ -282,14 +282,14 @@ program rawdata_to_nc write(c,'(i1)') n8 ! (1) Read in the saturated water content [cm3/cm3] - lndname = trim(bindir) // '/RAW_DATA_updated/theta_s_l'//trim(c) + lndname = trim(bindir) // '/RAW_DATA_updated/theta_s_l'//trim(c) iunit = 100 inquire (iolength=length) a_real8 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_real8 (:,irow) - end do + enddo close (iunit) lndname = trim(ncdir) // '/soil/theta_s.nc' @@ -299,31 +299,31 @@ program rawdata_to_nc write(*,*) 'Theta_s_l' // trim(c) // ' done' ! (2) Read in the matric potential at saturation [cm] - lndname = trim(bindir) // '/RAW_DATA_updated/psi_s_l'//trim(c) + lndname = trim(bindir) // '/RAW_DATA_updated/psi_s_l'//trim(c) iunit = 100 inquire (iolength=length) a_real8 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_real8 (:,irow) - end do + enddo close (iunit) lndname = trim(ncdir) // '/soil/psi_s.nc' - call ncio_write_serial (lndname, 'psi_s_l'//trim(c), a_real8, & + call ncio_write_serial (lndname, 'psi_s_l'//trim(c), a_real8, & 'longitude', 'latitude', compress) write(*,*) 'psi_s_l' // trim(c) // ' done' ! (3) Read in the pore size distribution index [dimensionless] - lndname = trim(bindir) // '/RAW_DATA_updated/lambda_l'//trim(c) + lndname = trim(bindir) // '/RAW_DATA_updated/lambda_l'//trim(c) iunit = 100 inquire (iolength=length) a_real8 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_real8 (:,irow) - end do + enddo close (iunit) lndname = trim(ncdir) // '/soil/lambda.nc' @@ -333,14 +333,14 @@ program rawdata_to_nc write(*,*) 'lambda_l' // trim(c) // ' done' ! (4) Read in the saturated hydraulic conductivity [cm/day] - lndname = trim(bindir) // '/RAW_DATA_updated/k_s_l'//trim(c) + lndname = trim(bindir) // '/RAW_DATA_updated/k_s_l'//trim(c) iunit = 100 inquire (iolength=length) a_real8 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_real8 (:,irow) - end do + enddo close (iunit) lndname = trim(ncdir) // '/soil/k_s.nc' @@ -350,14 +350,14 @@ program rawdata_to_nc write(*,*) 'k_s_l' // trim(c) // ' done' ! (5) Read in the heat capacity of soil solids [J/(m3 K)] - lndname = trim(bindir) // '/RAW_DATA_updated/csol_l'//trim(c) + lndname = trim(bindir) // '/RAW_DATA_updated/csol_l'//trim(c) iunit = 100 inquire (iolength=length) a_real8 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_real8 (:,irow) - end do + enddo close (iunit) lndname = trim(ncdir) // '/soil/csol.nc' @@ -367,14 +367,14 @@ program rawdata_to_nc write(*,*) 'csol_l' // trim(c) // ' done' ! (6) Read in the thermal conductivity of saturated soil [W/m-K] - lndname = trim(bindir) // '/RAW_DATA_updated/tksatu_l'//trim(c) + lndname = trim(bindir) // '/RAW_DATA_updated/tksatu_l'//trim(c) iunit = 100 inquire (iolength=length) a_real8 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_real8 (:,irow) - end do + enddo close (iunit) lndname = trim(ncdir) // '/soil/tksatu.nc' @@ -384,14 +384,14 @@ program rawdata_to_nc write(*,*) 'tksatu_l' // trim(c) // ' done' ! (7) Read in the thermal conductivity for dry soil [W/(m-K)] - lndname = trim(bindir) // '/RAW_DATA_updated/tkdry_l'//trim(c) + lndname = trim(bindir) // '/RAW_DATA_updated/tkdry_l'//trim(c) iunit = 100 inquire (iolength=length) a_real8 (:,1) - open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') + open (iunit, file=trim(lndname), access='direct', recl=length, form='unformatted', status='old') do irow = 1, nlat read (iunit, rec=irow) a_real8 (:,irow) - end do + enddo close (iunit) lndname = trim(ncdir) // '/soil/tkdry.nc' @@ -400,7 +400,7 @@ program rawdata_to_nc write(*,*) 'tkdry_l' // trim(c) // ' done' - end do + enddo deallocate (a_real8) diff --git a/preprocess/rd_land_types.F90 b/preprocess/rd_land_types.F90 index 6c712512..4610279b 100644 --- a/preprocess/rd_land_types.F90 +++ b/preprocess/rd_land_types.F90 @@ -260,7 +260,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (ii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) call mpi_reduce (int_min, 0, 1, MPI_INTEGER, MPI_MIN, 0, p_comm_slave, p_err) call mpi_reduce (int_max, 0, 1, MPI_INTEGER, MPI_MAX, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*,int_min,int_max if (p_master) print*,'ii=', ii @@ -339,7 +339,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (jjj, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) call mpi_reduce (int_min, 0, 1, MPI_INTEGER, MPI_MIN, 0, p_comm_slave, p_err) call mpi_reduce (int_max, 0, 1, MPI_INTEGER, MPI_MAX, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*, int_min, int_max @@ -415,7 +415,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (jjj, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) call mpi_reduce (int_min, 0, 1, MPI_INTEGER, MPI_MIN, 0, p_comm_slave, p_err) call mpi_reduce (int_max, 0, 1, MPI_INTEGER, MPI_MAX, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*, int_min, int_max @@ -497,7 +497,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (iii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) call mpi_reduce (int_min, 0, 1, MPI_INTEGER, MPI_MIN, 0, p_comm_slave, p_err) call mpi_reduce (int_max, 0, 1, MPI_INTEGER, MPI_MAX, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*,int_min, int_max @@ -592,7 +592,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (ii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) call mpi_reduce (r8_min, 0, 1, MPI_INTEGER, MPI_MIN, 0, p_comm_slave, p_err) call mpi_reduce (r8_max, 0, 1, MPI_INTEGER, MPI_MAX, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*, r8_min, r8_max @@ -657,7 +657,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (ii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) call mpi_reduce (int_min, 0, 1, MPI_INTEGER, MPI_MIN, 0, p_comm_slave, p_err) call mpi_reduce (int_max, 0, 1, MPI_INTEGER, MPI_MAX, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*, int_min, int_max @@ -700,7 +700,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (iii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) call mpi_reduce (iiii,0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) call mpi_reduce (jjj, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*,' SECOND USGS GLCC land cover ' if (p_master) print*,'land water points =', ii, 'wetland points=', iii, 'glacier points=', iiii, 'urban points=', jjj @@ -741,7 +741,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (iii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) call mpi_reduce (iiii,0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) call mpi_reduce (jjj, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*,' SECOND MODIS IGBP land cover ' if (p_master) print*,'land water points =', ii, 'wetland points=', iii, 'glacier points=', iiii, 'urban points=', jjj @@ -794,7 +794,7 @@ SUBROUTINE rd_land_types(dir_rawdata) ! call mpi_reduce (MPI_IN_PLACE, iii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) ! else ! call mpi_reduce (iii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) -! end if +! endif !#endif ! if (p_master) print*, 'GLCC WATER BODIES','iii=',iii !#endif @@ -830,7 +830,7 @@ SUBROUTINE rd_land_types(dir_rawdata) ! call mpi_reduce (MPI_IN_PLACE, iii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) ! else ! call mpi_reduce (iii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) -! end if +! endif !#endif ! if (p_master) print*, 'MODIS IGBP WATER BODIES','iii=',iii !#endif @@ -853,7 +853,7 @@ SUBROUTINE rd_land_types(dir_rawdata) ! call mpi_reduce (MPI_IN_PLACE, iiii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) ! else ! call mpi_reduce (iiii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) -! end if +! endif !#endif ! if (p_master) print*, 'GLCC WATER BODIES','iiii=',iiii !#endif @@ -874,7 +874,7 @@ SUBROUTINE rd_land_types(dir_rawdata) ! call mpi_reduce (MPI_IN_PLACE, iiii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) ! else ! call mpi_reduce (iiii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) -! end if +! endif !#endif ! if (p_master) print*, 'MODIS IGBP WATER BODIES','iiii=',iiii !#endif @@ -914,7 +914,7 @@ SUBROUTINE rd_land_types(dir_rawdata) ! call mpi_reduce (MPI_IN_PLACE, iii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) ! else ! call mpi_reduce (iii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) -! end if +! endif !#endif ! if (p_master) print*, 'GLCC WETLAND','iii=',iii !#endif @@ -947,7 +947,7 @@ SUBROUTINE rd_land_types(dir_rawdata) ! call mpi_reduce (MPI_IN_PLACE, iii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) ! else ! call mpi_reduce (iii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) -! end if +! endif !#endif ! if (p_master) print*, 'MODIS IGBP WETLAND','iii=',iii !#endif @@ -970,7 +970,7 @@ SUBROUTINE rd_land_types(dir_rawdata) ! call mpi_reduce (MPI_IN_PLACE, iiii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) ! else ! call mpi_reduce (iiii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) -! end if +! endif !#endif ! if (p_master) print*, 'GLCC WETLAND', 'iiii=',iiii !#endif @@ -991,7 +991,7 @@ SUBROUTINE rd_land_types(dir_rawdata) ! call mpi_reduce (MPI_IN_PLACE, iiii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) ! else ! call mpi_reduce (iiii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) -! end if +! endif !#endif ! if (p_master) print*, 'MODIS IGBP WETLAND', 'iiii=',iiii !#endif @@ -1030,7 +1030,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (MPI_IN_PLACE, iii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) else call mpi_reduce (iii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*, 'GLCC GLACIER/ICESHEET','iii=',iii #endif @@ -1065,7 +1065,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (MPI_IN_PLACE, iii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) else call mpi_reduce (iii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*, 'MODIS IGBP GLACIER/ICESHEET','iii=',iii #endif @@ -1088,7 +1088,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (MPI_IN_PLACE, iiii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) else call mpi_reduce (iiii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*, 'GLCC GLACIER/ICESHEET', 'iiii=',iiii #endif @@ -1109,7 +1109,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (MPI_IN_PLACE, iiii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) else call mpi_reduce (iiii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*, 'MODIS IGBP GLACIER/ICESHEET', 'iiii=',iiii #endif @@ -1148,7 +1148,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (MPI_IN_PLACE, iii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) else call mpi_reduce (iii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*, 'GLCC URBAN and BUILT-UP LAND','iii=',iii #endif @@ -1184,7 +1184,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (MPI_IN_PLACE, iii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) else call mpi_reduce (iii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*, 'MODIS IGBP URBAN and BUILT-UP LAND','iii=',iii #endif @@ -1207,7 +1207,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (MPI_IN_PLACE, iiii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) else call mpi_reduce (iiii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*, 'GLCC URBAN and BUILT-UP LAND', 'iiii=',iiii #endif @@ -1228,7 +1228,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (MPI_IN_PLACE, iiii, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) else call mpi_reduce (iiii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*, 'MODIS IGBP URBAN and BUILT-UP LAND', 'iiii=',iiii #endif @@ -1273,7 +1273,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (iii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) call mpi_reduce (iiii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) call mpi_reduce (jjj, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*,' FINAL USGS GLCC land cover ' if (p_master) print*,'land water points =', ii, 'wetland points=', iii, 'glacier points=', iiii, 'urban points=', jjj @@ -1316,7 +1316,7 @@ SUBROUTINE rd_land_types(dir_rawdata) call mpi_reduce (iii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) call mpi_reduce (iiii, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) call mpi_reduce (jjj, 0, 1, MPI_INTEGER, MPI_SUM, 0, p_comm_slave, p_err) - end if + endif #endif if (p_master) print*,' FINAL MODIS IGBP land cover ' if (p_master) print*,'land water points =', ii, 'wetland points=', iii, 'glacier points=', iiii, 'urban points=', jjj @@ -1446,7 +1446,7 @@ INTEGER FUNCTION ia(chr,n,ispval) nbit = (m-1)*8 jj = ishft(bit_2,nbit) ia = ieor(jj,ia) - end do + enddo endif ! .. get the byte from chr: @@ -1457,7 +1457,7 @@ INTEGER FUNCTION ia(chr,n,ispval) ia2 = ishft(ii2,mshft) ! .. the abs(integer): ia = ieor(ia,ia2) - end do + enddo if (ia.lt.0) ia = ispval @@ -1505,8 +1505,8 @@ SUBROUTINE substitute(i0,j0,ni,njl,nju,nl,np,a,c,L) if(a(i2,j2) > 0)then num(a(i2,j2)) = num(a(i2,j2)) + 1 endif - end do - end do + enddo + enddo msk = .true. msk(c(1:np)) = .false. @@ -1523,7 +1523,7 @@ SUBROUTINE substitute(i0,j0,ni,njl,nju,nl,np,a,c,L) L = loc1(1) exit endif - end do + enddo ! if(r.eq.(rmax+1))then ! print*, 'failed to find suitable type in 100 grid cells' radius' @@ -1572,7 +1572,7 @@ SUBROUTINE update_buff (buff, nlon, nlat, buff_lb, nrow_start, nrow_end, buff_ub lat_disp(0) = 0 do iproc = 1, p_nslaves-1 lat_disp(iproc) = sum(nlat_proc(0:iproc-1)) - end do + enddo allocate (cbuff_g (nlon, nlat)) call mpi_gatherv (cbuff(:,nrow_start:nrow_end), nlon*(nrow_end-nrow_start+1), MPI_CHARACTER, & @@ -1585,7 +1585,7 @@ SUBROUTINE update_buff (buff, nlon, nlat, buff_lb, nrow_start, nrow_end, buff_ub bub = min(lat_disp(iproc)+nlat_proc(iproc)+rmax, nlat) call mpi_isend (cbuff_g(:,blb:bub), nlon*(bub-blb+1), MPI_CHARACTER, & iproc, iproc, p_comm_slave, reqs(iproc), p_err) - end do + enddo 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, & @@ -1594,7 +1594,7 @@ SUBROUTINE update_buff (buff, nlon, nlat, buff_lb, nrow_start, nrow_end, buff_ub 0, 0, 0, MPI_CHARACTER, 0, p_comm_slave, p_err) call mpi_recv (cbuff, nlon*(buff_ub-buff_lb+1), MPI_CHARACTER, 0, p_iam_slave, & p_comm_slave, p_stat, p_err) - end if + endif buff = ichar(cbuff) @@ -1604,7 +1604,7 @@ SUBROUTINE update_buff (buff, nlon, nlat, buff_lb, nrow_start, nrow_end, buff_ub deallocate (nlat_proc) deallocate (lat_disp ) deallocate (cbuff_g) - end if + endif END SUBROUTINE update_buff #endif diff --git a/preprocess/rd_soil_properties.F90 b/preprocess/rd_soil_properties.F90 index a26bc3c5..c72cc3bc 100644 --- a/preprocess/rd_soil_properties.F90 +++ b/preprocess/rd_soil_properties.F90 @@ -2,42 +2,42 @@ SUBROUTINE rd_soil_properties(dir_rawdata) !----------------------------------------------------------------------- -! DESCRIPTION: -! Read in soil characteristic dataset GSDE with 30 arc seconds resolution, -! fill the missing data, and estimate soil porosity and -! soil hydraulic and thermal parameters at the resolution of 30 arc seconds. -! The data format are binary. +! !DESCRIPTION: +! Read in soil characteristic dataset GSDE with 30 arc seconds resolution, +! fill the missing data, and estimate soil porosity and +! soil hydraulic and thermal parameters at the resolution of 30 arc seconds. +! The data format are binary. ! -! The Global Soil Characteristics dataset GSDE -! (http://globalchange.bnu.edu.cn/research/soilw) -! 1 percentage of gravel (fine earth and rock fragments) (% volume) -! 2 percentage of sand (mineral soil) (% weight) -! 3 percentage of clay (mineral soil) (% weight) -! 4 organic Carbon (SOC) (fine earth) (% weight) -! 5 bulk density (BD) (fine earth) (g/cm3) -! 6 ... - -! The calling sequence is: -! -> soil_solids_fractions: soil porosity and soil fractions which are needed to estimate -! soil hydraulic and thermal parameters -! -> soil_thermal_parameters: soil solid heat capacity and (dry and saturated) soil thermal conductivity -! -> soil_hydraulic_parameters: soil water retension curves and saturated hydraulic conductivity +! The Global Soil Characteristics dataset GSDE +! (http://globalchange.bnu.edu.cn/research/soilw) +! 1 percentage of gravel (fine earth and rock fragments) (% volume) +! 2 percentage of sand (mineral soil) (% weight) +! 3 percentage of clay (mineral soil) (% weight) +! 4 organic Carbon (SOC) (fine earth) (% weight) +! 5 bulk density (BD) (fine earth) (g/cm3) +! 6 ... + +! The calling sequence is: +! -> soil_solids_fractions: soil porosity and soil fractions which are needed to estimate +! soil hydraulic and thermal parameters +! -> soil_thermal_parameters: soil solid heat capacity and (dry and saturated) soil thermal conductivity +! -> soil_hydraulic_parameters: soil water retension curves and saturated hydraulic conductivity ! -! Reference: -! (1) Shangguan et al., 2014: A global soil data set for earth system modeling. -! J. of Advances in Modeling Earth Systems, DOI: 10.1002/2013MS000293 -! (2) Dai et al.,2019: A Global High-Resolution Data Set of Soil Hydraulic and Thermal Properties -! for Land Surface Modeling. J. of Advances in Modeling Earth Systems, DOI: 10.1029/2019MS001784 +! !REFERENCES: +! (1) Shangguan et al., 2014: A global soil data set for earth system modeling. +! J. of Advances in Modeling Earth Systems, DOI: 10.1002/2013MS000293 +! (2) Dai et al.,2019: A Global High-Resolution Data Set of Soil Hydraulic and Thermal Properties +! for Land Surface Modeling. J. of Advances in Modeling Earth Systems, DOI: 10.1029/2019MS001784 ! -! Original author: Yongjiu Dai, 12/2013/ +! Original author: Yongjiu Dai, 12/2013/ ! -! 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 -! Nan Wei, 12/2022: output more parameters for BGC parts -! ---------------------------------------------------------------------- -use MOD_Precision +! !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 +! Nan Wei, 12/2022: output more parameters for BGC parts +!----------------------------------------------------------------------- +USE MOD_Precision IMPLICIT NONE ! arguments: @@ -205,13 +205,13 @@ SUBROUTINE rd_soil_properties(dir_rawdata) ! ---------------------------------- do nsl = 1, nl_soil zsoi(nsl) = 0.025*(exp(0.5*(nsl-0.5))-1.) ! node depths - end do + enddo dzsoi(1) = 0.5*(zsoi(1)+zsoi(2)) ! =zsoih(1) dzsoi(nl_soil) = zsoi(nl_soil)-zsoi(nl_soil-1) do nsl = 2, nl_soil-1 dzsoi(nsl) = 0.5*(zsoi(nsl+1)-zsoi(nsl-1)) ! thickness b/n two interfaces - end do + enddo zsoih(0) = 0. zsoih(nl_soil) = zsoi(nl_soil) + 0.5*dzsoi(nl_soil) @@ -346,7 +346,7 @@ SUBROUTINE rd_soil_properties(dir_rawdata) open(iunit,file=trim(lndname),access='direct',recl=length,form='unformatted',status='old') do nrow = 1, nlat read(iunit,rec=nrow,err=100) VGM_theta_r_Rose(:,nrow) - end do + enddo close(iunit) inquire(iolength=length) VGM_alpha_Rose(:,1) @@ -356,7 +356,7 @@ SUBROUTINE rd_soil_properties(dir_rawdata) open(iunit,file=trim(lndname),access='direct',recl=length,form='unformatted',status='old') do nrow = 1, nlat read(iunit,rec=nrow,err=100) VGM_alpha_Rose(:,nrow) - end do + enddo close(iunit) inquire(iolength=length) VGM_n_Rose(:,1) @@ -366,7 +366,7 @@ SUBROUTINE rd_soil_properties(dir_rawdata) open(iunit,file=trim(lndname),access='direct',recl=length,form='unformatted',status='old') do nrow = 1, nlat read(iunit,rec=nrow,err=100) VGM_n_Rose(:,nrow) - end do + enddo close(iunit) inquire(iolength=length) k_s_Rose(:,1) @@ -376,7 +376,7 @@ SUBROUTINE rd_soil_properties(dir_rawdata) open(iunit,file=trim(lndname),access='direct',recl=length,form='unformatted',status='old') do nrow = 1, nlat read(iunit,rec=nrow,err=100) k_s_Rose(:,nrow) - end do + enddo close(iunit) @@ -460,7 +460,7 @@ SUBROUTINE rd_soil_properties(dir_rawdata) if (soil_bd_l < 0.111 .or. soil_bd_l > 2.0 .or. soil_oc_l > 10.0) then SOM=1.724*soil_oc_l soil_bd_l = 0.111*2.0/(2.0*SOM/100.+0.111*(100.-SOM)/100.) - end if + endif ! -------------------------------------------------- ! The weight and volumetric fractions of soil solids diff --git a/share/MOD_5x5DataReadin.F90 b/share/MOD_5x5DataReadin.F90 index 17166cd9..4cc54435 100644 --- a/share/MOD_5x5DataReadin.F90 +++ b/share/MOD_5x5DataReadin.F90 @@ -2,30 +2,30 @@ MODULE MOD_5x5DataReadin - !----------------------------------------------------------------------- - ! DESCRIPTION: - ! - ! Reading data in netCDF files by 5 degree blocks. - ! - ! The file name gives the boundaries of the block. - ! For example, file "RG_65_75_60_80.URB2010.nc" stores data in region - ! from 65N to 60N and 75E to 80E. - ! - ! Notice that: - ! 1. Subroutines loop over all 5 degree blocks in simulation region. - ! 2. Latitude in files is from north to south. - ! 3. "read_5x5_data_pft" reads data with dimension "pft" and permute - ! dimension (lon,lat,pft) in files to (pft,lon,lat) in variables. - ! 4. "read_5x5_data_time" reads data with dimension "time" - ! at given time. - ! 5. "read_5x5_data_pft_time" reads data with dimension "pft" and "time" - ! at given time and permute dimension (lon,lat,pft) in files - ! to (pft,lon,lat) in variables. - ! - ! Created by Shupeng Zhang, May 2023 - !----------------------------------------------------------------------- - - USE MOD_NetCDFSerial, only : nccheck +!----------------------------------------------------------------------- +! !DESCRIPTION: +! +! Reading data in netCDF files by 5 degree blocks. +! +! The file name gives the boundaries of the block. +! For example, file "RG_65_75_60_80.URB2010.nc" stores data in region +! from 65N to 60N and 75E to 80E. +! +! Notice that: +! 1. Subroutines loop over all 5 degree blocks in simulation region. +! 2. Latitude in files is from north to south. +! 3. "read_5x5_data_pft" reads data with dimension "pft" and permute +! dimension (lon,lat,pft) in files to (pft,lon,lat) in variables. +! 4. "read_5x5_data_time" reads data with dimension "time" +! at given time. +! 5. "read_5x5_data_pft_time" reads data with dimension "pft" and "time" +! at given time and permute dimension (lon,lat,pft) in files +! to (pft,lon,lat) in variables. +! +! Created by Shupeng Zhang, May 2023 +!----------------------------------------------------------------------- + + USE MOD_NetCDFSerial, only: nccheck IMPLICIT NONE integer, parameter :: N_PFT_modis = 16 diff --git a/share/MOD_Block.F90 b/share/MOD_Block.F90 index 01591abd..6c2e0be5 100644 --- a/share/MOD_Block.F90 +++ b/share/MOD_Block.F90 @@ -2,46 +2,46 @@ MODULE MOD_Block - !------------------------------------------------------------------------------------- - ! DESCRIPTION: - ! - ! To deal with high-resolution data, the globe is divided into blocks. - ! - ! (180W,90N) (180E,90N) - ! .-----------------------------------. - ! | | | | | - ! | | | | | - ! | | | | | - ! .-----------------------------------. - ! | | | | | - ! | | | | | - ! | | | | | - ! .-----------------------------------. - ! | | | | | - ! | | | | | - ! | | | | | - ! .-----------------------------------. - ! (180W,90S) (180E,90S) - ! - ! 1. - ! Boundaries for block (i,j) is saved in - ! "gblock%lat_s(j), gblock%lat_n(j), gblock%lon_w(i), gblock%lon_e(i)" - ! for south, north, west and east boundaries respectively. - ! - ! 2. - ! The (i,j) element of 2D array gblock%pio saves the global communication - ! number of process which is in charge of Input/Output of block (i,j). - ! - ! 3. - ! For Input/Output processes, "gblock%nblkme, gblock%xblkme(:), gblock%yblkme(:)" - ! SAVE the locations of blocks which are handled by themselves. - ! - ! 4. - ! Division of blocks can be generated by number of blocks globally (by set_by_size), - ! or set by predefined boundaries in files (by set_by_file). - ! - ! Created by Shupeng Zhang, May 2023 - !------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------- +! !DESCRIPTION: +! +! To deal with high-resolution data, the globe is divided into blocks. +! +! (180W,90N) (180E,90N) +! .-----------------------------------. +! | | | | | +! | | | | | +! | | | | | +! .-----------------------------------. +! | | | | | +! | | | | | +! | | | | | +! .-----------------------------------. +! | | | | | +! | | | | | +! | | | | | +! .-----------------------------------. +! (180W,90S) (180E,90S) +! +! 1. +! Boundaries for block (i,j) is saved in +! "gblock%lat_s(j), gblock%lat_n(j), gblock%lon_w(i), gblock%lon_e(i)" +! for south, north, west and east boundaries respectively. +! +! 2. +! The (i,j) element of 2D array gblock%pio saves the global communication +! number of process which is in charge of Input/Output of block (i,j). +! +! 3. +! For Input/Output processes, "gblock%nblkme, gblock%xblkme(:), gblock%yblkme(:)" +! SAVE the locations of blocks which are handled by themselves. +! +! 4. +! Division of blocks can be generated by number of blocks globally (by set_by_size), +! or set by predefined boundaries in files (by set_by_file). +! +! Created by Shupeng Zhang, May 2023 +!------------------------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE @@ -58,7 +58,7 @@ MODULE MOD_Block ! IO. integer, allocatable :: pio(:,:) - + integer :: nblkme integer, allocatable :: xblkme(:), yblkme(:) @@ -68,7 +68,7 @@ MODULE MOD_Block procedure, PUBLIC :: save_to_file => block_save_to_file procedure, PUBLIC :: load_from_file => block_load_from_file - + procedure, PRIVATE :: clip => block_clip procedure, PRIVATE :: init_pio => block_init_pio procedure, PRIVATE :: read_pio => block_read_pio @@ -79,7 +79,7 @@ MODULE MOD_Block ! ---- Instance ---- type (block_type) :: gblock - + ! ---- PUBLIC SUBROUTINE ---- PUBLIC :: get_filename_block @@ -88,7 +88,7 @@ MODULE MOD_Block ! -------------------------------- SUBROUTINE block_set (this) - + USE MOD_Precision USE MOD_Namelist USE MOD_Utils @@ -102,10 +102,10 @@ SUBROUTINE block_set (this) logical :: fexists integer :: iblk, jblk - inquire(file=trim(DEF_BlockInfoFile), exist=fexists) + inquire(file=trim(DEF_BlockInfoFile), exist=fexists) IF (fexists) THEN - + CALL ncio_read_bcast_serial (DEF_BlockInfoFile, 'lat_s', this%lat_s) CALL ncio_read_bcast_serial (DEF_BlockInfoFile, 'lat_n', this%lat_n) CALL ncio_read_bcast_serial (DEF_BlockInfoFile, 'lon_w', this%lon_w) @@ -145,8 +145,8 @@ SUBROUTINE block_set (this) IF ((mod(360,DEF_nx_blocks) /= 0) .or. (mod(180,DEF_ny_blocks) /= 0)) THEN IF (p_is_master) THEN - write(*,*) 'Number of blocks in longitude should be a factor of 360 ' - write(*,*) ' and Number of blocks in latitude should be a factor of 180.' + write(*,*) 'Number of blocks in longitude should be a factor of 360 ' + write(*,*) ' and Number of blocks in latitude should be a factor of 180.' CALL CoLM_stop () ENDIF ENDIF @@ -155,7 +155,7 @@ SUBROUTINE block_set (this) allocate (this%lon_e (this%nxblk)) DO iblk = 1, this%nxblk - this%lon_w(iblk) = -180.0 + 360.0/this%nxblk * (iblk-1) + this%lon_w(iblk) = -180.0 + 360.0/this%nxblk * (iblk-1) this%lon_e(iblk) = -180.0 + 360.0/this%nxblk * iblk CALL normalize_longitude (this%lon_w(iblk)) @@ -166,14 +166,14 @@ SUBROUTINE block_set (this) allocate (this%lat_n (this%nyblk)) DO jblk = 1, this%nyblk - this%lat_s(jblk) = -90.0 + 180.0/this%nyblk * (jblk-1) + this%lat_s(jblk) = -90.0 + 180.0/this%nyblk * (jblk-1) this%lat_n(jblk) = -90.0 + 180.0/this%nyblk * jblk ENDDO ENDIF IF (p_is_master) THEN - write (*,*) + write (*,*) write (*,'(A)') '----- Block information -----' write (*,'(I4,A,I4,A)') this%nxblk, ' blocks in longitude,', & this%nyblk, ' blocks in latitude.' @@ -197,9 +197,9 @@ SUBROUTINE block_save_to_file (this, dir_landdata) ! Local variables character(len=256) :: filename - + IF (p_is_master) THEN - + filename = trim(dir_landdata) // '/block.nc' CALL ncio_create_file (filename) @@ -228,17 +228,17 @@ SUBROUTINE block_load_from_file (this, dir_landdata) ! Local variables character(len=256) :: filename - + filename = trim(dir_landdata) // '/block.nc' - + CALL ncio_read_bcast_serial (filename, 'lat_s', this%lat_s) CALL ncio_read_bcast_serial (filename, 'lat_n', this%lat_n) CALL ncio_read_bcast_serial (filename, 'lon_w', this%lon_w) CALL ncio_read_bcast_serial (filename, 'lon_e', this%lon_e) - + this%nyblk = size(this%lat_s) this%nxblk = size(this%lon_w) - + IF (p_is_master) THEN write (*,*) 'Block information:' write (*,'(I3,A,I3,A)') this%nxblk, ' blocks in longitude,', & @@ -253,11 +253,11 @@ END SUBROUTINE block_load_from_file ! -------------------------------- SUBROUTINE block_clip (this, & iblk_south, iblk_north, iblk_west, iblk_east, numblocks) - + USE MOD_Namelist USE MOD_Utils - IMPLICIT NONE - + IMPLICIT NONE + class (block_type) :: this integer, intent(out) :: iblk_south, iblk_north, iblk_west, iblk_east integer, intent(out), optional :: numblocks @@ -293,9 +293,9 @@ SUBROUTINE block_clip (this, & ENDIF IF (present(numblocks)) THEN - + numblocks_y = iblk_north - iblk_south + 1 - + IF (iblk_east >= iblk_west) THEN numblocks_x = iblk_east - iblk_west + 1 ELSE @@ -310,7 +310,7 @@ END SUBROUTINE block_clip ! -------------------------------- SUBROUTINE block_init_pio (this) - + USE MOD_Precision USE MOD_SPMD_Task USE MOD_Namelist @@ -321,7 +321,7 @@ SUBROUTINE block_init_pio (this) IMPLICIT NONE class (block_type) :: this - + integer :: iblk, jblk, iproc integer :: iblk_south, iblk_north, iblk_west, iblk_east integer :: numblocks, ngrp @@ -330,19 +330,19 @@ SUBROUTINE block_init_pio (this) IF (p_is_master) THEN CALL this%clip (iblk_south, iblk_north, iblk_west, iblk_east, numblocks) ENDIF - + #ifdef USEMPI CALL mpi_bcast (numblocks, 1, MPI_INTEGER, p_address_master, p_comm_glb, p_err) - + ngrp = max((p_np_glb-1) / DEF_PIO_groupsize, 1) ngrp = min(ngrp, numblocks) CALL divide_processes_into_groups (ngrp) -#endif +#endif allocate (this%pio (this%nxblk,this%nyblk)) IF (p_is_master) THEN - + this%pio(:,:) = -1 iproc = -1 @@ -355,7 +355,7 @@ SUBROUTINE block_init_pio (this) this%pio(iblk,jblk) = p_address_io(iproc) #else this%pio(iblk,jblk) = p_root -#endif +#endif IF (iblk /= iblk_east) THEN iblk = mod(iblk,this%nxblk) + 1 @@ -370,7 +370,7 @@ SUBROUTINE block_init_pio (this) #ifdef USEMPI CALL mpi_bcast (this%pio, this%nxblk * this%nyblk, MPI_INTEGER, & p_address_master, p_comm_glb, p_err) -#endif +#endif #ifndef SinglePoint this%nblkme = 0 @@ -406,7 +406,7 @@ END SUBROUTINE block_init_pio ! -------------------------------- SUBROUTINE block_read_pio (this, dir_landdata) - + USE MOD_SPMD_Task USE MOD_NetCDFSerial USE MOD_Namelist @@ -421,14 +421,14 @@ SUBROUTINE block_read_pio (this, dir_landdata) integer :: iblk_south, iblk_north, iblk_west, iblk_east integer :: numblocks, ngrp, iblk, jblk, iproc, jproc integer :: iblkme - + IF (p_is_master) THEN ! Whether it varies by year??? write(cyear,'(i4.4)') DEF_LC_YEAR filename = trim(dir_landdata) // '/mesh/' // trim(cyear) // '/mesh.nc' CALL ncio_read_serial (filename, 'nelm_blk', nelmblk) numblocks = count(nelmblk > 0) - + CALL this%clip (iblk_south, iblk_north, iblk_west, iblk_east) ENDIF @@ -459,7 +459,7 @@ SUBROUTINE block_read_pio (this, dir_landdata) ENDIF ENDDO ENDDO - + IF (maxval(nelm_io) < 2 * minval(nelm_io)) THEN deallocate (nelm_io) EXIT @@ -467,14 +467,14 @@ SUBROUTINE block_read_pio (this, dir_landdata) ngrp = ngrp - 1 deallocate (nelm_io) ENDIF - ENDDO + ENDDO ENDIF CALL mpi_bcast (numblocks, 1, MPI_INTEGER, p_address_master, p_comm_glb, p_err) CALL mpi_bcast (ngrp, 1, MPI_INTEGER, p_address_master, p_comm_glb, p_err) CALL divide_processes_into_groups (ngrp) #endif - + allocate (this%pio (this%nxblk,this%nyblk)) IF (p_is_master) THEN @@ -502,7 +502,7 @@ SUBROUTINE block_read_pio (this, dir_landdata) #else this%pio(iblk,jblk) = p_root #endif - + IF (iblk /= iblk_east) THEN iblk = mod(iblk,this%nxblk) + 1 ELSE @@ -520,7 +520,7 @@ SUBROUTINE block_read_pio (this, dir_landdata) CALL mpi_bcast (this%pio, this%nxblk * this%nyblk, MPI_INTEGER, & p_address_master, p_comm_glb, p_err) #endif - + #ifndef SinglePoint this%nblkme = 0 IF (p_is_io) THEN @@ -544,7 +544,7 @@ SUBROUTINE block_read_pio (this, dir_landdata) this%nblkme = 1 allocate(this%xblkme(1)) allocate(this%yblkme(1)) - + DO jblk = 1, this%nyblk DO iblk = 1, this%nxblk IF (nelmblk(iblk,jblk) > 0) THEN @@ -569,17 +569,17 @@ SUBROUTINE block_free_mem (this) IF (allocated (this%lat_n)) deallocate (this%lat_n) IF (allocated (this%lon_w)) deallocate (this%lon_w) IF (allocated (this%lon_e)) deallocate (this%lon_e) - + IF (allocated (this%pio) ) deallocate (this%pio ) IF (allocated (this%xblkme)) deallocate (this%xblkme) IF (allocated (this%yblkme)) deallocate (this%yblkme) - + END SUBROUTINE block_free_mem - + ! ----- SUBROUTINE get_blockname (iblk, jblk, blockname) - + IMPLICIT NONE integer, intent(in) :: iblk, jblk @@ -605,11 +605,11 @@ SUBROUTINE get_blockname (iblk, jblk, blockname) blockname = trim(cx) // '_' // trim(cy) - END SUBROUTINE get_blockname + END SUBROUTINE get_blockname ! -------------------------------- SUBROUTINE get_filename_block (filename, iblk, jblk, fileblock) - + IMPLICIT NONE character(len=*), intent(in) :: filename @@ -623,7 +623,7 @@ SUBROUTINE get_filename_block (filename, iblk, jblk, fileblock) CALL get_blockname (iblk, jblk, blockname) - i = len_trim (filename) + i = len_trim (filename) DO WHILE (i > 0) IF (filename(i:i) == '.') EXIT i = i - 1 @@ -635,6 +635,6 @@ SUBROUTINE get_filename_block (filename, iblk, jblk, fileblock) fileblock = filename // '_' // blockname // '.nc' ENDIF - END SUBROUTINE get_filename_block + END SUBROUTINE get_filename_block END MODULE MOD_Block diff --git a/share/MOD_CatchmentDataReadin.F90 b/share/MOD_CatchmentDataReadin.F90 index 89f82cc6..453d65e4 100644 --- a/share/MOD_CatchmentDataReadin.F90 +++ b/share/MOD_CatchmentDataReadin.F90 @@ -2,22 +2,22 @@ MODULE MOD_CatchmentDataReadin - !-------------------------------------------------------------------------------------- - ! DESCRIPTION: - ! - ! Reading preprocessed MERIT Hydro data and generated catchment data in netcdf files. - ! - ! 1. If "in_one_file" is false, then the data is orgnized by 5 degree blocks. - ! The file name gives the southwest corner of the block. - ! For example, file "n60e075.nc" stores data in region from 65N to 60N and 75E to 80E, - ! Subroutines loop over all 5 degree blocks in simulation region. - ! - ! 2. Data is saved in variables with types of "block_data_xxxxx_xd". - ! - ! 3. Latitude in files is from north to south. - ! - ! Created by Shupeng Zhang, May 2023 - !-------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------- +! !DESCRIPTION: +! +! Reading preprocessed MERIT Hydro data and generated catchment data in netcdf files. +! +! 1. If "in_one_file" is false, then the data is orgnized by 5 degree blocks. +! The file name gives the southwest corner of the block. +! For example, file "n60e075.nc" stores data in region from 65N to 60N and 75E to 80E, +! Subroutines loop over all 5 degree blocks in simulation region. +! +! 2. Data is saved in variables with types of "block_data_xxxxx_xd". +! +! 3. Latitude in files is from north to south. +! +! Created by Shupeng Zhang, May 2023 +!-------------------------------------------------------------------------------------- IMPLICIT NONE @@ -62,7 +62,7 @@ SUBROUTINE catchment_data_read (file_meshdata_in, dataname, grid, rdata, spv) IF (grid%yinc == 1) THEN write(*,*) 'Warning: latitude in catchment data should be from north to south.' ENDIF - ENDIF + ENDIF IF (p_is_master) THEN in_one_file = ncio_var_exist (file_meshdata_in, dataname) @@ -80,7 +80,7 @@ SUBROUTINE catchment_data_read (file_meshdata_in, dataname, grid, rdata, spv) IF (p_is_io) THEN - nlat = size(latitude ) + nlat = size(latitude ) nlon = size(longitude) isouth = find_nearest_south (latitude(nlat), grid%nlat, grid%lat_s) @@ -93,7 +93,7 @@ SUBROUTINE catchment_data_read (file_meshdata_in, dataname, grid, rdata, spv) iwest = find_nearest_west (longitude(1), grid%nlon, grid%lon_w) ieast = find_nearest_east (longitude(nlon), grid%nlon, grid%lon_e) - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) @@ -118,7 +118,7 @@ SUBROUTINE catchment_data_read (file_meshdata_in, dataname, grid, rdata, spv) i0min = grid%xdsp(iblk) + 1 i1max = grid%xdsp(iblk) + grid%xcnt(iblk) IF (i1max > grid%nlon) i1max = i1max - grid%nlon - + DO WHILE ((i0min /= i1max) .and. (.not. (lon_between_floor(grid%lon_w(i0min), & grid%lon_w(iwest), grid%lon_e(ieast))))) i0min = i0min + 1; IF (i0min > grid%nlon) i0min = 1 @@ -169,7 +169,7 @@ SUBROUTINE catchment_data_read (file_meshdata_in, dataname, grid, rdata, spv) ENDDO ENDIF - + ELSE IF (p_is_io) THEN @@ -177,7 +177,7 @@ SUBROUTINE catchment_data_read (file_meshdata_in, dataname, grid, rdata, spv) ! remove suffix ".nc" path_mesh = file_meshdata_in(1:len_trim(file_meshdata_in)-3) - DO iblkme = 1, gblock%nblkme + DO iblkme = 1, gblock%nblkme iblk = gblock%xblkme(iblkme) jblk = gblock%yblkme(iblkme) @@ -227,7 +227,7 @@ SUBROUTINE catchment_data_read (file_meshdata_in, dataname, grid, rdata, spv) ENDIF IF (jbox <= 18) THEN - write (pre1,'(A1,I2.2)') 'n', (18-jbox)*5 + write (pre1,'(A1,I2.2)') 'n', (18-jbox)*5 ELSE write (pre1,'(A1,I2.2)') 's', (jbox-18)*5 ENDIF @@ -247,8 +247,8 @@ SUBROUTINE catchment_data_read (file_meshdata_in, dataname, grid, rdata, spv) rdata%blk(iblk,jblk)%val(il0:il1,jl0:jl1) = dcache ENDIF - IF ((ieast >= xdsp + 1) .and. (ieast <= xdsp + nxhbox)) THEN - IF (isouth <= ydsp + nyhbox) THEN + IF ((ieast >= xdsp + 1) .and. (ieast <= xdsp + nxhbox)) THEN + IF (isouth <= ydsp + nyhbox) THEN EXIT ELSE ibox = grid%xdsp(iblk)/nxhbox + 1 diff --git a/share/MOD_DataType.F90 b/share/MOD_DataType.F90 index 59a61581..4a907ac1 100644 --- a/share/MOD_DataType.F90 +++ b/share/MOD_DataType.F90 @@ -3,7 +3,7 @@ MODULE MOD_DataType !----------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! Definitions of data types used in CoLM. ! @@ -20,7 +20,7 @@ MODULE MOD_DataType ! 3. copy data; ! 4. do linear transformation and interpolations. ! -! Created by Shupeng Zhang, May 2023 +! Created by Shupeng Zhang, May 2023 !----------------------------------------------------------------------- USE MOD_Precision @@ -662,7 +662,7 @@ SUBROUTINE block_data_division (gdata, sumdata, spv) USE MOD_Precision USE MOD_Block USE MOD_SPMD_Task - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE type(block_data_real8_2d), intent(inout) :: gdata diff --git a/share/MOD_Grid.F90 b/share/MOD_Grid.F90 index 5f773c3a..f8ea18cf 100644 --- a/share/MOD_Grid.F90 +++ b/share/MOD_Grid.F90 @@ -3,28 +3,28 @@ MODULE MOD_Grid !------------------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! -! Definition of latitude-longitude grids and data types related to grids. +! Definition of latitude-longitude grids and data types related to grids. ! ! Latitude-longitude grid can be defined by ! 1. "name" : frequently used grids is predefined in this MODULE; ! 2. "ndims" : how many longitude and latitude grids are used globally; ! 3. "res" : longitude and latitude resolutions in radian -! 4. "center" : longitude and latitude grid centers, and the border lines +! 4. "center" : longitude and latitude grid centers, and the border lines ! are defined by center lines of grid centers; the region ! boundaries is optional. ! 5. "file" : read grid informations from a file, the variables are ! 'lat_s', 'lat_n', 'lon_w', 'lon_e' ! 6. "copy" : copy grid informations from an existing grid -! +! ! Grid centers in radian can be calculated by using "set_rlon" and "set_rlat" -! +! ! Two additional data types are defined: ! 1. "grid_list_type" : list of grid boxes; ! 2. "grid_concat_type" : used to concatenate grids distributed in blocks. -! -! Created by Shupeng Zhang, May 2023 +! +! Created by Shupeng Zhang, May 2023 !------------------------------------------------------------------------------- USE MOD_Precision @@ -406,7 +406,7 @@ SUBROUTINE grid_define_from_file (this, filename, latname, lonname) CALL ncio_read_bcast_serial (filename, latname, lat_in) CALL ncio_read_bcast_serial (filename, lonname, lon_in) CALL this%define_by_center (lat_in, lon_in) - + deallocate (lat_in, lon_in) ENDIF @@ -458,7 +458,7 @@ SUBROUTINE grid_normalize (this) ELSE this%yinc = -1 ENDIF - + ! align grid DO ilon = 1, this%nlon-1 IF (lon_between_ceil(this%lon_e(ilon), this%lon_w(ilon+1), this%lon_e(ilon+1))) THEN @@ -467,7 +467,7 @@ SUBROUTINE grid_normalize (this) this%lon_w(ilon+1) = this%lon_e(ilon) ENDIF ENDDO - + IF (this%nlon > 1) THEN ilon = this%nlon IF (lon_between_ceil(this%lon_e(ilon), this%lon_w(1), this%lon_e(1))) THEN @@ -678,7 +678,7 @@ SUBROUTINE grid_set_rlon (this) USE MOD_Precision USE MOD_Utils - USE MOD_Vars_Global, only : pi + USE MOD_Vars_Global, only: pi IMPLICIT NONE class (grid_type) :: this @@ -710,7 +710,7 @@ SUBROUTINE grid_set_rlat (this) USE MOD_Precision USE MOD_Utils - USE MOD_Vars_Global, only : pi + USE MOD_Vars_Global, only: pi IMPLICIT NONE class (grid_type) :: this diff --git a/share/MOD_Mesh.F90 b/share/MOD_Mesh.F90 index 54ea8704..9087791a 100644 --- a/share/MOD_Mesh.F90 +++ b/share/MOD_Mesh.F90 @@ -3,10 +3,10 @@ MODULE MOD_Mesh !------------------------------------------------------------------------------------ -! DESCRIPTION: +! !DESCRIPTION: ! ! MESH refers to the set of largest elements in CoLM. -! +! ! In CoLM, the global/regional area is divided into a hierarchical structure: ! 1. If GRIDBASED or UNSTRUCTURED is defined, it is ! ELEMENT >>> PATCH @@ -15,21 +15,21 @@ MODULE MOD_Mesh ! If Plant Function Type classification is used, PATCH is further divided into PFT. ! If Plant Community classification is used, PATCH is further divided into PC. ! -! To represent ELEMENT in CoLM, the land surface is first divided into pixels, +! To represent ELEMENT in CoLM, the land surface is first divided into pixels, ! which are rasterized points defined by fine-resolution data. -! +! ! ELEMENT in MESH is set of pixels: -! 1. If GRIDBASED, ELEMENT is set of pixels in a longitude-latitude rectangle. -! 2. If UNSTRUCTURED, ELEMENT is set of pixels in an irregular area (usually polygon). +! 1. If GRIDBASED, ELEMENT is set of pixels in a longitude-latitude rectangle. +! 2. If UNSTRUCTURED, ELEMENT is set of pixels in an irregular area (usually polygon). ! 3. If CATCHMENT, ELEMENT is set of pixels in a catchment whose area is less than -! a predefined value. +! a predefined value. ! -! If GRIDBASED is defined, MESH is built by using input files containing mask of +! If GRIDBASED is defined, MESH is built by using input files containing mask of ! land area or by defining the resolution of longitude-latitude grid. -! If CATCHMENT or UNSTRUCTURED is defined, MESH is built by using input files +! If CATCHMENT or UNSTRUCTURED is defined, MESH is built by using input files ! containing index of elements. ! -! Created by Shupeng Zhang, May 2023 +! Created by Shupeng Zhang, May 2023 !------------------------------------------------------------------------------------ USE MOD_Precision @@ -412,7 +412,7 @@ SUBROUTINE mesh_build () xlist2(ixloc,iyloc) = ix ylist2(ixloc,iyloc) = iy - elist2(ixloc,iyloc) = elmid + elist2(ixloc,iyloc) = elmid IF (dlonp < 1.0e-6_r8) THEN elist2(ixloc,iyloc) = 0 @@ -575,7 +575,7 @@ SUBROUTINE mesh_build () ENDIF iaddr(iloc) = nelm - meshtmp(iaddr(iloc))%indx = elmid + meshtmp(iaddr(iloc))%indx = elmid meshtmp(iaddr(iloc))%npxl = npxl ELSE meshtmp(iaddr(iloc))%npxl = meshtmp(iaddr(iloc))%npxl + npxl @@ -729,7 +729,7 @@ SUBROUTINE mesh_build () 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 diff --git a/share/MOD_Namelist.F90 b/share/MOD_Namelist.F90 index e210b96f..7f6fdd14 100644 --- a/share/MOD_Namelist.F90 +++ b/share/MOD_Namelist.F90 @@ -3,12 +3,12 @@ MODULE MOD_Namelist !----------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! 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 +! Initial Authors: Shupeng Zhang, Zhongwang Wei, Xingjie Lu, Nan Wei, +! Hua Yuan, Wenzong Dong et al., May 2023 !----------------------------------------------------------------------- USE MOD_Precision, only: r8 diff --git a/share/MOD_NetCDFBlock.F90 b/share/MOD_NetCDFBlock.F90 index a55978b7..6ed5242c 100644 --- a/share/MOD_NetCDFBlock.F90 +++ b/share/MOD_NetCDFBlock.F90 @@ -3,7 +3,7 @@ MODULE MOD_NetCDFBlock !---------------------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! High-level Subroutines to read and write variables in files with netCDF format. ! @@ -17,7 +17,7 @@ MODULE MOD_NetCDFBlock ! ! This MODULE contains subroutines of "3. Block". ! -! Created by Shupeng Zhang, May 2023 +! Created by Shupeng Zhang, May 2023 !---------------------------------------------------------------------------------- USE netcdf diff --git a/share/MOD_NetCDFSerial.F90 b/share/MOD_NetCDFSerial.F90 index 0e0e14db..a7a2211d 100644 --- a/share/MOD_NetCDFSerial.F90 +++ b/share/MOD_NetCDFSerial.F90 @@ -3,7 +3,7 @@ MODULE MOD_NetCDFSerial !---------------------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! High-level Subroutines to read and write variables in files with netCDF format. ! @@ -14,10 +14,10 @@ MODULE MOD_NetCDFSerial ! Notice: each file CONTAINS vector data in one block. ! 3. Block : read blocked data by IO ! Notice: input file is a single file. -! +! ! This MODULE CONTAINS subroutines of "1. Serial". ! -! Created by Shupeng Zhang, May 2023 +! Created by Shupeng Zhang, May 2023 !---------------------------------------------------------------------------------- USE netcdf @@ -119,7 +119,7 @@ MODULE MOD_NetCDFSerial MODULE procedure ncio_write_serial_real8_4d_time END INTERFACE ncio_write_serial_time - PUBLIC :: get_time_now + PUBLIC :: get_time_now PUBLIC :: ncio_write_colm_dimension @@ -127,9 +127,9 @@ MODULE MOD_NetCDFSerial ! ---- SUBROUTINE nccheck (status, trace) - + USE MOD_SPMD_Task - IMPLICIT NONE + IMPLICIT NONE integer, intent(in) :: status character(len=*), intent(in), optional :: trace @@ -166,15 +166,15 @@ END SUBROUTINE check_ncfile_exist ! ---- character(len=27) FUNCTION get_time_now () - + IMPLICIT NONE character(len=8) :: date character(len=10) :: time character(len=5) :: zone CALL date_and_time(date, time, zone) - get_time_now = date(1:8)//'-'//time(1:2)//':'//time(3:4)//':'//time(5:6) & - //' UTC'//zone(1:3)//':'//zone(4:5) + get_time_now = date(1:8)//'-'//time(1:2)//':'//time(3:4)//':'//time(5:6) & + //' UTC'//zone(1:3)//':'//zone(4:5) END FUNCTION get_time_now @@ -1097,7 +1097,7 @@ SUBROUTINE ncio_read_period_serial_real8_2d (filename, dataname, timestt, timeen integer, allocatable :: varsize(:) CALL check_ncfile_exist (filename) - + CALL ncio_inquire_varsize (filename, dataname, varsize) allocate (rdata (varsize(1), varsize(2), timestt:timeend) ) @@ -1946,7 +1946,7 @@ SUBROUTINE ncio_write_time (filename, dataname, time_component, itime, adjust) integer :: timelen, minutes minutes = minutes_since_1900 (time_component(1), time_component(2), time_component(3)) - + IF (present(adjust)) THEN SELECTCASE (trim(adjustl(adjust))) CASE ('HOURLY') @@ -1957,7 +1957,7 @@ SUBROUTINE ncio_write_time (filename, dataname, time_component, itime, adjust) minutes = minutes - 21600 CASE ('YEARLY') minutes = minutes - 262800 - ENDSELECT + ENDSELECT ENDIF CALL nccheck( nf90_open(trim(filename), NF90_WRITE, ncid) ) @@ -2008,7 +2008,7 @@ SUBROUTINE ncio_write_lastdim (filename, lastname, lastvalue, ilast) IMPLICIT NONE character (len=*), intent(in) :: filename - character (len=*), intent(in) :: lastname + character (len=*), intent(in) :: lastname integer, intent(in) :: lastvalue integer, intent(out) :: ilast @@ -2017,7 +2017,7 @@ SUBROUTINE ncio_write_lastdim (filename, lastname, lastvalue, ilast) integer, allocatable :: lastvalue_f(:) CALL nccheck( nf90_open(trim(filename), NF90_WRITE, ncid) ) - + status = nf90_inq_varid(ncid, trim(lastname), varid) IF (status == NF90_NOERR) THEN @@ -2052,7 +2052,7 @@ SUBROUTINE ncio_write_lastdim (filename, lastname, lastvalue, ilast) ENDIF CALL nccheck( nf90_put_var(ncid, varid, lastvalue, (/ilast/)) ) - + CALL nccheck( nf90_close(ncid) ) END SUBROUTINE ncio_write_lastdim @@ -2304,7 +2304,7 @@ END SUBROUTINE ncio_write_serial_real8_4d_time !---------------------- SUBROUTINE ncio_write_colm_dimension (filename) - USE MOD_Vars_Global, only : nl_soil, maxsnl, nl_lake, nvegwcs + USE MOD_Vars_Global, only: nl_soil, maxsnl, nl_lake, nvegwcs IMPLICIT NONE character(len=*), intent(in) :: filename @@ -2331,7 +2331,7 @@ SUBROUTINE ncio_write_colm_dimension (filename) CALL ncio_define_dimension (filename, 'lake', nl_lake) CALL ncio_write_serial (filename, 'lake', lakelayers, 'lake') CALL ncio_put_attr_str (filename, 'lake', 'long_name', 'vertical lake layers') - + vegnodes = (/(i, i = 1,nvegwcs)/) CALL ncio_define_dimension (filename, 'vegnodes', nvegwcs) CALL ncio_write_serial (filename, 'vegnodes', vegnodes, 'vegnodes') @@ -2345,6 +2345,6 @@ SUBROUTINE ncio_write_colm_dimension (filename) CALL ncio_write_serial (filename, 'rtyp', (/1,2/), 'rtyp') CALL ncio_put_attr_str (filename, 'rtyp', 'long_name', '1 = direct; 2 = diffuse') - END SUBROUTINE ncio_write_colm_dimension + END SUBROUTINE ncio_write_colm_dimension END MODULE MOD_NetCDFSerial diff --git a/share/MOD_NetCDFVectorBlk.F90 b/share/MOD_NetCDFVectorBlk.F90 index af93975a..5ace85a5 100644 --- a/share/MOD_NetCDFVectorBlk.F90 +++ b/share/MOD_NetCDFVectorBlk.F90 @@ -1,7 +1,7 @@ #include !---------------------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! High-level Subroutines to read and write variables in files with netCDF format. ! @@ -25,7 +25,7 @@ ! READ/WRITE may be slow in this way. ! CHOOSE this implementation by "#define VectorInOneFile" in include/define.h ! -! Created by Shupeng Zhang, May 2023 +! Created by Shupeng Zhang, May 2023 !---------------------------------------------------------------------------------- ! Put vector in separated files. diff --git a/share/MOD_NetCDFVectorOneP.F90 b/share/MOD_NetCDFVectorOneP.F90 index b1f95d0e..b8b687d2 100644 --- a/share/MOD_NetCDFVectorOneP.F90 +++ b/share/MOD_NetCDFVectorOneP.F90 @@ -1,7 +1,7 @@ #include !---------------------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! High-level Subroutines to read and write variables in files with netCDF format. ! @@ -11,21 +11,21 @@ ! 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 VectorInOneFileP" in include/define.h ! -! Created by Shupeng Zhang, May 2023 +! Created by Shupeng Zhang, May 2023 !---------------------------------------------------------------------------------- ! Put vector in one file. @@ -38,39 +38,39 @@ MODULE MOD_NetCDFVector USE MOD_SPMD_Task USE MOD_Block USE MOD_Pixelset - USE MOD_NetCDFSerial, only : nccheck + USE MOD_NetCDFSerial, only: nccheck IMPLICIT NONE ! PUBLIC subroutines - PUBLIC :: ncio_create_file_vector - PUBLIC :: ncio_define_dimension_vector + PUBLIC :: ncio_create_file_vector + PUBLIC :: ncio_define_dimension_vector 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 INTERFACE ncio_write_vector MODULE procedure ncio_write_vector_logical_1d - MODULE procedure ncio_write_vector_int32_1d - 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_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_open_vector (filename, dataname, exit_on_err, ncid, grpid, vecname, noerr) - + IMPLICIT NONE character(len=*), intent(in) :: filename @@ -80,7 +80,7 @@ SUBROUTINE ncio_open_vector (filename, dataname, exit_on_err, ncid, grpid, vecna integer, intent(out) :: ncid, grpid logical, intent(out) :: noerr character(len=*), intent(out) :: vecname - + noerr = (nf90_open(trim(filename), NF90_NOWRITE, ncid) == NF90_NOERR) IF (.not. noerr) write(*,*) 'Warning: '//trim(filename)//' not found.' @@ -91,12 +91,12 @@ SUBROUTINE ncio_open_vector (filename, dataname, exit_on_err, ncid, grpid, vecna IF (.not. noerr) write(*,*) 'Warning: '//trim(vecname)//' in '//trim(filename)//' not found.' IF ((.not. noerr) .and. (exit_on_err)) THEN - write(*,'(A)') 'Netcdf error in reading ' // trim(dataname) // ' from ' // trim(filename) + write(*,'(A)') 'Netcdf error in reading ' // trim(dataname) // ' from ' // trim(filename) CALL CoLM_Stop () ENDIF END SUBROUTINE ncio_open_vector - + !--------------------------------------------------------- SUBROUTINE ncio_inquire_length_grp (filename, dataname, blkname, length) @@ -204,9 +204,9 @@ SUBROUTINE ncio_read_vector_int32_1d ( & ENDIF IF (.not. ok) THEN - IF (.not. present(defval)) THEN + IF (.not. present(defval)) THEN write(*,'(A)') 'Netcdf error in reading ' & - // trim(varname) // ' from ' // trim(filename) + // trim(varname) // ' from ' // trim(filename) CALL CoLM_Stop () ELSE sbuff = defval @@ -228,18 +228,18 @@ SUBROUTINE ncio_read_vector_int32_1d ( & deallocate (sbuff) ENDDO - + IF (noerr) CALL nccheck( nf90_close(ncid), trim(filename) // ' close failed' ) ENDIF #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 @@ -312,9 +312,9 @@ SUBROUTINE ncio_read_vector_int64_1d ( & ENDIF IF (.not. ok) THEN - IF (.not. present(defval)) THEN + IF (.not. present(defval)) THEN write(*,'(A)') 'Netcdf error in reading ' & - // trim(varname) // ' from ' // trim(filename) + // trim(varname) // ' from ' // trim(filename) CALL CoLM_Stop () ELSE sbuff = defval @@ -343,11 +343,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 @@ -420,9 +420,9 @@ SUBROUTINE ncio_read_vector_logical_1d (filename, dataname, pixelset, rdata, & ENDIF IF (.not. ok) THEN - IF (.not. present(defval)) THEN + IF (.not. present(defval)) THEN write(*,'(A)') 'Netcdf error in reading ' & - // trim(varname) // ' from ' // trim(filename) + // trim(varname) // ' from ' // trim(filename) CALL CoLM_Stop () ELSE IF (defval) THEN @@ -450,7 +450,7 @@ SUBROUTINE ncio_read_vector_logical_1d (filename, dataname, pixelset, rdata, & ENDDO IF (noerr) CALL nccheck( nf90_close(ncid), trim(filename) // ' close failed' ) - + ENDIF #ifdef USEMPI @@ -504,13 +504,13 @@ SUBROUTINE ncio_read_vector_real8_1d (filename, dataname, pixelset, rdata, & character(len=256) :: blockname, varname, vecname real(r8), allocatable :: sbuff(:), rbuff(:) logical :: noerr, ok - + IF (p_is_worker) THEN IF ((pixelset%nset > 0) .and. (.not. allocated(rdata))) THEN allocate (rdata (pixelset%nset)) ENDIF ENDIF - + IF (p_is_io) THEN CALL ncio_open_vector (filename, dataname, .not. present(defval), & @@ -532,9 +532,9 @@ SUBROUTINE ncio_read_vector_real8_1d (filename, dataname, pixelset, rdata, & ENDIF IF (.not. ok) THEN - IF (.not. present(defval)) THEN + IF (.not. present(defval)) THEN write(*,'(A)') 'Netcdf error in reading ' & - // trim(varname) // ' from ' // trim(filename) + // trim(varname) // ' from ' // trim(filename) CALL CoLM_Stop () ELSE sbuff = defval @@ -558,12 +558,12 @@ SUBROUTINE ncio_read_vector_real8_1d (filename, dataname, pixelset, rdata, & ENDDO IF (noerr) CALL nccheck( nf90_close(ncid), trim(filename) // ' close failed' ) - + ENDIF #ifdef USEMPI IF (p_is_worker) THEN - + DO iblkgrp = 1, pixelset%nblkgrp iblk = pixelset%xblkgrp(iblkgrp) jblk = pixelset%yblkgrp(iblkgrp) @@ -630,7 +630,7 @@ SUBROUTINE ncio_read_vector_real8_2d ( & jblk = pixelset%yblkgrp(iblkgrp) allocate (sbuff (ndim1, pixelset%vecgs%vlen(iblk,jblk))) - + IF (noerr) THEN CALL get_blockname (iblk, jblk, blockname) varname = trim(vecname)//'_'//trim(blockname) @@ -641,9 +641,9 @@ SUBROUTINE ncio_read_vector_real8_2d ( & ENDIF IF (.not. ok) THEN - IF (.not. present(defval)) THEN + IF (.not. present(defval)) THEN write(*,'(A)') 'Netcdf error in reading ' & - // trim(varname) // ' from ' // trim(filename) + // trim(varname) // ' from ' // trim(filename) CALL CoLM_Stop () ELSE sbuff = defval @@ -672,7 +672,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) @@ -750,9 +750,9 @@ SUBROUTINE ncio_read_vector_real8_3d ( & ENDIF IF (.not. ok) THEN - IF (.not. present(defval)) THEN + IF (.not. present(defval)) THEN write(*,'(A)') 'Netcdf error in reading ' & - // trim(varname) // ' from ' // trim(filename) + // trim(varname) // ' from ' // trim(filename) CALL CoLM_Stop () ELSE sbuff = defval @@ -774,7 +774,7 @@ SUBROUTINE ncio_read_vector_real8_3d ( & deallocate (sbuff) ENDDO - + IF (noerr) CALL nccheck( nf90_close(ncid), trim(filename) // ' close failed' ) ENDIF @@ -811,7 +811,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) @@ -859,9 +859,9 @@ SUBROUTINE ncio_read_vector_real8_4d ( & ENDIF IF (.not. ok) THEN - IF (.not. present(defval)) THEN + IF (.not. present(defval)) THEN write(*,'(A)') 'Netcdf error in reading ' & - // trim(varname) // ' from ' // trim(filename) + // trim(varname) // ' from ' // trim(filename) CALL CoLM_Stop () ELSE sbuff = defval @@ -890,7 +890,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) @@ -920,11 +920,11 @@ SUBROUTINE ncio_read_vector_real8_4d ( & #endif END SUBROUTINE ncio_read_vector_real8_4d - + !--------------------------------------------------------- SUBROUTINE ncio_create_file_vector (filename, pixelset) - USE MOD_NetCDFSerial, only : get_time_now + USE MOD_NetCDFSerial, only: get_time_now IMPLICIT NONE character(len=*), intent(in) :: filename @@ -970,7 +970,7 @@ SUBROUTINE ncio_define_dimension_vector (filename, pixelset, dimname, dimlen) character(len=8) :: blockname IF (p_is_io) THEN - + #ifdef USEMPI CALL nccheck( nf90_open (trim(filename), ior(NF90_WRITE,NF90_NETCDF4), ncid, & comm = p_comm_io, info = MPI_INFO_NULL) ) @@ -1001,14 +1001,14 @@ SUBROUTINE ncio_define_dimension_vector (filename, pixelset, dimname, dimlen) ENDDO ENDIF - + CALL nccheck (nf90_enddef(ncid)) CALL nccheck (nf90_close (ncid)) #ifdef USEMPI CALL mpi_barrier (p_comm_io, p_err) #endif ENDIF - + END SUBROUTINE ncio_define_dimension_vector !--------------------------------------------------------- @@ -1147,14 +1147,14 @@ SUBROUTINE ncio_write_vector_int32_1d ( & deallocate (rbuff) ENDDO - + CALL nccheck( nf90_close(ncid) ) #ifdef USEMPI CALL mpi_barrier (p_comm_io, p_err) #endif ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1250,14 +1250,14 @@ SUBROUTINE ncio_write_vector_logical_1d ( & deallocate (rbuff) ENDDO - + CALL nccheck( nf90_close(ncid) ) #ifdef USEMPI CALL mpi_barrier (p_comm_io, p_err) #endif ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1360,7 +1360,7 @@ SUBROUTINE ncio_write_vector_int64_1d ( & #endif ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1402,7 +1402,7 @@ SUBROUTINE ncio_write_vector_real8_1d ( & character(len=*), intent(in) :: vecname type(pixelset_type), intent(in) :: pixelset real(r8), intent(in) :: wdata (:) - + integer, intent(in), optional :: compress_level ! Local variables @@ -1456,7 +1456,7 @@ SUBROUTINE ncio_write_vector_real8_1d ( & CALL mpi_barrier (p_comm_io, p_err) #endif ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1554,7 +1554,7 @@ SUBROUTINE ncio_write_vector_real8_2d ( & CALL mpi_barrier (p_comm_io, p_err) #endif ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1598,7 +1598,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 @@ -1652,7 +1652,7 @@ SUBROUTINE ncio_write_vector_real8_3d ( & CALL mpi_barrier (p_comm_io, p_err) #endif ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1696,7 +1696,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 @@ -1751,7 +1751,7 @@ SUBROUTINE ncio_write_vector_real8_4d ( & CALL mpi_barrier (p_comm_io, p_err) #endif ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN diff --git a/share/MOD_NetCDFVectorOneS.F90 b/share/MOD_NetCDFVectorOneS.F90 index ff60fa65..e85884a4 100644 --- a/share/MOD_NetCDFVectorOneS.F90 +++ b/share/MOD_NetCDFVectorOneS.F90 @@ -1,7 +1,7 @@ #include !---------------------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! High-level Subroutines to read and write variables in files with netCDF format. ! @@ -11,21 +11,21 @@ ! 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 VectorInOneFileS" in include/define.h ! -! Created by Shupeng Zhang, May 2023 +! Created by Shupeng Zhang, May 2023 !---------------------------------------------------------------------------------- ! Put vector in one file. @@ -38,39 +38,39 @@ MODULE MOD_NetCDFVector USE MOD_SPMD_Task USE MOD_Block USE MOD_Pixelset - USE MOD_NetCDFSerial, only : nccheck + USE MOD_NetCDFSerial, only: nccheck IMPLICIT NONE ! PUBLIC subroutines - PUBLIC :: ncio_create_file_vector - PUBLIC :: ncio_define_dimension_vector + PUBLIC :: ncio_create_file_vector + PUBLIC :: ncio_define_dimension_vector 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 INTERFACE ncio_write_vector MODULE procedure ncio_write_vector_logical_1d - MODULE procedure ncio_write_vector_int32_1d - 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_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_open_vector (filename, dataname, exit_on_err, ncid, grpid, vecname, noerr) - + IMPLICIT NONE character(len=*), intent(in) :: filename @@ -80,7 +80,7 @@ SUBROUTINE ncio_open_vector (filename, dataname, exit_on_err, ncid, grpid, vecna integer, intent(out) :: ncid, grpid logical, intent(out) :: noerr character(len=*), intent(out) :: vecname - + noerr = (nf90_open(trim(filename), NF90_NOWRITE, ncid) == NF90_NOERR) IF (.not. noerr) write(*,*) 'Warning: '//trim(filename)//' not found.' @@ -91,12 +91,12 @@ SUBROUTINE ncio_open_vector (filename, dataname, exit_on_err, ncid, grpid, vecna IF (.not. noerr) write(*,*) 'Warning: '//trim(vecname)//' in '//trim(filename)//' not found.' IF ((.not. noerr) .and. (exit_on_err)) THEN - write(*,'(A)') 'Netcdf error in reading ' // trim(dataname) // ' from ' // trim(filename) + write(*,'(A)') 'Netcdf error in reading ' // trim(dataname) // ' from ' // trim(filename) CALL CoLM_Stop () ENDIF END SUBROUTINE ncio_open_vector - + !--------------------------------------------------------- SUBROUTINE ncio_inquire_length_grp (filename, dataname, blkname, length) @@ -204,9 +204,9 @@ SUBROUTINE ncio_read_vector_int32_1d ( & ENDIF IF (.not. ok) THEN - IF (.not. present(defval)) THEN + IF (.not. present(defval)) THEN write(*,'(A)') 'Netcdf error in reading ' & - // trim(varname) // ' from ' // trim(filename) + // trim(varname) // ' from ' // trim(filename) CALL CoLM_Stop () ELSE sbuff = defval @@ -228,18 +228,18 @@ SUBROUTINE ncio_read_vector_int32_1d ( & deallocate (sbuff) ENDDO - + IF (noerr) CALL nccheck( nf90_close(ncid), trim(filename) // ' close failed' ) ENDIF #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 @@ -312,9 +312,9 @@ SUBROUTINE ncio_read_vector_int64_1d ( & ENDIF IF (.not. ok) THEN - IF (.not. present(defval)) THEN + IF (.not. present(defval)) THEN write(*,'(A)') 'Netcdf error in reading ' & - // trim(varname) // ' from ' // trim(filename) + // trim(varname) // ' from ' // trim(filename) CALL CoLM_Stop () ELSE sbuff = defval @@ -343,11 +343,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 @@ -420,9 +420,9 @@ SUBROUTINE ncio_read_vector_logical_1d (filename, dataname, pixelset, rdata, & ENDIF IF (.not. ok) THEN - IF (.not. present(defval)) THEN + IF (.not. present(defval)) THEN write(*,'(A)') 'Netcdf error in reading ' & - // trim(varname) // ' from ' // trim(filename) + // trim(varname) // ' from ' // trim(filename) CALL CoLM_Stop () ELSE IF (defval) THEN @@ -450,7 +450,7 @@ SUBROUTINE ncio_read_vector_logical_1d (filename, dataname, pixelset, rdata, & ENDDO IF (noerr) CALL nccheck( nf90_close(ncid), trim(filename) // ' close failed' ) - + ENDIF #ifdef USEMPI @@ -504,13 +504,13 @@ SUBROUTINE ncio_read_vector_real8_1d (filename, dataname, pixelset, rdata, & character(len=256) :: blockname, varname, vecname real(r8), allocatable :: sbuff(:), rbuff(:) logical :: noerr, ok - + IF (p_is_worker) THEN IF ((pixelset%nset > 0) .and. (.not. allocated(rdata))) THEN allocate (rdata (pixelset%nset)) ENDIF ENDIF - + IF (p_is_io) THEN CALL ncio_open_vector (filename, dataname, .not. present(defval), & @@ -532,9 +532,9 @@ SUBROUTINE ncio_read_vector_real8_1d (filename, dataname, pixelset, rdata, & ENDIF IF (.not. ok) THEN - IF (.not. present(defval)) THEN + IF (.not. present(defval)) THEN write(*,'(A)') 'Netcdf error in reading ' & - // trim(varname) // ' from ' // trim(filename) + // trim(varname) // ' from ' // trim(filename) CALL CoLM_Stop () ELSE sbuff = defval @@ -558,12 +558,12 @@ SUBROUTINE ncio_read_vector_real8_1d (filename, dataname, pixelset, rdata, & ENDDO IF (noerr) CALL nccheck( nf90_close(ncid), trim(filename) // ' close failed' ) - + ENDIF #ifdef USEMPI IF (p_is_worker) THEN - + DO iblkgrp = 1, pixelset%nblkgrp iblk = pixelset%xblkgrp(iblkgrp) jblk = pixelset%yblkgrp(iblkgrp) @@ -630,7 +630,7 @@ SUBROUTINE ncio_read_vector_real8_2d ( & jblk = pixelset%yblkgrp(iblkgrp) allocate (sbuff (ndim1, pixelset%vecgs%vlen(iblk,jblk))) - + IF (noerr) THEN CALL get_blockname (iblk, jblk, blockname) varname = trim(vecname)//'_'//trim(blockname) @@ -641,9 +641,9 @@ SUBROUTINE ncio_read_vector_real8_2d ( & ENDIF IF (.not. ok) THEN - IF (.not. present(defval)) THEN + IF (.not. present(defval)) THEN write(*,'(A)') 'Netcdf error in reading ' & - // trim(varname) // ' from ' // trim(filename) + // trim(varname) // ' from ' // trim(filename) CALL CoLM_Stop () ELSE sbuff = defval @@ -672,7 +672,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) @@ -750,9 +750,9 @@ SUBROUTINE ncio_read_vector_real8_3d ( & ENDIF IF (.not. ok) THEN - IF (.not. present(defval)) THEN + IF (.not. present(defval)) THEN write(*,'(A)') 'Netcdf error in reading ' & - // trim(varname) // ' from ' // trim(filename) + // trim(varname) // ' from ' // trim(filename) CALL CoLM_Stop () ELSE sbuff = defval @@ -774,7 +774,7 @@ SUBROUTINE ncio_read_vector_real8_3d ( & deallocate (sbuff) ENDDO - + IF (noerr) CALL nccheck( nf90_close(ncid), trim(filename) // ' close failed' ) ENDIF @@ -811,7 +811,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) @@ -859,9 +859,9 @@ SUBROUTINE ncio_read_vector_real8_4d ( & ENDIF IF (.not. ok) THEN - IF (.not. present(defval)) THEN + IF (.not. present(defval)) THEN write(*,'(A)') 'Netcdf error in reading ' & - // trim(varname) // ' from ' // trim(filename) + // trim(varname) // ' from ' // trim(filename) CALL CoLM_Stop () ELSE sbuff = defval @@ -890,7 +890,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) @@ -920,11 +920,11 @@ SUBROUTINE ncio_read_vector_real8_4d ( & #endif END SUBROUTINE ncio_read_vector_real8_4d - + !--------------------------------------------------------- SUBROUTINE ncio_create_file_vector (filename, pixelset) - USE MOD_NetCDFSerial, only : get_time_now + USE MOD_NetCDFSerial, only: get_time_now IMPLICIT NONE character(len=*), intent(in) :: filename @@ -934,7 +934,7 @@ SUBROUTINE ncio_create_file_vector (filename, pixelset) integer :: ncid, mode IF (p_is_master) THEN - + mode = ior(NF90_NETCDF4,NF90_CLOBBER) CALL nccheck( nf90_create(trim(filename), mode, ncid) ) @@ -964,8 +964,8 @@ SUBROUTINE ncio_define_dimension_vector (filename, pixelset, dimname, dimlen) character(len=8) :: blockname IF (p_is_io) THEN - - IF (p_iam_io == 0) THEN + + IF (p_iam_io == 0) THEN CALL nccheck( nf90_open (trim(filename), ior(NF90_WRITE,NF90_NETCDF4), ncid) ) @@ -1002,7 +1002,7 @@ SUBROUTINE ncio_define_dimension_vector (filename, pixelset, dimname, dimlen) CALL mpi_barrier (p_comm_io, p_err) #endif ENDIF - + END SUBROUTINE ncio_define_dimension_vector !--------------------------------------------------------- @@ -1074,7 +1074,7 @@ SUBROUTINE ncio_define_variable_vector ( & deallocate (dimids) - ENDIF + ENDIF #ifdef USEMPI CALL mpi_barrier (p_comm_io, p_err) @@ -1121,7 +1121,7 @@ SUBROUTINE ncio_write_vector_int32_1d ( & ELSE CALL ncio_define_variable_vector (filename, pixelset, vecname, dataname, NF90_INT) ENDIF - + allocate(rbuff(pixelset%nblkgrp)) DO iblkgrp = 1, pixelset%nblkgrp @@ -1153,7 +1153,7 @@ SUBROUTINE ncio_write_vector_int32_1d ( & jblk = pixelset%yblkgrp(iblkgrp) CALL get_blockname (iblk, jblk, blockname) - CALL nccheck( nf90_inq_varid(grpid, trim(vecname)//'_'//trim(blockname), varid) ) + CALL nccheck( nf90_inq_varid(grpid, trim(vecname)//'_'//trim(blockname), varid) ) CALL nccheck( nf90_put_var (grpid, varid, rbuff(iblkgrp)%val) ) deallocate (rbuff(iblkgrp)%val) @@ -1166,7 +1166,7 @@ SUBROUTINE ncio_write_vector_int32_1d ( & CALL mpi_send (lock, 1, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) #endif ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1240,7 +1240,7 @@ SUBROUTINE ncio_write_vector_logical_1d ( & ELSE CALL ncio_define_variable_vector (filename, pixelset, vecname, dataname, NF90_BYTE) ENDIF - + allocate(rbuff(pixelset%nblkgrp)) DO iblkgrp = 1, pixelset%nblkgrp @@ -1276,14 +1276,14 @@ SUBROUTINE ncio_write_vector_logical_1d ( & DO iblkgrp = 1, pixelset%nblkgrp iblk = pixelset%xblkgrp(iblkgrp) jblk = pixelset%yblkgrp(iblkgrp) - + CALL get_blockname (iblk, jblk, blockname) CALL nccheck( nf90_inq_varid(grpid, trim(vecname)//'_'//trim(blockname), varid)) CALL nccheck( nf90_put_var (grpid, varid, rbuff(iblkgrp)%val) ) - + deallocate (rbuff(iblkgrp)%val) ENDDO - + deallocate (rbuff) CALL nccheck( nf90_sync (ncid) ) CALL nccheck( nf90_close(ncid) ) @@ -1291,7 +1291,7 @@ SUBROUTINE ncio_write_vector_logical_1d ( & CALL mpi_send (lock, 1, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) #endif ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1371,7 +1371,7 @@ SUBROUTINE ncio_write_vector_int64_1d ( & ELSE CALL ncio_define_variable_vector (filename, pixelset, vecname, dataname, NF90_INT64) ENDIF - + allocate(rbuff(pixelset%nblkgrp)) DO iblkgrp = 1, pixelset%nblkgrp @@ -1405,7 +1405,7 @@ SUBROUTINE ncio_write_vector_int64_1d ( & CALL get_blockname (iblk, jblk, blockname) CALL nccheck( nf90_inq_varid(grpid, trim(vecname)//'_'//trim(blockname), varid)) CALL nccheck( nf90_put_var (grpid, varid, rbuff(iblkgrp)%val) ) - + deallocate (rbuff(iblkgrp)%val) ENDDO @@ -1416,7 +1416,7 @@ SUBROUTINE ncio_write_vector_int64_1d ( & CALL mpi_send (lock, 1, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) #endif ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1462,7 +1462,7 @@ SUBROUTINE ncio_write_vector_real8_1d ( & character(len=*), intent(in) :: vecname type(pixelset_type), intent(in) :: pixelset real(r8), intent(in) :: wdata (:) - + integer, intent(in), optional :: compress_level ! Local variables @@ -1483,7 +1483,7 @@ SUBROUTINE ncio_write_vector_real8_1d ( & #endif IF (p_is_io) THEN - + IF (present(compress_level)) THEN CALL ncio_define_variable_vector (filename, pixelset, vecname, dataname, NF90_DOUBLE, & compress = compress_level) @@ -1524,7 +1524,7 @@ SUBROUTINE ncio_write_vector_real8_1d ( & CALL get_blockname (iblk, jblk, blockname) CALL nccheck( nf90_inq_varid(grpid, trim(vecname)//'_'//trim(blockname), varid)) CALL nccheck( nf90_put_var (grpid, varid, rbuff(iblkgrp)%val) ) - + deallocate (rbuff(iblkgrp)%val) ENDDO @@ -1535,7 +1535,7 @@ SUBROUTINE ncio_write_vector_real8_1d ( & CALL mpi_send (lock, 1, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) #endif ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1612,7 +1612,7 @@ SUBROUTINE ncio_write_vector_real8_2d ( & CALL ncio_define_variable_vector (filename, pixelset, vecname, dataname, NF90_DOUBLE, & dim1name = dim1name) ENDIF - + allocate(rbuff(pixelset%nblkgrp)) DO iblkgrp = 1, pixelset%nblkgrp @@ -1646,7 +1646,7 @@ SUBROUTINE ncio_write_vector_real8_2d ( & CALL get_blockname (iblk, jblk, blockname) CALL nccheck( nf90_inq_varid(grpid, trim(vecname)//'_'//trim(blockname), varid)) CALL nccheck( nf90_put_var (grpid, varid, rbuff(iblkgrp)%val) ) - + deallocate (rbuff(iblkgrp)%val) ENDDO @@ -1657,7 +1657,7 @@ SUBROUTINE ncio_write_vector_real8_2d ( & CALL mpi_send (lock, 1, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) #endif ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1705,7 +1705,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 @@ -1734,7 +1734,7 @@ SUBROUTINE ncio_write_vector_real8_3d ( & CALL ncio_define_variable_vector (filename, pixelset, vecname, dataname, NF90_DOUBLE, & dim1name = dim1name, dim2name = dim2name) ENDIF - + allocate(rbuff(pixelset%nblkgrp)) DO iblkgrp = 1, pixelset%nblkgrp @@ -1768,10 +1768,10 @@ SUBROUTINE ncio_write_vector_real8_3d ( & CALL get_blockname (iblk, jblk, blockname) CALL nccheck( nf90_inq_varid(grpid, trim(vecname)//'_'//trim(blockname), varid)) CALL nccheck( nf90_put_var (grpid, varid, rbuff(iblkgrp)%val) ) - + deallocate (rbuff(iblkgrp)%val) ENDDO - + deallocate (rbuff) CALL nccheck( nf90_sync (ncid) ) CALL nccheck( nf90_close(ncid) ) @@ -1779,7 +1779,7 @@ SUBROUTINE ncio_write_vector_real8_3d ( & CALL mpi_send (lock, 1, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) #endif ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN @@ -1827,7 +1827,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 @@ -1857,7 +1857,7 @@ SUBROUTINE ncio_write_vector_real8_4d ( & CALL ncio_define_variable_vector (filename, pixelset, vecname, dataname, NF90_DOUBLE, & dim1name = dim1name, dim2name = dim2name, dim3name = dim3name) ENDIF - + allocate(rbuff(pixelset%nblkgrp)) DO iblkgrp = 1, pixelset%nblkgrp @@ -1891,7 +1891,7 @@ SUBROUTINE ncio_write_vector_real8_4d ( & CALL get_blockname (iblk, jblk, blockname) CALL nccheck( nf90_inq_varid(grpid, trim(vecname)//'_'//trim(blockname), varid)) CALL nccheck( nf90_put_var (grpid, varid, rbuff(iblkgrp)%val) ) - + deallocate (rbuff(iblkgrp)%val) ENDDO @@ -1902,7 +1902,7 @@ SUBROUTINE ncio_write_vector_real8_4d ( & CALL mpi_send (lock, 1, MPI_INTEGER, p_address_master, mpi_tag_mesg, p_comm_glb, p_err) #endif ENDIF - + #ifdef USEMPI IF (p_is_worker) THEN diff --git a/share/MOD_Pixel.F90 b/share/MOD_Pixel.F90 index 1ed67fe7..cf18c44c 100644 --- a/share/MOD_Pixel.F90 +++ b/share/MOD_Pixel.F90 @@ -3,23 +3,23 @@ MODULE MOD_Pixel !------------------------------------------------------------------------------------ -! DESCRIPTION: +! !DESCRIPTION: ! ! Pixels are rasterized points defined by fine-resolution data. -! -! CoLM USE multiple grids to construct pixels. Grids are assimilated into pixel -! coordinate one by one. One grid is assimilated by adding grid lines not present +! +! CoLM USE multiple grids to construct pixels. Grids are assimilated into pixel +! coordinate one by one. One grid is assimilated by adding grid lines not present ! in pixel coordinate. In other words, pixel coordinate is the union of all grids. -! -! Pixels are used to carry out land surface tessellation. The grids used to -! construct pixels are associated with surface data such as land cover types, soil -! parameters, plant function types, leaf area index and forest height. +! +! Pixels are used to carry out land surface tessellation. The grids used to +! construct pixels are associated with surface data such as land cover types, soil +! parameters, plant function types, leaf area index and forest height. ! By using pixels, these variables are downscaled to fine resolution. ! ! In pixel data type, region boundaries and each pixel boundaries are defined. ! Subroutines to assimilate grid and map pixel to grid are defined as methods. -! -! Created by Shupeng Zhang, May 2023 +! +! Created by Shupeng Zhang, May 2023 !------------------------------------------------------------------------------------ USE MOD_Precision @@ -32,38 +32,38 @@ MODULE MOD_Pixel real(r8) :: edgen ! northern edge (degrees) real(r8) :: edgew ! western edge (degrees) real(r8) :: edgee ! eastern edge (degrees) - + integer :: nlon, nlat real(r8), allocatable :: lat_s (:) real(r8), allocatable :: lat_n (:) real(r8), allocatable :: lon_w (:) real(r8), allocatable :: lon_e (:) - CONTAINS + CONTAINS procedure, PUBLIC :: set_edges => pixel_set_edges - procedure, PRIVATE :: assimilate_latlon => pixel_assimilate_latlon - procedure, PUBLIC :: assimilate_gblock => pixel_assimilate_gblock - procedure, PUBLIC :: assimilate_grid => pixel_assimilate_grid + procedure, PRIVATE :: assimilate_latlon => pixel_assimilate_latlon + procedure, PUBLIC :: assimilate_gblock => pixel_assimilate_gblock + procedure, PUBLIC :: assimilate_grid => pixel_assimilate_grid procedure, PUBLIC :: map_to_grid => pixel_map_to_grid procedure, PUBLIC :: save_to_file => pixel_save_to_file procedure, PUBLIC :: load_from_file => pixel_load_from_file - + final :: pixel_free_mem END type pixel_type - + ! ---- Instance ---- type(pixel_type) :: pixel CONTAINS - + ! -------------------------------- - SUBROUTINE pixel_set_edges (this, & + SUBROUTINE pixel_set_edges (this, & edges_in, edgen_in, edgew_in, edgee_in) - + USE MOD_Precision USE MOD_SPMD_Task USE MOD_Utils @@ -81,7 +81,7 @@ SUBROUTINE pixel_set_edges (this, & this%edgen = edgen_in this%edgew = edgew_in this%edgee = edgee_in - + CALL normalize_longitude (this%edgew) CALL normalize_longitude (this%edgee) @@ -141,14 +141,14 @@ SUBROUTINE pixel_assimilate_latlon (this, & allocate (ytmp (this%nlat+nlat+2)) ny = 0 - DO iy1 = 1, this%nlat + DO iy1 = 1, this%nlat ny = ny + 1 ytmp(ny) = this%lat_s(iy1) - IF ((this%lat_s(iy1) < north) .and. (this%lat_n(iy1) > south)) THEN - ys2 = find_nearest_south (this%lat_s(iy1), nlat, lat_s) - yn2 = find_nearest_north (this%lat_n(iy1), nlat, lat_n) + IF ((this%lat_s(iy1) < north) .and. (this%lat_n(iy1) > south)) THEN + ys2 = find_nearest_south (this%lat_s(iy1), nlat, lat_s) + yn2 = find_nearest_north (this%lat_n(iy1), nlat, lat_n) DO iy2 = ys2, yn2, yinc IF (lat_s(iy2) > this%lat_s(iy1)) THEN ny = ny + 1 @@ -176,7 +176,7 @@ SUBROUTINE pixel_assimilate_latlon (this, & this%lat_n = ytmp(2:ny) deallocate (ytmp) - + west = lon_w(1) east = lon_e(nlon) @@ -198,7 +198,7 @@ SUBROUTINE pixel_assimilate_latlon (this, & nx = nx + 1 xtmp(nx) = this%lon_w(ix1) - xw2 = find_nearest_west (this%lon_w(ix1), nlonc, loncirc) + 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 @@ -218,7 +218,7 @@ SUBROUTINE pixel_assimilate_latlon (this, & ENDDO ENDDO - + nx = nx + 1 xtmp(nx) = this%lon_e(this%nlon) @@ -239,14 +239,14 @@ END SUBROUTINE pixel_assimilate_latlon ! -------------------------------- SUBROUTINE pixel_assimilate_gblock (this) - USE MOD_Block, only : gblock + USE MOD_Block, only: gblock IMPLICIT NONE class(pixel_type) :: this CALL this%assimilate_latlon ( & gblock%nyblk, gblock%lat_s, gblock%lat_n, & gblock%nxblk, gblock%lon_w, gblock%lon_e) - + END SUBROUTINE pixel_assimilate_gblock ! -------------------------------- @@ -261,7 +261,7 @@ SUBROUTINE pixel_assimilate_grid (this, grid) CALL this%assimilate_latlon ( & grid%nlat, grid%lat_s, grid%lat_n, & grid%nlon, grid%lon_w, grid%lon_e) - + END SUBROUTINE pixel_assimilate_grid ! -------------------------------- @@ -272,7 +272,7 @@ SUBROUTINE pixel_map_to_grid (this, grd) IMPLICIT NONE class(pixel_type) :: this - type(grid_type), intent(inout) :: grd + type(grid_type), intent(inout) :: grd ! Local variables integer :: iy1, iy2, ix1, ix2 @@ -282,7 +282,7 @@ SUBROUTINE pixel_map_to_grid (this, grd) IF (allocated (grd%ygrd)) deallocate (grd%ygrd) allocate (grd%ygrd (this%nlat)) - + IF (grd%yinc == 1) THEN south = grd%lat_s(1) north = grd%lat_n(grd%nlat) @@ -293,8 +293,8 @@ SUBROUTINE pixel_map_to_grid (this, grd) iy1 = 1 DO WHILE (.true.) - IF ((this%lat_s(iy1) < north) .and. (this%lat_n(iy1) > south)) THEN - iy2 = find_nearest_south (this%lat_s(iy1), grd%nlat, grd%lat_s) + IF ((this%lat_s(iy1) < north) .and. (this%lat_n(iy1) > south)) THEN + iy2 = find_nearest_south (this%lat_s(iy1), grd%nlat, grd%lat_s) DO WHILE (this%lat_n(iy1) <= grd%lat_n(iy2)) grd%ygrd(iy1) = iy2 iy1 = iy1 + 1 @@ -313,13 +313,13 @@ SUBROUTINE pixel_map_to_grid (this, grd) west = grd%lon_w(1) east = grd%lon_e(grd%nlon) - + ix1 = 1 DO WHILE (.true.) IF ( lon_between_floor(this%lon_w(ix1), west, east) & .or. lon_between_ceil (this%lon_e(ix1), west, east) ) THEN - ix2 = find_nearest_west (this%lon_w(ix1), grd%nlon, grd%lon_w) + ix2 = find_nearest_west (this%lon_w(ix1), grd%nlon, grd%lon_w) DO WHILE (lon_between_ceil(this%lon_e(ix1), grd%lon_w(ix2), grd%lon_e(ix2))) grd%xgrd(ix1) = ix2 ix1 = ix1 + 1 @@ -335,7 +335,7 @@ SUBROUTINE pixel_map_to_grid (this, grd) IF (ix1 > this%nlon) EXIT ENDDO - END SUBROUTINE pixel_map_to_grid + END SUBROUTINE pixel_map_to_grid ! -------------------------------- SUBROUTINE pixel_save_to_file (this, dir_landdata) @@ -345,17 +345,17 @@ SUBROUTINE pixel_save_to_file (this, dir_landdata) IMPLICIT NONE class(pixel_type) :: this - character(len=*), intent(in) :: dir_landdata + character(len=*), intent(in) :: dir_landdata ! Local variables character(len=256) :: filename IF (p_is_master) THEN - + filename = trim(dir_landdata) // '/pixel.nc' CALL ncio_create_file (filename) - + CALL ncio_write_serial (filename, 'edges', this%edges) CALL ncio_write_serial (filename, 'edgen', this%edgen) CALL ncio_write_serial (filename, 'edgew', this%edgew) @@ -376,7 +376,7 @@ END SUBROUTINE pixel_save_to_file ! -------------------------------- SUBROUTINE pixel_load_from_file (this, dir_landdata) - USE MOD_NetCDFSerial + USE MOD_NetCDFSerial IMPLICIT NONE class(pixel_type) :: this @@ -404,7 +404,7 @@ END SUBROUTINE pixel_load_from_file ! -------------------------------- SUBROUTINE pixel_free_mem (this) - + IMPLICIT NONE type (pixel_type) :: this @@ -413,6 +413,6 @@ SUBROUTINE pixel_free_mem (this) IF (allocated(this%lon_w)) deallocate(this%lon_w) IF (allocated(this%lon_e)) deallocate(this%lon_e) - END SUBROUTINE pixel_free_mem + END SUBROUTINE pixel_free_mem END MODULE MOD_Pixel diff --git a/share/MOD_Pixelset.F90 b/share/MOD_Pixelset.F90 index c26c56be..6642f4fd 100644 --- a/share/MOD_Pixelset.F90 +++ b/share/MOD_Pixelset.F90 @@ -3,7 +3,7 @@ MODULE MOD_Pixelset !------------------------------------------------------------------------------------ -! DESCRIPTION: +! !DESCRIPTION: ! ! Pixelset refers to a set of pixels in CoLM. ! @@ -38,7 +38,7 @@ MODULE MOD_Pixelset ! To read, vector is first loaded from files by IO and then scattered from IO to worker. ! To write, vector is first gathered from worker to IO and then saved to files by IO. ! -! Created by Shupeng Zhang, May 2023 +! Created by Shupeng Zhang, May 2023 !------------------------------------------------------------------------------------ USE MOD_Precision @@ -71,7 +71,7 @@ MODULE MOD_Pixelset integer*8, allocatable :: eindex(:) ! global index of element to which pixelset belongs - integer, allocatable :: ipxstt(:) ! start local index of pixel in the element + integer, allocatable :: ipxstt(:) ! start local index of pixel in the element integer, allocatable :: ipxend(:) ! end local index of pixel in the element integer, allocatable :: settyp(:) ! type of pixelset @@ -177,7 +177,7 @@ END SUBROUTINE pixelset_get_lonlat_radian FUNCTION get_pixelset_rlat (npxl, ilat, area) result(rlat) USE MOD_Precision - USE MOD_Vars_Global, only : pi + USE MOD_Vars_Global, only: pi USE MOD_Pixel IMPLICIT NONE @@ -203,7 +203,7 @@ FUNCTION get_pixelset_rlon (npxl, ilon, area) result(rlon) USE MOD_Precision USE MOD_Utils - USE MOD_Vars_Global, only : pi + USE MOD_Vars_Global, only: pi USE MOD_Pixel IMPLICIT NONE @@ -536,7 +536,7 @@ SUBROUTINE pixelset_pack (this, mask, nset_packed) deallocate (this%ipxend) deallocate (this%settyp) deallocate (this%ielm ) - + IF (this%has_shared) THEN allocate (pctshared_(this%nset)) pctshared_ = this%pctshared @@ -579,7 +579,7 @@ SUBROUTINE pixelset_pack (this, mask, nset_packed) this%pctshared(s:e) = this%pctshared(s:e)/sum(this%pctshared(s:e)) ENDIF - s = e + 1 + s = e + 1 ENDDO ENDIF diff --git a/share/MOD_Precision.F90 b/share/MOD_Precision.F90 index 06161153..d3c25920 100644 --- a/share/MOD_Precision.F90 +++ b/share/MOD_Precision.F90 @@ -1,6 +1,6 @@ MODULE MOD_Precision !------------------------------------------------------------------------------- -! Purpose: +! !Purpose: ! Define the precision to use for floating point and integer operations ! throughout the model. !------------------------------------------------------------------------------- diff --git a/share/MOD_RangeCheck.F90 b/share/MOD_RangeCheck.F90 index 59eab042..aad29a1b 100644 --- a/share/MOD_RangeCheck.F90 +++ b/share/MOD_RangeCheck.F90 @@ -3,7 +3,7 @@ MODULE MOD_RangeCheck !----------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! Subroutines show the range of values in block data or vector data. ! @@ -11,11 +11,11 @@ MODULE MOD_RangeCheck ! 1. "check_block_data" can only be called by IO processes. ! 2. "check_vector_data" can only be called by worker processes. ! -! Created by Shupeng Zhang, May 2023 +! Created by Shupeng Zhang, May 2023 !----------------------------------------------------------------------- #ifdef RangeCheck - USE MOD_UserDefFun, only : isnan_ud + USE MOD_UserDefFun, only: isnan_ud IMPLICIT NONE INTERFACE check_block_data @@ -39,7 +39,7 @@ SUBROUTINE check_block_data_real8_2d (varname, gdata, spv_in, limits) USE MOD_SPMD_Task USE MOD_Block USE MOD_DataType - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE character(len=*), intent(in) :: varname @@ -165,7 +165,7 @@ SUBROUTINE check_vector_data_real8_1d (varname, vdata, spv_in, limits) USE MOD_Precision USE MOD_SPMD_Task - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE character(len=*), intent(in) :: varname @@ -272,14 +272,14 @@ SUBROUTINE check_vector_data_real8_2d (varname, vdata, spv_in, limits) USE MOD_Precision USE MOD_SPMD_Task - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE 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) + real(r8), intent(in), optional :: limits(2) ! Local variables real(r8) :: vmin, vmax, spv @@ -381,14 +381,14 @@ SUBROUTINE check_vector_data_real8_3d (varname, vdata, spv_in, limits) USE MOD_Precision USE MOD_SPMD_Task - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE 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) + real(r8), intent(in), optional :: limits(2) ! Local variables real(r8) :: vmin, vmax, spv @@ -493,14 +493,14 @@ SUBROUTINE check_vector_data_real8_4d (varname, vdata, spv_in, limits) USE MOD_Precision USE MOD_SPMD_Task - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE 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) + real(r8), intent(in), optional :: limits(2) ! Local variables real(r8) :: vmin, vmax, spv diff --git a/share/MOD_SPMD_Task.F90 b/share/MOD_SPMD_Task.F90 index b6b2ad15..13cfd17f 100644 --- a/share/MOD_SPMD_Task.F90 +++ b/share/MOD_SPMD_Task.F90 @@ -3,69 +3,69 @@ MODULE MOD_SPMD_Task !----------------------------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! SPMD refers to "Single PROGRAM/Multiple Data" parallelization. -! +! ! In CoLM, processes do three types of tasks, -! 1. master : There is only one master process, usually rank 0 in global communicator. +! 1. master : There is only one master process, usually rank 0 in global communicator. ! It reads or writes global data, prints informations. -! 2. io : IO processes read data from files and scatter to workers, gather data from +! 2. io : IO processes read data from files and scatter to workers, gather data from ! workers and write to files. ! 3. worker : Worker processes do model calculations. -! +! ! Notice that, -! 1. There are mainly two types of data in CoLM: gridded data and vector data. -! Gridded data takes longitude and latitude as its last two dimensions. +! 1. There are mainly two types of data in CoLM: gridded data and vector data. +! Gridded data takes longitude and latitude as its last two dimensions. ! Vector data takes ELEMENT/PATCH/HRU/PFT/PC as its last dimension. ! Usually gridded data is allocated on IO processes and vector data is allocated on ! worker processes. -! 2. One IO process and multiple worker processes form a group. The Input/Output +! 2. One IO process and multiple worker processes form a group. The Input/Output ! in CoLM is mainly between IO and workers in the same group. However, all processes ! can communicate with each other. ! 3. Number of IO is less or equal than the number of blocks with non-zero elements. ! -! Created by Shupeng Zhang, May 2023 +! Created by Shupeng Zhang, May 2023 !----------------------------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE - + include 'mpif.h' #ifndef USEMPI - + integer, parameter :: p_root = 0 logical, parameter :: p_is_master = .true. logical, parameter :: p_is_io = .true. logical, parameter :: p_is_worker = .true. - integer, parameter :: p_np_glb = 1 + integer, parameter :: p_np_glb = 1 integer, parameter :: p_np_worker = 1 integer, parameter :: p_np_io = 1 integer, parameter :: p_iam_glb = 0 integer, parameter :: p_iam_io = 0 integer, parameter :: p_iam_worker = 0 - + integer, parameter :: p_np_group = 1 #else integer, parameter :: p_root = 0 - logical :: p_is_master + logical :: p_is_master logical :: p_is_io logical :: p_is_worker logical :: p_is_writeback - + integer :: p_comm_glb_plus integer :: p_iam_glb_plus ! Global communicator integer :: p_comm_glb - integer :: p_iam_glb - integer :: p_np_glb + integer :: p_iam_glb + integer :: p_np_glb ! Processes in the same working group integer :: p_comm_group @@ -76,19 +76,19 @@ MODULE MOD_SPMD_Task integer :: p_address_master - ! Input/output processes + ! Input/output processes integer :: p_comm_io integer :: p_iam_io - integer :: p_np_io + integer :: p_np_io integer, allocatable :: p_itis_io (:) integer, allocatable :: p_address_io (:) - + ! Processes carrying out computing work integer :: p_comm_worker integer :: p_iam_worker - integer :: p_np_worker - + integer :: p_np_worker + integer, allocatable :: p_itis_worker (:) integer, allocatable :: p_address_worker (:) @@ -100,13 +100,13 @@ MODULE MOD_SPMD_Task ! tags integer, PUBLIC, parameter :: mpi_tag_size = 1 integer, PUBLIC, parameter :: mpi_tag_mesg = 2 - integer, PUBLIC, parameter :: mpi_tag_data = 3 + 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 + integer, parameter :: MesgMaxSize = 4194304 ! 4MB ! subroutines PUBLIC :: spmd_init @@ -128,7 +128,7 @@ SUBROUTINE spmd_init (MyComm_r) CALL MPI_INITIALIZED (mpi_inited, p_err) IF ( .not. mpi_inited ) THEN - CALL mpi_init (p_err) + CALL mpi_init (p_err) ENDIF IF (present(MyComm_r)) THEN @@ -138,8 +138,8 @@ SUBROUTINE spmd_init (MyComm_r) ENDIF ! 1. Constructing global communicator. - CALL mpi_comm_rank (p_comm_glb, p_iam_glb, p_err) - CALL mpi_comm_size (p_comm_glb, p_np_glb, p_err) + CALL mpi_comm_rank (p_comm_glb, p_iam_glb, p_err) + CALL mpi_comm_size (p_comm_glb, p_np_glb, p_err) p_address_master = p_np_glb-1 p_is_master = (p_iam_glb == p_address_master) @@ -158,9 +158,9 @@ SUBROUTINE spmd_assign_writeback () CALL MPI_Comm_dup (p_comm_glb, p_comm_glb_plus, p_err) CALL MPI_Comm_free (p_comm_glb, p_err) - - CALL mpi_comm_rank (p_comm_glb_plus, p_iam_glb_plus, p_err) - CALL mpi_comm_size (p_comm_glb_plus, p_np_glb_plus, p_err) + + CALL mpi_comm_rank (p_comm_glb_plus, p_iam_glb_plus, p_err) + CALL mpi_comm_size (p_comm_glb_plus, p_np_glb_plus, p_err) p_address_writeback = p_np_glb_plus-1 p_is_writeback = (p_iam_glb_plus == p_address_writeback) @@ -169,8 +169,8 @@ SUBROUTINE spmd_assign_writeback () ! Reconstruct global communicator. CALL mpi_comm_split (p_comm_glb_plus, 0, p_iam_glb_plus, p_comm_glb, p_err) - CALL mpi_comm_rank (p_comm_glb, p_iam_glb, p_err) - CALL mpi_comm_size (p_comm_glb, p_np_glb, p_err) + CALL mpi_comm_rank (p_comm_glb, p_iam_glb, p_err) + CALL mpi_comm_size (p_comm_glb, p_np_glb, p_err) p_address_master = p_np_glb-1 p_is_master = (p_iam_glb == p_address_master) @@ -178,7 +178,7 @@ SUBROUTINE spmd_assign_writeback () ELSE CALL mpi_comm_split (p_comm_glb_plus, MPI_UNDEFINED, p_iam_glb_plus, p_comm_glb, p_err) p_is_master = .false. - ENDIF + ENDIF END SUBROUTINE spmd_assign_writeback @@ -186,7 +186,7 @@ END SUBROUTINE spmd_assign_writeback SUBROUTINE divide_processes_into_groups (ngrp) IMPLICIT NONE - + integer, intent(in) :: ngrp ! Local variables @@ -215,7 +215,7 @@ SUBROUTINE divide_processes_into_groups (ngrp) p_my_group = (p_iam_glb-(nave+1)*nres) / nave + nres ENDIF - p_is_worker = .not. p_is_io + p_is_worker = .not. p_is_io ELSE p_is_io = .false. p_is_worker = .false. @@ -226,15 +226,15 @@ SUBROUTINE divide_processes_into_groups (ngrp) IF (p_is_io) THEN key = 1 CALL mpi_comm_split (p_comm_glb, key, p_iam_glb, p_comm_io, p_err) - CALL mpi_comm_rank (p_comm_io, p_iam_io, p_err) + CALL mpi_comm_rank (p_comm_io, p_iam_io, p_err) ELSE CALL mpi_comm_split (p_comm_glb, MPI_UNDEFINED, p_iam_glb, p_comm_io, p_err) ENDIF - + IF (.not. p_is_io) p_iam_io = -1 allocate (p_itis_io (0:p_np_glb-1)) CALL mpi_allgather (p_iam_io, 1, MPI_INTEGER, p_itis_io, 1, MPI_INTEGER, p_comm_glb, p_err) - + p_np_io = count(p_itis_io >= 0) allocate (p_address_io (0:p_np_io-1)) @@ -248,7 +248,7 @@ SUBROUTINE divide_processes_into_groups (ngrp) IF (p_is_worker) THEN key = 1 CALL mpi_comm_split (p_comm_glb, key, p_iam_glb, p_comm_worker, p_err) - CALL mpi_comm_rank (p_comm_worker, p_iam_worker, p_err) + CALL mpi_comm_rank (p_comm_worker, p_iam_worker, p_err) ELSE CALL mpi_comm_split (p_comm_glb, MPI_UNDEFINED, p_iam_glb, p_comm_worker, p_err) ENDIF @@ -256,7 +256,7 @@ SUBROUTINE divide_processes_into_groups (ngrp) IF (.not. p_is_worker) p_iam_worker = -1 allocate (p_itis_worker (0:p_np_glb-1)) CALL mpi_allgather (p_iam_worker, 1, MPI_INTEGER, p_itis_worker, 1, MPI_INTEGER, p_comm_glb, p_err) - + p_np_worker = count(p_itis_worker >= 0) allocate (p_address_worker (0:p_np_worker-1)) @@ -268,8 +268,8 @@ SUBROUTINE divide_processes_into_groups (ngrp) ! 5. Construct group communicator. CALL mpi_comm_split (p_comm_glb, p_my_group, p_iam_glb, p_comm_group, p_err) - CALL mpi_comm_rank (p_comm_group, p_iam_group, p_err) - CALL mpi_comm_size (p_comm_group, p_np_group, p_err) + CALL mpi_comm_rank (p_comm_group, p_iam_group, p_err) + CALL mpi_comm_size (p_comm_group, p_np_group, p_err) ! 6. Print global task informations. allocate (p_igroup_all (0:p_np_glb-1)) @@ -301,12 +301,12 @@ SUBROUTINE divide_processes_into_groups (ngrp) write(*,'(A)') trim(info) ENDIF ENDDO - - write (*,*) + + write (*,*) ENDIF deallocate (p_igroup_all ) - + END SUBROUTINE divide_processes_into_groups !----------------------------------------- diff --git a/share/MOD_SpatialMapping.F90 b/share/MOD_SpatialMapping.F90 index fa23ad0d..e5fbc612 100644 --- a/share/MOD_SpatialMapping.F90 +++ b/share/MOD_SpatialMapping.F90 @@ -2,18 +2,18 @@ MODULE MOD_SpatialMapping -!--------------------------------------------------------------------------------! -! DESCRIPTION: ! -! ! -! Spatial Mapping module. ! -! ! -! Created by Shupeng Zhang, May 2024 ! -!--------------------------------------------------------------------------------! +!-------------------------------------------------------------------------------- +! !DESCRIPTION: +! +! Spatial Mapping module. +! +! Created by Shupeng Zhang, May 2024 +!-------------------------------------------------------------------------------- USE MOD_Precision USE MOD_Grid USE MOD_DataType - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE ! ------ @@ -1499,7 +1499,7 @@ SUBROUTINE spatial_mapping_pset2grid_max (this, pdata, gdata, spv, msk) USE MOD_Grid USE MOD_DataType USE MOD_SPMD_Task - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE class (spatial_mapping_type) :: this @@ -1861,7 +1861,7 @@ SUBROUTINE spatial_mapping_grid2pset_2d (this, gdata, pdata) USE MOD_Pixelset USE MOD_DataType USE MOD_SPMD_Task - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE class (spatial_mapping_type) :: this @@ -1968,7 +1968,7 @@ SUBROUTINE spatial_mapping_grid2pset_3d (this, gdata, ndim1, pdata) USE MOD_Pixelset USE MOD_DataType USE MOD_SPMD_Task - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE class (spatial_mapping_type) :: this @@ -2077,7 +2077,7 @@ SUBROUTINE spatial_mapping_dominant_2d (this, gdata, pdata) USE MOD_Pixelset USE MOD_DataType USE MOD_SPMD_Task - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE class (spatial_mapping_type) :: this @@ -2174,7 +2174,7 @@ SUBROUTINE spatial_mapping_grid2part (this, gdata, sdata) USE MOD_Pixelset USE MOD_DataType USE MOD_SPMD_Task - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE class (spatial_mapping_type) :: this @@ -2383,7 +2383,7 @@ SUBROUTINE spatial_mapping_normalize (this, gdata, sdata) USE MOD_Pixelset USE MOD_DataType USE MOD_SPMD_Task - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE class (spatial_mapping_type) :: this @@ -2443,7 +2443,7 @@ SUBROUTINE spatial_mapping_part2pset (this, sdata, pdata) USE MOD_Grid USE MOD_DataType USE MOD_SPMD_Task - USE MOD_Vars_Global, only : spval + USE MOD_Vars_Global, only: spval IMPLICIT NONE class (spatial_mapping_type) :: this diff --git a/share/MOD_TimeManager.F90 b/share/MOD_TimeManager.F90 index 4baa1bad..e5e18a5f 100644 --- a/share/MOD_TimeManager.F90 +++ b/share/MOD_TimeManager.F90 @@ -1,20 +1,19 @@ #include -! -------------------------------------------------------- MODULE MOD_TimeManager +! -------------------------------------------------------- ! ! !DESCRIPTION: -! Time manager module: to provide some basic operations for time stamp +! Time manager module: to provide some basic operations for time stamp ! -! Created by Hua Yuan, 04/2014 +! Created by Hua Yuan, 04/2014 ! -! REVISIONS: -! 06/28/2017, Hua Yuan: added issame() and monthday2julian() -! TODO... +! !REVISIONS: +! 06/28/2017, Hua Yuan: added issame() and monthday2julian() +! TODO... ! -------------------------------------------------------- - USE MOD_Precision IMPLICIT NONE @@ -188,7 +187,7 @@ logical FUNCTION lessthan(tstamp1, tstamp2) idate1 = (/tstamp1%year, tstamp1%day, tstamp1%sec/) idate2 = (/tstamp2%year, tstamp2%day, tstamp2%sec/) - + CALL adj2end(idate1) CALL adj2end(idate2) @@ -619,7 +618,7 @@ SUBROUTINE gmt2local(idate, long, ldate) ENDIF ENDIF - ELSE IF (ldate(3) > 86400) THEN + ELSEIF (ldate(3) > 86400) THEN ldate(3) = ldate(3) - 86400 ldate(2) = idate(2) + 1 diff --git a/share/MOD_UserDefFun.F90 b/share/MOD_UserDefFun.F90 index 83622607..bb925e73 100644 --- a/share/MOD_UserDefFun.F90 +++ b/share/MOD_UserDefFun.F90 @@ -1,25 +1,25 @@ MODULE MOD_UserDefFun !----------------------------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! This MODULE contains user defined functions to replace non-standard functions. ! -! Created by Shupeng Zhang, April 2024 +! Created by Shupeng Zhang, April 2024 !----------------------------------------------------------------------------------------- - + ! ---- PUBLIC subroutines ---- INTERFACE isnan_ud MODULE procedure isnan_ud_r8 - END INTERFACE isnan_ud + END INTERFACE isnan_ud CONTAINS ! ---------- logical FUNCTION isnan_ud_r8 (a) - USE MOD_Precision, only : r8 + USE MOD_Precision, only: r8 IMPLICIT NONE real(r8), intent(in) :: a diff --git a/share/MOD_Utils.F90 b/share/MOD_Utils.F90 index a6de72c1..4f22b5b0 100644 --- a/share/MOD_Utils.F90 +++ b/share/MOD_Utils.F90 @@ -1,14 +1,14 @@ MODULE MOD_Utils !----------------------------------------------------------------------------------------- -! DESCRIPTION: +! !DESCRIPTION: ! ! This MODULE CONTAINS utilities. ! -! History: +! !REVISIONS: ! Subroutines lmder, enorm, tridia and polint are moved from other files. ! -! Created by Shupeng Zhang, May 2023 +! Created by Shupeng Zhang, May 2023 !----------------------------------------------------------------------------------------- ! ---- PUBLIC subroutines ----