diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 08e6c0513f..01cc0d32e5 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -1930,7 +1930,10 @@ subroutine update_hlm_dynamics(nsites,sites,fcolumn,bc_out) ifp = ifp+1 if ( currentPatch%total_canopy_area-currentPatch%area > 0.000001_r8 ) then - write(fates_log(),*) 'ED: canopy area bigger than area',currentPatch%total_canopy_area ,currentPatch%area + if(debug)then + write(fates_log(),*) 'ED: canopy area bigger than area', & + currentPatch%total_canopy_area ,currentPatch%area + end if currentPatch%total_canopy_area = currentPatch%area endif @@ -2219,7 +2222,9 @@ function NumPotentialCanopyLayers(currentPatch,site_spread,include_substory) res if(arealayer > currentPatch%area)then z = z + 1 if(hlm_use_sp.eq.itrue)then - write(fates_log(),*) 'SPmode, canopy_layer full:',arealayer,currentPatch%area + if(debug)then + write(fates_log(),*) 'SPmode, canopy_layer full:',arealayer,currentPatch%area + end if end if endif diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 2fa98aa59f..420e7c92ad 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -1537,7 +1537,6 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) !---------------------------------------------------------------------! dynamic_size_fusion_tolerance = dynamic_size_fusion_tolerance * 1.1_r8 dynamic_age_fusion_tolerance = dynamic_age_fusion_tolerance * 1.1_r8 - !write(fates_log(),*) 'maxcohorts exceeded',dynamic_fusion_tolerance else @@ -1552,7 +1551,6 @@ subroutine fuse_cohorts(currentSite, currentPatch, bc_in) ! Making profile tolerance larger means that more fusion will happen ! !---------------------------------------------------------------------! dynamic_size_fusion_tolerance = dynamic_size_fusion_tolerance * 1.1_r8 - !write(fates_log(),*) 'maxcohorts exceeded',dynamic_fusion_tolerance else @@ -1931,10 +1929,13 @@ subroutine count_cohorts( currentPatch ) currentCohort => currentCohort%shorter enddo - if (backcount /= currentPatch%countcohorts) then - write(fates_log(),*) 'problem with linked list, not symmetrical' - endif - + if(debug) then + if (backcount /= currentPatch%countcohorts) then + write(fates_log(),*) 'problem with linked list, not symmetrical' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + end if + end subroutine count_cohorts ! =================================================================================== diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index f1f23d9f33..52178f46cf 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -73,7 +73,8 @@ module EDLoggingMortalityMod logical, protected :: logging_time ! If true, logging should be ! performed during the current time-step - + logical, parameter :: debug = .false. + ! harvest litter localization specifies how much of the litter from a falling ! tree lands within the newly generated patch, and how much lands outside of ! the new patch, and thus in the original patch. By setting this to zero, diff --git a/biogeochem/EDMortalityFunctionsMod.F90 b/biogeochem/EDMortalityFunctionsMod.F90 index 6eb5ec3097..ca4b3a5dad 100644 --- a/biogeochem/EDMortalityFunctionsMod.F90 +++ b/biogeochem/EDMortalityFunctionsMod.F90 @@ -6,6 +6,8 @@ module EDMortalityFunctionsMod use FatesConstantsMod , only : r8 => fates_r8 use FatesGlobals , only : fates_log + use FatesGlobals , only : endrun => fates_endrun + use FatesGlobals , only : fates_log use EDPftvarcon , only : EDPftvarcon_inst use EDTypesMod , only : ed_cohort_type use EDTypesMod , only : ed_site_type @@ -22,10 +24,15 @@ module EDMortalityFunctionsMod use PRTGenericMod, only : all_carbon_elements use PRTGenericMod, only : store_organ - + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none private + + logical, parameter :: debug = .false. + character(len=*), parameter, private :: sourcefile = & + __FILE__ public :: mortality_rates public :: Mortality_Derivative @@ -164,6 +171,7 @@ subroutine mortality_rates( cohort_in,bc_in,cmort,hmort,bmort,frmort,smort,asmor else write(fates_log(),*) 'dbh problem in mortality_rates', & cohort_in%dbh,cohort_in%pft,cohort_in%n,cohort_in%canopy_layer + call endrun(msg=errMsg(sourcefile, __LINE__)) endif !-------------------------------------------------------------------------------- ! Mortality due to cold and freezing stress (frmort), based on ED2 and: diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index c08e93565e..fda538e36e 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -335,8 +335,8 @@ subroutine disturbance_rates( site_in, bc_in) ! Fires can't burn the whole patch, as this causes /0 errors. if (debug) then if (currentPatch%disturbance_rates(dtype_ifire) > 0.98_r8)then - write(fates_log(),*) 'very high fire areas', & - currentPatch%disturbance_rates(dtype_ifire),currentPatch%frac_burnt + write(fates_log(),*) 'very high fire areas', & + currentPatch%disturbance_rates(dtype_ifire),currentPatch%frac_burnt endif endif @@ -2295,7 +2295,8 @@ subroutine fuse_patches( csite, bc_in ) do while(associated(tpp)) if(.not.associated(currentPatch))then - write(fates_log(),*) 'ED: issue with currentPatch' + write(fates_log(),*) 'FATES fuse_patches(): currentPatch is not associated?' + call endrun(msg=errMsg(sourcefile, __LINE__)) endif if(associated(tpp).and.associated(currentPatch))then @@ -2414,9 +2415,7 @@ subroutine fuse_patches( csite, bc_in ) !------------------------------------------------------------------------! profiletol = ED_val_patch_fusion_tol - - else - ! write(fates_log(),*) 'patches not fused' + endif endif !are both patches the same anthropogenic disturbance category as the disturbance type loop iterator? endif !are both patches associated? diff --git a/biogeochem/EDPhysiologyMod.F90 b/biogeochem/EDPhysiologyMod.F90 index 859f6e3534..1ca5b06546 100644 --- a/biogeochem/EDPhysiologyMod.F90 +++ b/biogeochem/EDPhysiologyMod.F90 @@ -590,11 +590,6 @@ subroutine trim_canopy( currentSite ) ! Make sure the cohort trim fraction is great than the pft trim limit if (currentCohort%canopy_trim > EDPftvarcon_inst%trim_limit(ipft)) then - ! if ( debug ) then - ! write(fates_log(),*) 'trimming leaves', & - ! currentCohort%canopy_trim,currentCohort%leaf_cost - ! endif - ! keep trimming until none of the canopy is in negative carbon balance. if (currentCohort%hite > EDPftvarcon_inst%hgt_min(ipft)) then currentCohort%canopy_trim = currentCohort%canopy_trim - & @@ -620,10 +615,6 @@ subroutine trim_canopy( currentSite ) call dgels(trans, m, n, nrhs, nnu_clai_a, lda, nnu_clai_b, ldb, work, lwork, info) lwork = int(work(1)) ! Pick the optimum. TBD, can work(1) come back with greater than work size? - ! if (debug) then - ! write(fates_log(),*) 'LLSF lwork output (info, lwork):', info, lwork - ! endif - ! Compute the minimum of 2-norm of of the least squares fit to solve for X ! Note that dgels returns the solution by overwriting the nnu_clai_b array. ! The result has the form: X = [b; m] diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index e47934715d..396cee9a60 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -2448,9 +2448,12 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl ) end if call h_allom(d,ipft,h) - if(counter>10)then - write(fates_log(),*) 'dbh counter: ',counter,' is woody: ',& - int(prt_params%woody(ipft))==itrue + + if(debug) then + if(counter>10)then + write(fates_log(),*) 'dbh counter: ',counter,' is woody: ',& + int(prt_params%woody(ipft))==itrue + end if end if diff --git a/biogeophys/EDAccumulateFluxesMod.F90 b/biogeophys/EDAccumulateFluxesMod.F90 index a0fe4dd7df..090b7848b0 100644 --- a/biogeophys/EDAccumulateFluxesMod.F90 +++ b/biogeophys/EDAccumulateFluxesMod.F90 @@ -9,11 +9,11 @@ module EDAccumulateFluxesMod ! Rosie Fisher. March 2014. ! ! !USES: - use FatesGlobals, only : fates_endrun + use FatesGlobals, only : endrun => fates_endrun use FatesGlobals, only : fates_log use shr_log_mod , only : errMsg => shr_log_errMsg use FatesConstantsMod , only : r8 => fates_r8 - + use shr_log_mod , only : errMsg => shr_log_errMsg implicit none private diff --git a/biogeophys/EDBtranMod.F90 b/biogeophys/EDBtranMod.F90 index e36642447e..52577b1b92 100644 --- a/biogeophys/EDBtranMod.F90 +++ b/biogeophys/EDBtranMod.F90 @@ -19,11 +19,16 @@ module EDBtranMod use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesGlobals , only : fates_log use FatesAllometryMod , only : set_root_fraction + use shr_log_mod , only : errMsg => shr_log_errMsg + use FatesGlobals, only : endrun => fates_endrun ! implicit none private + + logical, parameter :: debug = .false. + public :: btran_ed public :: get_active_suction_layers public :: check_layer_water @@ -231,10 +236,13 @@ subroutine btran_ed( nsites, sites, bc_in, bc_out) temprootr = sum(bc_out(s)%rootr_pasl(ifp,1:bc_in(s)%nlevsoil)) if(abs(1.0_r8-temprootr) > 1.0e-10_r8 .and. temprootr > 1.0e-10_r8)then - write(fates_log(),*) 'error with rootr in canopy fluxes',temprootr,sum_pftgs + + if(debug) write(fates_log(),*) 'error with rootr in canopy fluxes',temprootr,sum_pftgs + do j = 1,bc_in(s)%nlevsoil bc_out(s)%rootr_pasl(ifp,j) = bc_out(s)%rootr_pasl(ifp,j)/temprootr enddo + end if endif ! not bare ground cpatch => cpatch%younger diff --git a/biogeophys/EDSurfaceAlbedoMod.F90 b/biogeophys/EDSurfaceAlbedoMod.F90 index ebc01b1b69..b77f87b95d 100644 --- a/biogeophys/EDSurfaceAlbedoMod.F90 +++ b/biogeophys/EDSurfaceAlbedoMod.F90 @@ -44,7 +44,8 @@ module EDSurfaceRadiationMod public :: ED_SunShadeFracs logical :: debug = .false. ! for debugging this module - + character(len=*), parameter, private :: sourcefile = & + __FILE__ real(r8), public :: albice(maxSWb) = & ! albedo land ice by waveband (1=vis, 2=nir) (/ 0.80_r8, 0.55_r8 /) @@ -339,13 +340,16 @@ subroutine PatchNormanRadiation (currentPatch, & end do !iv end do !ft1 end do !L - if (sum(ftweight(1,:,1))<0.999_r8)then - write(fates_log(),*) 'canopy not full',ftweight(1,:,1) - endif - if (sum(ftweight(1,:,1))>1.0001_r8)then - write(fates_log(),*) 'canopy too full',ftweight(1,:,1) - endif + if(debug)then + if (sum(ftweight(1,:,1))<0.999_r8)then + write(fates_log(),*) 'canopy not full',ftweight(1,:,1) + endif + if (sum(ftweight(1,:,1))>1.0001_r8)then + write(fates_log(),*) 'canopy too full',ftweight(1,:,1) + endif + end if + do L = 1,currentPatch%NCL_p !start at the top canopy layer (1 is the top layer.) weighted_dir_tr(L) = 0.0_r8 @@ -397,11 +401,13 @@ subroutine PatchNormanRadiation (currentPatch, & !where there is a partly empty leaf layer, some fluxes go straight through. lai_change(L,ft,iv) = ftweight(L,ft,iv)-ftweight(L,ft,iv+1) endif - if (ftweight(L,ft,iv+1) - ftweight(L,ft,iv) > 1.e-10_r8)then - write(fates_log(),*) 'lower layer has more coverage. This is wrong' , & - ftweight(L,ft,iv),ftweight(L,ft,iv+1),ftweight(L,ft,iv+1)-ftweight(L,ft,iv) - endif - + if(debug)then + if (ftweight(L,ft,iv+1) - ftweight(L,ft,iv) > 1.e-10_r8)then + write(fates_log(),*) 'lower layer has more coverage. This is wrong' , & + ftweight(L,ft,iv),ftweight(L,ft,iv+1),ftweight(L,ft,iv+1)-ftweight(L,ft,iv) + endif + end if + !n.b. in theory lai_change could be calculated daily in the ED code. !This is light coming striaght through the canopy. if (L==1)then @@ -922,26 +928,30 @@ subroutine PatchNormanRadiation (currentPatch, & error = abs(currentPatch%sabs_dir(ib) - (currentPatch%tr_soil_dir(ib) * & (1.0_r8-currentPatch%gnd_alb_dir(ib) ) + & currentPatch%tr_soil_dir_dif(ib) * (1.0_r8-currentPatch%gnd_alb_dif(ib) ))) - if ( abs(error) > 0.0001)then - write(fates_log(),*)'dir ground absorption error',error,currentPatch%sabs_dir(ib), & - currentPatch%tr_soil_dir(ib)* & - (1.0_r8-currentPatch%gnd_alb_dir(ib) ),currentPatch%NCL_p,ib,sum(ftweight(1,1:numpft,1)) - write(fates_log(),*) 'albedos',currentPatch%sabs_dir(ib) ,currentPatch%tr_soil_dir(ib), & - (1.0_r8-currentPatch%gnd_alb_dir(ib) ) - - do ft =1,3 - iv = currentPatch%nrad(1,ft) + 1 - write(fates_log(),*) 'abs soil fluxes', Abs_dir_z(ft,iv),Abs_dif_z(ft,iv) - end do + if(debug)then + if ( abs(error) > 0.0001)then + write(fates_log(),*)'dir ground absorption error',error,currentPatch%sabs_dir(ib), & + currentPatch%tr_soil_dir(ib)* & + (1.0_r8-currentPatch%gnd_alb_dir(ib) ),currentPatch%NCL_p,ib,sum(ftweight(1,1:numpft,1)) + write(fates_log(),*) 'albedos',currentPatch%sabs_dir(ib) ,currentPatch%tr_soil_dir(ib), & + (1.0_r8-currentPatch%gnd_alb_dir(ib) ) + do ft =1,numpft + iv = currentPatch%nrad(1,ft) + 1 + write(fates_log(),*) 'abs soil fluxes', Abs_dir_z(ft,iv),Abs_dif_z(ft,iv) + end do + end if end if + else - if ( abs(currentPatch%sabs_dif(ib)-(currentPatch%tr_soil_dif(ib) * & - (1.0_r8-currentPatch%gnd_alb_dif(ib) ))) > 0.0001_r8)then - write(fates_log(),*)'dif ground absorption error',currentPatch%sabs_dif(ib) , & - (currentPatch%tr_soil_dif(ib)* & - (1.0_r8-currentPatch%gnd_alb_dif(ib) )),currentPatch%NCL_p,ib,sum(ftweight(1,1:numpft,1)) - endif + if (debug) then + if ( abs(currentPatch%sabs_dif(ib)-(currentPatch%tr_soil_dif(ib) * & + (1.0_r8-currentPatch%gnd_alb_dif(ib) ))) > 0.0001_r8)then + write(fates_log(),*)'dif ground absorption error',currentPatch%sabs_dif(ib) , & + (currentPatch%tr_soil_dif(ib)* & + (1.0_r8-currentPatch%gnd_alb_dif(ib) )),currentPatch%NCL_p,ib,sum(ftweight(1,1:numpft,1)) + endif + end if endif if (radtype == idirect)then @@ -976,17 +986,19 @@ subroutine PatchNormanRadiation (currentPatch, & ! to the complexity of this code, but where the system generates occasional errors, we ! will deal with them for now. end if + if (abs(error) > 0.15_r8)then - write(fates_log(),*) 'Large Dir Radn consvn error',error ,ib - write(fates_log(),*) 'diags', albd_parb_out(ib), ftdd_parb_out(ib), & - ftid_parb_out(ib), fabd_parb_out(ib) - write(fates_log(),*) 'lai_change',lai_change(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) - write(fates_log(),*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) - write(fates_log(),*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) - write(fates_log(),*) 'ftweight',ftweight(1,1:numpft,1:diag_nlevleaf) - write(fates_log(),*) 'cp',currentPatch%area, currentPatch%patchno - write(fates_log(),*) 'ground albedo diffuse (ib)', currentPatch%gnd_alb_dir(ib) - + if(debug)then + write(fates_log(),*) 'Large Dir Radn consvn error',error ,ib + write(fates_log(),*) 'diags', albd_parb_out(ib), ftdd_parb_out(ib), & + ftid_parb_out(ib), fabd_parb_out(ib) + write(fates_log(),*) 'lai_change',lai_change(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) + write(fates_log(),*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) + write(fates_log(),*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) + write(fates_log(),*) 'ftweight',ftweight(1,1:numpft,1:diag_nlevleaf) + write(fates_log(),*) 'cp',currentPatch%area, currentPatch%patchno + write(fates_log(),*) 'ground albedo diffuse (ib)', currentPatch%gnd_alb_dir(ib) + end if albd_parb_out(ib) = albd_parb_out(ib) + error end if else @@ -996,20 +1008,21 @@ subroutine PatchNormanRadiation (currentPatch, & end if if (abs(error) > 0.15_r8)then - write(fates_log(),*) '>5% Dif Radn consvn error',error ,ib - write(fates_log(),*) 'diags', albi_parb_out(ib), ftii_parb_out(ib), & - fabi_parb_out(ib) - write(fates_log(),*) 'lai_change',lai_change(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) - write(fates_log(),*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) - write(fates_log(),*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) - write(fates_log(),*) 'ftweight',ftweight(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) - write(fates_log(),*) 'cp',currentPatch%area, currentPatch%patchno - write(fates_log(),*) 'ground albedo diffuse (ib)', currentPatch%gnd_alb_dir(ib) - write(fates_log(),*) 'rhol',rhol(1:numpft,:) - write(fates_log(),*) 'ftw',sum(ftweight(1,1:numpft,1)),ftweight(1,1:numpft,1) - write(fates_log(),*) 'present',currentPatch%canopy_mask(1,1:numpft) - write(fates_log(),*) 'CAP',currentPatch%canopy_area_profile(1,1:numpft,1) - + if(debug)then + write(fates_log(),*) '>5% Dif Radn consvn error',error ,ib + write(fates_log(),*) 'diags', albi_parb_out(ib), ftii_parb_out(ib), & + fabi_parb_out(ib) + write(fates_log(),*) 'lai_change',lai_change(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) + write(fates_log(),*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) + write(fates_log(),*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) + write(fates_log(),*) 'ftweight',ftweight(currentpatch%ncl_p,1:numpft,1:diag_nlevleaf) + write(fates_log(),*) 'cp',currentPatch%area, currentPatch%patchno + write(fates_log(),*) 'ground albedo diffuse (ib)', currentPatch%gnd_alb_dir(ib) + write(fates_log(),*) 'rhol',rhol(1:numpft,:) + write(fates_log(),*) 'ftw',sum(ftweight(1,1:numpft,1)),ftweight(1,1:numpft,1) + write(fates_log(),*) 'present',currentPatch%canopy_mask(1,1:numpft) + write(fates_log(),*) 'CAP',currentPatch%canopy_area_profile(1,1:numpft,1) + end if albi_parb_out(ib) = albi_parb_out(ib) + error end if @@ -1021,10 +1034,12 @@ subroutine PatchNormanRadiation (currentPatch, & (fabi_parb_out(ib) + albi_parb_out(ib) + currentPatch%sabs_dif(ib)) endif - if (abs(error) > 0.00000001_r8)then - write(fates_log(),*) 'there is still error after correction',error ,ib + if(debug) then + if (abs(error) > 0.00000001_r8)then + write(fates_log(),*) 'there is still error after correction',error ,ib + end if end if - + end if end do !hlm_numSWb @@ -1132,11 +1147,13 @@ subroutine ED_SunShadeFracs(nsites, sites,bc_in,bc_out) bc_out(s)%fsun_pa(ifp) = 0._r8 endif - if(bc_out(s)%fsun_pa(ifp) > 1._r8)then - write(fates_log(),*) 'too much leaf area in profile', bc_out(s)%fsun_pa(ifp), & - sunlai,shalai - endif - + if(debug)then + if(bc_out(s)%fsun_pa(ifp) > 1._r8)then + write(fates_log(),*) 'too much leaf area in profile', bc_out(s)%fsun_pa(ifp), & + sunlai,shalai + endif + end if + elai = calc_areaindex(cpatch,'elai') bc_out(s)%laisun_pa(ifp) = elai*bc_out(s)%fsun_pa(ifp) diff --git a/biogeophys/FatesPlantHydraulicsMod.F90 b/biogeophys/FatesPlantHydraulicsMod.F90 index 98aaad6488..de3953a46a 100644 --- a/biogeophys/FatesPlantHydraulicsMod.F90 +++ b/biogeophys/FatesPlantHydraulicsMod.F90 @@ -2682,16 +2682,17 @@ subroutine hydraulics_bc ( nsites, sites, bc_in, bc_out, dtime) wb_check_site = delta_plant_storage+delta_soil_storage+site_runoff+transp_flux ! Now check on total error - if( abs(wb_check_site) > 1.e-4_r8 ) then - write(fates_log(),*) 'FATES hydro water balance is not so great [kg/m2]' - write(fates_log(),*) 'site_hydr%errh2o_hyd: ',wb_check_site - write(fates_log(),*) 'delta_plant_storage: ',delta_plant_storage - write(fates_log(),*) 'delta_soil_storage: ',delta_soil_storage - write(fates_log(),*) 'site_runoff: ',site_runoff - write(fates_log(),*) 'transp_flux: ',transp_flux + if(debug)then + if( abs(wb_check_site) > 1.e-4_r8 ) then + write(fates_log(),*) 'FATES hydro water balance is not so great [kg/m2]' + write(fates_log(),*) 'site_hydr%errh2o_hyd: ',wb_check_site + write(fates_log(),*) 'delta_plant_storage: ',delta_plant_storage + write(fates_log(),*) 'delta_soil_storage: ',delta_soil_storage + write(fates_log(),*) 'site_runoff: ',site_runoff + write(fates_log(),*) 'transp_flux: ',transp_flux + end if end if - site_hydr%h2oveg_hydro_err = site_hydr%h2oveg_hydro_err + site_hydr%errh2o_hyd @@ -3868,10 +3869,6 @@ subroutine Report1DError(cohort, site_hydr, ilayer, z_node, v_node, & write(fates_log(),*) 'inner shell kmaxs: ',site_hydr%kmax_lower_shell(:,1)*aroot_frac_plant - - - - deallocate(psi_node) deallocate(h_node) @@ -4897,7 +4894,9 @@ subroutine MatSolve2D(bc_in,site_hydr,cohort,cohort_hydr, & enddo if ( nwtn_iter > max_newton_iter) then icnv = icnv_fail_round - write(fates_log(),*) 'Newton hydraulics solve failed',residual_amax,nsd,tm + if(debug)then + write(fates_log(),*) 'Newton hydraulics solve failed',residual_amax,nsd,tm + end if endif ! Three scenarios: @@ -5089,10 +5088,12 @@ subroutine MatSolve2D(bc_in,site_hydr,cohort,cohort_hydr, & end do outerloop - if(cohort_hydr%iterh1>1._r8) then - write(fates_log(),*) "hydro solve info: i1: ",cohort_hydr%iterh1,"i2: ",cohort_hydr%iterh2 + if(debug)then + if(cohort_hydr%iterh1>1._r8) then + write(fates_log(),*) "hydro solve info: i1: ",cohort_hydr%iterh1,"i2: ",cohort_hydr%iterh2 + end if end if - + ! Save flux diagnostics ! ------------------------------------------------------ diff --git a/biogeophys/FatesPlantRespPhotosynthMod.F90 b/biogeophys/FatesPlantRespPhotosynthMod.F90 index 4ff827443b..c58205d89e 100644 --- a/biogeophys/FatesPlantRespPhotosynthMod.F90 +++ b/biogeophys/FatesPlantRespPhotosynthMod.F90 @@ -1212,6 +1212,7 @@ subroutine LeafLayerPhotosynthesis(f_sun_lsl, & ! in if (abs(gs_mol-gs_mol_err) > 1.e-01_r8) then write (fates_log(),*) 'Stomatal model error check - stomatal conductance error:' write (fates_log(),*) gs_mol, gs_mol_err + call endrun(msg=errMsg(sourcefile, __LINE__)) end if enddo !sunsha loop diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index 127dfa43f9..0b367b862d 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -65,8 +65,8 @@ module SFMainMod ! The following parameter represents one of the values of hlm_spitfire_mode ! and more of these appear in subroutine area_burnt_intensity below ! NB. The same parameters are set in /src/biogeochem/CNFireFactoryMod - integer :: write_SF = 0 ! for debugging - logical :: debug = .false. ! for debugging + integer :: write_SF = ifalse ! for debugging + logical :: debug = .false. ! for debugging ! ============================================================================ ! ============================================================================ @@ -94,7 +94,7 @@ subroutine fire_model( currentSite, bc_in) currentPatch => currentPatch%older enddo - if(write_SF==1)then + if(write_SF==itrue)then write(fates_log(),*) 'spitfire_mode', hlm_spitfire_mode endif @@ -303,8 +303,10 @@ subroutine charecteristics_of_fuel ( currentSite ) endif currentPatch%fuel_sav = sum(SF_val_SAV(1:nfsc))/(nfsc) ! make average sav to avoid crashing code. - if ( hlm_masterproc == itrue ) write(fates_log(),*) 'problem with spitfire fuel averaging' - + if ( hlm_masterproc == itrue .and. write_SF == itrue)then + write(fates_log(),*) 'problem with spitfire fuel averaging' + end if + ! FIX(SPM,032414) refactor...should not have 0 fuel unless everything is burnt ! off. currentPatch%fuel_eff_moist = 0.0000000001_r8 diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index c3b503a729..35cf871b75 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -333,7 +333,7 @@ subroutine set_site_properties( nsites, sites,bc_in ) do ft = 1,numpft if(sites(s)%area_pft(ft).lt.0.01_r8.and.sites(s)%area_pft(ft).gt.0.0_r8)then - write(fates_log(),*) 'removing small pft patches',s,ft,sites(s)%area_pft(ft) + if(debug) write(fates_log(),*) 'removing small pft patches',s,ft,sites(s)%area_pft(ft) sites(s)%area_pft(ft)=0.0_r8 ! remove tiny patches to prevent numerical errors in terminate patches endif @@ -581,13 +581,13 @@ subroutine init_patches( nsites, sites, bc_in) ! remove or add extra area ! if the oldest patch has enough area, use that sites(s)%oldest_patch%area = sites(s)%oldest_patch%area - (tota-area) - write(*,*) 'fixing patch precision - oldest',s, tota-area + if(debug) write(fates_log(),*) 'fixing patch precision - oldest',s, tota-area else ! or otherwise take the area from the youngest patch. sites(s)%youngest_patch%area = sites(s)%oldest_patch%area - (tota-area) - write(*,*) 'fixing patch precision -youngest ',s, tota-area + if(debug) write(fates_log(),*) 'fixing patch precision -youngest ',s, tota-area endif else !this is a big error not just a precision error. - write(*,*) 'issue with patch area in EDinit',tota-area,tota + write(fates_log(),*) 'issue with patch area in EDinit',tota-area,tota call endrun(msg=errMsg(sourcefile, __LINE__)) endif ! big error end if ! too much patch area diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index 48820e5ad6..219e5a1e3c 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -349,6 +349,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) if( currentPatch%age < 0._r8 )then write(fates_log(),*) 'negative patch age?',currentPatch%age, & currentPatch%patchno,currentPatch%area + call endrun(msg=errMsg(sourcefile, __LINE__)) endif ! add age increment to secondary forest patches as well @@ -560,6 +561,7 @@ subroutine ed_integrate_state_variables(currentSite, bc_in, bc_out ) currentCohort%coage = currentCohort%coage + hlm_freq_day if(currentCohort%coage < 0.0_r8)then write(fates_log(),*) 'negative cohort age?',currentCohort%coage + call endrun(msg=errMsg(sourcefile, __LINE__)) end if ! update cohort age class and age x pft class diff --git a/main/EDPftvarcon.F90 b/main/EDPftvarcon.F90 index c89e63df98..eeea523f79 100644 --- a/main/EDPftvarcon.F90 +++ b/main/EDPftvarcon.F90 @@ -1442,7 +1442,7 @@ subroutine FatesReportPFTParams(is_master) write(fates_log(),fmt0) 'phen_cold_size_threshold = ',EDPftvarcon_inst%phen_cold_size_threshold write(fates_log(),fmt0) 'phen_stem_drop_fraction',EDpftvarcon_inst%phen_stem_drop_fraction write(fates_log(),fmt0) 'fire_alpha_SH = ',EDPftvarcon_inst%fire_alpha_SH - write(fates_log(),fmt0) 'allom_frbstor_repro = ',EDPftvarcon_inst%allom_frbstor_repro + write(fates_log(),fmt0) 'allom_frbstor_repro = ',EDPftvarcon_inst%allom_frbstor_repro write(fates_log(),fmt0) 'hydr_p_taper = ',EDPftvarcon_inst%hydr_p_taper write(fates_log(),fmt0) 'hydr_rs2 = ',EDPftvarcon_inst%hydr_rs2 write(fates_log(),fmt0) 'hydr_srl = ',EDPftvarcon_inst%hydr_srl diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 97f3342b43..94f9e9c25d 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1123,8 +1123,7 @@ subroutine set_dim_indices(this, dk_name, idim, dim_index) write(fates_log(), *) 'Trying to define dimension size to a dim-type structure' write(fates_log(), *) 'but the dimension index does not exist' write(fates_log(), *) 'type: ',dk_name,' ndims: ',this%dim_kinds(ityp)%ndims,' input dim:',idim - stop - !end_run + call endrun(msg=errMsg(sourcefile, __LINE__)) end if if (idim == 1) then @@ -2236,11 +2235,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_leaf_height_dist_si_height(io_si,i_heightbin) = & hio_leaf_height_dist_si_height(io_si,i_heightbin) + & ccohort%c_area * AREA_INV * ccohort%treelai * frac_canopy_in_bin - - ! if ( ( ccohort%c_area * AREA_INV * ccohort%treelai * frac_canopy_in_bin) .lt. 0._r8) then - ! write(fates_log(),*) ' negative hio_leaf_height_dist_si_height:' - ! write(fates_log(),*) ' c_area, treelai, frac_canopy_in_bin:', ccohort%c_area, ccohort%treelai, frac_canopy_in_bin - ! endif end do if (ccohort%canopy_layer .eq. 1) then @@ -4132,11 +4126,8 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,bc_in,dt_tstep) end if if(print_iterations) then -! print*,' Mean solves: ',sum(hio_iterh2_scpf(io_si,:))/real(count(ncohort_scpf(:)>0._r8),r8), & -! ' Mean failures: ',sum(hio_iterh1_scpf(io_si,:))/real(count(ncohort_scpf(:)>0._r8),r8) - write(fmt_char,'(I2)') iterh2_nhist - write(fates_log(),fmt='(A,'//fmt_char//'I5)') 'Solves: ',int(iterh2_histy(:)) - !write(*,*) 'Histogram: ',int(iterh2_histy(:)) + write(fmt_char,'(I2)') iterh2_nhist + write(fates_log(),fmt='(A,'//fmt_char//'I5)') 'Solves: ',int(iterh2_histy(:)) end if diff --git a/main/FatesHistoryVariableType.F90 b/main/FatesHistoryVariableType.F90 index 6457e644f1..75a6d30f3f 100644 --- a/main/FatesHistoryVariableType.F90 +++ b/main/FatesHistoryVariableType.F90 @@ -1,7 +1,8 @@ module FatesHistoryVariableType use FatesConstantsMod, only : r8 => fates_r8 - use FatesGlobals, only : fates_log + use FatesGlobals, only : fates_log + use FatesGlobals , only : endrun => fates_endrun use FatesIODimensionsMod, only : fates_io_dimension_type use FatesIOVariableKindMod, only : fates_io_variable_kind_type use FatesIOVariableKindMod, only : patch_r8, patch_ground_r8, patch_size_pft_r8 @@ -15,12 +16,16 @@ module FatesHistoryVariableType use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 use FatesIOVariableKindMod, only : iotype_index, site_agefuel_r8 - + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none private ! By default everything is private ! Make public necessary subroutines and functions + + character(len=*), parameter, private :: sourcefile = & + __FILE__ ! This type is instanteated in the HLM-FATES interface (clmfates_interfaceMod.F90) @@ -208,8 +213,7 @@ subroutine Init(this, vname, units, long, use_default, & case default write(fates_log(),*) 'Incompatible vtype passed to set_history_var' write(fates_log(),*) 'vtype = ',trim(vtype),' ?' - stop - ! end_run + call endrun(msg=errMsg(sourcefile, __LINE__)) end select end subroutine Init @@ -336,8 +340,7 @@ subroutine Flush(this, thread, dim_bounds, dim_kinds) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case default write(fates_log(),*) 'fates history variable type undefined while flushing history variables' - stop - !end_run + call endrun(msg=errMsg(sourcefile, __LINE__)) end select end subroutine Flush diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index 93b34ebab3..02eb39f594 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -3,10 +3,16 @@ module FatesIOVariableKindMod use FatesConstantsMod, only : fates_long_string_length use FatesGlobals, only : fates_log use FatesIODimensionsMod, only : fates_io_dimension_type + use FatesGlobals , only : endrun => fates_endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none private + character(len=*), parameter, private :: sourcefile = & + __FILE__ + ! FIXME(bja, 2016-10) do these need to be strings, or can they be integer enumerations? ! FIXME(rgk, 2016-11) these should probably be moved to varkindmod? @@ -122,7 +128,7 @@ function iotype_index(iotype_name, num_dim_kinds, dim_kinds) result(dk_index) end if end do write(fates_log(),*) 'An IOTYPE THAT DOESNT EXIST WAS SPECIFIED' - !end_run + call endrun(msg=errMsg(sourcefile, __LINE__)) end function iotype_index diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 5561a78f52..bc7cb4e7ea 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -1251,36 +1251,28 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) case('check_allset') if(hlm_numSWb .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(), *) 'FATES dimension/parameter unset: num_sw_rad_bbands' - end if + write(fates_log(), *) 'FATES dimension/parameter unset: num_sw_rad_bbands' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_masterproc .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(), *) 'FATES parameter unset: hlm_masterproc' - end if + write(fates_log(), *) 'FATES parameter unset: hlm_masterproc' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_numSWb > maxSWb) then - if (fates_global_verbose()) then - write(fates_log(), *) 'FATES sets a maximum number of shortwave bands' - write(fates_log(), *) 'for some scratch-space, maxSWb' - write(fates_log(), *) 'it defaults to 2, but can be increased as needed' - write(fates_log(), *) 'your driver or host model is intending to drive' - write(fates_log(), *) 'FATES with:',hlm_numSWb,' bands.' - write(fates_log(), *) 'please increase maxSWb in EDTypes to match' - write(fates_log(), *) 'or exceed this value' - end if + write(fates_log(), *) 'FATES sets a maximum number of shortwave bands' + write(fates_log(), *) 'for some scratch-space, maxSWb' + write(fates_log(), *) 'it defaults to 2, but can be increased as needed' + write(fates_log(), *) 'your driver or host model is intending to drive' + write(fates_log(), *) 'FATES with:',hlm_numSWb,' bands.' + write(fates_log(), *) 'please increase maxSWb in EDTypes to match' + write(fates_log(), *) 'or exceed this value' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if ( .not.((hlm_use_planthydro.eq.1).or.(hlm_use_planthydro.eq.0)) ) then - if (fates_global_verbose()) then - write(fates_log(), *) 'The FATES namelist planthydro flag must be 0 or 1, exiting' - end if + write(fates_log(), *) 'The FATES namelist planthydro flag must be 0 or 1, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) elseif (hlm_use_planthydro.eq.1 ) then write(fates_log(), *) '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' @@ -1293,30 +1285,23 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) end if if ( (hlm_use_lu_harvest .lt. 0).or.(hlm_use_lu_harvest .gt. 1) ) then - if (fates_global_verbose()) then - write(fates_log(), *) 'The FATES lu_harvest flag must be 0 or 1, exiting' - end if + write(fates_log(), *) 'The FATES lu_harvest flag must be 0 or 1, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if ( (hlm_num_lu_harvest_cats .lt. 0) ) then - if (fates_global_verbose()) then - write(fates_log(), *) 'The FATES number of hlm harvest cats must be >= 0, exiting' - end if + write(fates_log(), *) 'The FATES number of hlm harvest cats must be >= 0, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if ( .not.((hlm_use_logging .eq.1).or.(hlm_use_logging.eq.0)) ) then - if (fates_global_verbose()) then - write(fates_log(), *) 'The FATES namelist use_logging flag must be 0 or 1, exiting' - end if + write(fates_log(), *) 'The FATES namelist use_logging flag must be 0 or 1, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if ( ( ANY(EDPftvarcon_inst%mort_ip_age_senescence < fates_check_param_set )) .and. & (hlm_use_cohort_age_tracking .eq.0 ) ) then - write(fates_log(),*) 'Age dependent mortality cannot be on if' write(fates_log(),*) 'cohort age tracking is off.' write(fates_log(),*) 'Set hlm_use_cohort_age_tracking = .true.' @@ -1324,191 +1309,136 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) write(fates_log(),*) 'Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if ( .not.((hlm_use_ed_st3.eq.1).or.(hlm_use_ed_st3.eq.0)) ) then - if (fates_global_verbose()) then - write(fates_log(), *) 'The FATES namelist stand structure flag must be 0 or 1, exiting' - end if + write(fates_log(), *) 'The FATES namelist stand structure flag must be 0 or 1, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if ( .not.((hlm_use_ed_prescribed_phys.eq.1).or.(hlm_use_ed_prescribed_phys.eq.0)) ) then - if (fates_global_verbose()) then - write(fates_log(), *) 'The FATES namelist prescribed physiology flag must be 0 or 1, exiting' - end if + write(fates_log(), *) 'The FATES namelist prescribed physiology flag must be 0 or 1, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if ( hlm_use_ed_prescribed_phys.eq.1 .and. hlm_use_ed_st3.eq.1 ) then - if (fates_global_verbose()) then - write(fates_log(), *) 'FATES ST3 and prescribed physiology cannot both be turned on.' - write(fates_log(), *) 'Review the namelist entries, exiting' - end if + write(fates_log(), *) 'FATES ST3 and prescribed physiology cannot both be turned on.' + write(fates_log(), *) 'Review the namelist entries, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if ( hlm_use_inventory_init.eq.1 .and. hlm_use_cohort_age_tracking .eq.1) then - if (fates_global_verbose()) then - write(fates_log(), *) 'Fates inventory init cannot be used with age dependent mortality' - write(fates_log(), *) 'Set hlm_use_cohort_age_tracking to 0 or turn off inventory init' - end if + write(fates_log(), *) 'Fates inventory init cannot be used with age dependent mortality' + write(fates_log(), *) 'Set hlm_use_cohort_age_tracking to 0 or turn off inventory init' call endrun(msg=errMsg(sourcefile, __LINE__)) end if - - if ( .not.((hlm_use_inventory_init.eq.1).or.(hlm_use_inventory_init.eq.0)) ) then - if (fates_global_verbose()) then - write(fates_log(), *) 'The FATES NL inventory flag must be 0 or 1, exiting' - end if + write(fates_log(), *) 'The FATES NL inventory flag must be 0 or 1, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(trim(hlm_inventory_ctrl_file) .eq. 'unset') then - if (fates_global_verbose()) then - write(fates_log(),*) 'namelist entry for fates inventory control file is unset, exiting' - end if + write(fates_log(),*) 'namelist entry for fates inventory control file is unset, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_ivis .ne. ivis) then - if (fates_global_verbose()) then - write(fates_log(), *) 'FATES assumption about the index of visible shortwave' - write(fates_log(), *) 'radiation is different from the HLM, exiting' - end if + write(fates_log(), *) 'FATES assumption about the index of visible shortwave' + write(fates_log(), *) 'radiation is different from the HLM, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_inir .ne. inir) then - if (fates_global_verbose()) then - write(fates_log(), *) 'FATES assumption about the index of NIR shortwave' - write(fates_log(), *) 'radiation is different from the HLM, exiting' - end if + write(fates_log(), *) 'FATES assumption about the index of NIR shortwave' + write(fates_log(), *) 'radiation is different from the HLM, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_is_restart .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(), *) 'FATES parameter unset: hlm_is_restart, exiting' - end if + write(fates_log(), *) 'FATES parameter unset: hlm_is_restart, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_numlevgrnd .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(), *) 'FATES dimension/parameter unset: numlevground, exiting' - end if + write(fates_log(), *) 'FATES dimension/parameter unset: numlevground, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(trim(hlm_name) .eq. 'unset') then - if (fates_global_verbose()) then - write(fates_log(),*) 'FATES dimension/parameter unset: hlm_name, exiting' - end if + write(fates_log(),*) 'FATES dimension/parameter unset: hlm_name, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(trim(hlm_nu_com) .eq. 'unset') then - if (fates_global_verbose()) then - write(fates_log(),*) 'FATES dimension/parameter unset: hlm_nu_com, exiting' - end if + write(fates_log(),*) 'FATES dimension/parameter unset: hlm_nu_com, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_nitrogen_spec .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(),*) 'FATES parameters unset: hlm_nitrogen_spec, exiting' - end if + write(fates_log(),*) 'FATES parameters unset: hlm_nitrogen_spec, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_phosphorus_spec .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(),*) 'FATES parameters unset: hlm_phosphorus_spec, exiting' - end if + write(fates_log(),*) 'FATES parameters unset: hlm_phosphorus_spec, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if( abs(hlm_hio_ignore_val-unset_double)<1e-10 ) then - if (fates_global_verbose()) then - write(fates_log(),*) 'FATES dimension/parameter unset: hio_ignore' - end if + write(fates_log(),*) 'FATES dimension/parameter unset: hio_ignore' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_ipedof .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(), *) 'index for the HLMs pedotransfer function unset: hlm_ipedof, exiting' - end if + write(fates_log(), *) 'index for the HLMs pedotransfer function unset: hlm_ipedof, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_max_patch_per_site .eq. unset_int ) then - if (fates_global_verbose()) then - write(fates_log(), *) 'the number of patch-space per site unset: hlm_max_patch_per_site, exiting' - end if + write(fates_log(), *) 'the number of patch-space per site unset: hlm_max_patch_per_site, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) elseif(hlm_max_patch_per_site < maxPatchesPerSite ) then - if (fates_global_verbose()) then - write(fates_log(), *) 'FATES is trying to allocate space for more patches per site, than the HLM has space for.' - write(fates_log(), *) 'hlm_max_patch_per_site (HLM side): ', hlm_max_patch_per_site - write(fates_log(), *) 'maxPatchesPerSite (FATES side): ', maxPatchesPerSite - write(fates_log(), *) - end if + write(fates_log(), *) 'FATES is trying to allocate space for more patches per site, than the HLM has space for.' + write(fates_log(), *) 'hlm_max_patch_per_site (HLM side): ', hlm_max_patch_per_site + write(fates_log(), *) 'maxPatchesPerSite (FATES side): ', maxPatchesPerSite + write(fates_log(), *) call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_parteh_mode .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(), *) 'switch deciding which plant reactive transport model to use is unset, hlm_parteh_mode, exiting' - end if + write(fates_log(), *) 'switch deciding which plant reactive transport model to use is unset, hlm_parteh_mode, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_use_ch4 .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(), *) 'switch for the HLMs CH4 module unset: hlm_use_ch4, exiting' - end if + write(fates_log(), *) 'switch for the HLMs CH4 module unset: hlm_use_ch4, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_use_vertsoilc .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(), *) 'switch for the HLMs soil carbon discretization unset: hlm_use_vertsoilc, exiting' - end if + write(fates_log(), *) 'switch for the HLMs soil carbon discretization unset: hlm_use_vertsoilc, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_spitfire_mode .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(), *) 'switch for SPITFIRE unset: hlm_spitfire_mode, exiting' - end if + write(fates_log(), *) 'switch for SPITFIRE unset: hlm_spitfire_mode, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_sf_nofire_def .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(), *) 'definition of no-fire mode unset: hlm_sf_nofire_def, exiting' - end if + write(fates_log(), *) 'definition of no-fire mode unset: hlm_sf_nofire_def, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_sf_scalar_lightning_def .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(), *) 'definition of scalar lightning mode unset: hlm_sf_scalltng_def, exiting' - end if + write(fates_log(), *) 'definition of scalar lightning mode unset: hlm_sf_scalltng_def, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_sf_successful_ignitions_def .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(), *) 'definition of successful ignition mode unset: hlm_sf_successful, exiting' - end if + write(fates_log(), *) 'definition of successful ignition mode unset: hlm_sf_successful, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_sf_anthro_ignitions_def .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(), *) 'definition of anthro-ignition mode unset: hlm_sf_anthig_def, exiting' - end if + write(fates_log(), *) 'definition of anthro-ignition mode unset: hlm_sf_anthig_def, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -1521,33 +1451,24 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) call endrun(msg=errMsg(sourcefile, __LINE__)) end if end if - if(hlm_use_fixed_biogeog.eq.unset_int) then - if(fates_global_verbose()) then - write(fates_log(), *) 'switch for fixed biogeog unset: him_use_fixed_biogeog, exiting' - end if - call endrun(msg=errMsg(sourcefile, __LINE__)) + write(fates_log(), *) 'switch for fixed biogeog unset: him_use_fixed_biogeog, exiting' + call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_use_nocomp.eq.unset_int) then - if(fates_global_verbose()) then - write(fates_log(), *) 'switch for no competition mode. ' - end if - call endrun(msg=errMsg(sourcefile, __LINE__)) + write(fates_log(), *) 'switch for no competition mode. ' + call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_use_sp.eq.unset_int) then - if(fates_global_verbose()) then - write(fates_log(), *) 'switch for SP mode. ' - end if - call endrun(msg=errMsg(sourcefile, __LINE__)) + write(fates_log(), *) 'switch for SP mode. ' + call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_use_cohort_age_tracking .eq. unset_int) then - if (fates_global_verbose()) then - write(fates_log(), *) 'switch for cohort_age_tracking unset: hlm_use_cohort_age_tracking, exiting' - end if + write(fates_log(), *) 'switch for cohort_age_tracking unset: hlm_use_cohort_age_tracking, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -1556,7 +1477,6 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - if(hlm_use_sp.eq.itrue.and.hlm_use_fixed_biogeog.eq.ifalse)then write(fates_log(), *) 'SP cannot be on if fixed biogeog mode is off. Exiting. ' call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -1565,7 +1485,6 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) if (fates_global_verbose()) then write(fates_log(), *) 'Checked. All control parameters sent to FATES.' end if - case default @@ -1695,10 +1614,10 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) end if case('use_sp') - hlm_use_sp = ival - if (fates_global_verbose()) then - write(fates_log(),*) 'Transfering hlm_use_sp= ',ival,' to FATES' - end if + hlm_use_sp = ival + if (fates_global_verbose()) then + write(fates_log(),*) 'Transfering hlm_use_sp= ',ival,' to FATES' + end if case('use_planthydro') hlm_use_planthydro = ival @@ -1749,11 +1668,8 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) end if case default - if (fates_global_verbose()) then - write(fates_log(), *) 'tag not recognized:',trim(tag) - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - ! end_run + write(fates_log(), *) 'fates NL tag not recognized:',trim(tag) + call endrun(msg=errMsg(sourcefile, __LINE__)) end select end if @@ -1766,10 +1682,8 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) write(fates_log(),*) 'Transfering hio_ignore_val = ',rval,' to FATES' end if case default - if (fates_global_verbose()) then - write(fates_log(),*) 'tag not recognized:',trim(tag) - end if - ! end_run + write(fates_log(),*) 'fates NL tag not recognized:',trim(tag) + call endrun(msg=errMsg(sourcefile, __LINE__)) end select end if @@ -1795,10 +1709,8 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) end if case default - if (fates_global_verbose()) then - write(fates_log(),*) 'tag not recognized:',trim(tag) - end if - ! end_run + write(fates_log(),*) 'fates NL tag not recognized:',trim(tag) + call endrun(msg=errMsg(sourcefile, __LINE__)) end select end if diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 19596a833e..cc939f6a33 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -484,7 +484,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) write(fates_log(),*) 'Lat: ',sites(s)%lat,' Lon: ',sites(s)%lon write(fates_log(),*) basal_area_pref,' [m2/ha]' write(fates_log(),*) '-------------------------------------------------------' - + ! Update the patch index numbers and fuse the cohorts in the patches ! ---------------------------------------------------------------------------------------- ipa=1 @@ -994,9 +994,11 @@ subroutine set_inventory_edcohort_type1(csite,bc_in,css_file_unit,npatches, & end if if (c_pft .eq. 0 ) then - write(fates_log(), *) 'inventory pft: ',c_pft - write(fates_log(), *) 'SPECIAL CASE TRIGGERED: PFT == 0 and therefore this subroutine' - write(fates_log(), *) 'will assign a cohort with n = n_orig/numpft to every cohort in range 1 to numpft' + if(debug_inv)then + write(fates_log(), *) 'inventory pft: ',c_pft + write(fates_log(), *) 'SPECIAL CASE TRIGGERED: PFT == 0 and therefore this subroutine' + write(fates_log(), *) 'will assign a cohort with n = n_orig/numpft to every cohort in range 1 to numpft' + end if ncohorts_to_create = numpft else ncohorts_to_create = 1 diff --git a/main/FatesParametersInterface.F90 b/main/FatesParametersInterface.F90 index f69d4ef5bf..2e5895c472 100644 --- a/main/FatesParametersInterface.F90 +++ b/main/FatesParametersInterface.F90 @@ -370,7 +370,6 @@ subroutine SetDimensionSizes(this, is_host_file, num_used_dimensions, dimension_ ! non-empty dimension name, set the size do i = 1, num_used_dimensions if (trim(dimension_names(i)) == trim(dim_name)) then - !write(*, *) '--> ', trim(this%parameters(p)%name), ' setting ', trim(dim_name), ' d = ', d, 'size = ', dimension_sizes(i) this%parameters(p)%dimension_sizes(d) = dimension_sizes(i) exit end if diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 5fe3b267a1..c138724711 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -410,8 +410,7 @@ subroutine set_dim_indices(this, dk_name, idim, dim_index) write(fates_log(), *) 'Trying to define dimension size to a dim-type structure' write(fates_log(), *) 'but the dimension index does not exist' write(fates_log(), *) 'type: ',dk_name,' ndims: ',this%dim_kinds(ityp)%ndims,' input dim:',idim - stop - !end_run + call endrun(msg=errMsg(sourcefile, __LINE__)) end if if (idim == 1) then diff --git a/main/FatesRestartVariableType.F90 b/main/FatesRestartVariableType.F90 index 48152ec955..501dfe7023 100644 --- a/main/FatesRestartVariableType.F90 +++ b/main/FatesRestartVariableType.F90 @@ -3,10 +3,16 @@ module FatesRestartVariableMod use FatesConstantsMod, only : r8 => fates_r8 use FatesGlobals, only : fates_log use FatesIOVariableKindMod, only : fates_io_variable_kind_type - + use FatesGlobals , only : endrun => fates_endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none private ! Modules are private by default + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + ! This type is instanteated in the HLM-FATES interface (clmfates_interfaceMod.F90) type, public :: fates_restart_variable_type @@ -108,8 +114,7 @@ subroutine Init(this, vname, units, long, vtype, flushval, num_dim_kinds, dim_ki case default write(fates_log(),*) 'Incompatible vtype passed to set_restart_var' write(fates_log(),*) 'vtype = ',trim(vtype),' ?' - stop - ! end_run + call endrun(msg=errMsg(sourcefile, __LINE__)) end select end subroutine Init @@ -200,8 +205,7 @@ subroutine flush(this, thread, dim_bounds, dim_kinds) case default write(fates_log(),*) 'fates history variable type undefined while flushing history variables' - stop - !end_run + call endrun(msg=errMsg(sourcefile, __LINE__)) end select end subroutine Flush diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index dce172d47d..3332b38f9b 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -1016,6 +1016,7 @@ subroutine PRTCheckParams(is_master) write(fates_log(),*) 'the parameter file organ list' write(fates_log(),*) 'fates_prt_organ_id: ',prt_params%organ_id(:) write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(prt_params%organ_id(io) == store_organ) then write(fates_log(),*) 'with flexible cnp or c-only alloc hypothesese' @@ -1024,6 +1025,7 @@ subroutine PRTCheckParams(is_master) write(fates_log(),*) 'the parameter file organ list' write(fates_log(),*) 'fates_prt_organ_id: ',prt_params%organ_id(:) write(fates_log(),*) 'Aborting' + call endrun(msg=errMsg(sourcefile, __LINE__)) end if end do