diff --git a/src/Makefile b/src/Makefile index e9fa8bb4..f53b6dbf 100644 --- a/src/Makefile +++ b/src/Makefile @@ -76,7 +76,7 @@ MODS = $(addprefix $(OBJ_DIR)/,${MODS_TMP:.F90=.mod}) \ $(INCS) OBJS = $(addprefix $(OBJ_DIR)/,${MODULES:.F90=.o}) -CPPDEFS=-DECOSYS_BASE_NT=32 -DZOOPLANKTON_CNT=1 -DAUTOTROPH_CNT=3 -DGRAZER_PREY_CNT=3 +CPPDEFS= ifeq ($(USEMPI),TRUE) CPPDEFS+= -DMARBL_TIMING_OPT=MPI diff --git a/src/marbl_ciso_mod.F90 b/src/marbl_ciso_mod.F90 index cb0a4d68..b7983e11 100644 --- a/src/marbl_ciso_mod.F90 +++ b/src/marbl_ciso_mod.F90 @@ -12,42 +12,38 @@ module marbl_ciso_mod ! This module adds 7 carbon pools for 13C and another 7 for 14C !----------------------------------------------------------------------- - use marbl_kinds_mod , only : r8 - use marbl_kinds_mod , only : int_kind - use marbl_kinds_mod , only : log_kind - use marbl_kinds_mod , only : char_len - - use marbl_constants_mod , only : c0 - use marbl_constants_mod , only : c1 - use marbl_constants_mod , only : c2 - use marbl_constants_mod , only : c1000 - use marbl_constants_mod , only : mpercm - - use marbl_config_mod, only : autotrophs_config - - use marbl_parms, only : autotrophs - use marbl_parms, only : zooplankton - use marbl_parms, only : grazing - - use marbl_sizes , only : autotroph_cnt - use marbl_sizes , only : zooplankton_cnt - use marbl_sizes , only : grazer_prey_cnt - - use marbl_logging , only : marbl_log_type - - use marbl_interface_types , only : marbl_tracer_metadata_type - use marbl_interface_types , only : marbl_diagnostics_type - use marbl_interface_types , only : marbl_domain_type - - use marbl_internal_types , only : autotroph_parms_type - use marbl_internal_types , only : column_sinking_particle_type - use marbl_internal_types , only : marbl_interior_share_type - use marbl_internal_types , only : marbl_zooplankton_share_type - use marbl_internal_types , only : marbl_autotroph_share_type - use marbl_internal_types , only : marbl_particulate_share_type - use marbl_internal_types , only : marbl_surface_forcing_share_type - use marbl_internal_types , only : marbl_tracer_index_type - + use marbl_kinds_mod, only : r8 + use marbl_kinds_mod, only : int_kind + use marbl_kinds_mod, only : log_kind + use marbl_kinds_mod, only : char_len + + use marbl_constants_mod, only : c0 + use marbl_constants_mod, only : c1 + use marbl_constants_mod, only : c2 + use marbl_constants_mod, only : c1000 + use marbl_constants_mod, only : mpercm + + use marbl_settings_mod, only : autotroph_cnt + use marbl_settings_mod, only : autotrophs + use marbl_settings_mod, only : zooplankton + use marbl_settings_mod, only : grazing + + use marbl_logging, only : marbl_log_type + + use marbl_interface_public_types, only : marbl_tracer_metadata_type + use marbl_interface_public_types, only : marbl_diagnostics_type + use marbl_interface_public_types, only : marbl_domain_type + + use marbl_interface_private_types, only : column_sinking_particle_type + use marbl_interface_private_types, only : marbl_interior_share_type + use marbl_interface_private_types, only : marbl_particulate_share_type + use marbl_interface_private_types, only : marbl_surface_forcing_share_type + use marbl_interface_private_types, only : marbl_tracer_index_type + + use marbl_pft_mod, only : autotroph_type + use marbl_pft_mod, only : marbl_zooplankton_share_type + use marbl_pft_mod, only : marbl_autotroph_share_type + implicit none private @@ -58,7 +54,6 @@ module marbl_ciso_mod public :: marbl_ciso_init_tracer_metadata public :: marbl_ciso_set_interior_forcing public :: marbl_ciso_set_surface_forcing - public :: marbl_ciso_tracer_index_consistency_check private :: setup_cell_attributes private :: setup_local_column_tracers @@ -69,7 +64,7 @@ module marbl_ciso_mod type, private :: autotroph_local_type real (r8) :: C13 ! local copy of model autotroph C13 - real (r8) :: C14 ! local copy of model autotroph C14 + real (r8) :: C14 ! local copy of model autotroph C14 real (r8) :: Ca13CO3 ! local copy of model autotroph Ca13CO3 real (r8) :: Ca14CO3 ! local copy of model autotroph Ca14CO3 end type autotroph_local_type @@ -92,7 +87,7 @@ subroutine marbl_ciso_init_tracer_metadata(marbl_tracer_metadata, & ! Set tracer and forcing metadata - use marbl_config_mod , only : ciso_lecovars_full_depth_tavg + use marbl_settings_mod, only : ciso_lecovars_full_depth_tavg implicit none @@ -119,8 +114,8 @@ subroutine marbl_ciso_init_tracer_metadata(marbl_tracer_metadata, & di14c_ind => marbl_tracer_indices%di14c_ind, & do14c_ind => marbl_tracer_indices%do14c_ind, & zoo14c_ind => marbl_tracer_indices%zoo14c_ind, & - ciso_ind_beg => marbl_tracer_indices%ciso_ind_beg, & - ciso_ind_end => marbl_tracer_indices%ciso_ind_end & + ciso_ind_beg => marbl_tracer_indices%ciso%ind_beg, & + ciso_ind_end => marbl_tracer_indices%ciso%ind_end & ) ! All CISO tracers share units, tend_units, flux_units, and @@ -155,23 +150,23 @@ subroutine marbl_ciso_init_tracer_metadata(marbl_tracer_metadata, & do auto_ind = 1, autotroph_cnt n = marbl_tracer_indices%auto_inds(auto_ind)%C13_ind - marbl_tracer_metadata(n)%short_name = trim(autotrophs_config(auto_ind)%sname) // '13C' - marbl_tracer_metadata(n)%long_name = trim(autotrophs_config(auto_ind)%lname) // ' Carbon-13' + marbl_tracer_metadata(n)%short_name = trim(autotrophs(auto_ind)%sname) // '13C' + marbl_tracer_metadata(n)%long_name = trim(autotrophs(auto_ind)%lname) // ' Carbon-13' n = marbl_tracer_indices%auto_inds(auto_ind)%C14_ind - marbl_tracer_metadata(n)%short_name = trim(autotrophs_config(auto_ind)%sname) // '14C' - marbl_tracer_metadata(n)%long_name = trim(autotrophs_config(auto_ind)%lname) // ' Carbon-14' + marbl_tracer_metadata(n)%short_name = trim(autotrophs(auto_ind)%sname) // '14C' + marbl_tracer_metadata(n)%long_name = trim(autotrophs(auto_ind)%lname) // ' Carbon-14' n = marbl_tracer_indices%auto_inds(auto_ind)%Ca13CO3_ind if (n .gt. 0) then - marbl_tracer_metadata(n)%short_name = trim(autotrophs_config(auto_ind)%sname) // 'Ca13CO3' - marbl_tracer_metadata(n)%long_name = trim(autotrophs_config(auto_ind)%lname) // ' Ca13CO3' + marbl_tracer_metadata(n)%short_name = trim(autotrophs(auto_ind)%sname) // 'Ca13CO3' + marbl_tracer_metadata(n)%long_name = trim(autotrophs(auto_ind)%lname) // ' Ca13CO3' end if n = marbl_tracer_indices%auto_inds(auto_ind)%Ca14CO3_ind if (n .gt. 0) then - marbl_tracer_metadata(n)%short_name = trim(autotrophs_config(auto_ind)%sname) // 'Ca14CO3' - marbl_tracer_metadata(n)%long_name = trim(autotrophs_config(auto_ind)%lname) // ' Ca14CO3' + marbl_tracer_metadata(n)%short_name = trim(autotrophs(auto_ind)%sname) // 'Ca14CO3' + marbl_tracer_metadata(n)%long_name = trim(autotrophs(auto_ind)%lname) // ' Ca14CO3' endif end do @@ -223,9 +218,9 @@ subroutine marbl_ciso_set_interior_forcing( & ! 13C code is based on code from X. Giraud, ETH Zürich, 2008, for pop1 ! Also added biotic 14C - use marbl_config_mod , only : ciso_lsource_sink - use marbl_parms , only : ciso_fract_factors - use marbl_parms , only : f_graze_CaCO3_REMIN + use marbl_settings_mod , only : ciso_lsource_sink + use marbl_settings_mod , only : ciso_fract_factors + use marbl_settings_mod , only : f_graze_CaCO3_REMIN use marbl_constants_mod , only : R13C_std use marbl_constants_mod , only : R14C_std use marbl_constants_mod , only : spd @@ -235,9 +230,9 @@ subroutine marbl_ciso_set_interior_forcing( & implicit none type(marbl_domain_type) , intent(in) :: marbl_domain - type(marbl_interior_share_type) , intent(in) :: marbl_interior_share(marbl_domain%km) - type(marbl_zooplankton_share_type) , intent(in) :: marbl_zooplankton_share(zooplankton_cnt, marbl_domain%km) - type(marbl_autotroph_share_type) , intent(in) :: marbl_autotroph_share(autotroph_cnt, marbl_domain%km) + type(marbl_interior_share_type) , intent(in) :: marbl_interior_share(:) + type(marbl_zooplankton_share_type) , intent(in) :: marbl_zooplankton_share(:, :) + type(marbl_autotroph_share_type) , intent(in) :: marbl_autotroph_share(:, :) type(marbl_particulate_share_type) , intent(in) :: marbl_particulate_share real (r8) , intent(in) :: temperature(:) real (r8) , intent(in) :: column_tracer(:,:) @@ -277,7 +272,7 @@ subroutine marbl_ciso_set_interior_forcing( & real(r8), parameter :: & eps_carb = -2.0_r8 ! eps_carb = d13C(CaCO3) - d13C(DIC) Ziveri et al., 2003 - type(column_sinking_particle_type) :: & + type(column_sinking_particle_type) :: & PO13C, & ! base units = nmol 13C PO14C, & ! base units = nmol 14C P_Ca13CO3, & ! base units = nmol CaCO3 13C @@ -672,7 +667,7 @@ subroutine marbl_ciso_set_interior_forcing( & ! C13 & C14 CaCO3 production !----------------------------------------------------------------------- - if (autotrophs_config(auto_ind)%imp_calcifier) then + if (autotrophs(auto_ind)%imp_calcifier) then R13C_CaCO3_form(k) = R13C_DIC(k) + R13C_std * eps_carb / c1000 R14C_CaCO3_form(k) = R14C_DIC(k) + R14C_std * eps_carb * 2.0_r8 / c1000 @@ -895,7 +890,7 @@ subroutine marbl_ciso_set_interior_forcing( & marbl_interior_diags) !----------------------------------------------------------------------- - ! Deallocate memory for column_sinking_particle data types + ! Deallocate memory for column_sinking_particle data types !----------------------------------------------------------------------- call PO13C%destruct() @@ -907,30 +902,6 @@ end subroutine marbl_ciso_set_interior_forcing !*********************************************************************** - subroutine marbl_ciso_tracer_index_consistency_check(tracer_indices, marbl_status_log) - - use marbl_sizes, only : ciso_tracer_cnt - - type(marbl_tracer_index_type), intent(in) :: tracer_indices - type(marbl_log_type), intent(inout) :: marbl_status_log - - character(len=*), parameter :: subname = 'marbl_ciso_mod:' // & - 'marbl_ciso_tracer_index_consistency_check' - character(len=char_len) :: log_message - - integer :: tracer_cnt - - tracer_cnt = tracer_indices%ciso_ind_end - (tracer_indices%ciso_ind_beg-1) - if (tracer_cnt.ne.ciso_tracer_cnt) then - write(log_message, "(A,I0,A,I0)") "Expected ", ciso_tracer_cnt, & - " CISO tracers, but provided indexes for ", tracer_cnt - call marbl_status_log%log_error(log_message, subname) - return - end if - end subroutine marbl_ciso_tracer_index_consistency_check - - !*********************************************************************** - subroutine setup_cell_attributes(ciso_fract_factors, & cell_active_C_uptake, cell_active_C, cell_surf, cell_carb_cont, & cell_radius, cell_permea, cell_eps_fix, marbl_status_log) @@ -964,7 +935,7 @@ subroutine setup_cell_attributes(ciso_fract_factors, & case ('KellerMorel') do auto_ind = 1, autotroph_cnt - if (autotrophs_config(auto_ind)%silicifier) then + if (autotrophs(auto_ind)%silicifier) then !---------------------------------------------------------------------------------------- ! Diatom based on P. tricornumtum ( Keller and morel, 1999; Popp et al., 1998 ) !---------------------------------------------------------------------------------------- @@ -975,7 +946,7 @@ subroutine setup_cell_attributes(ciso_fract_factors, & cell_permea(auto_ind) = 3.3e-5_r8 ! cell wall permeability to CO2(aq) (m/s) cell_eps_fix(auto_ind) = 26.6_r8 ! fractionation effect of carbon fixation - else if (autotrophs_config(auto_ind)%Nfixer) then + else if (autotrophs(auto_ind)%Nfixer) then !---------------------------------------------------------------------------------------- ! Diazotroph based on Standard Phyto of Rau et al., (1996) !---------------------------------------------------------------------------------------- @@ -995,7 +966,7 @@ subroutine setup_cell_attributes(ciso_fract_factors, & cell_permea(auto_ind) = 3.0e-8_r8 ! cell wall permeability to CO2(aq) (m/s) cell_eps_fix(auto_ind) = 30.0_r8 ! fractionation effect of carbon fixation - !else if (autotrophs_config(auto_ind)%exp_calcifier) then + !else if (autotrophs(auto_ind)%exp_calcifier) then !Currently not set up to separate exp_calcifiers, needs cell_radius value from data !---------------------------------------------------------------------------------------- ! Calcifier based on P. glacialis ( Keller and morel, 1999; Popp et al., 1998 ) @@ -1008,9 +979,9 @@ subroutine setup_cell_attributes(ciso_fract_factors, & ! cell_radius(auto_ind) = ! cell radius ( um ) ! cell_permea(auto_ind) = 1.1e-5_r8 ! cell wall permeability to CO2(aq) (m/s) ! cell_eps_fix(auto_ind) = 23.0_r8 ! fractionation effect of carbon fixation - - else if (autotrophs_config(auto_ind)%Nfixer .and. & - autotrophs_config(auto_ind)%silicifier) then + + else if (autotrophs(auto_ind)%Nfixer .and. & + autotrophs(auto_ind)%silicifier) then log_message = "ciso: Currently Keller and Morel fractionation does not work for Diatoms-Diazotrophs" call marbl_status_log%log_error(log_message, subname) return @@ -1049,7 +1020,7 @@ subroutine setup_local_column_tracers(column_km, column_kmt, column_tracer, & integer(int_kind) , intent(in) :: column_km integer(int_kind) , intent(in) :: column_kmt - real (r8) , intent(in) :: column_tracer(:,:) ! (marbl_total_tracer_cnt,km) tracer values + real (r8) , intent(in) :: column_tracer(:,:) ! (tracer_cnt,km) tracer values type(marbl_tracer_index_type), intent(in) :: marbl_tracer_indices real (r8) , intent(out) :: DI13C_loc(:) ! (km) local copy of model DI13C @@ -1108,7 +1079,7 @@ subroutine setup_local_autotrophs(column_km, column_kmt, column_tracer, & integer(int_kind) , intent(in) :: column_km integer(int_kind) , intent(in) :: column_kmt - real (r8) , intent(in) :: column_tracer(:,:) ! (marbl_total_tracer_cnt, km) tracer values + real (r8) , intent(in) :: column_tracer(:,:) ! (tracer_cnt, km) tracer values type(marbl_tracer_index_type), intent(in) :: marbl_tracer_indices type(autotroph_local_type) , intent(out) :: autotroph_loc(:,:) ! (autotroph_cnt) @@ -1375,9 +1346,9 @@ subroutine compute_particulate_terms(k, column_km, column_kmt, column_delta_z, c ! Incoming fluxes are assumed to be the outgoing fluxes from the previous level. ! For other comments, see compute_particulate_terms in marbl_mod !---------------------------------------------------------------------------------------- - - use marbl_parms , only : denitrif_C_N - use marbl_constants_mod , only : spd + + use marbl_settings_mod , only : denitrif_C_N + use marbl_constants_mod, only : spd implicit none @@ -1385,7 +1356,7 @@ subroutine compute_particulate_terms(k, column_km, column_kmt, column_delta_z, c integer (int_kind) , intent(in) :: column_km integer (int_kind) , intent(in) :: column_kmt real (r8) , intent(in) :: column_delta_z - real (r8) , intent(in) :: column_zw + real (r8) , intent(in) :: column_zw real (r8) , intent(in) :: O2_loc ! dissolved oxygen used to modify POC%diss, Sed fluxes real (r8) , intent(in) :: NO3_loc ! dissolved nitrate used to modify sed fluxes type(column_sinking_particle_type) , intent(in) :: POC ! base units = nmol C @@ -1659,7 +1630,7 @@ subroutine marbl_autotroph_consistency_check(column_km, autotroph_cnt, & integer(int_kind) , intent(in) :: column_km ! number of active model layers integer(int_kind) , intent(in) :: autotroph_cnt ! autotroph_cnt - type(autotroph_parms_type) , intent(in) :: autotroph_meta(autotroph_cnt) ! autotroph metadata + type(autotroph_type) , intent(in) :: autotroph_meta(autotroph_cnt) ! autotroph metadata type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices type(marbl_autotroph_share_type) , intent(in) :: autotroph_share(autotroph_cnt, column_km) type(autotroph_local_type) , intent(inout) :: autotroph_loc(autotroph_cnt, column_km) @@ -1803,8 +1774,8 @@ subroutine marbl_ciso_set_surface_forcing( & do13c_ind => marbl_tracer_indices%do13c_ind , & di14c_ind => marbl_tracer_indices%di14c_ind , & do14c_ind => marbl_tracer_indices%do14c_ind , & - ciso_ind_beg => marbl_tracer_indices%ciso_ind_beg , & - ciso_ind_end => marbl_tracer_indices%ciso_ind_end & + ciso_ind_beg => marbl_tracer_indices%ciso%ind_beg , & + ciso_ind_end => marbl_tracer_indices%ciso%ind_end & ) !----------------------------------------------------------------------- diff --git a/src/marbl_config_mod.F90 b/src/marbl_config_mod.F90 deleted file mode 100644 index 4650860e..00000000 --- a/src/marbl_config_mod.F90 +++ /dev/null @@ -1,1300 +0,0 @@ -module marbl_config_mod - - use marbl_kinds_mod, only : r8 - use marbl_kinds_mod, only : int_kind - use marbl_kinds_mod, only : log_kind - use marbl_kinds_mod, only : char_len - - use marbl_sizes, only : autotroph_cnt - use marbl_sizes, only : zooplankton_cnt - use marbl_sizes, only : grazer_prey_cnt - - use marbl_logging, only : marbl_log_type - - use marbl_constants_mod, only : c0 - use marbl_constants_mod, only : c1 - use marbl_constants_mod, only : dps - - use marbl_internal_types, only : autotroph_config_type - use marbl_internal_types, only : zooplankton_config_type - use marbl_internal_types, only : grazing_config_type - - implicit none - public - save - - !--------------------------------------------------------------------- - ! Variables read in via &marbl_config_nml - !--------------------------------------------------------------------- - - logical(log_kind), target :: ciso_on ! control whether ciso tracer module is active - logical(log_kind), target :: lsource_sink ! control which portion of code is executed, useful for debugging - logical(log_kind), target :: ciso_lsource_sink ! control which portion of carbon isotope code is executed, useful for debugging - logical(log_kind), target :: lecovars_full_depth_tavg ! should base ecosystem vars be written full depth - logical(log_kind), target :: ciso_lecovars_full_depth_tavg ! should carbon isotope vars be written full depth - logical(log_kind), target :: lflux_gas_o2 ! controls which portion of code are executed usefull for debugging - logical(log_kind), target :: lflux_gas_co2 ! controls which portion of code are executed usefull for debugging - logical(log_kind), target :: lcompute_nhx_surface_emis ! control if NHx emissions are computed - logical(log_kind), target :: lvariable_PtoC ! control if PtoC ratios in autotrophs vary - type(autotroph_config_type), dimension(autotroph_cnt), target :: autotrophs_config - type(zooplankton_config_type), dimension(zooplankton_cnt), target :: zooplankton_config - type(grazing_config_type), dimension(grazer_prey_cnt, zooplankton_cnt), target :: grazing_config - - !----------------------------------------------------------------------- - ! bury to sediment options - ! bury coefficients (POC_bury_coeff, POP_bury_coeff, bSi_bury_coeff) reside in marbl_particulate_share_type - ! when ladjust_bury_coeff is .true., bury coefficients are adjusted - ! to preserve C, P, Si inventories on timescales exceeding bury_coeff_rmean_timescale_years - ! this is done primarily in spinup runs - !----------------------------------------------------------------------- - character(len=char_len), target :: init_bury_coeff_opt - logical(log_kind), target :: ladjust_bury_coeff - - - !--------------------------------------------------------------------- - ! Variables that don't match namelist read - !--------------------------------------------------------------------- - - !--------------------------------------------------------------------------- - ! Datatypes for marbl_instance%configuration and marbl_instance%parameters - !--------------------------------------------------------------------------- - - type, public :: marbl_single_config_or_parm_type - ! Metadata - character(len=char_len) :: long_name - character(len=char_len) :: short_name - character(len=char_len) :: units - character(len=char_len) :: group - character(len=char_len) :: datatype - integer :: category_ind ! used for sorting output list - character(len=char_len) :: comment ! used to add comment in log - ! Actual parameter data - real(r8), pointer :: rptr => NULL() - integer(int_kind), pointer :: iptr => NULL() - logical(log_kind), pointer :: lptr => NULL() - character(len=char_len), pointer :: sptr => NULL() - end type marbl_single_config_or_parm_type - - type, public :: marbl_config_and_parms_type - logical :: locked = .false. - integer :: cnt = 0 - character(len=char_len), dimension(:), pointer :: categories - type(marbl_single_config_or_parm_type), dimension(:), pointer :: vars => NULL() - contains - procedure :: add_var => marbl_var_add - procedure :: add_var_1d_r8 => marbl_var_add_1d_r8 - procedure :: add_var_1d_int => marbl_var_add_1d_int - procedure :: add_var_1d_str => marbl_var_add_1d_str - procedure :: finalize_vars => marbl_vars_finalize - procedure :: inquire_id => marbl_var_inquire_id - procedure :: inquire_metadata => marbl_var_inquire_metadata - generic :: put => put_real, & - put_integer, & - put_logical, & - put_string - generic :: get => get_real, & - get_integer, & - get_logical, & - get_string - procedure, private :: put_real => marbl_var_put_real - procedure, private :: put_integer => marbl_var_put_integer - procedure, private :: put_logical => marbl_var_put_logical - procedure, private :: put_string => marbl_var_put_string - procedure, private :: get_real => marbl_var_get_real - procedure, private :: get_integer => marbl_var_get_integer - procedure, private :: get_logical => marbl_var_get_logical - procedure, private :: get_string => marbl_var_get_string - procedure, private :: put_general => marbl_var_put_all_types - procedure, private :: get_general => marbl_var_get_all_types - end type marbl_config_and_parms_type - - !***************************************************************************** - - private :: r8, int_kind, log_kind, char_len - private :: autotroph_cnt, zooplankton_cnt - private :: marbl_log_type - private :: marbl_var_put_real, marbl_var_put_integer, marbl_var_put_logical - private :: marbl_var_put_string, marbl_var_put_all_types - -contains - - !***************************************************************************** - - subroutine marbl_config_set_defaults() - - integer :: m, n - - !----------------------------------------------------------------------- - ! &marbl_config_nml - !----------------------------------------------------------------------- - - ciso_on = .false. - lsource_sink = .true. - ciso_lsource_sink = .true. - lecovars_full_depth_tavg = .false. - ciso_lecovars_full_depth_tavg = .false. - lflux_gas_o2 = .true. - lflux_gas_co2 = .true. - lcompute_nhx_surface_emis = .true. - lvariable_PtoC = .true. - init_bury_coeff_opt = 'nml' - ladjust_bury_coeff = .false. - - do n=1,autotroph_cnt - select case (n) - case (1) - autotrophs_config(n)%sname = 'sp' - autotrophs_config(n)%lname = 'Small Phyto' - autotrophs_config(n)%Nfixer = .false. - autotrophs_config(n)%imp_calcifier = .true. - autotrophs_config(n)%exp_calcifier = .false. - autotrophs_config(n)%silicifier = .false. - case (2) - autotrophs_config(n)%sname = 'diat' - autotrophs_config(n)%lname = 'Diatom' - autotrophs_config(n)%Nfixer = .false. - autotrophs_config(n)%imp_calcifier = .false. - autotrophs_config(n)%exp_calcifier = .false. - autotrophs_config(n)%silicifier = .true. - case (3) - autotrophs_config(n)%sname = 'diaz' - autotrophs_config(n)%lname = 'Diazotroph' - autotrophs_config(n)%Nfixer = .true. - autotrophs_config(n)%imp_calcifier = .false. - autotrophs_config(n)%exp_calcifier = .false. - autotrophs_config(n)%silicifier = .false. - case DEFAULT - write(autotrophs_config(n)%sname,"(A,I0)") 'auto', n - write(autotrophs_config(n)%lname,"(A,I0)") 'Autotroph number ', n - autotrophs_config(n)%Nfixer = .false. - autotrophs_config(n)%imp_calcifier = .false. - autotrophs_config(n)%exp_calcifier = .false. - autotrophs_config(n)%silicifier = .false. - end select - end do - - do n=1,zooplankton_cnt - select case (n) - case (1) - zooplankton_config(n)%sname = 'zoo' - zooplankton_config(n)%lname = 'Zooplankton' - case DEFAULT - write(zooplankton_config(n)%sname, "(A,I0)") 'zoo', n - write(zooplankton_config(n)%lname, "(A,I0)") 'Zooplankton number ', n - end select - end do - - ! predator-prey relationships - do n=1,zooplankton_cnt - do m=1,grazer_prey_cnt - - write(grazing_config(m,n)%sname, "(4A)") 'grz_', & - trim(autotrophs_config(m)%sname), & - '_', trim(zooplankton_config(n)%sname) - write(grazing_config(m,n)%lname, "(4A)") 'Grazing of ', & - trim(autotrophs_config(m)%sname), & - ' by ', trim(zooplankton_config(n)%sname) - grazing_config(m,n)%auto_ind_cnt = 1 - grazing_config(m,n)%zoo_ind_cnt = 0 - end do - end do - - end subroutine marbl_config_set_defaults - - !***************************************************************************** - - subroutine marbl_config_read_namelist(nl_buffer, marbl_status_log) - - use marbl_namelist_mod, only : marbl_namelist - - character(len=*), intent(in) :: nl_buffer(:) - type(marbl_log_type), intent(inout) :: marbl_status_log - - !--------------------------------------------------------------------------- - ! local variables - !--------------------------------------------------------------------------- - character(len=*), parameter :: subname = 'marbl_config:marbl_config_read_namelist' - character(len=char_len) :: log_message - - character(len=len(nl_buffer)) :: tmp_nl_buffer - integer (int_kind) :: nml_error ! namelist i/o error flag - - namelist /marbl_config_nml/ & - ciso_on, lsource_sink, ciso_lsource_sink, lecovars_full_depth_tavg, & - ciso_lecovars_full_depth_tavg, & - lflux_gas_o2, lflux_gas_co2, lcompute_nhx_surface_emis, & - init_bury_coeff_opt, ladjust_bury_coeff, & - lvariable_PtoC, & - autotrophs_config, zooplankton_config, grazing_config - - !----------------------------------------------------------------------- - ! read the &marbl_config_nml namelist - !----------------------------------------------------------------------- - - tmp_nl_buffer = marbl_namelist(nl_buffer, 'marbl_config_nml', marbl_status_log) - if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('marbl_namelist', subname) - return - end if - - read(tmp_nl_buffer, nml=marbl_config_nml, iostat=nml_error) - if (nml_error /= 0) then - write(log_message, "(A)") 'error reading &marbl_config_nml' - call marbl_status_log%log_error(log_message, subname) - return - end if - - end subroutine marbl_config_read_namelist - - !***************************************************************************** - - subroutine marbl_define_config_vars(this, marbl_status_log) - - class(marbl_config_and_parms_type), intent(inout) :: this - type(marbl_log_type), intent(inout) :: marbl_status_log - - character(len=*), parameter :: subname = 'marbl_config_mod:marbl_define_config_vars' - character(len=char_len) :: log_message - - character(len=char_len) :: sname, lname, units, datatype, group, category - real(r8), pointer :: rptr => NULL() - integer(int_kind), pointer :: iptr => NULL() - logical(log_kind), pointer :: lptr => NULL() - character(len=char_len), pointer :: sptr => NULL() - - integer :: m, n - character(len=char_len) :: prefix - - if (associated(this%vars)) then - write(log_message, "(A)") "this%configuration has been constructed already" - call marbl_status_log%log_error(log_message, subname) - return - end if - - this%cnt = 0 - allocate(this%vars(this%cnt)) - allocate(this%categories(0)) - - !------------------! - ! marbl_config_nml ! - !------------------! - - category = 'config flags' - - sname = 'ciso_on' - lname = 'Control whether CISO tracer module is active' - units = 'unitless' - datatype = 'logical' - group = 'marbl_config_nml' - lptr => ciso_on - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, lptr=lptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'lsource_sink' - lname = 'Control which portions of code are executed (useful for debugging)' - units = 'unitless' - datatype = 'logical' - group = 'marbl_config_nml' - lptr => lsource_sink - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, lptr=lptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'lecovars_full_depth_tavg' - lname = 'Are base ecosystem tracers full depth?' - units = 'unitless' - datatype = 'logical' - group = 'marbl_config_nml' - lptr => lecovars_full_depth_tavg - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, lptr=lptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'ciso_lsource_sink' - lname = 'Control which portions of carbon isotope code are executed (useful for debugging)' - units = 'unitless' - datatype = 'logical' - group = 'marbl_config_nml' - lptr => ciso_lsource_sink - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, lptr=lptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'ciso_lecovars_full_depth_tavg' - lname = 'Are carbon isotope tracers full depth?' - units = 'unitless' - datatype = 'logical' - group = 'marbl_config_nml' - lptr => ciso_lecovars_full_depth_tavg - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, lptr=lptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'lflux_gas_o2' - lname = 'Run O2 gas flux portion of the code' - units = 'unitless' - datatype = 'logical' - group = 'marbl_config_nml' - lptr => lflux_gas_o2 - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, lptr=lptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'lflux_gas_co2' - lname = 'Run CO2 gas flux portion of the code' - units = 'unitless' - datatype = 'logical' - group = 'marbl_config_nml' - lptr => lflux_gas_co2 - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, lptr=lptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'lcompute_nhx_surface_emis' - lname = 'control if NHx emissions are computed' - units = 'unitless' - datatype = 'logical' - group = 'marbl_config_nml' - lptr => lcompute_nhx_surface_emis - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, lptr=lptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'lvariable_PtoC' - lname = 'control if PtoC ratios in autotrophs vary' - units = 'unitless' - datatype = 'logical' - group = 'marbl_config_nml' - lptr => lvariable_PtoC - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, lptr=lptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'ladjust_bury_coeff' - lname = 'Adjust the bury coefficient to maintain equilibrium' - units = 'unitless' - datatype = 'logical' - group = 'marbl_config_nml' - lptr => ladjust_bury_coeff - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, lptr=lptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'init_bury_coeff_opt' - lname = 'How to set initial bury coefficients' - units = 'unitless' - datatype = 'string' - group = 'marbl_config_nml' - sptr => init_bury_coeff_opt - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, sptr=sptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - do n=1,autotroph_cnt - write(prefix, "(A,I0,A)") 'autotrophs_config(', n, ')%' - write(category, "(A,1X,I0)") 'autotroph config', n - - write(sname, "(2A)") trim(prefix), 'sname' - lname = 'Short name of autotroph' - units = 'unitless' - datatype = 'string' - group = 'marbl_config_nml' - sptr => autotrophs_config(n)%sname - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, sptr=sptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'lname' - lname = 'Long name of autotroph' - units = 'unitless' - datatype = 'string' - group = 'marbl_config_nml' - sptr => autotrophs_config(n)%lname - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, sptr=sptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'Nfixer' - lname = 'Flag is true if this autotroph fixes N2' - units = 'unitless' - datatype = 'logical' - group = 'marbl_config_nml' - lptr => autotrophs_config(n)%Nfixer - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, lptr=lptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'imp_calcifier' - lname = 'Flag is true if this autotroph implicitly handles calcification' - units = 'unitless' - datatype = 'logical' - group = 'marbl_config_nml' - lptr => autotrophs_config(n)%imp_calcifier - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, lptr=lptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'exp_calcifier' - lname = 'Flag is true if this autotroph explicitly handles calcification' - units = 'unitless' - datatype = 'logical' - group = 'marbl_config_nml' - lptr => autotrophs_config(n)%exp_calcifier - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, lptr=lptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'silicifier' - lname = 'Flag is true if this autotroph is a silicifier' - units = 'unitless' - datatype = 'logical' - group = 'marbl_config_nml' - lptr => autotrophs_config(n)%silicifier - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, lptr=lptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - end do - - do n=1, zooplankton_cnt - write(prefix, "(A,I0,A)") 'zooplankton_config(', n, ')%' - write(category, "(A,1X,I0)") 'zooplankton config', n - - write(sname, "(2A)") trim(prefix), 'sname' - lname = 'Short name of zooplankton' - units = 'unitless' - datatype = 'string' - group = 'marbl_config_nml' - sptr => zooplankton_config(n)%sname - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, sptr=sptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'lname' - lname = 'Long name of zooplankton' - units = 'unitless' - datatype = 'string' - group = 'marbl_config_nml' - sptr => zooplankton_config(n)%lname - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, sptr=sptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - end do - - do n=1,zooplankton_cnt - do m=1,grazer_prey_cnt - write(prefix, "(A,I0,A,I0,A)") 'grazing_config(', m, ',', n, ')%' - write(category, "(A,1X,I0,1X,I0)") 'grazing config', m, n - - write(sname, "(2A)") trim(prefix), 'sname' - lname = 'Short name of grazer' - units = 'unitless' - datatype = 'string' - group = 'marbl_config_nml' - sptr => grazing_config(m,n)%sname - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, sptr=sptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'lname' - lname = 'Long name of grazer' - units = 'unitless' - datatype = 'string' - group = 'marbl_config_nml' - sptr => grazing_config(m,n)%lname - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, sptr=sptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'auto_ind_cnt' - lname = 'number of autotrophs in prey-clase auto_ind' - units = 'unitless' - datatype = 'integer' - group = 'marbl_config_nml' - iptr => grazing_config(m,n)%auto_ind_cnt - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, iptr=iptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'zoo_ind_cnt' - lname = 'number of zooplankton in prey-clase auto_ind' - units = 'unitless' - datatype = 'integer' - group = 'marbl_config_nml' - iptr => grazing_config(m,n)%zoo_ind_cnt - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, iptr=iptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - end do - end do - - end subroutine marbl_define_config_vars - - !***************************************************************************** - - subroutine marbl_var_add(this, sname, lname, units, datatype, group, & - category, marbl_status_log, & - rptr, iptr, lptr, sptr, comment) - - class(marbl_config_and_parms_type), intent(inout) :: this - character(len=*), intent(in) :: sname - character(len=*), intent(in) :: lname - character(len=*), intent(in) :: units - character(len=*), intent(in) :: datatype - character(len=*), intent(in) :: group - character(len=*), intent(in) :: category - type(marbl_log_type), intent(inout) :: marbl_status_log - real(r8), optional, pointer, intent(in) :: rptr - integer, optional, pointer, intent(in) :: iptr - logical, optional, pointer, intent(in) :: lptr - character(len=char_len), optional, pointer, intent(in) :: sptr - character(len=char_len), optional, intent(in) :: comment - - character(len=*), parameter :: subname = 'marbl_config_mod:marbl_var_add' - - type(marbl_single_config_or_parm_type), dimension(:), pointer :: new_vars - character(len=char_len), dimension(:), pointer :: new_categories - integer :: old_size, id, cat_ind, n - character(len=char_len) :: log_message - - if (.not.associated(this%vars)) then - write(log_message, "(A)") 'Constructor must be run before adding vars' - call marbl_status_log%log_error(log_message, subname) - return - end if - - old_size = size(this%vars) - id = old_size+1 - - ! 1) Allocate new_vars to be size N (one element larger than this%vars) - allocate(new_vars(id)) - - ! 2) Determine category ID - do cat_ind = 1, size(this%categories) - if (trim(category) .eq. trim(this%categories(cat_ind))) then - exit - end if - end do - if (cat_ind .gt. size(this%categories)) then - allocate(new_categories(cat_ind)) - new_categories(1:size(this%categories)) = this%categories - new_categories(cat_ind) = category - deallocate(this%categories) - this%categories => new_categories - end if - - ! 3) copy this%vars into first N-1 elements of new_vars - do n=1, old_size - ! Also do some error checking - ! (a) Ensure sname does not match a previous variable short_name - if (trim(sname) .eq. trim(this%vars(n)%short_name)) then - write(log_message, "(A,1X,A)") trim(sname), "has been added twice" - call marbl_status_log%log_error(log_message, subname) - end if - - ! (b) Ensure pointers do not point to same target as other variables - if (present(rptr)) then - if (associated(rptr, this%vars(n)%rptr)) then - write(log_message, "(4A)") trim(sname), " and ", trim(this%vars(n)%short_name), & - " both point to same variable in memory." - call marbl_status_log%log_error(log_message, subname) - end if - end if - if (present(iptr)) then - if (associated(iptr, this%vars(n)%iptr)) then - write(log_message, "(4A)") trim(sname), " and ", trim(this%vars(n)%short_name), & - " both point to same variable in memory." - call marbl_status_log%log_error(log_message, subname) - end if - end if - if (present(lptr)) then - if (associated(lptr, this%vars(n)%lptr)) then - write(log_message, "(4A)") trim(sname), " and ", trim(this%vars(n)%short_name), & - " both point to same variable in memory." - call marbl_status_log%log_error(log_message, subname) - end if - end if - if (present(sptr)) then - if (associated(sptr, this%vars(n)%sptr)) then - write(log_message, "(4A)") trim(sname), " and ", trim(this%vars(n)%short_name), & - " both point to same variable in memory." - call marbl_status_log%log_error(log_message, subname) - end if - end if - if (marbl_status_log%labort_marbl) return - - new_vars(n)%long_name = this%vars(n)%long_name - new_vars(n)%short_name = this%vars(n)%short_name - new_vars(n)%units = this%vars(n)%units - new_vars(n)%datatype = this%vars(n)%datatype - new_vars(n)%group = this%vars(n)%group - new_vars(n)%category_ind = this%vars(n)%category_ind - new_vars(n)%comment = this%vars(n)%comment - ! All pointer components of new_vars are nullified in the type definition - ! via => NULL() statements - if (associated(this%vars(n)%lptr)) & - new_vars(n)%lptr => this%vars(n)%lptr - if (associated(this%vars(n)%iptr)) & - new_vars(n)%iptr => this%vars(n)%iptr - if (associated(this%vars(n)%rptr)) & - new_vars(n)%rptr => this%vars(n)%rptr - if (associated(this%vars(n)%sptr)) & - new_vars(n)%sptr => this%vars(n)%sptr - end do - - ! 4) add newest parm variable - ! All pointer components of new_vars are nullified in the type definition - ! via => NULL() statements - select case (trim(datatype)) - case ('real') - if (present(rptr)) then - new_vars(id)%rptr => rptr - else - write(log_message, "(A)") & - "Defining real parameter but rptr not present!" - call marbl_status_log%log_error(log_message, subname) - return - end if - case ('integer') - if (present(iptr)) then - new_vars(id)%iptr => iptr - else - write(log_message, "(A)") & - "Defining integer parameter but iptr not present!" - call marbl_status_log%log_error(log_message, subname) - return - end if - case ('logical') - if (present(lptr)) then - new_vars(id)%lptr => lptr - else - write(log_message, "(A)") & - "Defining logical parameter but lptr not present!" - call marbl_status_log%log_error(log_message, subname) - return - end if - case ('string') - if (present(sptr)) then - new_vars(id)%sptr => sptr - else - write(log_message, "(A)") & - "Defining string parameter but aptr not present!" - call marbl_status_log%log_error(log_message, subname) - return - end if - case DEFAULT - write(log_message, "(2A)") "Unknown datatype: ", trim(datatype) - call marbl_status_log%log_error(log_message, subname) - return - end select - new_vars(id)%short_name = trim(sname) - new_vars(id)%long_name = trim(lname) - new_vars(id)%units = trim(units) - new_vars(id)%datatype = trim(datatype) - new_vars(id)%group = trim(group) - new_vars(id)%category_ind = cat_ind - if (present(comment)) then - new_vars(id)%comment = comment - else - new_vars(id)%comment = '' - end if - - ! 5) deallocate this%vars / point to new_vars (and update cnt) - deallocate(this%vars) - this%vars => new_vars - this%cnt = id - - end subroutine marbl_var_add - - !***************************************************************************** - - subroutine marbl_var_add_1d_r8(this, sname, lname, units, group, category, & - r8array, marbl_status_log) - - class(marbl_config_and_parms_type), intent(inout) :: this - character(len=char_len), intent(in) :: sname - character(len=char_len), intent(in) :: lname - character(len=char_len), intent(in) :: units - character(len=char_len), intent(in) :: group - character(len=char_len), intent(in) :: category - real(kind=r8), dimension(:), target, intent(in) :: r8array - type(marbl_log_type), intent(inout) :: marbl_status_log - - character(len=*), parameter :: subname = 'marbl_config_mod:marbl_var_add_1d_r8' - - character(len=char_len) :: sname_loc - real(r8), pointer :: rptr => NULL() - integer :: n - - do n=1,size(r8array) - write(sname_loc, "(2A,I0,A)") trim(sname), '(', n, ')' - rptr => r8array(n) - call this%add_var(sname_loc, lname, units, 'real', group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname_loc, subname) - return - end if - end do - - end subroutine marbl_var_add_1d_r8 - - !***************************************************************************** - - subroutine marbl_var_add_1d_int(this, sname, lname, units, group, category, & - intarray, marbl_status_log) - - class(marbl_config_and_parms_type), intent(inout) :: this - character(len=char_len), intent(in) :: sname - character(len=char_len), intent(in) :: lname - character(len=char_len), intent(in) :: units - character(len=char_len), intent(in) :: group - character(len=char_len), intent(in) :: category - integer, dimension(:), target, intent(in) :: intarray - type(marbl_log_type), intent(inout) :: marbl_status_log - - character(len=*), parameter :: subname = 'marbl_config_mod:marbl_var_add_1d_int' - - character(len=char_len) :: sname_loc - integer, pointer :: iptr => NULL() - integer :: n - - do n=1,size(intarray) - write(sname_loc, "(2A,I0,A)") trim(sname), '(', n, ')' - iptr => intarray(n) - call this%add_var(sname_loc, lname, units, 'integer', group, category, & - marbl_status_log, iptr=iptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname_loc, subname) - return - end if - end do - - end subroutine marbl_var_add_1d_int - - !***************************************************************************** - - subroutine marbl_var_add_1d_str(this, sname, lname, units, group, category, & - strarray, marbl_status_log) - - class(marbl_config_and_parms_type), intent(inout) :: this - character(len=char_len), intent(in) :: sname - character(len=char_len), intent(in) :: lname - character(len=char_len), intent(in) :: units - character(len=char_len), intent(in) :: group - character(len=char_len), intent(in) :: category - character(len=char_len), target, intent(in) :: strarray(:) - type(marbl_log_type), intent(inout) :: marbl_status_log - - character(len=*), parameter :: subname = 'marbl_config_mod:marbl_var_add_1d_str' - - character(len=char_len) :: sname_loc - character(len=char_len), pointer :: sptr => NULL() - integer :: n - - do n=1,size(strarray) - write(sname_loc, "(2A,I0,A)") trim(sname), '(', n, ')' - sptr => strarray(n) - call this%add_var(sname_loc, lname, units, 'string', group, category, & - marbl_status_log, sptr=sptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname_loc, subname) - return - end if - end do - - end subroutine marbl_var_add_1d_str - - !***************************************************************************** - - subroutine marbl_vars_finalize(this, marbl_status_log) - - class(marbl_config_and_parms_type), intent(inout) :: this - type(marbl_log_type), intent(inout) :: marbl_status_log - - character(len=*), parameter :: subname = 'marbl_config_mod:marbl_vars_finalize' - character(len=char_len) :: log_message - - character(len=char_len) :: group - character(len=7) :: logic - integer :: i,n, cat_ind - - ! (1) Lock data type (put calls will now cause MARBL to abort) - this%locked = .true. - group = '' - - do cat_ind = 1,size(this%categories) - do n=1,this%cnt - if (this%vars(n)%category_ind .eq. cat_ind) then - ! (2) Log the group name if different than previous parameter - if (this%vars(n)%group.ne.group) then - group = trim(this%vars(n)%group) - call marbl_status_log%log_header(trim(group), subname) - end if - - ! (3) write parameter to log_message (format depends on datatype) - select case(trim(this%vars(n)%datatype)) - case ('string') - write(log_message, "(4A)") trim(this%vars(n)%short_name), " = '", & - trim(this%vars(n)%sptr), "'" - case ('real') - write(log_message, "(2A,E24.16)") trim(this%vars(n)%short_name), & - " = ", this%vars(n)%rptr - case ('integer') - write(log_message, "(2A,I0)") trim(this%vars(n)%short_name), " = ", & - this%vars(n)%iptr - case ('logical') - if (this%vars(n)%lptr) then - logic = '.true.' - else - logic = '.false.' - end if - write(log_message, "(3A)") trim(this%vars(n)%short_name), " = ", & - trim(logic) - case DEFAULT - write(log_message, "(2A)") trim(this%vars(n)%datatype), & - ' is not a valid datatype for parameter' - call marbl_status_log%log_error(log_message, subname) - return - end select - - ! (4) Write log_message to the log - if (this%vars(n)%comment.ne.'') then - if (len_trim(log_message) + 3 + len_trim(this%vars(n)%comment) .le. len(log_message)) then - write(log_message, "(3A)") trim(log_message), ' ! ', & - trim(this%vars(n)%comment) - else - call marbl_status_log%log_noerror(& - '! WARNING: omitting comment on line below because including it exceeds max length for log message', & - subname) - end if - endif - call marbl_status_log%log_noerror(log_message, subname) - end if - end do - if (cat_ind .ne. size(this%categories)) then - call marbl_status_log%log_noerror('', subname) - end if - end do - - end subroutine marbl_vars_finalize - - !*********************************************************************** - - subroutine log_add_var_error(marbl_status_log, sname, subname) - - type(marbl_log_type), intent(inout) :: marbl_status_log - character(len=*), intent(in) :: sname - character(len=*), intent(in) :: subname - character(len=char_len) :: routine_name - - write(routine_name,"(3A)") "this%add_var(", trim(sname), ")" - call marbl_status_log%log_error_trace(routine_name, subname) - - end subroutine log_add_var_error - - !***************************************************************************** - - subroutine set_derived_config(marbl_status_log) - - type(marbl_log_type), intent(inout) :: marbl_status_log - - character(len=*), parameter :: subname = 'marbl_config_mod:set_derived_config' - character(len=char_len) :: log_message - - end subroutine set_derived_config - - !***************************************************************************** - - subroutine marbl_var_put_all_types(this, var, marbl_status_log, rval, ival, & - lval, sval) - - class(marbl_config_and_parms_type), intent(inout) :: this - character(len=*), intent(in) :: var - real(r8), optional, intent(in) :: rval - integer, optional, intent(in) :: ival - logical, optional, intent(in) :: lval - character(len=*), optional, intent(in) :: sval - type(marbl_log_type), intent(inout) :: marbl_status_log - - character(len=*), parameter :: subname = 'marbl_config_mod%marbl_var_put_all_types' - character(len=char_len) :: log_message - - integer :: varid - - if (this%locked) then - write(log_message, "(3A)") 'Can not change value of ', trim(var), & - ', parameters are locked!' - call marbl_status_log%log_error(log_message, subname) - return - end if - - varid = this%inquire_id(var, marbl_status_log) - if (marbl_status_log%labort_marbl) then - write(log_message, "(3A)") 'config_parms%put(', trim(var), ')' - call marbl_status_log%log_error_trace(log_message, subname) - return - end if - - select case(trim(this%vars(varid)%datatype)) - case ('real') - if (present(rval)) then - this%vars(varid)%rptr = rval - else - write(log_message, "(2A)") trim(var), ' requires real value' - call marbl_status_log%log_error(log_message, subname) - end if - case ('integer') - if (present(ival)) then - this%vars(varid)%iptr = ival - else - write(log_message, "(2A)") trim(var), ' requires integer value' - call marbl_status_log%log_error(log_message, subname) - end if - case ('logical') - if (present(lval)) then - this%vars(varid)%lptr = lval - else - write(log_message, "(2A)") trim(var), ' requires logical value' - call marbl_status_log%log_error(log_message, subname) - end if - case ('string') - if (present(sval)) then - this%vars(varid)%sptr = sval - else - write(log_message, "(2A)") trim(var), ' requires string value' - call marbl_status_log%log_error(log_message, subname) - end if - end select - - end subroutine marbl_var_put_all_types - - !***************************************************************************** - - subroutine marbl_var_get_all_types(this, var, marbl_status_log, rval, ival, & - lval, sval) - - class(marbl_config_and_parms_type), intent(inout) :: this - character(len=*), intent(in) :: var - real(r8), optional, intent(out) :: rval - integer, optional, intent(out) :: ival - logical, optional, intent(out) :: lval - character(len=*), optional, intent(out) :: sval - type(marbl_log_type), intent(inout) :: marbl_status_log - - character(len=*), parameter :: subname = 'marbl_config_mod%marbl_var_get_all_types' - character(len=char_len) :: log_message - - integer :: varid, cnt - - cnt = 0 - if (present(rval)) cnt = cnt + 1 - if (present(ival)) cnt = cnt + 1 - if (present(lval)) cnt = cnt + 1 - if (present(sval)) cnt = cnt + 1 - - if (cnt .eq. 0) then - write(log_message, "(A)") 'Must provide rval, ival, lval, or sval to var_get()' - call marbl_status_log%log_error(log_message, subname) - return - end if - - if (cnt .gt. 1) then - write(log_message, "(A)") 'Must provide just one of rval, ival, lval, or sval to var_get()' - call marbl_status_log%log_error(log_message, subname) - return - end if - - varid = this%inquire_id(var, marbl_status_log) - if (marbl_status_log%labort_marbl) then - write(log_message, "(3A)") 'config_parms%get(', trim(var), ')' - call marbl_status_log%log_error_trace(log_message, subname) - return - end if - - select case(trim(this%vars(varid)%datatype)) - case ('real') - if (present(rval)) then - rval = this%vars(varid)%rptr - else - write(log_message, "(2A)") trim(var), ' requires real value' - call marbl_status_log%log_error(log_message, subname) - end if - case ('integer') - if (present(ival)) then - ival = this%vars(varid)%iptr - else - write(log_message, "(2A)") trim(var), ' requires integer value' - call marbl_status_log%log_error(log_message, subname) - end if - case ('logical') - if (present(lval)) then - lval = this%vars(varid)%lptr - else - write(log_message, "(2A)") trim(var), ' requires logical value' - call marbl_status_log%log_error(log_message, subname) - end if - case ('string') - if (present(sval)) then - if (len(sval).lt.len(trim(this%vars(varid)%sptr))) then - write(log_message, "(2A,I0,A,I0,A)") trim(var), ' requires ', & - len(trim(this%vars(varid)%sptr)), ' bytes to store, but only ', & - len(sval), ' are provided.' - call marbl_status_log%log_error(log_message, subname) - return - end if - sval = trim(this%vars(varid)%sptr) - else - write(log_message, "(2A)") trim(var), ' requires string value' - call marbl_status_log%log_error(log_message, subname) - end if - end select - - end subroutine marbl_var_get_all_types - - !***************************************************************************** - - subroutine marbl_var_put_real(this, var, val, marbl_status_log) - - class(marbl_config_and_parms_type), intent(inout) :: this - character(len=*), intent(in) :: var - real(r8), intent(in) :: val - type(marbl_log_type), intent(inout) :: marbl_status_log - - call this%put_general(var, marbl_status_log, rval = val) - - end subroutine marbl_var_put_real - - !***************************************************************************** - - subroutine marbl_var_put_integer(this, var, val, marbl_status_log) - - class(marbl_config_and_parms_type), intent(inout) :: this - character(len=*), intent(in) :: var - integer, intent(in) :: val - type(marbl_log_type), intent(inout) :: marbl_status_log - - call this%put_general(var, marbl_status_log, ival=val, rval=real(val,r8)) - - end subroutine marbl_var_put_integer - - !***************************************************************************** - - subroutine marbl_var_put_string(this, var, val, marbl_status_log) - - class(marbl_config_and_parms_type), intent(inout) :: this - character(len=*), intent(in) :: var - character(len=*), intent(in) :: val - type(marbl_log_type), intent(inout) :: marbl_status_log - - call this%put_general(var, marbl_status_log, sval=val) - - end subroutine marbl_var_put_string - - !***************************************************************************** - - subroutine marbl_var_put_logical(this, var, val, marbl_status_log) - - class(marbl_config_and_parms_type), intent(inout) :: this - character(len=*), intent(in) :: var - logical, intent(in) :: val - type(marbl_log_type), intent(inout) :: marbl_status_log - - call this%put_general(var, marbl_status_log, lval=val) - - end subroutine marbl_var_put_logical - - !***************************************************************************** - - subroutine marbl_var_get_real(this, var, val, marbl_status_log) - - class(marbl_config_and_parms_type), intent(inout) :: this - character(len=*), intent(in) :: var - real(r8), intent(out) :: val - type(marbl_log_type), intent(inout) :: marbl_status_log - - call this%get_general(var, marbl_status_log, rval = val) - - end subroutine marbl_var_get_real - - !***************************************************************************** - - subroutine marbl_var_get_integer(this, var, val, marbl_status_log) - - class(marbl_config_and_parms_type), intent(inout) :: this - character(len=*), intent(in) :: var - integer, intent(out) :: val - type(marbl_log_type), intent(inout) :: marbl_status_log - - call this%get_general(var, marbl_status_log, ival=val) - - end subroutine marbl_var_get_integer - - !***************************************************************************** - - subroutine marbl_var_get_string(this, var, val, marbl_status_log) - - class(marbl_config_and_parms_type), intent(inout) :: this - character(len=*), intent(in) :: var - character(len=*), intent(out) :: val - type(marbl_log_type), intent(inout) :: marbl_status_log - - call this%get_general(var, marbl_status_log, sval=val) - - end subroutine marbl_var_get_string - - !***************************************************************************** - - subroutine marbl_var_get_logical(this, var, val, marbl_status_log) - - class(marbl_config_and_parms_type), intent(inout) :: this - character(len=*), intent(in) :: var - logical, intent(out) :: val - type(marbl_log_type), intent(inout) :: marbl_status_log - - call this%get_general(var, marbl_status_log, lval=val) - - end subroutine marbl_var_get_logical - - !***************************************************************************** - - function marbl_var_inquire_id(this, var, marbl_status_log) result(id) - - class(marbl_config_and_parms_type), intent(inout) :: this - character(len=*), intent(in) :: var - type(marbl_log_type), intent(inout) :: marbl_status_log - integer :: id - - character(len=*), parameter :: subname = 'marbl_config_mod:marbl_var_inquire_id' - character(len=char_len) :: log_message - - integer :: n - - id = 0 - do n=1,this%cnt - if (trim(var).eq.trim(this%vars(n)%short_name)) then - id = n - return - end if - end do - write(log_message, "(2A)") trim(var), ' is not a known variable name for put' - call marbl_status_log%log_error(log_message, subname) - - end function marbl_var_inquire_id - - !***************************************************************************** - - subroutine marbl_var_inquire_metadata(this, ind, marbl_status_log, lname, & - sname, units, group, datatype) - - class(marbl_config_and_parms_type), intent(inout) :: this - integer, intent(in) :: ind - type(marbl_log_type), intent(inout) :: marbl_status_log - character(len=*), optional, intent(out) :: lname, sname, units - character(len=*), optional, intent(out) :: group, datatype - - character(len=*), parameter :: subname = 'marbl_config_mod:marbl_var_inquire_metadata' - character(len=char_len) :: log_message - - if ((ind .lt. 1).or.(ind .gt. this%cnt)) then - write(log_message,'(I0,2A,I0)') ind, ' is not a valid index: must be ', & - 'between 1 and ', this%cnt - call marbl_status_log%log_error(log_message, subname) - return - end if - - if (present(lname)) then - lname = this%vars(ind)%long_name - end if - - if (present(sname)) then - sname = this%vars(ind)%short_name - end if - - if (present(units)) then - units = this%vars(ind)%units - end if - - if (present(group)) then - group = this%vars(ind)%group - end if - - if (present(datatype)) then - datatype = this%vars(ind)%datatype - end if - - end subroutine marbl_var_inquire_metadata - - !***************************************************************************** - -end module marbl_config_mod diff --git a/src/marbl_diagnostics_mod.F90 b/src/marbl_diagnostics_mod.F90 index 4aaf5383..1650d94a 100644 --- a/src/marbl_diagnostics_mod.F90 +++ b/src/marbl_diagnostics_mod.F90 @@ -3,42 +3,39 @@ module marbl_diagnostics_mod - use marbl_kinds_mod , only : r8 - use marbl_kinds_mod , only : int_kind - use marbl_kinds_mod , only : log_kind - use marbl_kinds_mod , only : char_len - - use marbl_sizes , only : marbl_total_tracer_cnt - use marbl_sizes , only : autotroph_cnt - use marbl_sizes , only : zooplankton_cnt - - use marbl_config_mod, only : autotrophs_config - use marbl_config_mod, only : zooplankton_config - - use marbl_parms, only : autotrophs - - use marbl_constants_mod , only : c0 - use marbl_constants_mod , only : c1 - - use marbl_internal_types , only : carbonate_type - use marbl_internal_types , only : zooplankton_secondary_species_type - use marbl_internal_types , only : autotroph_secondary_species_type - use marbl_internal_types , only : dissolved_organic_matter_type - use marbl_internal_types , only : column_sinking_particle_type - use marbl_internal_types , only : marbl_PAR_type - use marbl_internal_types , only : marbl_particulate_share_type - use marbl_internal_types , only : marbl_interior_share_type - use marbl_internal_types , only : marbl_autotroph_share_type - use marbl_internal_types , only : marbl_zooplankton_share_type - use marbl_internal_types , only : marbl_surface_forcing_share_type - use marbl_internal_types , only : marbl_surface_forcing_internal_type - use marbl_internal_types , only : marbl_tracer_index_type - - use marbl_interface_types , only : marbl_domain_type - use marbl_interface_types , only : marbl_tracer_metadata_type - use marbl_interface_types , only : marbl_forcing_fields_type - use marbl_interface_types , only : marbl_saved_state_type - use marbl_interface_types , only : marbl_diagnostics_type + use marbl_kinds_mod, only : r8 + use marbl_kinds_mod, only : int_kind + use marbl_kinds_mod, only : log_kind + use marbl_kinds_mod, only : char_len + + use marbl_settings_mod, only : autotroph_cnt + use marbl_settings_mod, only : zooplankton_cnt + use marbl_settings_mod, only : autotrophs + use marbl_settings_mod, only : zooplankton + + use marbl_constants_mod, only : c0 + use marbl_constants_mod, only : c1 + + use marbl_interface_private_types, only : carbonate_type + use marbl_interface_private_types, only : dissolved_organic_matter_type + use marbl_interface_private_types, only : column_sinking_particle_type + use marbl_interface_private_types, only : marbl_PAR_type + use marbl_interface_private_types, only : marbl_particulate_share_type + use marbl_interface_private_types, only : marbl_interior_share_type + use marbl_interface_private_types, only : marbl_surface_forcing_share_type + use marbl_interface_private_types, only : marbl_surface_forcing_internal_type + use marbl_interface_private_types, only : marbl_tracer_index_type + + use marbl_interface_public_types, only : marbl_domain_type + use marbl_interface_public_types, only : marbl_tracer_metadata_type + use marbl_interface_public_types, only : marbl_forcing_fields_type + use marbl_interface_public_types, only : marbl_saved_state_type + use marbl_interface_public_types, only : marbl_diagnostics_type + + use marbl_pft_mod, only : marbl_autotroph_share_type + use marbl_pft_mod, only : marbl_zooplankton_share_type + use marbl_pft_mod, only : autotroph_secondary_species_type + use marbl_pft_mod, only : zooplankton_secondary_species_type use marbl_logging, only : marbl_log_type @@ -69,7 +66,6 @@ module marbl_diagnostics_mod private :: store_diagnostics_silicon_fluxes private :: store_diagnostics_iron_fluxes private :: compute_saturation_depth - private :: linear_root !----------------------------------------------------------------------- ! Largest possible size for each class of diagnostics @@ -111,9 +107,9 @@ module marbl_diagnostics_mod integer(int_kind) :: pfeToSed ! Autotroph 2D diags - integer(int_kind), dimension(autotroph_cnt) :: photoC_zint - integer(int_kind), dimension(autotroph_cnt) :: photoC_NO3_zint - integer(int_kind), dimension(autotroph_cnt) :: CaCO3_form_zint + integer(int_kind), allocatable :: photoC_zint(:) + integer(int_kind), allocatable :: photoC_NO3_zint(:) + integer(int_kind), allocatable :: CaCO3_form_zint(:) integer(int_kind) :: tot_CaCO3_form_zint ! General 3D diags @@ -180,43 +176,43 @@ module marbl_diagnostics_mod integer(int_kind) :: P_iron_REMIN ! Autotroph 3D diags - integer(int_kind), dimension(autotroph_cnt) :: Qp - integer(int_kind), dimension(autotroph_cnt) :: N_lim - integer(int_kind), dimension(autotroph_cnt) :: P_lim - integer(int_kind), dimension(autotroph_cnt) :: Fe_lim - integer(int_kind), dimension(autotroph_cnt) :: SiO3_lim - integer(int_kind), dimension(autotroph_cnt) :: light_lim - integer(int_kind), dimension(autotroph_cnt) :: photoC - integer(int_kind), dimension(autotroph_cnt) :: photoC_NO3 - integer(int_kind), dimension(autotroph_cnt) :: photoFe - integer(int_kind), dimension(autotroph_cnt) :: photoNO3 - integer(int_kind), dimension(autotroph_cnt) :: photoNH4 - integer(int_kind), dimension(autotroph_cnt) :: DOP_uptake - integer(int_kind), dimension(autotroph_cnt) :: PO4_uptake - integer(int_kind), dimension(autotroph_cnt) :: auto_graze - integer(int_kind), dimension(autotroph_cnt) :: auto_graze_poc - integer(int_kind), dimension(autotroph_cnt) :: auto_graze_doc - integer(int_kind), dimension(autotroph_cnt) :: auto_graze_zoo - integer(int_kind), dimension(autotroph_cnt) :: auto_loss - integer(int_kind), dimension(autotroph_cnt) :: auto_loss_poc - integer(int_kind), dimension(autotroph_cnt) :: auto_loss_doc - integer(int_kind), dimension(autotroph_cnt) :: auto_agg - integer(int_kind), dimension(autotroph_cnt) :: bSi_form - integer(int_kind), dimension(autotroph_cnt) :: CaCO3_form - integer(int_kind), dimension(autotroph_cnt) :: Nfix + integer(int_kind), allocatable :: Qp(:) + integer(int_kind), allocatable :: N_lim(:) + integer(int_kind), allocatable :: P_lim(:) + integer(int_kind), allocatable :: Fe_lim(:) + integer(int_kind), allocatable :: SiO3_lim(:) + integer(int_kind), allocatable :: light_lim(:) + integer(int_kind), allocatable :: photoC(:) + integer(int_kind), allocatable :: photoC_NO3(:) + integer(int_kind), allocatable :: photoFe(:) + integer(int_kind), allocatable :: photoNO3(:) + integer(int_kind), allocatable :: photoNH4(:) + integer(int_kind), allocatable :: DOP_uptake(:) + integer(int_kind), allocatable :: PO4_uptake(:) + integer(int_kind), allocatable :: auto_graze(:) + integer(int_kind), allocatable :: auto_graze_poc(:) + integer(int_kind), allocatable :: auto_graze_doc(:) + integer(int_kind), allocatable :: auto_graze_zoo(:) + integer(int_kind), allocatable :: auto_loss(:) + integer(int_kind), allocatable :: auto_loss_poc(:) + integer(int_kind), allocatable :: auto_loss_doc(:) + integer(int_kind), allocatable :: auto_agg(:) + integer(int_kind), allocatable :: bSi_form(:) + integer(int_kind), allocatable :: CaCO3_form(:) + integer(int_kind), allocatable :: Nfix(:) integer(int_kind) :: tot_bSi_form integer(int_kind) :: tot_CaCO3_form integer(int_kind) :: tot_Nfix ! zooplankton 3D diags - integer(int_kind), dimension(zooplankton_cnt) :: zoo_loss - integer(int_kind), dimension(zooplankton_cnt) :: zoo_loss_poc - integer(int_kind), dimension(zooplankton_cnt) :: zoo_loss_doc - integer(int_kind), dimension(zooplankton_cnt) :: zoo_graze - integer(int_kind), dimension(zooplankton_cnt) :: zoo_graze_poc - integer(int_kind), dimension(zooplankton_cnt) :: zoo_graze_doc - integer(int_kind), dimension(zooplankton_cnt) :: zoo_graze_zoo - integer(int_kind), dimension(zooplankton_cnt) :: x_graze_zoo + integer(int_kind), allocatable :: zoo_loss(:) + integer(int_kind), allocatable :: zoo_loss_poc(:) + integer(int_kind), allocatable :: zoo_loss_doc(:) + integer(int_kind), allocatable :: zoo_graze(:) + integer(int_kind), allocatable :: zoo_graze_poc(:) + integer(int_kind), allocatable :: zoo_graze_doc(:) + integer(int_kind), allocatable :: zoo_graze_zoo(:) + integer(int_kind), allocatable :: x_graze_zoo(:) ! ciso ids for nonstandard 3d fields integer (int_kind) :: CISO_PO13C_FLUX_IN ! po13c flux into cell @@ -237,20 +233,20 @@ module marbl_diagnostics_mod integer (int_kind) :: CISO_photo14C_TOT_zint ! total 14C fixation vertical integral ! ciso ids for MORE nonstandard 3d fields - integer (int_kind), dimension(autotroph_cnt) :: CISO_eps_autotroph ! epsilon for each autotroph - integer (int_kind), dimension(autotroph_cnt) :: CISO_mui_to_co2star ! mui_to_co2star for each autotroph - integer (int_kind), dimension(autotroph_cnt) :: CISO_Ca13CO3_form ! Ca13CO3 formation - integer (int_kind), dimension(autotroph_cnt) :: CISO_Ca14CO3_form ! Ca14CO3 formation - integer (int_kind), dimension(autotroph_cnt) :: CISO_Ca13CO3_form_zint ! Ca13CO3 formation vertical integral 0-100 m - integer (int_kind), dimension(autotroph_cnt) :: CISO_Ca14CO3_form_zint ! Ca14CO3 formation vertical integral 0-100 m - integer (int_kind), dimension(autotroph_cnt) :: CISO_photo13C ! 13C fixation - integer (int_kind), dimension(autotroph_cnt) :: CISO_photo14C ! 14C fixation - integer (int_kind), dimension(autotroph_cnt) :: CISO_photo13C_zint ! 13C fixation vertical integral - integer (int_kind), dimension(autotroph_cnt) :: CISO_photo14C_zint ! 14C fixation vertical integral - integer (int_kind), dimension(autotroph_cnt) :: CISO_d13C ! if for d13C of autotroph carbon - integer (int_kind), dimension(autotroph_cnt) :: CISO_d14C ! if for d14C of autotroph carbon - integer (int_kind), dimension(autotroph_cnt) :: CISO_autotrophCaCO3_d14C ! if for d14C of autotrophCaCO3 - integer (int_kind), dimension(autotroph_cnt) :: CISO_autotrophCaCO3_d13C ! if for d13C of autotrophCaCO3 + integer (int_kind), allocatable :: CISO_eps_autotroph(:) ! epsilon for each autotroph + integer (int_kind), allocatable :: CISO_mui_to_co2star(:) ! mui_to_co2star for each autotroph + integer (int_kind), allocatable :: CISO_Ca13CO3_form(:) ! Ca13CO3 formation + integer (int_kind), allocatable :: CISO_Ca14CO3_form(:) ! Ca14CO3 formation + integer (int_kind), allocatable :: CISO_Ca13CO3_form_zint(:) ! Ca13CO3 formation vertical integral 0-100 m + integer (int_kind), allocatable :: CISO_Ca14CO3_form_zint(:) ! Ca14CO3 formation vertical integral 0-100 m + integer (int_kind), allocatable :: CISO_photo13C(:) ! 13C fixation + integer (int_kind), allocatable :: CISO_photo14C(:) ! 14C fixation + integer (int_kind), allocatable :: CISO_photo13C_zint(:) ! 13C fixation vertical integral + integer (int_kind), allocatable :: CISO_photo14C_zint(:) ! 14C fixation vertical integral + integer (int_kind), allocatable :: CISO_d13C(:) ! if for d13C of autotroph carbon + integer (int_kind), allocatable :: CISO_d14C(:) ! if for d14C of autotroph carbon + integer (int_kind), allocatable :: CISO_autotrophCaCO3_d14C(:) ! if for d14C of autotrophCaCO3 + integer (int_kind), allocatable :: CISO_autotrophCaCO3_d13C(:) ! if for d13C of autotrophCaCO3 integer (int_kind) :: CISO_eps_aq_g ! eps_aq_g integer (int_kind) :: CISO_eps_dic_g ! eps_dic_g @@ -275,7 +271,9 @@ module marbl_diagnostics_mod ! restoring 3D diags integer(int_kind), dimension(:), allocatable :: restore_tend - + contains + procedure, public :: lconstructed => interior_diag_ind_constructed + procedure, public :: destruct => interior_diag_ind_destructor end type marbl_interior_diagnostics_indexing_type type(marbl_interior_diagnostics_indexing_type), public :: marbl_interior_diag_ind @@ -344,7 +342,7 @@ subroutine marbl_diagnostics_init( & marbl_surface_forcing_diags, & marbl_status_log) - use marbl_config_mod, only : ciso_on + use marbl_settings_mod, only : ciso_on type(marbl_domain_type) , intent(in) :: marbl_domain type(marbl_tracer_metadata_type) , intent(in) :: marbl_tracer_metadata(:) ! descriptors for each tracer @@ -1242,9 +1240,14 @@ subroutine marbl_diagnostics_init( & end if ! Autotroph 2D diags + if (.not.ind%lconstructed()) then + allocate(ind%photoC_zint(autotroph_cnt)) + allocate(ind%photoC_NO3_zint(autotroph_cnt)) + allocate(ind%CaCO3_form_zint(autotroph_cnt)) + end if do n=1,autotroph_cnt - lname = trim(autotrophs_config(n)%lname) // ' C Fixation Vertical Integral' - sname = 'photoC_' // trim(autotrophs_config(n)%sname) // '_zint' + lname = trim(autotrophs(n)%lname) // ' C Fixation Vertical Integral' + sname = 'photoC_' // trim(autotrophs(n)%sname) // '_zint' units = 'mmol/m^3 cm/s' vgrid = 'none' truncate = .false. @@ -1255,8 +1258,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' C Fixation from NO3 Vertical Integral' - sname = 'photoC_NO3_' // trim(autotrophs_config(n)%sname) // '_zint' + lname = trim(autotrophs(n)%lname) // ' C Fixation from NO3 Vertical Integral' + sname = 'photoC_NO3_' // trim(autotrophs(n)%sname) // '_zint' units = 'mmol/m^3 cm/s' vgrid = 'none' truncate = .false. @@ -1267,10 +1270,10 @@ subroutine marbl_diagnostics_init( & return end if - if (autotrophs_config(n)%imp_calcifier .or. & - autotrophs_config(n)%exp_calcifier) then - lname = trim(autotrophs_config(n)%lname) // ' CaCO3 Formation Vertical Integral' - sname = trim(autotrophs_config(n)%sname) // '_CaCO3_form_zint' + if (autotrophs(n)%imp_calcifier .or. & + autotrophs(n)%exp_calcifier) then + lname = trim(autotrophs(n)%lname) // ' CaCO3 Formation Vertical Integral' + sname = trim(autotrophs(n)%sname) // '_CaCO3_form_zint' units = 'mmol/m^3 cm/s' vgrid = 'none' truncate = .false. @@ -2008,9 +2011,35 @@ subroutine marbl_diagnostics_init( & end if ! Autotroph 3D diags + if (.not.ind%lconstructed()) then + allocate(ind%Qp(autotroph_cnt)) + allocate(ind%N_lim(autotroph_cnt)) + allocate(ind%P_lim(autotroph_cnt)) + allocate(ind%Fe_lim(autotroph_cnt)) + allocate(ind%SiO3_lim(autotroph_cnt)) + allocate(ind%light_lim(autotroph_cnt)) + allocate(ind%photoC(autotroph_cnt)) + allocate(ind%photoC_NO3(autotroph_cnt)) + allocate(ind%photoFe(autotroph_cnt)) + allocate(ind%photoNO3(autotroph_cnt)) + allocate(ind%photoNH4(autotroph_cnt)) + allocate(ind%DOP_uptake(autotroph_cnt)) + allocate(ind%PO4_uptake(autotroph_cnt)) + allocate(ind%auto_graze(autotroph_cnt)) + allocate(ind%auto_graze_poc(autotroph_cnt)) + allocate(ind%auto_graze_doc(autotroph_cnt)) + allocate(ind%auto_graze_zoo(autotroph_cnt)) + allocate(ind%auto_loss(autotroph_cnt)) + allocate(ind%auto_loss_poc(autotroph_cnt)) + allocate(ind%auto_loss_doc(autotroph_cnt)) + allocate(ind%auto_agg(autotroph_cnt)) + allocate(ind%bSi_form(autotroph_cnt)) + allocate(ind%CaCO3_form(autotroph_cnt)) + allocate(ind%Nfix(autotroph_cnt)) + end if do n= 1,autotroph_cnt - lname = trim(autotrophs_config(n)%lname) // ' P:C ratio' - sname = trim(autotrophs_config(n)%sname) // '_Qp' + lname = trim(autotrophs(n)%lname) // ' P:C ratio' + sname = trim(autotrophs(n)%sname) // '_Qp' units = 'none' vgrid = 'layer_avg' truncate = .true. @@ -2021,8 +2050,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' N Limitation' - sname = trim(autotrophs_config(n)%sname) // '_N_lim' + lname = trim(autotrophs(n)%lname) // ' N Limitation' + sname = trim(autotrophs(n)%sname) // '_N_lim' units = 'none' vgrid = 'layer_avg' truncate = .true. @@ -2033,8 +2062,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' P Limitation' - sname = trim(autotrophs_config(n)%sname) // '_P_lim' + lname = trim(autotrophs(n)%lname) // ' P Limitation' + sname = trim(autotrophs(n)%sname) // '_P_lim' units = 'none' vgrid = 'layer_avg' truncate = .true. @@ -2045,8 +2074,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' Fe Limitation' - sname = trim(autotrophs_config(n)%sname) // '_Fe_lim' + lname = trim(autotrophs(n)%lname) // ' Fe Limitation' + sname = trim(autotrophs(n)%sname) // '_Fe_lim' units = 'none' vgrid = 'layer_avg' truncate = .true. @@ -2057,9 +2086,9 @@ subroutine marbl_diagnostics_init( & return end if - if (autotrophs_config(n)%silicifier) then - lname = trim(autotrophs_config(n)%lname) // ' SiO3 Limitation' - sname = trim(autotrophs_config(n)%sname) // '_SiO3_lim' + if (autotrophs(n)%silicifier) then + lname = trim(autotrophs(n)%lname) // ' SiO3 Limitation' + sname = trim(autotrophs(n)%sname) // '_SiO3_lim' units = 'none' vgrid = 'layer_avg' truncate = .true. @@ -2073,8 +2102,8 @@ subroutine marbl_diagnostics_init( & ind%SiO3_lim(n) = -1 end if - lname = trim(autotrophs_config(n)%lname) // ' Light Limitation' - sname = trim(autotrophs_config(n)%sname) // '_light_lim' + lname = trim(autotrophs(n)%lname) // ' Light Limitation' + sname = trim(autotrophs(n)%sname) // '_light_lim' units = 'none' vgrid = 'layer_avg' truncate = .true. @@ -2085,8 +2114,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' C Fixation' - sname = 'photoC_' // trim(autotrophs_config(n)%sname) + lname = trim(autotrophs(n)%lname) // ' C Fixation' + sname = 'photoC_' // trim(autotrophs(n)%sname) units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2097,8 +2126,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' C Fixation from NO3' - sname = 'photoC_NO3_' // trim(autotrophs_config(n)%sname) + lname = trim(autotrophs(n)%lname) // ' C Fixation from NO3' + sname = 'photoC_NO3_' // trim(autotrophs(n)%sname) units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2109,8 +2138,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' Fe Uptake' - sname = 'photoFe_' // trim(autotrophs_config(n)%sname) + lname = trim(autotrophs(n)%lname) // ' Fe Uptake' + sname = 'photoFe_' // trim(autotrophs(n)%sname) units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2121,8 +2150,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' NO3 Uptake' - sname = 'photoNO3_' // trim(autotrophs_config(n)%sname) + lname = trim(autotrophs(n)%lname) // ' NO3 Uptake' + sname = 'photoNO3_' // trim(autotrophs(n)%sname) units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2133,8 +2162,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' NH4 Uptake' - sname = 'photoNH4_' // trim(autotrophs_config(n)%sname) + lname = trim(autotrophs(n)%lname) // ' NH4 Uptake' + sname = 'photoNH4_' // trim(autotrophs(n)%sname) units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2145,8 +2174,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' DOP Uptake' - sname = 'DOP_' // trim(autotrophs_config(n)%sname) // '_uptake' + lname = trim(autotrophs(n)%lname) // ' DOP Uptake' + sname = 'DOP_' // trim(autotrophs(n)%sname) // '_uptake' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2157,8 +2186,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' PO4 Uptake' - sname = 'PO4_' // trim(autotrophs_config(n)%sname) // '_uptake' + lname = trim(autotrophs(n)%lname) // ' PO4 Uptake' + sname = 'PO4_' // trim(autotrophs(n)%sname) // '_uptake' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2169,8 +2198,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' Grazing' - sname = 'graze_' // trim(autotrophs_config(n)%sname) + lname = trim(autotrophs(n)%lname) // ' Grazing' + sname = 'graze_' // trim(autotrophs(n)%sname) units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2181,8 +2210,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' Grazing to POC' - sname = 'graze_' // trim(autotrophs_config(n)%sname) // '_poc' + lname = trim(autotrophs(n)%lname) // ' Grazing to POC' + sname = 'graze_' // trim(autotrophs(n)%sname) // '_poc' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2193,8 +2222,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' Grazing to DOC' - sname = 'graze_' // trim(autotrophs_config(n)%sname) // '_doc' + lname = trim(autotrophs(n)%lname) // ' Grazing to DOC' + sname = 'graze_' // trim(autotrophs(n)%sname) // '_doc' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2205,8 +2234,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' Grazing to ZOO' - sname = 'graze_' // trim(autotrophs_config(n)%sname) // '_zoo' + lname = trim(autotrophs(n)%lname) // ' Grazing to ZOO' + sname = 'graze_' // trim(autotrophs(n)%sname) // '_zoo' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2217,8 +2246,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' Loss' - sname = trim(autotrophs_config(n)%sname) // '_loss' + lname = trim(autotrophs(n)%lname) // ' Loss' + sname = trim(autotrophs(n)%sname) // '_loss' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2229,8 +2258,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' Loss to POC' - sname = trim(autotrophs_config(n)%sname) // '_loss_poc' + lname = trim(autotrophs(n)%lname) // ' Loss to POC' + sname = trim(autotrophs(n)%sname) // '_loss_poc' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2241,8 +2270,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' Loss to DOC' - sname = trim(autotrophs_config(n)%sname) // '_loss_doc' + lname = trim(autotrophs(n)%lname) // ' Loss to DOC' + sname = trim(autotrophs(n)%sname) // '_loss_doc' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2253,8 +2282,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' Aggregate' - sname = trim(autotrophs_config(n)%sname) // '_agg' + lname = trim(autotrophs(n)%lname) // ' Aggregate' + sname = trim(autotrophs(n)%sname) // '_agg' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2265,9 +2294,9 @@ subroutine marbl_diagnostics_init( & return end if - if (autotrophs_config(n)%silicifier) then - lname = trim(autotrophs_config(n)%lname) // ' Si Uptake' - sname = trim(autotrophs_config(n)%sname) // '_bSi_form' + if (autotrophs(n)%silicifier) then + lname = trim(autotrophs(n)%lname) // ' Si Uptake' + sname = trim(autotrophs(n)%sname) // '_bSi_form' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2281,10 +2310,10 @@ subroutine marbl_diagnostics_init( & ind%bSi_form(n) = -1 end if - if (autotrophs_config(n)%imp_calcifier .or. & - autotrophs_config(n)%exp_calcifier) then - lname = trim(autotrophs_config(n)%lname) // ' CaCO3 Formation' - sname = trim(autotrophs_config(n)%sname) // '_CaCO3_form' + if (autotrophs(n)%imp_calcifier .or. & + autotrophs(n)%exp_calcifier) then + lname = trim(autotrophs(n)%lname) // ' CaCO3 Formation' + sname = trim(autotrophs(n)%sname) // '_CaCO3_form' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2298,9 +2327,9 @@ subroutine marbl_diagnostics_init( & ind%CaCO3_form(n) = -1 end if - if (autotrophs_config(n)%Nfixer) then - lname = trim(autotrophs_config(n)%lname) // ' N Fixation' - sname = trim(autotrophs_config(n)%sname) // '_Nfix' + if (autotrophs(n)%Nfixer) then + lname = trim(autotrophs(n)%lname) // ' N Fixation' + sname = trim(autotrophs(n)%sname) // '_Nfix' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2314,7 +2343,7 @@ subroutine marbl_diagnostics_init( & ind%Nfix(n) = -1 end if - end do ! end do-loop for atutroph_cnt + end do ! end do-loop for autotroph_cnt lname = 'Total Si Uptake' sname = 'bSi_form' @@ -2353,9 +2382,19 @@ subroutine marbl_diagnostics_init( & end if ! Zooplankton 3D diags + if (.not.ind%lconstructed()) then + allocate(ind%zoo_loss(zooplankton_cnt)) + allocate(ind%zoo_loss_poc(zooplankton_cnt)) + allocate(ind%zoo_loss_doc(zooplankton_cnt)) + allocate(ind%zoo_graze(zooplankton_cnt)) + allocate(ind%zoo_graze_poc(zooplankton_cnt)) + allocate(ind%zoo_graze_doc(zooplankton_cnt)) + allocate(ind%zoo_graze_zoo(zooplankton_cnt)) + allocate(ind%x_graze_zoo(zooplankton_cnt)) + end if do n = 1,zooplankton_cnt - lname = trim(zooplankton_config(n)%lname) // ' Loss' - sname = trim(zooplankton_config(n)%sname) // '_loss' + lname = trim(zooplankton(n)%lname) // ' Loss' + sname = trim(zooplankton(n)%sname) // '_loss' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2366,8 +2405,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(zooplankton_config(n)%lname) // ' Loss to POC' - sname = trim(zooplankton_config(n)%sname) // '_loss_poc' + lname = trim(zooplankton(n)%lname) // ' Loss to POC' + sname = trim(zooplankton(n)%sname) // '_loss_poc' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2378,8 +2417,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(zooplankton_config(n)%lname) // ' Loss to DOC' - sname = trim(zooplankton_config(n)%sname) // '_loss_doc' + lname = trim(zooplankton(n)%lname) // ' Loss to DOC' + sname = trim(zooplankton(n)%sname) // '_loss_doc' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2390,8 +2429,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(zooplankton_config(n)%lname) // ' grazing loss' - sname = 'graze_' // trim(zooplankton_config(n)%sname) + lname = trim(zooplankton(n)%lname) // ' grazing loss' + sname = 'graze_' // trim(zooplankton(n)%sname) units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2402,8 +2441,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(zooplankton_config(n)%lname) // ' grazing loss to POC' - sname = 'graze_' // trim(zooplankton_config(n)%sname) // '_poc' + lname = trim(zooplankton(n)%lname) // ' grazing loss to POC' + sname = 'graze_' // trim(zooplankton(n)%sname) // '_poc' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2414,8 +2453,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(zooplankton_config(n)%lname) // ' grazing loss to DOC' - sname = 'graze_' // trim(zooplankton_config(n)%sname) // '_doc' + lname = trim(zooplankton(n)%lname) // ' grazing loss to DOC' + sname = 'graze_' // trim(zooplankton(n)%sname) // '_doc' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2426,8 +2465,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(zooplankton_config(n)%lname) // ' grazing loss to ZOO' - sname = 'graze_' // trim(zooplankton_config(n)%sname) // '_zoo' + lname = trim(zooplankton(n)%lname) // ' grazing loss to ZOO' + sname = 'graze_' // trim(zooplankton(n)%sname) // '_zoo' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2438,8 +2477,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(zooplankton_config(n)%lname) // ' grazing gain' - sname = 'x_graze_' // trim(zooplankton_config(n)%sname) + lname = trim(zooplankton(n)%lname) // ' grazing gain' + sname = 'x_graze_' // trim(zooplankton(n)%sname) units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2818,10 +2857,25 @@ subroutine marbl_diagnostics_init( & end if ! Nonstandard autotroph 2D and 3D fields for each autotroph - + if (.not.ind%lconstructed()) then + allocate(ind%CISO_eps_autotroph(autotroph_cnt)) + allocate(ind%CISO_mui_to_co2star(autotroph_cnt)) + allocate(ind%CISO_Ca13CO3_form(autotroph_cnt)) + allocate(ind%CISO_Ca14CO3_form(autotroph_cnt)) + allocate(ind%CISO_Ca13CO3_form_zint(autotroph_cnt)) + allocate(ind%CISO_Ca14CO3_form_zint(autotroph_cnt)) + allocate(ind%CISO_photo13C(autotroph_cnt)) + allocate(ind%CISO_photo14C(autotroph_cnt)) + allocate(ind%CISO_photo13C_zint(autotroph_cnt)) + allocate(ind%CISO_photo14C_zint(autotroph_cnt)) + allocate(ind%CISO_d13C(autotroph_cnt)) + allocate(ind%CISO_d14C(autotroph_cnt)) + allocate(ind%CISO_autotrophCaCO3_d13C(autotroph_cnt)) + allocate(ind%CISO_autotrophCaCO3_d14C(autotroph_cnt)) + end if do n = 1, autotroph_cnt - lname = trim(autotrophs_config(n)%lname) // ' Ca13CO3 Formation' - sname = 'CISO_' // trim(autotrophs_config(n)%sname) // '_Ca13CO3_form' + lname = trim(autotrophs(n)%lname) // ' Ca13CO3 Formation' + sname = 'CISO_' // trim(autotrophs(n)%sname) // '_Ca13CO3_form' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2832,8 +2886,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' Ca13CO3 Formation Vertical Integral' - sname = 'CISO_' // trim(autotrophs_config(n)%sname) // '_Ca13CO3_form_zint' + lname = trim(autotrophs(n)%lname) // ' Ca13CO3 Formation Vertical Integral' + sname = 'CISO_' // trim(autotrophs(n)%sname) // '_Ca13CO3_form_zint' units = 'mmol/m^3 cm/s' vgrid = 'none' truncate = .false. @@ -2844,8 +2898,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' Ca14CO3 Formation' - sname = 'CISO_' // trim(autotrophs_config(n)%sname) // '_Ca14CO3_form' + lname = trim(autotrophs(n)%lname) // ' Ca14CO3 Formation' + sname = 'CISO_' // trim(autotrophs(n)%sname) // '_Ca14CO3_form' units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2856,8 +2910,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' Ca14CO3 Formation Vertical Integral' - sname = 'CISO_' // trim(autotrophs_config(n)%sname) // '_Ca14CO3_form_zint' + lname = trim(autotrophs(n)%lname) // ' Ca14CO3 Formation Vertical Integral' + sname = 'CISO_' // trim(autotrophs(n)%sname) // '_Ca14CO3_form_zint' units = 'mmol/m^3 cm/s' vgrid = 'none' truncate = .false. @@ -2868,8 +2922,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' d13C of CaCO3' - sname = 'CISO_autotrophCaCO3_d13C_' // trim(autotrophs_config(n)%sname) + lname = trim(autotrophs(n)%lname) // ' d13C of CaCO3' + sname = 'CISO_autotrophCaCO3_d13C_' // trim(autotrophs(n)%sname) units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .false. @@ -2880,8 +2934,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' d14C of CaCO3' - sname = 'CISO_autotrophCaCO3_d14C_' // trim(autotrophs_config(n)%sname) + lname = trim(autotrophs(n)%lname) // ' d14C of CaCO3' + sname = 'CISO_autotrophCaCO3_d14C_' // trim(autotrophs(n)%sname) units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .false. @@ -2892,8 +2946,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' 13C Fixation' - sname = 'CISO_photo13C_' // trim(autotrophs_config(n)%sname) + lname = trim(autotrophs(n)%lname) // ' 13C Fixation' + sname = 'CISO_photo13C_' // trim(autotrophs(n)%sname) units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2904,8 +2958,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' 14C Fixation' - sname = 'CISO_photo14C_' // trim(autotrophs_config(n)%sname) + lname = trim(autotrophs(n)%lname) // ' 14C Fixation' + sname = 'CISO_photo14C_' // trim(autotrophs(n)%sname) units = 'mmol/m^3/s' vgrid = 'layer_avg' truncate = .true. @@ -2916,8 +2970,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' 13C Fixation Vertical Integral' - sname = 'CISO_photo13C_' // trim(autotrophs_config(n)%sname) // '_zint' + lname = trim(autotrophs(n)%lname) // ' 13C Fixation Vertical Integral' + sname = 'CISO_photo13C_' // trim(autotrophs(n)%sname) // '_zint' units = 'mmol/m^3 cm/s' vgrid = 'none' truncate = .false. @@ -2928,8 +2982,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' 14C Fixation Vertical Integral' - sname = 'CISO_photo14C_' // trim(autotrophs_config(n)%sname) // '_zint' + lname = trim(autotrophs(n)%lname) // ' 14C Fixation Vertical Integral' + sname = 'CISO_photo14C_' // trim(autotrophs(n)%sname) // '_zint' units = 'mmol/m^3 cm/s' vgrid = 'none' truncate = .false. @@ -2940,8 +2994,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' discrimination factor (eps)' - sname = 'CISO_eps_autotroph_' // trim(autotrophs_config(n)%sname) + lname = trim(autotrophs(n)%lname) // ' discrimination factor (eps)' + sname = 'CISO_eps_autotroph_' // trim(autotrophs(n)%sname) units = 'permil' vgrid = 'layer_avg' truncate = .false. @@ -2952,8 +3006,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' d13C' - sname = 'CISO_d13C_' // trim(autotrophs_config(n)%sname) + lname = trim(autotrophs(n)%lname) // ' d13C' + sname = 'CISO_d13C_' // trim(autotrophs(n)%sname) units = 'permil' vgrid = 'layer_avg' truncate = .false. @@ -2964,8 +3018,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' d14C' - sname = 'CISO_d14C_' // trim(autotrophs_config(n)%sname) + lname = trim(autotrophs(n)%lname) // ' d14C' + sname = 'CISO_d14C_' // trim(autotrophs(n)%sname) units = 'permil' vgrid = 'layer_avg' truncate = .false. @@ -2976,8 +3030,8 @@ subroutine marbl_diagnostics_init( & return end if - lname = trim(autotrophs_config(n)%lname) // ' instanteous growth rate over [CO2*]' - sname = 'CISO_mui_to_co2star_' // trim(autotrophs_config(n)%sname) + lname = trim(autotrophs(n)%lname) // ' instanteous growth rate over [CO2*]' + sname = 'CISO_mui_to_co2star_' // trim(autotrophs(n)%sname) units = 'm^3/mmol C/s' vgrid = 'layer_avg' truncate = .false. @@ -3077,11 +3131,11 @@ subroutine marbl_diagnostics_init( & ! FIXME #60: this approach is not thread-safe ! i.e. if this is called from 2 threads simulatneously, a race condition ! on the allocation status check and allocation is introduced - if (.not. allocated(ind%restore_tend)) then - allocate(ind%restore_tend(marbl_total_tracer_cnt)) + if (.not.ind%lconstructed()) then + allocate(ind%restore_tend(marbl_tracer_indices%total_cnt)) end if - do n = 1,marbl_total_tracer_cnt + do n = 1,marbl_tracer_indices%total_cnt ! restoring tendency lname = trim(marbl_tracer_metadata(n)%long_name) // " Restoring Tendency" sname = trim(marbl_tracer_metadata(n)%short_name) // "_RESTORE_TEND" @@ -3140,7 +3194,7 @@ subroutine marbl_diagnostics_set_interior_forcing ( & marbl_interior_forcing_diags, & marbl_status_log) - use marbl_internal_types , only : marbl_interior_forcing_indexing_type + use marbl_interface_private_types , only : marbl_interior_forcing_indexing_type implicit none @@ -3148,7 +3202,7 @@ subroutine marbl_diagnostics_set_interior_forcing ( & type(marbl_interior_forcing_indexing_type), intent(in) :: interior_forcing_ind type(marbl_forcing_fields_type) , intent(in) :: interior_forcings(:) - real(r8), intent(in) :: dtracers(:,:) ! (marbl_total_tracer_cnt, km) computed source/sink terms + real(r8), intent(in) :: dtracers(:,:) ! (tracer_cnt, km) computed source/sink terms type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices type (carbonate_type) , intent(in) :: carbonate(domain%km) @@ -3174,7 +3228,7 @@ subroutine marbl_diagnostics_set_interior_forcing ( & real (r8) , intent(in) :: Fefree(domain%km) real (r8) , intent(in) :: Lig_photochem(domain%km) real (r8) , intent(in) :: Lig_deg(domain%km) - real (r8) , intent(in) :: interior_restore(:,:) ! (marbl_total_tracer_cnt, km) local restoring terms for nutrients (mmol ./m^3/sec) + real (r8) , intent(in) :: interior_restore(:,:) ! (tracer_cnt, km) local restoring terms for nutrients (mmol ./m^3/sec) type (marbl_diagnostics_type) , intent(inout) :: marbl_interior_forcing_diags type (marbl_log_type) , intent(inout) :: marbl_status_log @@ -3278,10 +3332,10 @@ subroutine marbl_diagnostics_set_surface_forcing( & ! !DESCRIPTION: ! Compute surface fluxes for ecosys tracer module. - use marbl_internal_types , only : marbl_surface_forcing_indexing_type - use marbl_internal_types , only : marbl_surface_saved_state_indexing_type - use marbl_config_mod , only : lflux_gas_o2 - use marbl_config_mod , only : lflux_gas_co2 + use marbl_interface_private_types , only : marbl_surface_forcing_indexing_type + use marbl_interface_private_types , only : marbl_surface_saved_state_indexing_type + use marbl_settings_mod , only : lflux_gas_o2 + use marbl_settings_mod , only : lflux_gas_co2 use marbl_constants_mod , only : mpercm implicit none @@ -3502,6 +3556,8 @@ end subroutine store_diagnostics_carbonate function compute_saturation_depth(marbl_domain, CO3, sat_val, marbl_status_log) + use marbl_utils_mod, only : marbl_utils_linear_root + type(marbl_domain_type) , intent(in) :: marbl_domain real(r8) , intent(in) :: CO3(:) real(r8) , intent(in) :: sat_val(:) @@ -3536,9 +3592,9 @@ function compute_saturation_depth(marbl_domain, CO3, sat_val, marbl_status_log) end do ! saturation depth is location of root of anomaly - compute_saturation_depth = linear_root(zt(k-1:k), anomaly(k-1:k), marbl_status_log) + compute_saturation_depth = marbl_utils_linear_root(zt(k-1:k), anomaly(k-1:k), marbl_status_log) if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('linear_root', subname) + call marbl_status_log%log_error_trace('marbl_utils_linear_root', subname) return end if end if @@ -3549,39 +3605,6 @@ end function compute_saturation_depth !*********************************************************************** - function linear_root(x,y, marbl_status_log) - ! TO-DO: if we end up with a marbl_math_mod, this can be generalized - ! to a better root-finding routine; otherwise maybe we compute - ! the root inside compute_saturation_depth rather than as a - ! separate function? - - real(kind=r8), dimension(2), intent(in) :: x,y - type(marbl_log_type), intent(inout) :: marbl_status_log - real(kind=r8) :: linear_root - - character(len=*), parameter :: subname = 'marbl_diagnostics_mod:linear_root' - - real(kind=r8) :: m_inv - - if ((y(1).gt.c0).and.(y(2).gt.c0)) then - call marbl_status_log%log_error("can not find root, both y-values are positive!", subname) - return - else if ((y(1).lt.c0).and.(y(2).lt.c0)) then - call marbl_status_log%log_error("can not find root, both y-values are negative!", subname) - return - end if - - if (y(2).eq.c0) then - linear_root = x(2) - else - m_inv = (x(2)-x(1))/(y(2)-y(1)) - linear_root = x(1)-m_inv*y(1) - end if - - end function linear_root - - !*********************************************************************** - subroutine store_diagnostics_nitrification(nitrif, denitrif, marbl_interior_diags) real(r8) , intent(in) :: nitrif(:) @@ -3747,9 +3770,9 @@ subroutine store_diagnostics_particulates(marbl_domain, & ! - Accumulte losses of BGC tracers to sediments !----------------------------------------------------------------------- - use marbl_parms , only : POCremin_refract - use marbl_parms , only : PONremin_refract - use marbl_parms , only : POPremin_refract + use marbl_settings_mod, only : POCremin_refract + use marbl_settings_mod, only : PONremin_refract + use marbl_settings_mod, only : POPremin_refract implicit none @@ -4017,8 +4040,8 @@ subroutine store_diagnostics_carbon_fluxes(marbl_domain, POC, P_CaCO3, dtracers, type(marbl_domain_type) , intent(in) :: marbl_domain type(column_sinking_particle_type) , intent(in) :: POC type(column_sinking_particle_type) , intent(in) :: P_CaCO3 - real(r8) , intent(in) :: dtracers(:,:) ! marbl_total_tracer_cnt, km - real(r8) , intent(in) :: interior_restore(:,:) ! marbl_total_tracer_cnt, km + real(r8) , intent(in) :: dtracers(:,:) ! tracer_cnt, km + real(r8) , intent(in) :: interior_restore(:,:) ! tracer_cnt, km type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices type(marbl_diagnostics_type) , intent(inout) :: marbl_diags @@ -4075,15 +4098,15 @@ subroutine store_diagnostics_nitrogen_fluxes(marbl_domain, & PON_sed_loss, denitrif, sed_denitrif, autotroph_secondary_species, dtracers, & interior_restore, marbl_tracer_indices, marbl_diags) - use marbl_parms, only : Q + use marbl_settings_mod, only : Q type(marbl_domain_type) , intent(in) :: marbl_domain real(r8) , intent(in) :: PON_sed_loss(:) ! km real(r8) , intent(in) :: denitrif(:) ! km real(r8) , intent(in) :: sed_denitrif(:) ! km type(autotroph_secondary_species_type) , intent(in) :: autotroph_secondary_species(:,:) - real(r8) , intent(in) :: dtracers(:,:) ! marbl_total_tracer_cnt, km - real(r8) , intent(in) :: interior_restore(:,:) ! marbl_total_tracer_cnt, km + real(r8) , intent(in) :: dtracers(:,:) ! tracer_cnt, km + real(r8) , intent(in) :: interior_restore(:,:) ! tracer_cnt, km type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices type(marbl_diagnostics_type) , intent(inout) :: marbl_diags @@ -4121,7 +4144,7 @@ subroutine store_diagnostics_nitrogen_fluxes(marbl_domain, & ! subtract out N fixation do n = 1, autotroph_cnt - if (autotrophs_config(n)%Nfixer) then + if (autotrophs(n)%Nfixer) then work = work - autotroph_secondary_species(n,:)%Nfix end if end do @@ -4141,14 +4164,14 @@ subroutine store_diagnostics_phosphorus_fluxes(marbl_domain, POP, & autotroph_secondary_species, dtracers, interior_restore, & marbl_tracer_indices, marbl_diags) - use marbl_parms , only : Qp_zoo - use marbl_config_mod, only : lvariable_PtoC + use marbl_pft_mod, only : Qp_zoo + use marbl_settings_mod, only : lvariable_PtoC type(marbl_domain_type) , intent(in) :: marbl_domain type(column_sinking_particle_type) , intent(in) :: POP type(autotroph_secondary_species_type) , intent(in) :: autotroph_secondary_species(:,:) - real(r8) , intent(in) :: dtracers(:,:) ! marbl_total_tracer_cnt, km - real(r8) , intent(in) :: interior_restore(:,:) ! marbl_total_tracer_cnt, km + real(r8) , intent(in) :: dtracers(:,:) ! tracer_cnt, km + real(r8) , intent(in) :: interior_restore(:,:) ! tracer_cnt, km type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices type(marbl_diagnostics_type) , intent(inout) :: marbl_diags @@ -4209,8 +4232,8 @@ subroutine store_diagnostics_silicon_fluxes(marbl_domain, P_SiO2, dtracers, & type(marbl_domain_type) , intent(in) :: marbl_domain type(column_sinking_particle_type) , intent(in) :: P_SiO2 - real(r8) , intent(in) :: dtracers(:,:) ! marbl_total_tracer_cnt, km - real(r8) , intent(in) :: interior_restore(:,:) ! marbl_total_tracer_cnt, km + real(r8) , intent(in) :: dtracers(:,:) ! tracer_cnt, km + real(r8) , intent(in) :: interior_restore(:,:) ! tracer_cnt, km type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices type(marbl_diagnostics_type) , intent(inout) :: marbl_diags @@ -4256,15 +4279,15 @@ end subroutine store_diagnostics_silicon_fluxes subroutine store_diagnostics_iron_fluxes(marbl_domain, P_iron, dust, & fesedflux, dtracers, interior_restore, marbl_tracer_indices, marbl_diags) - use marbl_parms , only : Qfe_zoo - use marbl_parms , only : dust_to_Fe + use marbl_settings_mod, only : Qfe_zoo + use marbl_settings_mod, only : dust_to_Fe type(marbl_domain_type) , intent(in) :: marbl_domain type(column_sinking_particle_type) , intent(in) :: P_iron type(column_sinking_particle_type) , intent(in) :: dust real(r8) , intent(in) :: fesedflux(:) ! km - real(r8) , intent(in) :: dtracers(:,:) ! marbl_total_tracer_cnt, km - real(r8) , intent(in) :: interior_restore(:,:) ! marbl_total_tracer_cnt, km + real(r8) , intent(in) :: dtracers(:,:) ! tracer_cnt, km + real(r8) , intent(in) :: interior_restore(:,:) ! tracer_cnt, km type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices type(marbl_diagnostics_type) , intent(inout) :: marbl_diags @@ -4317,7 +4340,7 @@ subroutine store_diagnostics_interior_restore(interior_restore, marbl_diags) ind => marbl_interior_diag_ind & ) - do n=1, marbl_total_tracer_cnt + do n=1, size(ind%restore_tend) diags(ind%restore_tend(n))%field_3d(:,1) = interior_restore(n,:) end do @@ -4394,7 +4417,7 @@ subroutine store_diagnostics_ciso_interior(& eps_aq_g , & ! equilibrium fractionation (CO2_gaseous <-> CO2_aq) eps_dic_g ! equilibrium fractionation between total DIC and gaseous CO2 - real (r8), intent(in) :: dtracers(:,:) ! (marbl_total_tracer_cnt, km) computed source/sink terms + real (r8), intent(in) :: dtracers(:,:) ! (tracer_cnt, km) computed source/sink terms type(marbl_tracer_index_type), intent(in) :: marbl_tracer_indices @@ -4502,7 +4525,7 @@ subroutine store_diagnostics_ciso_interior(& diags(ind%CISO_mui_to_co2star(n))%field_3d(k, 1) = mui_to_co2star(n,k) - if (autotrophs_config(n)%imp_calcifier) then + if (autotrophs(n)%imp_calcifier) then diags(ind%CISO_Ca13CO3_form(n))%field_3d(k, 1) = Ca13CO3_prod(n,k) diags(ind%CISO_Ca14CO3_form(n))%field_3d(k, 1) = Ca14CO3_prod(n,k) end if @@ -4717,4 +4740,82 @@ subroutine log_add_diagnostics_error(marbl_status_log, sname, subname) end subroutine log_add_diagnostics_error + !***************************************************************************** + + function interior_diag_ind_constructed(this) result(constructed) + + class(marbl_interior_diagnostics_indexing_type), intent(inout) :: this + logical(log_kind) :: constructed + + constructed = allocated(this%restore_tend) + + end function interior_diag_ind_constructed + + !***************************************************************************** + + subroutine interior_diag_ind_destructor(this) + + use marbl_settings_mod, only : ciso_on + + class(marbl_interior_diagnostics_indexing_type), intent(inout) :: this + + if (this%lconstructed()) then + deallocate(this%photoC_zint) + deallocate(this%photoC_NO3_zint) + deallocate(this%CaCO3_form_zint) + deallocate(this%Qp) + deallocate(this%N_lim) + deallocate(this%P_lim) + deallocate(this%Fe_lim) + deallocate(this%SiO3_lim) + deallocate(this%light_lim) + deallocate(this%photoC) + deallocate(this%photoC_NO3) + deallocate(this%photoFe) + deallocate(this%photoNO3) + deallocate(this%photoNH4) + deallocate(this%DOP_uptake) + deallocate(this%PO4_uptake) + deallocate(this%auto_graze) + deallocate(this%auto_graze_poc) + deallocate(this%auto_graze_doc) + deallocate(this%auto_graze_zoo) + deallocate(this%auto_loss) + deallocate(this%auto_loss_poc) + deallocate(this%auto_loss_doc) + deallocate(this%auto_agg) + deallocate(this%bSi_form) + deallocate(this%CaCO3_form) + deallocate(this%Nfix) + deallocate(this%zoo_loss) + deallocate(this%zoo_loss_poc) + deallocate(this%zoo_loss_doc) + deallocate(this%zoo_graze) + deallocate(this%zoo_graze_poc) + deallocate(this%zoo_graze_doc) + deallocate(this%zoo_graze_zoo) + deallocate(this%x_graze_zoo) + if (ciso_on) then + deallocate(this%CISO_eps_autotroph) + deallocate(this%CISO_mui_to_co2star) + deallocate(this%CISO_Ca13CO3_form) + deallocate(this%CISO_Ca14CO3_form) + deallocate(this%CISO_Ca13CO3_form_zint) + deallocate(this%CISO_Ca14CO3_form_zint) + deallocate(this%CISO_photo13C) + deallocate(this%CISO_photo14C) + deallocate(this%CISO_photo13C_zint) + deallocate(this%CISO_photo14C_zint) + deallocate(this%CISO_d13C) + deallocate(this%CISO_d14C) + deallocate(this%CISO_autotrophCaCO3_d14C) + deallocate(this%CISO_autotrophCaCO3_d13C) + end if + deallocate(this%restore_tend) + end if + + end subroutine interior_diag_ind_destructor + + !***************************************************************************** + end module marbl_diagnostics_mod diff --git a/src/marbl_init_mod.F90 b/src/marbl_init_mod.F90 new file mode 100644 index 00000000..54332ed3 --- /dev/null +++ b/src/marbl_init_mod.F90 @@ -0,0 +1,1013 @@ +module marbl_init_mod + + use marbl_kinds_mod, only : int_kind + use marbl_kinds_mod, only : r8 + use marbl_kinds_mod, only : char_len + + use marbl_interface_public_types, only : marbl_tracer_metadata_type + use marbl_interface_public_types, only : marbl_forcing_fields_type + + use marbl_interface_private_types, only : marbl_tracer_index_type + + use marbl_logging, only : marbl_log_type + + use marbl_settings_mod, only : autotroph_cnt + use marbl_settings_mod, only : zooplankton_cnt + + implicit none + private + + public :: marbl_init_log_and_timers + public :: marbl_init_parameters_pre_tracers + public :: marbl_init_parameters_post_tracers + public :: marbl_init_tracers + public :: marbl_init_bury_coeff + public :: marbl_init_forcing_fields + + private :: marbl_init_tracer_metadata + private :: marbl_init_non_autotroph_tracer_metadata + private :: marbl_init_non_autotroph_tracers_metadata + private :: marbl_init_zooplankton_tracer_metadata + private :: marbl_init_autotroph_tracer_metadata + private :: marbl_init_surface_forcing_fields + private :: marbl_init_interior_forcing_fields + +contains + + !*********************************************************************** + + subroutine marbl_init_log_and_timers(marbl_timers, timer_ids, marbl_status_log) + + use marbl_interface_private_types, only : marbl_internal_timers_type + use marbl_interface_private_types, only : marbl_timer_indexing_type + + type(marbl_internal_timers_type), intent(out) :: marbl_timers + type(marbl_timer_indexing_type), intent(out) :: timer_ids + type(marbl_log_type), intent(inout) :: marbl_status_log + + character(len=*), parameter :: subname = 'marbl_init_mod:marbl_init_log_and_timers' + + ! Construct status log + call marbl_status_log%construct() + call marbl_status_log%log_noerror('', subname) + + ! Set up timers + call marbl_timers%setup(timer_ids, marbl_status_log) + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace("setup_timers()", subname) + return + end if + + end subroutine marbl_init_log_and_timers + + !*********************************************************************** + + subroutine marbl_init_parameters_pre_tracers(lallow_glo_ops, marbl_settings, marbl_status_log) + + use marbl_settings_mod, only : marbl_settings_type + use marbl_settings_mod, only : ladjust_bury_coeff + use marbl_settings_mod, only : marbl_settings_set_defaults_general_parms + use marbl_settings_mod, only : marbl_settings_define_general_parms + use marbl_settings_mod, only : marbl_settings_set_defaults_PFT_counts + use marbl_settings_mod, only : marbl_settings_define_PFT_counts + use marbl_settings_mod, only : marbl_settings_set_defaults_PFT_derived_types + use marbl_settings_mod, only : marbl_settings_define_PFT_derived_types + + logical, intent(in) :: lallow_glo_ops + type(marbl_settings_type), intent(inout) :: marbl_settings + type(marbl_log_type), intent(inout) :: marbl_status_log + + ! local variables + character(len=*), parameter :: subname = 'marbl_init_mod:marbl_init_parameters_pre_tracers' + character(len=char_len) :: log_message + + !--------------------------------------------------------------------------- + ! set default values for basic settings + !--------------------------------------------------------------------------- + + call marbl_settings_set_defaults_general_parms() + + !--------------------------------------------------------------------------- + ! Add general settings to list of allowable put / get vars + !--------------------------------------------------------------------------- + + call marbl_settings_define_general_parms(marbl_settings, marbl_status_log) + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace("marbl_settings_define_general_parms()", subname) + return + end if + + ! Abort if GCM doesn't support global ops but configuration requires them + if (ladjust_bury_coeff .and. (.not.lallow_glo_ops)) then + write(log_message,'(2A)') 'Can not run with ladjust_bury_coeff = ', & + '.true. unless GCM can perform global operations' + call marbl_status_log%log_error(log_message, subname) + return + end if + + !--------------------------------------------------------------------------- + ! Add PFT counts to list of allowable put / get vars + !--------------------------------------------------------------------------- + + call marbl_settings_set_defaults_PFT_counts(marbl_status_log) + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace("marbl_settings_set_defaults_PFT_counts()", subname) + return + end if + + call marbl_settings_define_PFT_counts(marbl_settings, marbl_status_log) + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace("marbl_settings_define_PFT_counts()", subname) + return + end if + + !--------------------------------------------------------------------------- + ! Add components of PFT derived types to list of allowable put / get vars + !--------------------------------------------------------------------------- + + call marbl_settings_set_defaults_PFT_derived_types(marbl_status_log) + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace("marbl_settings_set_defaults_PFT_derived_types()", subname) + return + end if + + call marbl_settings_define_PFT_derived_types(marbl_settings, marbl_status_log) + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace("marbl_settings_define_PFT_derived_types()", subname) + return + end if + + end subroutine marbl_init_parameters_pre_tracers + + !*********************************************************************** + + subroutine marbl_init_tracers(num_levels, & + num_surface_elements, & + tracer_indices, & + surface_vals, & + surface_tracer_fluxes, & + column_tracers, & + column_dtracers, & + tracer_metadata, & + marbl_status_log, & + marbl_tracer_cnt) + + use marbl_settings_mod, only : ciso_on + use marbl_settings_mod, only : lvariable_PtoC + use marbl_settings_mod, only : autotrophs + use marbl_settings_mod, only : zooplankton + use marbl_settings_mod, only : tracer_restore_vars + use marbl_ciso_mod, only : marbl_ciso_init_tracer_metadata + + integer(int_kind), intent(in) :: num_levels + integer(int_kind), intent(in) :: num_surface_elements + type(marbl_tracer_index_type), pointer, intent(out) :: tracer_indices + real(r8), allocatable, intent(out) :: surface_vals(:,:) + real(r8), allocatable, intent(out) :: surface_tracer_fluxes(:,:) + real(r8), allocatable, intent(out) :: column_tracers(:,:) + real(r8), allocatable, intent(out) :: column_dtracers(:,:) + type(marbl_tracer_metadata_type), allocatable, intent(out) :: tracer_metadata(:) + type(marbl_log_type), intent(inout) :: marbl_status_log + integer(int_kind), optional, intent(out) :: marbl_tracer_cnt + + ! local variables + character(len=*), parameter :: subname = 'marbl_init_mod:marbl_init_tracers' + character(len=char_len) :: log_message + integer :: i + + ! Construct tracer indices + allocate(tracer_indices) + call tracer_indices%construct(ciso_on, lvariable_PtoC, autotrophs, zooplankton, & + marbl_status_log, marbl_tracer_cnt) + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace("tracer_indices%construct", subname) + return + end if + + ! Allocate memory for tracers + allocate(surface_vals(num_surface_elements, tracer_indices%total_cnt)) + allocate(surface_tracer_fluxes(num_surface_elements, tracer_indices%total_cnt)) + allocate(column_tracers(tracer_indices%total_cnt, num_levels)) + allocate(column_dtracers(tracer_indices%total_cnt, num_levels)) + allocate(tracer_metadata(tracer_indices%total_cnt)) + if (.not.allocated(tracer_restore_vars)) & + allocate(tracer_restore_vars(tracer_indices%total_cnt)) + + ! Set up tracer metadata + call marbl_init_tracer_metadata(tracer_metadata, tracer_indices, marbl_status_log) + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace("marbl_init_tracer_metadata()", subname) + return + end if + if (ciso_on) then + call marbl_ciso_init_tracer_metadata(tracer_metadata, tracer_indices) + end if + + ! Log what tracers are being used + call marbl_status_log%log_header('MARBL Tracer indices', subname) + do i=1,tracer_indices%total_cnt + write(log_message, "(I3,2A)") i, '. ', trim(tracer_metadata(i)%short_name) + call marbl_status_log%log_noerror(log_message, subname) + end do + +100 format(A, ' tracer module contains ', I0, ' tracers; indices are ', I0, ' to ', I0) + if (tracer_indices%ecosys_base%cnt.gt.0) then + write(log_message, 100) 'ecosys_base', & + tracer_indices%ecosys_base%cnt, & + tracer_indices%ecosys_base%ind_beg, & + tracer_indices%ecosys_base%ind_end + call marbl_status_log%log_noerror(log_message, subname) + end if + if (tracer_indices%ciso%cnt.gt.0) then + write(log_message, 100) 'ciso', & + tracer_indices%ciso%cnt, & + tracer_indices%ciso%ind_beg, & + tracer_indices%ciso%ind_end + call marbl_status_log%log_noerror(log_message, subname) + end if + + end subroutine marbl_init_tracers + + !*********************************************************************** + + subroutine marbl_init_tracer_metadata(marbl_tracer_metadata, & + marbl_tracer_indices, marbl_status_log) + + ! Set tracer and forcing metadata + + use marbl_settings_mod, only : lecovars_full_depth_tavg + + implicit none + + type (marbl_tracer_metadata_type), intent(out) :: marbl_tracer_metadata(:) ! descriptors for each tracer + type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices + type(marbl_log_type) , intent(inout) :: marbl_status_log + + !----------------------------------------------------------------------- + ! local variables + !----------------------------------------------------------------------- + + character(len=*), parameter :: subname = 'marbl_init_mod:marbl_init_tracer_metadata' + + integer (int_kind) :: n ! index for looping over tracers + integer (int_kind) :: zoo_ind ! zooplankton functional group index + integer (int_kind) :: auto_ind ! autotroph functional group index + + !----------------------------------------------------------------------- + ! initialize tracer metatdata + !----------------------------------------------------------------------- + + marbl_tracer_metadata(:)%lfull_depth_tavg = .true. + marbl_tracer_metadata(:)%tracer_module_name = 'ecosys' + + call marbl_init_non_autotroph_tracers_metadata(marbl_tracer_metadata, & + marbl_tracer_indices) + + call marbl_init_zooplankton_tracer_metadata(marbl_tracer_metadata, & + marbl_tracer_indices) + + call marbl_init_autotroph_tracer_metadata(marbl_tracer_metadata, & + marbl_tracer_indices) + + !----------------------------------------------------------------------- + ! set lfull_depth_tavg flag for short-lived ecosystem tracers + !----------------------------------------------------------------------- + + ! Should be done in marbl_diagnostics, and without the _tavg name + do zoo_ind = 1, zooplankton_cnt + n = marbl_tracer_indices%zoo_inds(zoo_ind)%C_ind + marbl_tracer_metadata(n)%lfull_depth_tavg = lecovars_full_depth_tavg + end do + + do auto_ind = 1, autotroph_cnt + n = marbl_tracer_indices%auto_inds(auto_ind)%Chl_ind + marbl_tracer_metadata(n)%lfull_depth_tavg = lecovars_full_depth_tavg + + n = marbl_tracer_indices%auto_inds(auto_ind)%C_ind + marbl_tracer_metadata(n)%lfull_depth_tavg = lecovars_full_depth_tavg + + n = marbl_tracer_indices%auto_inds(auto_ind)%P_ind + if (n > 0) then + marbl_tracer_metadata(n)%lfull_depth_tavg = lecovars_full_depth_tavg + endif + + n = marbl_tracer_indices%auto_inds(auto_ind)%Fe_ind + marbl_tracer_metadata(n)%lfull_depth_tavg = lecovars_full_depth_tavg + + n = marbl_tracer_indices%auto_inds(auto_ind)%Si_ind + if (n > 0) then + marbl_tracer_metadata(n)%lfull_depth_tavg = lecovars_full_depth_tavg + endif + + n = marbl_tracer_indices%auto_inds(auto_ind)%CaCO3_ind + if (n > 0) then + marbl_tracer_metadata(n)%lfull_depth_tavg = lecovars_full_depth_tavg + endif + end do + + end subroutine marbl_init_tracer_metadata + + !*********************************************************************** + + subroutine marbl_init_parameters_post_tracers(marbl_settings, marbl_status_log) + + use marbl_settings_mod, only : marbl_settings_type + use marbl_settings_mod, only : marbl_settings_set_defaults_tracer_dependent + use marbl_settings_mod, only : marbl_settings_define_tracer_dependent + + type(marbl_settings_type), intent(inout) :: marbl_settings + type(marbl_log_type), intent(inout) :: marbl_status_log + + ! local variables + character(len=*), parameter :: subname = 'marbl_init_mod:marbl_init_parameters_tracer_dependent' + character(len=char_len) :: log_message + + ! set default values for parameters + call marbl_settings_set_defaults_tracer_dependent(marbl_status_log) + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace("marbl_settings_set_defaults_tracer_dependent()", subname) + return + end if + + ! construct parameters_type + call marbl_settings_define_tracer_dependent(marbl_settings, marbl_status_log) + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace("marbl_settings_define_tracer_dependent()", subname) + return + end if + + end subroutine marbl_init_parameters_post_tracers + + !*********************************************************************** + + subroutine marbl_init_bury_coeff(marbl_particulate_share, num_levels, marbl_status_log) + + use marbl_logging, only : marbl_log_type + use marbl_settings_mod, only : init_bury_coeff_opt + use marbl_settings_mod, only : ladjust_bury_coeff + use marbl_settings_mod, only : parm_init_POC_bury_coeff + use marbl_settings_mod, only : parm_init_POP_bury_coeff + use marbl_settings_mod, only : parm_init_bSi_bury_coeff + use marbl_interface_private_types, only : marbl_particulate_share_type + + type(marbl_particulate_share_type), intent(out) :: marbl_particulate_share + integer(int_kind), intent(in) :: num_levels + type(marbl_log_type), intent(inout) :: marbl_status_log + + !--------------------------------------------------------------------------- + ! local variables + !--------------------------------------------------------------------------- + character(len=*), parameter :: subname = 'marbl_init_mod:marbl_init_bury_coeff' + + !--------------------------------------------------------------------------- + + call marbl_particulate_share%construct(num_levels) + + ! if ladjust_bury_coeff is true, then bury coefficients are set at runtime + ! so they do not need to be initialized here + + if (.not. ladjust_bury_coeff) then + if (init_bury_coeff_opt == 'nml') then + marbl_particulate_share%POC_bury_coeff = parm_init_POC_bury_coeff + marbl_particulate_share%POP_bury_coeff = parm_init_POP_bury_coeff + marbl_particulate_share%bSi_bury_coeff = parm_init_bSi_bury_coeff + else + call marbl_status_log%log_error("ladjust_bury_coeff=.false., init_bury_coeff_opt='restfile' not implemented", subname) + return + end if + end if + + end subroutine marbl_init_bury_coeff + + !*********************************************************************** + + subroutine marbl_init_forcing_fields(domain, & + tracer_metadata, & + surface_forcing_ind, & + surface_forcing_share, & + surface_forcing_internal, & + surface_input_forcings, & + interior_forcing_ind, & + interior_input_forcings, & + marbl_status_log) + + use marbl_interface_public_types, only : marbl_domain_type + use marbl_interface_private_types, only : marbl_surface_forcing_indexing_type + use marbl_interface_private_types, only : marbl_surface_forcing_share_type + use marbl_interface_private_types, only : marbl_surface_forcing_internal_type + use marbl_interface_private_types, only : marbl_interior_forcing_indexing_type + use marbl_settings_mod, only : ciso_on + use marbl_settings_mod, only : lflux_gas_o2 + use marbl_settings_mod, only : lflux_gas_co2 + use marbl_settings_mod, only : ladjust_bury_coeff + use marbl_settings_mod, only : tracer_restore_vars + + type(marbl_domain_type), intent(in) :: domain + type(marbl_tracer_metadata_type), intent(in) :: tracer_metadata(:) + type(marbl_surface_forcing_indexing_type), intent(out) :: surface_forcing_ind + type(marbl_surface_forcing_share_type), intent(out) :: surface_forcing_share + type(marbl_surface_forcing_internal_type), intent(out) :: surface_forcing_internal + type(marbl_forcing_fields_type), allocatable, intent(out) :: surface_input_forcings(:) + type(marbl_interior_forcing_indexing_type), intent(out) :: interior_forcing_ind + type(marbl_forcing_fields_type), allocatable, intent(out) :: interior_input_forcings(:) + type(marbl_log_type), intent(inout) :: marbl_status_log + + ! Local variables + character(len=*), parameter :: subname = 'marbl_init_mod:marbl_init_forcing_fields' + character(len=char_len) :: log_message + integer :: num_surface_forcing_fields + integer :: num_interior_forcing_fields + integer :: i + + associate(& + num_surface_elements => domain%num_elements_surface_forcing, & + num_interior_elements => domain%num_elements_interior_forcing, & + num_PAR_subcols => domain%num_PAR_subcols, & + num_levels => domain%km & + ) + + ! Construct indices for surface and interior forcing + call surface_forcing_ind%construct(ciso_on, & + lflux_gas_o2, & + lflux_gas_co2, & + ladjust_bury_coeff, & + num_surface_forcing_fields) + call interior_forcing_ind%construct(tracer_metadata%short_name, & + tracer_restore_vars, & + num_interior_forcing_fields, & + marbl_status_log) + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace("interior_forcing_ind%construct", subname) + return + end if + + ! Construct share / internal types for surface forcing + call surface_forcing_share%construct(num_surface_elements) + call surface_forcing_internal%construct(num_surface_elements) + + ! Initialize surface forcing fields + allocate(surface_input_forcings(num_surface_forcing_fields)) + call marbl_init_surface_forcing_fields( & + num_elements = num_surface_elements, & + surface_forcing_indices = surface_forcing_ind, & + surface_forcings = surface_input_forcings, & + marbl_status_log = marbl_status_log) + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace("marbl_init_surface_forcing_fields()", subname) + return + end if + + ! Initialize interior forcing fields + allocate(interior_input_forcings(num_interior_forcing_fields)) + call marbl_init_interior_forcing_fields( & + num_elements = num_interior_elements, & + interior_forcing_indices = interior_forcing_ind, & + tracer_metadata = tracer_metadata, & + num_PAR_subcols = num_PAR_subcols, & + num_levels = num_levels, & + interior_forcings = interior_input_forcings, & + marbl_status_log = marbl_status_log) + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace("marbl_init_interior_forcing_fields()", subname) + return + end if + + !-------------------------------------------------------------------- + ! Report what forcings are required from the driver + !-------------------------------------------------------------------- + + call marbl_status_log%log_header('MARBL-Required Forcing Fields', subname) + call marbl_status_log%log_noerror('Surface:', subname) + do i=1,size(surface_input_forcings) + write(log_message, "(2A)") '* ', trim(surface_input_forcings(i)%metadata%varname) + call marbl_status_log%log_noerror(log_message, subname) + end do + + call marbl_status_log%log_noerror('', subname) + call marbl_status_log%log_noerror('Interior:', subname) + do i=1,size(interior_input_forcings) + write(log_message, "(2A)") '* ', trim(interior_input_forcings(i)%metadata%varname) + call marbl_status_log%log_noerror(log_message, subname) + end do + + end associate + + end subroutine marbl_init_forcing_fields + + !*********************************************************************** + + subroutine marbl_init_non_autotroph_tracer_metadata(short_name, long_name, & + marbl_tracer_metadata) + + !----------------------------------------------------------------------- + ! initialize non-autotroph tracer_d values and accumulate + ! non_living_biomass_ecosys_tracer_cnt + !----------------------------------------------------------------------- + + implicit none + + character(len=*), intent(in) :: short_name + character(len=*), intent(in) :: long_name + type(marbl_tracer_metadata_type), intent(inout) :: marbl_tracer_metadata + + marbl_tracer_metadata%short_name = short_name + marbl_tracer_metadata%long_name = long_name + if ((trim(short_name) == "ALK") .or. & + (trim(short_name) == "ALK_ALT_CO2")) then + marbl_tracer_metadata%units = 'meq/m^3' + marbl_tracer_metadata%tend_units = 'meq/m^3/s' + marbl_tracer_metadata%flux_units = 'meq/m^3 cm/s' + else + marbl_tracer_metadata%units = 'mmol/m^3' + marbl_tracer_metadata%tend_units = 'mmol/m^3/s' + marbl_tracer_metadata%flux_units = 'mmol/m^3 cm/s' + endif + + end subroutine marbl_init_non_autotroph_tracer_metadata + + !*********************************************************************** + + subroutine marbl_init_non_autotroph_tracers_metadata(marbl_tracer_metadata, & + marbl_tracer_indices) + + !----------------------------------------------------------------------- + ! initialize non-autotroph tracer_d values and accumulate + ! non_living_biomass_ecosys_tracer_cnt + !----------------------------------------------------------------------- + + implicit none + + type(marbl_tracer_metadata_type) , intent(inout) :: marbl_tracer_metadata(:) ! descriptors for each tracer + type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices + + call marbl_init_non_autotroph_tracer_metadata('PO4', 'Dissolved Inorganic Phosphate', & + marbl_tracer_metadata(marbl_tracer_indices%po4_ind)) + call marbl_init_non_autotroph_tracer_metadata('NO3', 'Dissolved Inorganic Nitrate', & + marbl_tracer_metadata(marbl_tracer_indices%no3_ind)) + call marbl_init_non_autotroph_tracer_metadata('SiO3', 'Dissolved Inorganic Silicate', & + marbl_tracer_metadata(marbl_tracer_indices%sio3_ind)) + call marbl_init_non_autotroph_tracer_metadata('NH4', 'Dissolved Ammonia', & + marbl_tracer_metadata(marbl_tracer_indices%nh4_ind)) + call marbl_init_non_autotroph_tracer_metadata('Fe', 'Dissolved Inorganic Iron', & + marbl_tracer_metadata(marbl_tracer_indices%fe_ind)) + call marbl_init_non_autotroph_tracer_metadata('Lig', 'Iron Binding Ligand', & + marbl_tracer_metadata(marbl_tracer_indices%lig_ind)) + call marbl_init_non_autotroph_tracer_metadata('O2', 'Dissolved Oxygen', & + marbl_tracer_metadata(marbl_tracer_indices%o2_ind)) + call marbl_init_non_autotroph_tracer_metadata('DIC', 'Dissolved Inorganic Carbon', & + marbl_tracer_metadata(marbl_tracer_indices%dic_ind)) + call marbl_init_non_autotroph_tracer_metadata('ALK', 'Alkalinity', & + marbl_tracer_metadata(marbl_tracer_indices%alk_ind)) + call marbl_init_non_autotroph_tracer_metadata('DOC', 'Dissolved Organic Carbon', & + marbl_tracer_metadata(marbl_tracer_indices%doc_ind)) + call marbl_init_non_autotroph_tracer_metadata('DON', 'Dissolved Organic Nitrogen', & + marbl_tracer_metadata(marbl_tracer_indices%don_ind)) + call marbl_init_non_autotroph_tracer_metadata('DOP', 'Dissolved Organic Phosphorus', & + marbl_tracer_metadata(marbl_tracer_indices%dop_ind)) + call marbl_init_non_autotroph_tracer_metadata('DOPr', 'Refractory DOP', & + marbl_tracer_metadata(marbl_tracer_indices%dopr_ind)) + call marbl_init_non_autotroph_tracer_metadata('DONr', 'Refractory DON', & + marbl_tracer_metadata(marbl_tracer_indices%donr_ind)) + call marbl_init_non_autotroph_tracer_metadata('DOCr', 'Refractory DOC', & + marbl_tracer_metadata(marbl_tracer_indices%docr_ind)) + + call marbl_init_non_autotroph_tracer_metadata('DIC_ALT_CO2', 'Dissolved Inorganic Carbon, Alternative CO2', & + marbl_tracer_metadata(marbl_tracer_indices%dic_alt_co2_ind)) + call marbl_init_non_autotroph_tracer_metadata('ALK_ALT_CO2', 'Alkalinity, Alternative CO2', & + marbl_tracer_metadata(marbl_tracer_indices%alk_alt_co2_ind)) + + end subroutine marbl_init_non_autotroph_tracers_metadata + + !*********************************************************************** + + subroutine marbl_init_zooplankton_tracer_metadata(marbl_tracer_metadata, & + marbl_tracer_indices) + + !----------------------------------------------------------------------- + ! initialize zooplankton tracer_d values and tracer indices + !----------------------------------------------------------------------- + + use marbl_settings_mod, only : zooplankton + + implicit none + + type (marbl_tracer_metadata_type) , intent(inout) :: marbl_tracer_metadata(:) ! descriptors for each tracer + type (marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices + + !----------------------------------------------------------------------- + ! local variables + !----------------------------------------------------------------------- + integer (int_kind) :: n, zoo_ind ! zooplankton functional group index + !----------------------------------------------------------------------- + + do zoo_ind = 1, zooplankton_cnt + n = marbl_tracer_indices%zoo_inds(zoo_ind)%C_ind + marbl_tracer_metadata(n)%short_name = trim(zooplankton(zoo_ind)%sname) // 'C' + marbl_tracer_metadata(n)%long_name = trim(zooplankton(zoo_ind)%lname) // ' Carbon' + marbl_tracer_metadata(n)%units = 'mmol/m^3' + marbl_tracer_metadata(n)%tend_units = 'mmol/m^3/s' + marbl_tracer_metadata(n)%flux_units = 'mmol/m^3 cm/s' + end do + + end subroutine marbl_init_zooplankton_tracer_metadata + + !*********************************************************************** + + subroutine marbl_init_autotroph_tracer_metadata(marbl_tracer_metadata, & + marbl_tracer_indices) + + !----------------------------------------------------------------------- + ! initialize autotroph tracer_d values and tracer indices + !----------------------------------------------------------------------- + + use marbl_settings_mod, only : autotrophs + + implicit none + + type (marbl_tracer_metadata_type) , intent(inout) :: marbl_tracer_metadata(:) ! descriptors for each tracer + type (marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices + + !----------------------------------------------------------------------- + ! local variables + !----------------------------------------------------------------------- + integer (int_kind) :: n, auto_ind + !----------------------------------------------------------------------- + + do auto_ind = 1, autotroph_cnt + n = marbl_tracer_indices%auto_inds(auto_ind)%Chl_ind + marbl_tracer_metadata(n)%short_name = trim(autotrophs(auto_ind)%sname) // 'Chl' + marbl_tracer_metadata(n)%long_name = trim(autotrophs(auto_ind)%lname) // ' Chlorophyll' + marbl_tracer_metadata(n)%units = 'mg/m^3' + marbl_tracer_metadata(n)%tend_units = 'mg/m^3/s' + marbl_tracer_metadata(n)%flux_units = 'mg/m^3 cm/s' + + n = marbl_tracer_indices%auto_inds(auto_ind)%C_ind + marbl_tracer_metadata(n)%short_name = trim(autotrophs(auto_ind)%sname) // 'C' + marbl_tracer_metadata(n)%long_name = trim(autotrophs(auto_ind)%lname) // ' Carbon' + marbl_tracer_metadata(n)%units = 'mmol/m^3' + marbl_tracer_metadata(n)%tend_units = 'mmol/m^3/s' + marbl_tracer_metadata(n)%flux_units = 'mmol/m^3 cm/s' + + n = marbl_tracer_indices%auto_inds(auto_ind)%P_ind + if (n.gt.0) then + marbl_tracer_metadata(n)%short_name = trim(autotrophs(auto_ind)%sname) // 'P' + marbl_tracer_metadata(n)%long_name = trim(autotrophs(auto_ind)%lname) // ' Phosphorus' + marbl_tracer_metadata(n)%units = 'mmol/m^3' + marbl_tracer_metadata(n)%tend_units = 'mmol/m^3/s' + marbl_tracer_metadata(n)%flux_units = 'mmol/m^3 cm/s' + endif + + n = marbl_tracer_indices%auto_inds(auto_ind)%Fe_ind + marbl_tracer_metadata(n)%short_name = trim(autotrophs(auto_ind)%sname) // 'Fe' + marbl_tracer_metadata(n)%long_name = trim(autotrophs(auto_ind)%lname) // ' Iron' + marbl_tracer_metadata(n)%units = 'mmol/m^3' + marbl_tracer_metadata(n)%tend_units = 'mmol/m^3/s' + marbl_tracer_metadata(n)%flux_units = 'mmol/m^3 cm/s' + + n = marbl_tracer_indices%auto_inds(auto_ind)%Si_ind + if (n .gt. 0) then + marbl_tracer_metadata(n)%short_name = trim(autotrophs(auto_ind)%sname) // 'Si' + marbl_tracer_metadata(n)%long_name = trim(autotrophs(auto_ind)%lname) // ' Silicon' + marbl_tracer_metadata(n)%units = 'mmol/m^3' + marbl_tracer_metadata(n)%tend_units = 'mmol/m^3/s' + marbl_tracer_metadata(n)%flux_units = 'mmol/m^3 cm/s' + endif + + n = marbl_tracer_indices%auto_inds(auto_ind)%CaCO3_ind + if (n .gt. 0) then + marbl_tracer_metadata(n)%short_name = trim(autotrophs(auto_ind)%sname) // 'CaCO3' + marbl_tracer_metadata(n)%long_name = trim(autotrophs(auto_ind)%lname) // ' CaCO3' + marbl_tracer_metadata(n)%units = 'mmol/m^3' + marbl_tracer_metadata(n)%tend_units = 'mmol/m^3/s' + marbl_tracer_metadata(n)%flux_units = 'mmol/m^3 cm/s' + endif + end do + + end subroutine marbl_init_autotroph_tracer_metadata + + !*********************************************************************** + + subroutine marbl_init_surface_forcing_fields(num_elements, surface_forcing_indices, & + surface_forcings, marbl_status_log) + + ! Initialize the surface forcing_fields datatype with information from the + ! namelist read + ! + + use marbl_interface_private_types, only : marbl_surface_forcing_indexing_type + + implicit none + + integer, intent(in) :: num_elements + type(marbl_surface_forcing_indexing_type), intent(in) :: surface_forcing_indices + type(marbl_forcing_fields_type), intent(out) :: surface_forcings(:) + type(marbl_log_type), intent(inout) :: marbl_status_log + + !----------------------------------------------------------------------- + ! local variables + !----------------------------------------------------------------------- + character(len=*), parameter :: subname = 'marbl_init_mod:marbl_init_surface_forcing_fields' + character(len=char_len) :: log_message + + integer :: id + logical :: found + !----------------------------------------------------------------------- + + associate(ind => surface_forcing_indices) + + surface_forcings(:)%metadata%varname = '' + do id=1,size(surface_forcings) + found = .false. + + ! Square of 10m wind + if (id .eq. ind%u10_sqr_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'u10_sqr' + surface_forcings(id)%metadata%field_units = 'cm^2/s^2' + end if + + ! Sea-surface salinity + if (id .eq. ind%sss_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'sss' + surface_forcings(id)%metadata%field_units = 'unknown units' + end if + + ! Sea-surface temperature + if (id .eq. ind%sst_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'sst' + surface_forcings(id)%metadata%field_units = 'degrees C' + end if + + ! Ice Fraction + if (id .eq. ind%ifrac_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'Ice Fraction' + surface_forcings(id)%metadata%field_units = 'unitless' + end if + + ! Dust Flux + if (id .eq. ind%dust_flux_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'Dust Flux' + surface_forcings(id)%metadata%field_units = 'g/cm^2/s' + end if + + ! Iron Flux + if (id .eq. ind%iron_flux_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'Iron Flux' + surface_forcings(id)%metadata%field_units = 'nmol/cm^2/s' + end if + + ! NOx Flux + if (id .eq. ind%nox_flux_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'NOx Flux' + surface_forcings(id)%metadata%field_units = 'unknown units' + end if + + ! NHy Flux + if (id .eq. ind%nhy_flux_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'NHy Flux' + surface_forcings(id)%metadata%field_units = 'unknown units' + end if + + ! external C Flux + if (id .eq. ind%ext_C_flux_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'external C Flux' + surface_forcings(id)%metadata%field_units = 'nmol/cm^2/s' + end if + + ! external P Flux + if (id .eq. ind%ext_P_flux_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'external P Flux' + surface_forcings(id)%metadata%field_units = 'nmol/cm^2/s' + end if + + ! external Si Flux + if (id .eq. ind%ext_Si_flux_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'external Si Flux' + surface_forcings(id)%metadata%field_units = 'nmol/cm^2/s' + end if + + ! atm pressure + if (id .eq. ind%atm_pressure_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'Atmospheric Pressure' + surface_forcings(id)%metadata%field_units = 'unknown units' + end if + + ! xco2 + if (id .eq. ind%xco2_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'xco2' + surface_forcings(id)%metadata%field_units = 'unknown units' + end if + + ! xco2_alt_co2 + if (id .eq. ind%xco2_alt_co2_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'xco2_alt_co2' + surface_forcings(id)%metadata%field_units = 'unknown units' + end if + + ! d13c + if (id .eq. ind%d13c_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'd13c' + surface_forcings(id)%metadata%field_units = 'unknown units' + end if + + ! d14c + if (id .eq. ind%d14c_id) then + found = .true. + surface_forcings(id)%metadata%varname = 'd14c' + surface_forcings(id)%metadata%field_units = 'unknown units' + end if + + if (.not.found) then + write(log_message, "(A,I0,A)") "Index number ", id, & + " is not associated with a forcing field!" + call marbl_status_log%log_error(log_message, subname) + return + end if + + ! All surface forcing fields are rank 0; if that changes, make this + ! call from inside each "if (id .eq. *)" block + call surface_forcings(id)%set_rank(num_elements, 0, marbl_status_log) + + end do + + end associate + + ! FIXME #26: do we have any forcing fields that are required to be set? + ! If so, check to make sure those indices are not zero here. + + end subroutine marbl_init_surface_forcing_fields + + !***************************************************************************** + + subroutine marbl_init_interior_forcing_fields(& + num_elements, & + interior_forcing_indices, & + tracer_metadata, & + num_PAR_subcols, & + num_levels, & + interior_forcings, & + marbl_status_log) + + ! Initialize the interior forcing_fields datatype with information from the + ! namelist read + ! + use marbl_interface_private_types, only : marbl_interior_forcing_indexing_type + + implicit none + + integer, intent(in) :: num_elements + type(marbl_interior_forcing_indexing_type), intent(in) :: interior_forcing_indices + type(marbl_tracer_metadata_type), intent(in) :: tracer_metadata(:) + integer, intent(in) :: num_PAR_subcols + integer, intent(in) :: num_levels + type(marbl_forcing_fields_type), intent(out) :: interior_forcings(:) + type(marbl_log_type), intent(inout) :: marbl_status_log + + !----------------------------------------------------------------------- + ! local variables + !----------------------------------------------------------------------- + character(len=*), parameter :: subname = 'marbl_init_mod:marbl_init_interior_forcing_fields' + character(len=char_len) :: log_message + + ! NAG didn't like associating to tracer_metadata(:)%* + character(len=char_len) :: tracer_name + character(len=char_len) :: tracer_units + integer :: id, n + logical :: found + !----------------------------------------------------------------------- + + associate(ind => interior_forcing_indices) + + interior_forcings(:)%metadata%varname = '' + + ! Surface fluxes that influence interior forcing + do id=1,size(interior_forcings) + found = .false. + ! Dust Flux + if (id .eq. ind%dustflux_id) then + found = .true. + interior_forcings(id)%metadata%varname = 'Dust Flux' + interior_forcings(id)%metadata%field_units = 'need_units' + call interior_forcings(id)%set_rank(num_elements, 0, marbl_status_log) + end if + + ! PAR Column Fraction and Shortwave Radiation + if (id .eq. ind%PAR_col_frac_id) then + found = .true. + interior_forcings(id)%metadata%varname = 'PAR Column Fraction' + interior_forcings(id)%metadata%field_units = 'unitless' + call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & + dim1 = num_PAR_subcols) + end if + + if (id .eq. ind%surf_shortwave_id) then + found = .true. + interior_forcings(id)%metadata%varname = 'Surface Shortwave' + interior_forcings(id)%metadata%field_units = 'need_units' ! W/m^2? + call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & + dim1 = num_PAR_subcols) + end if + + + ! Temperature + if (id .eq. ind%temperature_id) then + found = .true. + interior_forcings(id)%metadata%varname = 'Temperature' + interior_forcings(id)%metadata%field_units = 'Degrees C' + call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & + dim1 = num_levels) + end if + + ! Salinity + if (id .eq. ind%salinity_id) then + found = .true. + interior_forcings(id)%metadata%varname = 'Salinity' + interior_forcings(id)%metadata%field_units = 'need_units' + call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & + dim1 = num_levels) + end if + + ! Pressure + if (id .eq. ind%pressure_id) then + found = .true. + interior_forcings(id)%metadata%varname = 'Pressure' + interior_forcings(id)%metadata%field_units = 'need_units' + call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & + dim1 = num_levels) + end if + + ! Iron Sediment Flux + if (id .eq. ind%fesedflux_id) then + found = .true. + interior_forcings(id)%metadata%varname = 'Iron Sediment Flux' + interior_forcings(id)%metadata%field_units = 'need_units' + call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & + dim1 = num_levels) + end if + + ! Interior Tracer Restoring + do n=1,size(ind%tracer_restore_id) + if (id .eq. ind%tracer_restore_id(n)) then + tracer_name = tracer_metadata(n)%short_name + tracer_units = tracer_metadata(n)%units + found = .true. + write(interior_forcings(id)%metadata%varname,"(A,1X,A)") & + trim(tracer_name), 'Restoring Field' + interior_forcings(id)%metadata%field_units = tracer_units + call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & + dim1 = num_levels) + end if + if (id .eq. ind%inv_tau_id(n)) then + found = .true. + write(interior_forcings(id)%metadata%varname,"(A,1X,A)") & + trim(tracer_name), 'Restoring Inverse Timescale' + interior_forcings(id)%metadata%field_units = '1/s' + call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & + dim1 = num_levels) + end if + end do + + ! Check to see if %set_rank() returned an error + if (marbl_status_log%labort_marbl) then + write(log_message, "(2A)") trim(interior_forcings(id)%metadata%varname), & + ' set_rank()' + call marbl_status_log%log_error_trace(log_message, subname) + return + end if + + ! Abort if there was no match between id and the restoring indices + if (.not.found) then + write(log_message, "(A,I0,A)") "Index number ", id, & + " is not associated with a forcing field!" + call marbl_status_log%log_error(log_message, subname) + return + end if + + end do + + end associate + + ! FIXME #26: do we have any forcing fields that are required to be set? + ! If so, check to make sure those indices are not zero here. + + end subroutine marbl_init_interior_forcing_fields + + !***************************************************************************** + +end module marbl_init_mod + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/src/marbl_interface.F90 b/src/marbl_interface.F90 index 2d6fb6bc..eea9b26f 100644 --- a/src/marbl_interface.F90 +++ b/src/marbl_interface.F90 @@ -17,40 +17,34 @@ module marbl_interface ! column test system !----------------------------------------------------------------------- - use marbl_kinds_mod , only : r8, log_kind, int_kind, log_kind, char_len - use marbl_logging , only : marbl_log_type - - use marbl_sizes , only : marbl_total_tracer_cnt - use marbl_sizes , only : autotroph_cnt - use marbl_sizes , only : zooplankton_cnt - use marbl_sizes , only : num_surface_forcing_fields - use marbl_sizes , only : num_interior_forcing_fields - - use marbl_interface_types , only : marbl_domain_type - use marbl_interface_types , only : marbl_tracer_metadata_type - use marbl_interface_types , only : marbl_surface_forcing_output_type - use marbl_interface_types , only : marbl_diagnostics_type - use marbl_interface_types , only : marbl_forcing_fields_type - use marbl_interface_types , only : marbl_saved_state_type - use marbl_interface_types , only : marbl_timers_type - use marbl_interface_types , only : marbl_running_mean_0d_type - - use marbl_internal_types , only : marbl_surface_forcing_indexing_type - use marbl_internal_types , only : marbl_surface_saved_state_indexing_type - use marbl_internal_types , only : marbl_interior_forcing_indexing_type - use marbl_internal_types , only : marbl_interior_saved_state_indexing_type - use marbl_internal_types , only : marbl_PAR_type - use marbl_internal_types , only : marbl_particulate_share_type - use marbl_internal_types , only : marbl_surface_forcing_share_type - use marbl_internal_types , only : marbl_surface_forcing_internal_type - use marbl_internal_types , only : marbl_tracer_index_type - use marbl_internal_types , only : marbl_internal_timers_type - use marbl_internal_types , only : marbl_timer_indexing_type - - - use marbl_config_mod, only : marbl_config_and_parms_type - use marbl_config_mod, only : ciso_on - use marbl_config_mod, only : lvariable_PtoC + use marbl_kinds_mod, only : r8, log_kind, int_kind, log_kind, char_len + + use marbl_settings_mod, only : autotroph_cnt + use marbl_settings_mod, only : zooplankton_cnt + use marbl_settings_mod, only : marbl_settings_type + + use marbl_logging, only : marbl_log_type + + use marbl_interface_public_types, only : marbl_domain_type + use marbl_interface_public_types, only : marbl_tracer_metadata_type + use marbl_interface_public_types, only : marbl_surface_forcing_output_type + use marbl_interface_public_types, only : marbl_diagnostics_type + use marbl_interface_public_types, only : marbl_forcing_fields_type + use marbl_interface_public_types, only : marbl_saved_state_type + use marbl_interface_public_types, only : marbl_timers_type + use marbl_interface_public_types, only : marbl_running_mean_0d_type + + use marbl_interface_private_types, only : marbl_surface_forcing_indexing_type + use marbl_interface_private_types, only : marbl_surface_saved_state_indexing_type + use marbl_interface_private_types, only : marbl_interior_forcing_indexing_type + use marbl_interface_private_types, only : marbl_interior_saved_state_indexing_type + use marbl_interface_private_types, only : marbl_PAR_type + use marbl_interface_private_types, only : marbl_particulate_share_type + use marbl_interface_private_types, only : marbl_surface_forcing_share_type + use marbl_interface_private_types, only : marbl_surface_forcing_internal_type + use marbl_interface_private_types, only : marbl_tracer_index_type + use marbl_interface_private_types, only : marbl_internal_timers_type + use marbl_interface_private_types, only : marbl_timer_indexing_type implicit none @@ -66,12 +60,12 @@ module marbl_interface type, public :: marbl_interface_class ! public data - general - type(marbl_domain_type) , public :: domain - type(marbl_tracer_metadata_type) , public, allocatable :: tracer_metadata(:) - type(marbl_tracer_index_type) , public :: tracer_indices - type(marbl_log_type) , public :: StatusLog - type(marbl_config_and_parms_type) , public :: configuration - type(marbl_config_and_parms_type) , public :: parameters + type(marbl_domain_type) , public :: domain + type(marbl_tracer_metadata_type) , allocatable, public :: tracer_metadata(:) + ! Pointer so that destructor doesn't need to reset all inds to 0 + ! (that happens automatically when new tracer indexing type is allocated) + type(marbl_tracer_index_type) , pointer , public :: tracer_indices => NULL() + type(marbl_log_type) , public :: StatusLog type(marbl_saved_state_type) , public :: surface_saved_state ! input/output type(marbl_saved_state_type) , public :: interior_saved_state ! input/output @@ -100,9 +94,8 @@ module marbl_interface real (r8) , public, allocatable :: glo_avg_fields_surface(:,:) ! output (num_elements,nfields) real (r8) , public, allocatable :: glo_avg_averages_surface(:) ! input (nfields) - ! FIXME - ! for now, running means are being computed in the driver - ! they will eventually be moved from the interface to inside MARBL + ! FIXME #77: for now, running means are being computed in the driver + ! they will eventually be moved from the interface to inside MARBL real (r8) , public, allocatable :: glo_scalar_interior(:) real (r8) , public, allocatable :: glo_scalar_surface(:) @@ -119,12 +112,11 @@ module marbl_interface logical , private :: lallow_glo_ops type(marbl_internal_timers_type) , private :: timers type(marbl_timer_indexing_type) , private :: timer_ids + type(marbl_settings_type) , private :: settings contains - procedure, public :: config procedure, public :: init - procedure, public :: complete_config_and_init procedure, public :: reset_timers procedure, public :: extract_timing procedure, private :: glo_vars_init @@ -133,12 +125,35 @@ module marbl_interface procedure, public :: set_surface_forcing procedure, public :: set_global_scalars procedure, public :: shutdown + generic :: inquire_settings_metadata => inquire_settings_metadata_by_name, & + inquire_settings_metadata_by_id + generic :: put_setting => put_real, & + put_integer, & + put_logical, & + put_string, & ! This routine checks to see if string is actually an array + put_inputfile_line, & ! This line converts string "var = val" to proper put() + put_all_string + generic :: get_setting => get_real, & + get_integer, & + get_logical, & + get_string + procedure, public :: get_settings_var_cnt + procedure, private :: inquire_settings_metadata_by_name + procedure, private :: inquire_settings_metadata_by_id + procedure, private :: put_real + procedure, private :: put_integer + procedure, private :: put_logical + procedure, private :: put_string + procedure, private :: put_inputfile_line + procedure, private :: put_all_string + procedure, private :: get_real + procedure, private :: get_integer + procedure, private :: get_logical + procedure, private :: get_string end type marbl_interface_class - private :: config private :: init - private :: complete_config_and_init private :: reset_timers private :: extract_timing private :: glo_vars_init @@ -152,35 +167,46 @@ module marbl_interface !*********************************************************************** - subroutine config(this, & + subroutine init(this, & + gcm_num_levels, & + gcm_num_PAR_subcols, & + gcm_num_elements_surface_forcing, & + gcm_delta_z, & + gcm_zw, & + gcm_zt, & lgcm_has_global_ops, & - gcm_nl_buffer) + marbl_tracer_cnt) - use marbl_config_mod , only : marbl_config_set_defaults - use marbl_config_mod , only : marbl_config_read_namelist - use marbl_config_mod , only : marbl_define_config_vars + use marbl_init_mod, only : marbl_init_log_and_timers + use marbl_init_mod, only : marbl_init_parameters_pre_tracers + use marbl_init_mod, only : marbl_init_tracers + use marbl_init_mod, only : marbl_init_parameters_post_tracers + use marbl_init_mod, only : marbl_init_bury_coeff + use marbl_init_mod, only : marbl_init_forcing_fields + use marbl_settings_mod, only : marbl_settings_set_all_derived + use marbl_diagnostics_mod, only : marbl_diagnostics_init + use marbl_saved_state_mod, only : marbl_saved_state_init class(marbl_interface_class), intent(inout) :: this - character(len=*), optional, intent(in) :: gcm_nl_buffer(:) - logical, optional, intent(in) :: lgcm_has_global_ops + integer(int_kind), intent(in) :: gcm_num_levels + integer(int_kind), intent(in) :: gcm_num_PAR_subcols + integer(int_kind), intent(in) :: gcm_num_elements_surface_forcing + real(r8), intent(in) :: gcm_delta_z(gcm_num_levels) ! thickness of layer k + real(r8), intent(in) :: gcm_zw(gcm_num_levels) ! thickness of layer k + real(r8), intent(in) :: gcm_zt(gcm_num_levels) ! thickness of layer k + logical, optional, intent(in) :: lgcm_has_global_ops + integer(int_kind), optional, intent(out) :: marbl_tracer_cnt - character(len=*), parameter :: subname = 'marbl_interface:config' - character(len=char_len) :: log_message + character(len=*), parameter :: subname = 'marbl_interface:init' + integer, parameter :: num_interior_elements = 1 ! FIXME #66: get this value from interface, let it vary !-------------------------------------------------------------------- - ! initialize status log + ! initialize status log and timers !-------------------------------------------------------------------- - call this%StatusLog%construct() - call this%StatusLog%log_noerror('', subname) - - !----------------------------------------------------------------------- - ! Set up timers - !----------------------------------------------------------------------- - - call this%timers%setup(this%timer_ids, this%StatusLog) + call marbl_init_log_and_timers(this%timers, this%timer_ids, this%StatusLog) if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace("setup_timers()", subname) + call this%StatusLog%log_error_trace("marbl_init_log_and_timers", subname) return end if @@ -202,92 +228,12 @@ subroutine config(this, & end if !--------------------------------------------------------------------------- - ! set default values for configuration - !--------------------------------------------------------------------------- - - call marbl_config_set_defaults() - - !--------------------------------------------------------------------------- - ! read configuration from namelist (if present) - !--------------------------------------------------------------------------- - - if (present(gcm_nl_buffer)) then - call marbl_config_read_namelist(gcm_nl_buffer, this%StatusLog) - if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace('marbl_config_read_namelist', subname) - return - end if - else - write(log_message, "(2A)") '** No namelists were provided to config, ', & - 'use put() and get() to change configuration variables' - call this%StatusLog%log_noerror(log_message, subname) - end if - - !--------------------------------------------------------------------------- - ! construct configuration_type + ! Initialize parameters that do not depend on tracer count or PFT categories !--------------------------------------------------------------------------- - call marbl_define_config_vars(this%configuration, this%StatusLog) - if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace("marbl_define_config_vars()", subname) - return - end if - - call this%timers%stop(this%timer_ids%init_timer_id, this%StatusLog) - if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace("this%timers%stop()", subname) - return - end if - - end subroutine config - - !*********************************************************************** - - subroutine init(this, & - gcm_num_levels, & - gcm_num_PAR_subcols, & - gcm_num_elements_surface_forcing, & - gcm_delta_z, & - gcm_zw, & - gcm_zt, & - gcm_nl_buffer, & - marbl_tracer_cnt) - - use marbl_ciso_mod , only : marbl_ciso_init_tracer_metadata - use marbl_mod , only : marbl_init_tracer_metadata - use marbl_mod , only : marbl_tracer_index_consistency_check - use marbl_diagnostics_mod , only : marbl_diagnostics_init - use marbl_config_mod , only : ladjust_bury_coeff - use marbl_config_mod , only : autotrophs_config - use marbl_config_mod , only : zooplankton_config - use marbl_config_mod , only : set_derived_config - use marbl_parms , only : marbl_parms_set_defaults - use marbl_parms , only : marbl_parms_read_namelist - use marbl_parms , only : marbl_define_parameters - use marbl_saved_state_mod , only : marbl_saved_state_init - - implicit none - - class(marbl_interface_class), intent(inout) :: this - integer(int_kind), intent(in) :: gcm_num_levels - integer(int_kind), intent(in) :: gcm_num_PAR_subcols - integer(int_kind), intent(in) :: gcm_num_elements_surface_forcing - real(r8), intent(in) :: gcm_delta_z(gcm_num_levels) ! thickness of layer k - real(r8), intent(in) :: gcm_zw(gcm_num_levels) ! thickness of layer k - real(r8), intent(in) :: gcm_zt(gcm_num_levels) ! thickness of layer k - character(len=*), optional, intent(in) :: gcm_nl_buffer(:) - integer(int_kind), optional, intent(out) :: marbl_tracer_cnt - - character(len=*), parameter :: subname = 'marbl_interface:init' - character(len=char_len) :: log_message - - integer :: i - integer, parameter :: num_interior_elements = 1 ! FIXME #66: get this value from interface, let it vary - !-------------------------------------------------------------------- - - call this%timers%start(this%timer_ids%init_timer_id, this%StatusLog) + call marbl_init_parameters_pre_tracers(this%lallow_glo_ops, this%settings, this%StatusLog) if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace("this%timers%start()", subname) + call this%StatusLog%log_error_trace("marbl_init_parameters_pre_tracers", subname) return end if @@ -298,49 +244,9 @@ subroutine init(this, & ) !----------------------------------------------------------------------- - ! Lock and log this%configuration - !----------------------------------------------------------------------- - - call this%configuration%finalize_vars(this%StatusLog) - if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace('configuration%finalize_vars', subname) - return - end if - - call set_derived_config(this%StatusLog) - if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace('set_derived_config', subname) - return - end if - - !----------------------------------------------------------------------- - ! Abort if GCM doesn't support global ops but configuration requires them - !----------------------------------------------------------------------- - - if (ladjust_bury_coeff .and. (.not.this%lallow_glo_ops)) then - write(log_message,'(2A)') 'Can not run with ladjust_bury_coeff = ', & - '.true. unless GCM can perform global operations' - call this%StatusLog%log_error(log_message, subname) - return - end if - - !----------------------------------------------------------------------- - ! Set up tracer indices + ! Set up domain type !----------------------------------------------------------------------- - call this%tracer_indices%construct(ciso_on, lvariable_PtoC, autotrophs_config, & - zooplankton_config) - if (present(marbl_tracer_cnt)) & - marbl_tracer_cnt = marbl_total_tracer_cnt - - !-------------------------------------------------------------------- - ! call constructors and allocate memory - !-------------------------------------------------------------------- - - call this%PAR%construct(num_levels, num_PAR_subcols) - - call this%particulate_share%construct(num_levels) - call this%domain%construct( & num_levels = num_levels, & num_PAR_subcols = num_PAR_subcols, & @@ -350,13 +256,24 @@ subroutine init(this, & zw = gcm_zw, & zt = gcm_zt) - allocate(this%surface_vals(num_surface_elements, marbl_total_tracer_cnt)) + !-------------------------------------------------------------------- + ! call constructors and allocate memory + !-------------------------------------------------------------------- - allocate(this%surface_tracer_fluxes(num_surface_elements, marbl_total_tracer_cnt)) + call this%PAR%construct(num_levels, num_PAR_subcols) - allocate(this%column_tracers(marbl_total_tracer_cnt, num_levels)) + !----------------------------------------------------------------------- + ! Set up tracers + !----------------------------------------------------------------------- - allocate(this%column_dtracers(marbl_total_tracer_cnt, num_levels)) + call marbl_init_tracers(num_levels, num_surface_elements, & + this%tracer_indices, this%surface_vals, this%surface_tracer_fluxes, & + this%column_tracers, this%column_dtracers, this%tracer_metadata, & + this%StatusLog, marbl_tracer_cnt) + if (this%StatusLog%labort_marbl) then + call this%StatusLog%log_error_trace("marbl_init_tracers", subname) + return + end if !-------------------------------------------------------------------- ! set up saved state variables @@ -376,46 +293,6 @@ subroutine init(this, & return end if - !-------------------------------------------------------------------- - ! Initialize public data / general tracer metadata - ! And then update tracer input info based on namelist - !-------------------------------------------------------------------- - - allocate(this%tracer_metadata(marbl_total_tracer_cnt)) - - call marbl_init_tracer_metadata( & - this%tracer_metadata, & - this%tracer_indices, & - this%StatusLog) - - if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace("marbl_init_tracer_metadata()", subname) - return - end if - - if (ciso_on) then - call marbl_ciso_init_tracer_metadata(this%tracer_metadata, & - this%tracer_indices) - end if - - !-------------------------------------------------------------------- - ! Report what tracers are being used, abort if count is not correct - !-------------------------------------------------------------------- - - call this%StatusLog%log_header('MARBL Tracer indices', subname) - do i=1,marbl_total_tracer_cnt - write(log_message, "(I3,2A)") i, '. ', & - trim(this%tracer_metadata(i)%short_name) - call this%StatusLog%log_noerror(log_message, subname) - end do - - call marbl_tracer_index_consistency_check(this%tracer_indices, this%StatusLog) - if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace('marbl_tracer_index_consistency_check', & - subname) - return - end if - !-------------------------------------------------------------------- ! Initialize marbl diagnostics !-------------------------------------------------------------------- @@ -433,39 +310,63 @@ subroutine init(this, & end if !--------------------------------------------------------------------------- - ! set default values for parameters + ! Initialize parameters that depend on tracer count !--------------------------------------------------------------------------- + call marbl_init_parameters_post_tracers(this%settings, this%StatusLog) + if (this%StatusLog%labort_marbl) then + call this%StatusLog%log_error_trace("marbl_init_parameters_post_tracers", subname) + return + end if - call marbl_parms_set_defaults(num_levels) - - !--------------------------------------------------------------------------- - ! read parameters from namelist (if present) - !--------------------------------------------------------------------------- + !----------------------------------------------------------------------- + ! Initialize bury coefficient + !----------------------------------------------------------------------- - if (present(gcm_nl_buffer)) then - call marbl_parms_read_namelist(gcm_nl_buffer, this%StatusLog) - if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace('marbl_parms_read_namelist', subname) - return - end if - else - write(log_message, "(2A)") '** No namelists were provided to init, ', & - 'use put() and get() to change parameters' - call this%StatusLog%log_noerror(log_message, subname) + call marbl_init_bury_coeff(this%particulate_share, num_levels, this%StatusLog) + if (this%StatusLog%labort_marbl) then + call this%StatusLog%log_error_trace('marbl_init_bury_coeff', subname) + return end if end associate - !--------------------------------------------------------------------------- - ! construct parameters_type - !--------------------------------------------------------------------------- + !----------------------------------------------------------------------- + ! Initialize surface and interior forcing (including tracer restoring) + !----------------------------------------------------------------------- + + call marbl_init_forcing_fields(this%domain, & + this%tracer_metadata, & + this%surface_forcing_ind, & + this%surface_forcing_share, & + this%surface_forcing_internal, & + this%surface_input_forcings, & + this%interior_forcing_ind, & + this%interior_input_forcings, & + this%StatusLog) + if (this%StatusLog%labort_marbl) then + call this%StatusLog%log_error_trace("marbl_init_forcing_fields", subname) + return + end if + + ! Set up running mean variables (dependent on parms namelist) + call this%glo_vars_init() - call marbl_define_parameters(this%parameters, this%StatusLog) + ! Lock and log configuration variables and parameters + call this%settings%finalize_vars(this%StatusLog) if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace("marbl_define_parameters()", subname) + call this%StatusLog%log_error_trace('parmeters%finalize_vars', subname) return end if + ! Set variables that depend on previously-set values + ! (Typically unit conversion or string -> int for easy comparison) + call marbl_settings_set_all_derived(this%StatusLog) + if (this%StatusLog%labort_marbl) then + call this%StatusLog%log_error_trace('marbl_settings_set_all_derived', subname) + return + end if + + ! End of initialization call this%timers%stop(this%timer_ids%init_timer_id, this%StatusLog) if (this%StatusLog%labort_marbl) then call this%StatusLog%log_error_trace("this%timers%stop()", subname) @@ -476,137 +377,383 @@ end subroutine init !*********************************************************************** - subroutine complete_config_and_init(this) + subroutine put_real(this, varname, val) - use marbl_parms, only : set_derived_parms - use marbl_parms, only : tracer_restore_vars - use marbl_mod, only : marbl_init_bury_coeff - use marbl_mod, only : marbl_init_surface_forcing_fields - use marbl_mod, only : marbl_init_interior_forcing_fields - use marbl_config_mod, only : lflux_gas_o2 - use marbl_config_mod, only : lflux_gas_co2 - use marbl_config_mod, only : ladjust_bury_coeff + class (marbl_interface_class), intent(inout) :: this + character(len=*), intent(in) :: varname + real(r8), intent(in) :: val - class(marbl_interface_class), intent(inout) :: this + character(len=*), parameter :: subname = 'marbl_interface:put_real' + character(len=char_len) :: log_message - character(len=*), parameter :: subname = 'marbl_interface:complete_config_and_init' - character(len=char_len) :: log_message + call this%settings%put(varname, this%StatusLog, rval=val) + if (this%StatusLog%labort_marbl) then + call this%StatusLog%log_error_trace('settings%put()', subname) + return + end if - integer :: i + end subroutine put_real - call this%timers%start(this%timer_ids%init_timer_id, this%StatusLog) + !*********************************************************************** + + subroutine put_integer(this, varname, val) + + class (marbl_interface_class), intent(inout) :: this + character(len=*), intent(in) :: varname + integer(int_kind), intent(in) :: val + + character(len=*), parameter :: subname = 'marbl_interface:put_integer' + character(len=char_len) :: log_message + + call this%settings%put(varname, this%StatusLog, ival=val) if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace("this%timers%start()", subname) + call this%StatusLog%log_error_trace('settings%put()', subname) return end if - !----------------------------------------------------------------------- - ! Lock and log this%parameters - !----------------------------------------------------------------------- + end subroutine put_integer + + !*********************************************************************** + + subroutine put_logical(this, varname, val) - call this%parameters%finalize_vars(this%StatusLog) + class (marbl_interface_class), intent(inout) :: this + character(len=*), intent(in) :: varname + logical, intent(in) :: val + + character(len=*), parameter :: subname = 'marbl_interface:put_logical' + character(len=char_len) :: log_message + + call this%settings%put(varname, this%StatusLog, lval=val) if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace('parmeters%finalize_list', & - subname) + call this%StatusLog%log_error_trace('settings%put()', subname) return end if - call set_derived_parms(this%StatusLog) + end subroutine put_logical + + !*********************************************************************** + + subroutine put_string(this, varname, val) + + class (marbl_interface_class), intent(inout) :: this + character(len=*), intent(in) :: varname + character(len=*), intent(in) :: val + + character(len=*), parameter :: subname = 'marbl_interface:put_string' + character(len=char_len) :: log_message + + call this%settings%put(varname, this%StatusLog, sval=val) if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace('set_derived_parms', subname) + call this%StatusLog%log_error_trace('settings%put()', subname) return end if - !----------------------------------------------------------------------- - ! Initialize bury coefficient - !----------------------------------------------------------------------- + end subroutine put_string - call marbl_init_bury_coeff(this%particulate_share, this%StatusLog) + !*********************************************************************** + + subroutine put_all_string(this, varname, datatype, val) + ! This interface to put_setting() is called from put_inputfile_line() + + use marbl_settings_mod, only : marbl_settings_string_to_var + + class (marbl_interface_class), intent(inout) :: this + character(len=*), intent(in) :: varname, datatype, val + + character(len=*), parameter :: subname = 'marbl_interface:put_all_string' + character(len=char_len) :: log_message + + real(r8) :: rval + integer(int_kind) :: ival + logical(log_kind) :: lval + + select case (trim(datatype)) + case ('logical') + call marbl_settings_string_to_var(val, this%StatusLog, lval = lval) + if (this%StatusLog%labort_marbl) then + call this%StatusLog%log_error_trace('marbl_settings_string_to_var', subname) + return + end if + call this%settings%put(trim(varname), this%StatusLog, lval=lval) + case ('real') + call marbl_settings_string_to_var(val, this%StatusLog, rval = rval) + if (this%StatusLog%labort_marbl) then + call this%StatusLog%log_error_trace('marbl_settings_string_to_var', subname) + return + end if + call this%settings%put(trim(varname), this%StatusLog, rval=rval) + case ('integer') + call marbl_settings_string_to_var(val, this%StatusLog, ival = ival) + if (this%StatusLog%labort_marbl) then + call this%StatusLog%log_error_trace('marbl_settings_string_to_var', subname) + return + end if + call this%settings%put(trim(varname), this%StatusLog, ival=ival) + case ('string') + call this%settings%put(trim(varname), this%StatusLog, sval=val) + case('unknown') + ! Is val an array? + call this%settings%put(trim(varname), this%StatusLog, uval=val) + case DEFAULT + call this%StatusLog%construct() + write(log_message,"(2A)") trim(datatype), " is not a recognized type" + call this%StatusLog%log_error(log_message, subname) + end select if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace('marbl_init_bury_coeff', subname) + write(log_message, "(3A)") "string_to_var(", trim(val), ")" + call this%StatusLog%log_error_trace(log_message, subname) return end if - associate(& - num_surface_elements => this%domain%num_elements_surface_forcing, & - num_interior_elements => this%domain%num_elements_interior_forcing, & - num_PAR_subcols => this%domain%num_PAR_subcols, & - num_levels => this%domain%km & - ) + end subroutine put_all_string - !----------------------------------------------------------------------- - ! Initialize surface and interior forcing (including tracer restoring) - !----------------------------------------------------------------------- + !*********************************************************************** + + subroutine put_inputfile_line(this, line, pgi_bugfix_var) + + ! This subroutine takes a single line from MARBL's default inputfile format, + ! determines the variable name and whether the value is a scalar or an array, + ! and then calls put_setting (once for a scalar, per-element for an array). + ! + ! The put_setting() call forces the datatype to be "unknown", so when the + ! put list is traversed by add_var the datatype is assumed to match new_entry + ! (and error checking verifies that it is an appropriate value) + + use marbl_utils_mod, only : marbl_utils_str_to_substrs + + class(marbl_interface_class), intent(inout) :: this + character(len=*), intent(in) :: line + ! For some reason PGI doesn't like this particular interface to put_setting() + ! --- Error from building stand-alone driver --- + ! PGF90-S-0155-cannot access PRIVATE type bound procedure + ! put_inputfile_line$tbp (/NO_BACKUP/codes/marbl/tests/driver_src/marbl.F90: 239) + ! + ! But adding another variable to the interface makes it okay + logical, optional, intent(in) :: pgi_bugfix_var(0) + + character(len=char_len), dimension(:), allocatable :: value, line_loc_arr + character(len=char_len) :: varname, var_loc, line_loc + integer(int_kind) :: n, char_ind + + line_loc = '' + ! Strip out comments (denoted by '!'); line_loc_arr(1) is the line to be processed + call marbl_utils_str_to_substrs(line, '!', line_loc_arr) + line_loc = line_loc_arr(1) + + ! Return without processing if + ! (a) line is empty / only contains spaces + if (len_trim(line_loc) .eq. 0) return + ! (b) first non-space character is '&' (can use namelist files) + if (line_loc(1:1) .eq. '&') return + ! (c) line contains only '/' (can use namelist files) + if (trim(line_loc) .eq. '/') return + + ! Everything up to first '=' is varname + varname = '' + do char_ind = 1, len_trim(line_loc) + if (line_loc(char_ind:char_ind) .eq. '=') then + line_loc(char_ind:char_ind) = ' ' + exit + end if + varname(char_ind:char_ind) = line_loc(char_ind:char_ind) + line_loc(char_ind:char_ind) = ' ' + end do + + ! Everything to the right of the first '=' is the variable value, which might be an array + call marbl_utils_str_to_substrs(line_loc, ',', value) + var_loc = varname + do n=1, size(value) + if (size(value) .gt. 1) write(var_loc, "(2A,I0,A)") trim(varname), '(', n, ')' + call this%put_setting(var_loc, "unknown", value(n)) + end do + deallocate(value) + + end subroutine put_inputfile_line + + !*********************************************************************** + + subroutine get_real(this, varname, val) - call this%surface_forcing_ind%construct(ciso_on, lflux_gas_o2, lflux_gas_co2, ladjust_bury_coeff) - call this%interior_forcing_ind%construct(this%tracer_metadata%short_name, & - tracer_restore_vars, this%StatusLog) + class (marbl_interface_class), intent(inout) :: this + character(len=*), intent(in) :: varname + real(r8), intent(out) :: val + + character(len=*), parameter :: subname = 'marbl_interface:get_real' + character(len=char_len) :: log_message + + call this%settings%get(varname, this%StatusLog, rval=val) if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace("interior_forcing_ind%construct", & - subname) + call this%StatusLog%log_error_trace('settings%get()', subname) return end if - call this%surface_forcing_share%construct(num_surface_elements) - call this%surface_forcing_internal%construct(num_surface_elements) + end subroutine get_real + + !*********************************************************************** + + subroutine get_integer(this, varname, val) + + class (marbl_interface_class), intent(inout) :: this + character(len=*), intent(in) :: varname + integer(int_kind), intent(out) :: val - allocate(this%surface_input_forcings(num_surface_forcing_fields)) - call marbl_init_surface_forcing_fields( & - num_elements = num_surface_elements, & - surface_forcing_indices = this%surface_forcing_ind, & - surface_forcings = this%surface_input_forcings, & - marbl_status_log = this%StatusLog) + character(len=*), parameter :: subname = 'marbl_interface:get_integer' + character(len=char_len) :: log_message + + call this%settings%get(varname, this%StatusLog, ival=val) if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace("marbl_init_surface_forcing_fields()", subname) + call this%StatusLog%log_error_trace('settings%get()', subname) return end if - allocate(this%interior_input_forcings(num_interior_forcing_fields)) - call marbl_init_interior_forcing_fields( & - num_elements = num_interior_elements, & - interior_forcing_indices = this%interior_forcing_ind, & - tracer_metadata = this%tracer_metadata, & - num_PAR_subcols = this%domain%num_PAR_subcols, & - num_levels = this%domain%km, & - interior_forcings = this%interior_input_forcings, & - marbl_status_log = this%StatusLog) + end subroutine get_integer + + !*********************************************************************** + + subroutine get_logical(this, varname, val) + + class (marbl_interface_class), intent(inout) :: this + character(len=*), intent(in) :: varname + logical, intent(out) :: val + + character(len=*), parameter :: subname = 'marbl_interface:get_logical' + character(len=char_len) :: log_message + + call this%settings%get(varname, this%StatusLog, lval=val) if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace("marbl_init_interior_forcing_fields()", & - subname) + call this%StatusLog%log_error_trace('settings%get()', subname) return end if - end associate + end subroutine get_logical - !-------------------------------------------------------------------- - ! Report what forcings are required from the driver - !-------------------------------------------------------------------- + !*********************************************************************** - call this%StatusLog%log_header('MARBL-Required Forcing Fields', subname) - call this%StatusLog%log_noerror('Surface:', subname) - do i=1,num_surface_forcing_fields - write(log_message, "(2A)") '* ', trim(this%surface_input_forcings(i)%metadata%varname) - call this%StatusLog%log_noerror(log_message, subname) - end do + subroutine get_string(this, varname, val, linputfile_format) - call this%StatusLog%log_noerror('', subname) - call this%StatusLog%log_noerror('Interior:', subname) - do i=1,num_interior_forcing_fields - write(log_message, "(2A)") '* ', trim(this%interior_input_forcings(i)%metadata%varname) - call this%StatusLog%log_noerror(log_message, subname) - end do + class (marbl_interface_class), intent(inout) :: this + character(len=*), intent(in) :: varname + character(len=*), intent(out) :: val + logical, optional, intent(in) :: linputfile_format + + character(len=*), parameter :: subname = 'marbl_interface:get_string' + character(len=char_len) :: log_message + + logical :: linputfile_format_loc + character(len=char_len) :: datatype + real(r8) :: rval + integer :: ival + logical :: lval + character(len=char_len) :: sval + + val = '' + if (present(linputfile_format)) then + linputfile_format_loc = linputfile_format + else + linputfile_format_loc = .false. + end if - ! Set up running mean variables (dependent on parms namelist) - call this%glo_vars_init() + if (linputfile_format_loc) then + ! Determine datatype + call this%inquire_settings_metadata(varname, datatype=datatype) + if (this%StatusLog%labort_marbl) then + call this%StatusLog%log_error_trace('inquire_settings_metadata', subname) + return + end if + select case (trim(datatype)) + case ('real') + call this%settings%get(varname, this%StatusLog, rval=rval) + write(val, "(A,' = ', E24.16)") trim(varname), rval + case ('integer') + call this%settings%get(varname, this%StatusLog, ival=ival) + write(val, "(A, ' = ', I0)") trim(varname), ival + case ('logical') + call this%settings%get(varname, this%StatusLog, lval=lval) + write(val, "(A, ' = ', L1)") trim(varname), lval + case ('string') + call this%settings%get(varname, this%StatusLog, sval=sval) + write(val, "(A, ' = ', 3A)") trim(varname), "'", trim(sval), "'" + case DEFAULT + write(log_message, "(3A)") "Unknown datatype '", trim(datatype), & + "' returned from inquire_settings_metadata()" + call this%StatusLog%log_error(log_message, subname) + return + end select + else + call this%settings%get(varname, this%StatusLog, sval=val) + end if ! linputfile_format_loc - ! End of initialization - call this%timers%stop(this%timer_ids%init_timer_id, this%StatusLog) if (this%StatusLog%labort_marbl) then - call this%StatusLog%log_error_trace("this%timers%stop()", subname) + call this%StatusLog%log_error_trace('settings%get()', subname) + end if + + end subroutine get_string + + !*********************************************************************** + + function get_settings_var_cnt(this) result(cnt) + + class (marbl_interface_class), intent(in) :: this + integer :: cnt + + cnt = this%settings%get_cnt() + + end function get_settings_var_cnt + + !*********************************************************************** + + subroutine inquire_settings_metadata_by_name(this, varname, id, lname, units, datatype) + + class (marbl_interface_class), intent(inout) :: this + character(len=*), intent(in) :: varname + integer(int_kind), optional, intent(out) :: id + character(len=*), optional, intent(out) :: lname, units, datatype + + character(len=*), parameter :: subname = 'marbl_interface:inquire_settings_metadata_by_name' + integer :: id_loc + + id_loc = this%settings%inquire_id(varname, this%StatusLog) + if (this%StatusLog%labort_marbl) then + call this%StatusLog%log_error_trace('settings%inquire_id', subname) + return + end if + if (present(id)) id = id_loc + if (any((/present(lname), present(units), present(datatype)/))) then + call this%settings%inquire_metadata(id_loc, this%StatusLog, & + lname = lname, & + units = units, & + datatype = datatype) + if (this%StatusLog%labort_marbl) then + call this%StatusLog%log_error_trace('settings%inquire_metadata', subname) + return + end if + end if + + end subroutine inquire_settings_metadata_by_name + + !*********************************************************************** + + subroutine inquire_settings_metadata_by_id(this, id, sname, lname, units, datatype) + + class (marbl_interface_class), intent(inout) :: this + integer(int_kind), intent(in) :: id + character(len=*), optional, intent(out) :: sname, lname, units + character(len=*), optional, intent(out) :: datatype + + character(len=*), parameter :: subname = 'marbl_interface:inquire_settings_metadata_by_id' + + call this%settings%inquire_metadata(id, this%StatusLog, & + sname = sname, & + lname = lname, & + units = units, & + datatype = datatype) + if (this%StatusLog%labort_marbl) then + call this%StatusLog%log_error_trace('settings%inquire_metadata', subname) return end if - end subroutine complete_config_and_init + end subroutine inquire_settings_metadata_by_id !*********************************************************************** @@ -806,13 +953,68 @@ end subroutine set_global_scalars subroutine shutdown(this) + use marbl_settings_mod, only : max_grazer_prey_cnt + use marbl_settings_mod, only : autotrophs + use marbl_settings_mod, only : zooplankton + use marbl_settings_mod, only : grazing + use marbl_settings_mod, only : tracer_restore_vars + use marbl_diagnostics_mod, only : marbl_interior_diag_ind + implicit none class(marbl_interface_class), intent(inout) :: this character(len=*), parameter :: subname = 'marbl_interface:shutdown' + integer(int_kind) :: m,n + + if (allocated(this%glo_avg_fields_interior)) then + deallocate(this%glo_avg_fields_interior) + deallocate(this%glo_avg_averages_interior) + deallocate(this%glo_avg_fields_surface) + deallocate(this%glo_avg_averages_surface) + deallocate(this%glo_scalar_interior) + deallocate(this%glo_scalar_surface) + deallocate(this%glo_avg_rmean_interior) + deallocate(this%glo_avg_rmean_surface) + deallocate(this%glo_scalar_rmean_interior) + deallocate(this%glo_scalar_rmean_surface) + end if ! free dynamically allocated memory, etc + ! FIXME #69: this is not ideal for threaded runs + if (allocated(autotrophs)) then + deallocate(autotrophs) + deallocate(zooplankton) + do m=1,max_grazer_prey_cnt + do n=1,zooplankton_cnt + deallocate(grazing(m,n)%auto_ind) + deallocate(grazing(m,n)%zoo_ind) + end do + end do + deallocate(grazing) + end if + call marbl_interior_diag_ind%destruct() + + if (allocated(this%interior_input_forcings)) then + deallocate(this%interior_input_forcings) + deallocate(this%surface_input_forcings) + end if + call this%surface_forcing_internal%destruct() + call this%surface_forcing_share%destruct() + if (allocated(this%surface_vals)) then + deallocate(this%surface_vals) + deallocate(this%surface_tracer_fluxes) + deallocate(this%column_tracers) + deallocate(this%column_dtracers) + deallocate(this%tracer_metadata) + deallocate(tracer_restore_vars) + end if + call this%tracer_indices%destruct() + deallocate(this%tracer_indices) + call this%settings%destruct() + call this%particulate_share%destruct() + call this%PAR%destruct() + call this%domain%destruct() call this%timers%shutdown(this%timer_ids, this%timer_summary, this%StatusLog) if (this%StatusLog%labort_marbl) then @@ -833,7 +1035,7 @@ function get_tracer_index(this, tracer_name) integer :: n get_tracer_index = 0 - do n=1,marbl_total_tracer_cnt + do n=1,this%tracer_indices%total_cnt if (trim(tracer_name).eq.trim(this%tracer_metadata(n)%short_name) .or. & trim(tracer_name).eq.trim(this%tracer_metadata(n)%long_name)) then get_tracer_index = n diff --git a/src/marbl_internal_types.F90 b/src/marbl_interface_private_types.F90 similarity index 60% rename from src/marbl_internal_types.F90 rename to src/marbl_interface_private_types.F90 index f8ee25b0..53b57221 100644 --- a/src/marbl_internal_types.F90 +++ b/src/marbl_interface_private_types.F90 @@ -1,4 +1,4 @@ -module marbl_internal_types +module marbl_interface_private_types ! module definitions of types that are internal to marbl @@ -7,10 +7,6 @@ module marbl_internal_types use marbl_kinds_mod, only : int_kind use marbl_kinds_mod, only : char_len - use marbl_sizes, only : autotroph_cnt - use marbl_sizes, only : zooplankton_cnt - use marbl_sizes, only : max_prey_class_size - use marbl_logging, only : marbl_log_type use marbl_timing_mod, only : marbl_internal_timers_type @@ -20,84 +16,6 @@ module marbl_internal_types private - !**************************************************************************** - ! derived types for zooplankton - - type, public :: zooplankton_config_type - character(len=char_len) :: sname - character(len=char_len) :: lname - end type zooplankton_config_type - - type, public :: zooplankton_parms_type - real (KIND=r8) :: z_mort_0_per_day ! zoo linear mort rate (1/day) - real (KIND=r8) :: z_mort_0 ! zoo linear mort rate (1/sec) (derived from z_mort_0_per_day) - real (KIND=r8) :: z_mort2_0_per_day ! zoo quad mort rate (1/day/((mmol C/m3)) - real (KIND=r8) :: z_mort2_0 ! zoo quad mort rate (1/sec/((mmol C/m3)) (derived from z_mort2_0_per_day) - real (KIND=r8) :: loss_thres ! zoo conc. where losses go to zero - end type zooplankton_parms_type - - !**************************************************************************** - ! derived types for autotrophs - - type, public :: autotroph_config_type - character(len=char_len) :: sname - character(len=char_len) :: lname - logical (KIND=log_kind) :: Nfixer ! flag set to true if this autotroph fixes N2 - logical (KIND=log_kind) :: imp_calcifier ! flag set to true if this autotroph implicitly handles calcification - logical (KIND=log_kind) :: exp_calcifier ! flag set to true if this autotroph explicitly handles calcification - logical (KIND=log_kind) :: silicifier ! flag set to true if this autotroph is a silicifier - end type autotroph_config_type - - type, public :: autotroph_parms_type - real (KIND=r8) :: kFe, kPO4, kDOP, kNO3, kNH4, kSiO3 ! nutrient uptake half-sat constants - real (KIND=r8) :: Qp_fixed ! P/C ratio for fixed P/C ratios - real (KIND=r8) :: gQfe_0, gQfe_min ! initial and minimum Fe/C ratio for growth - real (KIND=r8) :: alphaPI_per_day ! init slope of P_I curve (GD98) (mmol C m^2/(mg Chl W day)) - real (KIND=r8) :: alphaPI ! init slope of P_I curve (GD98) (mmol C m^2/(mg Chl W sec)) - ! (derived from alphaPI_per_day) - real (KIND=r8) :: PCref_per_day ! max C-spec. grth rate at tref (1/day) - real (KIND=r8) :: PCref ! max C-spec. grth rate at tref (1/sec) (derived from PCref_per_day) - real (KIND=r8) :: thetaN_max ! max thetaN (Chl/N) (mg Chl/mmol N) - real (KIND=r8) :: loss_thres, loss_thres2 ! conc. where losses go to zero - real (KIND=r8) :: temp_thres ! Temp. where concentration threshold and photosynth. rate drops - real (KIND=r8) :: mort_per_day, mort2_per_day ! linear and quadratic mortality rates (1/day), (1/day/((mmol C/m3)) - real (KIND=r8) :: mort, mort2 ! linear and quadratic mortality rates (1/sec), (1/sec/((mmol C/m3)) - ! (derived from mort_per_day and mort2_per_day) - real (KIND=r8) :: agg_rate_max, agg_rate_min ! max and min agg. rate (1/d) - real (KIND=r8) :: loss_poc ! routing of loss term - end type autotroph_parms_type - - !**************************************************************************** - ! derived types for grazing - - type, public :: grazing_config_type - character(len=char_len) :: sname - character(len=char_len) :: lname - integer (KIND=int_kind) :: auto_ind_cnt ! number of autotrophs in prey-clase auto_ind - integer (KIND=int_kind) :: zoo_ind_cnt ! number of zooplankton in prey-clase zoo_ind - end type grazing_config_type - - type, public :: grazing_parms_type - integer (KIND=int_kind) :: grazing_function ! functional form of grazing parameterization - real (KIND=r8) :: z_umax_0_per_day ! max zoo growth rate at tref (1/day) - real (KIND=r8) :: z_umax_0 ! max zoo growth rate at tref (1/sec) (derived from z_umax_0_per_day) - real (KIND=r8) :: z_grz ! grazing coef. (mmol C/m^3)^2 - real (KIND=r8) :: graze_zoo ! routing of grazed term, remainder goes to dic - real (KIND=r8) :: graze_poc ! routing of grazed term, remainder goes to dic - real (KIND=r8) :: graze_doc ! routing of grazed term, remainder goes to dic - real (KIND=r8) :: f_zoo_detr ! fraction of zoo losses to detrital - ! FIXME #78: we want auto_ind and zoo_ind to be allocatable, but gfortran - ! does not support having derived types with allocatable components - ! in a namelist (at least as of 5.2.0). Eventually these two - ! components should be made allocatable and then we can - ! (1) remove max_prey_class_size from marbl_sizes - ! (2) uncomment the constructor for this class - integer (KIND=int_kind), dimension(max_prey_class_size) :: auto_ind - integer (KIND=int_kind), dimension(max_prey_class_size) :: zoo_ind -! contains -! procedure, public :: construct => grazing_parms_constructor - end type grazing_parms_type - !**************************************************************************** ! derived type for PAR computation @@ -154,6 +72,7 @@ module marbl_internal_types real (r8), allocatable, dimension(:) :: nhx_surface_emis contains procedure, public :: construct => marbl_surface_forcing_internal_constructor + procedure, public :: destruct => marbl_surface_forcing_internal_destructor end type marbl_surface_forcing_internal_type !**************************************************************************** @@ -176,40 +95,6 @@ module marbl_internal_types !*********************************************************************** - type, public :: marbl_zooplankton_share_type - real(r8) :: zooC_loc_fields ! local copy of model zooC - real(r8) :: zoo_loss_fields ! mortality & higher trophic grazing on zooplankton (mmol C/m^3/sec) - real(r8) :: zoo_loss_poc_fields ! zoo_loss routed to large detrital (mmol C/m^3/sec) - real(r8) :: zoo_loss_doc_fields ! zoo_loss routed to doc (mmol C/m^3/sec) - real(r8) :: zoo_loss_dic_fields ! zoo_loss routed to dic (mmol C/m^3/sec) - end type marbl_zooplankton_share_type - - !*********************************************************************** - - type, public :: marbl_autotroph_share_type - real(r8) :: autotrophChl_loc_fields ! local copy of model autotroph Chl - real(r8) :: autotrophC_loc_fields ! local copy of model autotroph C - real(r8) :: autotrophFe_loc_fields ! local copy of model autotroph Fe - real(r8) :: autotrophSi_loc_fields ! local copy of model autotroph Si - real(r8) :: autotrophCaCO3_loc_fields ! local copy of model autotroph CaCO3 - real(r8) :: QCaCO3_fields ! small phyto CaCO3/C ratio (mmol CaCO3/mmol C) - real(r8) :: auto_graze_fields ! autotroph grazing rate (mmol C/m^3/sec) - real(r8) :: auto_graze_zoo_fields ! auto_graze routed to zoo (mmol C/m^3/sec) - real(r8) :: auto_graze_poc_fields ! auto_graze routed to poc (mmol C/m^3/sec) - real(r8) :: auto_graze_doc_fields ! auto_graze routed to doc (mmol C/m^3/sec) - real(r8) :: auto_graze_dic_fields ! auto_graze routed to dic (mmol C/m^3/sec) - real(r8) :: auto_loss_fields ! autotroph non-grazing mort (mmol C/m^3/sec) - real(r8) :: auto_loss_poc_fields ! auto_loss routed to poc (mmol C/m^3/sec) - real(r8) :: auto_loss_doc_fields ! auto_loss routed to doc (mmol C/m^3/sec) - real(r8) :: auto_loss_dic_fields ! auto_loss routed to dic (mmol C/m^3/sec) - real(r8) :: auto_agg_fields ! autotroph aggregation (mmol C/m^3/sec) - real(r8) :: photoC_fields ! C-fixation (mmol C/m^3/sec) - real(r8) :: CaCO3_form_fields ! calcification of CaCO3 by small phyto (mmol CaCO3/m^3/sec) - real(r8) :: PCphoto_fields ! C-specific rate of photosynth. (1/sec) - end type marbl_autotroph_share_type - - !*********************************************************************** - type, public :: marbl_particulate_share_type type(column_sinking_particle_type) :: POC ! base units = nmol C type(column_sinking_particle_type) :: POP ! base units = nmol P @@ -257,72 +142,6 @@ module marbl_internal_types !***************************************************************************** - type, public :: autotroph_secondary_species_type - real (r8) :: thetaC ! current Chl/C ratio (mg Chl/mmol C) - real (r8) :: QCaCO3 ! current CaCO3/C ratio (mmol CaCO3/mmol C) - real (r8) :: Qp ! current P/C ratio (mmol P/mmol C) - real (r8) :: gQp ! P/C for growth - real (r8) :: Qfe ! current Fe/C ratio (mmol Fe/mmol C) - real (r8) :: gQfe ! fe/C for growth - real (r8) :: Qsi ! current Si/C ratio (mmol Si/mmol C) - real (r8) :: gQsi ! diatom Si/C ratio for growth (new biomass) - real (r8) :: VNO3 ! NH4 uptake rate (non-dim) - real (r8) :: VNH4 ! NO3 uptake rate (non-dim) - real (r8) :: VNtot ! total N uptake rate (non-dim) - real (r8) :: NO3_V ! nitrate uptake (mmol NO3/m^3/sec) - real (r8) :: NH4_V ! ammonium uptake (mmol NH4/m^3/sec) - real (r8) :: PO4_V ! PO4 uptake (mmol PO4/m^3/sec) - real (r8) :: DOP_V ! DOP uptake (mmol DOP/m^3/sec) - real (r8) :: VPO4 ! C-specific PO4 uptake (non-dim) - real (r8) :: VDOP ! C-specific DOP uptake rate (non-dim) - real (r8) :: VPtot ! total P uptake rate (non-dim) - real (r8) :: f_nut ! nut limitation factor, modifies C fixation (non-dim) - real (r8) :: VFe ! C-specific Fe uptake (non-dim) - real (r8) :: VSiO3 ! C-specific SiO3 uptake (non-dim) - real (r8) :: light_lim ! light limitation factor - real (r8) :: PCphoto ! C-specific rate of photosynth. (1/sec) - real (r8) :: photoC ! C-fixation (mmol C/m^3/sec) - real (r8) :: photoFe ! iron uptake - real (r8) :: photoSi ! silicon uptake (mmol Si/m^3/sec) - real (r8) :: photoacc ! Chl synth. term in photoadapt. (GD98) (mg Chl/m^3/sec) - real (r8) :: auto_loss ! autotroph non-grazing mort (mmol C/m^3/sec) - real (r8) :: auto_loss_poc ! auto_loss routed to poc (mmol C/m^3/sec) - real (r8) :: auto_loss_doc ! auto_loss routed to doc (mmol C/m^3/sec) - real (r8) :: auto_loss_dic ! auto_loss routed to dic (mmol C/m^3/sec) - real (r8) :: auto_agg ! autotroph aggregation (mmol C/m^3/sec) - real (r8) :: auto_graze ! autotroph grazing rate (mmol C/m^3/sec) - real (r8) :: auto_graze_zoo ! auto_graze routed to zoo (mmol C/m^3/sec) - real (r8) :: auto_graze_poc ! auto_graze routed to poc (mmol C/m^3/sec) - real (r8) :: auto_graze_doc ! auto_graze routed to doc (mmol C/m^3/sec) - real (r8) :: auto_graze_dic ! auto_graze routed to dic (mmol C/m^3/sec) - real (r8) :: Pprime ! used to limit autotroph mort at low biomass (mmol C/m^3) - real (r8) :: CaCO3_form ! calcification of CaCO3 by small phyto (mmol CaCO3/m^3/sec) - real (r8) :: Nfix ! total Nitrogen fixation (mmol N/m^3/sec) - real (r8) :: Nexcrete ! fixed N excretion - real (r8) :: remaining_P_dop ! remaining_P from grazing routed to DOP pool - real (r8) :: remaining_P_pop ! remaining_P from grazing routed to POP pool - real (r8) :: remaining_P_dip ! remaining_P from grazing routed to remin - end type autotroph_secondary_species_type - - !***************************************************************************** - - type, public :: zooplankton_secondary_species_type - real (r8):: f_zoo_detr ! frac of zoo losses into large detrital pool (non-dim) - real (r8):: x_graze_zoo ! {auto, zoo}_graze routed to zoo (mmol C/m^3/sec) - real (r8):: zoo_graze ! zooplankton losses due to grazing (mmol C/m^3/sec) - real (r8):: zoo_graze_zoo ! grazing of zooplankton routed to zoo (mmol C/m^3/sec) - real (r8):: zoo_graze_poc ! grazing of zooplankton routed to poc (mmol C/m^3/sec) - real (r8):: zoo_graze_doc ! grazing of zooplankton routed to doc (mmol C/m^3/sec) - real (r8):: zoo_graze_dic ! grazing of zooplankton routed to dic (mmol C/m^3/sec) - real (r8):: zoo_loss ! mortality & higher trophic grazing on zooplankton (mmol C/m^3/sec) - real (r8):: zoo_loss_poc ! zoo_loss routed to poc (mmol C/m^3/sec) - real (r8):: zoo_loss_doc ! zoo_loss routed to doc (mmol C/m^3/sec) - real (r8):: zoo_loss_dic ! zoo_loss routed to dic (mmol C/m^3/sec) - real (r8):: Zprime ! used to limit zoo mort at low biomass (mmol C/m^3) - end type zooplankton_secondary_species_type - - !***************************************************************************** - type, public :: dissolved_organic_matter_type real (r8) :: DOC_prod ! production of DOC (mmol C/m^3/sec) real (r8) :: DOC_remin ! remineralization of DOC (mmol C/m^3/sec) @@ -365,12 +184,24 @@ module marbl_internal_types !***************************************************************************** - type, public :: marbl_tracer_index_type + type, private :: marbl_tracer_count_type + ! Total count + integer(int_kind) :: cnt = 0 ! Index ranges - integer (int_kind) :: ecosys_base_ind_beg - integer (int_kind) :: ecosys_base_ind_end - integer (int_kind) :: ciso_ind_beg - integer (int_kind) :: ciso_ind_end + integer(int_kind) :: ind_beg = 0 + integer(int_kind) :: ind_end = 0 + contains + procedure, public :: update_count + procedure, public :: reset => tracer_count_reset + end type marbl_tracer_count_type + + !***************************************************************************** + + type, public :: marbl_tracer_index_type + ! Book-keeping (tracer count and index ranges) + integer (int_kind) :: total_cnt = 0 + type (marbl_tracer_count_type) :: ecosys_base + type (marbl_tracer_count_type) :: ciso ! General tracers integer (int_kind) :: po4_ind = 0 ! dissolved inorganic phosphate @@ -398,8 +229,8 @@ module marbl_internal_types integer (int_kind) :: do14c_ind = 0 ! dissolved organic carbon 14 ! Living tracers - type(marbl_living_tracer_index_type), dimension(autotroph_cnt) :: auto_inds - type(marbl_living_tracer_index_type), dimension(zooplankton_cnt) :: zoo_inds + type(marbl_living_tracer_index_type), allocatable :: auto_inds(:) + type(marbl_living_tracer_index_type), allocatable :: zoo_inds(:) ! For CISO, don't want individual C13 and C14 tracers for each zooplankton ! Instead we collect them into one tracer for each isotope, regardless of ! zooplankton_cnt @@ -407,7 +238,9 @@ module marbl_internal_types integer (int_kind) :: zoo14C_ind = 0 ! zooplankton carbon 14 contains + procedure, public :: add_tracer_index procedure, public :: construct => tracer_index_constructor + procedure, public :: destruct => tracer_index_destructor end type marbl_tracer_index_type !**************************************************************************** @@ -486,7 +319,9 @@ module marbl_internal_types !*********************************************************************** subroutine column_sinking_particle_constructor(this, num_levels) - class(column_sinking_particle_type), intent(inout) :: this + + class(column_sinking_particle_type), intent(out) :: this + integer (int_kind) :: num_levels allocate(this%sflux_in (num_levels)) @@ -496,10 +331,15 @@ subroutine column_sinking_particle_constructor(this, num_levels) allocate(this%hflux_out(num_levels)) allocate(this%sed_loss (num_levels)) allocate(this%remin (num_levels)) + end subroutine column_sinking_particle_constructor + !*********************************************************************** + subroutine column_sinking_particle_destructor(this) + class(column_sinking_particle_type), intent(inout) :: this + integer (int_kind) :: num_levels deallocate(this%sflux_in) @@ -509,12 +349,15 @@ subroutine column_sinking_particle_destructor(this) deallocate(this%hflux_out) deallocate(this%sed_loss) deallocate(this%remin) + end subroutine column_sinking_particle_destructor !*********************************************************************** subroutine marbl_particulate_share_constructor(this, num_levels) - class(marbl_particulate_share_type), intent(inout) :: this + + class(marbl_particulate_share_type), intent(out) :: this + integer (int_kind) :: num_levels allocate(this%decay_CaCO3_fields (num_levels)) @@ -538,9 +381,13 @@ subroutine marbl_particulate_share_constructor(this, num_levels) call this%P_SiO2%construct (num_levels) call this%P_iron%construct (num_levels) call this%dust%construct (num_levels) + end subroutine marbl_particulate_share_constructor + !*********************************************************************** + subroutine marbl_particulate_share_destructor(this) + class(marbl_particulate_share_type), intent(inout) :: this deallocate(this%decay_CaCO3_fields) @@ -564,12 +411,15 @@ subroutine marbl_particulate_share_destructor(this) call this%P_SiO2%destruct() call this%P_iron%destruct() call this%dust%destruct() + end subroutine marbl_particulate_share_destructor !*********************************************************************** subroutine marbl_surface_forcing_share_constructor(this, num_elements) - class(marbl_surface_forcing_share_type), intent(inout) :: this + + class(marbl_surface_forcing_share_type), intent(out) :: this + integer (int_kind) , intent(in) :: num_elements allocate(this%PV_SURF_fields (num_elements)) ! piston velocity (cm/s) @@ -577,46 +427,59 @@ subroutine marbl_surface_forcing_share_constructor(this, num_elements) allocate(this%CO2STAR_SURF_fields (num_elements)) ! CO2STAR from solver allocate(this%DCO2STAR_SURF_fields (num_elements)) ! DCO2STAR from solver allocate(this%CO3_SURF_fields (num_elements)) ! Surface carbonate ion + end subroutine marbl_surface_forcing_share_constructor - subroutine marbl_surface_forcing_share_destructor(this, num_elements) + !*********************************************************************** + + subroutine marbl_surface_forcing_share_destructor(this) + class(marbl_surface_forcing_share_type), intent(inout) :: this - integer (int_kind) , intent(in) :: num_elements - deallocate(this%PV_SURF_fields ) ! piston velocity (cm/s) - deallocate(this%DIC_SURF_fields ) ! Surface values of DIC for solver - deallocate(this%CO2STAR_SURF_fields ) ! CO2STAR from solver - deallocate(this%DCO2STAR_SURF_fields) ! DCO2STAR from solver - deallocate(this%CO3_SURF_fields ) ! Surface carbonate ion - end subroutine marbl_surface_forcing_share_destructor + if (allocated(this%PV_SURF_fields)) then + deallocate(this%PV_SURF_fields ) ! piston velocity (cm/s) + deallocate(this%DIC_SURF_fields ) ! Surface values of DIC for solver + deallocate(this%CO2STAR_SURF_fields ) ! CO2STAR from solver + deallocate(this%DCO2STAR_SURF_fields) ! DCO2STAR from solver + deallocate(this%CO3_SURF_fields ) ! Surface carbonate ion + end if + + end subroutine !***************************************************************************** subroutine marbl_PAR_constructor(this, num_levels, num_PAR_subcols) - class(marbl_PAR_type) , intent(inout) :: this - integer , intent(in) :: num_levels - integer , intent(in) :: num_PAR_subcols + + class(marbl_PAR_type), intent(out) :: this + integer, intent(in) :: num_levels + integer, intent(in) :: num_PAR_subcols allocate(this%interface(0:num_levels,num_PAR_subcols)) allocate(this%avg ( num_levels,num_PAR_subcols)) allocate(this%KPARdz ( num_levels )) allocate(this%col_frac ( num_PAR_subcols)) + end subroutine marbl_PAR_constructor + !***************************************************************************** + subroutine marbl_PAR_destructor(this) + class(marbl_PAR_type) , intent(inout) :: this deallocate(this%interface) deallocate(this%avg ) deallocate(this%KPARdz ) deallocate(this%col_frac ) + end subroutine marbl_PAR_destructor !*********************************************************************** subroutine marbl_surface_forcing_internal_constructor(this, num_elements) - class(marbl_surface_forcing_internal_type) , intent(inout) :: this - integer (int_kind) , intent(in) :: num_elements + + class(marbl_surface_forcing_internal_type), intent(out) :: this + integer (int_kind), intent(in) :: num_elements allocate(this%piston_velocity (num_elements)) allocate(this%flux_co2 (num_elements)) @@ -636,185 +499,278 @@ subroutine marbl_surface_forcing_internal_constructor(this, num_elements) allocate(this%pv_co2 (num_elements)) allocate(this%o2sat (num_elements)) allocate(this%nhx_surface_emis(num_elements)) + end subroutine marbl_surface_forcing_internal_constructor + !*********************************************************************** + + subroutine marbl_surface_forcing_internal_destructor(this) + + class(marbl_surface_forcing_internal_type) , intent(inout) :: this + + if (allocated(this%piston_velocity)) then + deallocate(this%piston_velocity ) + deallocate(this%flux_co2 ) + deallocate(this%flux_alt_co2 ) + deallocate(this%co2star ) + deallocate(this%dco2star ) + deallocate(this%pco2surf ) + deallocate(this%dpco2 ) + deallocate(this%co3 ) + deallocate(this%co2star_alt ) + deallocate(this%dco2star_alt ) + deallocate(this%pco2surf_alt ) + deallocate(this%dpco2_alt ) + deallocate(this%schmidt_co2 ) + deallocate(this%schmidt_o2 ) + deallocate(this%pv_o2 ) + deallocate(this%pv_co2 ) + deallocate(this%o2sat ) + deallocate(this%nhx_surface_emis) + end if + + end subroutine marbl_surface_forcing_internal_destructor + !***************************************************************************** - subroutine tracer_index_constructor(this, ciso_on, lvariable_PtoC, autotrophs_config, & - zooplankton_config) + subroutine tracer_index_constructor(this, ciso_on, lvariable_PtoC, autotrophs, & + zooplankton, marbl_status_log, marbl_tracer_cnt) ! This subroutine sets the tracer indices for the non-autotroph tracers. To ! know where to start the indexing for the autotroph tracers, it increments ! tracer_cnt by 1 for each tracer that is included. Note that this gives an ! accurate count whether the carbon isotope tracers are included or not. - use marbl_sizes, only : marbl_total_tracer_cnt use marbl_constants_mod, only : c0 + use marbl_pft_mod, only : autotroph_type + use marbl_pft_mod, only : zooplankton_type - class(marbl_tracer_index_type), intent(inout) :: this + class(marbl_tracer_index_type), intent(out) :: this logical, intent(in) :: ciso_on logical, intent(in) :: lvariable_PtoC - type(autotroph_config_type), intent(in) :: autotrophs_config(:) - type(zooplankton_config_type), intent(in) :: zooplankton_config(:) - - integer :: n - - associate(tracer_cnt => marbl_total_tracer_cnt) - - tracer_cnt = 0 - this%ciso_ind_beg = 0 - this%ciso_ind_end = 0 - - ! General ecosys tracers - this%ecosys_base_ind_beg = tracer_cnt + 1 - - tracer_cnt = tracer_cnt + 1 - this%po4_ind = tracer_cnt - - tracer_cnt = tracer_cnt + 1 - this%no3_ind = tracer_cnt - - tracer_cnt = tracer_cnt + 1 - this%sio3_ind = tracer_cnt - - tracer_cnt = tracer_cnt + 1 - this%nh4_ind = tracer_cnt - - tracer_cnt = tracer_cnt + 1 - this%fe_ind = tracer_cnt - - tracer_cnt = tracer_cnt + 1 - this%lig_ind = tracer_cnt + type(autotroph_type), intent(in) :: autotrophs(:) + type(zooplankton_type), intent(in) :: zooplankton(:) + type(marbl_log_type), intent(inout) :: marbl_status_log + integer(int_kind), optional, intent(out) :: marbl_tracer_cnt + + character(len=*), parameter :: subname = 'marbl_interface_private_types:tracer_index_constructor' + character(len=char_len) :: ind_name + integer :: autotroph_cnt, zooplankton_cnt, n + + ! If marbl_tracer_cnt is requested, initialize to zero + ! (so that count is zero if an error is encountered) + autotroph_cnt = size(autotrophs) + zooplankton_cnt = size(zooplankton) + if (present(marbl_tracer_cnt)) marbl_tracer_cnt = 0 + + !Allocate memory + allocate(this%auto_inds(autotroph_cnt)) + allocate(this%zoo_inds(zooplankton_cnt)) + + ! General ecosys tracers + call this%add_tracer_index('po4', 'ecosys_base', this%po4_ind, marbl_status_log) + call this%add_tracer_index('no3', 'ecosys_base', this%no3_ind, marbl_status_log) + call this%add_tracer_index('sio3', 'ecosys_base', this%sio3_ind, marbl_status_log) + call this%add_tracer_index('nh4', 'ecosys_base', this%nh4_ind, marbl_status_log) + call this%add_tracer_index('fe', 'ecosys_base', this%fe_ind, marbl_status_log) + call this%add_tracer_index('lig', 'ecosys_base', this%lig_ind, marbl_status_log) + call this%add_tracer_index('o2', 'ecosys_base', this%o2_ind, marbl_status_log) + call this%add_tracer_index('dic', 'ecosys_base', this%dic_ind, marbl_status_log) + call this%add_tracer_index('dic_alt_co2', 'ecosys_base', this%dic_alt_co2_ind, marbl_status_log) + call this%add_tracer_index('alk', 'ecosys_base', this%alk_ind, marbl_status_log) + call this%add_tracer_index('alk_alt_co2', 'ecosys_base', this%alk_alt_co2_ind, marbl_status_log) + call this%add_tracer_index('doc', 'ecosys_base', this%doc_ind, marbl_status_log) + call this%add_tracer_index('don', 'ecosys_base', this%don_ind, marbl_status_log) + call this%add_tracer_index('dop', 'ecosys_base', this%dop_ind, marbl_status_log) + call this%add_tracer_index('dopr', 'ecosys_base', this%dopr_ind, marbl_status_log) + call this%add_tracer_index('donr', 'ecosys_base', this%donr_ind, marbl_status_log) + call this%add_tracer_index('docr', 'ecosys_base', this%docr_ind, marbl_status_log) + + do n=1,zooplankton_cnt + write(ind_name, "(2A)") trim(zooplankton(n)%sname), "C" + call this%add_tracer_index(ind_name, 'ecosys_base', this%zoo_inds(n)%C_ind, marbl_status_log) + end do + + do n=1,autotroph_cnt + write(ind_name, "(2A)") trim(autotrophs(n)%sname), "Chl" + call this%add_tracer_index(ind_name, 'ecosys_base', this%auto_inds(n)%Chl_ind, marbl_status_log) + + write(ind_name, "(2A)") trim(autotrophs(n)%sname), "C" + call this%add_tracer_index(ind_name, 'ecosys_base', this%auto_inds(n)%C_ind, marbl_status_log) + + if (lvariable_PtoC) then + write(ind_name, "(2A)") trim(autotrophs(n)%sname), "P" + call this%add_tracer_index(ind_name, 'ecosys_base', this%auto_inds(n)%P_ind, marbl_status_log) + end if - tracer_cnt = tracer_cnt + 1 - this%o2_ind = tracer_cnt + write(ind_name, "(2A)") trim(autotrophs(n)%sname), "Fe" + call this%add_tracer_index(ind_name, 'ecosys_base', this%auto_inds(n)%Fe_ind, marbl_status_log) - tracer_cnt = tracer_cnt + 1 - this%dic_ind = tracer_cnt + if (autotrophs(n)%silicifier) then + write(ind_name, "(2A)") trim(autotrophs(n)%sname), "Si" + call this%add_tracer_index(ind_name, 'ecosys_base', this%auto_inds(n)%Si_ind, marbl_status_log) + end if - tracer_cnt = tracer_cnt + 1 - this%dic_alt_co2_ind = tracer_cnt + if (autotrophs(n)%imp_calcifier.or. & + autotrophs(n)%exp_calcifier) then + write(ind_name, "(2A)") trim(autotrophs(n)%sname), "CaCO3" + call this%add_tracer_index(ind_name, 'ecosys_base', this%auto_inds(n)%CaCO3_ind, marbl_status_log) + end if + end do - tracer_cnt = tracer_cnt + 1 - this%alk_ind = tracer_cnt + if (ciso_on) then + call this%add_tracer_index('di13c', 'ciso', this%di13c_ind, marbl_status_log) + call this%add_tracer_index('do13c', 'ciso', this%do13c_ind, marbl_status_log) + call this%add_tracer_index('di14c', 'ciso', this%di14c_ind, marbl_status_log) + call this%add_tracer_index('do14c', 'ciso', this%do14c_ind, marbl_status_log) + call this%add_tracer_index('zoo13c', 'ciso', this%zoo13C_ind, marbl_status_log) + call this%add_tracer_index('zoo14c', 'ciso', this%zoo14C_ind, marbl_status_log) - tracer_cnt = tracer_cnt + 1 - this%alk_alt_co2_ind = tracer_cnt + do n=1,autotroph_cnt + write(ind_name, "(2A)") trim(autotrophs(n)%sname), "C13" + call this%add_tracer_index(ind_name, 'ciso', this%auto_inds(n)%C13_ind, marbl_status_log) - tracer_cnt = tracer_cnt + 1 - this%doc_ind = tracer_cnt + write(ind_name, "(2A)") trim(autotrophs(n)%sname), "C14" + call this%add_tracer_index(ind_name, 'ciso', this%auto_inds(n)%C14_ind, marbl_status_log) - tracer_cnt = tracer_cnt + 1 - this%don_ind = tracer_cnt + if (autotrophs(n)%imp_calcifier .or. & + autotrophs(n)%exp_calcifier) then + write(ind_name, "(2A)") trim(autotrophs(n)%sname), "Ca13CO3" + call this%add_tracer_index(ind_name, 'ciso', this%auto_inds(n)%Ca13CO3_ind, marbl_status_log) - tracer_cnt = tracer_cnt + 1 - this%dop_ind = tracer_cnt + write(ind_name, "(2A)") trim(autotrophs(n)%sname), "Ca14CO3" + call this%add_tracer_index(ind_name, 'ciso', this%auto_inds(n)%Ca14CO3_ind, marbl_status_log) + end if + end do + end if - tracer_cnt = tracer_cnt + 1 - this%dopr_ind = tracer_cnt + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace("add_tracer_index", subname) + return + end if - tracer_cnt = tracer_cnt + 1 - this%donr_ind = tracer_cnt + ! If marbl_tracer_cnt is requested, provide before returning + if (present(marbl_tracer_cnt)) marbl_tracer_cnt = this%total_cnt - tracer_cnt = tracer_cnt + 1 - this%docr_ind = tracer_cnt + end subroutine tracer_index_constructor - do n=1,zooplankton_cnt - tracer_cnt = tracer_cnt + 1 - this%zoo_inds(n)%C_ind = tracer_cnt - end do + !***************************************************************************** - do n=1,autotroph_cnt - tracer_cnt = tracer_cnt + 1 - this%auto_inds(n)%Chl_ind = tracer_cnt + subroutine tracer_index_destructor(this) - tracer_cnt = tracer_cnt + 1 - this%auto_inds(n)%C_ind = tracer_cnt + class(marbl_tracer_index_type), intent(inout) :: this - if (lvariable_PtoC) then - tracer_cnt = tracer_cnt + 1 - this%auto_inds(n)%P_ind = tracer_cnt - end if + ! Zero out counts + this%total_cnt = 0 + call this%ecosys_base%reset() + call this%ciso%reset() - tracer_cnt = tracer_cnt + 1 - this%auto_inds(n)%Fe_ind = tracer_cnt + ! Deallocate memory + if (allocated(this%auto_inds)) then + deallocate(this%auto_inds) + deallocate(this%zoo_inds) + end if - if (autotrophs_config(n)%silicifier) then - tracer_cnt = tracer_cnt + 1 - this%auto_inds(n)%Si_ind = tracer_cnt - end if + end subroutine tracer_index_destructor - if (autotrophs_config(n)%imp_calcifier.or. & - autotrophs_config(n)%exp_calcifier) then - tracer_cnt = tracer_cnt + 1 - this%auto_inds(n)%CaCO3_ind = tracer_cnt - end if - end do - this%ecosys_base_ind_end = tracer_cnt + !***************************************************************************** - if (ciso_on) then - ! Next tracer is start of the CISO tracers - this%ciso_ind_beg = tracer_cnt + 1 + subroutine tracer_count_reset(this) + class(marbl_tracer_count_type), intent(inout) :: this + this%cnt = 0 + this%ind_beg = 0 + this%ind_end = 0 + end subroutine tracer_count_reset - tracer_cnt = tracer_cnt + 1 - this%di13c_ind = tracer_cnt + !***************************************************************************** - tracer_cnt = tracer_cnt + 1 - this%do13c_ind = tracer_cnt + subroutine add_tracer_index(this, ind_name, category, ind, marbl_status_log) - tracer_cnt = tracer_cnt + 1 - this%di14c_ind = tracer_cnt + class(marbl_tracer_index_type), intent(inout) :: this + character(len=*), intent(in) :: ind_name + character(len=*), intent(in) :: category + integer(int_kind), intent(out) :: ind + type(marbl_log_type), intent(inout) :: marbl_status_log - tracer_cnt = tracer_cnt + 1 - this%do14c_ind = tracer_cnt + character(len=*), parameter :: subname = 'marbl_interface_private_types:add_tracer_index' + character(len=char_len) :: log_message - tracer_cnt = tracer_cnt + 1 - this%zoo13C_ind = tracer_cnt + ! This routine may be called multiple times after an error has been logged + ! (tracer_index_constructor doesn't check log status until all indices have + ! been added) + if (marbl_status_log%labort_marbl) return + + ind = this%total_cnt+1 + select case (trim(category)) + case ('ecosys_base') + call this%ecosys_base%update_count(ind, marbl_status_log) + case ('ciso') + call this%ciso%update_count(ind, marbl_status_log) + case DEFAULT + write(log_message, "(A,1X,A)") trim(category), & + 'is not a recognized tracer module!' + call marbl_status_log%log_error(log_message, subname) + write(log_message, "(2A)") "Error triggered by ", trim(ind_name) + call marbl_status_log%log_error(log_message, subname) + return + ! TO-DO add default case with "category not found" error + end select + + if (marbl_status_log%labort_marbl) then + write(log_message, "(2A)") trim(category), "%update_count" + call marbl_status_log%log_error_trace(log_message, subname) + write(log_message, "(2A)") "Error triggered by ", trim(ind_name) + call marbl_status_log%log_error(log_message, subname) + return + end if - tracer_cnt = tracer_cnt + 1 - this%zoo14C_ind = tracer_cnt + this%total_cnt = ind - do n=1,autotroph_cnt - tracer_cnt = tracer_cnt + 1 - this%auto_inds(n)%C13_ind = tracer_cnt + end subroutine add_tracer_index - tracer_cnt = tracer_cnt + 1 - this%auto_inds(n)%C14_ind = tracer_cnt + !***************************************************************************** - if (autotrophs_config(n)%imp_calcifier .or. & - autotrophs_config(n)%exp_calcifier) then - tracer_cnt = tracer_cnt + 1 - this%auto_inds(n)%Ca13CO3_ind = tracer_cnt + subroutine update_count(this, ind, marbl_status_log) - tracer_cnt = tracer_cnt + 1 - this%auto_inds(n)%Ca14CO3_ind = tracer_cnt - end if + class(marbl_tracer_count_type), intent(inout) :: this + integer(int_kind), intent(in) :: ind + type(marbl_log_type), intent(inout) :: marbl_status_log - end do + character(len=*), parameter :: subname = 'marbl_interface_private_types:update_count' + character(len=char_len) :: log_message - this%ciso_ind_end = tracer_cnt + ! (1) Make sure tracer modules have contiguous indices + if ((this%ind_end .ne. 0) .and. (this%ind_end .ne. ind-1)) then + write(log_message, "(2A,I0,A,I0)") "Can not add another tracer to this module", & + " current tracer index is ", ind, " and last tracer in module is ", & + this%ind_end + call marbl_status_log%log_error(log_message, subname) + return + end if - end if + ! (2) If this is first tracer in module, set ind_beg + if (this%ind_beg .eq. 0) this%ind_beg = ind - end associate + ! (3) Update ind_end and total count + this%ind_end = ind + this%cnt = this%cnt + 1 - end subroutine tracer_index_constructor + end subroutine update_count !***************************************************************************** subroutine surface_forcing_index_constructor(this, ciso_on, lflux_gas_o2, & - lflux_gas_co2, ladjust_bury_coeff) + lflux_gas_co2, ladjust_bury_coeff, num_surface_forcing_fields) ! This subroutine sets the surface forcing indexes, which are used to ! determine what forcing fields are required from the driver. - use marbl_sizes, only : num_surface_forcing_fields - - class(marbl_surface_forcing_indexing_type), intent(inout) :: this - logical, intent(in) :: ciso_on - logical, intent(in) :: lflux_gas_o2 - logical, intent(in) :: lflux_gas_co2 - logical, intent(in) :: ladjust_bury_coeff + class(marbl_surface_forcing_indexing_type), intent(out) :: this + logical, intent(in) :: ciso_on + logical, intent(in) :: lflux_gas_o2 + logical, intent(in) :: lflux_gas_co2 + logical, intent(in) :: ladjust_bury_coeff + integer, intent(out) :: num_surface_forcing_fields associate(forcing_cnt => num_surface_forcing_fields) @@ -919,34 +875,29 @@ end subroutine surface_forcing_index_constructor subroutine interior_forcing_index_constructor(this, & tracer_names, & tracer_restore_vars, & + num_interior_forcing_fields, & marbl_status_log) ! This subroutine sets the interior forcing indexes, which are used to ! determine what forcing fields are required from the driver. - use marbl_sizes, only : num_interior_forcing_fields - use marbl_sizes, only : marbl_total_tracer_cnt - use marbl_sizes, only : tracer_restore_cnt - - class(marbl_interior_forcing_indexing_type), intent(inout) :: this + class(marbl_interior_forcing_indexing_type), intent(out) :: this character(len=char_len), dimension(:), intent(in) :: tracer_names character(len=char_len), dimension(:), intent(in) :: tracer_restore_vars + integer(int_kind), intent(out) :: num_interior_forcing_fields type(marbl_log_type), intent(inout) :: marbl_status_log - character(len=*), parameter :: subname = 'marbl_internal_types:interior_forcing_index_constructor' + character(len=*), parameter :: subname = 'marbl_interface_private_types:interior_forcing_index_constructor' character(len=char_len) :: log_message + integer :: tracer_restore_cnt, tracer_cnt integer :: m, n associate(forcing_cnt => num_interior_forcing_fields) + tracer_cnt = size(tracer_names) + forcing_cnt = 0 - allocate(this%tracer_restore_id(marbl_total_tracer_cnt)) - this%tracer_restore_id = 0 - allocate(this%inv_tau_id(marbl_total_tracer_cnt)) - this%inv_tau_id = 0 - allocate(this%tracer_id(marbl_total_tracer_cnt)) - this%tracer_id = 0 ! ------------------------------- ! | Always request these fields | @@ -982,15 +933,18 @@ subroutine interior_forcing_index_constructor(this, & ! Tracer restoring ! Note that this section - ! (1) sets tracer_restore_cnt + ! (1) sets tracer_restore_cnt and allocate memory for restoring + ! arrays ! (2) includes consistency check on the tracer_restore_vars array ! (3) writes all tracer restore fields to log tracer_restore_cnt = count((len_trim(tracer_restore_vars).gt.0)) - if (tracer_restore_cnt .gt. 0) then - log_message = "Restoring the following tracers to data:" - call marbl_status_log%log_noerror(log_message, subname) - end if + allocate(this%tracer_restore_id(tracer_cnt)) + this%tracer_restore_id = 0 + allocate(this%inv_tau_id(tracer_cnt)) + this%inv_tau_id = 0 + allocate(this%tracer_id(tracer_restore_cnt)) + this%tracer_id = 0 do m=1,tracer_restore_cnt ! loop over tracer_restore_vars ! Check for empty strings in first tracer_restore_cnt elements of @@ -1002,7 +956,7 @@ subroutine interior_forcing_index_constructor(this, & end if ! Check for duplicate tracers in tracer_restore_vars - if (m .lt. marbl_total_tracer_cnt) then + if (m .lt. tracer_cnt) then if (any(tracer_restore_vars(m).eq.tracer_restore_vars(m+1:))) then write(log_message,"(A,1X,A)") trim(tracer_restore_vars(m)), & "appears in tracer_restore_vars more than once" @@ -1012,7 +966,7 @@ subroutine interior_forcing_index_constructor(this, & end if ! For each element - do n=1,marbl_total_tracer_cnt ! loop over tracer_names + do n=1,tracer_cnt ! loop over tracer_names if (trim(tracer_restore_vars(m)).eq.trim(tracer_names(n))) then forcing_cnt = forcing_cnt + 1 this%tracer_restore_id(n) = forcing_cnt @@ -1023,11 +977,8 @@ subroutine interior_forcing_index_constructor(this, & end do ! Check to make sure match was found - if (n.le.marbl_total_tracer_cnt) then + if (n.le.tracer_cnt) then this%tracer_id(m) = n - write(log_message, "(2A,I0,A)") trim(tracer_names(n)), & - " (tracer index: ", n, ')' - call marbl_status_log%log_noerror(log_message, subname) else write(log_message, "(2A)") "Can not find tracer named ", & trim(tracer_restore_vars(m)) @@ -1044,36 +995,5 @@ end subroutine interior_forcing_index_constructor !***************************************************************************** -#if 0 - ! FIXME #78: commented because auto_ind and zoo_ind are not allocatable yet - subroutine grazing_parms_constructor(this, grazing_conf, marbl_status_log) - - class(grazing_parms_type), intent(inout) :: this - type(grazing_config_type), intent(in) :: grazing_conf - type(marbl_log_type), intent(inout) :: marbl_status_log - - character(len=*), parameter :: subname = 'marbl_internal_types:grazing_config_constructor' - character(len=char_len) :: log_message - - if (allocated(this%auto_ind)) then - log_message = 'grazing%auto_inds is already allocated!' - call marbl_status_log%log_error(log_message, subname) - return - end if - - if (allocated(this%zoo_ind)) then - log_message = 'grazing%zoo_inds is already allocated!' - call marbl_status_log%log_error(log_message, subname) - return - end if - - allocate(this%auto_ind(grazing_conf%auto_ind_cnt)) - allocate(this%zoo_ind(grazing_conf%zoo_ind_cnt)) - - end subroutine grazing_parms_constructor -#endif - - !***************************************************************************** - -end module marbl_internal_types +end module marbl_interface_private_types diff --git a/src/marbl_interface_types.F90 b/src/marbl_interface_public_types.F90 similarity index 92% rename from src/marbl_interface_types.F90 rename to src/marbl_interface_public_types.F90 index f8f509c4..685dc36c 100644 --- a/src/marbl_interface_types.F90 +++ b/src/marbl_interface_public_types.F90 @@ -1,4 +1,4 @@ -module marbl_interface_types +module marbl_interface_public_types ! module for definitions of types that are shared between marbl interior and the driver. use marbl_kinds_mod , only : r8, log_kind, int_kind, char_len @@ -63,6 +63,7 @@ module marbl_interface_types real(r8), allocatable :: delta_z(:) ! (km) delta z - different values for partial bottom cells contains procedure, public :: construct => marbl_domain_constructor + procedure, public :: destruct => marbl_domain_destructor end type marbl_domain_type !***************************************************************************** @@ -203,14 +204,14 @@ subroutine marbl_domain_constructor(this, & num_elements_surface_forcing, num_elements_interior_forcing, & delta_z, zw, zt) - class(marbl_domain_type), intent(inout) :: this - integer (int_kind) , intent(in) :: num_levels - integer (int_kind) , intent(in) :: num_PAR_subcols - integer (int_kind) , intent(in) :: num_elements_surface_forcing - integer (int_kind) , intent(in) :: num_elements_interior_forcing - real (r8) , intent(in) :: delta_z(num_levels) - real (r8) , intent(in) :: zw(num_levels) - real (r8) , intent(in) :: zt(num_levels) + class(marbl_domain_type), intent(out) :: this + integer (int_kind), intent(in) :: num_levels + integer (int_kind), intent(in) :: num_PAR_subcols + integer (int_kind), intent(in) :: num_elements_surface_forcing + integer (int_kind), intent(in) :: num_elements_interior_forcing + real (r8), intent(in) :: delta_z(num_levels) + real (r8), intent(in) :: zw(num_levels) + real (r8), intent(in) :: zt(num_levels) integer :: k @@ -233,6 +234,20 @@ end subroutine marbl_domain_constructor !***************************************************************************** + subroutine marbl_domain_destructor(this) + + class(marbl_domain_type), intent(inout) :: this + + if (allocated(this%delta_z)) then + deallocate(this%delta_z) + deallocate(this%zw) + deallocate(this%zt) + end if + + end subroutine marbl_domain_destructor + + !***************************************************************************** + subroutine marbl_single_saved_state_construct(this, lname, sname, units, & vgrid, rank, num_elements, num_levels, marbl_status_log) @@ -248,7 +263,7 @@ subroutine marbl_single_saved_state_construct(this, lname, sname, units, & integer, intent(in) :: num_levels character(len=*), parameter :: subname = & - 'marbl_interface_types:marbl_single_saved_state_construct' + 'marbl_interface_public_types:marbl_single_saved_state_construct' character(len=char_len) :: log_message select case (rank) @@ -290,9 +305,9 @@ end subroutine marbl_single_saved_state_construct subroutine marbl_saved_state_constructor(this, num_elements, num_levels) - class(marbl_saved_state_type), intent(inout) :: this - integer (int_kind) , intent(in) :: num_elements - integer (int_kind) , intent(in) :: num_levels + class(marbl_saved_state_type), intent(out) :: this + integer (int_kind), intent(in) :: num_elements + integer (int_kind), intent(in) :: num_levels this%saved_state_cnt = 0 this%num_elements = num_elements @@ -316,7 +331,7 @@ subroutine marbl_saved_state_add(this, lname, sname, units, vgrid, rank, & integer(int_kind), intent(in) :: rank integer(int_kind), intent(out) :: id - character(len=*), parameter :: subname = 'marbl_interface_types:marbl_saved_state_add' + character(len=*), parameter :: subname = 'marbl_interface_public_types:marbl_saved_state_add' character(len=char_len) :: log_message type(marbl_single_saved_state_type), dimension(:), pointer :: new_state @@ -383,7 +398,7 @@ subroutine marbl_single_diag_init(this, lname, sname, units, vgrid, & integer , intent(in) :: num_levels type(marbl_log_type) , intent(inout) :: marbl_status_log - character(len=*), parameter :: subname = 'marbl_interface_types:marbl_single_diag_init' + character(len=*), parameter :: subname = 'marbl_interface_public_types:marbl_single_diag_init' character(len=char_len) :: log_message ! Allocate column memory for 3D vars or num_elements memory for 2D vars @@ -414,13 +429,14 @@ end subroutine marbl_single_diag_init subroutine marbl_single_sfo_constructor(this, num_elements, field_name, id, & marbl_status_log) - class(marbl_single_sfo_type), intent(inout) :: this + + class(marbl_single_sfo_type), intent(out) :: this character(len=*), intent(in) :: field_name integer(int_kind), intent(in) :: num_elements integer(int_kind), intent(in) :: id type(marbl_log_type), intent(inout) :: marbl_status_log - character(len=*), parameter :: subname = 'marbl_interface_types:marbl_single_sfo_constructor' + character(len=*), parameter :: subname = 'marbl_interface_public_types:marbl_single_sfo_constructor' character(len=char_len) :: log_message select case (trim(field_name)) @@ -483,7 +499,7 @@ subroutine marbl_sfo_add(this, num_elements, field_name, sfo_id, & type(marbl_log_type), intent(inout) :: marbl_status_log integer(int_kind), intent(out) :: sfo_id - character(len=*), parameter :: subname = 'marbl_interface_types:marbl_sfo_add' + character(len=*), parameter :: subname = 'marbl_interface_public_types:marbl_sfo_add' type(marbl_single_sfo_type), dimension(:), pointer :: new_sfo integer :: n, old_size @@ -531,9 +547,9 @@ end subroutine marbl_sfo_add subroutine marbl_diagnostics_constructor(this, num_elements, num_levels) - class(marbl_diagnostics_type), intent(inout) :: this - integer (int_kind), intent(in) :: num_elements - integer (int_kind), intent(in) :: num_levels + class(marbl_diagnostics_type), intent(out) :: this + integer (int_kind), intent(in) :: num_elements + integer (int_kind), intent(in) :: num_levels allocate(this%diags(0)) this%num_elements = num_elements @@ -548,7 +564,7 @@ subroutine marbl_diagnostics_set_to_zero(this, marbl_status_log) class(marbl_diagnostics_type), intent(inout) :: this type(marbl_log_type), intent(inout) :: marbl_status_log - character(len=*), parameter :: subname = 'marbl_interface_types:marbl_diagnostics_set_to_zero' + character(len=*), parameter :: subname = 'marbl_interface_public_types:marbl_diagnostics_set_to_zero' character(len=char_len) :: log_message integer (int_kind) :: n @@ -582,7 +598,7 @@ subroutine marbl_diagnostics_add(this, lname, sname, units, vgrid, & integer (int_kind) , intent(out) :: id type(marbl_log_type) , intent(inout) :: marbl_status_log - character(len=*), parameter :: subname = 'marbl_interface_types:marbl_diagnostics_add' + character(len=*), parameter :: subname = 'marbl_interface_public_types:marbl_diagnostics_add' character(len=char_len) :: log_message type(marbl_single_diagnostic_type), dimension(:), pointer :: new_diags @@ -669,7 +685,7 @@ subroutine marbl_forcing_fields_set_rank(this, num_elements, rank, & type(marbl_log_type), intent(inout) :: marbl_status_log integer, optional, intent(in) :: dim1 - character(len=*), parameter :: subname = 'marbl_interface_types:marbl_forcing_fields_set_rank' + character(len=*), parameter :: subname = 'marbl_interface_public_types:marbl_forcing_fields_set_rank' character(len=char_len) :: log_message this%metadata%rank = rank @@ -696,8 +712,8 @@ end subroutine marbl_forcing_fields_set_rank subroutine marbl_timers_constructor(this, num_timers) - class(marbl_timers_type), intent(inout) :: this - integer, intent(in) :: num_timers + class(marbl_timers_type), intent(out) :: this + integer, intent(in) :: num_timers this%num_timers = num_timers allocate(this%names(num_timers)) @@ -729,4 +745,4 @@ end subroutine marbl_timers_deconstructor !***************************************************************************** -end module marbl_interface_types +end module marbl_interface_public_types diff --git a/src/marbl_logging.F90 b/src/marbl_logging.F90 index afb8600b..579755d9 100644 --- a/src/marbl_logging.F90 +++ b/src/marbl_logging.F90 @@ -102,7 +102,8 @@ module marbl_logging !**************************************************************************** type, public :: marbl_log_type - logical, public :: labort_marbl ! True => driver should abort GCM + logical, private :: lconstructed = .false. ! True => constructor was already called + logical, public :: labort_marbl = .false. ! True => driver should abort GCM type(marbl_log_output_options_type) :: OutputOptions type(marbl_status_log_entry_type), pointer :: FullLog type(marbl_status_log_entry_type), pointer :: LastEntry @@ -172,7 +173,8 @@ subroutine marbl_log_constructor(this) class(marbl_log_type), intent(inout) :: this - this%labort_marbl = .false. + if (this%lconstructed) return + this%lconstructed = .true. nullify(this%FullLog) nullify(this%LastEntry) call this%OutputOptions%construct() diff --git a/src/marbl_mod.F90 b/src/marbl_mod.F90 index 10efdc48..80fed2c4 100644 --- a/src/marbl_mod.F90 +++ b/src/marbl_mod.F90 @@ -90,106 +90,96 @@ module marbl_mod use marbl_kinds_mod, only : r8 use marbl_kinds_mod, only : char_len - use marbl_config_mod, only : ciso_on - use marbl_config_mod, only : lsource_sink - use marbl_config_mod, only : lflux_gas_o2 - use marbl_config_mod, only : lflux_gas_co2 - use marbl_config_mod, only : lecovars_full_depth_tavg - use marbl_config_mod, only : autotrophs_config - use marbl_config_mod, only : zooplankton_config - use marbl_config_mod, only : grazing_config - use marbl_config_mod, only : init_bury_coeff_opt - use marbl_config_mod, only : ladjust_bury_coeff - - use marbl_parms, only : autotrophs - use marbl_parms, only : zooplankton - use marbl_parms, only : grz_fnc_michaelis_menten - use marbl_parms, only : grz_fnc_sigmoidal - use marbl_parms, only : f_qsw_par - use marbl_parms, only : parm_Fe_bioavail - use marbl_parms, only : dust_to_Fe - use marbl_parms, only : denitrif_C_N - use marbl_parms, only : parm_Red_Fe_C - use marbl_parms, only : Q - use marbl_parms, only : Qp_zoo - use marbl_parms, only : parm_scalelen_z - use marbl_parms, only : parm_scalelen_vals - use marbl_parms, only : caco3_poc_min - use marbl_parms, only : CaCO3_sp_thres - use marbl_parms, only : CaCO3_temp_thres1 - use marbl_parms, only : CaCO3_temp_thres2 - use marbl_parms, only : DOC_reminR_light - use marbl_parms, only : DON_reminR_light - use marbl_parms, only : DOP_reminR_light - use marbl_parms, only : DOC_reminR_dark - use marbl_parms, only : DON_reminR_dark - use marbl_parms, only : DOP_reminR_dark - use marbl_parms, only : DOCr_reminR0 - use marbl_parms, only : DONr_reminR0 - use marbl_parms, only : DOPr_reminR0 - use marbl_parms, only : DOCprod_refract - use marbl_parms, only : DONprod_refract - use marbl_parms, only : DOPprod_refract - use marbl_parms, only : POCremin_refract - use marbl_parms, only : PONremin_refract - use marbl_parms, only : POPremin_refract - use marbl_parms, only : f_toDON - use marbl_parms, only : f_graze_CaCO3_REMIN - use marbl_parms, only : f_graze_si_remin - use marbl_parms, only : f_graze_sp_poc_lim - use marbl_parms, only : f_photosp_CaCO3 - use marbl_parms, only : bury_coeff_rmean_timescale_years - use marbl_parms, only : parm_f_prod_sp_CaCO3 - use marbl_parms, only : parm_kappa_nitrif - use marbl_parms, only : parm_labile_ratio - use marbl_parms, only : parm_nitrif_par_lim - use marbl_parms, only : parm_o2_min - use marbl_parms, only : parm_o2_min_delta - use marbl_parms, only : parm_red_d_c_o2 - use marbl_parms, only : parm_red_d_c_o2_diaz - use marbl_parms, only : parm_Remin_D_C_O2 - use marbl_parms, only : QCaCO3_max - use marbl_parms, only : Qfe_zoo - use marbl_parms, only : r_Nfix_photo - use marbl_parms, only : spc_poc_fac - use marbl_parms, only : grazing - use marbl_parms, only : caco3_bury_thres_iopt - use marbl_parms, only : caco3_bury_thres_iopt_fixed_depth - use marbl_parms, only : caco3_bury_thres_iopt_omega_calc - use marbl_parms, only : caco3_bury_thres_depth - use marbl_parms, only : PON_bury_coeff - - use marbl_sizes, only : ecosys_base_tracer_cnt - use marbl_sizes, only : autotroph_cnt - use marbl_sizes, only : zooplankton_cnt - use marbl_sizes, only : grazer_prey_cnt - - use marbl_internal_types , only : carbonate_type - use marbl_internal_types , only : zooplankton_parms_type - use marbl_internal_types , only : autotroph_parms_type - use marbl_internal_types , only : autotroph_config_type - use marbl_internal_types , only : zooplankton_secondary_species_type - use marbl_internal_types , only : autotroph_secondary_species_type - use marbl_internal_types , only : dissolved_organic_matter_type - use marbl_internal_types , only : column_sinking_particle_type - use marbl_internal_types , only : marbl_PAR_type - use marbl_internal_types , only : marbl_particulate_share_type - use marbl_internal_types , only : marbl_interior_share_type - use marbl_internal_types , only : marbl_autotroph_share_type - use marbl_internal_types , only : marbl_zooplankton_share_type - use marbl_internal_types , only : marbl_surface_forcing_share_type - use marbl_internal_types , only : marbl_surface_forcing_internal_type - use marbl_internal_types , only : marbl_tracer_index_type - use marbl_internal_types , only : marbl_surface_forcing_indexing_type - use marbl_internal_types , only : marbl_interior_forcing_indexing_type - - use marbl_interface_types , only : marbl_domain_type - use marbl_interface_types , only : marbl_tracer_metadata_type - use marbl_interface_types , only : marbl_saved_state_type - use marbl_interface_types , only : marbl_surface_forcing_output_type - use marbl_interface_types , only : marbl_forcing_fields_type - use marbl_interface_types , only : marbl_diagnostics_type - use marbl_interface_types , only : marbl_running_mean_0d_type + use marbl_settings_mod, only : autotroph_cnt + use marbl_settings_mod, only : zooplankton_cnt + use marbl_settings_mod, only : max_grazer_prey_cnt + use marbl_settings_mod, only : ciso_on + use marbl_settings_mod, only : lsource_sink + use marbl_settings_mod, only : lflux_gas_o2 + use marbl_settings_mod, only : lflux_gas_co2 + use marbl_settings_mod, only : init_bury_coeff_opt + use marbl_settings_mod, only : ladjust_bury_coeff + use marbl_settings_mod, only : autotrophs + use marbl_settings_mod, only : zooplankton + use marbl_settings_mod, only : f_qsw_par + use marbl_settings_mod, only : parm_Fe_bioavail + use marbl_settings_mod, only : dust_to_Fe + use marbl_settings_mod, only : denitrif_C_N + use marbl_settings_mod, only : parm_Red_Fe_C + use marbl_settings_mod, only : Q + use marbl_settings_mod, only : parm_scalelen_z + use marbl_settings_mod, only : parm_scalelen_vals + use marbl_settings_mod, only : caco3_poc_min + use marbl_settings_mod, only : CaCO3_sp_thres + use marbl_settings_mod, only : CaCO3_temp_thres1 + use marbl_settings_mod, only : CaCO3_temp_thres2 + use marbl_settings_mod, only : DOC_reminR_light + use marbl_settings_mod, only : DON_reminR_light + use marbl_settings_mod, only : DOP_reminR_light + use marbl_settings_mod, only : DOC_reminR_dark + use marbl_settings_mod, only : DON_reminR_dark + use marbl_settings_mod, only : DOP_reminR_dark + use marbl_settings_mod, only : DOCr_reminR0 + use marbl_settings_mod, only : DONr_reminR0 + use marbl_settings_mod, only : DOPr_reminR0 + use marbl_settings_mod, only : DOCprod_refract + use marbl_settings_mod, only : DONprod_refract + use marbl_settings_mod, only : DOPprod_refract + use marbl_settings_mod, only : POCremin_refract + use marbl_settings_mod, only : PONremin_refract + use marbl_settings_mod, only : POPremin_refract + use marbl_settings_mod, only : f_toDON + use marbl_settings_mod, only : f_graze_CaCO3_REMIN + use marbl_settings_mod, only : f_graze_si_remin + use marbl_settings_mod, only : f_graze_sp_poc_lim + use marbl_settings_mod, only : f_photosp_CaCO3 + use marbl_settings_mod, only : bury_coeff_rmean_timescale_years + use marbl_settings_mod, only : parm_f_prod_sp_CaCO3 + use marbl_settings_mod, only : parm_kappa_nitrif + use marbl_settings_mod, only : parm_labile_ratio + use marbl_settings_mod, only : parm_nitrif_par_lim + use marbl_settings_mod, only : parm_o2_min + use marbl_settings_mod, only : parm_o2_min_delta + use marbl_settings_mod, only : parm_red_d_c_o2 + use marbl_settings_mod, only : parm_red_d_c_o2_diaz + use marbl_settings_mod, only : parm_Remin_D_C_O2 + use marbl_settings_mod, only : QCaCO3_max + use marbl_settings_mod, only : Qfe_zoo + use marbl_settings_mod, only : r_Nfix_photo + use marbl_settings_mod, only : spc_poc_fac + use marbl_settings_mod, only : grazing + use marbl_settings_mod, only : caco3_bury_thres_iopt + use marbl_settings_mod, only : caco3_bury_thres_iopt_fixed_depth + use marbl_settings_mod, only : caco3_bury_thres_iopt_omega_calc + use marbl_settings_mod, only : caco3_bury_thres_depth + use marbl_settings_mod, only : PON_bury_coeff + + use marbl_interface_private_types, only : carbonate_type + use marbl_interface_private_types, only : dissolved_organic_matter_type + use marbl_interface_private_types, only : column_sinking_particle_type + use marbl_interface_private_types, only : marbl_PAR_type + use marbl_interface_private_types, only : marbl_particulate_share_type + use marbl_interface_private_types, only : marbl_interior_share_type + use marbl_interface_private_types, only : marbl_surface_forcing_share_type + use marbl_interface_private_types, only : marbl_surface_forcing_internal_type + use marbl_interface_private_types, only : marbl_tracer_index_type + use marbl_interface_private_types, only : marbl_surface_forcing_indexing_type + use marbl_interface_private_types, only : marbl_interior_forcing_indexing_type + + use marbl_interface_public_types, only : marbl_domain_type + use marbl_interface_public_types, only : marbl_saved_state_type + use marbl_interface_public_types, only : marbl_surface_forcing_output_type + use marbl_interface_public_types, only : marbl_forcing_fields_type + use marbl_interface_public_types, only : marbl_diagnostics_type + use marbl_interface_public_types, only : marbl_running_mean_0d_type + + use marbl_pft_mod, only : autotroph_type + use marbl_pft_mod, only : zooplankton_type + use marbl_pft_mod, only : autotroph_secondary_species_type + use marbl_pft_mod, only : zooplankton_secondary_species_type + use marbl_pft_mod, only : marbl_autotroph_share_type + use marbl_pft_mod, only : marbl_zooplankton_share_type + use marbl_pft_mod, only : Qp_zoo use marbl_diagnostics_mod , only : marbl_diagnostics_set_surface_forcing use marbl_diagnostics_mod , only : marbl_diagnostics_set_interior_forcing @@ -203,22 +193,13 @@ module marbl_mod ! public/private member procedure declarations !----------------------------------------------------------------------- - public :: marbl_init_surface_forcing_fields - public :: marbl_init_interior_forcing_fields - public :: marbl_init_tracer_metadata - public :: marbl_init_bury_coeff public :: marbl_set_glo_vars_cnt public :: marbl_set_rmean_init_vals public :: marbl_set_interior_forcing public :: marbl_set_surface_forcing public :: marbl_set_global_scalars_interior - public :: marbl_tracer_index_consistency_check - private :: marbl_init_non_autotroph_tracer_metadata - private :: marbl_init_non_autotroph_tracers_metadata private :: marbl_init_particulate_terms - private :: marbl_init_zooplankton_tracer_metadata - private :: marbl_init_autotroph_tracer_metadata private :: marbl_update_particulate_terms_from_prior_level private :: marbl_update_sinking_particle_from_prior_level private :: marbl_setup_local_tracers @@ -276,440 +257,6 @@ module marbl_mod !***************************************************************************** - subroutine marbl_init_surface_forcing_fields(num_elements, surface_forcing_indices, & - surface_forcings, marbl_status_log) - - use marbl_sizes, only : num_surface_forcing_fields - - ! Initialize the surface forcing_fields datatype with information from the - ! namelist read - ! - - implicit none - - integer, intent(in) :: num_elements - type(marbl_surface_forcing_indexing_type), intent(in) :: surface_forcing_indices - type(marbl_forcing_fields_type), intent(inout) :: surface_forcings(:) - type(marbl_log_type), intent(inout) :: marbl_status_log - - !----------------------------------------------------------------------- - ! local variables - !----------------------------------------------------------------------- - character(len=*), parameter :: subname = 'marbl_mod:marbl_init_surface_forcing_fields' - character(len=char_len) :: log_message - - integer :: id - logical :: found - !----------------------------------------------------------------------- - - associate(ind => surface_forcing_indices) - - surface_forcings(:)%metadata%varname = '' - do id=1,num_surface_forcing_fields - found = .false. - - ! Square of 10m wind - if (id .eq. ind%u10_sqr_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'u10_sqr' - surface_forcings(id)%metadata%field_units = 'cm^2/s^2' - end if - - ! Sea-surface salinity - if (id .eq. ind%sss_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'sss' - surface_forcings(id)%metadata%field_units = 'unknown units' - end if - - ! Sea-surface temperature - if (id .eq. ind%sst_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'sst' - surface_forcings(id)%metadata%field_units = 'degrees C' - end if - - ! Ice Fraction - if (id .eq. ind%ifrac_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'Ice Fraction' - surface_forcings(id)%metadata%field_units = 'unitless' - end if - - ! Dust Flux - if (id .eq. ind%dust_flux_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'Dust Flux' - surface_forcings(id)%metadata%field_units = 'g/cm^2/s' - end if - - ! Iron Flux - if (id .eq. ind%iron_flux_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'Iron Flux' - surface_forcings(id)%metadata%field_units = 'nmol/cm^2/s' - end if - - ! NOx Flux - if (id .eq. ind%nox_flux_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'NOx Flux' - surface_forcings(id)%metadata%field_units = 'unknown units' - end if - - ! NHy Flux - if (id .eq. ind%nhy_flux_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'NHy Flux' - surface_forcings(id)%metadata%field_units = 'unknown units' - end if - - ! external C Flux - if (id .eq. ind%ext_C_flux_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'external C Flux' - surface_forcings(id)%metadata%field_units = 'nmol/cm^2/s' - end if - - ! external P Flux - if (id .eq. ind%ext_P_flux_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'external P Flux' - surface_forcings(id)%metadata%field_units = 'nmol/cm^2/s' - end if - - ! external Si Flux - if (id .eq. ind%ext_Si_flux_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'external Si Flux' - surface_forcings(id)%metadata%field_units = 'nmol/cm^2/s' - end if - - ! atm pressure - if (id .eq. ind%atm_pressure_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'Atmospheric Pressure' - surface_forcings(id)%metadata%field_units = 'unknown units' - end if - - ! xco2 - if (id .eq. ind%xco2_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'xco2' - surface_forcings(id)%metadata%field_units = 'unknown units' - end if - - ! xco2_alt_co2 - if (id .eq. ind%xco2_alt_co2_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'xco2_alt_co2' - surface_forcings(id)%metadata%field_units = 'unknown units' - end if - - ! d13c - if (id .eq. ind%d13c_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'd13c' - surface_forcings(id)%metadata%field_units = 'unknown units' - end if - - ! d14c - if (id .eq. ind%d14c_id) then - found = .true. - surface_forcings(id)%metadata%varname = 'd14c' - surface_forcings(id)%metadata%field_units = 'unknown units' - end if - - if (.not.found) then - write(log_message, "(A,I0,A)") "Index number ", id, & - " is not associated with a forcing field!" - call marbl_status_log%log_error(log_message, subname) - return - end if - - ! All surface forcing fields are rank 0; if that changes, make this - ! call from inside each "if (id .eq. *)" block - call surface_forcings(id)%set_rank(num_elements, 0, marbl_status_log) - - end do - - end associate - - ! FIXME #26: do we have any forcing fields that are required to be set? - ! If so, check to make sure those indices are not zero here. - - end subroutine marbl_init_surface_forcing_fields - - !***************************************************************************** - - subroutine marbl_init_interior_forcing_fields(& - num_elements, & - interior_forcing_indices, & - tracer_metadata, & - num_PAR_subcols, & - num_levels, & - interior_forcings, & - marbl_status_log) - - use marbl_sizes, only : num_interior_forcing_fields - - ! Initialize the interior forcing_fields datatype with information from the - ! namelist read - ! - - implicit none - - integer, intent(in) :: num_elements - type(marbl_interior_forcing_indexing_type), intent(in) :: interior_forcing_indices - type(marbl_tracer_metadata_type), intent(in) :: tracer_metadata(:) - integer, intent(in) :: num_PAR_subcols - integer, intent(in) :: num_levels - type(marbl_forcing_fields_type), intent(inout) :: interior_forcings(:) - type(marbl_log_type), intent(inout) :: marbl_status_log - - !----------------------------------------------------------------------- - ! local variables - !----------------------------------------------------------------------- - character(len=*), parameter :: subname = 'marbl_mod:marbl_init_interior_forcing_fields' - character(len=char_len) :: log_message - - ! NAG didn't like associating to tracer_metadata(:)%* - character(len=char_len) :: tracer_name - character(len=char_len) :: tracer_units - integer :: id, n - logical :: found - !----------------------------------------------------------------------- - - associate(ind => interior_forcing_indices) - - interior_forcings(:)%metadata%varname = '' - - ! Surface fluxes that influence interior forcing - do id=1,num_interior_forcing_fields - found = .false. - ! Dust Flux - if (id .eq. ind%dustflux_id) then - found = .true. - interior_forcings(id)%metadata%varname = 'Dust Flux' - interior_forcings(id)%metadata%field_units = 'need_units' - call interior_forcings(id)%set_rank(num_elements, 0, marbl_status_log) - end if - - ! PAR Column Fraction and Shortwave Radiation - if (id .eq. ind%PAR_col_frac_id) then - found = .true. - interior_forcings(id)%metadata%varname = 'PAR Column Fraction' - interior_forcings(id)%metadata%field_units = 'unitless' - call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & - dim1 = num_PAR_subcols) - end if - - if (id .eq. ind%surf_shortwave_id) then - found = .true. - interior_forcings(id)%metadata%varname = 'Surface Shortwave' - interior_forcings(id)%metadata%field_units = 'need_units' ! W/m^2? - call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & - dim1 = num_PAR_subcols) - end if - - - ! Temperature - if (id .eq. ind%temperature_id) then - found = .true. - interior_forcings(id)%metadata%varname = 'Temperature' - interior_forcings(id)%metadata%field_units = 'Degrees C' - call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & - dim1 = num_levels) - end if - - ! Salinity - if (id .eq. ind%salinity_id) then - found = .true. - interior_forcings(id)%metadata%varname = 'Salinity' - interior_forcings(id)%metadata%field_units = 'need_units' - call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & - dim1 = num_levels) - end if - - ! Pressure - if (id .eq. ind%pressure_id) then - found = .true. - interior_forcings(id)%metadata%varname = 'Pressure' - interior_forcings(id)%metadata%field_units = 'need_units' - call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & - dim1 = num_levels) - end if - - ! Iron Sediment Flux - if (id .eq. ind%fesedflux_id) then - found = .true. - interior_forcings(id)%metadata%varname = 'Iron Sediment Flux' - interior_forcings(id)%metadata%field_units = 'need_units' - call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & - dim1 = num_levels) - end if - - ! Interior Tracer Restoring - do n=1,size(ind%tracer_restore_id) - if (id .eq. ind%tracer_restore_id(n)) then - tracer_name = tracer_metadata(n)%short_name - tracer_units = tracer_metadata(n)%units - found = .true. - write(interior_forcings(id)%metadata%varname,"(A,1X,A)") & - trim(tracer_name), 'Restoring Field' - interior_forcings(id)%metadata%field_units = tracer_units - call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & - dim1 = num_levels) - end if - if (id .eq. ind%inv_tau_id(n)) then - found = .true. - write(interior_forcings(id)%metadata%varname,"(A,1X,A)") & - trim(tracer_name), 'Restoring Inverse Timescale' - interior_forcings(id)%metadata%field_units = '1/s' - call interior_forcings(id)%set_rank(num_elements, 1, marbl_status_log, & - dim1 = num_levels) - end if - end do - - ! Check to see if %set_rank() returned an error - if (marbl_status_log%labort_marbl) then - write(log_message, "(2A)") trim(interior_forcings(id)%metadata%varname), & - ' set_rank()' - call marbl_status_log%log_error_trace(log_message, subname) - return - end if - - ! Abort if there was no match between id and the restoring indices - if (.not.found) then - write(log_message, "(A,I0,A)") "Index number ", id, & - " is not associated with a forcing field!" - call marbl_status_log%log_error(log_message, subname) - return - end if - - end do - - end associate - - ! FIXME #26: do we have any forcing fields that are required to be set? - ! If so, check to make sure those indices are not zero here. - - end subroutine marbl_init_interior_forcing_fields - - !***************************************************************************** - - subroutine marbl_init_tracer_metadata(marbl_tracer_metadata, & - marbl_tracer_indices, marbl_status_log) - - ! Set tracer and forcing metadata - - implicit none - - type (marbl_tracer_metadata_type), intent(inout) :: marbl_tracer_metadata(:) ! descriptors for each tracer - type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices - type(marbl_log_type) , intent(inout) :: marbl_status_log - - !----------------------------------------------------------------------- - ! local variables - !----------------------------------------------------------------------- - - character(len=*), parameter :: subname = 'marbl_mod:marbl_init_tracer_metadata' - - integer (int_kind) :: n ! index for looping over tracers - integer (int_kind) :: zoo_ind ! zooplankton functional group index - integer (int_kind) :: auto_ind ! autotroph functional group index - - !----------------------------------------------------------------------- - ! initialize tracer metatdata - !----------------------------------------------------------------------- - - marbl_tracer_metadata(:)%lfull_depth_tavg = .true. - marbl_tracer_metadata(:)%tracer_module_name = 'ecosys' - - call marbl_init_non_autotroph_tracers_metadata(marbl_tracer_metadata, & - marbl_tracer_indices) - - call marbl_init_zooplankton_tracer_metadata(marbl_tracer_metadata, & - marbl_tracer_indices) - - call marbl_init_autotroph_tracer_metadata(marbl_tracer_metadata, & - marbl_tracer_indices) - - !----------------------------------------------------------------------- - ! set lfull_depth_tavg flag for short-lived ecosystem tracers - !----------------------------------------------------------------------- - - ! Should be done in marbl_diagnostics, and without the _tavg name - do zoo_ind = 1, zooplankton_cnt - n = marbl_tracer_indices%zoo_inds(zoo_ind)%C_ind - marbl_tracer_metadata(n)%lfull_depth_tavg = lecovars_full_depth_tavg - end do - - do auto_ind = 1, autotroph_cnt - n = marbl_tracer_indices%auto_inds(auto_ind)%Chl_ind - marbl_tracer_metadata(n)%lfull_depth_tavg = lecovars_full_depth_tavg - - n = marbl_tracer_indices%auto_inds(auto_ind)%C_ind - marbl_tracer_metadata(n)%lfull_depth_tavg = lecovars_full_depth_tavg - - n = marbl_tracer_indices%auto_inds(auto_ind)%P_ind - if (n > 0) then - marbl_tracer_metadata(n)%lfull_depth_tavg = lecovars_full_depth_tavg - endif - - n = marbl_tracer_indices%auto_inds(auto_ind)%Fe_ind - marbl_tracer_metadata(n)%lfull_depth_tavg = lecovars_full_depth_tavg - - n = marbl_tracer_indices%auto_inds(auto_ind)%Si_ind - if (n > 0) then - marbl_tracer_metadata(n)%lfull_depth_tavg = lecovars_full_depth_tavg - endif - - n = marbl_tracer_indices%auto_inds(auto_ind)%CaCO3_ind - if (n > 0) then - marbl_tracer_metadata(n)%lfull_depth_tavg = lecovars_full_depth_tavg - endif - end do - - end subroutine marbl_init_tracer_metadata - - !*********************************************************************** - - subroutine marbl_init_bury_coeff(marbl_particulate_share, marbl_status_log) - - use marbl_logging, only : marbl_log_type - use marbl_parms , only : parm_init_POC_bury_coeff - use marbl_parms , only : parm_init_POP_bury_coeff - use marbl_parms , only : parm_init_bSi_bury_coeff - - type(marbl_particulate_share_type), intent(inout) :: marbl_particulate_share - type(marbl_log_type) , intent(inout) :: marbl_status_log - - !--------------------------------------------------------------------------- - ! local variables - !--------------------------------------------------------------------------- - character(len=*), parameter :: subname = 'marbl_mod:marbl_init_bury_coeff' - - !--------------------------------------------------------------------------- - - ! if ladjust_bury_coeff is true, then bury coefficients are set at runtime - ! so they do not need to be initialized here - - if (.not. ladjust_bury_coeff) then - if (init_bury_coeff_opt == 'nml') then - marbl_particulate_share%POC_bury_coeff = parm_init_POC_bury_coeff - marbl_particulate_share%POP_bury_coeff = parm_init_POP_bury_coeff - marbl_particulate_share%bSi_bury_coeff = parm_init_bSi_bury_coeff - else - call marbl_status_log%log_error("ladjust_bury_coeff=.false., init_bury_coeff_opt='restfile' not implemented", subname) - return - end if - end if - - end subroutine marbl_init_bury_coeff - - !*********************************************************************** - subroutine marbl_set_glo_vars_cnt( & glo_avg_field_cnt_interior, & glo_avg_field_cnt_surface, & @@ -779,10 +326,10 @@ subroutine marbl_set_rmean_init_vals( & glo_scalar_rmean_interior, & glo_scalar_rmean_surface) - use marbl_interface_types, only : marbl_running_mean_0d_type - use marbl_parms , only : parm_init_POC_bury_coeff - use marbl_parms , only : parm_init_POP_bury_coeff - use marbl_parms , only : parm_init_bSi_bury_coeff + use marbl_interface_public_types, only : marbl_running_mean_0d_type + use marbl_settings_mod, only : parm_init_POC_bury_coeff + use marbl_settings_mod, only : parm_init_POP_bury_coeff + use marbl_settings_mod, only : parm_init_bSi_bury_coeff type(marbl_running_mean_0d_type), intent(out) :: glo_avg_rmean_interior(:) type(marbl_running_mean_0d_type), intent(out) :: glo_avg_rmean_surface(:) @@ -925,22 +472,21 @@ subroutine marbl_set_interior_forcing( & ! Compute time derivatives for ecosystem state variables - use marbl_ciso_mod , only : marbl_ciso_set_interior_forcing - use marbl_sizes , only : marbl_total_tracer_cnt - use marbl_internal_types, only : marbl_internal_timers_type - use marbl_internal_types, only : marbl_timer_indexing_type - use marbl_internal_types, only : marbl_interior_saved_state_indexing_type - use marbl_restore_mod , only : marbl_restore_compute_interior_restore + use marbl_ciso_mod, only : marbl_ciso_set_interior_forcing + use marbl_interface_private_types, only : marbl_internal_timers_type + use marbl_interface_private_types, only : marbl_timer_indexing_type + use marbl_interface_private_types, only : marbl_interior_saved_state_indexing_type + use marbl_restore_mod, only : marbl_restore_compute_interior_restore type (marbl_domain_type) , intent(in) :: domain type(marbl_forcing_fields_type) , intent(in) :: interior_forcings(:) - real (r8) , intent(in) :: tracers(:,: ) ! (marbl_total_tracer_cnt, km) tracer values + real (r8) , intent(in) :: tracers(:,: ) ! (tracer_cnt, km) tracer values type(marbl_surface_forcing_indexing_type) , intent(in) :: surface_forcing_indices type(marbl_interior_forcing_indexing_type) , intent(in) :: interior_forcing_indices type (marbl_PAR_type) , intent(inout) :: PAR type (marbl_saved_state_type) , intent(inout) :: saved_state type (marbl_interior_saved_state_indexing_type), intent(in) :: saved_state_ind - real (r8) , intent(out) :: dtracers(:,:) ! (marbl_total_tracer_cnt, km) computed source/sink terms + real (r8) , intent(out) :: dtracers(:,:) ! (tracer_cnt, km) computed source/sink terms type (marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices type (marbl_internal_timers_type) , intent(inout) :: marbl_timers type (marbl_timer_indexing_type) , intent(in) :: marbl_timer_indices @@ -954,7 +500,7 @@ subroutine marbl_set_interior_forcing( & !----------------------------------------------------------------------- character(len=*), parameter :: subname = 'marbl_mod:marbl_set_interior_forcing' - real(r8), dimension(marbl_total_tracer_cnt, domain%km) :: interior_restore + real(r8), dimension(size(tracers,1), domain%km) :: interior_restore type(marbl_interior_share_type) :: marbl_interior_share(domain%km) type(marbl_autotroph_share_type) :: marbl_autotroph_share(autotroph_cnt, domain%km) @@ -984,7 +530,7 @@ subroutine marbl_set_interior_forcing( & real (r8) :: Lig_deg(domain%km) ! loss of Fe-binding Ligand from bacterial degradation real (r8) :: Lig_loss(domain%km) ! loss of Fe-binding Ligand real (r8) :: totalChl_local(domain%km) ! local value of totalChl - real (r8) :: tracer_local(ecosys_base_tracer_cnt, domain%km) + real (r8) :: tracer_local(marbl_tracer_indices%ecosys_base%cnt, domain%km) type(zooplankton_local_type) :: zooplankton_local(zooplankton_cnt, domain%km) type(autotroph_local_type) :: autotroph_local(autotroph_cnt, domain%km) @@ -1106,8 +652,8 @@ subroutine marbl_set_interior_forcing( & call marbl_compute_Pprime(k, domain, autotroph_cnt, autotrophs, & autotroph_local(:, k), temperature(k), autotroph_secondary_species(:, k)) - call marbl_compute_autotroph_uptake(autotroph_cnt, autotrophs_config, & - autotrophs, tracer_local(:, k), marbl_tracer_indices, & + call marbl_compute_autotroph_uptake(autotroph_cnt, autotrophs, & + tracer_local(:, k), marbl_tracer_indices, & autotroph_secondary_species(:, k)) call marbl_compute_autotroph_photosynthesis(autotroph_cnt, & @@ -1120,22 +666,23 @@ subroutine marbl_set_interior_forcing( & autotroph_secondary_species(:, k)) call marbl_compute_autotroph_calcification(autotroph_cnt, & - autotrophs_config, autotroph_local(:, k), temperature(k), & + autotrophs, autotroph_local(:, k), temperature(k), & autotroph_secondary_species(:, k)) - call marbl_compute_autotroph_nfixation(autotroph_cnt, autotrophs_config, & + call marbl_compute_autotroph_nfixation(autotroph_cnt, autotrophs, & autotroph_secondary_species(:, k)) - call marbl_compute_autotroph_loss(autotroph_cnt, autotrophs_config, & - autotrophs, Tfunc(k), autotroph_secondary_species(:, k)) + call marbl_compute_autotroph_loss(autotroph_cnt, autotrophs, & + Tfunc(k), autotroph_secondary_species(:, k)) call marbl_compute_Zprime(k, domain, & zooplankton_cnt, zooplankton, zooplankton_local(:, k)%C, & Tfunc(k), zooplankton_secondary_species(:, k)) - call marbl_compute_grazing (autotroph_cnt, zooplankton_cnt, & - grazer_prey_cnt, autotrophs_config, Tfunc(k), zooplankton_local(:, k), & - zooplankton_secondary_species(:, k), autotroph_secondary_species(:, k)) + call marbl_compute_grazing (autotroph_cnt, zooplankton_cnt, & + max_grazer_prey_cnt, autotrophs, Tfunc(k), zooplankton_local(:, k), & + zooplankton_secondary_species(:, k), & + autotroph_secondary_species(:, k)) call marbl_compute_routing (autotroph_cnt, zooplankton_cnt, autotrophs, & zooplankton_secondary_species(:, k), autotroph_secondary_species(:, k)) @@ -1195,7 +742,7 @@ subroutine marbl_set_interior_forcing( & POC%remin(k), other_remin(k), sed_denitrif(k), denitrif(k)) call marbl_compute_dtracer_local (autotroph_cnt, zooplankton_cnt, & - autotrophs_config, autotrophs, zooplankton, & + autotrophs, zooplankton, & autotroph_secondary_species(:, k), & zooplankton_secondary_species(:, k), & dissolved_organic_matter(k), & @@ -1302,9 +849,9 @@ subroutine marbl_init_particulate_terms(k, surface_forcing_indices, & ! !USES: - use marbl_parms, only : parm_POC_diss - use marbl_parms, only : parm_CaCO3_diss - use marbl_parms, only : parm_SiO2_diss + use marbl_settings_mod, only : parm_POC_diss + use marbl_settings_mod, only : parm_CaCO3_diss + use marbl_settings_mod, only : parm_SiO2_diss integer(int_kind) , intent(in) :: k real (r8) , intent(in) :: net_dust_in ! dust flux @@ -1525,31 +1072,31 @@ subroutine marbl_compute_particulate_terms(k, domain, & ! !USES: use marbl_constants_mod, only : Tref - use marbl_parms , only : parm_Fe_desorption_rate0 - use marbl_parms , only : parm_sed_denitrif_coeff - - integer (int_kind) , intent(in) :: k ! vertical model level - type(marbl_domain_type) , intent(in) :: domain - real (r8) , intent(in) :: temperature ! temperature for scaling functions bsi%diss - real (r8), dimension(ecosys_base_tracer_cnt) , intent(in) :: tracer_local ! local copies of model tracer concentrations - type(carbonate_type) , intent(in) :: carbonate - real(r8) , intent(in) :: fesedflux ! sedimentary Fe input - real(r8) , intent(out) :: PON_remin ! remin of PON - real(r8) , intent(out) :: PON_sed_loss ! loss of PON to sediments - type(column_sinking_particle_type) , intent(inout) :: POC ! base units = nmol C - type(column_sinking_particle_type) , intent(inout) :: POP ! base units = nmol P - type(column_sinking_particle_type) , intent(inout) :: P_CaCO3 ! base units = nmol CaCO3 - type(column_sinking_particle_type) , intent(inout) :: P_CaCO3_ALT_CO2 ! base units = nmol CaCO3 - type(column_sinking_particle_type) , intent(inout) :: P_SiO2 ! base units = nmol SiO2 - type(column_sinking_particle_type) , intent(inout) :: dust ! base units = g - type(column_sinking_particle_type) , intent(inout) :: P_iron ! base units = nmol Fe - real (r8) , intent(inout) :: QA_dust_def ! incoming deficit in the QA(dust) POC flux - real (r8) , intent(out) :: sed_denitrif ! sedimentary denitrification (umolN/cm^2/s) - real (r8) , intent(out) :: other_remin ! sedimentary remin not due to oxic or denitrification - type(marbl_particulate_share_type) , intent(inout) :: marbl_particulate_share - type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices - real (r8) , intent(inout) :: glo_avg_fields_interior(:) - type(marbl_log_type) , intent(inout) :: marbl_status_log + use marbl_settings_mod , only : parm_Fe_desorption_rate0 + use marbl_settings_mod , only : parm_sed_denitrif_coeff + + integer (int_kind) , intent(in) :: k ! vertical model level + type(marbl_domain_type) , intent(in) :: domain + real (r8) , intent(in) :: temperature ! temperature for scaling functions bsi%diss + real (r8), dimension(:) , intent(in) :: tracer_local ! local copies of model tracer concentrations + type(carbonate_type) , intent(in) :: carbonate + real(r8) , intent(in) :: fesedflux ! sedimentary Fe input + real(r8) , intent(out) :: PON_remin ! remin of PON + real(r8) , intent(out) :: PON_sed_loss ! loss of PON to sediments + type(column_sinking_particle_type), intent(inout) :: POC ! base units = nmol C + type(column_sinking_particle_type), intent(inout) :: POP ! base units = nmol P + type(column_sinking_particle_type), intent(inout) :: P_CaCO3 ! base units = nmol CaCO3 + type(column_sinking_particle_type), intent(inout) :: P_CaCO3_ALT_CO2 ! base units = nmol CaCO3 + type(column_sinking_particle_type), intent(inout) :: P_SiO2 ! base units = nmol SiO2 + type(column_sinking_particle_type), intent(inout) :: dust ! base units = g + type(column_sinking_particle_type), intent(inout) :: P_iron ! base units = nmol Fe + real (r8) , intent(inout) :: QA_dust_def ! incoming deficit in the QA(dust) POC flux + real (r8) , intent(out) :: sed_denitrif ! sedimentary denitrification (umolN/cm^2/s) + real (r8) , intent(out) :: other_remin ! sedimentary remin not due to oxic or denitrification + type(marbl_particulate_share_type), intent(inout) :: marbl_particulate_share + type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices + real (r8) , intent(inout) :: glo_avg_fields_interior(:) + type(marbl_log_type) , intent(inout) :: marbl_status_log !----------------------------------------------------------------------- ! local variables @@ -2247,22 +1794,21 @@ subroutine marbl_set_surface_forcing( & ! Compute surface forcing fluxes - use marbl_interface_types , only : sfo_ind - use marbl_internal_types , only : marbl_surface_saved_state_indexing_type - use marbl_schmidt_number_mod , only : schmidt_co2_surf - use marbl_oxygen , only : schmidt_o2_surf - use marbl_co2calc_mod , only : marbl_co2calc_surf - use marbl_co2calc_mod , only : co2calc_coeffs_type - use marbl_co2calc_mod , only : co2calc_state_type - use marbl_oxygen , only : o2sat_surf - use marbl_constants_mod , only : molw_Fe + use marbl_interface_public_types, only : sfo_ind + use marbl_interface_private_types, only : marbl_surface_saved_state_indexing_type + use marbl_schmidt_number_mod, only : schmidt_co2_surf + use marbl_oxygen, only : schmidt_o2_surf + use marbl_co2calc_mod, only : marbl_co2calc_surf + use marbl_co2calc_mod, only : co2calc_coeffs_type + use marbl_co2calc_mod, only : co2calc_state_type + use marbl_oxygen, only : o2sat_surf + use marbl_constants_mod, only : molw_Fe use marbl_nhx_surface_emis_mod, only : marbl_comp_nhx_surface_emis - use marbl_config_mod , only : lcompute_nhx_surface_emis - use marbl_parms , only : xkw_coeff - use marbl_parms , only : iron_frac_in_dust - use marbl_parms , only : iron_frac_in_bc - use marbl_sizes , only : marbl_total_tracer_cnt - use marbl_ciso_mod , only : marbl_ciso_set_surface_forcing + use marbl_settings_mod, only : lcompute_nhx_surface_emis + use marbl_settings_mod, only : xkw_coeff + use marbl_settings_mod, only : iron_frac_in_dust + use marbl_settings_mod, only : iron_frac_in_bc + use marbl_ciso_mod, only : marbl_ciso_set_surface_forcing implicit none @@ -2671,194 +2217,7 @@ end subroutine marbl_set_surface_forcing !*********************************************************************** - subroutine marbl_init_non_autotroph_tracer_metadata(short_name, long_name, & - marbl_tracer_metadata) - - !----------------------------------------------------------------------- - ! initialize non-autotroph tracer_d values and accumulate - ! non_living_biomass_ecosys_tracer_cnt - !----------------------------------------------------------------------- - - implicit none - - character(len=*), intent(in) :: short_name - character(len=*), intent(in) :: long_name - type(marbl_tracer_metadata_type), intent(inout) :: marbl_tracer_metadata - - marbl_tracer_metadata%short_name = short_name - marbl_tracer_metadata%long_name = long_name - if ((trim(short_name) == "ALK") .or. & - (trim(short_name) == "ALK_ALT_CO2")) then - marbl_tracer_metadata%units = 'meq/m^3' - marbl_tracer_metadata%tend_units = 'meq/m^3/s' - marbl_tracer_metadata%flux_units = 'meq/m^3 cm/s' - else - marbl_tracer_metadata%units = 'mmol/m^3' - marbl_tracer_metadata%tend_units = 'mmol/m^3/s' - marbl_tracer_metadata%flux_units = 'mmol/m^3 cm/s' - endif - - end subroutine marbl_init_non_autotroph_tracer_metadata - - !*********************************************************************** - - subroutine marbl_init_non_autotroph_tracers_metadata(marbl_tracer_metadata, & - marbl_tracer_indices) - - !----------------------------------------------------------------------- - ! initialize non-autotroph tracer_d values and accumulate - ! non_living_biomass_ecosys_tracer_cnt - !----------------------------------------------------------------------- - - implicit none - - type(marbl_tracer_metadata_type) , intent(inout) :: marbl_tracer_metadata(:) ! descriptors for each tracer - type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices - - call marbl_init_non_autotroph_tracer_metadata('PO4', 'Dissolved Inorganic Phosphate', & - marbl_tracer_metadata(marbl_tracer_indices%po4_ind)) - call marbl_init_non_autotroph_tracer_metadata('NO3', 'Dissolved Inorganic Nitrate', & - marbl_tracer_metadata(marbl_tracer_indices%no3_ind)) - call marbl_init_non_autotroph_tracer_metadata('SiO3', 'Dissolved Inorganic Silicate', & - marbl_tracer_metadata(marbl_tracer_indices%sio3_ind)) - call marbl_init_non_autotroph_tracer_metadata('NH4', 'Dissolved Ammonia', & - marbl_tracer_metadata(marbl_tracer_indices%nh4_ind)) - call marbl_init_non_autotroph_tracer_metadata('Fe', 'Dissolved Inorganic Iron', & - marbl_tracer_metadata(marbl_tracer_indices%fe_ind)) - call marbl_init_non_autotroph_tracer_metadata('Lig', 'Iron Binding Ligand', & - marbl_tracer_metadata(marbl_tracer_indices%lig_ind)) - call marbl_init_non_autotroph_tracer_metadata('O2', 'Dissolved Oxygen', & - marbl_tracer_metadata(marbl_tracer_indices%o2_ind)) - call marbl_init_non_autotroph_tracer_metadata('DIC', 'Dissolved Inorganic Carbon', & - marbl_tracer_metadata(marbl_tracer_indices%dic_ind)) - call marbl_init_non_autotroph_tracer_metadata('ALK', 'Alkalinity', & - marbl_tracer_metadata(marbl_tracer_indices%alk_ind)) - call marbl_init_non_autotroph_tracer_metadata('DOC', 'Dissolved Organic Carbon', & - marbl_tracer_metadata(marbl_tracer_indices%doc_ind)) - call marbl_init_non_autotroph_tracer_metadata('DON', 'Dissolved Organic Nitrogen', & - marbl_tracer_metadata(marbl_tracer_indices%don_ind)) - call marbl_init_non_autotroph_tracer_metadata('DOP', 'Dissolved Organic Phosphorus', & - marbl_tracer_metadata(marbl_tracer_indices%dop_ind)) - call marbl_init_non_autotroph_tracer_metadata('DOPr', 'Refractory DOP', & - marbl_tracer_metadata(marbl_tracer_indices%dopr_ind)) - call marbl_init_non_autotroph_tracer_metadata('DONr', 'Refractory DON', & - marbl_tracer_metadata(marbl_tracer_indices%donr_ind)) - call marbl_init_non_autotroph_tracer_metadata('DOCr', 'Refractory DOC', & - marbl_tracer_metadata(marbl_tracer_indices%docr_ind)) - - call marbl_init_non_autotroph_tracer_metadata('DIC_ALT_CO2', 'Dissolved Inorganic Carbon, Alternative CO2', & - marbl_tracer_metadata(marbl_tracer_indices%dic_alt_co2_ind)) - call marbl_init_non_autotroph_tracer_metadata('ALK_ALT_CO2', 'Alkalinity, Alternative CO2', & - marbl_tracer_metadata(marbl_tracer_indices%alk_alt_co2_ind)) - - end subroutine marbl_init_non_autotroph_tracers_metadata - - !*********************************************************************** - - subroutine marbl_init_zooplankton_tracer_metadata(marbl_tracer_metadata, & - marbl_tracer_indices) - - !----------------------------------------------------------------------- - ! initialize zooplankton tracer_d values and tracer indices - !----------------------------------------------------------------------- - - implicit none - - type (marbl_tracer_metadata_type) , intent(inout) :: marbl_tracer_metadata(:) ! descriptors for each tracer - type (marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices - - !----------------------------------------------------------------------- - ! local variables - !----------------------------------------------------------------------- - integer (int_kind) :: n, zoo_ind ! zooplankton functional group index - !----------------------------------------------------------------------- - - do zoo_ind = 1, zooplankton_cnt - n = marbl_tracer_indices%zoo_inds(zoo_ind)%C_ind - marbl_tracer_metadata(n)%short_name = trim(zooplankton_config(zoo_ind)%sname) // 'C' - marbl_tracer_metadata(n)%long_name = trim(zooplankton_config(zoo_ind)%lname) // ' Carbon' - marbl_tracer_metadata(n)%units = 'mmol/m^3' - marbl_tracer_metadata(n)%tend_units = 'mmol/m^3/s' - marbl_tracer_metadata(n)%flux_units = 'mmol/m^3 cm/s' - end do - - end subroutine marbl_init_zooplankton_tracer_metadata - - !*********************************************************************** - - subroutine marbl_init_autotroph_tracer_metadata(marbl_tracer_metadata, & - marbl_tracer_indices) - - !----------------------------------------------------------------------- - ! initialize autotroph tracer_d values and tracer indices - !----------------------------------------------------------------------- - - implicit none - - type (marbl_tracer_metadata_type) , intent(inout) :: marbl_tracer_metadata(:) ! descriptors for each tracer - type (marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices - - !----------------------------------------------------------------------- - ! local variables - !----------------------------------------------------------------------- - integer (int_kind) :: n, auto_ind - !----------------------------------------------------------------------- - - do auto_ind = 1, autotroph_cnt - n = marbl_tracer_indices%auto_inds(auto_ind)%Chl_ind - marbl_tracer_metadata(n)%short_name = trim(autotrophs_config(auto_ind)%sname) // 'Chl' - marbl_tracer_metadata(n)%long_name = trim(autotrophs_config(auto_ind)%lname) // ' Chlorophyll' - marbl_tracer_metadata(n)%units = 'mg/m^3' - marbl_tracer_metadata(n)%tend_units = 'mg/m^3/s' - marbl_tracer_metadata(n)%flux_units = 'mg/m^3 cm/s' - - n = marbl_tracer_indices%auto_inds(auto_ind)%C_ind - marbl_tracer_metadata(n)%short_name = trim(autotrophs_config(auto_ind)%sname) // 'C' - marbl_tracer_metadata(n)%long_name = trim(autotrophs_config(auto_ind)%lname) // ' Carbon' - marbl_tracer_metadata(n)%units = 'mmol/m^3' - marbl_tracer_metadata(n)%tend_units = 'mmol/m^3/s' - marbl_tracer_metadata(n)%flux_units = 'mmol/m^3 cm/s' - - n = marbl_tracer_indices%auto_inds(auto_ind)%P_ind - if (n.gt.0) then - marbl_tracer_metadata(n)%short_name = trim(autotrophs_config(auto_ind)%sname) // 'P' - marbl_tracer_metadata(n)%long_name = trim(autotrophs_config(auto_ind)%lname) // ' Phosphorus' - marbl_tracer_metadata(n)%units = 'mmol/m^3' - marbl_tracer_metadata(n)%tend_units = 'mmol/m^3/s' - marbl_tracer_metadata(n)%flux_units = 'mmol/m^3 cm/s' - endif - - n = marbl_tracer_indices%auto_inds(auto_ind)%Fe_ind - marbl_tracer_metadata(n)%short_name = trim(autotrophs_config(auto_ind)%sname) // 'Fe' - marbl_tracer_metadata(n)%long_name = trim(autotrophs_config(auto_ind)%lname) // ' Iron' - marbl_tracer_metadata(n)%units = 'mmol/m^3' - marbl_tracer_metadata(n)%tend_units = 'mmol/m^3/s' - marbl_tracer_metadata(n)%flux_units = 'mmol/m^3 cm/s' - - n = marbl_tracer_indices%auto_inds(auto_ind)%Si_ind - if (n .gt. 0) then - marbl_tracer_metadata(n)%short_name = trim(autotrophs_config(auto_ind)%sname) // 'Si' - marbl_tracer_metadata(n)%long_name = trim(autotrophs_config(auto_ind)%lname) // ' Silicon' - marbl_tracer_metadata(n)%units = 'mmol/m^3' - marbl_tracer_metadata(n)%tend_units = 'mmol/m^3/s' - marbl_tracer_metadata(n)%flux_units = 'mmol/m^3 cm/s' - endif - - n = marbl_tracer_indices%auto_inds(auto_ind)%CaCO3_ind - if (n .gt. 0) then - marbl_tracer_metadata(n)%short_name = trim(autotrophs_config(auto_ind)%sname) // 'CaCO3' - marbl_tracer_metadata(n)%long_name = trim(autotrophs_config(auto_ind)%lname) // ' CaCO3' - marbl_tracer_metadata(n)%units = 'mmol/m^3' - marbl_tracer_metadata(n)%tend_units = 'mmol/m^3/s' - marbl_tracer_metadata(n)%flux_units = 'mmol/m^3 cm/s' - endif - end do - - end subroutine marbl_init_autotroph_tracer_metadata - - !*********************************************************************** - - subroutine marbl_setup_local_tracers(column_kmt, marbl_tracer_indices, autotroph_parms, & + subroutine marbl_setup_local_tracers(column_kmt, marbl_tracer_indices, autotrophs, & tracers, tracer_local, zooplankton_local, autotroph_local, totalChl_local) !----------------------------------------------------------------------- @@ -2870,7 +2229,7 @@ subroutine marbl_setup_local_tracers(column_kmt, marbl_tracer_indices, autotroph integer(int_kind) , intent(in) :: column_kmt type(marbl_tracer_index_type), intent(in) :: marbl_tracer_indices - type(autotroph_parms_type) , intent(in) :: autotroph_parms(:) + type(autotroph_type) , intent(in) :: autotrophs(:) real (r8) , intent(in) :: tracers(:,:) real (r8) , intent(out) :: tracer_local(:,:) type(zooplankton_local_type) , intent(out) :: zooplankton_local(:,:) @@ -2885,11 +2244,11 @@ subroutine marbl_setup_local_tracers(column_kmt, marbl_tracer_indices, autotroph !----------------------------------------------------------------------- do k = 1, column_kmt - tracer_local(1:ecosys_base_tracer_cnt,k) = max(c0, tracers(1:ecosys_base_tracer_cnt,k)) + tracer_local(:,k) = max(c0, tracers(1:size(tracer_local,1),k)) end do - do k = column_kmt+1, size(tracers,2) - tracer_local(1:ecosys_base_tracer_cnt,k) = c0 + do k = column_kmt+1, size(tracer_local,2) + tracer_local(:,k) = c0 end do !----------------------------------------------------------------------- @@ -2917,7 +2276,7 @@ subroutine marbl_setup_local_tracers(column_kmt, marbl_tracer_indices, autotroph autotroph_local(auto_ind,:)%P = tracer_local(n,:) else autotroph_local(auto_ind,:)%P = & - autotroph_parms(auto_ind)%Qp_fixed * autotroph_local(auto_ind,:)%C + autotrophs(auto_ind)%Qp_fixed * autotroph_local(auto_ind,:)%C endif n = marbl_tracer_indices%auto_inds(auto_ind)%Fe_ind @@ -2945,41 +2304,6 @@ end subroutine marbl_setup_local_tracers !*********************************************************************** - subroutine marbl_tracer_index_consistency_check(tracer_indices, marbl_status_log) - - use marbl_ciso_mod, only : marbl_ciso_tracer_index_consistency_check - - type(marbl_tracer_index_type), intent(in) :: tracer_indices - type(marbl_log_type), intent(inout) :: marbl_status_log - - character(len=*), parameter :: subname = 'marbl_mod:marbl_tracer_index_consistency_check' - character(len=char_len) :: log_message - - integer :: tracer_cnt - - tracer_cnt = tracer_indices%ecosys_base_ind_end - & - (tracer_indices%ecosys_base_ind_beg-1) - if (tracer_cnt.ne.ecosys_base_tracer_cnt) then - write(log_message, "(A,I0,A,I0)") "Expected ", ecosys_base_tracer_cnt, & - " base tracers, but provided indexes for ", tracer_cnt - call marbl_status_log%log_error(log_message, subname) - return - end if - - if (ciso_on) then - call marbl_ciso_tracer_index_consistency_check(tracer_indices, & - marbl_status_log) - if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('ciso_tracer_ind_consistency', & - subname) - return - end if - end if - - end subroutine marbl_tracer_index_consistency_check - - !*********************************************************************** - subroutine marbl_consistency_check_autotrophs(auto_cnt, column_kmt, & marbl_tracer_indices, autotroph_local) @@ -3036,25 +2360,25 @@ end subroutine marbl_consistency_check_autotrophs !*********************************************************************** - subroutine marbl_compute_autotroph_elemental_ratios(auto_cnt, autotroph_parms, & - autotroph_local, tracer_local, marbl_tracer_indices, & + subroutine marbl_compute_autotroph_elemental_ratios(auto_cnt, autotrophs, & + autotroph_local, tracer_local, marbl_tracer_indices, & autotroph_secondary_species) use marbl_constants_mod, only : epsC - use marbl_config_mod , only : lvariable_PtoC - use marbl_parms , only : gQsi_0 - use marbl_parms , only : gQsi_max - use marbl_parms , only : gQsi_min - use marbl_parms , only : PquotaSlope, PquotaIntercept, PquotaMinNP + use marbl_settings_mod , only : lvariable_PtoC + use marbl_settings_mod , only : gQsi_0 + use marbl_settings_mod , only : gQsi_max + use marbl_settings_mod , only : gQsi_min + use marbl_settings_mod , only : PquotaSlope, PquotaIntercept, PquotaMinNP implicit none - integer (int_kind) , intent(in) :: auto_cnt - type(autotroph_parms_type) , intent(in) :: autotroph_parms(auto_cnt) ! autotrophs - type(autotroph_local_type) , intent(in) :: autotroph_local(auto_cnt) - real (r8) , intent(in) :: tracer_local(ecosys_base_tracer_cnt) ! local copies of model tracer concentrations - type(marbl_tracer_index_type), intent(in) :: marbl_tracer_indices - type(autotroph_secondary_species_type), intent(inout) :: autotroph_secondary_species(auto_cnt) + integer (int_kind) , intent(in) :: auto_cnt + type(autotroph_type) , intent(in) :: autotrophs(:) ! autotrophs + type(autotroph_local_type) , intent(in) :: autotroph_local(:) + real (r8) , intent(in) :: tracer_local(:) ! local copies of model tracer concentrations + type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices + type(autotroph_secondary_species_type), intent(inout) :: autotroph_secondary_species(:) !----------------------------------------------------------------------- ! local variables @@ -3093,7 +2417,7 @@ subroutine marbl_compute_autotroph_elemental_ratios(auto_cnt, autotroph_parms, & if (lvariable_PtoC) then Qp(auto_ind) = auto_P(auto_ind) / (auto_C(auto_ind) + epsC) else - Qp(auto_ind) = autotroph_parms(auto_ind)%Qp_fixed + Qp(auto_ind) = autotrophs(auto_ind)%Qp_fixed endif Qfe(auto_ind) = auto_Fe(auto_ind) / (auto_C(auto_ind) + epsC) if (marbl_tracer_indices%auto_inds(auto_ind)%Si_ind > 0) then @@ -3181,7 +2505,7 @@ subroutine marbl_compute_PAR(domain, interior_forcings, interior_forcing_ind, & integer(int_kind) , intent(in) :: auto_cnt type(marbl_domain_type) , intent(in) :: domain - type(marbl_forcing_fields_type) , intent(in) :: interior_forcings(:) ! (num_elements, num_interior_forcing_fields_0d) + type(marbl_forcing_fields_type) , intent(in) :: interior_forcings(:) type(marbl_interior_forcing_indexing_type), intent(in) :: interior_forcing_ind real(r8) , intent(in) :: totalChl_local(:) type(marbl_PAR_type) , intent(inout) :: PAR @@ -3305,13 +2629,13 @@ subroutine marbl_compute_carbonate_chemistry(domain, temperature, press_bar, & real (r8) , intent(in) :: temperature(:) real (r8) , intent(in) :: press_bar(:) real (r8) , intent(in) :: salinity(:) - real (r8) , intent(in) :: tracer_local(ecosys_base_tracer_cnt,domain%km) ! local copies of model tracer concentrations + real (r8) , intent(in) :: tracer_local(:,:) ! local copies of model tracer concentrations type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices - type(carbonate_type) , intent(out) :: carbonate(domain%km) - real(r8) , intent(inout) :: ph_prev_col(domain%km) - real(r8) , intent(inout) :: ph_prev_alt_co2_col(domain%km) - real(r8) , intent(inout) :: zsat_calcite(domain%km) ! Calcite Saturation Depth - real(r8) , intent(inout) :: zsat_aragonite(domain%km) ! Aragonite Saturation Depth + type(carbonate_type) , intent(out) :: carbonate(:) ! km + real(r8) , intent(inout) :: ph_prev_col(:) ! km + real(r8) , intent(inout) :: ph_prev_alt_co2_col(:) ! km + real(r8) , intent(inout) :: zsat_calcite(:) ! Calcite Saturation Depth (km) + real(r8) , intent(inout) :: zsat_aragonite(:) ! Aragonite Saturation Depth (km) type(marbl_log_type) , intent(inout) :: marbl_status_log !----------------------------------------------------------------------- @@ -3428,7 +2752,7 @@ subroutine marbl_compute_function_scaling(column_temperature, Tfunc ) ! growth, mort and grazing rates scaled by Tfunc where they are computed !----------------------------------------------------------------------- - use marbl_parms, only : Q_10 + use marbl_settings_mod, only : Q_10 use marbl_constants_mod, only : Tref use marbl_constants_mod, only : c10 @@ -3441,16 +2765,16 @@ end subroutine marbl_compute_function_scaling !*********************************************************************** - subroutine marbl_compute_Pprime(k, domain, auto_cnt, auto_meta, & + subroutine marbl_compute_Pprime(k, domain, auto_cnt, autotrophs, & autotroph_local, column_temperature, autotroph_secondary_species) - use marbl_parms , only : thres_z1_auto - use marbl_parms , only : thres_z2_auto + use marbl_settings_mod, only : thres_z1_auto + use marbl_settings_mod, only : thres_z2_auto integer(int_kind) , intent(in) :: k type(marbl_domain_type) , intent(in) :: domain integer(int_kind) , intent(in) :: auto_cnt - type(autotroph_parms_type) , intent(in) :: auto_meta(auto_cnt) + type(autotroph_type) , intent(in) :: autotrophs(auto_cnt) type(autotroph_local_type) , intent(in) :: autotroph_local(auto_cnt) real(r8) , intent(in) :: column_temperature type(autotroph_secondary_species_type) , intent(out) :: autotroph_secondary_species(auto_cnt) @@ -3481,10 +2805,10 @@ subroutine marbl_compute_Pprime(k, domain, auto_cnt, auto_meta, & ! Compute Pprime for all autotrophs, used for loss terms do auto_ind = 1, auto_cnt - if (column_temperature < auto_meta(auto_ind)%temp_thres) then - C_loss_thres = f_loss_thres * auto_meta(auto_ind)%loss_thres2 + if (column_temperature < autotrophs(auto_ind)%temp_thres) then + C_loss_thres = f_loss_thres * autotrophs(auto_ind)%loss_thres2 else - C_loss_thres = f_loss_thres * auto_meta(auto_ind)%loss_thres + C_loss_thres = f_loss_thres * autotrophs(auto_ind)%loss_thres end if Pprime(auto_ind) = max(autotroph_local(auto_ind)%C - C_loss_thres, c0) end do @@ -3496,16 +2820,16 @@ end subroutine marbl_compute_Pprime !*********************************************************************** subroutine marbl_compute_Zprime(k, domain, & - zoo_cnt, zoo_meta, zooC, & + zoo_cnt, zooplankton, zooC, & Tfunc, zooplankton_secondary_species) - use marbl_parms , only : thres_z1_zoo - use marbl_parms , only : thres_z2_zoo + use marbl_settings_mod, only : thres_z1_zoo + use marbl_settings_mod, only : thres_z2_zoo integer(int_kind) , intent(in) :: k type(marbl_domain_type) , intent(in) :: domain integer(int_kind) , intent(in) :: zoo_cnt - type(zooplankton_parms_type) , intent(in) :: zoo_meta(zoo_cnt) + type(zooplankton_type) , intent(in) :: zooplankton(zoo_cnt) real(r8) , intent(in) :: zooC(zoo_cnt) real(r8) , intent(in) :: Tfunc type(zooplankton_secondary_species_type) , intent(inout) :: zooplankton_secondary_species(zoo_cnt) @@ -3536,11 +2860,11 @@ subroutine marbl_compute_Zprime(k, domain, & endif do zoo_ind = 1, zoo_cnt - C_loss_thres = f_loss_thres * zoo_meta(zoo_ind)%loss_thres + C_loss_thres = f_loss_thres * zooplankton(zoo_ind)%loss_thres Zprime(zoo_ind) = max(zooC(zoo_ind) - C_loss_thres, c0) - zoo_loss(zoo_ind) = ( zoo_meta(zoo_ind)%z_mort2_0 * Zprime(zoo_ind)**1.5_r8 + & - zoo_meta(zoo_ind)%z_mort_0 * Zprime(zoo_ind)) * Tfunc + zoo_loss(zoo_ind) = ( zooplankton(zoo_ind)%z_mort2_0 * Zprime(zoo_ind)**1.5_r8 + & + zooplankton(zoo_ind)%z_mort_0 * Zprime(zoo_ind)) * Tfunc end do end associate @@ -3548,15 +2872,14 @@ end subroutine marbl_compute_Zprime !*********************************************************************** - subroutine marbl_compute_autotroph_uptake (auto_cnt, auto_config, auto_meta, & + subroutine marbl_compute_autotroph_uptake (auto_cnt, autotrophs, & tracer_local, marbl_tracer_indices, autotroph_secondary_species) integer(int_kind) , intent(in) :: auto_cnt - type(autotroph_config_type) , intent(in) :: auto_config(auto_cnt) - type(autotroph_parms_type) , intent(in) :: auto_meta(auto_cnt) - real(r8) , intent(in) :: tracer_local(ecosys_base_tracer_cnt) + type(autotroph_type) , intent(in) :: autotrophs(:) + real(r8) , intent(in) :: tracer_local(:) type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices - type(autotroph_secondary_species_type) , intent(out) :: autotroph_secondary_species(auto_cnt) + type(autotroph_secondary_species_type) , intent(out) :: autotroph_secondary_species(:) !----------------------------------------------------------------------- ! local variables @@ -3589,16 +2912,15 @@ subroutine marbl_compute_autotroph_uptake (auto_cnt, auto_config, auto_meta, & VPO4 => autotroph_secondary_species(auto_ind)%VPO4, & VPtot => autotroph_secondary_species(auto_ind)%VPtot, & VSiO3 => autotroph_secondary_species(auto_ind)%VSiO3, & - ! AUTO_CONFIG - Nfixer => auto_config(auto_ind)%Nfixer, & - silicifier => auto_config(auto_ind)%silicifier, & - ! AUTO_META - kNO3 => auto_meta(auto_ind)%kNO3, & - kNH4 => auto_meta(auto_ind)%kNH4, & - kFe => auto_meta(auto_ind)%kFe, & - kPO4 => auto_meta(auto_ind)%kPO4, & - kDOP => auto_meta(auto_ind)%kDOP, & - kSiO3 => auto_meta(auto_ind)%kSiO3 & + ! AUTOTROPHS + Nfixer => autotrophs(auto_ind)%Nfixer, & + silicifier => autotrophs(auto_ind)%silicifier, & + kNO3 => autotrophs(auto_ind)%kNO3, & + kNH4 => autotrophs(auto_ind)%kNH4, & + kFe => autotrophs(auto_ind)%kFe, & + kPO4 => autotrophs(auto_ind)%kPO4, & + kDOP => autotrophs(auto_ind)%kDOP, & + kSiO3 => autotrophs(auto_ind)%kSiO3 & ) VNO3 = (NO3_loc / kNO3) / (c1 + (NO3_loc / kNO3) + (NH4_loc / kNH4)) @@ -3632,8 +2954,8 @@ end subroutine marbl_compute_autotroph_uptake !*********************************************************************** - subroutine marbl_compute_autotroph_photosynthesis (auto_cnt, PAR_nsubcols, & - auto_meta, autotroph_loc, temperature, Tfunc, PAR_col_frac, PAR_avg, & + subroutine marbl_compute_autotroph_photosynthesis (auto_cnt, PAR_nsubcols, & + autotrophs, autotroph_loc, temperature, Tfunc, PAR_col_frac, PAR_avg, & autotroph_secondary_species) !----------------------------------------------------------------------- @@ -3644,7 +2966,7 @@ subroutine marbl_compute_autotroph_photosynthesis (auto_cnt, PAR_nsubcols, & integer(int_kind) , intent(in) :: auto_cnt integer(int_kind) , intent(in) :: PAR_nsubcols - type(autotroph_parms_type) , intent(in) :: auto_meta(auto_cnt) + type(autotroph_type) , intent(in) :: autotrophs(auto_cnt) type(autotroph_local_type) , intent(in) :: autotroph_loc(auto_cnt) real(r8) , intent(in) :: temperature real(r8) , intent(in) :: Tfunc @@ -3674,9 +2996,8 @@ subroutine marbl_compute_autotroph_photosynthesis (auto_cnt, PAR_nsubcols, & PCPhoto => autotroph_secondary_species(auto_ind)%PCPhoto, & photoC => autotroph_secondary_species(auto_ind)%photoC, & photoacc => autotroph_secondary_species(auto_ind)%photoacc, & - - PCref => auto_meta(auto_ind)%PCref, & - alphaPI => auto_meta(auto_ind)%alphaPI & + PCref => autotrophs(auto_ind)%PCref, & + alphaPI => autotrophs(auto_ind)%alphaPI & ) PCmax = PCref * f_nut * Tfunc @@ -3729,7 +3050,7 @@ subroutine marbl_compute_autotroph_phyto_diatoms (auto_cnt, & ! Get nutrient uptakes by small phyto based on calculated C fixation !----------------------------------------------------------------------- - use marbl_parms , only : Q + use marbl_settings_mod, only : Q integer(int_kind) , intent(in) :: auto_cnt type(autotroph_local_type) , intent(in) :: autotroph_loc(auto_cnt) @@ -3797,7 +3118,7 @@ end subroutine marbl_compute_autotroph_phyto_diatoms !*********************************************************************** - subroutine marbl_compute_autotroph_calcification (auto_cnt, auto_config, & + subroutine marbl_compute_autotroph_calcification (auto_cnt, autotrophs, & autotroph_loc, temperature, autotroph_secondary_species) !----------------------------------------------------------------------- @@ -3807,14 +3128,14 @@ subroutine marbl_compute_autotroph_calcification (auto_cnt, auto_config, & ! maximum calcification rate is 40% of primary production !----------------------------------------------------------------------- - use marbl_parms , only : parm_f_prod_sp_CaCO3 - use marbl_parms , only : CaCO3_sp_thres - use marbl_parms , only : CaCO3_temp_thres1 - use marbl_parms , only : CaCO3_temp_thres2 - use marbl_parms , only : f_photosp_CaCO3 + use marbl_settings_mod, only : parm_f_prod_sp_CaCO3 + use marbl_settings_mod, only : CaCO3_sp_thres + use marbl_settings_mod, only : CaCO3_temp_thres1 + use marbl_settings_mod, only : CaCO3_temp_thres2 + use marbl_settings_mod, only : f_photosp_CaCO3 integer(int_kind) , intent(in) :: auto_cnt - type(autotroph_config_type) , intent(in) :: auto_config(auto_cnt) + type(autotroph_type) , intent(in) :: autotrophs(auto_cnt) type(autotroph_local_type) , intent(in) :: autotroph_loc(auto_cnt) real(r8) , intent(in) :: temperature type(autotroph_secondary_species_type) , intent(inout) :: autotroph_secondary_species(auto_cnt) @@ -3832,7 +3153,7 @@ subroutine marbl_compute_autotroph_calcification (auto_cnt, auto_config, & ) do auto_ind = 1, auto_cnt - if (auto_config(auto_ind)%imp_calcifier) then + if (autotrophs(auto_ind)%imp_calcifier) then CaCO3_form(auto_ind) = parm_f_prod_sp_CaCO3 * photoC(auto_ind) CaCO3_form(auto_ind) = CaCO3_form(auto_ind) * f_nut(auto_ind) * f_nut(auto_ind) @@ -3853,7 +3174,7 @@ end subroutine marbl_compute_autotroph_calcification !*********************************************************************** - subroutine marbl_compute_autotroph_nfixation (auto_cnt, auto_config, & + subroutine marbl_compute_autotroph_nfixation (auto_cnt, autotrophs, & autotroph_secondary_species) !----------------------------------------------------------------------- @@ -3861,11 +3182,11 @@ subroutine marbl_compute_autotroph_nfixation (auto_cnt, auto_config, & ! Diazotrophs fix more than they need then 20% is excreted !----------------------------------------------------------------------- - use marbl_parms , only : Q - use marbl_parms , only : r_Nfix_photo + use marbl_settings_mod, only : Q + use marbl_settings_mod, only : r_Nfix_photo integer(int_kind) , intent(in) :: auto_cnt - type(autotroph_config_type) , intent(in) :: auto_config(auto_cnt) + type(autotroph_type) , intent(in) :: autotrophs(auto_cnt) type(autotroph_secondary_species_type) , intent(out) :: autotroph_secondary_species(auto_cnt) !----------------------------------------------------------------------- @@ -3884,7 +3205,7 @@ subroutine marbl_compute_autotroph_nfixation (auto_cnt, auto_config, & ) do auto_ind = 1, autotroph_cnt - if (auto_config(auto_ind)%Nfixer) then + if (autotrophs(auto_ind)%Nfixer) then work1 = photoC(auto_ind) * Q Nfix(auto_ind) = (work1 * r_Nfix_photo) - NO3_V(auto_ind) - NH4_V(auto_ind) Nexcrete(auto_ind) = Nfix(auto_ind) + NO3_V(auto_ind) + NH4_V(auto_ind) - work1 @@ -3896,8 +3217,8 @@ end subroutine marbl_compute_autotroph_nfixation !*********************************************************************** - subroutine marbl_compute_autotroph_loss (auto_cnt, auto_config, auto_meta, & - Tfunc, autotroph_secondary_species) + subroutine marbl_compute_autotroph_loss (auto_cnt, autotrophs, Tfunc, & + autotroph_secondary_species) !----------------------------------------------------------------------- ! Compute autotroph-loss, autotroph aggregation loss and routine of @@ -3905,8 +3226,7 @@ subroutine marbl_compute_autotroph_loss (auto_cnt, auto_config, auto_meta, & !----------------------------------------------------------------------- integer(int_kind) , intent(in) :: auto_cnt - type(autotroph_config_type) , intent(in) :: auto_config(auto_cnt) - type(autotroph_parms_type) , intent(in) :: auto_meta(auto_cnt) + type(autotroph_type) , intent(in) :: autotrophs(auto_cnt) real(r8) , intent(in) :: Tfunc type(autotroph_secondary_species_type) , intent(inout) :: autotroph_secondary_species(auto_cnt) @@ -3932,11 +3252,11 @@ subroutine marbl_compute_autotroph_loss (auto_cnt, auto_config, auto_meta, & ! autotroph agg loss !----------------------------------------------------------------------- - auto_loss(auto_ind) = auto_meta(auto_ind)%mort * Pprime(auto_ind) * Tfunc + auto_loss(auto_ind) = autotrophs(auto_ind)%mort * Pprime(auto_ind) * Tfunc - auto_agg(auto_ind) = min((auto_meta(auto_ind)%agg_rate_max * dps) * Pprime(auto_ind), & - auto_meta(auto_ind)%mort2 * Pprime(auto_ind)**1.75_r8) - auto_agg(auto_ind) = max((auto_meta(auto_ind)%agg_rate_min * dps) * Pprime(auto_ind), auto_agg(auto_ind)) + auto_agg(auto_ind) = min((autotrophs(auto_ind)%agg_rate_max * dps) * Pprime(auto_ind), & + autotrophs(auto_ind)%mort2 * Pprime(auto_ind)**1.75_r8) + auto_agg(auto_ind) = max((autotrophs(auto_ind)%agg_rate_min * dps) * Pprime(auto_ind), auto_agg(auto_ind)) !----------------------------------------------------------------------- ! routing of loss terms @@ -3944,10 +3264,10 @@ subroutine marbl_compute_autotroph_loss (auto_cnt, auto_config, auto_meta, & ! min.%C routed from sp_loss = 0.59 * QCaCO3, or P_CaCO3%rho !----------------------------------------------------------------------- - if (auto_config(auto_ind)%imp_calcifier) then + if (autotrophs(auto_ind)%imp_calcifier) then auto_loss_poc(auto_ind) = QCaCO3(auto_ind) * auto_loss(auto_ind) else - auto_loss_poc(auto_ind) = auto_meta(auto_ind)%loss_poc * auto_loss(auto_ind) + auto_loss_poc(auto_ind) = autotrophs(auto_ind)%loss_poc * auto_loss(auto_ind) endif auto_loss_doc(auto_ind) = (c1 - parm_labile_ratio) * (auto_loss(auto_ind) - auto_loss_poc(auto_ind)) auto_loss_dic(auto_ind) = parm_labile_ratio * (auto_loss(auto_ind) - auto_loss_poc(auto_ind)) @@ -3958,8 +3278,8 @@ end subroutine marbl_compute_autotroph_loss !*********************************************************************** - subroutine marbl_compute_grazing (auto_cnt, zoo_cnt, grazer_prey_cnt, & - auto_config, Tfunc, zooplankton_loc, & + subroutine marbl_compute_grazing (auto_cnt, zoo_cnt, max_grazer_prey_cnt, & + autotrophs, Tfunc, zooplankton_loc, & zooplankton_secondary_species, autotroph_secondary_species) !----------------------------------------------------------------------- @@ -3976,13 +3296,13 @@ subroutine marbl_compute_grazing (auto_cnt, zoo_cnt, grazer_prey_cnt, & use marbl_constants_mod, only : epsC use marbl_constants_mod, only : epsTinv - use marbl_parms , only : grz_fnc_michaelis_menten - use marbl_parms , only : grz_fnc_sigmoidal + use marbl_pft_mod, only : grz_fnc_michaelis_menten + use marbl_pft_mod, only : grz_fnc_sigmoidal integer(int_kind) , intent(in) :: auto_cnt integer(int_kind) , intent(in) :: zoo_cnt - integer(int_kind) , intent(in) :: grazer_prey_cnt - type(autotroph_config_type) , intent(in) :: auto_config(auto_cnt) + integer(int_kind) , intent(in) :: max_grazer_prey_cnt + type(autotroph_type) , intent(in) :: autotrophs(auto_cnt) real(r8) , intent(in) :: Tfunc type(zooplankton_local_type) , intent(in) :: zooplankton_loc(zoo_cnt) type(zooplankton_secondary_species_type) , intent(inout) :: zooplankton_secondary_species(zoo_cnt) @@ -4036,18 +3356,18 @@ subroutine marbl_compute_grazing (auto_cnt, zoo_cnt, grazer_prey_cnt, & work3 = c0 work4 = c0 - do prey_ind = 1, grazer_prey_cnt + do prey_ind = 1, max_grazer_prey_cnt !----------------------------------------------------------------------- ! compute sum of carbon in the grazee class, both autotrophs and zoop !----------------------------------------------------------------------- work1 = c0 ! biomass in prey class prey_ind - do auto_ind2 = 1, grazing_config(prey_ind, pred_ind)%auto_ind_cnt + do auto_ind2 = 1, grazing(prey_ind, pred_ind)%auto_ind_cnt auto_ind = grazing(prey_ind, pred_ind)%auto_ind(auto_ind2) work1 = work1 + Pprime(auto_ind) end do - do zoo_ind2 = 1, grazing_config(prey_ind, pred_ind)%zoo_ind_cnt + do zoo_ind2 = 1, grazing(prey_ind, pred_ind)%zoo_ind_cnt zoo_ind = grazing(prey_ind, pred_ind)%zoo_ind(zoo_ind2) work1 = work1 + Zprime(zoo_ind) end do @@ -4079,7 +3399,7 @@ subroutine marbl_compute_grazing (auto_cnt, zoo_cnt, grazer_prey_cnt, & ! autotroph prey !----------------------------------------------------------------------- - do auto_ind2 = 1, grazing_config(prey_ind, pred_ind)%auto_ind_cnt + do auto_ind2 = 1, grazing(prey_ind, pred_ind)%auto_ind_cnt auto_ind = grazing(prey_ind, pred_ind)%auto_ind(auto_ind2) ! scale by biomass from autotroph pool @@ -4095,7 +3415,7 @@ subroutine marbl_compute_grazing (auto_cnt, zoo_cnt, grazer_prey_cnt, & x_graze_zoo(pred_ind) = x_graze_zoo(pred_ind) + grazing(prey_ind, pred_ind)%graze_zoo * work2 ! routed to POC - if (auto_config(auto_ind)%imp_calcifier) then + if (autotrophs(auto_ind)%imp_calcifier) then auto_graze_poc(auto_ind) = auto_graze_poc(auto_ind) & + work2 * max((caco3_poc_min * QCaCO3(auto_ind)), & min(spc_poc_fac * (Pprime(auto_ind)+0.6_r8)**1.6_r8, & @@ -4116,7 +3436,7 @@ subroutine marbl_compute_grazing (auto_cnt, zoo_cnt, grazer_prey_cnt, & !----------------------------------------------------------------------- ! Zooplankton prey !----------------------------------------------------------------------- - do zoo_ind2 = 1, grazing_config(prey_ind, pred_ind)%zoo_ind_cnt + do zoo_ind2 = 1, grazing(prey_ind, pred_ind)%zoo_ind_cnt zoo_ind = grazing(prey_ind, pred_ind)%zoo_ind(zoo_ind2) ! scale by biomass from zooplankton pool @@ -4153,16 +3473,15 @@ end subroutine marbl_compute_grazing !*********************************************************************** - subroutine marbl_compute_routing (auto_cnt, zoo_cnt, auto_meta, & + subroutine marbl_compute_routing (auto_cnt, zoo_cnt, autotrophs, & zooplankton_secondary_species, autotroph_secondary_species) - use marbl_parms , only : Qp_zoo - use marbl_parms , only : parm_labile_ratio - use marbl_parms , only : f_toDOP + use marbl_settings_mod, only : parm_labile_ratio + use marbl_settings_mod, only : f_toDOP integer(int_kind) , intent(in) :: auto_cnt integer(int_kind) , intent(in) :: zoo_cnt - type(autotroph_parms_type) , intent(in) :: auto_meta(auto_cnt) + type(autotroph_type) , intent(in) :: autotrophs(auto_cnt) type(zooplankton_secondary_species_type) , intent(inout) :: zooplankton_secondary_species(zoo_cnt) type(autotroph_secondary_species_type) , intent(inout) :: autotroph_secondary_species(auto_cnt) @@ -4261,38 +3580,35 @@ end subroutine marbl_compute_routing !*********************************************************************** subroutine marbl_compute_dissolved_organic_matter (k, auto_cnt, zoo_cnt, & - PAR_nsubcols, auto_meta, zooplankton_secondary_species, & + PAR_nsubcols, autotrophs, zooplankton_secondary_species, & autotroph_secondary_species, PAR_col_frac, PAR_in, PAR_avg, & dz1, tracer_local, marbl_tracer_indices, dissolved_organic_matter) - use marbl_parms , only : Qfe_zoo - use marbl_parms , only : Qp_zoo - use marbl_parms , only : Q - - use marbl_parms , only : DOC_reminR_light - use marbl_parms , only : DON_reminR_light - use marbl_parms , only : DOP_reminR_light - use marbl_parms , only : DOC_reminR_dark - use marbl_parms , only : DON_reminR_dark - use marbl_parms , only : DOP_reminR_dark - - use marbl_parms , only : DOCr_reminR0 - use marbl_parms , only : DONr_reminR0 - use marbl_parms , only : DOPr_reminR0 - use marbl_parms , only : DOMr_reminR_photo + use marbl_settings_mod, only : Qfe_zoo + use marbl_settings_mod, only : Q + use marbl_settings_mod, only : DOC_reminR_light + use marbl_settings_mod, only : DON_reminR_light + use marbl_settings_mod, only : DOP_reminR_light + use marbl_settings_mod, only : DOC_reminR_dark + use marbl_settings_mod, only : DON_reminR_dark + use marbl_settings_mod, only : DOP_reminR_dark + use marbl_settings_mod, only : DOCr_reminR0 + use marbl_settings_mod, only : DONr_reminR0 + use marbl_settings_mod, only : DOPr_reminR0 + use marbl_settings_mod, only : DOMr_reminR_photo integer(int_kind) , intent(in) :: k integer , intent(in) :: auto_cnt integer , intent(in) :: zoo_cnt integer(int_kind) , intent(in) :: PAR_nsubcols - type(autotroph_parms_type) , intent(in) :: auto_meta(auto_cnt) - type(zooplankton_secondary_species_type), intent(in) :: zooplankton_secondary_species(zoo_cnt) - type(autotroph_secondary_species_type) , intent(in) :: autotroph_secondary_species(auto_cnt) - real(r8) , intent(in) :: PAR_col_frac(PAR_nsubcols) - real(r8) , intent(in) :: PAR_in(PAR_nsubcols) - real(r8) , intent(in) :: PAR_avg(PAR_nsubcols) + type(autotroph_type) , intent(in) :: autotrophs(:) + type(zooplankton_secondary_species_type), intent(in) :: zooplankton_secondary_species(:) + type(autotroph_secondary_species_type) , intent(in) :: autotroph_secondary_species(:) + real(r8) , intent(in) :: PAR_col_frac(:) + real(r8) , intent(in) :: PAR_in(:) + real(r8) , intent(in) :: PAR_avg(:) real(r8) , intent(in) :: dz1 - real(r8) , intent(in) :: tracer_local(ecosys_base_tracer_cnt) + real(r8) , intent(in) :: tracer_local(:) type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices type(dissolved_organic_matter_type) , intent(out) :: dissolved_organic_matter @@ -4401,11 +3717,11 @@ subroutine marbl_compute_scavenging(k, Fe_loc, Lig_loc, & marbl_status_log) use marbl_constants_mod, only : c1, c2, c3, c4 - use marbl_parms , only : Lig_cnt - use marbl_parms , only : parm_Fe_scavenge_rate0 - use marbl_parms , only : parm_Lig_scavenge_rate0 - use marbl_parms , only : parm_FeLig_scavenge_rate0 - use marbl_parms , only : dust_Fe_scavenge_scale + use marbl_settings_mod , only : Lig_cnt + use marbl_settings_mod , only : parm_Fe_scavenge_rate0 + use marbl_settings_mod , only : parm_Lig_scavenge_rate0 + use marbl_settings_mod , only : parm_FeLig_scavenge_rate0 + use marbl_settings_mod , only : dust_Fe_scavenge_scale integer , intent(in) :: k real(r8) , intent(in) :: Fe_loc @@ -4603,13 +3919,13 @@ end subroutine marbl_compute_scavenging !*********************************************************************** subroutine marbl_compute_large_detritus_prod(k, auto_cnt, zoo_cnt, & - auto_meta, zooplankton_secondary_species, autotroph_secondary_species, & + autotrophs, zooplankton_secondary_species, autotroph_secondary_species, & Fe_scavenge, POC, POP, P_CaCO3, P_CaCO3_ALT_CO2, P_SiO2, dust, P_iron, & marbl_tracer_indices) - use marbl_parms , only : f_graze_CaCO3_remin - use marbl_parms , only : f_graze_si_remin - use marbl_parms , only : Qfe_zoo + use marbl_settings_mod, only : f_graze_CaCO3_remin + use marbl_settings_mod, only : f_graze_si_remin + use marbl_settings_mod, only : Qfe_zoo ! Note (mvertens, 2016-02), all the column_sinking_partiles must be intent(inout) ! rather than intent(out), since if they were intent(out) they would be automatically @@ -4619,7 +3935,7 @@ subroutine marbl_compute_large_detritus_prod(k, auto_cnt, zoo_cnt, & integer , intent(in) :: k integer , intent(in) :: auto_cnt integer , intent(in) :: zoo_cnt - type(autotroph_parms_type) , intent(in) :: auto_meta(auto_cnt) + type(autotroph_type) , intent(in) :: autotrophs(auto_cnt) type(zooplankton_secondary_species_type) , intent(in) :: zooplankton_secondary_species(zoo_cnt) type(autotroph_secondary_species_type) , intent(in) :: autotroph_secondary_species(auto_cnt) real(r8) , intent(in) :: Fe_scavenge @@ -4690,7 +4006,7 @@ subroutine marbl_compute_large_detritus_prod(k, auto_cnt, zoo_cnt, & do auto_ind = 1, auto_cnt if (marbl_tracer_indices%auto_inds(auto_ind)%Si_ind > 0) then P_SiO2%prod(k) = Qsi(auto_ind) * ((c1 - f_graze_si_remin) * auto_graze(auto_ind) + auto_agg(auto_ind) & - + auto_meta(auto_ind)%loss_poc * auto_loss(auto_ind)) + + autotrophs(auto_ind)%loss_poc * auto_loss(auto_ind)) endif end do @@ -4722,8 +4038,8 @@ subroutine marbl_compute_Lig_terms(k, POC_remin, DOC_prod, & Lig_prod, Lig_photochem, Lig_deg, Lig_loss) use marbl_constants_mod , only : c2, yps, ypd, dps - use marbl_parms , only : remin_to_Lig - use marbl_parms , only : parm_Lig_degrade_rate0 + use marbl_settings_mod , only : remin_to_Lig + use marbl_settings_mod , only : parm_Lig_degrade_rate0 integer(int_kind) , intent(in) :: k real(r8) , intent(in) :: POC_remin @@ -4801,8 +4117,8 @@ subroutine marbl_compute_nitrif(k, PAR_nsubcols, column_kmt, & ! use exponential decay of PAR across model level to compute taper factor !----------------------------------------------------------------------- - use marbl_parms, only : parm_nitrif_par_lim - use marbl_parms, only : parm_kappa_nitrif + use marbl_settings_mod, only : parm_nitrif_par_lim + use marbl_settings_mod, only : parm_kappa_nitrif integer(int_kind) , intent(in) :: k integer(int_kind) , intent(in) :: PAR_nsubcols @@ -4884,8 +4200,8 @@ end subroutine marbl_compute_denitrif !*********************************************************************** - subroutine marbl_compute_dtracer_local (auto_cnt, zoo_cnt, auto_config, & - auto_meta, zoo_meta, autotroph_secondary_species, & + subroutine marbl_compute_dtracer_local (auto_cnt, zoo_cnt, autotrophs, & + zooplankton, autotroph_secondary_species, & zooplankton_secondary_species, dissolved_organic_matter, & nitrif, denitrif, sed_denitrif, Fe_scavenge, Lig_prod, Lig_loss, & P_iron_remin, POC_remin, POP_remin, P_SiO2_remin, P_CaCO3_remin, & @@ -4894,11 +4210,10 @@ subroutine marbl_compute_dtracer_local (auto_cnt, zoo_cnt, auto_config, & integer , intent(in) :: auto_cnt integer , intent(in) :: zoo_cnt - type(autotroph_config_type) , intent(in) :: auto_config(auto_cnt) - type(autotroph_parms_type) , intent(in) :: auto_meta(auto_cnt) - type(zooplankton_parms_type) , intent(in) :: zoo_meta(zoo_cnt) - type(zooplankton_secondary_species_type) , intent(in) :: zooplankton_secondary_species(zoo_cnt) - type(autotroph_secondary_species_type) , intent(in) :: autotroph_secondary_species(auto_cnt) + type(autotroph_type) , intent(in) :: autotrophs(:) + type(zooplankton_type) , intent(in) :: zooplankton(:) + type(zooplankton_secondary_species_type) , intent(in) :: zooplankton_secondary_species(:) + type(autotroph_secondary_species_type) , intent(in) :: autotroph_secondary_species(:) type(dissolved_organic_matter_type) , intent(in) :: dissolved_organic_matter real(r8) , intent(in) :: nitrif real(r8) , intent(in) :: denitrif @@ -4914,11 +4229,11 @@ subroutine marbl_compute_dtracer_local (auto_cnt, zoo_cnt, auto_config, & real(r8) , intent(in) :: P_CaCO3_ALT_CO2_remin real(r8) , intent(in) :: other_remin real(r8) , intent(in) :: PON_remin - real(r8) , intent(in) :: interior_restore(ecosys_base_tracer_cnt) + real(r8) , intent(in) :: interior_restore(:) real(r8) , intent(in) :: O2_loc real(r8) , intent(out) :: o2_production real(r8) , intent(out) :: o2_consumption - real(r8) , intent(out) :: dtracers(ecosys_base_tracer_cnt) + real(r8) , intent(out) :: dtracers(:) type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices !----------------------------------------------------------------------- @@ -5006,7 +4321,7 @@ subroutine marbl_compute_dtracer_local (auto_cnt, zoo_cnt, auto_config, & + PON_remin * (c1 - PONremin_refract) do auto_ind = 1, auto_cnt - if (auto_config(auto_ind)%Nfixer) then + if (autotrophs(auto_ind)%Nfixer) then dtracers(nh4_ind) = dtracers(nh4_ind) + Nexcrete(auto_ind) end if end do @@ -5041,7 +4356,7 @@ subroutine marbl_compute_dtracer_local (auto_cnt, zoo_cnt, auto_config, & if (marbl_tracer_indices%auto_inds(auto_ind)%Si_ind > 0) then dtracers(sio3_ind) = dtracers(sio3_ind) & - photoSi(auto_ind) + Qsi(auto_ind) * (f_graze_si_remin * auto_graze(auto_ind) & - + (c1 - auto_meta(auto_ind)%loss_poc) * auto_loss(auto_ind)) + + (c1 - autotrophs(auto_ind)%loss_poc) * auto_loss(auto_ind)) endif end do @@ -5155,7 +4470,7 @@ subroutine marbl_compute_dtracer_local (auto_cnt, zoo_cnt, auto_config, & o2_production = c0 do auto_ind = 1, auto_cnt - if (.not. auto_config(auto_ind)%Nfixer) then + if (.not. autotrophs(auto_ind)%Nfixer) then if (photoC(auto_ind) > c0) then o2_production = o2_production + photoC(auto_ind) * & ((NO3_V(auto_ind) / (NO3_V(auto_ind) + NH4_V(auto_ind))) / parm_Red_D_C_O2 + & @@ -5193,7 +4508,7 @@ subroutine marbl_export_interior_shared_variables (& QA_dust_def, & marbl_interior_share) - real(r8) , intent(in) :: tracer_local(ecosys_base_tracer_cnt) + real(r8) , intent(in) :: tracer_local(:) type(marbl_tracer_index_type) , intent(in) :: marbl_tracer_indices type(carbonate_type) , intent(in) :: carbonate type(dissolved_organic_matter_type) , intent(in) :: dissolved_organic_matter diff --git a/src/marbl_namelist_mod.F90 b/src/marbl_namelist_mod.F90 deleted file mode 100644 index 5ddcba6e..00000000 --- a/src/marbl_namelist_mod.F90 +++ /dev/null @@ -1,119 +0,0 @@ -module marbl_namelist_mod - - ! This module contains a few parameters to control the size of the buffer used - ! to pass the namelist from the GCM to MARBL as well as functions to convert - ! from one long string to an array of strings each containing a single - ! namelist. There is also a function to return the requested namelist, which - ! is used for the read() calls. This is needed due to what I believe is a bug - ! in gfortran, where reading a string that does not contain the requested - ! namelist returns a successful status code so we can't just loop over all - ! elements of nl_buffer until the namelist has been read. - - implicit none - private - - ! Need to know what carriage return is on the system; use #define if we - ! come across a machine that doesn't use achar(10) - - character, parameter :: cr = achar(10) - - public :: marbl_nl_split_string - public :: marbl_namelist - - !*********************************************************************** - -contains - - !*********************************************************************** - - subroutine marbl_nl_split_string(str_in, array_out) - ! This routine takes a string (str_in) containing the entire contents of a - ! a namelist file and returns an array of strings (array_out) where each - ! element contains a single namelist. It also removes all carriage returns - ! from the elements of array_out - - ! FIXME #34: This routine depends on the namelist file conforming - ! to very specific formatting - a more general / robust - ! solution would be preferred - - ! FIXME #74: Strip comments out of str_in (without accidentally removing - ! strings that happen to contain exclamation points) - - character(len=*), intent(in) :: str_in - ! array_out is intent(inout) because we initialized to '' previously - ! (and also to save memory) - character(len=*), dimension(:), intent(inout) :: array_out - - character(len=len(str_in)) :: str_tmp - integer :: old_pos, nl_cnt, i, j - - ! each namelist needs to be stored in different element of array_out - old_pos = 1 - nl_cnt = 1 - do i=1,len_trim(str_in)-1 - if (str_in(i:i+1) .eq. '/' // cr) then - ! FIXME #32: add error checking in case - ! (i+1-old_pos) > marbl_nl_buffer_size - array_out(nl_cnt) = str_in(old_pos:i) - nl_cnt = nl_cnt+1 - old_pos = i+2 - end if - end do - - ! We need to strip carriage returns from the namelist, replacing them with - ! empty space - do j= 1,nl_cnt - str_tmp = array_out(j) - do i=1,len_trim(str_tmp) - if (str_tmp(i:i).eq.cr) then - str_tmp(i:i) = ' ' - end if - end do - ! Remove whitespace from beginning of string (if any) - array_out(j) = trim(adjustl(str_tmp)) - ! FIXME #32: add error checking in case first character is not '&' - end do - end subroutine marbl_nl_split_string - - !***************************************************************************** - - function marbl_namelist(nl_buffer, nl_name, marbl_status_log) - - use marbl_logging, only : marbl_log_type - use marbl_kinds_mod, only : char_len - - character(len=*), intent(in) :: nl_buffer(:) - character(len=*), intent(in) :: nl_name - type(marbl_log_type), intent(inout) :: marbl_status_log - character(len=len(nl_buffer)) :: marbl_namelist - - character(len=*), parameter :: subname = 'marbl_namelist_mod:marbl_namelist' - character(len=char_len) :: log_message - - character(len=len(nl_buffer)) :: single_namelist - integer :: j, n - - ! Will return empty string if namelist not found - marbl_namelist = '' - - ! Look for correct namelist in array - do j = 1, size(nl_buffer) - single_namelist = nl_buffer(j) - n = len_trim(nl_name) - if (single_namelist(2:n+1).eq.trim(nl_name)) then - marbl_namelist = single_namelist - exit - end if - end do - - if (trim(marbl_namelist).eq.'') then - write(log_message, "(2A)") trim(nl_name), ' is not included in nl_buffer' - call marbl_status_log%log_error(log_message, subname) - return - end if - - end function marbl_namelist - - !***************************************************************************** - -end module marbl_namelist_mod diff --git a/src/marbl_parms.F90 b/src/marbl_parms.F90 deleted file mode 100644 index 0643bdb4..00000000 --- a/src/marbl_parms.F90 +++ /dev/null @@ -1,1505 +0,0 @@ -module marbl_parms - - !----------------------------------------------------------------------------- - ! This module manages BGC-specific parameters. - ! - ! Most of the variables are not parameters in the Fortran sense. In the - ! the Fortran sense, they are vanilla module variables most of which are - ! associated with the MARBL namelist (marbl_parms_nml) - ! - ! In addition to containing all the namelist variables, this modules also - ! handles initializing the variables in &marbl_parms_nml to default values - ! and then reading that specific namelist. - ! - ! This module also writes parameter values to the status log. - !----------------------------------------------------------------------------- - - use marbl_kinds_mod, only : r8 - use marbl_kinds_mod, only : int_kind - use marbl_kinds_mod, only : log_kind - use marbl_kinds_mod, only : char_len - - use marbl_config_mod, only : marbl_config_and_parms_type - - use marbl_constants_mod, only : c0 - use marbl_constants_mod, only : c1 - use marbl_constants_mod, only : c2 - use marbl_constants_mod, only : c1000 - use marbl_constants_mod, only : dps - use marbl_constants_mod, only : molw_Fe - - use marbl_internal_types, only : autotroph_parms_type - use marbl_internal_types, only : zooplankton_parms_type - use marbl_internal_types, only : grazing_parms_type - - use marbl_sizes, only : autotroph_cnt - use marbl_sizes, only : zooplankton_cnt - use marbl_sizes, only : grazer_prey_cnt - - use marbl_logging, only: marbl_log_type - - implicit none - - !----------------------------------------------------------------------------- - ! public/private declarations - ! all module variables are public and should have their values preserved - !----------------------------------------------------------------------------- - - public - save - - !--------------------------------------------------------------------- - ! Variables read in via &marbl_parms_nml - !--------------------------------------------------------------------- - - real(kind=r8), target :: & - parm_Fe_bioavail, & ! fraction of Fe flux that is bioavailable - parm_o2_min, & ! min O2 needed for prod & consump. (nmol/cm^3) - parm_o2_min_delta, & ! width of min O2 range (nmol/cm^3) - parm_kappa_nitrif_per_day, & ! nitrification inverse time constant (1/day) - parm_kappa_nitrif, & ! nitrification inverse time constant (1/sec) (derived from parm_kappa_nitrif_per_day) - parm_nitrif_par_lim, & ! PAR limit for nitrif. (W/m^2) - parm_labile_ratio, & ! fraction of loss to DOC that routed directly to DIC (non-dimensional) - parm_init_POC_bury_coeff, & ! initial scale factor for burial of POC, PON - parm_init_POP_bury_coeff, & ! initial scale factor for burial of POP - parm_init_bSi_bury_coeff, & ! initial scale factor burial of bSi - parm_Fe_scavenge_rate0, & ! scavenging base rate for Fe - parm_Lig_scavenge_rate0, & ! scavenging base rate for bound ligand - parm_FeLig_scavenge_rate0, & ! scavenging base rate for bound iron - parm_Lig_degrade_rate0, & ! Fe-binding ligand bacterial degradation base rate coefficient - parm_Fe_desorption_rate0, & ! desorption rate for scavenged Fe from particles - parm_f_prod_sp_CaCO3, & ! fraction of sp prod. as CaCO3 prod. - parm_POC_diss, & ! base POC diss len scale - parm_SiO2_diss, & ! base SiO2 diss len scale - parm_CaCO3_diss, & ! base CaCO3 diss len scale - parm_sed_denitrif_coeff, & ! global scaling factor for sed_denitrif - bury_coeff_rmean_timescale_years - - real(kind=r8), dimension(4), target :: & - parm_scalelen_z, & ! depths of prescribed scalelen values - parm_scalelen_vals ! prescribed scalelen values - - type(zooplankton_parms_type), target :: zooplankton(zooplankton_cnt) - type(autotroph_parms_type), target :: autotrophs(autotroph_cnt) - type(grazing_parms_type), target :: grazing(grazer_prey_cnt, zooplankton_cnt) - - real(r8), target :: iron_frac_in_dust ! fraction by weight of iron in dust - real(r8), target :: iron_frac_in_bc ! fraction by weight of iron in black carbon - character(len=char_len), target :: caco3_bury_thres_opt ! option of threshold of caco3 burial ['fixed_depth', 'omega_calc'] - real(r8), target :: caco3_bury_thres_depth ! threshold depth for caco3_bury_thres_opt='fixed_depth' - ! ----------- - ! PON_sed_loss = PON_bury_coeff * Q * POC_sed_loss - ! factor is used to avoid overburying PON like POC - ! is when total C burial is matched to C riverine input - ! ----------- - real(r8), target :: PON_bury_coeff - character(len=char_len), target :: ciso_fract_factors ! option for which biological fractionation calculation to use - - character(len=char_len), allocatable, target, dimension(:) :: tracer_restore_vars - - !--------------------------------------------------------------------- - ! BGC parameters that are not part of marbl_parms_nml - !--------------------------------------------------------------------- - - ! Redfield Ratios, dissolved & particulate - real(kind=r8), parameter :: & - Q_10 = 1.7_r8, & ! factor for temperature dependence (non-dim) - xkw_coeff = 6.97e-9_r8, & ! in s/cm, from a = 0.251 cm/hr s^2/m^2 in Wannikhof 2014 - parm_Red_D_C_P = 117.0_r8, & ! carbon:phosphorus - parm_Red_D_N_P = 16.0_r8, & ! nitrogen:phosphorus - parm_Red_D_O2_P = 170.0_r8, & ! oxygen:phosphorus - parm_Remin_D_O2_P = 138.0_r8, & ! oxygen:phosphorus - parm_Red_P_C_P = parm_Red_D_C_P, & ! carbon:phosphorus - parm_Red_D_C_N = parm_Red_D_C_P/parm_Red_D_N_P, & ! carbon:nitrogen - parm_Red_P_C_N = parm_Red_D_C_N, & ! carbon:nitrogen - parm_Red_D_C_O2 = parm_Red_D_C_P/parm_Red_D_O2_P, & ! carbon:oxygen - parm_Remin_D_C_O2 = parm_Red_D_C_P/parm_Remin_D_O2_P, & ! carbon:oxygen - parm_Red_P_C_O2 = parm_Red_D_C_O2, & ! carbon:oxygen - parm_Red_Fe_C = 3.0e-6_r8, & ! iron:carbon - parm_Red_D_C_O2_diaz = parm_Red_D_C_P/150.0_r8 ! carbon:oxygen - ! for diazotrophs - - ! Misc. Rate constants - real(kind=r8), parameter :: & - dust_Fe_scavenge_scale = 1.0e9 !dust scavenging scale factor - - ! dust_to_Fe: conversion of dust to iron (nmol Fe/g Dust) - ! dust remin gDust = 0.035 gFe mol Fe 1e9 nmolFe - ! --------- * ----------- * ---------- - ! gDust molw_Fe gFe molFe - real(kind=r8), parameter :: dust_to_Fe = 0.035_r8 / molw_Fe * 1.0e9_r8 - - ! parameters related to Iron binding ligands - integer (int_kind), parameter :: Lig_cnt = 1 ! valid values are 1 or 2 - real(kind=r8), parameter :: & - remin_to_Lig = 0.0001_r8 - - ! Partitioning of phytoplankton growth, grazing and losses - ! All f_* variables are fractions and are non-dimensional - real(kind=r8), parameter :: & - caco3_poc_min = 0.40_r8, & ! minimum proportionality between - ! QCaCO3 and grazing losses to POC - ! (mmol C/mmol CaCO3) - spc_poc_fac = 0.13_r8, & ! small phyto grazing factor (1/mmolC) - f_graze_sp_poc_lim = 0.36_r8, & - f_photosp_CaCO3 = 0.40_r8, & ! proportionality between small phyto - ! production and CaCO3 production - f_graze_CaCO3_remin = 0.33_r8, & ! fraction of spCaCO3 grazing which is remin - f_graze_si_remin = 0.50_r8, & ! fraction of diatom Si grazing which is remin - f_toDON = 0.70_r8, & ! fraction DON relative to DOC - f_toDOP = 0.15_r8 ! fraction of remaining_P to DOP - - - ! fixed ratios - real(kind=r8), parameter :: & - r_Nfix_photo=1.25_r8 ! N fix relative to C fix (non-dim) - - ! SET parmaeters and RATIOS for N/C, P/C, SiO3/C, Fe/C, etc... - real(kind=r8), parameter :: & - Q = 16.0_r8 / 117.0_r8, & !N/C ratio (mmol/mmol) of phyto & zoo - Qp_zoo = c1 / 117.0_r8, & !P/C ratio (mmol/mmol) zoo - Qfe_zoo = 3.0e-6_r8, & !zooplankton Fe/C ratio - gQsi_0 = 0.137_r8, & !initial Si/C ratio for growth - gQsi_max = 0.685_r8, & !max Si/C ratio for growth - gQsi_min = 0.0457_r8, & !min Si/C ratio for growth - QCaCO3_max = 0.4_r8, & !max QCaCO3 - ! parameters in GalbraithMartiny Pquota Model^M - PquotaSlope = 7.0_r8, & - PquotaIntercept = 5.571_r8, & - PquotaMinNP = 0.00854701_r8, & - ! carbon:nitrogen ratio for denitrification - denitrif_C_N = parm_Red_D_C_P/136.0_r8 - - ! loss term threshold parameters, chl:c ratios - real(kind=r8), parameter :: & - thres_z1_auto = 80.0e2_r8, & !autotroph threshold = C_loss_thres for z shallower than this (cm) - thres_z2_auto = 120.0e2_r8, & !autotroph threshold = 0 for z deeper than this (cm) - thres_z1_zoo = 110.0e2_r8, & !zooplankton threshold = C_loss_thres for z shallower than this (cm) - thres_z2_zoo = 150.0e2_r8, & !zooplankton threshold = 0 for z deeper than this (cm) - CaCO3_temp_thres1 = 4.0_r8, & !upper temp threshold for CaCO3 prod - CaCO3_temp_thres2 = -2.0_r8, & !lower temp threshold - CaCO3_sp_thres = 2.5_r8 ! bloom condition thres (mmolC/m3) - - ! fraction of incoming shortwave assumed to be PAR - real(kind=r8), parameter :: & - f_qsw_par = 0.45_r8 ! PAR fraction - - ! DOM parameters for refractory components and DOP uptake - real(kind=r8), parameter :: & - DOC_reminR_light = (c1/(365.0_r8*15.0_r8)) * dps, & ! remin rate for semi-labile DOC, 1/15yr - DON_reminR_light = (c1/(365.0_r8*15.0_r8)) * dps, & ! remin rate for semi-labile DON, 1/15yr - DOP_reminR_light = (c1/(365.0_r8*60.0_r8)) * dps, & ! remin rate for semi-labile DOP, 1/60yr - DOC_reminR_dark = (c1/(365.0_r8*6.0_r8)) * dps, & ! remin rate in the dark, 1/6yr - DON_reminR_dark = (c1/(365.0_r8*5.5_r8)) * dps, & ! remin rate in the dark, 1/5.5yr - DOP_reminR_dark = (c1/(365.0_r8*4.5_r8)) * dps ! remin rate in the dark, 1/4.5yr - - real(kind=r8), parameter :: & - DOCr_reminR0 = (c1/(365.0_r8*16000.0_r8)) * dps, & ! remin rate for refractory DOC, 1/16000yr - DONr_reminR0 = (c1/(365.0_r8*9500.0_r8)) * dps, & ! remin rate for refractory DON, 1/9500yr - DOPr_reminR0 = (c1/(365.0_r8*5500.0_r8)) * dps, & ! remin rate for refractory DOP, 1/5500yr - DOMr_reminR_photo = (c1/(365.0_r8*18.0_r8)) * dps ! additional remin from photochemistry, 1/18yrs over top 10m - - real(kind=r8), parameter :: & - DOCprod_refract = 0.01_r8, & ! fraction of DOCprod to refractory pool - DONprod_refract = 0.0115_r8, & ! fraction of DONprod to refractory pool - DOPprod_refract = 0.003_r8, & ! fraction of DOPprod to refractory pool - POCremin_refract = DOCprod_refract * 0.06_r8, & ! fraction of POCremin to refractory pool - PONremin_refract = DONprod_refract * 0.03_r8, & ! fraction of POCremin to refractory pool - POPremin_refract = DOPprod_refract * 0.06_r8 ! fraction of POCremin to refractory pool - - !--------------------------------------------------------------------- - ! Auxiliary variables (str -> int conversions, indices, etc) - !--------------------------------------------------------------------- - - integer (int_kind) :: caco3_bury_thres_iopt - integer (int_kind), parameter :: caco3_bury_thres_iopt_fixed_depth = 1 - integer (int_kind), parameter :: caco3_bury_thres_iopt_omega_calc = 2 - - ! grazing functions - integer (kind=int_kind), parameter :: & - grz_fnc_michaelis_menten = 1, & - grz_fnc_sigmoidal = 2 - - !***************************************************************************** - - public :: & - marbl_parms_read_namelist, & - marbl_parms_set_defaults - - ! Variables used from other modules should be private - ! (So we don't accidentally use them from this module) - private :: r8, int_kind, log_kind, char_len - private :: c1, dps - private :: zooplankton_parms_type, autotroph_parms_type, grazing_parms_type - private :: autotroph_cnt, zooplankton_cnt, grazer_prey_cnt - private :: marbl_log_type - -contains - - !***************************************************************************** - - subroutine marbl_parms_set_defaults(km) - ! assign default values to all module variables - - ! NOTE: defaults values below, of vars in the marbl_parms framework, may be overridden at runtime - ! through either a namelist read or a put call from marbl_config_and_parms_type class - - use marbl_sizes , only : marbl_total_tracer_cnt - use marbl_config_mod , only : autotrophs_config - use marbl_config_mod , only : zooplankton_config - - integer, intent(in) :: km ! max number of levels - - !--------------------------------------------------------------------------- - ! local variables - !--------------------------------------------------------------------------- - integer :: m, n - !--------------------------------------------------------------------------- - - !----------------------------------------------------------------------- - ! &marbl_parms_nml - !----------------------------------------------------------------------- - - parm_Fe_bioavail = 1.0_r8 ! in marbl_parms framework, see NOTE above - parm_o2_min = 5.0_r8 ! in marbl_parms framework, see NOTE above - parm_o2_min_delta = 5.0_r8 ! in marbl_parms framework, see NOTE above - parm_kappa_nitrif_per_day = 0.06_r8 ! in marbl_parms framework, see NOTE above - parm_nitrif_par_lim = 1.0_r8 ! in marbl_parms framework, see NOTE above - parm_labile_ratio = 0.94_r8 ! in marbl_parms framework, see NOTE above - parm_init_POC_bury_coeff = 1.1_r8 ! in marbl_parms framework, see NOTE above - parm_init_POP_bury_coeff = 1.1_r8 ! in marbl_parms framework, see NOTE above - parm_init_bSi_bury_coeff = 1.0_r8 ! in marbl_parms framework, see NOTE above - parm_Fe_scavenge_rate0 = 15.0_r8 ! in marbl_parms framework, see NOTE above - parm_Lig_scavenge_rate0 = 0.015_r8 ! in marbl_parms framework, see NOTE above - parm_FeLig_scavenge_rate0 = 1.3_r8 ! in marbl_parms framework, see NOTE above - parm_Lig_degrade_rate0 = 0.000094_r8 ! in marbl_parms framework, see NOTE above - parm_Fe_desorption_rate0 = 1.0e-6_r8 ! in marbl_parms framework, see NOTE above - parm_f_prod_sp_CaCO3 = 0.070_r8 ! in marbl_parms framework, see NOTE above - parm_POC_diss = 100.0e2_r8 ! in marbl_parms framework, see NOTE above - parm_SiO2_diss = 770.0e2_r8 ! in marbl_parms framework, see NOTE above - parm_CaCO3_diss = 500.0e2_r8 ! in marbl_parms framework, see NOTE above - parm_sed_denitrif_coeff = 1.0_r8 ! in marbl_parms framework, see NOTE above - bury_coeff_rmean_timescale_years = 10.0_r8 ! in marbl_parms framework, see NOTE above - parm_scalelen_z = (/ 100.0e2_r8, 250.0e2_r8, 500.0e2_r8, 1000.0e2_r8 /) ! in marbl_parms framework, see NOTE above - parm_scalelen_vals = (/ 1.0_r8, 2.2_r8, 4.0_r8, 5.0_r8 /) ! in marbl_parms framework, see NOTE above - - ! Autotrophs - do n=1,autotroph_cnt - select case (trim(autotrophs_config(n)%sname)) - case ('sp') - autotrophs(n)%kFe = 0.03e-3_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%kPO4 = 0.005_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%kDOP = 0.3_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%kNO3 = 0.25_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%kNH4 = 0.01_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%kSiO3 = 0.0_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%Qp_fixed = Qp_zoo ! only used for lvariable_PtoC=.false. - autotrophs(n)%gQfe_0 = 35.0e-6_r8 - autotrophs(n)%gQfe_min = 3.0e-6_r8 - autotrophs(n)%alphaPI_per_day = 0.39_r8 - autotrophs(n)%PCref_per_day = 5.0_r8 - autotrophs(n)%thetaN_max = 2.5_r8 - autotrophs(n)%loss_thres = 0.01_r8 - autotrophs(n)%loss_thres2 = 0.0_r8 - autotrophs(n)%temp_thres = -10.0_r8 - autotrophs(n)%mort_per_day = 0.1_r8 - autotrophs(n)%mort2_per_day = 0.01_r8 - autotrophs(n)%agg_rate_max = 0.5_r8 - autotrophs(n)%agg_rate_min = 0.01_r8 - autotrophs(n)%loss_poc = 0.0_r8 - - case ('diat') - autotrophs(n)%kFe = 0.06e-3_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%kPO4 = 0.05_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%kDOP = 0.5_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%kNO3 = 0.5_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%kNH4 = 0.05_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%kSiO3 = 0.7_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%Qp_fixed = Qp_zoo ! only used for lvariable_PtoC=.false. - autotrophs(n)%gQfe_0 = 35.0e-6_r8 - autotrophs(n)%gQfe_min = 3.0e-6_r8 - autotrophs(n)%alphaPI_per_day = 0.29_r8 - autotrophs(n)%PCref_per_day = 5.0_r8 - autotrophs(n)%thetaN_max = 4.0_r8 - autotrophs(n)%loss_thres = 0.02_r8 - autotrophs(n)%loss_thres2 = 0.0_r8 - autotrophs(n)%temp_thres = -10.0_r8 - autotrophs(n)%mort_per_day = 0.1_r8 - autotrophs(n)%mort2_per_day = 0.01_r8 - autotrophs(n)%agg_rate_max = 0.5_r8 - autotrophs(n)%agg_rate_min = 0.02_r8 - autotrophs(n)%loss_poc = 0.0_r8 - - case ('diaz') - autotrophs(n)%kFe = 0.045e-3_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%kPO4 = 0.015_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%kDOP = 0.075_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%kNO3 = 2.0_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%kNH4 = 0.2_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%kSiO3 = 0.0_r8 ! in marbl_parms framework, see NOTE above - autotrophs(n)%Qp_fixed = 0.32_r8 * Qp_zoo ! only used for lvariable_PtoC=.false. - autotrophs(n)%gQfe_0 = 70.0e-6_r8 - autotrophs(n)%gQfe_min = 6.0e-6_r8 - autotrophs(n)%alphaPI_per_day = 0.39_r8 - autotrophs(n)%PCref_per_day = 2.2_r8 - autotrophs(n)%thetaN_max = 2.5_r8 - autotrophs(n)%loss_thres = 0.02_r8 - autotrophs(n)%loss_thres2 = 0.001_r8 - autotrophs(n)%temp_thres = 15.0_r8 - autotrophs(n)%mort_per_day = 0.1_r8 - autotrophs(n)%mort2_per_day = 0.01_r8 - autotrophs(n)%agg_rate_max = 0.5_r8 - autotrophs(n)%agg_rate_min = 0.01_r8 - autotrophs(n)%loss_poc = 0.0_r8 - - case DEFAULT - autotrophs(n)%kFe = c0 - autotrophs(n)%kPO4 = c0 - autotrophs(n)%kDOP = c0 - autotrophs(n)%kNO3 = c0 - autotrophs(n)%kNH4 = c0 - autotrophs(n)%kSiO3 = c0 - autotrophs(n)%Qp_fixed = c0 - autotrophs(n)%gQfe_0 = c0 - autotrophs(n)%gQfe_min = c0 - autotrophs(n)%alphaPI_per_day = c0 - autotrophs(n)%PCref_per_day = c0 - autotrophs(n)%thetaN_max = c0 - autotrophs(n)%loss_thres = c0 - autotrophs(n)%loss_thres2 = c0 - autotrophs(n)%temp_thres = c0 - autotrophs(n)%mort_per_day = c0 - autotrophs(n)%mort2_per_day = c0 - autotrophs(n)%agg_rate_max = c0 - autotrophs(n)%agg_rate_min = c0 - autotrophs(n)%loss_poc = c0 - end select - end do - - ! zooplankton - ! TODO: add do loop and select case - do n=1,zooplankton_cnt - select case (trim(zooplankton_config(n)%sname)) - case ('zoo') - zooplankton(n)%z_mort_0_per_day = 0.1_r8 ! in marbl_parms framework, see NOTE above - zooplankton(n)%z_mort2_0_per_day = 0.4_r8 ! in marbl_parms framework, see NOTE above - zooplankton(n)%loss_thres = 0.075_r8 ! in marbl_parms framework, see NOTE above - case DEFAULT - zooplankton(n)%z_mort_0_per_day = c0 - zooplankton(n)%z_mort2_0_per_day = c0 - zooplankton(n)%loss_thres = c0 - end select - end do - - ! predator-prey relationships - do n=1,zooplankton_cnt - do m=1,grazer_prey_cnt - - ! Properties that are the same for all grazers - grazing(m,n)%auto_ind(:) = 0 - grazing(m,n)%auto_ind(1) = m - grazing(m,n)%zoo_ind = -1 - - ! Properties that depend on m & n - if ((trim(zooplankton_config(n)%sname).eq.'zoo').and. & - (trim(autotrophs_config(m)%sname).eq.'sp')) then - grazing(m,n)%z_umax_0_per_day = 3.3_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%z_grz = 1.2_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%graze_zoo = 0.3_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%graze_poc = 0.0_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%graze_doc = 0.06_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%f_zoo_detr = 0.12_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%grazing_function = grz_fnc_michaelis_menten ! in marbl_parms framework, see NOTE above - elseif ((trim(zooplankton_config(n)%sname).eq.'zoo').and. & - (trim(autotrophs_config(m)%sname).eq.'diat')) then - grazing(m,n)%z_umax_0_per_day = 3.05_r8 - grazing(m,n)%z_grz = 1.2_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%graze_zoo = 0.25_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%graze_poc = 0.38_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%graze_doc = 0.06_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%f_zoo_detr = 0.24_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%grazing_function = grz_fnc_michaelis_menten ! in marbl_parms framework, see NOTE above - elseif ((trim(zooplankton_config(n)%sname).eq.'zoo').and. & - (trim(autotrophs_config(m)%sname).eq.'diaz')) then - grazing(m,n)%z_umax_0_per_day = 3.1_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%z_grz = 1.2_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%graze_zoo = 0.3_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%graze_poc = 0.1_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%graze_doc = 0.06_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%f_zoo_detr = 0.12_r8 ! in marbl_parms framework, see NOTE above - grazing(m,n)%grazing_function = grz_fnc_michaelis_menten ! in marbl_parms framework, see NOTE above - else - grazing(m,n)%z_umax_0_per_day = c0 - grazing(m,n)%z_grz = c0 - grazing(m,n)%graze_zoo = c0 - grazing(m,n)%graze_poc = c0 - grazing(m,n)%graze_doc = c0 - grazing(m,n)%f_zoo_detr = c0 - grazing(m,n)%grazing_function = grz_fnc_michaelis_menten - end if - end do - end do - - iron_frac_in_dust = 0.035_r8 * 0.01_r8 ! in marbl_parms framework, see NOTE above - iron_frac_in_bc = 0.06_r8 ! in marbl_parms framework, see NOTE above - caco3_bury_thres_opt = 'omega_calc' ! in marbl_parms framework, see NOTE above - caco3_bury_thres_depth = 3000.0e2 ! in marbl_parms framework, see NOTE above - PON_bury_coeff = 0.5_r8 ! in marbl_parms framework, see NOTE above - ciso_fract_factors = 'Rau' ! in marbl_parms framework, see NOTE above - - ! FIXME #69: not thread-safe! - if (.not.allocated(tracer_restore_vars)) & - allocate(tracer_restore_vars(marbl_total_tracer_cnt)) - - ! initialize namelist variables to default values - tracer_restore_vars = '' - - end subroutine marbl_parms_set_defaults - - !***************************************************************************** - - subroutine marbl_parms_read_namelist(nl_buffer, marbl_status_log) - - use marbl_namelist_mod, only : marbl_namelist - - character(len=*), intent(in) :: nl_buffer(:) - type(marbl_log_type), intent(inout) :: marbl_status_log - - !--------------------------------------------------------------------------- - ! local variables - !--------------------------------------------------------------------------- - character(len=*), parameter :: subname = 'marbl_parms:marbl_parms_read_namelist' - character(len=char_len) :: log_message - - character(len=len(nl_buffer)) :: tmp_nl_buffer - - integer (int_kind) :: n ! index for looping over tracers - integer (int_kind) :: nml_error ! namelist i/o error flag - integer (int_kind) :: zoo_ind ! zooplankton functional group index - - NAMELIST /marbl_parms_nml/ & - parm_Fe_bioavail, & - parm_o2_min, & - parm_o2_min_delta, & - parm_kappa_nitrif_per_day, & - parm_nitrif_par_lim, & - parm_labile_ratio, & - parm_init_POC_bury_coeff, & - parm_init_POP_bury_coeff, & - parm_init_bSi_bury_coeff, & - parm_Fe_scavenge_rate0, & - parm_Lig_scavenge_rate0, & - parm_FeLig_scavenge_rate0, & - parm_Lig_degrade_rate0, & - parm_Fe_desorption_rate0, & - parm_f_prod_sp_CaCO3, & - parm_POC_diss, & - parm_SiO2_diss, & - parm_CaCO3_diss, & - parm_sed_denitrif_coeff, & - iron_frac_in_dust, & - iron_frac_in_bc, & - caco3_bury_thres_opt, & - caco3_bury_thres_depth, & - PON_bury_coeff, & - ciso_fract_factors, & - tracer_restore_vars, & - bury_coeff_rmean_timescale_years, & - parm_scalelen_z, & - parm_scalelen_vals, & - autotrophs, & - zooplankton, & - grazing - - !--------------------------------------------------------------------------- - ! read the &marbl_parms_nml namelist - !--------------------------------------------------------------------------- - tmp_nl_buffer = marbl_namelist(nl_buffer, 'marbl_parms_nml', marbl_status_log) - if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('marbl_namelist', subname) - return - end if - - read(tmp_nl_buffer, nml=marbl_parms_nml, iostat=nml_error) - if (nml_error /= 0) then - write(log_message, "(A)") 'error reading &marbl_parms_nml' - call marbl_status_log%log_error(log_message, subname) - return - end if - - end subroutine marbl_parms_read_namelist - - !***************************************************************************** - - subroutine marbl_define_parameters(this, marbl_status_log) - - use marbl_config_mod, only : ciso_on - use marbl_config_mod, only : log_add_var_error - use marbl_config_mod, only : autotrophs_config - use marbl_config_mod, only : zooplankton_config - use marbl_config_mod, only : grazing_config - - class(marbl_config_and_parms_type), intent(inout) :: this - type(marbl_log_type), intent(inout) :: marbl_status_log - - character(len=*), parameter :: subname = 'marbl_parms:marbl_define_parameters' - character(len=char_len) :: log_message - - character(len=char_len) :: sname, lname, units, datatype, group, category - real(r8), pointer :: rptr => NULL() - integer(int_kind), pointer :: iptr => NULL() - logical(log_kind), pointer :: lptr => NULL() - character(len=char_len), pointer :: sptr => NULL() - - character(len=char_len) :: prefix, comment - integer :: m, n, cnt - - if (associated(this%vars)) then - write(log_message, "(A)") "this%parameters has been constructed already" - call marbl_status_log%log_error(log_message, subname) - return - end if - - this%cnt = 0 - allocate(this%vars(this%cnt)) - allocate(this%categories(0)) - - !-----------------! - ! marbl_parms_nml ! - !-----------------! - - category = 'general parmeters' - - sname = 'parm_Fe_bioavail' - lname = 'Fraction of Fe flux that is bioavailable' - units = 'unitless' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_Fe_bioavail - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_o2_min' - lname = 'Minimum O2 needed for production and consumption' - units = 'nmol/cm^3' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_o2_min - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_o2_min_delta' - lname = 'Width of minimum O2 range' - units = 'nmol/cm^3' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_o2_min_delta - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_kappa_nitrif_per_day' - lname = 'Nitrification inverse time constant' - units = '1/day' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_kappa_nitrif_per_day - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_nitrif_par_lim' - lname = 'PAR limit for nitrification' - units = 'W/m^2' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_nitrif_par_lim - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_labile_ratio' - lname = 'Fraction of loss to DOC that is routed directly to DIC' - units = 'unitless' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_labile_ratio - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_init_POC_bury_coeff' - lname = 'initial scale factor for burial of POC, PON' - units = 'unitless' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_init_POC_bury_coeff - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_init_POP_bury_coeff' - lname = 'initial scale factor for burial of POP' - units = 'unitless' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_init_POP_bury_coeff - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_init_bSi_bury_coeff' - lname = 'initial scale factor for burial of bSi' - units = 'unitless' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_init_bSi_bury_coeff - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_Fe_scavenge_rate0' - lname = 'scavenging base rate for Fe' - units = '1/yr' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_Fe_scavenge_rate0 - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_Lig_scavenge_rate0' - lname = 'scavenging base rate for bound ligand' - units = '1/yr' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_Lig_scavenge_rate0 - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_FeLig_scavenge_rate0' - lname = 'scavenging base rate for bound iron' - units = '1/yr' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_FeLig_scavenge_rate0 - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_Lig_degrade_rate0' - lname = 'Fe-binding ligand bacterial degradation rate coefficient' - units = '1' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_Lig_degrade_rate0 - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_Fe_desorption_rate0' - lname = 'desorption rate for scavenged Fe from particles' - units = '1/cm' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_Fe_desorption_rate0 - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_f_prod_sp_CaCO3' - lname = 'Fraction of sp production as CaCO3 production' - units = 'unitless' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_f_prod_sp_CaCO3 - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_POC_diss' - lname = 'base POC dissolution length scale' - units = 'cm' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_POC_diss - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_SiO2_diss' - lname = 'base SiO2 dissolution length scale' - units = 'cm' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_SiO2_diss - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_CaCO3_diss' - lname = 'base CaCO3 dissolution length scale' - units = 'cm' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_CaCO3_diss - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'parm_sed_denitrif_coeff' - lname = 'global scaling factor for sed_denitrif' - units = '1' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => parm_sed_denitrif_coeff - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'bury_coeff_rmean_timescale_years' - lname = 'Timescale for bury coefficient running means' - units = 'yr' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => bury_coeff_rmean_timescale_years - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - category = 'Scale lengths' - - sname = 'parm_scalelen_z' - lname = 'Depths of prescribed scale length values' - units = 'cm' - group = 'marbl_parms_nml' - call this%add_var_1d_r8(sname, lname, units, group, category, & - parm_scalelen_z, marbl_status_log) - if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('add_var_1d_r8', subname) - return - end if - - sname = 'parm_scalelen_vals' - lname = 'Prescribed scale length values' - units = 'cm' - group = 'marbl_parms_nml' - call this%add_var_1d_r8(sname, lname, units, group, category, & - parm_scalelen_vals, marbl_status_log) - if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('add_var_1d_r8', subname) - return - end if - - do n=1,size(autotrophs) - write(prefix, "(A,I0,A)") 'autotrophs(', n, ')%' - write(category, "(A,1X,I0)") 'autotroph', n - write(comment, "(2A)") 'autotroph short name = ', & - trim(autotrophs_config(n)%sname) - - write(sname, "(2A)") trim(prefix), 'kFe' - lname = 'nutrient uptake half-sat constants' - units = 'nmol/cm^3' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%kFe - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'kPO4' - lname = 'nutrient uptake half-sat constants' - units = 'nmol/cm^3' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%kPO4 - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'kDOP' - lname = 'nutrient uptake half-sat constants' - units = 'nmol/cm^3' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%kDOP - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'kNO3' - lname = 'nutrient uptake half-sat constants' - units = 'nmol/cm^3' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%kNO3 - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'kNH4' - lname = 'nutrient uptake half-sat constants' - units = 'nmol/cm^3' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%kNH4 - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'kSiO3' - lname = 'nutrient uptake half-sat constants' - units = 'nmol/cm^3' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%kSiO3 - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'Qp_fixed' - lname = 'P/C ratio when using fixed P/C ratios' - units = 'unitless' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%Qp_fixed - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'gQfe_0' - lname = 'initial Fe/C ratio for growth' - units = 'unitless' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%gQFe_0 - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'gQfe_min' - lname = 'minimum Fe/C ratio for growth' - units = 'unitless' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%gQFe_min - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'alphaPi_per_day' - lname = 'Initial slope of P_I curve (GD98)' - units = 'mmol C m^2 / (mg Chl W day)' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%alphaPi_per_day - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'PCref_per_day' - lname = 'max C-spec growth rate at Tref' - units = '1/day' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%PCref_per_day - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'thetaN_max' - lname = 'max thetaN (Chl/N)' - units = 'mg Chl / mmol N' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%thetaN_max - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'loss_thres' - lname = 'concentration where losses go to zero' - units = 'nmol/cm^3' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%loss_thres - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'loss_thres2' - lname = 'concentration where losses go to zero' - units = 'nmol/cm^3' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%loss_thres2 - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'temp_thres' - lname = 'Temperature where concentration threshold and photosynthesis rate drop' - units = 'deg C' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%temp_thres - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'mort_per_day' - lname = 'linear mortality rate' - units = '1/day' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%mort_per_day - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'mort2_per_day' - lname = 'quadratic mortality rate' - units = '1/day/(mmol C/m^3)' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%mort2_per_day - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'agg_rate_max' - lname = 'Maximum agg rate' - units = '1/d' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%agg_rate_max - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'agg_rate_min' - lname = 'Minimum agg rate' - units = '1/d' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%agg_rate_min - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'loss_poc' - lname = 'routing of loss term' - units = 'unitless' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => autotrophs(n)%loss_poc - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - end do - - do n=1,size(zooplankton) - write(prefix, "(A,I0,A)") 'zooplankton(', n, ')%' - write(category, "(A,1X,I0)") 'zooplankton', n - write(comment, "(2A)") 'zooplankton short name = ', & - trim(zooplankton_config(n)%sname) - - write(sname, "(2A)") trim(prefix), 'z_mort_0_per_day' - lname = 'Linear mortality rate' - units = '1/day' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => zooplankton(n)%z_mort_0_per_day - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'loss_thres' - lname = 'Concentration where losses go to zero' - units = 'nmol/cm^3' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => zooplankton(n)%loss_thres - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'z_mort2_0_per_day' - lname = 'Quadratic mortality rate' - units = '1/day/(mmol C / m^3)' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => zooplankton(n)%z_mort2_0_per_day - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr, comment=comment) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - end do - - do n=1,zooplankton_cnt - do m=1,grazer_prey_cnt - write(prefix, "(A,I0,A,I0,A)") 'grazing(', m, ',', n, ')%' - write(category, "(A,1X,I0,1X,I0)") 'grazing', m, n - - write(sname, "(2A)") trim(prefix), 'grazing_function' - lname = 'functional form of grazing parmaeterization' - units = 'unitless' - datatype = 'integer' - group = 'marbl_parms_nml' - iptr => grazing(m,n)%grazing_function - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, iptr=iptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'z_umax_0_per_day' - lname = 'max zoo growth rate at Tref' - units = '1/day' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => grazing(m,n)%z_umax_0_per_day - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'z_grz' - lname = 'Grazing coefficient' - units = '(mmol C/m^3)^2' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => grazing(m,n)%z_grz - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'graze_zoo' - lname = 'routing of grazed term (remainder goes to DIC)' - units = 'unitless' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => grazing(m,n)%graze_zoo - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'graze_poc' - lname = 'routing of grazed term (remainder goes to DIC)' - units = 'unitless' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => grazing(m,n)%graze_poc - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'graze_doc' - lname = 'routing of grazed term (remainder goes to DIC)' - units = 'unitless' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => grazing(m,n)%graze_doc - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - write(sname, "(2A)") trim(prefix), 'f_zoo_detr' - lname = 'Fraction of zoo losses to detrital' - units = 'unitless' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => grazing(m,n)%f_zoo_detr - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - cnt = grazing_config(m,n)%auto_ind_cnt - if (cnt .gt. 0) then - write(sname, "(2A)") trim(prefix), 'auto_ind' - lname = 'Indices of autotrophs in class' - units = 'unitless' - group = 'marbl_parms_nml' - call this%add_var_1d_int(sname, lname, units, group, category, & - grazing(m,n)%auto_ind(1:cnt), & - marbl_status_log) - if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('add_var_1d_int', subname) - return - end if - end if - - cnt = grazing_config(m,n)%zoo_ind_cnt - if (cnt .gt. 0) then - write(sname, "(2A)") trim(prefix), 'zoo_ind' - lname = 'Indices of autotrophs in class' - units = 'unitless' - group = 'marbl_parms_nml' - call this%add_var_1d_int(sname, lname, units, group, category, & - grazing(m,n)%zoo_ind(1:cnt), & - marbl_status_log) - if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('add_var_1d_int', subname) - return - end if - end if - - end do - end do - - category = 'general parmeters' - - sname = 'iron_frac_in_dust' - lname = 'Fraction by weight of iron in dust' - units = 'unitless (kg/kg)' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => iron_frac_in_dust - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'iron_frac_in_bc' - lname = 'Fraction by weight of iron in black carbon' - units = 'unitless (kg/kg)' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => iron_frac_in_bc - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'caco3_bury_thres_opt' - lname = 'Option for CaCO3 burial threshold' - units = 'unitless' - datatype = 'string' - group = 'marbl_parms_nml' - sptr => caco3_bury_thres_opt - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, sptr=sptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'caco3_bury_thres_depth' - lname = 'Threshold depth for CaCO3 burial (if using fixed_depth option)' - units = 'cm' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => caco3_bury_thres_depth - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - sname = 'PON_bury_coeff' - lname = 'scale factor for burial of PON' - units = 'unitless' - datatype = 'real' - group = 'marbl_parms_nml' - rptr => PON_bury_coeff - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, rptr=rptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - - if (ciso_on) then - sname = 'ciso_fract_factors' - lname = 'Optiob for which biological fractionation calculation to use' - units = 'unitless' - datatype = 'string' - group = 'marbl_parms_nml' - sptr => ciso_fract_factors - call this%add_var(sname, lname, units, datatype, group, category, & - marbl_status_log, sptr=sptr) - if (marbl_status_log%labort_marbl) then - call log_add_var_error(marbl_status_log, sname, subname) - return - end if - end if - - category = 'tracer restoring' - - sname = 'tracer_restore_vars' - lname = 'Tracer names for tracers that are restored' - units = 'unitless' - group = 'marbl_parms_nml' - call this%add_var_1d_str(sname, lname, units, group, category, & - tracer_restore_vars, marbl_status_log) - if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('add_var_1d_str', subname) - return - end if - - end subroutine marbl_define_parameters - - !***************************************************************************** - - subroutine set_derived_parms(marbl_status_log) - - type(marbl_log_type), intent(inout) :: marbl_status_log - - !--------------------------------------------------------------------------- - ! local variables - !--------------------------------------------------------------------------- - character(len=*), parameter :: subname = 'marbl_parms:set_derived_parms' - character(len=char_len) :: log_message - - character(len=char_len) :: sname_in, sname_out - integer :: m, n - - call marbl_status_log%log_header('Setting derived parms', subname) - - select case (caco3_bury_thres_opt) - case ('fixed_depth') - caco3_bury_thres_iopt = caco3_bury_thres_iopt_fixed_depth - case ('omega_calc') - caco3_bury_thres_iopt = caco3_bury_thres_iopt_omega_calc - case default - write(log_message, "(2A)") "unknown caco3_bury_thres_opt: ", trim(caco3_bury_thres_opt) - call marbl_status_log%log_error(log_message, subname) - return - end select - - parm_kappa_nitrif = dps * parm_kappa_nitrif_per_day - call print_single_derived_parm('parm_kappa_nitrif_per_day', 'parm_kappa_nitrif', & - parm_kappa_nitrif, subname, marbl_status_log) - - do n = 1, autotroph_cnt - autotrophs(n)%alphaPI = dps * autotrophs(n)%alphaPI_per_day - write(sname_in, "(A,I0,A)") 'autotrophs(', n, ')%alphaPI_per_day' - write(sname_out, "(A,I0,A)") 'autotrophs(', n, ')%alphaPI' - call print_single_derived_parm(sname_in, sname_out, & - autotrophs(n)%alphaPI, subname, marbl_status_log) - - autotrophs(n)%PCref = dps * autotrophs(n)%PCref_per_day - write(sname_in, "(A,I0,A)") 'autotrophs(', n, ')%PCref_per_day' - write(sname_out, "(A,I0,A)") 'autotrophs(', n, ')%PCref' - call print_single_derived_parm(sname_in, sname_out, & - autotrophs(n)%PCref, subname, marbl_status_log) - - autotrophs(n)%mort = dps * autotrophs(n)%mort_per_day - write(sname_in, "(A,I0,A)") 'autotrophs(', n, ')%mort_per_day' - write(sname_out, "(A,I0,A)") 'autotrophs(', n, ')%mort' - call print_single_derived_parm(sname_in, sname_out, & - autotrophs(n)%mort, subname, marbl_status_log) - - autotrophs(n)%mort2 = dps * autotrophs(n)%mort2_per_day - write(sname_in, "(A,I0,A)") 'autotrophs(', n, ')%mort2_per_day' - write(sname_out, "(A,I0,A)") 'autotrophs(', n, ')%mort2' - call print_single_derived_parm(sname_in, sname_out, & - autotrophs(n)%mort2, subname, marbl_status_log) - end do - - do n = 1, zooplankton_cnt - zooplankton(n)%z_mort_0 = dps * zooplankton(n)%z_mort_0_per_day - write(sname_in, "(A,I0,A)") 'zooplankton(', n, ')%z_mort_0_per_day' - write(sname_out, "(A,I0,A)") 'zooplankton(', n, ')%z_mort_0' - call print_single_derived_parm(sname_in, sname_out, & - zooplankton(n)%z_mort_0, subname, marbl_status_log) - - zooplankton(n)%z_mort2_0 = dps * zooplankton(n)%z_mort2_0_per_day - write(sname_in, "(A,I0,A)") 'zooplankton(', n, ')%z_mort2_0_per_day' - write(sname_out, "(A,I0,A)") 'zooplankton(', n, ')%z_mort2_0' - call print_single_derived_parm(sname_in, sname_out, & - zooplankton(n)%z_mort2_0, subname, marbl_status_log) - end do - - do n = 1, zooplankton_cnt - do m = 1, grazer_prey_cnt - grazing(m,n)%z_umax_0 = dps * grazing(m,n)%z_umax_0_per_day - write(sname_in, "(A,I0,A,I0,A)") 'grazing(', m, ',', n, ')%z_umax_0_per_day' - write(sname_out, "(A,I0,A,I0,A)") 'grazing(', m, ',', n, ')%z_umax_0' - call print_single_derived_parm(sname_in, sname_out, & - grazing(m,n)%z_umax_0, subname, marbl_status_log) - end do - end do - - end subroutine set_derived_parms - - !***************************************************************************** - - subroutine print_single_derived_parm(sname_in, sname_out, val_out, subname, marbl_status_log) - - character(len=*), intent(in) :: sname_in - character(len=*), intent(in) :: sname_out - real(kind=r8), intent(in) :: val_out - character(len=*), intent(in) :: subname - type(marbl_log_type), intent(inout) :: marbl_status_log - - !--------------------------------------------------------------------------- - ! local variables - !--------------------------------------------------------------------------- - character(len=char_len) :: log_message - - write(log_message, "(2A,E24.16,3A)") & - trim(sname_out), ' = ', val_out, ' (from ', trim(sname_in), ')' - call marbl_status_log%log_noerror(log_message, subname) - - end subroutine print_single_derived_parm - - !***************************************************************************** - -end module marbl_parms diff --git a/src/marbl_pft_mod.F90 b/src/marbl_pft_mod.F90 new file mode 100644 index 00000000..f2124538 --- /dev/null +++ b/src/marbl_pft_mod.F90 @@ -0,0 +1,460 @@ +module marbl_pft_mod + + use marbl_kinds_mod, only : r8 + use marbl_kinds_mod, only : log_kind + use marbl_kinds_mod, only : int_kind + use marbl_kinds_mod, only : char_len + + use marbl_constants_mod, only : c0, c1 + + use marbl_logging, only : marbl_log_type + + implicit none + private + + real(r8), parameter :: UnsetValue = 1e34_r8 + + !**************************************************************************** + ! derived types for autotrophs + + type, public :: autotroph_type + character(len=char_len) :: sname + character(len=char_len) :: lname + logical(log_kind) :: Nfixer ! flag set to true if this autotroph fixes N2 + logical(log_kind) :: imp_calcifier ! flag set to true if this autotroph implicitly handles calcification + logical(log_kind) :: exp_calcifier ! flag set to true if this autotroph explicitly handles calcification + logical(log_kind) :: silicifier ! flag set to true if this autotroph is a silicifier + + real(r8) :: kFe, kPO4, kDOP, kNO3, kNH4, kSiO3 ! nutrient uptake half-sat constants + real(r8) :: Qp_fixed ! P/C ratio for fixed P/C ratios + real(r8) :: gQfe_0, gQfe_min ! initial and minimum Fe/C ratio for growth + real(r8) :: alphaPI_per_day ! init slope of P_I curve (GD98) (mmol C m^2/(mg Chl W day)) + real(r8) :: alphaPI ! init slope of P_I curve (GD98) (mmol C m^2/(mg Chl W sec)) + ! (derived from alphaPI_per_day) + real(r8) :: PCref_per_day ! max C-spec. grth rate at tref (1/day) + real(r8) :: PCref ! max C-spec. grth rate at tref (1/sec) (derived from PCref_per_day) + real(r8) :: thetaN_max ! max thetaN (Chl/N) (mg Chl/mmol N) + real(r8) :: loss_thres, loss_thres2 ! conc. where losses go to zero + real(r8) :: temp_thres ! Temp. where concentration threshold and photosynth. rate drops + real(r8) :: mort_per_day, mort2_per_day ! linear and quadratic mortality rates (1/day), (1/day/((mmol C/m3)) + real(r8) :: mort, mort2 ! linear and quadratic mortality rates (1/sec), (1/sec/((mmol C/m3)) + ! (derived from mort_per_day and mort2_per_day) + real(r8) :: agg_rate_max, agg_rate_min ! max and min agg. rate (1/d) + real(r8) :: loss_poc ! routing of loss term + contains + procedure, public :: set_to_default => autotroph_set_to_default + end type autotroph_type + + !**************************************************************************** + ! derived types for zooplankton + + type, public :: zooplankton_type + character(len=char_len) :: sname + character(len=char_len) :: lname + real(r8) :: z_mort_0_per_day ! zoo linear mort rate (1/day) + real(r8) :: z_mort_0 ! zoo linear mort rate (1/sec) (derived from z_mort_0_per_day) + real(r8) :: z_mort2_0_per_day ! zoo quad mort rate (1/day/((mmol C/m3)) + real(r8) :: z_mort2_0 ! zoo quad mort rate (1/sec/((mmol C/m3)) (derived from z_mort2_0_per_day) + real(r8) :: loss_thres ! zoo conc. where losses go to zero + contains + procedure, public :: set_to_default => zooplankton_set_to_default + end type zooplankton_type + + !**************************************************************************** + ! derived types for grazing + + type, public :: grazing_type + character(len=char_len) :: sname + character(len=char_len) :: lname + integer(int_kind) :: auto_ind_cnt ! number of autotrophs in prey-clase auto_ind + integer(int_kind) :: zoo_ind_cnt ! number of zooplankton in prey-clase zoo_ind + integer(int_kind) :: grazing_function ! functional form of grazing parameterization + real(r8) :: z_umax_0_per_day ! max zoo growth rate at tref (1/day) + real(r8) :: z_umax_0 ! max zoo growth rate at tref (1/sec) (derived from z_umax_0_per_day) + real(r8) :: z_grz ! grazing coef. (mmol C/m^3)^2 + real(r8) :: graze_zoo ! routing of grazed term, remainder goes to dic + real(r8) :: graze_poc ! routing of grazed term, remainder goes to dic + real(r8) :: graze_doc ! routing of grazed term, remainder goes to dic + real(r8) :: f_zoo_detr ! fraction of zoo losses to detrital + integer(int_kind), allocatable :: auto_ind(:) + integer(int_kind), allocatable :: zoo_ind(:) + contains + procedure, public :: set_to_default => grazing_set_to_default + procedure, public :: construct => grazing_constructor + end type grazing_type + + !*********************************************************************** + + type, public :: marbl_autotroph_share_type + real(r8) :: autotrophChl_loc_fields ! local copy of model autotroph Chl + real(r8) :: autotrophC_loc_fields ! local copy of model autotroph C + real(r8) :: autotrophFe_loc_fields ! local copy of model autotroph Fe + real(r8) :: autotrophSi_loc_fields ! local copy of model autotroph Si + real(r8) :: autotrophCaCO3_loc_fields ! local copy of model autotroph CaCO3 + real(r8) :: QCaCO3_fields ! small phyto CaCO3/C ratio (mmol CaCO3/mmol C) + real(r8) :: auto_graze_fields ! autotroph grazing rate (mmol C/m^3/sec) + real(r8) :: auto_graze_zoo_fields ! auto_graze routed to zoo (mmol C/m^3/sec) + real(r8) :: auto_graze_poc_fields ! auto_graze routed to poc (mmol C/m^3/sec) + real(r8) :: auto_graze_doc_fields ! auto_graze routed to doc (mmol C/m^3/sec) + real(r8) :: auto_graze_dic_fields ! auto_graze routed to dic (mmol C/m^3/sec) + real(r8) :: auto_loss_fields ! autotroph non-grazing mort (mmol C/m^3/sec) + real(r8) :: auto_loss_poc_fields ! auto_loss routed to poc (mmol C/m^3/sec) + real(r8) :: auto_loss_doc_fields ! auto_loss routed to doc (mmol C/m^3/sec) + real(r8) :: auto_loss_dic_fields ! auto_loss routed to dic (mmol C/m^3/sec) + real(r8) :: auto_agg_fields ! autotroph aggregation (mmol C/m^3/sec) + real(r8) :: photoC_fields ! C-fixation (mmol C/m^3/sec) + real(r8) :: CaCO3_form_fields ! calcification of CaCO3 by small phyto (mmol CaCO3/m^3/sec) + real(r8) :: PCphoto_fields ! C-specific rate of photosynth. (1/sec) + end type marbl_autotroph_share_type + + !*********************************************************************** + + type, public :: marbl_zooplankton_share_type + real(r8) :: zooC_loc_fields ! local copy of model zooC + real(r8) :: zoo_loss_fields ! mortality & higher trophic grazing on zooplankton (mmol C/m^3/sec) + real(r8) :: zoo_loss_poc_fields ! zoo_loss routed to large detrital (mmol C/m^3/sec) + real(r8) :: zoo_loss_doc_fields ! zoo_loss routed to doc (mmol C/m^3/sec) + real(r8) :: zoo_loss_dic_fields ! zoo_loss routed to dic (mmol C/m^3/sec) + end type marbl_zooplankton_share_type + + !***************************************************************************** + + type, public :: autotroph_secondary_species_type + real(r8) :: thetaC ! current Chl/C ratio (mg Chl/mmol C) + real(r8) :: QCaCO3 ! current CaCO3/C ratio (mmol CaCO3/mmol C) + real(r8) :: Qp ! current P/C ratio (mmol P/mmol C) + real(r8) :: gQp ! P/C for growth + real(r8) :: Qfe ! current Fe/C ratio (mmol Fe/mmol C) + real(r8) :: gQfe ! fe/C for growth + real(r8) :: Qsi ! current Si/C ratio (mmol Si/mmol C) + real(r8) :: gQsi ! diatom Si/C ratio for growth (new biomass) + real(r8) :: VNO3 ! NH4 uptake rate (non-dim) + real(r8) :: VNH4 ! NO3 uptake rate (non-dim) + real(r8) :: VNtot ! total N uptake rate (non-dim) + real(r8) :: NO3_V ! nitrate uptake (mmol NO3/m^3/sec) + real(r8) :: NH4_V ! ammonium uptake (mmol NH4/m^3/sec) + real(r8) :: PO4_V ! PO4 uptake (mmol PO4/m^3/sec) + real(r8) :: DOP_V ! DOP uptake (mmol DOP/m^3/sec) + real(r8) :: VPO4 ! C-specific PO4 uptake (non-dim) + real(r8) :: VDOP ! C-specific DOP uptake rate (non-dim) + real(r8) :: VPtot ! total P uptake rate (non-dim) + real(r8) :: f_nut ! nut limitation factor, modifies C fixation (non-dim) + real(r8) :: VFe ! C-specific Fe uptake (non-dim) + real(r8) :: VSiO3 ! C-specific SiO3 uptake (non-dim) + real(r8) :: light_lim ! light limitation factor + real(r8) :: PCphoto ! C-specific rate of photosynth. (1/sec) + real(r8) :: photoC ! C-fixation (mmol C/m^3/sec) + real(r8) :: photoFe ! iron uptake + real(r8) :: photoSi ! silicon uptake (mmol Si/m^3/sec) + real(r8) :: photoacc ! Chl synth. term in photoadapt. (GD98) (mg Chl/m^3/sec) + real(r8) :: auto_loss ! autotroph non-grazing mort (mmol C/m^3/sec) + real(r8) :: auto_loss_poc ! auto_loss routed to poc (mmol C/m^3/sec) + real(r8) :: auto_loss_doc ! auto_loss routed to doc (mmol C/m^3/sec) + real(r8) :: auto_loss_dic ! auto_loss routed to dic (mmol C/m^3/sec) + real(r8) :: auto_agg ! autotroph aggregation (mmol C/m^3/sec) + real(r8) :: auto_graze ! autotroph grazing rate (mmol C/m^3/sec) + real(r8) :: auto_graze_zoo ! auto_graze routed to zoo (mmol C/m^3/sec) + real(r8) :: auto_graze_poc ! auto_graze routed to poc (mmol C/m^3/sec) + real(r8) :: auto_graze_doc ! auto_graze routed to doc (mmol C/m^3/sec) + real(r8) :: auto_graze_dic ! auto_graze routed to dic (mmol C/m^3/sec) + real(r8) :: Pprime ! used to limit autotroph mort at low biomass (mmol C/m^3) + real(r8) :: CaCO3_form ! calcification of CaCO3 by small phyto (mmol CaCO3/m^3/sec) + real(r8) :: Nfix ! total Nitrogen fixation (mmol N/m^3/sec) + real(r8) :: Nexcrete ! fixed N excretion + real(r8) :: remaining_P_dop ! remaining_P from grazing routed to DOP pool + real(r8) :: remaining_P_pop ! remaining_P from grazing routed to POP pool + real(r8) :: remaining_P_dip ! remaining_P from grazing routed to remin + end type autotroph_secondary_species_type + + !***************************************************************************** + + type, public :: zooplankton_secondary_species_type + real(r8) :: f_zoo_detr ! frac of zoo losses into large detrital pool (non-dim) + real(r8) :: x_graze_zoo ! {auto, zoo}_graze routed to zoo (mmol C/m^3/sec) + real(r8) :: zoo_graze ! zooplankton losses due to grazing (mmol C/m^3/sec) + real(r8) :: zoo_graze_zoo ! grazing of zooplankton routed to zoo (mmol C/m^3/sec) + real(r8) :: zoo_graze_poc ! grazing of zooplankton routed to poc (mmol C/m^3/sec) + real(r8) :: zoo_graze_doc ! grazing of zooplankton routed to doc (mmol C/m^3/sec) + real(r8) :: zoo_graze_dic ! grazing of zooplankton routed to dic (mmol C/m^3/sec) + real(r8) :: zoo_loss ! mortality & higher trophic grazing on zooplankton (mmol C/m^3/sec) + real(r8) :: zoo_loss_poc ! zoo_loss routed to poc (mmol C/m^3/sec) + real(r8) :: zoo_loss_doc ! zoo_loss routed to doc (mmol C/m^3/sec) + real(r8) :: zoo_loss_dic ! zoo_loss routed to dic (mmol C/m^3/sec) + real(r8) :: Zprime ! used to limit zoo mort at low biomass (mmol C/m^3) + end type zooplankton_secondary_species_type + + !**************************************************************************** + + ! Public parameters + real(r8), public, parameter :: Qp_zoo = c1 / 117.0_r8 ! P/C ratio (mmol/mmol) zoo + + ! grazing functions + integer(int_kind), public, parameter :: grz_fnc_michaelis_menten = 1 + integer(int_kind), public, parameter :: grz_fnc_sigmoidal = 2 + +contains + + !***************************************************************************** + + subroutine autotroph_set_to_default(self, autotroph_id, marbl_status_log) + + class(autotroph_type), intent(out) :: self + character(len=*), intent(in) :: autotroph_id + type(marbl_log_type), intent(inout) :: marbl_status_log + + character(len=*), parameter :: subname = 'marbl_pft_mod:autotroph_set_to_default' + character(len=char_len) :: log_message + + select case (autotroph_id) + case ('sp') + self%sname = 'sp' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%lname = 'Small Phyto' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%Nfixer = .false. + self%imp_calcifier = .true. + self%exp_calcifier = .false. + self%silicifier = .false. + self%kFe = 0.03e-3_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%kPO4 = 0.005_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%kDOP = 0.3_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%kNO3 = 0.25_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%kNH4 = 0.01_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%kSiO3 = 0.0_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%Qp_fixed = Qp_zoo ! only used for lvariable_PtoC=.false. + self%gQfe_0 = 35.0e-6_r8 + self%gQfe_min = 3.0e-6_r8 + self%alphaPI_per_day = 0.39_r8 + self%PCref_per_day = 5.0_r8 + self%thetaN_max = 2.5_r8 + self%loss_thres = 0.01_r8 + self%loss_thres2 = 0.0_r8 + self%temp_thres = -10.0_r8 + self%mort_per_day = 0.1_r8 + self%mort2_per_day = 0.01_r8 + self%agg_rate_max = 0.5_r8 + self%agg_rate_min = 0.01_r8 + self%loss_poc = 0.0_r8 + case ('diat') + self%sname = 'diat' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%lname = 'Diatom' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%Nfixer = .false. + self%imp_calcifier = .false. + self%exp_calcifier = .false. + self%silicifier = .true. + self%kFe = 0.06e-3_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%kPO4 = 0.05_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%kDOP = 0.5_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%kNO3 = 0.5_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%kNH4 = 0.05_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%kSiO3 = 0.7_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%Qp_fixed = Qp_zoo ! only used for lvariable_PtoC=.false. + self%gQfe_0 = 35.0e-6_r8 + self%gQfe_min = 3.0e-6_r8 + self%alphaPI_per_day = 0.29_r8 + self%PCref_per_day = 5.0_r8 + self%thetaN_max = 4.0_r8 + self%loss_thres = 0.02_r8 + self%loss_thres2 = 0.0_r8 + self%temp_thres = -10.0_r8 + self%mort_per_day = 0.1_r8 + self%mort2_per_day = 0.01_r8 + self%agg_rate_max = 0.5_r8 + self%agg_rate_min = 0.02_r8 + self%loss_poc = 0.0_r8 + case ('diaz') + self%sname = 'diaz' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%lname = 'Diazotroph' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%Nfixer = .true. + self%imp_calcifier = .false. + self%exp_calcifier = .false. + self%silicifier = .false. + self%kFe = 0.045e-3_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%kPO4 = 0.015_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%kDOP = 0.075_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%kNO3 = 2.0_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%kNH4 = 0.2_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%kSiO3 = 0.0_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%Qp_fixed = 0.32_r8 * Qp_zoo ! only used for lvariable_PtoC=.false. + self%gQfe_0 = 70.0e-6_r8 + self%gQfe_min = 6.0e-6_r8 + self%alphaPI_per_day = 0.39_r8 + self%PCref_per_day = 2.2_r8 + self%thetaN_max = 2.5_r8 + self%loss_thres = 0.02_r8 + self%loss_thres2 = 0.001_r8 + self%temp_thres = 15.0_r8 + self%mort_per_day = 0.1_r8 + self%mort2_per_day = 0.01_r8 + self%agg_rate_max = 0.5_r8 + self%agg_rate_min = 0.01_r8 + self%loss_poc = 0.0_r8 + case ('unset') + self%sname = 'unknown' + self%lname = 'unknown' + self%Nfixer = .false. + self%imp_calcifier = .false. + self%exp_calcifier = .false. + self%silicifier = .false. + self%kFe = UnsetValue + self%kPO4 = UnsetValue + self%kDOP = UnsetValue + self%kNO3 = UnsetValue + self%kNH4 = UnsetValue + self%kSiO3 = UnsetValue + self%Qp_fixed = UnsetValue + self%gQfe_0 = UnsetValue + self%gQfe_min = UnsetValue + self%alphaPI_per_day = UnsetValue + self%PCref_per_day = UnsetValue + self%thetaN_max = UnsetValue + self%loss_thres = UnsetValue + self%loss_thres2 = UnsetValue + self%temp_thres = UnsetValue + self%mort_per_day = UnsetValue + self%mort2_per_day = UnsetValue + self%agg_rate_max = UnsetValue + self%agg_rate_min = UnsetValue + self%loss_poc = UnsetValue + case DEFAULT + write(log_message, "(3A)") "'", autotroph_id, "' is not a valid autotroph ID" + call marbl_status_log%log_error(log_message, subname) + return + end select + + end subroutine autotroph_set_to_default + + !***************************************************************************** + + subroutine zooplankton_set_to_default(self, zooplankton_id, marbl_status_log) + + class(zooplankton_type), intent(out) :: self + character(len=*), intent(in) :: zooplankton_id + type(marbl_log_type), intent(inout) :: marbl_status_log + + character(len=*), parameter :: subname = 'marbl_pft_mod:zooplankton_set_to_default' + character(len=char_len) :: log_message + + select case (zooplankton_id) + case ('zoo') + self%sname = 'zoo' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%lname = 'Zooplankton' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%z_mort_0_per_day = 0.1_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%z_mort2_0_per_day = 0.4_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%loss_thres = 0.075_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + case ('unset') + self%sname = 'unknown' + self%lname = 'unknown' + self%z_mort_0_per_day = UnsetValue + self%z_mort2_0_per_day = UnsetValue + self%loss_thres = UnsetValue + case DEFAULT + write(log_message, "(3A)") "'", zooplankton_id, "' is not a valid zooplankton ID" + call marbl_status_log%log_error(log_message, subname) + return + end select + + end subroutine zooplankton_set_to_default + + !***************************************************************************** + + subroutine grazing_set_to_default(self, grazing_id, marbl_status_log) + + class(grazing_type), intent(inout) :: self + character(len=*), intent(in) :: grazing_id + type(marbl_log_type), intent(inout) :: marbl_status_log + + character(len=*), parameter :: subname = 'marbl_pft_mod:grazing_set_to_default' + character(len=char_len) :: log_message + + select case (grazing_id) + case ('sp_zoo') + self%sname = 'grz_sp_zoo' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%lname = 'Grazing of sp by zoo' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%auto_ind_cnt = 1 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%zoo_ind_cnt = 0 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%z_umax_0_per_day = 3.3_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%z_grz = 1.2_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%graze_zoo = 0.3_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%graze_poc = 0.0_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%graze_doc = 0.06_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%f_zoo_detr = 0.12_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%grazing_function = grz_fnc_michaelis_menten ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%auto_ind(1) = 1 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + case ('diat_zoo') + self%sname = 'grz_diat_zoo' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%lname = 'Grazing of diat by zoo' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%auto_ind_cnt = 1 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%zoo_ind_cnt = 0 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%z_umax_0_per_day = 3.05_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%z_grz = 1.2_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%graze_zoo = 0.25_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%graze_poc = 0.38_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%graze_doc = 0.06_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%f_zoo_detr = 0.24_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%grazing_function = grz_fnc_michaelis_menten ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%auto_ind(1) = 2 + case ('diaz_zoo') + self%sname = 'grz_diaz_zoo' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%lname = 'Grazing of diaz by zoo' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%auto_ind_cnt = 1 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%zoo_ind_cnt = 0 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%z_umax_0_per_day = 3.1_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%z_grz = 1.2_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%graze_zoo = 0.3_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%graze_poc = 0.1_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%graze_doc = 0.06_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%f_zoo_detr = 0.12_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%grazing_function = grz_fnc_michaelis_menten ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE in marbl_settings_mod + self%auto_ind(1) = 3 + case ('unset') + self%sname = 'unknown' + self%lname = 'unknown' + self%auto_ind_cnt = 0 + self%zoo_ind_cnt = 0 + self%auto_ind = -1 + self%zoo_ind = -1 + self%z_umax_0_per_day = UnsetValue + self%z_grz = UnsetValue + self%graze_zoo = UnsetValue + self%graze_poc = UnsetValue + self%graze_doc = UnsetValue + self%f_zoo_detr = UnsetValue + self%grazing_function = grz_fnc_michaelis_menten + case DEFAULT + write(log_message, "(3A)") "'", grazing_id, "' is not a valid grazing ID" + call marbl_status_log%log_error(log_message, subname) + return + end select + + end subroutine grazing_set_to_default + !***************************************************************************** + + subroutine grazing_constructor(self, autotroph_cnt, zooplankton_cnt, marbl_status_log) + + class(grazing_type), intent(out) :: self + integer(int_kind), intent(in) :: autotroph_cnt + integer(int_kind), intent(in) :: zooplankton_cnt + type(marbl_log_type), intent(inout) :: marbl_status_log + + character(len=*), parameter :: subname = 'marbl_pft_mod:grazing_constructor' + character(len=char_len) :: log_message + + if (allocated(self%auto_ind)) then + log_message = 'grazing%auto_inds is already allocated!' + call marbl_status_log%log_error(log_message, subname) + return + end if + + if (allocated(self%zoo_ind)) then + log_message = 'grazing%zoo_inds is already allocated!' + call marbl_status_log%log_error(log_message, subname) + return + end if + + allocate(self%auto_ind(autotroph_cnt)) + allocate(self%zoo_ind(zooplankton_cnt)) + + end subroutine grazing_constructor + + !***************************************************************************** + +end module marbl_pft_mod \ No newline at end of file diff --git a/src/marbl_restore_mod.F90 b/src/marbl_restore_mod.F90 index c3b4a0fc..cf16b651 100644 --- a/src/marbl_restore_mod.F90 +++ b/src/marbl_restore_mod.F90 @@ -3,11 +3,16 @@ module marbl_restore_mod ! Module to generalize restoring any non-autotroph tracer ! - use marbl_kinds_mod , only : r8, int_kind, char_len - use marbl_constants_mod , only : p5, c0, c2, c1000 - use marbl_interface_types, only : marbl_domain_type - use marbl_sizes , only : marbl_total_tracer_cnt - use marbl_sizes , only : tracer_restore_cnt + use marbl_kinds_mod, only : r8 + use marbl_kinds_mod, only : int_kind + use marbl_kinds_mod, only : char_len + + use marbl_constants_mod, only : p5 + use marbl_constants_mod, only : c0 + use marbl_constants_mod, only : c2 + use marbl_constants_mod, only : c1000 + + use marbl_interface_public_types, only : marbl_domain_type implicit none public @@ -24,10 +29,8 @@ subroutine marbl_restore_compute_interior_restore(interior_tracers, km, & ! ! restore a variable if required ! - use marbl_kinds_mod , only : r8, int_kind - use marbl_constants_mod , only : c0 - use marbl_interface_types, only : marbl_forcing_fields_type - use marbl_internal_types , only : marbl_interior_forcing_indexing_type + use marbl_interface_public_types, only : marbl_forcing_fields_type + use marbl_interface_private_types, only : marbl_interior_forcing_indexing_type !----------------------------------------------------------------------- ! input variables @@ -42,7 +45,7 @@ subroutine marbl_restore_compute_interior_restore(interior_tracers, km, & ! output variables !----------------------------------------------------------------------- - real(kind=r8), dimension(marbl_total_tracer_cnt, km), intent(out) :: interior_restore + real(kind=r8), dimension(:, :), intent(out) :: interior_restore !----------------------------------------------------------------------- ! local variables @@ -56,7 +59,7 @@ subroutine marbl_restore_compute_interior_restore(interior_tracers, km, & restoring_inds => interior_forcing_ind%tracer_restore_id inv_tau_inds => interior_forcing_ind%inv_tau_id - do m=1,tracer_restore_cnt + do m=1,size(interior_forcing_ind%tracer_id) n = interior_forcing_ind%tracer_id(m) associate(restore_field => interior_forcings(restoring_inds(n))%field_1d, & inv_tau => interior_forcings(inv_tau_inds(n))%field_1d) diff --git a/src/marbl_saved_state_mod.F90 b/src/marbl_saved_state_mod.F90 index 8a98cb6a..e9693e10 100644 --- a/src/marbl_saved_state_mod.F90 +++ b/src/marbl_saved_state_mod.F90 @@ -12,11 +12,11 @@ subroutine marbl_saved_state_init(surface_state, interior_state, surf_ind, & interior_ind, num_levels, num_surface_elements, & num_interior_forcing, marbl_status_log) - use marbl_interface_types , only : marbl_saved_state_type - use marbl_internal_types , only : marbl_surface_saved_state_indexing_type - use marbl_internal_types , only : marbl_interior_saved_state_indexing_type - use marbl_logging , only : marbl_log_type - use marbl_kinds_mod , only : char_len + use marbl_interface_public_types, only : marbl_saved_state_type + use marbl_interface_private_types, only : marbl_surface_saved_state_indexing_type + use marbl_interface_private_types, only : marbl_interior_saved_state_indexing_type + use marbl_logging, only : marbl_log_type + use marbl_kinds_mod, only : char_len type(marbl_saved_state_type), intent(inout) :: surface_state diff --git a/src/marbl_settings_mod.F90 b/src/marbl_settings_mod.F90 new file mode 100644 index 00000000..71e43181 --- /dev/null +++ b/src/marbl_settings_mod.F90 @@ -0,0 +1,2496 @@ +module marbl_settings_mod + + !----------------------------------------------------------------------------- + ! This module manages BGC-specific parameters. + ! + ! Most of the variables are not parameters in the Fortran sense. In the + ! the Fortran sense, they are vanilla module variables that can be set + ! by marbl_instance%put_setting() calls from the GCM. + ! + ! In addition to containing all the parameters, this module also handles + ! initializing the variables to default values and then applying any + ! changes made via put_setting(). + ! + ! This module also writes parameter values to the status log. + !----------------------------------------------------------------------------- + + use marbl_kinds_mod, only : r8 + use marbl_kinds_mod, only : int_kind + use marbl_kinds_mod, only : log_kind + use marbl_kinds_mod, only : char_len + + use marbl_constants_mod, only : c0 + use marbl_constants_mod, only : c1 + use marbl_constants_mod, only : c2 + use marbl_constants_mod, only : c1000 + use marbl_constants_mod, only : dps + use marbl_constants_mod, only : molw_Fe + + use marbl_pft_mod, only : autotroph_type + use marbl_pft_mod, only : zooplankton_type + use marbl_pft_mod, only : grazing_type + + use marbl_logging, only: marbl_log_type + + implicit none + + !----------------------------------------------------------------------------- + ! public/private declarations + ! all module variables are public and should have their values preserved + !----------------------------------------------------------------------------- + + public + save + + !--------------------------------------------------------------------------- + ! Datatypes for marbl_instance%settings + !--------------------------------------------------------------------------- + + type, private :: marbl_single_setting_ll_type + ! Metadata + character(len=char_len) :: long_name + character(len=char_len) :: short_name + character(len=char_len) :: units + character(len=char_len) :: datatype + integer :: category_ind ! used for sorting output list + character(len=char_len) :: comment ! used to add comment in log + type(marbl_single_setting_ll_type), pointer :: next => NULL() + ! Actual parameter data + real(r8), pointer :: rptr => NULL() + integer(int_kind), pointer :: iptr => NULL() + logical(log_kind), pointer :: lptr => NULL() + character(len=char_len), pointer :: sptr => NULL() + end type marbl_single_setting_ll_type + + type, private :: marbl_setting_ptr + type(marbl_single_setting_ll_type), pointer :: ptr => NULL() + end type marbl_setting_ptr + + type, public :: marbl_settings_type + logical, private :: init_called = .false. + integer, private :: cnt = 0 + character(len=char_len), dimension(:), private, pointer :: categories + type(marbl_single_setting_ll_type), private, pointer :: vars => NULL() + type(marbl_single_setting_ll_type), private, pointer :: VarsFromPut => NULL() + type(marbl_single_setting_ll_type), private, pointer :: LastVarFromPut => NULL() + type(marbl_setting_ptr), dimension(:), private, allocatable :: varArray + contains + procedure :: add_var + procedure :: add_var_1d_r8 + procedure :: add_var_1d_int + procedure :: add_var_1d_str + procedure :: finalize_vars + procedure :: inquire_id + procedure :: inquire_metadata + procedure :: get_cnt + procedure :: put + procedure :: get + procedure :: destruct + end type marbl_settings_type + + !--------------------------------------------------------------------- + ! BGC parameters that are currently hard-coded + !--------------------------------------------------------------------- + + ! Redfield Ratios, dissolved & particulate + real(r8), parameter :: & + Q_10 = 1.7_r8, & ! factor for temperature dependence (non-dim) + xkw_coeff = 6.97e-9_r8, & ! in s/cm, from a = 0.251 cm/hr s^2/m^2 in Wannikhof 2014 + parm_Red_D_C_P = 117.0_r8, & ! carbon:phosphorus + parm_Red_D_N_P = 16.0_r8, & ! nitrogen:phosphorus + parm_Red_D_O2_P = 170.0_r8, & ! oxygen:phosphorus + parm_Remin_D_O2_P = 138.0_r8, & ! oxygen:phosphorus + parm_Red_P_C_P = parm_Red_D_C_P, & ! carbon:phosphorus + parm_Red_D_C_N = parm_Red_D_C_P/parm_Red_D_N_P, & ! carbon:nitrogen + parm_Red_P_C_N = parm_Red_D_C_N, & ! carbon:nitrogen + parm_Red_D_C_O2 = parm_Red_D_C_P/parm_Red_D_O2_P, & ! carbon:oxygen + parm_Remin_D_C_O2 = parm_Red_D_C_P/parm_Remin_D_O2_P, & ! carbon:oxygen + parm_Red_P_C_O2 = parm_Red_D_C_O2, & ! carbon:oxygen + parm_Red_Fe_C = 3.0e-6_r8, & ! iron:carbon + parm_Red_D_C_O2_diaz = parm_Red_D_C_P/150.0_r8 ! carbon:oxygen + ! for diazotrophs + + ! Misc. Rate constants + real(r8), parameter :: & + dust_Fe_scavenge_scale = 1.0e9 !dust scavenging scale factor + + ! dust_to_Fe: conversion of dust to iron (nmol Fe/g Dust) + ! dust remin gDust = 0.035 gFe mol Fe 1e9 nmolFe + ! --------- * ----------- * ---------- + ! gDust molw_Fe gFe molFe + real(r8), parameter :: dust_to_Fe = 0.035_r8 / molw_Fe * 1.0e9_r8 + + ! parameters related to Iron binding ligands + integer (int_kind), parameter :: Lig_cnt = 1 ! valid values are 1 or 2 + real(r8), parameter :: remin_to_Lig = 0.0001_r8 + + ! Partitioning of phytoplankton growth, grazing and losses + ! All f_* variables are fractions and are non-dimensional + real(r8), parameter :: & + caco3_poc_min = 0.40_r8, & ! minimum proportionality between + ! QCaCO3 and grazing losses to POC + ! (mmol C/mmol CaCO3) + spc_poc_fac = 0.13_r8, & ! small phyto grazing factor (1/mmolC) + f_graze_sp_poc_lim = 0.36_r8, & + f_photosp_CaCO3 = 0.40_r8, & ! proportionality between small phyto + ! production and CaCO3 production + f_graze_CaCO3_remin = 0.33_r8, & ! fraction of spCaCO3 grazing which is remin + f_graze_si_remin = 0.50_r8, & ! fraction of diatom Si grazing which is remin + f_toDON = 0.70_r8, & ! fraction DON relative to DOC + f_toDOP = 0.15_r8 ! fraction of remaining_P to DOP + + ! fixed ratios + real(r8), parameter :: r_Nfix_photo=1.25_r8 ! N fix relative to C fix (non-dim) + + ! SET parmaeters and RATIOS for N/C, P/C, SiO3/C, Fe/C, etc... + real(r8), parameter :: & + Q = 16.0_r8 / 117.0_r8, & !N/C ratio (mmol/mmol) of phyto & zoo + Qfe_zoo = 3.0e-6_r8, & !zooplankton Fe/C ratio + gQsi_0 = 0.137_r8, & !initial Si/C ratio for growth + gQsi_max = 0.685_r8, & !max Si/C ratio for growth + gQsi_min = 0.0457_r8, & !min Si/C ratio for growth + QCaCO3_max = 0.4_r8, & !max QCaCO3 + ! parameters in GalbraithMartiny Pquota Model^M + PquotaSlope = 7.0_r8, & + PquotaIntercept = 5.571_r8, & + PquotaMinNP = 0.00854701_r8, & + ! carbon:nitrogen ratio for denitrification + denitrif_C_N = parm_Red_D_C_P/136.0_r8 + + ! loss term threshold parameters, chl:c ratios + real(r8), parameter :: & + thres_z1_auto = 80.0e2_r8, & !autotroph threshold = C_loss_thres for z shallower than this (cm) + thres_z2_auto = 120.0e2_r8, & !autotroph threshold = 0 for z deeper than this (cm) + thres_z1_zoo = 110.0e2_r8, & !zooplankton threshold = C_loss_thres for z shallower than this (cm) + thres_z2_zoo = 150.0e2_r8, & !zooplankton threshold = 0 for z deeper than this (cm) + CaCO3_temp_thres1 = 4.0_r8, & !upper temp threshold for CaCO3 prod + CaCO3_temp_thres2 = -2.0_r8, & !lower temp threshold + CaCO3_sp_thres = 2.5_r8 ! bloom condition thres (mmolC/m3) + + ! fraction of incoming shortwave assumed to be PAR + real(r8), parameter :: f_qsw_par = 0.45_r8 ! PAR fraction + + ! DOM parameters for refractory components and DOP uptake + real(r8), parameter :: & + DOC_reminR_light = (c1/(365.0_r8*15.0_r8)) * dps, & ! remin rate for semi-labile DOC, 1/15yr + DON_reminR_light = (c1/(365.0_r8*15.0_r8)) * dps, & ! remin rate for semi-labile DON, 1/15yr + DOP_reminR_light = (c1/(365.0_r8*60.0_r8)) * dps, & ! remin rate for semi-labile DOP, 1/60yr + DOC_reminR_dark = (c1/(365.0_r8*6.0_r8)) * dps, & ! remin rate in the dark, 1/6yr + DON_reminR_dark = (c1/(365.0_r8*5.5_r8)) * dps, & ! remin rate in the dark, 1/5.5yr + DOP_reminR_dark = (c1/(365.0_r8*4.5_r8)) * dps ! remin rate in the dark, 1/4.5yr + + real(r8), parameter :: & + DOCr_reminR0 = (c1/(365.0_r8*16000.0_r8)) * dps, & ! remin rate for refractory DOC, 1/16000yr + DONr_reminR0 = (c1/(365.0_r8*9500.0_r8)) * dps, & ! remin rate for refractory DON, 1/9500yr + DOPr_reminR0 = (c1/(365.0_r8*5500.0_r8)) * dps, & ! remin rate for refractory DOP, 1/5500yr + DOMr_reminR_photo = (c1/(365.0_r8*18.0_r8)) * dps ! additional remin from photochemistry, 1/18yrs over top 10m + + real(r8), parameter :: & + DOCprod_refract = 0.01_r8, & ! fraction of DOCprod to refractory pool + DONprod_refract = 0.0115_r8, & ! fraction of DONprod to refractory pool + DOPprod_refract = 0.003_r8, & ! fraction of DOPprod to refractory pool + POCremin_refract = DOCprod_refract * 0.06_r8, & ! fraction of POCremin to refractory pool + PONremin_refract = DONprod_refract * 0.03_r8, & ! fraction of POCremin to refractory pool + POPremin_refract = DOPprod_refract * 0.06_r8 ! fraction of POCremin to refractory pool + + !--------------------------------------------------------------------------------------------- + ! Variables defined in marbl_settings_define_general_parms, marbl_settings_define_PFT_counts, + ! marbl_settings_define_PFT_derived_types, or marbl_settings_define_tracer_dependent + ! + ! CESM NOTE: defaults values are set in the corresponding marbl_settings_set_defaults routines + ! but may be overridden at run time through a put_setting() call (use user_nl_pop + ! to change parameter value) + !--------------------------------------------------------------------------------------------- + + ! marbl_settings_mod_general_parms + ! parameters with no dependencies on other parameter values + !------------------------------------------------------------- + + character(len=char_len), target :: PFT_defaults ! Set up PFT parameters based on known classes, e.g. 'CESM2' + ! (or set to 'user-specified' and use put_setting()) + logical(log_kind), target :: ciso_on ! control whether ciso tracer module is active + logical(log_kind), target :: lsource_sink ! control which portion of code is executed, useful for debugging + logical(log_kind), target :: ciso_lsource_sink ! control which portion of carbon isotope code is executed, useful for debugging + logical(log_kind), target :: lecovars_full_depth_tavg ! should base ecosystem vars be written full depth + logical(log_kind), target :: ciso_lecovars_full_depth_tavg ! should carbon isotope vars be written full depth + logical(log_kind), target :: lflux_gas_o2 ! controls which portion of code are executed usefull for debugging + logical(log_kind), target :: lflux_gas_co2 ! controls which portion of code are executed usefull for debugging + logical(log_kind), target :: lcompute_nhx_surface_emis ! control if NHx emissions are computed + logical(log_kind), target :: lvariable_PtoC ! control if PtoC ratios in autotrophs vary + logical(log_kind), target :: ladjust_bury_coeff ! control if bury coefficients are adjusted (rather than constant) + ! bury coefficients (POC_bury_coeff, POP_bury_coeff, bSi_bury_coeff) + ! reside in marbl_particulate_share_type; when ladjust_bury_coeff is + ! .true., bury coefficients are adjusted to preserve C, P, Si + ! inventories on timescales exceeding bury_coeff_rmean_timescale_years + ! (this is done primarily in spinup runs) + + character(len=char_len), target :: init_bury_coeff_opt + + real(r8), target :: & + parm_Fe_bioavail, & ! fraction of Fe flux that is bioavailable + parm_o2_min, & ! min O2 needed for prod & consump. (nmol/cm^3) + parm_o2_min_delta, & ! width of min O2 range (nmol/cm^3) + parm_kappa_nitrif_per_day, & ! nitrification inverse time constant (1/day) + parm_kappa_nitrif, & ! nitrification inverse time constant (1/sec) (derived from parm_kappa_nitrif_per_day) + parm_nitrif_par_lim, & ! PAR limit for nitrif. (W/m^2) + parm_labile_ratio, & ! fraction of loss to DOC that routed directly to DIC (non-dimensional) + parm_init_POC_bury_coeff, & ! initial scale factor for burial of POC, PON + parm_init_POP_bury_coeff, & ! initial scale factor for burial of POP + parm_init_bSi_bury_coeff, & ! initial scale factor burial of bSi + parm_Fe_scavenge_rate0, & ! scavenging base rate for Fe + parm_Lig_scavenge_rate0, & ! scavenging base rate for bound ligand + parm_FeLig_scavenge_rate0, & ! scavenging base rate for bound iron + parm_Lig_degrade_rate0, & ! Fe-binding ligand bacterial degradation base rate coefficient + parm_Fe_desorption_rate0, & ! desorption rate for scavenged Fe from particles + parm_f_prod_sp_CaCO3, & ! fraction of sp prod. as CaCO3 prod. + parm_POC_diss, & ! base POC diss len scale + parm_SiO2_diss, & ! base SiO2 diss len scale + parm_CaCO3_diss, & ! base CaCO3 diss len scale + parm_sed_denitrif_coeff, & ! global scaling factor for sed_denitrif + bury_coeff_rmean_timescale_years + + real(r8), dimension(4), target :: & + parm_scalelen_z, & ! depths of prescribed scalelen values + parm_scalelen_vals ! prescribed scalelen values + + real(r8), target :: iron_frac_in_dust ! fraction by weight of iron in dust + real(r8), target :: iron_frac_in_bc ! fraction by weight of iron in black carbon + character(len=char_len), target :: caco3_bury_thres_opt ! option of threshold of caco3 burial ['fixed_depth', 'omega_calc'] + real(r8), target :: caco3_bury_thres_depth ! threshold depth for caco3_bury_thres_opt='fixed_depth' + ! ----------- + ! PON_sed_loss = PON_bury_coeff * Q * POC_sed_loss + ! factor is used to avoid overburying PON like POC + ! is when total C burial is matched to C riverine input + ! ----------- + real(r8), target :: PON_bury_coeff + character(len=char_len), target :: ciso_fract_factors ! option for which biological fractionation calculation to use + + ! marbl_settings_define_PFT_counts + ! Parameters determining array size for PFT derived types + ! (can not be set until PFT_defaults is set) + !------------------------------------------------------------- + + integer(int_kind), target :: autotroph_cnt ! number of autotroph classes + integer(int_kind), target :: zooplankton_cnt ! number of zooplankton classes + integer(int_kind), target :: max_grazer_prey_cnt ! max number of biomass aggregates grazed by a zooplankton class + + ! marbl_settings_define_PFT_derived_types + ! Parameters associated with the PFT classes + ! (can not be set until autotroph_cnt, zooplankton_cnt + ! are max_grazer_prey_cnt are known) + !------------------------------------------------------------- + + type(autotroph_type), allocatable, target :: autotrophs(:) + type(zooplankton_type), allocatable, target :: zooplankton(:) + type(grazing_type), allocatable, target :: grazing(:,:) + + ! marbl_settings_define_tracer_dependent + ! parameters that can not be set until MARBL knows what tracers + ! have been enabled. + ! Currently just tracer_restore_vars (which has dimension of + ! tracer_cnt; also, only valid values are tracer short names) + !----------------------------------------------------------------- + + ! FIXME #69: this array is allocated in marbl_init_mod:marbl_init_tracers() + ! and that allocation is not ideal for threaded runs + character(len=char_len), allocatable, target, dimension(:) :: tracer_restore_vars + + !--------------------------------------------------------------------- + ! Auxiliary variables (str -> int conversions, indices, etc) + !--------------------------------------------------------------------- + + integer (int_kind) :: caco3_bury_thres_iopt + integer (int_kind), parameter :: caco3_bury_thres_iopt_fixed_depth = 1 + integer (int_kind), parameter :: caco3_bury_thres_iopt_omega_calc = 2 + + !***************************************************************************** + + interface print_single_derived_parm + module procedure print_single_derived_parm_r8 + module procedure print_single_derived_parm_int + end interface print_single_derived_parm + + ! Functions only used in this module + private :: add_var + private :: add_var_1d_r8 + private :: add_var_1d_int + private :: add_var_1d_str + private :: finalize_vars + private :: put + private :: get + private :: get_cnt + private :: inquire_id + private :: inquire_metadata + private :: check_and_log_add_var_error + private :: case_insensitive_eq + private :: print_single_derived_parm + private :: print_single_derived_parm_r8 + private :: print_single_derived_parm_int + +contains + + !***************************************************************************** + + subroutine marbl_settings_set_defaults_general_parms() + + PFT_defaults = 'CESM2' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + ciso_on = .false. ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + lsource_sink = .true. ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + ciso_lsource_sink = .true. ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + lecovars_full_depth_tavg = .false. ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + ciso_lecovars_full_depth_tavg = .false. ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + lflux_gas_o2 = .true. ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + lflux_gas_co2 = .true. ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + lcompute_nhx_surface_emis = .true. ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + lvariable_PtoC = .true. ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + init_bury_coeff_opt = 'nml' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + ladjust_bury_coeff = .false. ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_Fe_bioavail = 1.0_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_o2_min = 5.0_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_o2_min_delta = 5.0_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_kappa_nitrif_per_day = 0.06_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_nitrif_par_lim = 1.0_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_labile_ratio = 0.94_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_init_POC_bury_coeff = 1.1_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_init_POP_bury_coeff = 1.1_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_init_bSi_bury_coeff = 1.0_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_Fe_scavenge_rate0 = 15.0_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_Lig_scavenge_rate0 = 0.015_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_FeLig_scavenge_rate0 = 1.3_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_Lig_degrade_rate0 = 0.000094_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_Fe_desorption_rate0 = 1.0e-6_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_f_prod_sp_CaCO3 = 0.070_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_POC_diss = 100.0e2_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_SiO2_diss = 770.0e2_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_CaCO3_diss = 500.0e2_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_sed_denitrif_coeff = 1.0_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + bury_coeff_rmean_timescale_years = 10.0_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_scalelen_z = (/ 100.0e2_r8, 250.0e2_r8, 500.0e2_r8, 1000.0e2_r8 /) ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + parm_scalelen_vals = (/ 1.0_r8, 2.2_r8, 4.0_r8, 5.0_r8 /) ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + + iron_frac_in_dust = 0.035_r8 * 0.01_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + iron_frac_in_bc = 0.06_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + caco3_bury_thres_opt = 'omega_calc' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + caco3_bury_thres_depth = 3000.0e2 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + PON_bury_coeff = 0.5_r8 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + ciso_fract_factors = 'Rau' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + + end subroutine marbl_settings_set_defaults_general_parms + + !***************************************************************************** + + subroutine marbl_settings_set_defaults_PFT_counts(marbl_status_log) + + type(marbl_log_type), intent(inout) :: marbl_status_log + + character(len=*), parameter :: subname = 'marbl_settings_mod:marbl_settings_set_defaults_PFT_counts' + character(len=char_len) :: log_message + + select case (trim(PFT_defaults)) + case ('CESM2') + autotroph_cnt = 3 + zooplankton_cnt = 1 + max_grazer_prey_cnt = 3 + case ('user-specified') + ! User must change these with put_setting() + autotroph_cnt = -1 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + zooplankton_cnt = -1 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + max_grazer_prey_cnt = -1 ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + case DEFAULT + write(log_message, "(3A)") "'", trim(PFT_defaults), "'' is not a valid value for PFT_defaults" + end select + + end subroutine marbl_settings_set_defaults_PFT_counts + + !***************************************************************************** + + subroutine marbl_settings_set_defaults_PFT_derived_types(marbl_status_log) + + type(marbl_log_type), intent(inout) :: marbl_status_log + + character(len=*), parameter :: subname = 'marbl_settings_mod:marbl_settings_set_defaults_PFT_derived_types' + character(len=char_len) :: log_message + integer :: m, n + + if (.not. all((/allocated(autotrophs), allocated(zooplankton), allocated(grazing)/))) then + write(log_message, '(A)') 'autotrophs, zooplankton, and grazing have not been allocated!' + call marbl_status_log%log_error(log_message, subname) + return + end if + + select case (trim(PFT_defaults)) + case ('CESM2') + call autotrophs(1)%set_to_default('sp', marbl_status_log) + call autotrophs(2)%set_to_default('diat', marbl_status_log) + call autotrophs(3)%set_to_default('diaz', marbl_status_log) + call zooplankton(1)%set_to_default('zoo', marbl_status_log) + call grazing(1,1)%set_to_default('sp_zoo', marbl_status_log) + call grazing(2,1)%set_to_default('diat_zoo', marbl_status_log) + call grazing(3,1)%set_to_default('diaz_zoo', marbl_status_log) + case ('user-specified') + do m=1,autotroph_cnt + call autotrophs(m)%set_to_default('unset', marbl_status_log) + end do + do n=1,zooplankton_cnt + call zooplankton(n)%set_to_default('unset', marbl_status_log) + end do + do n=1,zooplankton_cnt + do m=1,max_grazer_prey_cnt + call grazing(m,n)%set_to_default('unset', marbl_status_log) + end do + end do + case DEFAULT + write(log_message, "(3A)") "'", trim(PFT_defaults), "' is not a valid value for PFT_defaults" + call marbl_status_log%log_error(log_message, subname) + return + end select + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace('PFT set_to_default()', subname) + return + end if + + end subroutine marbl_settings_set_defaults_PFT_derived_types + + !***************************************************************************** + + subroutine marbl_settings_set_defaults_tracer_dependent(marbl_status_log) + + type(marbl_log_type), intent(inout) :: marbl_status_log + + character(len=*), parameter :: subname = 'marbl_settings_mod:marbl_settings_set_defaults_tracer_dependent' + + if (.not. allocated(tracer_restore_vars)) then + call marbl_status_log%log_error('tracer_restore_vars has not been allocated!', subname) + return + end if + + ! initialize namelist variables to default values + tracer_restore_vars = '' ! CESM USERS - DO NOT CHANGE HERE! POP calls put_setting() for this var, see CESM NOTE above + + end subroutine marbl_settings_set_defaults_tracer_dependent + + !***************************************************************************** + + subroutine marbl_settings_define_general_parms(this, marbl_status_log) + + class(marbl_settings_type), intent(inout) :: this + type(marbl_log_type), intent(inout) :: marbl_status_log + + character(len=*), parameter :: subname = 'marbl_settings_mod:marbl_settings_define_general_parms' + character(len=char_len) :: log_message + + character(len=char_len) :: sname, lname, units, datatype, category + real(r8), pointer :: rptr => NULL() + integer(int_kind), pointer :: iptr => NULL() + logical(log_kind), pointer :: lptr => NULL() + character(len=char_len), pointer :: sptr => NULL() + logical :: labort_marbl_loc + + if (associated(this%vars)) then + write(log_message, "(A)") "this%settings has been constructed already" + call marbl_status_log%log_error(log_message, subname) + return + end if + allocate(this%categories(0)) + labort_marbl_loc = .false. + + ! ---------------------- + category = 'config PFTs' + ! ---------------------- + + sname = 'PFT_defaults' + lname = 'Define how PFTs are initialized' + units = 'unitless' + datatype = 'string' + sptr => PFT_defaults + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, sptr=sptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + ! ----------------------- + category = 'config flags' + ! ----------------------- + + sname = 'ciso_on' + lname = 'Control whether CISO tracer module is active' + units = 'unitless' + datatype = 'logical' + lptr => ciso_on + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, lptr=lptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'lsource_sink' + lname = 'Control which portions of code are executed (useful for debugging)' + units = 'unitless' + datatype = 'logical' + lptr => lsource_sink + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, lptr=lptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'lecovars_full_depth_tavg' + lname = 'Are base ecosystem tracers full depth?' + units = 'unitless' + datatype = 'logical' + lptr => lecovars_full_depth_tavg + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, lptr=lptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'ciso_lsource_sink' + lname = 'Control which portions of carbon isotope code are executed (useful for debugging)' + units = 'unitless' + datatype = 'logical' + lptr => ciso_lsource_sink + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, lptr=lptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'ciso_lecovars_full_depth_tavg' + lname = 'Are carbon isotope tracers full depth?' + units = 'unitless' + datatype = 'logical' + lptr => ciso_lecovars_full_depth_tavg + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, lptr=lptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'lflux_gas_o2' + lname = 'Run O2 gas flux portion of the code' + units = 'unitless' + datatype = 'logical' + lptr => lflux_gas_o2 + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, lptr=lptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'lflux_gas_co2' + lname = 'Run CO2 gas flux portion of the code' + units = 'unitless' + datatype = 'logical' + lptr => lflux_gas_co2 + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, lptr=lptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'lcompute_nhx_surface_emis' + lname = 'control if NHx emissions are computed' + units = 'unitless' + datatype = 'logical' + lptr => lcompute_nhx_surface_emis + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, lptr=lptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'lvariable_PtoC' + lname = 'control if PtoC ratios in autotrophs vary' + units = 'unitless' + datatype = 'logical' + lptr => lvariable_PtoC + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, lptr=lptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'ladjust_bury_coeff' + lname = 'Adjust the bury coefficient to maintain equilibrium' + units = 'unitless' + datatype = 'logical' + lptr => ladjust_bury_coeff + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, lptr=lptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + ! -------------------------- + category = 'config strings' + ! -------------------------- + + sname = 'init_bury_coeff_opt' + lname = 'How to set initial bury coefficients' + units = 'unitless' + datatype = 'string' + sptr => init_bury_coeff_opt + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, sptr=sptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + ! ----------------------------- + category = 'general parmeters' + ! ----------------------------- + + sname = 'parm_Fe_bioavail' + lname = 'Fraction of Fe flux that is bioavailable' + units = 'unitless' + datatype = 'real' + rptr => parm_Fe_bioavail + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_o2_min' + lname = 'Minimum O2 needed for production and consumption' + units = 'nmol/cm^3' + datatype = 'real' + rptr => parm_o2_min + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_o2_min_delta' + lname = 'Width of minimum O2 range' + units = 'nmol/cm^3' + datatype = 'real' + rptr => parm_o2_min_delta + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_kappa_nitrif_per_day' + lname = 'Nitrification inverse time constant' + units = '1/day' + datatype = 'real' + rptr => parm_kappa_nitrif_per_day + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_nitrif_par_lim' + lname = 'PAR limit for nitrification' + units = 'W/m^2' + datatype = 'real' + rptr => parm_nitrif_par_lim + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_labile_ratio' + lname = 'Fraction of loss to DOC that is routed directly to DIC' + units = 'unitless' + datatype = 'real' + rptr => parm_labile_ratio + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_init_POC_bury_coeff' + lname = 'initial scale factor for burial of POC, PON' + units = 'unitless' + datatype = 'real' + rptr => parm_init_POC_bury_coeff + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_init_POP_bury_coeff' + lname = 'initial scale factor for burial of POP' + units = 'unitless' + datatype = 'real' + rptr => parm_init_POP_bury_coeff + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_init_bSi_bury_coeff' + lname = 'initial scale factor for burial of bSi' + units = 'unitless' + datatype = 'real' + rptr => parm_init_bSi_bury_coeff + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_Fe_scavenge_rate0' + lname = 'scavenging base rate for Fe' + units = '1/yr' + datatype = 'real' + rptr => parm_Fe_scavenge_rate0 + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_Lig_scavenge_rate0' + lname = 'scavenging base rate for bound ligand' + units = '1/yr' + datatype = 'real' + rptr => parm_Lig_scavenge_rate0 + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_FeLig_scavenge_rate0' + lname = 'scavenging base rate for bound iron' + units = '1/yr' + datatype = 'real' + rptr => parm_FeLig_scavenge_rate0 + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_Lig_degrade_rate0' + lname = 'Fe-binding ligand bacterial degradation rate coefficient' + units = '1' + datatype = 'real' + rptr => parm_Lig_degrade_rate0 + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_Fe_desorption_rate0' + lname = 'desorption rate for scavenged Fe from particles' + units = '1/cm' + datatype = 'real' + rptr => parm_Fe_desorption_rate0 + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_f_prod_sp_CaCO3' + lname = 'Fraction of sp production as CaCO3 production' + units = 'unitless' + datatype = 'real' + rptr => parm_f_prod_sp_CaCO3 + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_POC_diss' + lname = 'base POC dissolution length scale' + units = 'cm' + datatype = 'real' + rptr => parm_POC_diss + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_SiO2_diss' + lname = 'base SiO2 dissolution length scale' + units = 'cm' + datatype = 'real' + rptr => parm_SiO2_diss + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_CaCO3_diss' + lname = 'base CaCO3 dissolution length scale' + units = 'cm' + datatype = 'real' + rptr => parm_CaCO3_diss + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_sed_denitrif_coeff' + lname = 'global scaling factor for sed_denitrif' + units = '1' + datatype = 'real' + rptr => parm_sed_denitrif_coeff + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'bury_coeff_rmean_timescale_years' + lname = 'Timescale for bury coefficient running means' + units = 'yr' + datatype = 'real' + rptr => bury_coeff_rmean_timescale_years + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + ! ------------------------- + category = 'Scale lengths' + ! ------------------------- + + sname = 'parm_scalelen_z' + lname = 'Depths of prescribed scale length values' + units = 'cm' + call this%add_var_1d_r8(sname, lname, units, category, & + parm_scalelen_z, marbl_status_log) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'parm_scalelen_vals' + lname = 'Prescribed scale length values' + units = 'cm' + call this%add_var_1d_r8(sname, lname, units, category, & + parm_scalelen_vals, marbl_status_log) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + ! ----------------------------- + category = 'general parmeters' + ! ----------------------------- + + sname = 'iron_frac_in_dust' + lname = 'Fraction by weight of iron in dust' + units = 'unitless (kg/kg)' + datatype = 'real' + rptr => iron_frac_in_dust + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'iron_frac_in_bc' + lname = 'Fraction by weight of iron in black carbon' + units = 'unitless (kg/kg)' + datatype = 'real' + rptr => iron_frac_in_bc + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'caco3_bury_thres_opt' + lname = 'Option for CaCO3 burial threshold' + units = 'unitless' + datatype = 'string' + sptr => caco3_bury_thres_opt + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, sptr=sptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'caco3_bury_thres_depth' + lname = 'Threshold depth for CaCO3 burial (if using fixed_depth option)' + units = 'cm' + datatype = 'real' + rptr => caco3_bury_thres_depth + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'PON_bury_coeff' + lname = 'scale factor for burial of PON' + units = 'unitless' + datatype = 'real' + rptr => PON_bury_coeff + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'ciso_fract_factors' + lname = 'Option for which biological fractionation calculation to use' + units = 'unitless' + datatype = 'string' + sptr => ciso_fract_factors + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, sptr=sptr) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + marbl_status_log%labort_marbl = labort_marbl_loc + if (marbl_status_log%labort_marbl) return + + end subroutine marbl_settings_define_general_parms + + !***************************************************************************** + + subroutine marbl_settings_define_PFT_counts(this, marbl_status_log) + + class(marbl_settings_type), intent(inout) :: this + type(marbl_log_type), intent(inout) :: marbl_status_log + + character(len=*), parameter :: subname = 'marbl_settings_mod:marbl_settings_define_PFT_counts' + character(len=char_len) :: log_message + + character(len=char_len) :: sname, lname, units, datatype, category + integer(int_kind), pointer :: iptr => NULL() + integer :: m,n + logical :: labort_marbl_loc + + labort_marbl_loc = .false. + + ! ---------------------- + category = 'config PFTs' + ! ---------------------- + + sname = 'autotroph_cnt' + lname = 'Number of autotroph classes' + units = 'unitless' + datatype = 'integer' + iptr => autotroph_cnt + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, iptr=iptr, & + nondefault_allowed=(PFT_defaults .eq. "user-specified"), & + nondefault_required=(PFT_defaults .eq. "user-specified")) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'zooplankton_cnt' + lname = 'Number of zooplankton classes' + units = 'unitless' + datatype = 'integer' + iptr => zooplankton_cnt + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, iptr=iptr, & + nondefault_allowed=(PFT_defaults .eq. "user-specified"), & + nondefault_required=(PFT_defaults .eq. "user-specified")) + + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + sname = 'max_grazer_prey_cnt' + lname = 'Number of grazer prey classes' + units = 'unitless' + datatype = 'integer' + iptr => max_grazer_prey_cnt + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, iptr=iptr, & + nondefault_allowed=(PFT_defaults .eq. "user-specified"), & + nondefault_required=(PFT_defaults .eq. "user-specified")) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + marbl_status_log%labort_marbl = labort_marbl_loc + if (marbl_status_log%labort_marbl) return + + ! FIXME #69: this is not ideal for threaded runs + if (.not. allocated(autotrophs)) & + allocate(autotrophs(autotroph_cnt)) + if (.not. allocated(zooplankton)) & + allocate(zooplankton(zooplankton_cnt)) + if (.not. allocated(grazing)) then + allocate(grazing(max_grazer_prey_cnt, zooplankton_cnt)) + do n=1,zooplankton_cnt + do m=1,max_grazer_prey_cnt + call grazing(m,n)%construct(autotroph_cnt, zooplankton_cnt, marbl_status_log) + if (marbl_status_log%labort_marbl) then + write(log_message,"(A,I0,A,I0,A)") 'grazing(', m, ',', n, ')%construct' + call marbl_status_log%log_error_trace(log_message, subname) + return + end if + end do + end do + end if + + end subroutine marbl_settings_define_PFT_counts + + !***************************************************************************** + + subroutine marbl_settings_define_PFT_derived_types(this, marbl_status_log) + + class(marbl_settings_type), intent(inout) :: this + type(marbl_log_type), intent(inout) :: marbl_status_log + + character(len=*), parameter :: subname = 'marbl_settings_mod:marbl_settings_define_PFT_derived_types' + character(len=char_len) :: log_message + + character(len=char_len) :: sname, lname, units, datatype, category + real(r8), pointer :: rptr => NULL() + integer(int_kind), pointer :: iptr => NULL() + logical(log_kind), pointer :: lptr => NULL() + character(len=char_len), pointer :: sptr => NULL() + + logical :: labort_marbl_loc + integer :: m, n, cnt + character(len=char_len) :: prefix + + labort_marbl_loc = .false. + do n=1,autotroph_cnt + write(prefix, "(A,I0,A)") 'autotrophs(', n, ')%' + write(category, "(A,1X,I0)") 'autotroph', n + + write(sname, "(2A)") trim(prefix), 'sname' + lname = 'Short name of autotroph' + units = 'unitless' + datatype = 'string' + sptr => autotrophs(n)%sname + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, sptr=sptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'lname' + lname = 'Long name of autotroph' + units = 'unitless' + datatype = 'string' + sptr => autotrophs(n)%lname + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, sptr=sptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'Nfixer' + lname = 'Flag is true if this autotroph fixes N2' + units = 'unitless' + datatype = 'logical' + lptr => autotrophs(n)%Nfixer + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, lptr=lptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'imp_calcifier' + lname = 'Flag is true if this autotroph implicitly handles calcification' + units = 'unitless' + datatype = 'logical' + lptr => autotrophs(n)%imp_calcifier + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, lptr=lptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'exp_calcifier' + lname = 'Flag is true if this autotroph explicitly handles calcification' + units = 'unitless' + datatype = 'logical' + lptr => autotrophs(n)%exp_calcifier + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, lptr=lptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'silicifier' + lname = 'Flag is true if this autotroph is a silicifier' + units = 'unitless' + datatype = 'logical' + lptr => autotrophs(n)%silicifier + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, lptr=lptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'kFe' + lname = 'nutrient uptake half-sat constants' + units = 'nmol/cm^3' + datatype = 'real' + rptr => autotrophs(n)%kFe + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'kPO4' + lname = 'nutrient uptake half-sat constants' + units = 'nmol/cm^3' + datatype = 'real' + rptr => autotrophs(n)%kPO4 + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'kDOP' + lname = 'nutrient uptake half-sat constants' + units = 'nmol/cm^3' + datatype = 'real' + rptr => autotrophs(n)%kDOP + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'kNO3' + lname = 'nutrient uptake half-sat constants' + units = 'nmol/cm^3' + datatype = 'real' + rptr => autotrophs(n)%kNO3 + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'kNH4' + lname = 'nutrient uptake half-sat constants' + units = 'nmol/cm^3' + datatype = 'real' + rptr => autotrophs(n)%kNH4 + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'kSiO3' + lname = 'nutrient uptake half-sat constants' + units = 'nmol/cm^3' + datatype = 'real' + rptr => autotrophs(n)%kSiO3 + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'Qp_fixed' + lname = 'P/C ratio when using fixed P/C ratios' + units = 'unitless' + datatype = 'real' + rptr => autotrophs(n)%Qp_fixed + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'gQfe_0' + lname = 'initial Fe/C ratio for growth' + units = 'unitless' + datatype = 'real' + rptr => autotrophs(n)%gQFe_0 + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'gQfe_min' + lname = 'minimum Fe/C ratio for growth' + units = 'unitless' + datatype = 'real' + rptr => autotrophs(n)%gQFe_min + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'alphaPi_per_day' + lname = 'Initial slope of P_I curve (GD98)' + units = 'mmol C m^2 / (mg Chl W day)' + datatype = 'real' + rptr => autotrophs(n)%alphaPi_per_day + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'PCref_per_day' + lname = 'max C-spec growth rate at Tref' + units = '1/day' + datatype = 'real' + rptr => autotrophs(n)%PCref_per_day + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'thetaN_max' + lname = 'max thetaN (Chl/N)' + units = 'mg Chl / mmol N' + datatype = 'real' + rptr => autotrophs(n)%thetaN_max + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'loss_thres' + lname = 'concentration where losses go to zero' + units = 'nmol/cm^3' + datatype = 'real' + rptr => autotrophs(n)%loss_thres + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'loss_thres2' + lname = 'concentration where losses go to zero' + units = 'nmol/cm^3' + datatype = 'real' + rptr => autotrophs(n)%loss_thres2 + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'temp_thres' + lname = 'Temperature where concentration threshold and photosynthesis rate drop' + units = 'deg C' + datatype = 'real' + rptr => autotrophs(n)%temp_thres + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'mort_per_day' + lname = 'linear mortality rate' + units = '1/day' + datatype = 'real' + rptr => autotrophs(n)%mort_per_day + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'mort2_per_day' + lname = 'quadratic mortality rate' + units = '1/day/(mmol C/m^3)' + datatype = 'real' + rptr => autotrophs(n)%mort2_per_day + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'agg_rate_max' + lname = 'Maximum agg rate' + units = '1/d' + datatype = 'real' + rptr => autotrophs(n)%agg_rate_max + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'agg_rate_min' + lname = 'Minimum agg rate' + units = '1/d' + datatype = 'real' + rptr => autotrophs(n)%agg_rate_min + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'loss_poc' + lname = 'routing of loss term' + units = 'unitless' + datatype = 'real' + rptr => autotrophs(n)%loss_poc + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + end do + + do n=1, zooplankton_cnt + write(prefix, "(A,I0,A)") 'zooplankton(', n, ')%' + write(category, "(A,1X,I0)") 'zooplankton', n + + write(sname, "(2A)") trim(prefix), 'sname' + lname = 'Short name of zooplankton' + units = 'unitless' + datatype = 'string' + sptr => zooplankton(n)%sname + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, sptr=sptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'lname' + lname = 'Long name of zooplankton' + units = 'unitless' + datatype = 'string' + sptr => zooplankton(n)%lname + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, sptr=sptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'z_mort_0_per_day' + lname = 'Linear mortality rate' + units = '1/day' + datatype = 'real' + rptr => zooplankton(n)%z_mort_0_per_day + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'loss_thres' + lname = 'Concentration where losses go to zero' + units = 'nmol/cm^3' + datatype = 'real' + rptr => zooplankton(n)%loss_thres + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'z_mort2_0_per_day' + lname = 'Quadratic mortality rate' + units = '1/day/(mmol C / m^3)' + datatype = 'real' + rptr => zooplankton(n)%z_mort2_0_per_day + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + end do + + do n=1,zooplankton_cnt + do m=1,max_grazer_prey_cnt + write(prefix, "(A,I0,A,I0,A)") 'grazing(', m, ',', n, ')%' + write(category, "(A,1X,I0,1X,I0)") 'grazing', m, n + + write(sname, "(2A)") trim(prefix), 'sname' + lname = 'Short name of grazer' + units = 'unitless' + datatype = 'string' + sptr => grazing(m,n)%sname + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, sptr=sptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'lname' + lname = 'Long name of grazer' + units = 'unitless' + datatype = 'string' + sptr => grazing(m,n)%lname + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, sptr=sptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'auto_ind_cnt' + lname = 'number of autotrophs in prey-clase auto_ind' + units = 'unitless' + datatype = 'integer' + iptr => grazing(m,n)%auto_ind_cnt + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, iptr=iptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'zoo_ind_cnt' + lname = 'number of zooplankton in prey-clase auto_ind' + units = 'unitless' + datatype = 'integer' + iptr => grazing(m,n)%zoo_ind_cnt + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, iptr=iptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'grazing_function' + lname = 'functional form of grazing parmaeterization' + units = 'unitless' + datatype = 'integer' + iptr => grazing(m,n)%grazing_function + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, iptr=iptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'z_umax_0_per_day' + lname = 'max zoo growth rate at Tref' + units = '1/day' + datatype = 'real' + rptr => grazing(m,n)%z_umax_0_per_day + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'z_grz' + lname = 'Grazing coefficient' + units = '(mmol C/m^3)^2' + datatype = 'real' + rptr => grazing(m,n)%z_grz + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'graze_zoo' + lname = 'routing of grazed term (remainder goes to DIC)' + units = 'unitless' + datatype = 'real' + rptr => grazing(m,n)%graze_zoo + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'graze_poc' + lname = 'routing of grazed term (remainder goes to DIC)' + units = 'unitless' + datatype = 'real' + rptr => grazing(m,n)%graze_poc + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'graze_doc' + lname = 'routing of grazed term (remainder goes to DIC)' + units = 'unitless' + datatype = 'real' + rptr => grazing(m,n)%graze_doc + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + write(sname, "(2A)") trim(prefix), 'f_zoo_detr' + lname = 'Fraction of zoo losses to detrital' + units = 'unitless' + datatype = 'real' + rptr => grazing(m,n)%f_zoo_detr + call this%add_var(sname, lname, units, datatype, category, & + marbl_status_log, rptr=rptr, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + cnt = grazing(m,n)%auto_ind_cnt + if (cnt .gt. 0) then + write(sname, "(2A)") trim(prefix), 'auto_ind' + lname = 'Indices of autotrophs in class' + units = 'unitless' + call this%add_var_1d_int(sname, lname, units, category, & + grazing(m,n)%auto_ind(1:cnt), & + marbl_status_log, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + end if + + cnt = grazing(m,n)%zoo_ind_cnt + if (cnt .gt. 0) then + write(sname, "(2A)") trim(prefix), 'zoo_ind' + lname = 'Indices of autotrophs in class' + units = 'unitless' + call this%add_var_1d_int(sname, lname, units, category, & + grazing(m,n)%zoo_ind(1:cnt), & + marbl_status_log, & + nondefault_required=(PFT_defaults .eq. 'user-specified')) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + end if + + end do + end do + + marbl_status_log%labort_marbl = labort_marbl_loc + if (marbl_status_log%labort_marbl) return + + end subroutine marbl_settings_define_PFT_derived_types + + !***************************************************************************** + + subroutine marbl_settings_define_tracer_dependent(this, marbl_status_log) + + class(marbl_settings_type), intent(inout) :: this + type(marbl_log_type), intent(inout) :: marbl_status_log + + character(len=*), parameter :: subname = 'marbl_settings_mod:marbl_settings_define_tracer_dependent' + character(len=char_len) :: sname, lname, units, category + logical :: labort_marbl_loc + + labort_marbl_loc = .false. + ! ---------------------------- + category = 'tracer restoring' + ! ---------------------------- + + sname = 'tracer_restore_vars' + lname = 'Tracer names for tracers that are restored' + units = 'unitless' + call this%add_var_1d_str(sname, lname, units, category, & + tracer_restore_vars, marbl_status_log) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + marbl_status_log%labort_marbl = labort_marbl_loc + if (marbl_status_log%labort_marbl) return + + end subroutine marbl_settings_define_tracer_dependent + + !***************************************************************************** + + subroutine marbl_settings_set_all_derived(marbl_status_log) + + type(marbl_log_type), intent(inout) :: marbl_status_log + + !--------------------------------------------------------------------------- + ! local variables + !--------------------------------------------------------------------------- + character(len=*), parameter :: subname = 'marbl_settings_mod:marbl_settings_set_all_derived' + character(len=char_len) :: log_message + + character(len=char_len) :: sname_in, sname_out + integer :: m, n + + call marbl_status_log%log_header('Setting derived parms', subname) + + select case (caco3_bury_thres_opt) + case ('fixed_depth') + caco3_bury_thres_iopt = caco3_bury_thres_iopt_fixed_depth + case ('omega_calc') + caco3_bury_thres_iopt = caco3_bury_thres_iopt_omega_calc + case default + write(log_message, "(2A)") "unknown caco3_bury_thres_opt: ", trim(caco3_bury_thres_opt) + call marbl_status_log%log_error(log_message, subname) + return + end select + call print_single_derived_parm('caco3_bury_thres_opt', 'caco3_bury_thres_iopt', & + caco3_bury_thres_iopt, subname, marbl_status_log) + + parm_kappa_nitrif = dps * parm_kappa_nitrif_per_day + call print_single_derived_parm('parm_kappa_nitrif_per_day', 'parm_kappa_nitrif', & + parm_kappa_nitrif, subname, marbl_status_log) + + call marbl_status_log%log_noerror('', subname) + + do n = 1, autotroph_cnt + autotrophs(n)%alphaPI = dps * autotrophs(n)%alphaPI_per_day + write(sname_in, "(A,I0,A)") 'autotrophs(', n, ')%alphaPI_per_day' + write(sname_out, "(A,I0,A)") 'autotrophs(', n, ')%alphaPI' + call print_single_derived_parm(sname_in, sname_out, & + autotrophs(n)%alphaPI, subname, marbl_status_log) + + autotrophs(n)%PCref = dps * autotrophs(n)%PCref_per_day + write(sname_in, "(A,I0,A)") 'autotrophs(', n, ')%PCref_per_day' + write(sname_out, "(A,I0,A)") 'autotrophs(', n, ')%PCref' + call print_single_derived_parm(sname_in, sname_out, & + autotrophs(n)%PCref, subname, marbl_status_log) + + autotrophs(n)%mort = dps * autotrophs(n)%mort_per_day + write(sname_in, "(A,I0,A)") 'autotrophs(', n, ')%mort_per_day' + write(sname_out, "(A,I0,A)") 'autotrophs(', n, ')%mort' + call print_single_derived_parm(sname_in, sname_out, & + autotrophs(n)%mort, subname, marbl_status_log) + + autotrophs(n)%mort2 = dps * autotrophs(n)%mort2_per_day + write(sname_in, "(A,I0,A)") 'autotrophs(', n, ')%mort2_per_day' + write(sname_out, "(A,I0,A)") 'autotrophs(', n, ')%mort2' + call print_single_derived_parm(sname_in, sname_out, & + autotrophs(n)%mort2, subname, marbl_status_log) + end do + + call marbl_status_log%log_noerror('', subname) + + do n = 1, zooplankton_cnt + zooplankton(n)%z_mort_0 = dps * zooplankton(n)%z_mort_0_per_day + write(sname_in, "(A,I0,A)") 'zooplankton(', n, ')%z_mort_0_per_day' + write(sname_out, "(A,I0,A)") 'zooplankton(', n, ')%z_mort_0' + call print_single_derived_parm(sname_in, sname_out, & + zooplankton(n)%z_mort_0, subname, marbl_status_log) + + zooplankton(n)%z_mort2_0 = dps * zooplankton(n)%z_mort2_0_per_day + write(sname_in, "(A,I0,A)") 'zooplankton(', n, ')%z_mort2_0_per_day' + write(sname_out, "(A,I0,A)") 'zooplankton(', n, ')%z_mort2_0' + call print_single_derived_parm(sname_in, sname_out, & + zooplankton(n)%z_mort2_0, subname, marbl_status_log) + end do + + call marbl_status_log%log_noerror('', subname) + + do n = 1, zooplankton_cnt + do m = 1, max_grazer_prey_cnt + grazing(m,n)%z_umax_0 = dps * grazing(m,n)%z_umax_0_per_day + write(sname_in, "(A,I0,A,I0,A)") 'grazing(', m, ',', n, ')%z_umax_0_per_day' + write(sname_out, "(A,I0,A,I0,A)") 'grazing(', m, ',', n, ')%z_umax_0' + call print_single_derived_parm(sname_in, sname_out, & + grazing(m,n)%z_umax_0, subname, marbl_status_log) + end do + end do + + end subroutine marbl_settings_set_all_derived + + !***************************************************************************** + + subroutine marbl_settings_string_to_var(value, marbl_status_log, rval, ival, lval, sval) + + character(len=*), intent(in) :: value + type(marbl_log_type), intent(inout) :: marbl_status_log + real(r8), optional, intent(out) :: rval + integer(int_kind), optional, intent(out) :: ival + logical(log_kind), optional, intent(out) :: lval + character(len=*), optional, intent(out) :: sval + + character(len=*), parameter :: subname = 'marbl_settings_mod:marbl_settings_string_to_var' + character(len_trim(value)) :: val_loc + character(len=char_len) :: log_message + integer :: ioerr, last_char + + val_loc = adjustl(trim(value)) + + ! Real value requested? + if (present(rval)) then + read(value, *, iostat=ioerr) rval + if (ioerr .ne. 0) then + write(log_message, "(2A)") trim(value), ' is not a valid real value' + call marbl_status_log%log_error(log_message, subname) + return + end if + end if + + ! Integer value requested? + if (present(ival)) then + read(value, *, iostat=ioerr) ival + if (ioerr .ne. 0) then + write(log_message, "(2A)") trim(value), ' is not a valid integer value' + call marbl_status_log%log_error(log_message, subname) + return + end if + end if + + ! Logical value requested? + if (present(lval)) then + read(value, *, iostat=ioerr) lval + if (ioerr .ne. 0) then + write(log_message, "(2A)") trim(value), ' is not a valid logical value' + call marbl_status_log%log_error(log_message, subname) + return + end if + end if + + ! String value requested? + if (present(sval)) then + ! Error checking: + ! (a) empty string not allowed + ! (b) first character must be ' or " + ! (c) first and last character must match + last_char = len_trim(val_loc) + if (last_char .eq. 0) then + log_message = "Empty string is not acceptable" + call marbl_status_log%log_error(log_message, subname) + return + end if + + if ((val_loc(1:1) .ne. '"') .and. (val_loc(1:1) .ne. "'")) then + write(log_message,"(3A)") "String value must be in quotes ", & + trim(val_loc), " is not acceptable" + call marbl_status_log%log_error(log_message, subname) + return + end if + + if (val_loc(1:1) .ne. val_loc(last_char:last_char)) then + write(log_message,"(3A)") "String value must be in quotes ", & + trim(val_loc), " is not acceptable" + call marbl_status_log%log_error(log_message, subname) + return + end if + sval = val_loc(2:last_char-1) + + end if + + end subroutine marbl_settings_string_to_var + +!***************************************************************************** + + subroutine add_var(this, sname, lname, units, datatype, category, & + marbl_status_log, rptr, iptr, lptr, sptr, & + nondefault_allowed, nondefault_required, comment) + + class(marbl_settings_type), intent(inout) :: this + character(len=*), intent(in) :: sname + character(len=*), intent(in) :: lname + character(len=*), intent(in) :: units + character(len=*), intent(in) :: datatype + character(len=*), intent(in) :: category + type(marbl_log_type), intent(inout) :: marbl_status_log + real(r8), optional, pointer, intent(in) :: rptr + integer, optional, pointer, intent(in) :: iptr + logical, optional, pointer, intent(in) :: lptr + character(len=char_len), optional, pointer, intent(in) :: sptr + logical, optional, intent(in) :: nondefault_allowed + logical, optional, intent(in) :: nondefault_required + character(len=char_len), optional, intent(in) :: comment + + character(len=*), parameter :: subname = 'marbl_settings_mod:add_var' + + type(marbl_single_setting_ll_type), pointer :: new_entry, ll_ptr, ll_prev + character(len=char_len), dimension(:), pointer :: new_categories + integer :: cat_ind, n + character(len=char_len) :: log_message, alternate_sname, tmp_sval + logical :: put_success, datatype_match, nondefault_val + logical :: allow_nondefault, require_nondefault, put_called + + if (present(nondefault_allowed)) then + allow_nondefault = nondefault_allowed + else + allow_nondefault = .true. + end if + + if (present(nondefault_required)) then + require_nondefault = nondefault_required + else + require_nondefault = .false. + end if + + if (require_nondefault .and. (.not. allow_nondefault)) then + write(log_message, "(A)") "Variable ", trim(sname), & + " requires user to set a value but does not allow value to change" + call marbl_status_log%log_error(log_message, subname) + return + end if + + ! 1) Determine category ID + do cat_ind = 1, size(this%categories) + if (trim(category) .eq. trim(this%categories(cat_ind))) then + exit + end if + end do + if (cat_ind .gt. size(this%categories)) then + allocate(new_categories(cat_ind)) + new_categories(1:size(this%categories)) = this%categories + new_categories(cat_ind) = category + deallocate(this%categories) + this%categories => new_categories + end if + + ! 2) Error checking + ll_ptr => this%vars + do while (associated(ll_ptr)) + if (case_insensitive_eq(trim(sname), trim(ll_ptr%short_name))) then + write(log_message, "(A,1X,A)") trim(sname), "has been added twice" + call marbl_status_log%log_error(log_message, subname) + end if + + ! (b) Ensure pointers do not point to same target as other variables + if (present(rptr)) then + if (associated(rptr, ll_ptr%rptr)) then + write(log_message, "(4A)") trim(sname), " and ", trim(ll_ptr%short_name), & + " both point to same variable in memory." + call marbl_status_log%log_error(log_message, subname) + end if + end if + if (present(iptr)) then + if (associated(iptr, ll_ptr%iptr)) then + write(log_message, "(4A)") trim(sname), " and ", trim(ll_ptr%short_name), & + " both point to same variable in memory." + call marbl_status_log%log_error(log_message, subname) + end if + end if + if (present(lptr)) then + if (associated(lptr, ll_ptr%lptr)) then + write(log_message, "(4A)") trim(sname), " and ", trim(ll_ptr%short_name), & + " both point to same variable in memory." + call marbl_status_log%log_error(log_message, subname) + end if + end if + if (present(sptr)) then + if (associated(sptr, ll_ptr%sptr)) then + write(log_message, "(4A)") trim(sname), " and ", trim(ll_ptr%short_name), & + " both point to same variable in memory." + call marbl_status_log%log_error(log_message, subname) + end if + end if + + if (marbl_status_log%labort_marbl) return + ll_prev => ll_ptr + ll_ptr => ll_ptr%next + end do + + ! 3) Create new entry + ! All pointer components of new_entry are nullified in the type definition + ! via => NULL() statements + allocate(new_entry) + select case (trim(datatype)) + case ('real') + if (present(rptr)) then + new_entry%rptr => rptr + else + write(log_message, "(A)") & + "Defining real parameter but rptr not present!" + call marbl_status_log%log_error(log_message, subname) + return + end if + case ('integer') + if (present(iptr)) then + new_entry%iptr => iptr + else + write(log_message, "(A)") & + "Defining integer parameter but iptr not present!" + call marbl_status_log%log_error(log_message, subname) + return + end if + case ('logical') + if (present(lptr)) then + new_entry%lptr => lptr + else + write(log_message, "(A)") & + "Defining logical parameter but lptr not present!" + call marbl_status_log%log_error(log_message, subname) + return + end if + case ('string') + if (present(sptr)) then + new_entry%sptr => sptr + else + write(log_message, "(A)") & + "Defining string parameter but aptr not present!" + call marbl_status_log%log_error(log_message, subname) + return + end if + case DEFAULT + write(log_message, "(2A)") "Unknown datatype: ", trim(datatype) + call marbl_status_log%log_error(log_message, subname) + return + end select + new_entry%short_name = trim(sname) + new_entry%long_name = trim(lname) + new_entry%units = trim(units) + new_entry%datatype = trim(datatype) + new_entry%category_ind = cat_ind + if (present(comment)) then + new_entry%comment = comment + else + new_entry%comment = '' + end if + + ! 4) Append new entry to list + if (.not.associated(this%vars)) then + this%vars => new_entry + else + ll_prev%next => new_entry + end if + + ! 5) Was there a put_setting() call to change this variable? + nullify(ll_prev) + ll_ptr => this%VarsFromPut + ! If new_entry%short_name = 'varname(1)' then it should match either 'varname(1)' or 'varname' + ! Use alternate_sname to hold potential alternate match + alternate_sname = '' + if (len_trim(new_entry%short_name) .ge. 3) then + if (new_entry%short_name(len_trim(new_entry%short_name)-2:len_trim(new_entry%short_name)) .eq. '(1)') then + alternate_sname = new_entry%short_name(1:len_trim(new_entry%short_name)-3) + end if + end if + put_called = .false. + do while (associated(ll_ptr)) + if (case_insensitive_eq(ll_ptr%short_name, new_entry%short_name) .or. & + case_insensitive_eq(ll_ptr%short_name, alternate_sname)) then + put_called = .true. + ! 5a) Look to see if put_setting used the inputline interface + if (trim(ll_ptr%datatype) .eq. "unknown") then + select case (new_entry%datatype) + case ("real") + allocate(ll_ptr%rptr) + call marbl_settings_string_to_var(ll_ptr%sptr, marbl_status_log, rval = ll_ptr%rptr) + case ("integer") + allocate(ll_ptr%iptr) + call marbl_settings_string_to_var(ll_ptr%sptr, marbl_status_log, ival = ll_ptr%iptr) + case ("string") + call marbl_settings_string_to_var(ll_ptr%sptr, marbl_status_log, sval = tmp_sval) + ll_ptr%sptr = tmp_sval + case ("logical") + allocate(ll_ptr%lptr) + call marbl_settings_string_to_var(ll_ptr%sptr, marbl_status_log, lval = ll_ptr%lptr) + end select + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace('marbl_settings_string_to_var', subname) + return + end if + ll_ptr%datatype = new_entry%datatype + end if + ! 5b) Look to see if an integer value was explicitly put for a real variable + if (associated(ll_ptr%iptr).and.associated(new_entry%rptr)) then + allocate(ll_ptr%rptr) + ll_ptr%rptr = real(ll_ptr%iptr,r8) + end if + ! 5c) Actually update the new entry in the linked list + nondefault_val = .false. + ! Allow update if the datatypes match and either the values are the same + ! or a non-default value is allowed + select case (new_entry%datatype) + case ("real") + datatype_match = associated(ll_ptr%rptr) + if (datatype_match) & + nondefault_val = .not. (ll_ptr%rptr .eq. new_entry%rptr) + put_success = (datatype_match .and. (allow_nondefault .or. (.not. nondefault_val))) + if (put_success) new_entry%rptr = ll_ptr%rptr + case ("integer") + datatype_match = associated(ll_ptr%iptr) + if (datatype_match) & + nondefault_val = .not. (ll_ptr%iptr .eq. new_entry%iptr) + put_success = (datatype_match .and. (allow_nondefault .or. (.not. nondefault_val))) + if (put_success) new_entry%iptr = ll_ptr%iptr + case ("string") + datatype_match = associated(ll_ptr%sptr) + if (datatype_match) & + nondefault_val = .not. (ll_ptr%sptr .eq. new_entry%sptr) + put_success = (datatype_match .and. (allow_nondefault .or. (.not. nondefault_val))) + if (put_success) new_entry%sptr = ll_ptr%sptr + case ("logical") + datatype_match = associated(ll_ptr%lptr) + if (datatype_match) & + nondefault_val = .not. (ll_ptr%lptr .eqv. new_entry%lptr) + put_success = (datatype_match .and. (allow_nondefault .or. (.not. nondefault_val))) + if (put_success) new_entry%lptr = ll_ptr%lptr + end select + ! Abort if the put() failed + if (.not. put_success) then + write(log_message, "(3A)") "put_setting(", trim(ll_ptr%short_name), ") failed..." + call marbl_status_log%log_error(log_message, subname) + if (.not. datatype_match) then + write(log_message, "(4A)") "...the datatype was incorrect; expecting ", & + trim(new_entry%datatype), " but user provided ", & + trim(ll_ptr%datatype) + call marbl_status_log%log_error(log_message, subname) + end if + if (nondefault_val .and. (.not. allow_nondefault)) then + write(log_message, "(3A)") "... ", trim(ll_ptr%short_name), & + " can not be changed in the current configuration" + call marbl_status_log%log_error(log_message, subname) + end if + return + end if + + ! 5b) Remove entry from VarsFromPut list + ! Different procedure if ll_ptr is first entry in list + if (associated(ll_ptr,this%VarsFromPut)) then + this%VarsFromPut => ll_ptr%next + deallocate(ll_ptr) + ll_ptr => this%VarsFromPut + else + ll_prev%next => ll_ptr%next + deallocate(ll_ptr) + ll_ptr => ll_prev%next + end if + else + ! 5c) Once we are past first entry, ll_prev%next => ll_ptr + ll_prev => ll_ptr + ll_ptr => ll_ptr%next + end if + end do + ! 5d) Error checking: was put_setting() called if variable requires it? + if (require_nondefault .and. (.not. put_called)) then + write(log_message, "(3A)") "User must provide value for ", trim(sname), " via put_setting()" + call marbl_status_log%log_error(log_message, subname) + return + end if + + ! 6) Increment count + this%cnt = this%cnt + 1 + + end subroutine add_var + + !***************************************************************************** + + subroutine add_var_1d_r8(this, sname, lname, units, category, r8array, & + marbl_status_log, nondefault_allowed, nondefault_required) + + class(marbl_settings_type), intent(inout) :: this + character(len=char_len), intent(in) :: sname + character(len=char_len), intent(in) :: lname + character(len=char_len), intent(in) :: units + character(len=char_len), intent(in) :: category + real(kind=r8), dimension(:), target, intent(in) :: r8array + type(marbl_log_type), intent(inout) :: marbl_status_log + logical, optional, intent(in) :: nondefault_allowed + logical, optional, intent(in) :: nondefault_required + + character(len=*), parameter :: subname = 'marbl_settings_mod:add_var_1d_r8' + + character(len=char_len) :: sname_loc + real(r8), pointer :: rptr => NULL() + integer :: n + logical :: labort_marbl_loc + + labort_marbl_loc = .false. + do n=1,size(r8array) + write(sname_loc, "(2A,I0,A)") trim(sname), '(', n, ')' + rptr => r8array(n) + call this%add_var(sname_loc, lname, units, 'real', category, marbl_status_log, & + rptr=rptr, nondefault_allowed=nondefault_allowed, & + nondefault_required=nondefault_required) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + end do + + marbl_status_log%labort_marbl = labort_marbl_loc + if (marbl_status_log%labort_marbl) return + + end subroutine add_var_1d_r8 + + !***************************************************************************** + + subroutine add_var_1d_int(this, sname, lname, units, category, intarray, & + marbl_status_log, nondefault_allowed, nondefault_required) + + class(marbl_settings_type), intent(inout) :: this + character(len=char_len), intent(in) :: sname + character(len=char_len), intent(in) :: lname + character(len=char_len), intent(in) :: units + character(len=char_len), intent(in) :: category + integer, dimension(:), target, intent(in) :: intarray + type(marbl_log_type), intent(inout) :: marbl_status_log + logical, optional, intent(in) :: nondefault_allowed + logical, optional, intent(in) :: nondefault_required + + character(len=*), parameter :: subname = 'marbl_settings_mod:add_var_1d_int' + + character(len=char_len) :: sname_loc + integer, pointer :: iptr => NULL() + integer :: n + logical :: labort_marbl_loc + + labort_marbl_loc = .false. + do n=1,size(intarray) + write(sname_loc, "(2A,I0,A)") trim(sname), '(', n, ')' + iptr => intarray(n) + call this%add_var(sname_loc, lname, units, 'integer', category, marbl_status_log, & + iptr=iptr, nondefault_allowed=nondefault_allowed, & + nondefault_required=nondefault_required) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + end do + + marbl_status_log%labort_marbl = labort_marbl_loc + if (marbl_status_log%labort_marbl) return + + end subroutine add_var_1d_int + + !***************************************************************************** + + subroutine add_var_1d_str(this, sname, lname, units, category, strarray, & + marbl_status_log, nondefault_allowed, nondefault_required) + + class(marbl_settings_type), intent(inout) :: this + character(len=char_len), intent(in) :: sname + character(len=char_len), intent(in) :: lname + character(len=char_len), intent(in) :: units + character(len=char_len), intent(in) :: category + character(len=char_len), target, intent(in) :: strarray(:) + type(marbl_log_type), intent(inout) :: marbl_status_log + logical, optional, intent(in) :: nondefault_allowed + logical, optional, intent(in) :: nondefault_required + + character(len=*), parameter :: subname = 'marbl_settings_mod:add_var_1d_str' + + character(len=char_len) :: sname_loc + character(len=char_len), pointer :: sptr => NULL() + integer :: n + logical :: labort_marbl_loc + + labort_marbl_loc = .false. + do n=1,size(strarray) + write(sname_loc, "(2A,I0,A)") trim(sname), '(', n, ')' + sptr => strarray(n) + call this%add_var(sname_loc, lname, units, 'string', category, marbl_status_log, & + sptr=sptr, nondefault_allowed=nondefault_allowed, & + nondefault_required=nondefault_required) + call check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + end do + + marbl_status_log%labort_marbl = labort_marbl_loc + if (marbl_status_log%labort_marbl) return + + end subroutine add_var_1d_str + + !***************************************************************************** + + subroutine finalize_vars(this, marbl_status_log) + + class(marbl_settings_type), intent(inout) :: this + type(marbl_log_type), intent(inout) :: marbl_status_log + + character(len=*), parameter :: subname = 'marbl_settings_mod:finalize_vars' + character(len=char_len) :: log_message + + character(len=7) :: logic + integer :: i, cat_ind + type(marbl_single_setting_ll_type), pointer :: ll_ptr + + ! (1) Lock data type (put calls will now cause MARBL to abort) + this%init_called = .true. + + ! (2) Abort if anything is left in this%VarsFromPut + if (associated(this%VarsFromPut)) then + ll_ptr => this%VarsFromPut + do while (associated(ll_ptr)) + write(log_message, "(2A)") "Unrecognized varname from put_setting(): ", & + trim(ll_ptr%short_name) + call marbl_status_log%log_error(log_message, subname) + ll_ptr => ll_ptr%next + end do + return + end if + + call marbl_status_log%log_header("Tunable Parameters", subname) + + do cat_ind = 1,size(this%categories) + ll_ptr => this%vars + do while (associated(ll_ptr)) + if (ll_ptr%category_ind .eq. cat_ind) then + ! (3) write parameter to log_message (format depends on datatype) + select case(trim(ll_ptr%datatype)) + case ('string') + write(log_message, "(4A)") trim(ll_ptr%short_name), " = '", & + trim(ll_ptr%sptr), "'" + case ('real') + write(log_message, "(2A,E24.16)") trim(ll_ptr%short_name), & + " = ", ll_ptr%rptr + case ('integer') + write(log_message, "(2A,I0)") trim(ll_ptr%short_name), " = ", & + ll_ptr%iptr + case ('logical') + if (ll_ptr%lptr) then + logic = '.true.' + else + logic = '.false.' + end if + write(log_message, "(3A)") trim(ll_ptr%short_name), " = ", & + trim(logic) + case DEFAULT + write(log_message, "(2A)") trim(ll_ptr%datatype), & + ' is not a valid datatype for parameter' + call marbl_status_log%log_error(log_message, subname) + return + end select + + ! (4) Write log_message to the log + if (ll_ptr%comment.ne.'') then + if (len_trim(log_message) + 3 + len_trim(ll_ptr%comment) .le. len(log_message)) then + write(log_message, "(3A)") trim(log_message), ' ! ', & + trim(ll_ptr%comment) + else + call marbl_status_log%log_noerror(& + '! WARNING: omitting comment on line below because including it exceeds max length for log message', & + subname) + end if + endif + call marbl_status_log%log_noerror(log_message, subname) + end if + ll_ptr => ll_ptr%next + end do ! ll_ptr + if (cat_ind .ne. size(this%categories)) then + call marbl_status_log%log_noerror('', subname) + end if + end do ! cat_ind + + ! (5) Set up array of pointers + if (allocated(this%varArray)) then + write(log_message, "(A)") "Already allocated memory for varArray!" + call marbl_status_log%log_error(log_message, subname) + return + end if + allocate(this%varArray(this%cnt)) + ll_ptr => this%vars + do i = 1,this%cnt + this%varArray(i)%ptr => ll_ptr + ll_ptr => ll_ptr%next + end do + + end subroutine finalize_vars + + !***************************************************************************** + + subroutine put(this, var, marbl_status_log, rval, ival, lval, sval, uval) + + class(marbl_settings_type), intent(inout) :: this + character(len=*), intent(in) :: var + type(marbl_log_type), intent(inout) :: marbl_status_log + real(r8), optional, intent(in) :: rval + integer, optional, intent(in) :: ival + logical, optional, intent(in) :: lval + character(len=*), optional, intent(in) :: sval + character(len=*), optional, intent(in) :: uval + + type(marbl_single_setting_ll_type), pointer :: new_entry, ll_ptr + character(len=*), parameter :: subname = 'marbl_settings_mod:put' + character(len=char_len) :: log_message + + call marbl_status_log%construct() + if (this%init_called) then + write(log_message, "(3A)") "Can not put ", trim(adjustl(var)), ", init has already been called" + call marbl_status_log%log_error(log_message, subname) + return + end if + + allocate(new_entry) + new_entry%short_name = adjustl(var) + + if (present(rval)) then + allocate(new_entry%rptr) + new_entry%rptr = rval + new_entry%datatype = 'real' + end if + if (present(ival)) then + allocate(new_entry%iptr) + new_entry%iptr = ival + new_entry%datatype = 'integer' + end if + if (present(lval)) then + allocate(new_entry%lptr) + new_entry%lptr = lval + new_entry%datatype = 'logical' + end if + if (present(sval)) then + allocate(new_entry%sptr) + new_entry%sptr = sval + new_entry%datatype = 'string' + end if + if (present(uval)) then + allocate(new_entry%sptr) + new_entry%sptr = uval + new_entry%datatype = 'unknown' + end if + + if (.not.associated(this%VarsFromPut)) then + this%VarsFromPut => new_entry + else + this%LastVarFromPut%next => new_entry + end if + this%LastVarFromPut => new_entry + + end subroutine put + + !***************************************************************************** + + subroutine get(this, var, marbl_status_log, rval, ival, lval, sval) + + class(marbl_settings_type), intent(in) :: this + character(len=*), intent(in) :: var + real(r8), optional, intent(out) :: rval + integer, optional, intent(out) :: ival + logical, optional, intent(out) :: lval + character(len=*), optional, intent(out) :: sval + type(marbl_log_type), intent(inout) :: marbl_status_log + + character(len=*), parameter :: subname = 'marbl_settings_mod%get' + character(len=char_len) :: log_message + + type(marbl_single_setting_ll_type), pointer :: ll_ptr + integer :: cnt + + call marbl_status_log%construct() + cnt = 0 + if (present(rval)) cnt = cnt + 1 + if (present(ival)) cnt = cnt + 1 + if (present(lval)) cnt = cnt + 1 + if (present(sval)) cnt = cnt + 1 + + if (cnt.gt.1) then + write(log_message, "(A)") 'Must provide just one of rval, ival, lval, or sval to get()' + call marbl_status_log%log_error(log_message, subname) + return + end if + + ll_ptr => this%vars + do while (associated(ll_ptr)) + if (case_insensitive_eq((ll_ptr%short_name), trim(var))) exit + ll_ptr => ll_ptr%next + end do + if (.not.associated(ll_ptr)) then + write(log_message, "(2A)") trim(var), 'not found!' + call marbl_status_log%log_error(log_message, subname) + return + end if + + select case(trim(ll_ptr%datatype)) + case ('real') + if (present(rval)) then + rval = ll_ptr%rptr + else + write(log_message, "(2A)") trim(var), ' requires real value' + call marbl_status_log%log_error(log_message, subname) + end if + case ('integer') + if (present(ival)) then + ival = ll_ptr%iptr + else + write(log_message, "(2A)") trim(var), ' requires integer value' + call marbl_status_log%log_error(log_message, subname) + end if + case ('logical') + if (present(lval)) then + lval = ll_ptr%lptr + else + write(log_message, "(2A)") trim(var), ' requires logical value' + call marbl_status_log%log_error(log_message, subname) + end if + case ('string') + if (present(sval)) then + if (len(sval).lt.len(trim(ll_ptr%sptr))) then + write(log_message, "(2A,I0,A,I0,A)") trim(var), ' requires ', & + len(trim(ll_ptr%sptr)), ' bytes to store, but only ', & + len(sval), ' are provided.' + call marbl_status_log%log_error(log_message, subname) + return + end if + sval = trim(ll_ptr%sptr) + else + write(log_message, "(2A)") trim(var), ' requires string value' + call marbl_status_log%log_error(log_message, subname) + end if + end select + + end subroutine get + + !***************************************************************************** + + subroutine destruct(this) + + class(marbl_settings_type), intent(inout) :: this + + type(marbl_single_setting_ll_type), pointer :: ll_next + + ! Empty vars linked list + do while (associated(this%vars)) + ll_next => this%vars%next + deallocate(this%vars) + this%vars => ll_next + end do + + ! Empty VarsFromPut linked list (should already be empty) + do while (associated(this%VarsFromPut)) + ll_next => this%VarsFromPut + deallocate(this%VarsFromPut) + this%VarsFromPut => ll_next + end do + + ! Nullify LastVarFromPut + nullify(this%LastVarFromPut) + + ! Deallocate varArray + if (allocated(this%varArray)) deallocate(this%varArray) + this%cnt=0 + this%init_called = .false. + + end subroutine destruct + + !***************************************************************************** + + function get_cnt(this) result(cnt) + class(marbl_settings_type), intent(in) :: this + integer(int_kind) :: cnt + + cnt = this%cnt + + end function get_cnt + + !***************************************************************************** + + function inquire_id(this, var, marbl_status_log) result(id) + + class(marbl_settings_type), intent(in) :: this + character(len=*), intent(in) :: var + type(marbl_log_type), intent(inout) :: marbl_status_log + integer(int_kind) :: id + + character(len=*), parameter :: subname = 'marbl_settings_mod:inquire_id' + character(len=char_len) :: log_message + integer(int_kind) :: n + + id = -1 + do n=1,this%cnt + if (case_insensitive_eq(trim(var), trim(this%varArray(n)%ptr%short_name))) then + id = n + return + end if + end do + + write(log_message, "(2A)") "No match for variable named ", trim(var) + call marbl_status_log%log_error(log_message, subname) + + end function inquire_id + + !***************************************************************************** + + subroutine inquire_metadata(this, id, marbl_status_log, sname, lname, units, & + datatype) + + class(marbl_settings_type), intent(in) :: this + integer(int_kind), intent(in) :: id + type(marbl_log_type), intent(inout) :: marbl_status_log + character(len=*), optional, intent(out) :: sname, lname, units + character(len=*), optional, intent(out) :: datatype + + character(len=*), parameter :: subname = 'marbl_settings_mod:inquire_metadata' + character(len=char_len) :: log_message + + if (present(sname)) then + sname = this%varArray(id)%ptr%short_name + end if + + if (present(lname)) then + lname = this%varArray(id)%ptr%long_name + end if + + if (present(units)) then + units = this%varArray(id)%ptr%units + end if + + if (present(datatype)) then + datatype = this%varArray(id)%ptr%datatype + end if + + end subroutine inquire_metadata + + !*********************************************************************** + + subroutine check_and_log_add_var_error(marbl_status_log, sname, subname, labort_marbl_loc) + + type(marbl_log_type), intent(inout) :: marbl_status_log + character(len=*), intent(in) :: sname + character(len=*), intent(in) :: subname + logical, intent(inout) :: labort_marbl_loc + character(len=char_len) :: routine_name + + if (marbl_status_log%labort_marbl) then + labort_marbl_loc = marbl_status_log%labort_marbl + write(routine_name,"(3A)") "this%add_var(", trim(sname), ")" + call marbl_status_log%log_error_trace(routine_name, subname) + marbl_status_log%labort_marbl = .false. + end if + + end subroutine check_and_log_add_var_error + + !*********************************************************************** + + function case_insensitive_eq(str1, str2) result(same_str) + + ! This routine is necessary to allow put statements to use different case + ! than the add_var() routine. For example, MARBL calls add_var with the + ! string 'parm_Fe_bioavail' but it's okay for the GCM to call put with the + ! string 'parm_fe_bioavail' + + character(len=*), intent(in) :: str1, str2 + logical :: same_str + + integer :: int_char(2) + integer :: i, j + + ! Assume strings are not the same + same_str = .false. + + ! If strings are not the same length, they can't be equal! + if (len_trim(str1).ne.len_trim(str2)) then + return + end if + + + do i=1,len_trim(str1) + ! character by character compare, convert letters to lower-case + int_char(1) = iachar(str1(i:i)) + int_char(2) = iachar(str2(i:i)) + do j=1,2 + if ((int_char(j) .ge. iachar('A')) .and. (int_char(j) .le. iachar('Z'))) & + int_char(j) = int_char(j) + iachar('a') - iachar('A') + end do + ! return if characters are not the same + if (int_char(1).ne.int_char(2)) return + end do + + ! If test made it this far, strings match + same_str = .true. + + end function case_insensitive_eq + + !***************************************************************************** + + subroutine print_single_derived_parm_r8(sname_in, sname_out, val_out, subname, marbl_status_log) + + character(len=*), intent(in) :: sname_in + character(len=*), intent(in) :: sname_out + real(r8), intent(in) :: val_out + character(len=*), intent(in) :: subname + type(marbl_log_type), intent(inout) :: marbl_status_log + + !--------------------------------------------------------------------------- + ! local variables + !--------------------------------------------------------------------------- + character(len=char_len) :: log_message + + write(log_message, "(2A,E24.16,3A)") & + trim(sname_out), ' = ', val_out, ' (value computed from ', trim(sname_in), ')' + call marbl_status_log%log_noerror(log_message, subname) + + end subroutine print_single_derived_parm_r8 + + !***************************************************************************** + + subroutine print_single_derived_parm_int(sname_in, sname_out, val_out, subname, marbl_status_log) + + character(len=*), intent(in) :: sname_in + character(len=*), intent(in) :: sname_out + integer(int_kind), intent(in) :: val_out + character(len=*), intent(in) :: subname + type(marbl_log_type), intent(inout) :: marbl_status_log + + !--------------------------------------------------------------------------- + ! local variables + !--------------------------------------------------------------------------- + character(len=char_len) :: log_message + + write(log_message, "(2A,I0,3A)") & + trim(sname_out), ' = ', val_out, ' (value computed from ', trim(sname_in), ')' + call marbl_status_log%log_noerror(log_message, subname) + + end subroutine print_single_derived_parm_int + + !***************************************************************************** + +end module marbl_settings_mod diff --git a/src/marbl_sizes.F90 b/src/marbl_sizes.F90 deleted file mode 100644 index d015ec3a..00000000 --- a/src/marbl_sizes.F90 +++ /dev/null @@ -1,36 +0,0 @@ -module marbl_sizes - - use marbl_kinds_mod, only : int_kind - - implicit none - - public - - !----------------------------------------------------------------------------- - ! number of ecosystem tracers - !----------------------------------------------------------------------------- - - integer(int_kind), parameter :: ecosys_base_tracer_cnt = ECOSYS_BASE_NT - integer(int_kind), parameter :: ciso_tracer_cnt = 14 - integer(int_kind) :: marbl_total_tracer_cnt = 0 - integer(int_kind) :: tracer_restore_cnt = 0 - - - !----------------------------------------------------------------------------- - ! number of ecosystem constituents and grazing interactions - !----------------------------------------------------------------------------- - - integer (KIND=int_kind), parameter :: zooplankton_cnt = ZOOPLANKTON_CNT - integer (KIND=int_kind), parameter :: autotroph_cnt = AUTOTROPH_CNT - integer (KIND=int_kind), parameter :: grazer_prey_cnt = GRAZER_PREY_CNT - - integer (KIND=int_kind), parameter :: max_prey_class_size = 9 - - !----------------------------------------------------------------------------- - ! number of forcing fields - !----------------------------------------------------------------------------- - - integer :: num_surface_forcing_fields - integer :: num_interior_forcing_fields - -end module marbl_sizes diff --git a/src/marbl_timing_mod.F90 b/src/marbl_timing_mod.F90 index d673e98c..01d0a13c 100644 --- a/src/marbl_timing_mod.F90 +++ b/src/marbl_timing_mod.F90 @@ -126,6 +126,7 @@ subroutine add_new_timer(self, name, id, marbl_status_log) allocate(self%individual_timers(self%num_timers+1)) self%individual_timers(1:self%num_timers) = tmp + deallocate(tmp) self%num_timers = self%num_timers + 1 id = self%num_timers associate(new_timer => self%individual_timers(id)) @@ -218,7 +219,7 @@ end subroutine stop_timer subroutine extract_timer_data(self, interface_timers, marbl_status_log) - use marbl_interface_types, only : marbl_timers_type + use marbl_interface_public_types, only : marbl_timers_type class(marbl_internal_timers_type), intent(in) :: self type(marbl_timers_type), intent(inout) :: interface_timers @@ -328,7 +329,7 @@ end subroutine reset_timers subroutine shutdown_timers(self, timer_ids, interface_timers, marbl_status_log) - use marbl_interface_types, only : marbl_timers_type + use marbl_interface_public_types, only : marbl_timers_type class(marbl_internal_timers_type), intent(inout) :: self type(marbl_timer_indexing_type), intent(inout) :: timer_ids diff --git a/src/marbl_utils_mod.F90 b/src/marbl_utils_mod.F90 new file mode 100644 index 00000000..08f11cce --- /dev/null +++ b/src/marbl_utils_mod.F90 @@ -0,0 +1,144 @@ +module marbl_utils_mod + + use marbl_kinds_mod, only : r8 + + use marbl_logging, only : marbl_log_type + + implicit none + public + +contains + + !*********************************************************************** + + function marbl_utils_linear_root(x,y, marbl_status_log) result(linear_root) + ! Given two points (x(1), y(1)) and (x(2), y(2)), find the root + ! between x(1) and x(2), or return an error if root doesn't exist + ! + ! TO-DOs: + ! (1) this can be generalized to a better root-finding routine + ! (2) provide a flag to allow a root that is not between x(1) and x(2) + ! (would only return error if y(1) = y(2) != 0) + + use marbl_constants_mod, only : c0 + + real(kind=r8), dimension(2), intent(in) :: x,y + type(marbl_log_type), intent(inout) :: marbl_status_log + real(kind=r8) :: linear_root + + character(len=*), parameter :: subname = 'marbl_utils_mod:linear_root' + + real(kind=r8) :: m_inv + + if ((y(1).gt.c0).and.(y(2).gt.c0)) then + call marbl_status_log%log_error("can not find root, both y-values are positive!", subname) + return + else if ((y(1).lt.c0).and.(y(2).lt.c0)) then + call marbl_status_log%log_error("can not find root, both y-values are negative!", subname) + return + end if + + if (y(2).eq.c0) then + linear_root = x(2) + else + m_inv = (x(2)-x(1))/(y(2)-y(1)) + linear_root = x(1)-m_inv*y(1) + end if + + end function marbl_utils_linear_root + + !*********************************************************************** + + subroutine marbl_utils_str_to_substrs(str, separator, substrs) + ! Given a string and a separator character, break the string into substrings + ! everywhere the separator appears (unless separator occurs between delimiters + ! defined in ignore_substr_delims) + + character(len=*), intent(in) :: str + character, intent(in) :: separator + character(len=*), allocatable, dimension(:), intent(out) :: substrs + + character, dimension(2), parameter :: ignore_substr_delims = (/'"', "'"/) + + character(len=len(substrs)), allocatable, dimension(:) :: substrs_loc + character(len=len_trim(str)) :: substr + character :: delim_char + integer :: char_ind, cur_pos, cur_size + logical :: linit_new_substr, linside_delim, lseparator_outside_delims + + ! Initialize some local variables and intent(out) + linit_new_substr = .true. + linside_delim = .false. + if (len_trim(str) .eq. 0) then + allocate(substrs(1)) + substrs(1) = '' + return + end if + allocate(substrs(0)) + + ! Look for separator character, but not between any matched pair of ignore_substr_delims characters + do char_ind = 1, len_trim(str) + ! (1) Is str(char_ind:char_ind) the first character in a new substring? + ! If so, empty substr and set cur_pos = 1 + if (linit_new_substr) then + substr = '' + cur_pos = 1 + linit_new_substr = .false. + end if + + ! (2) Does current character change whether or not we are between ignore_substr_delims characters? + if (.not. linside_delim) then + ! Set linside_delim = true (and set delim_char) if we encounter ANY acceptable delimiters + if (any(str(char_ind:char_ind) .eq. ignore_substr_delims)) then + linside_delim = .true. + delim_char = str(char_ind:char_ind) + end if + else ! linside_delim = .true. + ! If we encounter the delimiter that started substring a second time, + ! then we have exited the substring + if (str(char_ind:char_ind) .eq. delim_char) linside_delim = .false. + end if + + ! Is the current character a separator outside delimiters? + lseparator_outside_delims = ((.not. linside_delim) .and. (str(char_ind:char_ind) .eq. separator)) + + ! (3) Append str(char_ind:char_ind) to substr unless character is a separator + ! outside of delimiters + if (.not. lseparator_outside_delims) then + ! append current character of str to substr + substr(cur_pos:cur_pos) = str(char_ind:char_ind) + cur_pos = cur_pos + 1 + end if + + ! (4) Grow substrs(:) by one element and set new element to substr if + ! str(char_ind:char_ind) is the last character of a substr; + ! either a separator outside delimiters or the last character of str + if ( lseparator_outside_delims .or. (char_ind .eq. len_trim(str))) then + ! (4a) extend substrs by one element + cur_size = size(substrs) + if (cur_size .eq. 0) then + ! end of first substr => allocate substrs(1) + deallocate(substrs) + allocate(substrs(1)) + else + ! substrs already contains some substrings, so copy to substrs_loc + ! before deallocating and allocating more memory + allocate(substrs_loc(cur_size)) + substrs_loc = substrs + deallocate(substrs) + allocate(substrs(cur_size+1)) + substrs(1:cur_size) = substrs_loc + deallocate(substrs_loc) + end if + ! (4b) store substr as newest element of substrs + substrs(cur_size+1) = trim(substr) + ! (4c) next character will be first in the next element + linit_new_substr = .true. + end if + end do + + end subroutine marbl_utils_str_to_substrs + + !*********************************************************************** + +end module marbl_utils_mod diff --git a/tests/bld_tests/bld_exe.py b/tests/bld_tests/bld_exe.py index ed491a46..799fe905 100755 --- a/tests/bld_tests/bld_exe.py +++ b/tests/bld_tests/bld_exe.py @@ -7,7 +7,7 @@ from general import pause mt = MARBL_testcase() -mt.parse_args(desc='Build marbl.exe with every supported compiler on specified machine', HaveCompiler=False, HaveNamelist=False) +mt.parse_args(desc='Build marbl.exe with every supported compiler on specified machine', HaveCompiler=False, HaveInputFile=False) for i,compiler in enumerate(mt.supported_compilers): mt.build_exe(loc_compiler=compiler) diff --git a/tests/bld_tests/bld_lib.py b/tests/bld_tests/bld_lib.py index c6bf162e..a31cf259 100755 --- a/tests/bld_tests/bld_lib.py +++ b/tests/bld_tests/bld_lib.py @@ -7,7 +7,7 @@ from general import pause mt = MARBL_testcase() -mt.parse_args(desc='Build lib-marbl.a with every supported compiler on specified machine', HaveCompiler=False, HaveNamelist=False, CleanLibOnly=True) +mt.parse_args(desc='Build lib-marbl.a with every supported compiler on specified machine', HaveCompiler=False, HaveInputFile=False, CleanLibOnly=True) for i,compiler in enumerate(mt.supported_compilers): mt.build_lib(loc_compiler=compiler) diff --git a/tests/driver_src/Makefile b/tests/driver_src/Makefile index 664ee281..be3c9e45 100644 --- a/tests/driver_src/Makefile +++ b/tests/driver_src/Makefile @@ -88,7 +88,7 @@ else LFLAG = -lmarbl-$(COMP_NAME) endif -LIBCPPDEFS=-DECOSYS_BASE_NT=32 -DZOOPLANKTON_CNT=1 -DAUTOTROPH_CNT=3 -DGRAZER_PREY_CNT=3 +LIBCPPDEFS= EXECPPDEFS= INCLUDES=-I$(INC_LOC) LINKS=-L$(LIB_DIR) $(LFLAG) @@ -107,10 +107,10 @@ endif COMP_ARGS = OBJ_DIR=$(OBJ_LOC) LIB_DIR=$(LIB_DIR) INC_DIR=$(INC_LOC) CPPDEFS="$(LIBCPPDEFS)" -OBJS = marbl_init_namelist_drv.o \ - marbl_init_no_namelist_drv.o \ - marbl_get_put_drv.o \ - marbl_mpi_mod.o \ +OBJS = marbl_mpi_mod.o \ + marbl_init_drv.o \ + marbl_get_put_drv.o \ + marbl_utils_drv.o \ marbl.o MODS = marbl_mpi_mod.mod @@ -119,7 +119,6 @@ MODS = marbl_mpi_mod.mod # TARGETS # ########### -.PHONY: intel pgi gnu nag cray clean clean_exe # default is to build with gnu .PHONY: all all: gnu @@ -138,7 +137,7 @@ pgi: .PHONY: nag nag: - $(MAKE) -f $(MAKE_DIR)/Makefile $(EXE) COMP_NAME=nag$(MPISUF) FC=nagfor FCFLAGS="-O2 -free -kind=byte" INC="-mdir $(OBJ_ROOT)/nag$(MPISUF) -I$(OBJ_ROOT)/nag$(MPISUF)" INC2="-mdir $(OBJ_ROOT)/nag$(MPISUF)/driver -I$(OBJ_ROOT)/nag$(MPISUF)/driver" + $(MAKE) -f $(MAKE_DIR)/Makefile $(EXE) COMP_NAME=nag$(MPISUF) FC=nagfor FCFLAGS="-O2 -free -kind=byte -wmismatch=mpi_bcast" INC="-mdir $(OBJ_ROOT)/nag$(MPISUF) -I$(OBJ_ROOT)/nag$(MPISUF)" INC2="-mdir $(OBJ_ROOT)/nag$(MPISUF)/driver -I$(OBJ_ROOT)/nag$(MPISUF)/driver" .PHONY: cray cray: @@ -149,7 +148,7 @@ $(LIB_DIR)/%.a: $(LIB_SRC_DIR)/*.F90 make -f $(LIB_SRC_DIR)/Makefile FC=$(FC) FCFLAGS="$(FCFLAGS) $(INC)" USE_DEPS=TRUE $(COMP_ARGS) $@ # Driver object files -$(OBJ_DIR)/%.o: $(EXE_SRC_DIR)/%.F90 +$(OBJ_DIR)/%.o: $(EXE_SRC_DIR)/%.F90 $(LIB_DIR)/$(LIB_NAME) $(FC) $(EXECPPDEFS) $(FCFLAGS) $(INC2) $(INCLUDES) -c $< -o $@ # Executable diff --git a/tests/driver_src/marbl.F90 b/tests/driver_src/marbl.F90 index 955eddb9..1f111ee4 100644 --- a/tests/driver_src/marbl.F90 +++ b/tests/driver_src/marbl.F90 @@ -29,15 +29,14 @@ Program marbl ! ***************************************************************************** ! Use from libmarbl.a - use marbl_interface, only : marbl_interface_class - use marbl_logging, only : marbl_log_type - use marbl_namelist_mod, only : marbl_nl_split_string - use marbl_namelist_mod, only : marbl_namelist + use marbl_interface, only : marbl_interface_class + use marbl_logging, only : marbl_log_type + use marbl_kinds_mod, only : r8 ! Driver modules for individual tests - use marbl_init_namelist_drv, only : marbl_init_namelist_test => test - use marbl_init_no_namelist_drv, only : marbl_init_no_namelist_test => test - use marbl_get_put_drv, only : marbl_get_put_test => test + use marbl_init_drv, only : marbl_init_test => test + use marbl_get_put_drv, only : marbl_get_put_test => test + use marbl_utils_drv, only : marbl_utils_test => test ! MPI wrappers (will build without MPI as well) use marbl_mpi_mod, only : marbl_mpi_init @@ -52,21 +51,20 @@ Program marbl Implicit None character(len=256), parameter :: subname = 'Program Marbl' - integer, parameter :: nl_buffer_size = 256 - integer, parameter :: nl_cnt = 4 - integer, parameter :: nl_in_size = 1024 type(marbl_interface_class) :: marbl_instance type(marbl_log_type) :: driver_status_log - character(len=nl_buffer_size) :: nl_buffer(nl_cnt) - character(len=nl_buffer_size) :: tmp_nl_buffer - character(len=nl_in_size) :: nl_str, tmp_str - integer :: ioerr=0 integer :: m, n, nt, cnt - character(len=256) :: testname, varname, log_message - logical :: lprint_marbl_log + character(len=256) :: input_line, testname, varname, log_message, log_out_file + logical :: lprint_marbl_log, lhas_inputfile + logical :: ldriver_log_to_file, lsummarize_timers - namelist /marbl_driver_nml/testname + ! Processing input file for put calls + integer :: ioerr + integer :: ival + real(r8) :: rval + + namelist /marbl_driver_nml/testname, lhas_inputfile, log_out_file !**************************************************************************** @@ -75,65 +73,70 @@ Program marbl call marbl_mpi_init() ! Set up local variables - ! * Empty strings used to pass namelist file contents to MARBL - nl_buffer(:) = '' - nl_str = '' ! * Some tests use a different status log than marbl_instance%StatusLog ! (default is to use marbl_instance%StatusLog) lprint_marbl_log = .true. + ldriver_log_to_file = .false. + lsummarize_timers = .true. + call driver_status_log%construct() ! (1) Set marbl_driver_nml defaults - testname = '' - - ! Read namelist - if (my_task.eq.0) then - n = 0 - m = 0 - do while(ioerr.eq.0) - n = n+m+1 - read(*, fmt="(A)", iostat=ioerr) tmp_str - m = len(trim(tmp_str)) - nl_str(n:n+m-1) = trim(tmp_str) - if (ioerr.eq.0) nl_str(n+m:n+m) = achar(10) - end do - if (.not.is_iostat_end(ioerr)) then - write(*,"(A,I0)") "ioerr = ", ioerr - write(*,"(A)") "ERROR encountered when reading MARBL namelist from stdin" - call marbl_mpi_abort() - end if - write(*,"(A,I0,A)") "MARBL namelist file contained ", len_trim(nl_str), & - " characters" - end if - call marbl_mpi_bcast(nl_str, 0) - call marbl_nl_split_string(nl_str, nl_buffer) - - ! (2) Read driver namelist to know what test to run - call driver_status_log%construct() - tmp_nl_buffer = marbl_namelist(nl_buffer, 'marbl_driver_nml', & - driver_status_log) - if (driver_status_log%labort_marbl) then - call print_marbl_log(marbl_instance%StatusLog) - end if + testname = '' + lhas_inputfile = .true. + log_out_file = 'marbl.out' ! only written if ldriver_log_to_file = .true. - read(tmp_nl_buffer, nml=marbl_driver_nml, iostat=ioerr) + ! (2a) Read driver namelist to know what test to run + open(8, file="test.nml", status="old") + read(8, nml=marbl_driver_nml, iostat=ioerr) if (ioerr.ne.0) then write(*,*) "ERROR reading &marbl_driver_nml" call marbl_mpi_abort() end if + close(8) + + ! (2b) Read inputfile + if (lhas_inputfile) then + call read_inputfile(marbl_instance) + end if ! (3) Run proper test if (my_task.eq.0) write(*,"(3A)") "Beginning ", trim(testname), " test..." select case (trim(testname)) - case ('init_from_namelist') - call marbl_init_namelist_test(marbl_instance, nl_buffer) - case ('init_without_namelist') - call marbl_init_no_namelist_test(marbl_instance) + case ('init') + call marbl_init_test(marbl_instance) + case ('init-twice') + call marbl_instance%put_setting('ciso_on = .false.') + call marbl_init_test(marbl_instance) + call summarize_timers(driver_status_log, header_text = 'Without the CISO Tracers') + call marbl_instance%put_setting('ciso_on = .true.') + call marbl_init_test(marbl_instance) + call summarize_timers(driver_status_log, header_text = 'With the CISO Tracers') + lsummarize_timers = .false. + case ('gen_inputfile') + lprint_marbl_log = .false. + ldriver_log_to_file = .true. + call marbl_init_test(marbl_instance, lshutdown=.false.) + if (.not. marbl_instance%StatusLog%labort_marbl) then + do n=1,marbl_instance%get_settings_var_cnt() + call marbl_instance%inquire_settings_metadata(n, sname=varname) + if (marbl_instance%StatusLog%labort_marbl) exit + call marbl_instance%get_setting(varname, input_line, linputfile_format=.true.) + if (marbl_instance%StatusLog%labort_marbl) exit + call driver_status_log%log_noerror(trim(input_line), subname) + end do + call marbl_instance%shutdown() + end if case ('get_put') lprint_marbl_log = .false. call marbl_get_put_test(marbl_instance, driver_status_log) + case ('marbl_utils') + lprint_marbl_log = .false. + lsummarize_timers = .false. + call marbl_utils_test(driver_status_log) case ('request_tracers') lprint_marbl_log = .false. - call marbl_init_namelist_test(marbl_instance, nl_buffer, nt) + call marbl_init_test(marbl_instance, nt = nt, lshutdown = .false.) + ! Log tracers requested for initialization call driver_status_log%log_noerror('', subname) call driver_status_log%log_noerror('Requested tracers', subname) @@ -143,9 +146,10 @@ Program marbl trim(marbl_instance%tracer_metadata(n)%short_name) call driver_status_log%log_noerror(log_message, subname) end do + call marbl_instance%shutdown() case ('request_forcings') lprint_marbl_log = .false. - call marbl_init_namelist_test(marbl_instance, nl_buffer) + call marbl_init_test(marbl_instance, lshutdown=.false.) ! Log requested surface forcing fields call driver_status_log%log_noerror('', subname) @@ -166,9 +170,12 @@ Program marbl trim(marbl_instance%interior_input_forcings(n)%metadata%varname) call driver_status_log%log_noerror(log_message, subname) end do + + call marbl_instance%shutdown() + case ('request_restoring') lprint_marbl_log = .false. - call marbl_init_namelist_test(marbl_instance, nl_buffer, nt) + call marbl_init_test(marbl_instance, nt = nt, lshutdown = .false.) ! Log tracers requested for restoring call driver_status_log%log_noerror('', subname) @@ -187,23 +194,27 @@ Program marbl if (cnt.eq.0) then call driver_status_log%log_noerror('No tracers to restore!', subname) end if + call marbl_instance%shutdown() case DEFAULT write(*,*) "ERROR: testname = ", trim(testname), " is not a valid option" call marbl_mpi_abort() end select ! (4) Print log(s) - ! (4a) If MARBL returns an error, print MARBL log - if (marbl_instance%StatusLog%labort_marbl) & + ! (4a) If MARBL returns an error (or MARBL log was requested), print MARBL log + if (marbl_instance%StatusLog%labort_marbl.or.lprint_marbl_log) & call print_marbl_log(marbl_instance%StatusLog) - ! (4b) If requested, print MARBL log - if (lprint_marbl_log) then - call print_marbl_log(marbl_instance%StatusLog) + ! (4b) If driver log should be written to file, do so + if (ldriver_log_to_file) then + call print_marbl_log(driver_status_log, outfile=log_out_file) end if - ! (5) Print timer results (and any other driver-logged output) - call summarize_timers() + ! (4c) Add timer information to driver log, then print driver log + ! note that if driver log was previously written to a file, + ! timers are all that will be written to screen + if (lsummarize_timers) & + call summarize_timers(driver_status_log) call print_marbl_log(driver_status_log) @@ -215,26 +226,78 @@ Program marbl !**************************************************************************** - subroutine print_marbl_log(log_to_print) + subroutine read_inputfile(marbl_instance) + + type(marbl_interface_class), intent(inout) :: marbl_instance + + character(len=256), parameter :: subname = 'marbl::read_inputfile' + character(len=256) :: input_line + integer :: ioerr + + ioerr = 0 + input_line = '' + do while(ioerr .eq. 0) + ! (i) call put_setting(); abort if error + ! calling with empty input_line on first entry to loop is okay, and + ! this ensures we don't call put_setting with a garbage line if + ! ioerr is non-zero + call marbl_instance%put_setting(input_line) + if (marbl_instance%StatusLog%labort_marbl) then + call marbl_instance%StatusLog%log_error_trace("put_setting(input_line)", subname) + call print_marbl_log(marbl_instance%StatusLog) + end if + ! (ii) master task reads next line in inputfile + if (my_task .eq. 0) read(*,"(A)", iostat=ioerr) input_line + ! (iii) broadcast inputfile line to all tasks (along with iostat) + call marbl_mpi_bcast(input_line, 0) + call marbl_mpi_bcast(ioerr, 0) + end do + + if (.not.is_iostat_end(ioerr)) then + write(*,"(A,I0)") "ioerr = ", ioerr + write(*,"(A)") "ERROR encountered when reading MARBL input file from stdin" + call marbl_mpi_abort() + end if + + end subroutine read_inputfile + + !**************************************************************************** + + subroutine print_marbl_log(log_to_print, outfile) use marbl_logging, only : marbl_status_log_entry_type - class(marbl_log_type), intent(inout) :: log_to_print + class(marbl_log_type), intent(inout) :: log_to_print + character(len=*), optional, intent(in) :: outfile type(marbl_status_log_entry_type), pointer :: tmp + integer :: out_unit + + ! write to stdout unless outfile is provided + out_unit = 6 + if (present(outfile)) then + out_unit = 99 + open(out_unit, file=outfile, action="write", status="replace") + if (my_task .eq. 0) write(6, "(3A)") " Writing log to ", trim(outfile), "..." + end if tmp => log_to_print%FullLog do while (associated(tmp)) if (mpi_on .and. (.not. tmp%lonly_master_writes)) then ! If running in parallel and all tasks are writing to the log, prefix ! the task # to log message - write(*,"(I0,': ',A)") my_task, trim(tmp%LogMessage) + write(out_unit, "(I0,': ',A)") my_task, trim(tmp%LogMessage) elseif (my_task.eq.0) then ! Otherwise only task 0 writes to the log and no prefix is necessary - write(*,"(A)") trim(tmp%LogMessage) + write(out_unit, "(A)") trim(tmp%LogMessage) end if tmp => tmp%next end do + if (present(outfile)) then + close(out_unit) + if (my_task .eq. 0) write(6, "(A)") " ... Done writing to file!" + end if + call log_to_print%erase() if (log_to_print%labort_marbl) call marbl_mpi_abort() @@ -243,17 +306,24 @@ end subroutine print_marbl_log !**************************************************************************** - subroutine summarize_timers() + subroutine summarize_timers(driver_status_log, header_text) use marbl_kinds_mod, only : r8 + type(marbl_log_type), intent(inout) :: driver_status_log + character(len=*), optional, intent(in) :: header_text + real(r8) :: min_runtime, ind_runtime, max_runtime, tot_runtime character(len=15) :: int_to_str 100 format(A, ': ', F11.3, ' seconds',A) associate(timers =>marbl_instance%timer_summary) - call driver_status_log%log_header('Timer summary', subname) + if (present(header_text)) then + call driver_status_log%log_header(header_text, subname) + else + call driver_status_log%log_header('Timer summary', subname) + end if write(log_message, "(A, I0, A)") 'There are ', timers%num_timers, & ' timers being returned' call driver_status_log%log_noerror(log_message, subname) diff --git a/tests/driver_src/marbl_get_put_drv.F90 b/tests/driver_src/marbl_get_put_drv.F90 index 01abf6d0..b9bea9b8 100644 --- a/tests/driver_src/marbl_get_put_drv.F90 +++ b/tests/driver_src/marbl_get_put_drv.F90 @@ -3,11 +3,19 @@ module marbl_get_put_drv use marbl_kinds_mod, only : r8, char_len use marbl_constants_mod, only : c1, p5 use marbl_logging, only : marbl_log_type + use marbl_interface, only : marbl_interface_class Implicit None Private Save + ! List of keywords (from variable names) to ignore in put / get statements + ! (necessary to prevent internal MARBL errors do to inconsistent settings) + character(len=*), dimension(5), parameter :: ignore_in_varnames = (/"_ind ", & + "caco3_bury_thres_opt", & + "tracer_restore_vars ", & + "PFT_defaults ", & + "_cnt "/) integer, parameter :: km = 5 Public :: test @@ -16,16 +24,13 @@ module marbl_get_put_drv !***************************************************************************** - subroutine test(marbl_instance, marbl_status_log) - - use marbl_interface, only : marbl_interface_class - use marbl_config_mod, only : marbl_config_set_defaults - use marbl_parms, only : marbl_parms_set_defaults + subroutine test(marbl_instance, driver_status_log) type(marbl_interface_class), intent(inout) :: marbl_instance - type(marbl_log_type), intent(inout) :: marbl_status_log + type(marbl_log_type), intent(inout) :: driver_status_log character(*), parameter :: subname = 'marbl_get_put_drv:test' + type(marbl_interface_class) :: marbl_instance_loc real(kind=r8), dimension(km) :: delta_z, zw, zt integer :: k @@ -38,32 +43,36 @@ subroutine test(marbl_instance, marbl_status_log) zt(k) = p5*(zw(k-1)+zw(k)) end do - ! Call marbl%config - call marbl_instance%config(lgcm_has_global_ops = .true.) - if (marbl_instance%StatusLog%labort_marbl) then - call marbl_instance%StatusLog%log_error_trace('marbl%config', subname) + ! Set ciso_on = .true. for local instance + call marbl_instance_loc%put_setting('ciso_on', .true.) + if (marbl_instance_loc%StatusLog%labort_marbl) then + call driver_status_log%log_error_trace('marbl_loc%put_setting', subname) return end if - ! Set all config vars to -1 or .true. - call set_all_vals(marbl_instance%configuration, marbl_status_log) - if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('set_all_vals', subname) + ! Call marbl_loc%init + call marbl_instance_loc%init(gcm_num_levels = km, & + gcm_num_PAR_subcols = 1, & + gcm_num_elements_surface_forcing = 1, & + gcm_delta_z = delta_z, & + gcm_zw = zw, & + gcm_zt = zt) + if (marbl_instance_loc%StatusLog%labort_marbl) then + call driver_status_log%log_error_trace('marbl_loc%init', subname) return end if - ! One by one, make sure vars are -1 or .true. and then set to n or .false. - call check_all_vals(marbl_instance%configuration, marbl_status_log) - if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('check_all_vals', subname) + ! Set all marbl_instance config vars / parms to -1 or .true. + call set_all_vals(marbl_instance_loc, marbl_instance, driver_status_log) + if (marbl_instance%StatusLog%labort_marbl) then + call marbl_instance%StatusLog%log_error_trace('set_all_vals', subname) return end if - ! Reset to default values + ciso_on (needed to ensure tracer count consistency) - call marbl_config_set_defaults() - call marbl_instance%configuration%put('ciso_on', .true., marbl_status_log) - if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('configuration%put(ciso_on)', subname) + ! Shutdown marbl_loc + call marbl_instance_loc%shutdown() + if (marbl_instance_loc%StatusLog%labort_marbl) then + call driver_status_log%log_error_trace('marbl%shutdown', subname) return end if @@ -73,33 +82,17 @@ subroutine test(marbl_instance, marbl_status_log) gcm_num_elements_surface_forcing = 1, & gcm_delta_z = delta_z, & gcm_zw = zw, & - gcm_zt = zt) + gcm_zt = zt, & + lgcm_has_global_ops = .true.) if (marbl_instance%StatusLog%labort_marbl) then call marbl_instance%StatusLog%log_error_trace('marbl%init', subname) return end if - ! Set all parameters to -1 or .true. - call set_all_vals(marbl_instance%parameters, marbl_status_log) - if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('set_all_vals', subname) - return - end if - - ! One by one, make sure parms are -1 or .true. and then set to n or .false. - call check_all_vals(marbl_instance%parameters, marbl_status_log) - if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('check_all_vals', subname) - return - end if - - ! Reset to default values + ciso_on (needed to ensure tracer count consistency) - call marbl_parms_set_defaults(km) - - call marbl_instance%complete_config_and_init + ! One by one, make sure vars are -1 or .true. + call check_all_vals(marbl_instance, driver_status_log) if (marbl_instance%StatusLog%labort_marbl) then - call marbl_instance%StatusLog%log_error_trace( & - 'marbl%complete_config_and_init', subname) + call marbl_instance%StatusLog%log_error_trace('check_all_vals', subname) return end if @@ -114,119 +107,137 @@ end subroutine test !***************************************************************************** - subroutine set_all_vals(config_or_parms, marbl_status_log) + subroutine set_all_vals(local_instance, marbl_instance, driver_status_log) - use marbl_config_mod, only : marbl_config_and_parms_type + use marbl_mpi_mod, only : marbl_mpi_abort - type(marbl_config_and_parms_type), intent(inout) :: config_or_parms - type(marbl_log_type), intent(inout) :: marbl_status_log + type(marbl_interface_class), intent(inout) :: local_instance ! inout because inquire_settings_metadata updates StatusLog + type(marbl_interface_class), intent(inout) :: marbl_instance + type(marbl_log_type), intent(inout) :: driver_status_log character(*), parameter :: subname = 'marbl_get_put_drv:set_all_vals' character(len=char_len) :: log_message, sname, datatype - integer :: n + integer :: n, n2 + logical :: var_match - ! Put values into marbl_instance%configuration%vars(n) + ! Put values into marbl_instance%settings%vars(n) ! logicals = .true. ! integers = -1 ! reals = real(-1,r8) ! strings = '-1' log_message = "Setting variables to .true. or -1 ..." - call marbl_status_log%log_noerror(log_message, subname) - do n=1,config_or_parms%cnt - call config_or_parms%inquire_metadata(n, marbl_status_log, & - sname=sname, datatype=datatype) - if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('inquire_metadata', subname) + call driver_status_log%log_noerror(log_message, subname) + + ! configuration variables and parameters + do n=1,local_instance%get_settings_var_cnt() + call local_instance%inquire_settings_metadata(n, sname=sname, datatype=datatype) + if (local_instance%StatusLog%labort_marbl) then + call marbl_instance%StatusLog%log_error_trace('inquire_metadata', subname) return end if + ! Do not change variables listed in ignore_in_varnames + var_match = .false. + do n2=1,size(ignore_in_varnames) + if (index(sname, trim(ignore_in_varnames(n2))).ne.0) var_match = .true. + end do + if (var_match) cycle select case (trim(datatype)) case ('real') - call config_or_parms%put(sname, -1, marbl_status_log) + call marbl_instance%put_setting(sname, -1) case ('integer') - call config_or_parms%put(sname, -1, marbl_status_log) + call marbl_instance%put_setting(sname, -1) case ('string') - call config_or_parms%put(sname, '-1', marbl_status_log) + call marbl_instance%put_setting(sname, '-1') case ('logical') - call config_or_parms%put(sname, .true., marbl_status_log) + call marbl_instance%put_setting(sname, .true.) end select + if (marbl_instance%StatusLog%labort_marbl) then + call marbl_instance%StatusLog%log_error_trace('marbl_instance%put_setting', subname) + return + end if end do + log_message = "... Done!" - call marbl_status_log%log_noerror(log_message, subname) + call driver_status_log%log_noerror(log_message, subname) end subroutine set_all_vals !***************************************************************************** - subroutine check_all_vals(config_or_parms, marbl_status_log) - - use marbl_config_mod, only : marbl_config_and_parms_type + subroutine check_all_vals(marbl_instance, driver_status_log) - type(marbl_config_and_parms_type), intent(inout) :: config_or_parms - type(marbl_log_type), intent(inout) :: marbl_status_log + type(marbl_interface_class), intent(inout) :: marbl_instance + type(marbl_log_type), intent(inout) :: driver_status_log character(*), parameter :: subname = 'marbl_get_put_drv:check_all_vals' character(len=char_len) :: log_message, sname, datatype, sval logical :: lval real(r8) :: rval integer :: ival - integer :: n - - write(log_message, "(2A)") "Making sure variables are .true. or -1 then", & - " setting to .false. or n ..." - call marbl_status_log%log_noerror(log_message, subname) - do n=1,config_or_parms%cnt - call config_or_parms%inquire_metadata(n, marbl_status_log, & - sname=sname, datatype=datatype) - if (marbl_status_log%labort_marbl) then - call marbl_status_log%log_error_trace('inquire_metadata', subname) - return - end if - select case (trim(datatype)) - case ('real') - ! (1) Check to see that variable was set to -1 correctly - call config_or_parms%get(sname, rval, marbl_status_log) - if (rval.ne.real(-1,r8)) then - write(log_message, "(2A,E24.16,A)") trim(sname), ' = ', rval, ' not -1' - call marbl_status_log%log_error(log_message, subname) - return - end if - ! (2) Change value - call config_or_parms%put(sname, n, marbl_status_log) - case ('integer') - ! (1) Check to see that variable was set to -1 correctly - call config_or_parms%get(sname, ival, marbl_status_log) - if (ival.ne.-1) then - write(log_message, "(2A,I0,A)") trim(sname), ' = ', ival, ' not -1' - call marbl_status_log%log_error(log_message, subname) - return - end if - ! (2) Change value - call config_or_parms%put(sname, n, marbl_status_log) - case ('string') - ! (1) Check to see that variable was set to .true. correctly - call config_or_parms%get(sname, sval, marbl_status_log) - if (trim(sval).ne.'-1') then - write(log_message, "(4A)") trim(sname), ' = ', trim(sval), ', not -1' - call marbl_status_log%log_error(log_message, subname) - return - end if - ! (2) Change value - write(sval, "(I0)") n - call config_or_parms%put(sname, sval, marbl_status_log) - case ('logical') - ! (1) Check to see that variable was set to .true. correctly - call config_or_parms%get(sname, lval, marbl_status_log) - if (.not.lval) then - write(log_message, "(2A)") trim(sname), ' is .false., not .true.' - call marbl_status_log%log_error(log_message, subname) - return - end if - ! (2) Change value - call config_or_parms%put(sname, .false., marbl_status_log) - end select - end do + integer :: n, n2 + logical :: var_match + + call driver_status_log%log_noerror("Making sure variables are .true. or -1", subname) + + associate(marbl_status_log => marbl_instance%StatusLog) + + ! Configuration variables and parameters + do n = 1,marbl_instance%get_settings_var_cnt() + call marbl_instance%inquire_settings_metadata(n, sname = sname, datatype=datatype) + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace('inquire_metadata', subname) + return + end if + + ! Do not check variables listed in ignore_in_varnames + var_match = .false. + do n2=1,size(ignore_in_varnames) + if (index(sname, trim(ignore_in_varnames(n2))).ne.0) var_match = .true. + end do + if (var_match) cycle + select case (trim(datatype)) + case ('real') + ! Check to see that variable was set to -1 correctly + call marbl_instance%get_setting(sname, rval) + if (rval.ne.real(-1,r8)) then + write(log_message, "(2A,E24.16,A)") trim(sname), ' = ', rval, ' not -1' + call marbl_status_log%log_error(log_message, subname) + return + end if + case ('integer') + ! Check to see that variable was set to -1 correctly + call marbl_instance%get_setting(sname, ival) + if (ival.ne.-1) then + write(log_message, "(2A,I0,A)") trim(sname), ' = ', ival, ' not -1' + call marbl_status_log%log_error(log_message, subname) + return + end if + case ('string') + ! Check to see that variable was set to .true. correctly + call marbl_instance%get_setting(sname, sval) + if (trim(sval).ne.'-1') then + write(log_message, "(4A)") trim(sname), ' = ', trim(sval), ', not -1' + call marbl_status_log%log_error(log_message, subname) + return + end if + case ('logical') + ! Check to see that variable was set to .true. correctly + call marbl_instance%get_setting(sname, lval) + if (.not.lval) then + write(log_message, "(2A)") trim(sname), ' is .false., not .true.' + call marbl_status_log%log_error(log_message, subname) + return + end if + end select + if (marbl_status_log%labort_marbl) then + call marbl_status_log%log_error_trace('marbl_instance%get_setting', subname) + return + end if + end do + end associate + log_message = "... Done!" - call marbl_status_log%log_noerror(log_message, subname) + call driver_status_log%log_noerror(log_message, subname) end subroutine check_all_vals diff --git a/tests/driver_src/marbl_init_drv.F90 b/tests/driver_src/marbl_init_drv.F90 new file mode 100644 index 00000000..f93b26a3 --- /dev/null +++ b/tests/driver_src/marbl_init_drv.F90 @@ -0,0 +1,72 @@ +module marbl_init_drv + + use marbl_interface, only : marbl_interface_class + use marbl_kinds_mod, only : r8 + use marbl_constants_mod, only : c1, p5 + + Implicit None + Private + Save + + integer, parameter :: km = 5 + + Public :: test + +Contains + + subroutine test(marbl_instance, nt, lshutdown) + + use marbl_mpi_mod, only : marbl_mpi_abort + + type(marbl_interface_class), intent(inout) :: marbl_instance + integer, optional, intent(inout) :: nt + logical, optional, intent(in) :: lshutdown + + character(*), parameter :: subname = 'marbl_init_drv:test' + real(kind=r8), dimension(km) :: delta_z, zw, zt + integer :: k + logical :: lshutdown_loc + + ! Run marbl_instance%shutdown? (Skip when running get_setting() from driver + if (present(lshutdown)) then + lshutdown_loc = lshutdown + else + lshutdown_loc = .true. + end if + + ! Initialize levels + delta_z = c1 + zw(1) = delta_z(1) + zt(1) = p5*delta_z(1) + do k=2,km + zw(k) = zw(k-1) + delta_z(k) + zt(k) = p5*(zw(k-1)+zw(k)) + end do + + ! Optional: call marbl_instance%put() + + ! Call marbl%init + call marbl_instance%init(gcm_num_levels = km, & + gcm_num_PAR_subcols = 1, & + gcm_num_elements_surface_forcing = 1, & + gcm_delta_z = delta_z, & + gcm_zw = zw, & + gcm_zt = zt, & + marbl_tracer_cnt = nt) + if (marbl_instance%StatusLog%labort_marbl) then + call marbl_instance%StatusLog%log_error_trace('marbl%init', subname) + return + end if + + if (lshutdown_loc) then + ! Shutdown + call marbl_instance%shutdown() + if (marbl_instance%StatusLog%labort_marbl) then + call marbl_instance%StatusLog%log_error_trace('marbl%shutdown', subname) + return + end if + end if + + end subroutine test + +end module marbl_init_drv diff --git a/tests/driver_src/marbl_init_namelist_drv.F90 b/tests/driver_src/marbl_init_namelist_drv.F90 deleted file mode 100644 index bb86d160..00000000 --- a/tests/driver_src/marbl_init_namelist_drv.F90 +++ /dev/null @@ -1,77 +0,0 @@ -module marbl_init_namelist_drv - - use marbl_interface, only : marbl_interface_class - use marbl_kinds_mod, only : r8 - use marbl_constants_mod, only : c1, p5 - - Implicit None - Private - Save - - integer, parameter :: km = 5 - - Public :: test - -Contains - - subroutine test(marbl_instance, gcm_namelist, nt) - - type(marbl_interface_class), intent(inout) :: marbl_instance - character(len=*), dimension(:), intent(in) :: gcm_namelist - integer, intent(inout), optional :: nt - - character(*), parameter :: subname = 'marbl_init_namelist_drv:test' - real(kind=r8), dimension(km) :: delta_z, zw, zt - integer :: k - - ! Initialize levels - delta_z = c1 - zw(1) = delta_z(1) - zt(1) = p5*delta_z(1) - do k=2,km - zw(k) = zw(k-1) + delta_z(k) - zt(k) = p5*(zw(k-1)+zw(k)) - end do - - ! Call marbl%config - call marbl_instance%config(gcm_nl_buffer = gcm_namelist) - if (marbl_instance%StatusLog%labort_marbl) then - call marbl_instance%StatusLog%log_error_trace('marbl%config', subname) - return - end if - - ! Optional: call marbl_instance%configuration%put() - - ! Call marbl%init - call marbl_instance%init(gcm_num_levels = km, & - gcm_num_PAR_subcols = 1, & - gcm_num_elements_surface_forcing = 1, & - gcm_delta_z = delta_z, & - gcm_zw = zw, & - gcm_zt = zt, & - gcm_nl_buffer = gcm_namelist, & - marbl_tracer_cnt = nt) - if (marbl_instance%StatusLog%labort_marbl) then - call marbl_instance%StatusLog%log_error_trace('marbl%init', subname) - return - end if - - ! Optional: call marbl_instance%parameters%put() - - call marbl_instance%complete_config_and_init - if (marbl_instance%StatusLog%labort_marbl) then - call marbl_instance%StatusLog%log_error_trace( & - 'marbl%complete_config_and_init', subname) - return - end if - - ! Shutdown - call marbl_instance%shutdown() - if (marbl_instance%StatusLog%labort_marbl) then - call marbl_instance%StatusLog%log_error_trace('marbl%shutdown', subname) - return - end if - - end subroutine test - -end module marbl_init_namelist_drv diff --git a/tests/driver_src/marbl_init_no_namelist_drv.F90 b/tests/driver_src/marbl_init_no_namelist_drv.F90 deleted file mode 100644 index b1627fe6..00000000 --- a/tests/driver_src/marbl_init_no_namelist_drv.F90 +++ /dev/null @@ -1,78 +0,0 @@ -module marbl_init_no_namelist_drv - - use marbl_interface, only : marbl_interface_class - use marbl_kinds_mod, only : r8 - use marbl_constants_mod, only : c1, p5 - - Implicit None - Private - Save - - integer, parameter :: km = 5 - - Public :: test - -Contains - - subroutine test(marbl_instance) - - type(marbl_interface_class), intent(inout) :: marbl_instance - - character(*), parameter :: subname = 'marbl_init_no_namelist_drv:test' - real(kind=r8), dimension(km) :: delta_z, zw, zt - integer :: k - - ! Initialize levels - delta_z = c1 - zw(1) = delta_z(1) - zt(1) = p5*delta_z(1) - do k=2,km - zw(k) = zw(k-1) + delta_z(k) - zt(k) = p5*(zw(k-1)+zw(k)) - end do - - ! Call marbl%config - call marbl_instance%config() - if (marbl_instance%StatusLog%labort_marbl) then - call marbl_instance%StatusLog%log_error_trace('marbl%config', subname) - return - end if - - ! Optional: call marbl_instance%configuration%put() - call marbl_instance%configuration%put('ciso_on', .true., marbl_instance%StatusLog) - if (marbl_instance%StatusLog%labort_marbl) then - call marbl_instance%StatusLog%log_error_trace('marbl%config%put', subname) - return - end if - - ! Call marbl%init - call marbl_instance%init(gcm_num_levels = km, & - gcm_num_PAR_subcols = 1, & - gcm_num_elements_surface_forcing = 1, & - gcm_delta_z = delta_z, & - gcm_zw = zw, & - gcm_zt = zt) - if (marbl_instance%StatusLog%labort_marbl) then - call marbl_instance%StatusLog%log_error_trace('marbl%init', subname) - return - end if - - ! Optional: call marbl_instance%parameters%put() - - call marbl_instance%complete_config_and_init() - if (marbl_instance%StatusLog%labort_marbl) then - call marbl_instance%StatusLog%log_error_trace( & - 'marbl%complete_config_and_init', subname) - return - end if - - ! Shutdown - call marbl_instance%shutdown() - if (marbl_instance%StatusLog%labort_marbl) then - call marbl_instance%StatusLog%log_error_trace('marbl%shutdown', subname) - return - end if - - end subroutine test - -end module marbl_init_no_namelist_drv diff --git a/tests/driver_src/marbl_mpi_mod.F90 b/tests/driver_src/marbl_mpi_mod.F90 index 286a527c..3284f4b6 100644 --- a/tests/driver_src/marbl_mpi_mod.F90 +++ b/tests/driver_src/marbl_mpi_mod.F90 @@ -31,6 +31,8 @@ module marbl_mpi_mod interface marbl_mpi_bcast module procedure marbl_mpi_bcast_str + module procedure marbl_mpi_bcast_logical + module procedure marbl_mpi_bcast_integer end interface marbl_mpi_bcast !**************************************************************************** @@ -56,6 +58,17 @@ end subroutine marbl_mpi_init !**************************************************************************** + subroutine marbl_mpi_barrier() + +#ifdef MARBL_WITH_MPI + integer :: ierr + + call MPI_Barrier(MPI_COMM_WORLD, ierr) +#endif + + end subroutine marbl_mpi_barrier + !**************************************************************************** + subroutine marbl_mpi_finalize() #ifdef MARBL_WITH_MPI @@ -125,11 +138,50 @@ end subroutine marbl_mpi_bcast_str !**************************************************************************** + subroutine marbl_mpi_bcast_logical(logical_to_bcast, root_task) + + logical, intent(inout) :: logical_to_bcast + integer, intent(in) :: root_task + + integer :: ierr + +#ifdef MARBL_WITH_MPI + call MPI_Bcast(logical_to_bcast, 1, MPI_LOGICAL, root_task, & + MPI_COMM_WORLD, ierr) +#else + ! Avoid an empty subroutien when no MPI + ierr = root_task +#endif + + end subroutine marbl_mpi_bcast_logical + + !**************************************************************************** + + subroutine marbl_mpi_bcast_integer(int_to_bcast, root_task) + + integer, intent(inout) :: int_to_bcast + integer, intent(in) :: root_task + + integer :: ierr + +#ifdef MARBL_WITH_MPI + call MPI_Bcast(int_to_bcast, 1, MPI_INTEGER, root_task, & + MPI_COMM_WORLD, ierr) +#else + ! Avoid an empty subroutien when no MPI + ierr = root_task +#endif + + end subroutine marbl_mpi_bcast_integer + + !**************************************************************************** + subroutine marbl_mpi_abort() #ifdef MARBL_WITH_MPI integer :: ierr + call marbl_mpi_barrier() call MPI_Abort(MPI_COMM_WORLD, ierr) #else stop 1 diff --git a/tests/driver_src/marbl_utils_drv.F90 b/tests/driver_src/marbl_utils_drv.F90 new file mode 100644 index 00000000..46dc152c --- /dev/null +++ b/tests/driver_src/marbl_utils_drv.F90 @@ -0,0 +1,347 @@ +module marbl_utils_drv + + use marbl_kinds_mod, only : r8 + use marbl_kinds_mod, only : char_len + use marbl_logging, only : marbl_log_type + + Implicit None + Private + Save + + public :: test + +contains + + !***************************************************************************** + + subroutine test(driver_status_log) + + type(marbl_log_type), intent(inout) :: driver_status_log + + real(kind=r8) :: linear_root, expected_root + real(kind=r8), dimension(2) :: x, y + character(len=char_len) :: str, expected_str + character(len=char_len), allocatable :: substrs(:), expected_substrs(:) + integer :: test_cnt, fail_cnt, tot_fail_cnt + character(len=*), parameter :: subname = 'marbl_utils_drv:test' + character(len=char_len) :: log_message + + ! Linear root tests + call driver_status_log%log_header("Linear Root Tests", subname) + test_cnt = 0 + fail_cnt = 0 + tot_fail_cnt = 0 + + ! (1) root between (1,-1) and (2,1) is at x=2 + test_cnt = test_cnt + 1 + x = (/ 1.0_r8, 2.0_r8/) + y = (/-1.0_r8, 1.0_r8/) + expected_root = 1.5_r8 + if (.not. linear_root_test(x, y, test_cnt, driver_status_log, expected_root)) fail_cnt = fail_cnt + 1 + + ! (2) root between (2,1) and (1,-1) is at x=2 + test_cnt = test_cnt + 1 + x = (/2.0_r8, 1.0_r8/) + y = (/1.0_r8, -1.0_r8/) + expected_root = 1.5_r8 + if (.not. linear_root_test(x, y, test_cnt, driver_status_log, expected_root)) fail_cnt = fail_cnt + 1 + + ! (3) root between (1,1) and (2,-1) is at x=2 + test_cnt = test_cnt + 1 + x = (/1.0_r8, 2.0_r8/) + y = (/1.0_r8, -1.0_r8/) + expected_root = 1.5_r8 + if (.not. linear_root_test(x, y, test_cnt, driver_status_log, expected_root)) fail_cnt = fail_cnt + 1 + + ! (4) root between (2,-1) and (1,1) is at x=2 + test_cnt = test_cnt + 1 + x = (/ 2.0_r8, 1.0_r8/) + y = (/-1.0_r8, 1.0_r8/) + expected_root = 1.5_r8 + if (.not. linear_root_test(x, y, test_cnt, driver_status_log, expected_root)) fail_cnt = fail_cnt + 1 + + ! (5) root between (5,0) and (7,3) is at x=5 + test_cnt = test_cnt + 1 + x = (/5.0_r8, 7.0_r8/) + y = (/0.0_r8, 3.0_r8/) + expected_root = 5.0_r8 + if (.not. linear_root_test(x, y, test_cnt, driver_status_log, expected_root)) fail_cnt = fail_cnt + 1 + + ! (6) root between (5,3) and (7,0) is at x=7 + test_cnt = test_cnt + 1 + x = (/5.0_r8, 7.0_r8/) + y = (/3.0_r8, 0.0_r8/) + expected_root = 7.0_r8 + if (.not. linear_root_test(x, y, test_cnt, driver_status_log, expected_root)) fail_cnt = fail_cnt + 1 + + ! (7) root between (5,0) and (7,0) is at x=7 + test_cnt = test_cnt + 1 + x = (/5.0_r8, 7.0_r8/) + y = (/0.0_r8, 0.0_r8/) + expected_root = 7.0_r8 + if (.not. linear_root_test(x, y, test_cnt, driver_status_log, expected_root)) fail_cnt = fail_cnt + 1 + + ! (8) no root between (1,1) and (2,3) + test_cnt = test_cnt + 1 + x = (/1.0_r8, 2.0_r8/) + y = (/1.0_r8, 3.0_r8/) + if (.not. linear_root_test(x, y, test_cnt, driver_status_log)) fail_cnt = fail_cnt + 1 + + ! (9) no root between (1,-1) and (2,-3) + test_cnt = test_cnt + 1 + x = (/ 1.0_r8, 2.0_r8/) + y = (/-1.0_r8, -3.0_r8/) + if (.not. linear_root_test(x, y, test_cnt, driver_status_log)) fail_cnt = fail_cnt + 1 + + ! Any failures above? + call analyze_results('linear root', fail_cnt, tot_fail_cnt, driver_status_log) + + ! str_to_substrs tests + call driver_status_log%log_header("String -> Substrings Tests", subname) + test_cnt = 0 + fail_cnt = 0 + + ! (1) ".true." -> ".true." + test_cnt = test_cnt + 1 + str = ".true." + allocate(expected_substrs(1)) + expected_substrs(1) = ".true." + if (.not. str_to_substrs_test(str, expected_substrs, test_cnt, driver_status_log)) fail_cnt = fail_cnt + 1 + deallocate(expected_substrs) + + ! (2) "123, 456" -> "123", " 456" + test_cnt = test_cnt + 1 + str = "123, 456" + allocate(expected_substrs(2)) + expected_substrs(1) = "123" + expected_substrs(2) = " 456" + if (.not. str_to_substrs_test(str, expected_substrs, test_cnt, driver_status_log)) fail_cnt = fail_cnt + 1 + deallocate(expected_substrs) + + ! (3) "'ABC, DEF', 'GHI'" -> "'ABC, DEF', " 'GHI'" + test_cnt = test_cnt + 1 + str = "'ABC, DEF', 'GHI'" + allocate(expected_substrs(2)) + expected_substrs(1) = "'ABC, DEF'" + expected_substrs(2) = " 'GHI'" + if (.not. str_to_substrs_test(str, expected_substrs, test_cnt, driver_status_log)) fail_cnt = fail_cnt + 1 + deallocate(expected_substrs) + + ! Any failures above? + call analyze_results('string to substrings', fail_cnt, tot_fail_cnt, driver_status_log) + + ! strip_comment tests + call driver_status_log%log_header("Comment-Stripping Tests", subname) + test_cnt = 0 + fail_cnt = 0 + + ! (1) "ciso_on = .true. ! Turn on ciso" -> "ciso_on = .true. " + test_cnt = test_cnt + 1 + str = "ciso_on = .true. ! Turn on ciso" + expected_str = "ciso_on = .true." + if (.not. strip_comments_test(str, expected_str, test_cnt, driver_status_log)) fail_cnt = fail_cnt + 1 + + ! (2) "autotrophs(1)%lname='Small Phytoplankton!'" -> "autotrophs(1)%lname='Small Phytoplankton!'" + test_cnt = test_cnt + 1 + str = "autotrophs(1)%lname='Small Phytoplankton!'" + expected_str = str + if (.not. strip_comments_test(str, expected_str, test_cnt, driver_status_log)) fail_cnt = fail_cnt + 1 + + ! Any failures above? + call analyze_results('comment stripping', fail_cnt, tot_fail_cnt, driver_status_log) + + call driver_status_log%log_noerror('', subname) + if (tot_fail_cnt .eq. 0) then + call driver_status_log%log_noerror('All unit tests passed!', subname) + else + write(log_message, "(A,I0,A)") "Failed ", tot_fail_cnt, " unit test(s)." + call driver_status_log%log_error(log_message, subname) + end if + + end subroutine test + + !***************************************************************************** + + function linear_root_test(x, y, test_cnt, driver_status_log, expected_root) result(ltest_pass) + + use marbl_utils_mod, only : marbl_utils_linear_root + + real(r8), dimension(2), intent(in) :: x + real(r8), dimension(2), intent(in) :: y + integer, intent(in) :: test_cnt + type(marbl_log_type), intent(inout) :: driver_status_log + real(r8), optional, intent(in) :: expected_root + logical :: ltest_pass + + character(len=*), parameter :: subname = 'marbl_utils_drv:linear_root_test' + character(len=char_len) :: log_message + character(len=char_len) :: test_desc + + real(r8) :: linear_root + real(r8) :: tol + + tol = 1e-13_r8 + ltest_pass = .false. + write(test_desc, "(A,F0.1,A,F0.1,A,F0.1,A,F0.1,A)") "root between (", x(1), ", ", y(1), ") and (", x(2), ", ", y(2), ')' + + if (.not. present(expected_root)) driver_status_log%OutputOptions%lLogError=.false. + linear_root = marbl_utils_linear_root(x, y, driver_status_log) + if (present(expected_root)) then ! expecting real result + if (driver_status_log%labort_marbl) then + call driver_status_log%log_error_trace('marbl_utils_linear_root', subname) + return + end if + + if (abs(linear_root - expected_root) .le. tol) then + ltest_pass = .true. + write(log_message, "(A,I0,3A)") "PASS: Test ", test_cnt, " [linear root: ", trim(test_desc), "]" + call driver_status_log%log_noerror(log_message, subname) + write(log_message, "(6X,A,F0.1)") "Root at x = ", linear_root + call driver_status_log%log_noerror(log_message, subname) + else + write(log_message, "(A,I0,3A)") "FAIL: Test ", test_cnt, " [linear root: ", trim(test_desc), "]" + call driver_status_log%log_noerror(log_message, subname) + write(log_message, "(6X,A,F0.1)") "Expected root: ", expected_root + call driver_status_log%log_noerror(log_message, subname) + write(log_message, "(6X,A,E24.16)") "Found root: ", linear_root + call driver_status_log%log_noerror(log_message, subname) + end if + else ! no expected real root => expect error + driver_status_log%OutputOptions%lLogError=.true. + ltest_pass = driver_status_log%labort_marbl + driver_status_log%labort_marbl = .false. + if (ltest_pass) then + write(log_message, "(A,I0,3A)") "PASS: Test ", test_cnt, " (linear root: ", trim(test_desc), "]" + call driver_status_log%log_noerror(log_message, subname) + write(log_message, "(6X,A)") "No root found" + call driver_status_log%log_noerror(log_message, subname) + else + write(log_message, "(A,I0,3A)") "FAIL: Test ", test_cnt, " (linear root: ", trim(test_desc), "]" + call driver_status_log%log_noerror(log_message, subname) + write(log_message, "(6X,A)") "Expected no root" + call driver_status_log%log_noerror(log_message, subname) + write(log_message, "(6X,A,E24.16)") "fount root: ", linear_root + call driver_status_log%log_noerror(log_message, subname) + end if + end if + + end function linear_root_test + + !***************************************************************************** + + function str_to_substrs_test(str, expected_substrs, test_cnt, driver_status_log) result(ltest_pass) + + use marbl_utils_mod, only : marbl_utils_str_to_substrs + + character(len=*), intent(in) :: str + character(len=*), dimension(:), intent(in) :: expected_substrs + integer, intent(in) :: test_cnt + type(marbl_log_type), intent(inout) :: driver_status_log + logical :: ltest_pass + + character(len=*), parameter :: subname = 'marbl_utils_drv:str_to_substrs_test' + character(len=char_len) :: log_message + + character(len=char_len), allocatable :: substrs(:) + integer :: i + + call marbl_utils_str_to_substrs(str, ",", substrs) + ltest_pass = (size(substrs) .eq. size(expected_substrs)) + if (.not. ltest_pass) then + write(log_message, "(A,I0,3A)") "FAIL: Test ", test_cnt, " [str_to_substrs: ", trim(str), "]" + call driver_status_log%log_noerror(log_message, subname) + write(log_message, "(6X,A,I0,A)") "expected ", size(expected_substrs), " element(s) in substrs" + call driver_status_log%log_noerror(log_message, subname) + write(log_message, "(6X,A,I0,A)") "result had ", size(substrs), " element(s)" + call driver_status_log%log_noerror(log_message, subname) + deallocate(substrs) + return + end if + + do i=1,size(substrs) + if (substrs(i) .ne. expected_substrs(i)) then + ltest_pass = .false. + write(log_message, "(A,I0,3A)") "FAIL: Test ", test_cnt, " (str_to_substrs: ", trim(str), ")" + call driver_status_log%log_noerror(log_message, subname) + write(log_message, "(6X,A,I0,2A)") "Expected substr(", i, "): ", trim(expected_substrs(i)) + call driver_status_log%log_noerror(log_message, subname) + write(log_message, "(6X,A,I0,2A)") "Result substr(", i, "): ", trim(substrs(i)) + call driver_status_log%log_noerror(log_message, subname) + end if + end do + + if (ltest_pass) then + write(log_message, "(A,I0,3A)") "PASS: Test ", test_cnt, " (str_to_substrs: ", trim(str), ")" + call driver_status_log%log_noerror(log_message, subname) + do i=1,size(substrs) + write(log_message, "(6X,A,I0,2A)") "substr(", i, "): ", trim(substrs(i)) + call driver_status_log%log_noerror(log_message, subname) + end do + end if + + deallocate(substrs) + + end function str_to_substrs_test + + !***************************************************************************** + + function strip_comments_test(str, expected_str, test_cnt, driver_status_log) result(ltest_pass) + + use marbl_utils_mod, only : marbl_utils_str_to_substrs + + character(len=*), intent(in) :: str + character(len=*), intent(in) :: expected_str + integer, intent(in) :: test_cnt + type(marbl_log_type), intent(inout) :: driver_status_log + logical :: ltest_pass + + character(len=*), parameter :: subname = 'marbl_utils_drv:str_to_substrs_test' + character(len=char_len) :: log_message + + character(len=char_len), allocatable :: substrs(:) + + call marbl_utils_str_to_substrs(str, "!", substrs) + ltest_pass = trim(substrs(1)) .eq. trim(expected_str) + if (ltest_pass) then + write(log_message, "(A,I0,3A)") "PASS: Test ", test_cnt, " (strip_comments: ", trim(str), ")" + call driver_status_log%log_noerror(log_message, subname) + write(log_message, "(6X,2A)") "string: ", trim(substrs(1)) + call driver_status_log%log_noerror(log_message, subname) + else + write(log_message, "(A,I0,3A)") "FAIL: Test ", test_cnt, " (strip_comments: ", trim(str), ")" + call driver_status_log%log_noerror(log_message, subname) + write(log_message, "(6X,2A)") "Expected: ", trim(expected_str) + call driver_status_log%log_noerror(log_message, subname) + write(log_message, "(6X,2A)") "Result: ", trim(substrs(1)) + call driver_status_log%log_noerror(log_message, subname) + end if + + end function strip_comments_test + + !***************************************************************************** + + subroutine analyze_results(testname, fail_cnt, tot_fail_cnt, driver_status_log) + + character(len=*), intent(in) :: testname + integer, intent(in) :: fail_cnt + integer, intent(inout) :: tot_fail_cnt + type(marbl_log_type), intent(inout) :: driver_status_log + character(len=char_len) :: log_message + + character(len=*), parameter :: subname = 'marbl_utils_drv:analyze_results' + call driver_status_log%log_noerror('', subname) + if (fail_cnt .gt. 0) then + write(log_message, "(A,I0,1X,A,1X,A)") "Failed ", fail_cnt, trim(testname), "test(s)" + call driver_status_log%log_error(log_message, subname) + driver_status_log%labort_marbl = .false. + else + write(log_message, "(3A)") "** passed all ", trim(testname), " tests **" + call driver_status_log%log_noerror(log_message, subname) + end if + tot_fail_cnt = tot_fail_cnt + fail_cnt + + end subroutine analyze_results + + !***************************************************************************** + +end module marbl_utils_drv diff --git a/tests/python_for_tests/machines.py b/tests/python_for_tests/machines.py index 14c2a937..5e69fd76 100644 --- a/tests/python_for_tests/machines.py +++ b/tests/python_for_tests/machines.py @@ -2,7 +2,7 @@ from os import system as sh_command # Supported machines for running MARBL tests -supported_machines = ['local-gnu', +supported_machines = ['local-gnu', 'local-pgi', 'yellowstone', 'cheyenne', @@ -11,15 +11,16 @@ # ----------------------------------------------- -def load_module(mach, compiler): +def load_module(mach, compiler, module_name): + + print "Building with %s on %s" % (compiler, mach) + print "Loading module %s..." % module_name - print "Trying to load %s on %s" % (compiler, mach) - if mach == 'yellowstone': sys.path.insert(0,'/glade/apps/opt/lmod/lmod/init') from env_modules_python import module module('purge') - module('load', compiler) + module('load', module_name) module('load', 'ncarcompilers') module('load', 'ncarbinlibs') @@ -27,26 +28,21 @@ def load_module(mach, compiler): sys.path.insert(0,'/glade/u/apps/ch/opt/lmod/7.2.1/lmod/lmod/init') from env_modules_python import module module('purge') - if compiler == 'intel': - module('load', '%s/17.0.1' % compiler) - else: - module('load', compiler) + module('load', module_name) module('load', 'ncarcompilers') + module('load', 'mpt/2.15') if mach == 'hobart': sys.path.insert(0,'/usr/share/Modules/init') from python import module module('purge') - if compiler == 'pgi': - module(['load', 'compiler/%s/17.01' % compiler]) - else: - module(['load', 'compiler/%s' % compiler]) + module(['load', module_name]) if mach == 'edison': sys.path.insert(0,'/opt/modules/default/init') from python import module module('purge') - module(['load', 'PrgEnv-%s' % compiler]) + module(['load', module_name]) if compiler == 'cray': module(['swap', 'cce', 'cce/8.5.0.4664']) @@ -55,7 +51,7 @@ def load_module(mach, compiler): # Set up supported compilers based on what machine you are running on # so code can abort if an unsupported compiler is requested. # If no compiler is specified, the supported_compilers[0] will be used. -def machine_specific(mach, supported_compilers): +def machine_specific(mach, supported_compilers, module_names): global supported_machines @@ -68,12 +64,18 @@ def machine_specific(mach, supported_compilers): # NCAR machine supported_compilers.append('intel') supported_compilers.append('gnu') + supported_compilers.append('pgi') + module_names['intel'] = 'intel/17.0.1' + module_names['gnu'] = 'gnu/7.1.0' + module_names['pgi'] = 'pgi/17.5' return if mach == 'cheyenne': # NCAR machine supported_compilers.append('intel') supported_compilers.append('gnu') + module_names['intel'] = 'intel/17.0.1' + module_names['gnu'] = 'gnu/7.1.0' return if mach == 'hobart': @@ -82,11 +84,16 @@ def machine_specific(mach, supported_compilers): supported_compilers.append('intel') supported_compilers.append('gnu') supported_compilers.append('pgi') + module_names['nag'] = 'compiler/nag/6.1' + module_names['intel'] = 'compiler/intel/17.0.4.196' + module_names['gnu'] = 'compiler/gnu/4.8.5' + module_names['pgi'] = 'compiler/pgi/17.04' return if mach == 'edison': # NERSC machine supported_compilers.append('cray') + module_names['cray'] = 'PrgEnv-cray' return if mach == 'local-gnu': diff --git a/tests/python_for_tests/marbl_testing_class.py b/tests/python_for_tests/marbl_testing_class.py index e1b8f745..7b0fcb31 100644 --- a/tests/python_for_tests/marbl_testing_class.py +++ b/tests/python_for_tests/marbl_testing_class.py @@ -11,19 +11,20 @@ def __init__(self): self.supported_compilers = [] # all other variables are private + self._module_names = {} self._compiler = None self._machine = None self._hostname = None - self._namelistfile = 'marbl_in' + self._inputfile = None self._mpitasks = 0 self._marbl_dir = path.abspath('%s/../..' % path.dirname(__file__)) # ----------------------------------------------- # Parse the arguments to the MARBL test script - # Some tests will let you specify a compiler and / or namelist + # Some tests will let you specify a compiler and / or input file # Some tests will require you to specify a machine - def parse_args(self, desc, HaveCompiler=True, HaveNamelist=True, + def parse_args(self, desc, HaveCompiler=True, HaveInputFile=True, CleanLibOnly=False): import argparse @@ -33,9 +34,9 @@ def parse_args(self, desc, HaveCompiler=True, HaveNamelist=True, parser.add_argument('-c', '--compiler', action='store', dest='compiler', help='compiler to build with') - if HaveNamelist: - parser.add_argument('-n', '--namelist', action='store', dest='namelistfile', - help='namelist file to read', default='marbl_in') + if HaveInputFile: + parser.add_argument('-i', '--input-file', action='store', dest='inputfile', + help='input file to read', default='marbl.input') if CleanLibOnly: parser.add_argument('--clean', action='store_true', @@ -87,8 +88,8 @@ def parse_args(self, desc, HaveCompiler=True, HaveNamelist=True, self._machine = args.mach print 'Running test on %s' % self._machine - machs.machine_specific(self._machine, self.supported_compilers) - + machs.machine_specific(self._machine, self.supported_compilers, self._module_names) + if HaveCompiler: self._compiler = args.compiler if self._compiler == None: @@ -97,8 +98,8 @@ def parse_args(self, desc, HaveCompiler=True, HaveNamelist=True, else: print 'Testing with %s' % self._compiler - if HaveNamelist: - self._namelistfile = args.namelistfile + if HaveInputFile: + self._inputfile = args.inputfile self._mpitasks = int(args.mpitasks) print '----' @@ -122,7 +123,7 @@ def build_lib(self, loc_compiler=None): src_dir = '%s/src' % self._marbl_dir if self._machine not in ['local-gnu','local-pgi']: - machs.load_module(self._machine, loc_compiler) + machs.load_module(self._machine, loc_compiler, self._module_names[loc_compiler]) makecmd = 'make %s' % loc_compiler if self._mpitasks > 0: @@ -140,7 +141,7 @@ def build_exe(self, loc_compiler=None): drv_dir = '%s/tests/driver_src' % self._marbl_dir if self._machine not in ['local-gnu','local-pgi']: - machs.load_module(self._machine, loc_compiler) + machs.load_module(self._machine, loc_compiler, self._module_names[loc_compiler]) makecmd = 'make %s' % loc_compiler if self._mpitasks > 0: @@ -155,7 +156,10 @@ def run_exe(self): exe_dir = '%s/tests/driver_exe' % self._marbl_dir if self._mpitasks > 0: - execmd = '%s/marbl-mpi.exe < %s' % (exe_dir, self._namelistfile) + if self._inputfile is not None: + execmd = '%s/marbl-mpi.exe < %s' % (exe_dir, self._inputfile) + else: + execmd = '%s/marbl-mpi.exe' % exe_dir if self._machine == 'yellowstone': execmd = 'mpirun.lsf %s' % execmd if 'yslogin' in self._hostname: @@ -164,7 +168,10 @@ def run_exe(self): else: execmd = 'mpirun -n %d %s' % (self._mpitasks, execmd) else: - execmd = '%s/marbl.exe < %s' % (exe_dir, self._namelistfile) + if self._inputfile is not None: + execmd = '%s/marbl.exe < %s' % (exe_dir, self._inputfile) + else: + execmd = '%s/marbl.exe' % exe_dir print "Running following command:" print execmd print '' diff --git a/tests/regression_tests/gen_inputfile/.gitignore b/tests/regression_tests/gen_inputfile/.gitignore new file mode 100644 index 00000000..1bf69091 --- /dev/null +++ b/tests/regression_tests/gen_inputfile/.gitignore @@ -0,0 +1 @@ +marbl_input.gen diff --git a/tests/regression_tests/init_from_namelist/init_namelist.py b/tests/regression_tests/gen_inputfile/gen_inputfile.py similarity index 58% rename from tests/regression_tests/init_from_namelist/init_namelist.py rename to tests/regression_tests/gen_inputfile/gen_inputfile.py index b1806850..df651f4d 100755 --- a/tests/regression_tests/init_from_namelist/init_namelist.py +++ b/tests/regression_tests/gen_inputfile/gen_inputfile.py @@ -7,7 +7,7 @@ mt = MARBL_testcase() -mt.parse_args(desc='Run full MARBL setup (config, init, and complete), reading configuration variables and parameters from namelist') +mt.parse_args(desc='Generate an inputfile for MARBL') mt.build_exe() diff --git a/tests/regression_tests/gen_inputfile/marbl.input b/tests/regression_tests/gen_inputfile/marbl.input new file mode 100644 index 00000000..dde6f25c --- /dev/null +++ b/tests/regression_tests/gen_inputfile/marbl.input @@ -0,0 +1 @@ +ciso_on = .true. diff --git a/tests/regression_tests/gen_inputfile/marbl_no_ciso.input b/tests/regression_tests/gen_inputfile/marbl_no_ciso.input new file mode 100644 index 00000000..e69de29b diff --git a/tests/regression_tests/gen_inputfile/marbl_with_restore.input b/tests/regression_tests/gen_inputfile/marbl_with_restore.input new file mode 100644 index 00000000..893668c0 --- /dev/null +++ b/tests/regression_tests/gen_inputfile/marbl_with_restore.input @@ -0,0 +1,3 @@ +tracer_restore_vars(1) = 'SiO3' +tracer_restore_vars(2) = 'NO3' +tracer_restore_vars(3) = 'PO4' diff --git a/tests/regression_tests/gen_inputfile/test.nml b/tests/regression_tests/gen_inputfile/test.nml new file mode 100644 index 00000000..b66fd337 --- /dev/null +++ b/tests/regression_tests/gen_inputfile/test.nml @@ -0,0 +1,4 @@ +&marbl_driver_nml +testname="gen_inputfile" +log_out_file='marbl_input.gen' +/ diff --git a/tests/regression_tests/init_without_namelist/init_without_namelist.py b/tests/regression_tests/init-twice/init-twice.py similarity index 53% rename from tests/regression_tests/init_without_namelist/init_without_namelist.py rename to tests/regression_tests/init-twice/init-twice.py index 9cc07052..6b00d0d3 100755 --- a/tests/regression_tests/init_without_namelist/init_without_namelist.py +++ b/tests/regression_tests/init-twice/init-twice.py @@ -7,7 +7,8 @@ mt = MARBL_testcase() -mt.parse_args(desc='Run full MARBL setup (config, init, and complete), without reading configuration variables and parameters from namelist', HaveNamelist=False) +mt.parse_args(desc='Run MARBL init twice (to ensure module-level memory is ' + 'handled correctly)', HaveInputFile=False) mt.build_exe() diff --git a/tests/regression_tests/init-twice/test.nml b/tests/regression_tests/init-twice/test.nml new file mode 100644 index 00000000..5bdf7938 --- /dev/null +++ b/tests/regression_tests/init-twice/test.nml @@ -0,0 +1,4 @@ +&marbl_driver_nml +testname = "init-twice" +lhas_inputfile = .false. +/ diff --git a/tests/regression_tests/init/init.py b/tests/regression_tests/init/init.py new file mode 100755 index 00000000..510af040 --- /dev/null +++ b/tests/regression_tests/init/init.py @@ -0,0 +1,14 @@ +#!/usr/bin/env python + +from sys import path + +path.insert(0,'../../python_for_tests') +from marbl_testing_class import MARBL_testcase + +mt = MARBL_testcase() + +mt.parse_args(desc='Run MARBL init') + +mt.build_exe() + +mt.run_exe() diff --git a/tests/regression_tests/init/marbl.input b/tests/regression_tests/init/marbl.input new file mode 100644 index 00000000..dde6f25c --- /dev/null +++ b/tests/regression_tests/init/marbl.input @@ -0,0 +1 @@ +ciso_on = .true. diff --git a/tests/regression_tests/init/marbl_no_ciso.input b/tests/regression_tests/init/marbl_no_ciso.input new file mode 100644 index 00000000..e69de29b diff --git a/tests/regression_tests/init/marbl_with_restore.input b/tests/regression_tests/init/marbl_with_restore.input new file mode 100644 index 00000000..893668c0 --- /dev/null +++ b/tests/regression_tests/init/marbl_with_restore.input @@ -0,0 +1,3 @@ +tracer_restore_vars(1) = 'SiO3' +tracer_restore_vars(2) = 'NO3' +tracer_restore_vars(3) = 'PO4' diff --git a/tests/unit_tests/get_put/marbl_in b/tests/regression_tests/init/test.nml similarity index 51% rename from tests/unit_tests/get_put/marbl_in rename to tests/regression_tests/init/test.nml index 9f62f3de..63c0dbc2 100644 --- a/tests/unit_tests/get_put/marbl_in +++ b/tests/regression_tests/init/test.nml @@ -1,3 +1,3 @@ &marbl_driver_nml -testname="get_put" +testname="init" / diff --git a/tests/regression_tests/init_from_namelist/marbl_in b/tests/regression_tests/init_from_namelist/marbl_in deleted file mode 100644 index 0db66e17..00000000 --- a/tests/regression_tests/init_from_namelist/marbl_in +++ /dev/null @@ -1,8 +0,0 @@ -&marbl_driver_nml -testname="init_from_namelist" -/ -&marbl_config_nml -ciso_on=.true. -/ -&marbl_parms_nml -/ diff --git a/tests/regression_tests/init_from_namelist/marbl_in_no_ciso b/tests/regression_tests/init_from_namelist/marbl_in_no_ciso deleted file mode 100644 index 101e621e..00000000 --- a/tests/regression_tests/init_from_namelist/marbl_in_no_ciso +++ /dev/null @@ -1,7 +0,0 @@ -&marbl_driver_nml -testname="init_from_namelist" -/ -&marbl_config_nml -/ -&marbl_parms_nml -/ diff --git a/tests/regression_tests/init_from_namelist/marbl_in_with_restore b/tests/regression_tests/init_from_namelist/marbl_in_with_restore deleted file mode 100644 index 55c98b4e..00000000 --- a/tests/regression_tests/init_from_namelist/marbl_in_with_restore +++ /dev/null @@ -1,8 +0,0 @@ -&marbl_driver_nml -testname="init_from_namelist" -/ -&marbl_config_nml -/ -&marbl_parms_nml - tracer_restore_vars = 'SiO3', 'NO3', 'PO4' -/ diff --git a/tests/regression_tests/init_without_namelist/marbl_in b/tests/regression_tests/init_without_namelist/marbl_in deleted file mode 100644 index 4efdd0e3..00000000 --- a/tests/regression_tests/init_without_namelist/marbl_in +++ /dev/null @@ -1,3 +0,0 @@ -&marbl_driver_nml -testname="init_without_namelist" -/ diff --git a/tests/regression_tests/requested_forcings/marbl.input b/tests/regression_tests/requested_forcings/marbl.input new file mode 100644 index 00000000..dde6f25c --- /dev/null +++ b/tests/regression_tests/requested_forcings/marbl.input @@ -0,0 +1 @@ +ciso_on = .true. diff --git a/tests/regression_tests/requested_forcings/marbl_in b/tests/regression_tests/requested_forcings/marbl_in deleted file mode 100644 index 5d52ad0d..00000000 --- a/tests/regression_tests/requested_forcings/marbl_in +++ /dev/null @@ -1,8 +0,0 @@ -&marbl_driver_nml -testname="request_forcings" -/ -&marbl_config_nml -ciso_on=.true. -/ -&marbl_parms_nml -/ diff --git a/tests/regression_tests/requested_forcings/marbl_in_with_restore b/tests/regression_tests/requested_forcings/marbl_in_with_restore deleted file mode 100644 index ca1905f8..00000000 --- a/tests/regression_tests/requested_forcings/marbl_in_with_restore +++ /dev/null @@ -1,9 +0,0 @@ -&marbl_driver_nml -testname="request_forcings" -/ -&marbl_config_nml -ciso_on=.true. -/ -&marbl_parms_nml - tracer_restore_vars = 'SiO3', 'NO3', 'PO4' -/ diff --git a/tests/regression_tests/requested_forcings/marbl_no_ciso.input b/tests/regression_tests/requested_forcings/marbl_no_ciso.input new file mode 100644 index 00000000..e69de29b diff --git a/tests/regression_tests/requested_forcings/marbl_with_restore.input b/tests/regression_tests/requested_forcings/marbl_with_restore.input new file mode 100644 index 00000000..893668c0 --- /dev/null +++ b/tests/regression_tests/requested_forcings/marbl_with_restore.input @@ -0,0 +1,3 @@ +tracer_restore_vars(1) = 'SiO3' +tracer_restore_vars(2) = 'NO3' +tracer_restore_vars(3) = 'PO4' diff --git a/tests/regression_tests/requested_forcings/marbl_in_no_ciso b/tests/regression_tests/requested_forcings/test.nml similarity index 55% rename from tests/regression_tests/requested_forcings/marbl_in_no_ciso rename to tests/regression_tests/requested_forcings/test.nml index d2bc90be..645c5b2e 100644 --- a/tests/regression_tests/requested_forcings/marbl_in_no_ciso +++ b/tests/regression_tests/requested_forcings/test.nml @@ -1,7 +1,3 @@ &marbl_driver_nml testname="request_forcings" / -&marbl_config_nml -/ -&marbl_parms_nml -/ diff --git a/tests/regression_tests/requested_restoring/marbl.input b/tests/regression_tests/requested_restoring/marbl.input new file mode 100644 index 00000000..893668c0 --- /dev/null +++ b/tests/regression_tests/requested_restoring/marbl.input @@ -0,0 +1,3 @@ +tracer_restore_vars(1) = 'SiO3' +tracer_restore_vars(2) = 'NO3' +tracer_restore_vars(3) = 'PO4' diff --git a/tests/regression_tests/requested_restoring/marbl_in b/tests/regression_tests/requested_restoring/marbl_in deleted file mode 100644 index 4144bed7..00000000 --- a/tests/regression_tests/requested_restoring/marbl_in +++ /dev/null @@ -1,8 +0,0 @@ -&marbl_driver_nml -testname="request_restoring" -/ -&marbl_config_nml -/ -&marbl_parms_nml -tracer_restore_vars = 'SiO3', 'PO4', 'DIC' -/ diff --git a/tests/regression_tests/requested_restoring/marbl_no_restoring.input b/tests/regression_tests/requested_restoring/marbl_no_restoring.input new file mode 100644 index 00000000..e69de29b diff --git a/tests/regression_tests/requested_restoring/marbl_in_no_restoring b/tests/regression_tests/requested_restoring/test.nml similarity index 55% rename from tests/regression_tests/requested_restoring/marbl_in_no_restoring rename to tests/regression_tests/requested_restoring/test.nml index f0077d2d..86e23a3b 100644 --- a/tests/regression_tests/requested_restoring/marbl_in_no_restoring +++ b/tests/regression_tests/requested_restoring/test.nml @@ -1,7 +1,3 @@ &marbl_driver_nml testname="request_restoring" / -&marbl_config_nml -/ -&marbl_parms_nml -/ diff --git a/tests/regression_tests/requested_tracers/marbl.input b/tests/regression_tests/requested_tracers/marbl.input new file mode 100644 index 00000000..dde6f25c --- /dev/null +++ b/tests/regression_tests/requested_tracers/marbl.input @@ -0,0 +1 @@ +ciso_on = .true. diff --git a/tests/regression_tests/requested_tracers/marbl_in b/tests/regression_tests/requested_tracers/marbl_in deleted file mode 100644 index f1fe7ddb..00000000 --- a/tests/regression_tests/requested_tracers/marbl_in +++ /dev/null @@ -1,8 +0,0 @@ -&marbl_driver_nml -testname="request_tracers" -/ -&marbl_config_nml -ciso_on=.true. -/ -&marbl_parms_nml -/ diff --git a/tests/regression_tests/requested_tracers/marbl_no_ciso.input b/tests/regression_tests/requested_tracers/marbl_no_ciso.input new file mode 100644 index 00000000..e69de29b diff --git a/tests/regression_tests/requested_tracers/marbl_in_no_ciso b/tests/regression_tests/requested_tracers/test.nml similarity index 54% rename from tests/regression_tests/requested_tracers/marbl_in_no_ciso rename to tests/regression_tests/requested_tracers/test.nml index a9d0154c..7e31a781 100644 --- a/tests/regression_tests/requested_tracers/marbl_in_no_ciso +++ b/tests/regression_tests/requested_tracers/test.nml @@ -1,7 +1,3 @@ &marbl_driver_nml testname="request_tracers" / -&marbl_config_nml -/ -&marbl_parms_nml -/ diff --git a/tests/unit_tests/get_put/get_put.py b/tests/unit_tests/get_put/get_put.py index 2b74799a..8880e713 100755 --- a/tests/unit_tests/get_put/get_put.py +++ b/tests/unit_tests/get_put/get_put.py @@ -10,7 +10,7 @@ mt.parse_args(desc='Set all configuration variables and parameters via put ' 'statements and use get statements to ensure they are ' 'correct. Also put different values to make sure nothing ' - 'else changes.', HaveNamelist=False) + 'else changes.', HaveInputFile=False) mt.build_exe() diff --git a/tests/unit_tests/get_put/test.nml b/tests/unit_tests/get_put/test.nml new file mode 100644 index 00000000..1a3d33c6 --- /dev/null +++ b/tests/unit_tests/get_put/test.nml @@ -0,0 +1,4 @@ +&marbl_driver_nml +testname = "get_put" +lhas_inputfile = .false. +/ diff --git a/tests/unit_tests/utils_routines/marbl_utils.py b/tests/unit_tests/utils_routines/marbl_utils.py new file mode 100755 index 00000000..fccf11a3 --- /dev/null +++ b/tests/unit_tests/utils_routines/marbl_utils.py @@ -0,0 +1,15 @@ +#!/usr/bin/env python + +from sys import path + +path.insert(0,'../../python_for_tests') +from marbl_testing_class import MARBL_testcase + +mt = MARBL_testcase() + +mt.parse_args(desc='Unit tests for all the functions / routines in ' + 'marbl_utils_mod.F90', HaveInputFile=False) + +mt.build_exe() + +mt.run_exe() diff --git a/tests/unit_tests/utils_routines/test.nml b/tests/unit_tests/utils_routines/test.nml new file mode 100644 index 00000000..5627d3af --- /dev/null +++ b/tests/unit_tests/utils_routines/test.nml @@ -0,0 +1,4 @@ +&marbl_driver_nml +testname = "marbl_utils" +lhas_inputfile = .false. +/