diff --git a/config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90 b/config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90 new file mode 100644 index 0000000000..5d78e0d501 --- /dev/null +++ b/config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90 @@ -0,0 +1,45 @@ +module FMS_coupler_util + +use coupler_types_mod, only : coupler_2d_bc_type + +implicit none ; private + +public :: extract_coupler_values, set_coupler_values + +contains + +!> Get element and index of a boundary condition +subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, ilb, jlb, & + is, ie, js, je, conversion) + integer, intent(in) :: ilb !< Lower bounds + integer, intent(in) :: jlb !< Lower bounds + real, dimension(ilb:,jlb:),intent(out) :: array_out !< The array being filled with the input values + type(coupler_2d_bc_type), intent(in) :: BC_struc !< The type from which the data is being extracted + integer, intent(in) :: BC_index !< The boundary condition number being extracted + integer, intent(in) :: BC_element !< The element of the boundary condition being extracted + integer, optional, intent(in) :: is !< The i- limits of array_out to be filled + integer, optional, intent(in) :: ie !< The i- limits of array_out to be filled + integer, optional, intent(in) :: js !< The j- limits of array_out to be filled + integer, optional, intent(in) :: je !< The j- limits of array_out to be filled + real, optional, intent(in) :: conversion !< A number that every element is multiplied by + + array_out(:,:) = -1. +end subroutine extract_coupler_values + +!> Set element and index of a boundary condition +subroutine set_coupler_values(array_in, BC_struc, BC_index, BC_element, ilb, jlb,& + is, ie, js, je, conversion) + integer, intent(in) :: ilb !< Lower bounds + integer, intent(in) :: jlb !< Lower bounds + real, dimension(ilb:,jlb:), intent(in) :: array_in !< The array containing the values to load into the BC + type(coupler_2d_bc_type), intent(inout) :: BC_struc !< The type into which the data is being loaded + integer, intent(in) :: BC_index !< The boundary condition number being set + integer, intent(in) :: BC_element !< The element of the boundary condition being set + integer, optional, intent(in) :: is !< The i- limits of array_out to be filled + integer, optional, intent(in) :: ie !< The i- limits of array_out to be filled + integer, optional, intent(in) :: js !< The j- limits of array_out to be filled + integer, optional, intent(in) :: je !< The j- limits of array_out to be filled + real, optional, intent(in) :: conversion !< A number that every element is multiplied by +end subroutine set_coupler_values + +end module FMS_coupler_util diff --git a/config_src/external/GFDL_ocean_BGC/MOM_generic_tracer.F90 b/config_src/external/GFDL_ocean_BGC/MOM_generic_tracer.F90 deleted file mode 100644 index 80d209fa6e..0000000000 --- a/config_src/external/GFDL_ocean_BGC/MOM_generic_tracer.F90 +++ /dev/null @@ -1,294 +0,0 @@ -!> Drives the generic version of tracers TOPAZ and CFC and other GFDL BGC components -module MOM_generic_tracer - -! This file is part of MOM6. See LICENSE.md for the license. - -#include - -! The following macro is usually defined in but since MOM6 should not directly -! include files from FMS we replicate the macro lines here: -#ifdef NO_F2000 -#define _ALLOCATED associated -#else -#define _ALLOCATED allocated -#endif - -! ### These imports should not reach into FMS directly ### - -use MOM_ALE_sponge, only : ALE_sponge_CS -use MOM_coms, only : EFP_type -use MOM_diag_mediator, only : diag_ctrl -use MOM_error_handler, only : MOM_error, FATAL -use MOM_file_parser, only : param_file_type -use MOM_forcing_type, only : forcing, optics_type -use MOM_grid, only : ocean_grid_type -use MOM_hor_index, only : hor_index_type -use MOM_open_boundary, only : ocean_OBC_type -use MOM_restart, only : MOM_restart_CS -use MOM_sponge, only : sponge_CS -use MOM_time_manager, only : time_type -use MOM_tracer_registry, only : tracer_registry_type -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface, thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type - -implicit none ; private - -!> A state hidden in module data that is very much not allowed in MOM6 -! ### This needs to be fixed -logical :: g_registered = .false. - -public register_MOM_generic_tracer, initialize_MOM_generic_tracer -public MOM_generic_tracer_column_physics, MOM_generic_tracer_surface_state -public end_MOM_generic_tracer, MOM_generic_tracer_get -public MOM_generic_tracer_stock -public MOM_generic_flux_init -public MOM_generic_tracer_min_max -public MOM_generic_tracer_fluxes_accumulate -public register_MOM_generic_tracer_segments - -!> Control structure for generic tracers -type, public :: MOM_generic_tracer_CS ; private - character(len = 200) :: IC_file !< The file in which the generic tracer initial values can - !! be found, or an empty string for internal initialization. - logical :: Z_IC_file !< If true, the generic_tracer IC_file is in Z-space. The default is false. - real :: tracer_IC_val = 0.0 !< The initial value assigned to tracers, in - !! concentration units [conc] - real :: tracer_land_val = -1.0 !< The values of tracers used where land is masked out, in - !! concentration units [conc] - logical :: tracers_may_reinit !< If true, tracers may go through the - !! initialization code if they are not found in the restart files. - - type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to - !! regulate the timing of diagnostic output. - type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< Restart control structure - type(ocean_OBC_type), pointer :: OBC => NULL() ! Pointer to the first element of the linked list of generic tracers. - !type(g_tracer_type), pointer :: g_tracer_list => NULL() - -end type MOM_generic_tracer_CS - -contains - -!> Initializes the generic tracer packages and adds their tracers to the list -!! Adds the tracers in the list of generic tracers to the set of MOM tracers (i.e., MOM-register them) -!! Register these tracers for restart -function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) -!subroutine register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI !< Horizontal index ranges - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module - type(tracer_registry_type), pointer :: tr_Reg !< Pointer to the control structure for the tracer - !! advection and diffusion module. - type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct - - logical :: register_MOM_generic_tracer - - register_MOM_generic_tracer = .false. - - call MOM_error(FATAL, "register_MOM_generic_tracer should not be called with the stub code "// & - "in MOM6/config_src/external, as it does nothing. Recompile using the full MOM_generic_tracer package.") - -end function register_MOM_generic_tracer - -!> Register OBC segments for generic tracers -subroutine register_MOM_generic_tracer_segments(CS, GV, OBC, tr_Reg, param_file) - type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether, - !! where, and what open boundary conditions are used. - type(tracer_registry_type), pointer :: tr_Reg !< Pointer to the control structure for the tracer - !! advection and diffusion module. - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - -end subroutine register_MOM_generic_tracer_segments - -!> Initialize phase II: Initialize required variables for generic tracers -!! There are some steps of initialization that cannot be done in register_MOM_generic_tracer -!! This is the place and time to do them: -!! Set the grid mask and initial time for all generic tracers. -!! Diag_register them. -!! Z_diag_register them. -!! -!! This subroutine initializes the NTR tracer fields in tr(:,:,:,:) -!! and it sets up the tracer output. -subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, tv, param_file, diag, OBC, & - CS, sponge_CSp, ALE_sponge_CSp) - logical, intent(in) :: restart !< .true. if the fields have already been - !! read from a restart file. - type(time_type), target, intent(in) :: day !< Time of the start of the run. - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic - !! variables - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(in) :: diag !< Regulates diagnostic output. - type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether, - !! where, and what open boundary conditions are used. - type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. - type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. - type(ALE_sponge_CS), pointer :: ALE_sponge_CSp !< Pointer to the control structure for the - !! ALE sponges. - -end subroutine initialize_MOM_generic_tracer - -!> Column physics for generic tracers. -!! Get the coupler values for generic tracers that exchange with atmosphere -!! Update generic tracer concentration fields from sources and sinks. -!! Vertically diffuse generic tracer concentration fields. -!! Update generic tracers from bottom and their bottom reservoir. -!! -!! This subroutine applies diapycnal diffusion and any other column -!! tracer physics or chemistry to the tracers from this file. -!! CFCs are relatively simple, as they are passive tracers. with only a surface -!! flux as a source. -subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, US, CS, tv, optics, & - evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: ea !< The amount of fluid entrained from the layer - !! above during this call [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: eb !< The amount of fluid entrained from the layer - !! below during this call [H ~> m or kg m-2]. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic - !! and tracer forcing fields. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Hml !< Mixed layer depth [Z ~> m] - real, intent(in) :: dt !< The amount of time covered by this call [T ~> s] - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(optics_type), intent(in) :: optics !< The structure containing optical properties. - real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can - !! be fluxed out of the top layer in a timestep [nondim] - ! Stored previously in diabatic CS. - real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which fluxes - !! can be applied [H ~> m or kg m-2] - ! Stored previously in diabatic CS. - -end subroutine MOM_generic_tracer_column_physics - -!> This subroutine calculates mass-weighted integral on the PE either -!! of all available tracer concentrations, or of a tracer that is -!! being requested specifically, returning the number of stocks it has -!! calculated. If the stock_index is present, only the stock corresponding -!! to that coded index is returned. -function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - type(EFP_type), dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each - !! tracer, in kg times concentration units [kg conc] - type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. - character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. - character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. - integer, optional, intent(in) :: stock_index !< The coded index of a specific stock - !! being sought. - integer :: MOM_generic_tracer_stock !< Return value, the - !! number of stocks calculated here. - - MOM_generic_tracer_stock = 0 - -end function MOM_generic_tracer_stock - -!> This subroutine finds the global min and max of either of all available -!! tracer concentrations, or of a tracer that is being requested specifically, -!! returning the number of tracers it has evaluated. -!! It also optionally returns the locations of the extrema. -function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, G, CS, names, units, & - xgmin, ygmin, zgmin, xgmax, ygmax, zgmax) - integer, intent(in) :: ind_start !< The index of the tracer to start with - logical, dimension(:), intent(out) :: got_minmax !< Indicates whether the global min and - !! max are found for each tracer - real, dimension(:), intent(out) :: gmin !< Global minimum of each tracer [conc] - real, dimension(:), intent(out) :: gmax !< Global maximum of each tracer [conc] - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. - character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. - character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. - real, dimension(:), optional, intent(out) :: xgmin !< The x-position of the global minimum in the - !! units of G%geoLonT, often [degrees_E] or [km] or [m] - real, dimension(:), optional, intent(out) :: ygmin !< The y-position of the global minimum in the - !! units of G%geoLatT, often [degrees_N] or [km] or [m] - real, dimension(:), optional, intent(out) :: zgmin !< The z-position of the global minimum [layer] - real, dimension(:), optional, intent(out) :: xgmax !< The x-position of the global maximum in the - !! units of G%geoLonT, often [degrees_E] or [km] or [m] - real, dimension(:), optional, intent(out) :: ygmax !< The y-position of the global maximum in the - !! units of G%geoLatT, often [degrees_N] or [km] or [m] - real, dimension(:), optional, intent(out) :: zgmax !< The z-position of the global maximum [layer] - integer :: MOM_generic_tracer_min_max !< Return value, the - !! number of tracers done here. - - MOM_generic_tracer_min_max = 0 - -end function MOM_generic_tracer_min_max - -!> This subroutine calculates the surface state and sets coupler values for -!! those generic tracers that have flux exchange with atmosphere. -!! -!! This subroutine sets up the fields that the coupler needs to calculate the -!! CFC fluxes between the ocean and atmosphere. -subroutine MOM_generic_tracer_surface_state(sfc_state, h, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. - -end subroutine MOM_generic_tracer_surface_state - -!ALL PE subroutine on Ocean! Due to otpm design the fluxes should be initialized like this on ALL PE's! -subroutine MOM_generic_flux_init(verbosity) - integer, optional, intent(in) :: verbosity !< A 0-9 integer indicating a level of verbosity. - -end subroutine MOM_generic_flux_init - -subroutine MOM_generic_tracer_fluxes_accumulate(flux_tmp, weight) - type(forcing), intent(in) :: flux_tmp !< A structure containing pointers to - !! thermodynamic and tracer forcing fields. - real, intent(in) :: weight !< A weight for accumulating this flux [nondim] - -end subroutine MOM_generic_tracer_fluxes_accumulate - -!> Copy the requested tracer into an array. -subroutine MOM_generic_tracer_get(name,member,array, CS) - character(len=*), intent(in) :: name !< Name of requested tracer. - character(len=*), intent(in) :: member !< The tracer element to return. - real, dimension(:,:,:), intent(out) :: array !< Array filled by this routine, in arbitrary units [A] - type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. - - ! Local variables - real, dimension(:,:,:), pointer :: array_ptr ! The tracer in the generic tracer structures, in - ! arbitrary units [A] - character(len=128), parameter :: sub_name = 'MOM_generic_tracer_get' - -end subroutine MOM_generic_tracer_get - -!> This subroutine deallocates the memory owned by this module. -subroutine end_MOM_generic_tracer(CS) - type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. - -end subroutine end_MOM_generic_tracer - -!---------------------------------------------------------------- -! Niki Zadeh -! -! -! William Cooke -! -! -! -! This module drives the generic version of tracers TOPAZ and CFC -! -!---------------------------------------------------------------- - -end module MOM_generic_tracer diff --git a/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 b/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 new file mode 100644 index 0000000000..90e7d795ff --- /dev/null +++ b/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 @@ -0,0 +1,158 @@ +!> A non-functioning template of the GFDL ocean BGC +module generic_tracer + + use time_manager_mod, only : time_type + use coupler_types_mod, only : coupler_2d_bc_type + + use g_tracer_utils, only : g_tracer_type, g_diag_type + + implicit none ; private + + public generic_tracer_register + public generic_tracer_init + public generic_tracer_register_diag + public generic_tracer_source + public generic_tracer_update_from_bottom + public generic_tracer_coupler_get + public generic_tracer_coupler_set + public generic_tracer_end + public generic_tracer_get_list + public do_generic_tracer + public generic_tracer_vertdiff_G + public generic_tracer_get_diag_list + public generic_tracer_coupler_accumulate + public generic_tracer_update_from_coupler + + !> Turn on generic tracers (note dangerous use of module data) + logical :: do_generic_tracer = .true. + +contains + + !> Unknown + subroutine generic_tracer_register + end subroutine generic_tracer_register + + !> Initialize generic tracers + subroutine generic_tracer_init(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes,grid_tmask,grid_kmt,init_time) + integer, intent(in) :: isc !< Computation start index in i direction + integer, intent(in) :: iec !< Computation end index in i direction + integer, intent(in) :: jsc !< Computation start index in j direction + integer, intent(in) :: jec !< Computation end index in j direction + integer, intent(in) :: isd !< Data start index in i direction + integer, intent(in) :: ied !< Data end index in i direction + integer, intent(in) :: jsd !< Data start index in j direction + integer, intent(in) :: jed !< Data end index in j direction + integer, intent(in) :: nk !< Number of levels in k direction + integer, intent(in) :: ntau !< The number of tracer time levels (always 1 for MOM6) + integer, intent(in) :: axes(3) !< Domain axes? + type(time_type), intent(in) :: init_time !< Time + real, dimension(:,:,:),target, intent(in) :: grid_tmask !< Mask + integer, dimension(:,:) , intent(in) :: grid_kmt !< Number of wet cells in column + end subroutine generic_tracer_init + + !> Unknown + subroutine generic_tracer_register_diag + end subroutine generic_tracer_register_diag + + !> Get coupler values + subroutine generic_tracer_coupler_get(IOB_struc) + type(coupler_2d_bc_type), intent(in) :: IOB_struc !< Ice Ocean Boundary flux structure + end subroutine generic_tracer_coupler_get + + !> Unknown + subroutine generic_tracer_coupler_accumulate(IOB_struc, weight, model_time) + type(coupler_2d_bc_type), intent(in) :: IOB_struc !< Ice Ocean Boundary flux structure + real, intent(in) :: weight !< A weight for accumulating these fluxes + type(time_type), optional,intent(in) :: model_time !< Time + end subroutine generic_tracer_coupler_accumulate + + !> Modify the values obtained from the coupler + subroutine generic_tracer_update_from_coupler(ilb, jlb, salt_flux_added) + integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain + integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain + real, dimension(ilb:,jlb:), intent(in) :: salt_flux_added !< Surface salt flux into ocean from restoring + !! or flux adjustment [g/m^2/sec] + end subroutine generic_tracer_update_from_coupler + + !> Calls the corresponding generic_X_update_from_source routine for each package X + subroutine generic_tracer_source(Temp,Salt,rho_dzt,dzt,hblt_depth,ilb,jlb,tau,dtts,& + grid_dat,model_time,nbands,max_wavelength_band,sw_pen_band,opacity_band,internal_heat,& + frunoff,grid_ht, current_wave_stress, sosga) + integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain + integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain + real, dimension(ilb:,jlb:,:), intent(in) :: Temp !< Potential temperature [deg C] + real, dimension(ilb:,jlb:,:), intent(in) :: Salt !< Salinity [psu] + real, dimension(ilb:,jlb:,:), intent(in) :: rho_dzt !< Mass per unit area of each layer [kg m-2] + real, dimension(ilb:,jlb:,:), intent(in) :: dzt !< Ocean layer thickness [m] + real, dimension(ilb:,jlb:), intent(in) :: hblt_depth !< Boundary layer depth [m] + integer, intent(in) :: tau !< Time step index of %field + real, intent(in) :: dtts !< The time step for this call [s] + real, dimension(ilb:,jlb:), intent(in) :: grid_dat !< Grid cell areas [m2] + type(time_type), intent(in) :: model_time !< Time + integer, intent(in) :: nbands !< The number of bands of penetrating shortwave radiation + real, dimension(:), intent(in) :: max_wavelength_band !< The maximum wavelength in each band + !! of penetrating shortwave radiation [nm] + real, dimension(:,ilb:,jlb:), intent(in) :: sw_pen_band !< Penetrating shortwave radiation per band [W m-2]. + !! The wavelength or angular direction band is the first index. + real, dimension(:,ilb:,jlb:,:), intent(in) :: opacity_band !< Opacity of seawater averaged over each band [m-1]. + !! The wavelength or angular direction band is the first index. + real, dimension(ilb:,jlb:),optional, intent(in) :: internal_heat !< Any internal or geothermal heat + !! sources that are applied to the ocean integrated + !! over this timestep [degC kg m-2] + real, dimension(ilb:,jlb:),optional, intent(in) :: frunoff !< Rate of iceberg calving [kg m-2 s-1] + real, dimension(ilb:,jlb:),optional, intent(in) :: grid_ht !< Unknown, and presently unused by MOM6 + real, dimension(ilb:,jlb:),optional , intent(in) :: current_wave_stress !< Unknown, and presently unused by MOM6 + real, optional , intent(in) :: sosga !< Global average sea surface salinity [ppt] + end subroutine generic_tracer_source + + !> Update the tracers from bottom fluxes + subroutine generic_tracer_update_from_bottom(dt, tau, model_time) + real, intent(in) :: dt !< Time step increment [s] + integer, intent(in) :: tau !< Time step index used for the concentration field + type(time_type), intent(in) :: model_time !< Time + end subroutine generic_tracer_update_from_bottom + + !> Vertically diffuse all generic tracers for GOLD ocean + subroutine generic_tracer_vertdiff_G(h_old, ea, eb, dt, kg_m2_to_H, m_to_H, tau) + real, dimension(:,:,:), intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2] + real, dimension(:,:,:), intent(in) :: ea !< The amount of fluid entrained from the layer + !! above during this call [H ~> m or kg m-2] + real, dimension(:,:,:), intent(in) :: eb !< The amount of fluid entrained from the layer + !! below during this call [H ~> m or kg m-2] + real, intent(in) :: dt !< The amount of time covered by this call [s] + real, intent(in) :: kg_m2_to_H !< A unit conversion factor from mass per unit + !! area to thickness units [H m2 kg-1 ~> m3 kg-1 or 1] + real, intent(in) :: m_to_H !< A unit conversion factor from heights to + !! thickness units [H m-1 ~> 1 or kg m-3] + integer, intent(in) :: tau !< The time level to work on (always 1 for MOM6) + end subroutine generic_tracer_vertdiff_G + + !> Set the coupler values for each generic tracer + subroutine generic_tracer_coupler_set(IOB_struc, ST,SS,rho,ilb,jlb,tau, dzt, sosga,model_time) + type(coupler_2d_bc_type), intent(inout) :: IOB_struc !< Ice Ocean Boundary flux structure + integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain + integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain + integer, intent(in) :: tau !< Time step index of %field + real, dimension(ilb:,jlb:), intent(in) :: ST !< Sea surface temperature [degC] + real, dimension(ilb:,jlb:), intent(in) :: SS !< Sea surface salinity [ppt] + real, dimension(ilb:,jlb:,:,:), intent(in) :: rho !< Ocean density [kg m-3] + real, dimension(ilb:,jlb:,:), optional, intent(in) :: dzt !< Layer thickness [m] + real, optional, intent(in) :: sosga !< Global mean sea surface salinity [ppt] + type(time_type),optional, intent(in) :: model_time !< Time + end subroutine generic_tracer_coupler_set + + !> End this module by calling the corresponding generic_X_end for each package X + subroutine generic_tracer_end + end subroutine generic_tracer_end + + !> Get a pointer to the head of the generic tracers list + subroutine generic_tracer_get_list(list) + type(g_tracer_type), pointer :: list !< Pointer to head of the linked list + end subroutine generic_tracer_get_list + + !> Unknown + subroutine generic_tracer_get_diag_list(list) + type(g_diag_type), pointer :: list !< Pointer to head of the linked list + end subroutine generic_tracer_get_diag_list + +end module generic_tracer diff --git a/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 b/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 new file mode 100644 index 0000000000..5c87c37e70 --- /dev/null +++ b/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 @@ -0,0 +1,355 @@ +!> g_tracer_utils module consists of core utility subroutines to be used by +!! all generic tracer modules. These include the lowest level functions +!! for adding, allocating memory, and record keeping of individual generic +!! tracers irrespective of their physical/chemical nature. +module g_tracer_utils + + use coupler_types_mod, only: coupler_2d_bc_type + use time_manager_mod, only : time_type + use field_manager_mod, only: fm_string_len + use MOM_diag_mediator, only : g_diag_ctrl=>diag_ctrl + +implicit none ; private + + !> Each generic tracer node is an instant of a FORTRAN type with the following member variables. + !! These member fields are supposed to uniquely define an individual tracer. + !! One such type shall be instantiated for EACH individual tracer. + type g_tracer_type + !> Tracer concentration field in space (and time) + !! MOM keeps the prognostic tracer fields at 3 time levels, hence 4D. + real, pointer, dimension(:,:,:,:) :: field => NULL() + !> Tracer concentration in river runoff + real, allocatable, dimension(:,:) :: trunoff + logical :: requires_restart = .true. !< Unknown + character(len=fm_string_len) :: src_file !< Tracer source filename + character(len=fm_string_len) :: src_var_name !< Tracer source variable name + character(len=fm_string_len) :: src_var_unit !< Tracer source variable units + character(len=fm_string_len) :: src_var_gridspec !< Tracer source grid file name + character(len=fm_string_len) :: obc_src_file_name !< Boundary condition tracer source filename + character(len=fm_string_len) :: obc_src_field_name !< Boundary condition tracer source fieldname + integer :: src_var_record !< Unknown + logical :: runoff_added_to_stf = .false. !< Has flux in from runoff been added to stf? + logical :: requires_src_info = .false. !< Unknown + real :: src_var_unit_conversion = 1.0 !< This factor depends on the tracer. Ask Jasmin + real :: src_var_valid_min = 0.0 !< Unknown + end type g_tracer_type + + !> Unknown + type g_diag_type + integer :: dummy !< A dummy member, not part of the API + end type g_diag_type + + !> The following type fields are common to ALL generic tracers and hence has to be instantiated only once + type g_tracer_common +! type(g_diag_ctrl) :: diag_CS !< Unknown + !> Domain extents + integer :: isd !< Start index of the data domain in the i-direction + integer :: jsd !< Start index of the data domain in the j-direction + end type g_tracer_common + + !> Unknown dangerous module data! + type(g_tracer_common), target, save :: g_tracer_com + + public :: g_tracer_type + public :: g_tracer_flux_init + public :: g_tracer_set_values + public :: g_tracer_get_values + public :: g_tracer_get_pointer + public :: g_tracer_get_common + public :: g_tracer_set_common + public :: g_tracer_set_csdiag + public :: g_tracer_send_diag + public :: g_tracer_get_name + public :: g_tracer_get_alias + public :: g_tracer_get_next + public :: g_tracer_is_prog + public :: g_diag_type + public :: g_tracer_get_obc_segment_props + + !> Set the values of various (array) members of the tracer node g_tracer_type + !! + !! This function is overloaded to set the values of the following member variables + interface g_tracer_set_values + module procedure g_tracer_set_real + module procedure g_tracer_set_2D + module procedure g_tracer_set_3D + module procedure g_tracer_set_4D + end interface + + !> Reverse of interface g_tracer_set_values for getting the tracer member arrays in the argument value + !! + !! This means "get the values of array %field_name for tracer tracer_name and put them in argument array_out" + interface g_tracer_get_values + module procedure g_tracer_get_4D_val + module procedure g_tracer_get_3D_val + module procedure g_tracer_get_2D_val + module procedure g_tracer_get_real + module procedure g_tracer_get_string + end interface + + !> Return the pointer to the requested field of a particular tracer + !! + !! This means "get the pointer of array %field_name for tracer tracer_name in argument array_ptr" + interface g_tracer_get_pointer + module procedure g_tracer_get_4D + module procedure g_tracer_get_3D + module procedure g_tracer_get_2D + end interface + +contains + + !> Unknown + subroutine g_tracer_flux_init(g_tracer, verbosity) + type(g_tracer_type), pointer :: g_tracer !< Pointer to this tracer node + integer, optional, intent(in) :: verbosity !< A 0-9 integer indicating a level of verbosity + end subroutine g_tracer_flux_init + + !> Unknown + subroutine g_tracer_set_csdiag(diag_CS) + type(g_diag_ctrl), target,intent(in) :: diag_CS !< Unknown + end subroutine g_tracer_set_csdiag + + subroutine g_tracer_set_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes,grid_tmask,grid_kmt,init_time) + integer, intent(in) :: isc !< Computation start index in i direction + integer, intent(in) :: iec !< Computation end index in i direction + integer, intent(in) :: jsc !< Computation start index in j direction + integer, intent(in) :: jec !< Computation end index in j direction + integer, intent(in) :: isd !< Data start index in i direction + integer, intent(in) :: ied !< Data end index in i direction + integer, intent(in) :: jsd !< Data start index in j direction + integer, intent(in) :: jed !< Data end index in j direction + integer, intent(in) :: nk !< Number of levels in k direction + integer, intent(in) :: ntau !< Unknown + integer, intent(in) :: axes(3) !< Domain axes? + real, dimension(isd:,jsd:,:),intent(in) :: grid_tmask !< Unknown + integer,dimension(isd:,jsd:),intent(in) :: grid_kmt !< Unknown + type(time_type), intent(in) :: init_time !< Unknown + end subroutine g_tracer_set_common + + subroutine g_tracer_get_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,& + axes,grid_tmask,grid_mask_coast,grid_kmt,init_time,diag_CS) + integer, intent(out) :: isc !< Computation start index in i direction + integer, intent(out) :: iec !< Computation end index in i direction + integer, intent(out) :: jsc !< Computation start index in j direction + integer, intent(out) :: jec !< Computation end index in j direction + integer, intent(out) :: isd !< Data start index in i direction + integer, intent(out) :: ied !< Data end index in i direction + integer, intent(out) :: jsd !< Data start index in j direction + integer, intent(out) :: jed !< Data end index in j direction + integer, intent(out) :: nk !< Number of levels in k direction + integer, intent(out) :: ntau !< Unknown + integer, optional, intent(out) :: axes(3) !< Unknown + type(time_type), optional, intent(out) :: init_time !< Unknown + real, optional, dimension(:,:,:), pointer :: grid_tmask !< Unknown + integer, optional, dimension(:,:), pointer :: grid_mask_coast !< Unknown + integer, optional, dimension(:,:), pointer :: grid_kmt !< Unknown + type(g_diag_ctrl), optional, pointer :: diag_CS !< Unknown + + isc = -1 + iec = -1 + jsc = -1 + jec = -1 + isd = -1 + ied = -1 + jsd = -1 + jed = -1 + nk = -1 + ntau = -1 + end subroutine g_tracer_get_common + + !> Unknown + subroutine g_tracer_get_4D(g_tracer_list,name,member,array_ptr) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list !< Unknown + real, dimension(:,:,:,:), pointer :: array_ptr !< Unknown + end subroutine g_tracer_get_4D + + !> Unknown + subroutine g_tracer_get_3D(g_tracer_list,name,member,array_ptr) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list !< Unknown + real, dimension(:,:,:), pointer :: array_ptr !< Unknown + end subroutine g_tracer_get_3D + + !> Unknown + subroutine g_tracer_get_2D(g_tracer_list,name,member,array_ptr) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list !< Unknown + real, dimension(:,:), pointer :: array_ptr !< Unknown + end subroutine g_tracer_get_2D + + !> Unknown + subroutine g_tracer_get_4D_val(g_tracer_list,name,member,array,isd,jsd) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list !< Unknown + integer, intent(in) :: isd !< Unknown + integer, intent(in) :: jsd !< Unknown + real, dimension(isd:,jsd:,:,:), intent(out):: array !< Unknown + + array(:,:,:,:) = -1. + end subroutine g_tracer_get_4D_val + + !> Unknown + subroutine g_tracer_get_3D_val(g_tracer_list,name,member,array,isd,jsd,ntau,positive) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list !< Unknown + integer, intent(in) :: isd !< Unknown + integer, intent(in) :: jsd !< Unknown + integer, optional, intent(in) :: ntau !< Unknown + logical, optional, intent(in) :: positive !< Unknown + real, dimension(isd:,jsd:,:), intent(out):: array !< Unknown + character(len=fm_string_len), parameter :: sub_name = 'g_tracer_get_3D_val' + + array(:,:,:) = -1. + end subroutine g_tracer_get_3D_val + + !> Unknown + subroutine g_tracer_get_2D_val(g_tracer_list,name,member,array,isd,jsd) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list !< Unknown + integer, intent(in) :: isd !< Unknown + integer, intent(in) :: jsd !< Unknown + real, dimension(isd:,jsd:), intent(out):: array !< Unknown + + array(:,:) = -1. + end subroutine g_tracer_get_2D_val + + !> Unknown + subroutine g_tracer_get_real(g_tracer_list,name,member,value) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list !< Unknown + real, intent(out):: value !< Unknown + + value = -1 + end subroutine g_tracer_get_real + + !> Unknown + subroutine g_tracer_get_string(g_tracer_list,name,member,string) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list !< Unknown + character(len=fm_string_len), intent(out) :: string !< Unknown + + string = "" + end subroutine g_tracer_get_string + + !> Unknown + subroutine g_tracer_set_2D(g_tracer_list,name,member,array,isd,jsd,weight) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list !< Unknown + integer, intent(in) :: isd !< Unknown + integer, intent(in) :: jsd !< Unknown + real, dimension(isd:,jsd:),intent(in) :: array !< Unknown + real, optional ,intent(in) :: weight !< Unknown + end subroutine g_tracer_set_2D + + !> Unknown + subroutine g_tracer_set_3D(g_tracer_list,name,member,array,isd,jsd,ntau) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list !< Unknown + integer, intent(in) :: isd !< Unknown + integer, intent(in) :: jsd !< Unknown + integer, optional, intent(in) :: ntau !< Unknown + real, dimension(isd:,jsd:,:), intent(in) :: array !< Unknown + end subroutine g_tracer_set_3D + + !> Unknown + subroutine g_tracer_set_4D(g_tracer_list,name,member,array,isd,jsd) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list !< Unknown + integer, intent(in) :: isd !< Unknown + integer, intent(in) :: jsd !< Unknown + real, dimension(isd:,jsd:,:,:), intent(in) :: array !< Unknown + end subroutine g_tracer_set_4D + + !> Unknown + subroutine g_tracer_set_real(g_tracer_list,name,member,value) + character(len=*), intent(in) :: name !< Unknown + character(len=*), intent(in) :: member !< Unknown + type(g_tracer_type), pointer :: g_tracer_list !< Unknown + real, intent(in) :: value !< Unknown + end subroutine g_tracer_set_real + + subroutine g_tracer_send_diag(g_tracer_list,model_time,tau) + type(g_tracer_type), pointer :: g_tracer_list !< pointer to the head of the generic tracer list + type(time_type), intent(in) :: model_time !< Time + integer, intent(in) :: tau !< The time step for the %field 4D field to be reported + end subroutine g_tracer_send_diag + + !> Unknown + subroutine g_tracer_get_name(g_tracer,string) + type(g_tracer_type), pointer :: g_tracer !< Unknown + character(len=*), intent(out) :: string !< Unknown + + string = "" + end subroutine g_tracer_get_name + + !> Unknown + subroutine g_tracer_get_alias(g_tracer,string) + type(g_tracer_type), pointer :: g_tracer !< Unknown + character(len=*), intent(out) :: string !< Unknown + + string = "" + end subroutine g_tracer_get_alias + + !> Is the tracer prognostic? + function g_tracer_is_prog(g_tracer) + logical :: g_tracer_is_prog + type(g_tracer_type), pointer :: g_tracer !< Pointer to tracer node + + g_tracer_is_prog = .false. + end function g_tracer_is_prog + + !> get the next tracer in the list + subroutine g_tracer_get_next(g_tracer,g_tracer_next) + type(g_tracer_type), pointer :: g_tracer !< Pointer to tracer node + type(g_tracer_type), pointer :: g_tracer_next !< Pointer to the next tracer node in the list + end subroutine g_tracer_get_next + + !> get obc segment properties for each tracer + subroutine g_tracer_get_obc_segment_props(g_tracer_list, name, obc_has, src_file, src_var_name,lfac_in,lfac_out) + type(g_tracer_type), pointer :: g_tracer_list !< pointer to the head of the generic tracer list + character(len=*), intent(in) :: name !< tracer name + logical, intent(out):: obc_has !< .true. if This tracer has OBC + real, optional,intent(out):: lfac_in !< OBC reservoir inverse lengthscale factor + real, optional,intent(out):: lfac_out !< OBC reservoir inverse lengthscale factor + character(len=*),optional,intent(out):: src_file !< OBC source file + character(len=*),optional,intent(out):: src_var_name !< OBC source variable in file + + obc_has = .false. + end subroutine g_tracer_get_obc_segment_props + + !>Vertical Diffusion of a tracer node + !! + !! This subroutine solves a tridiagonal equation to find and set values of vertically diffused field + !! for a tracer node.This is ported from GOLD (vertdiff) and simplified + !! Since the surface flux from the atmosphere (%stf) has the units of mol/m^2/sec the resulting + !! tracer concentration has units of mol/Kg + subroutine g_tracer_vertdiff_G(g_tracer, h_old, ea, eb, dt, kg_m2_to_H, m_to_H, tau, mom) + type(g_tracer_type), pointer :: g_tracer !< Unknown + !> Layer thickness before entrainment, in m or kg m-2. + real, dimension(g_tracer_com%isd:,g_tracer_com%jsd:,:), intent(in) :: h_old + !> The amount of fluid entrained from the layer above, in H. + real, dimension(g_tracer_com%isd:,g_tracer_com%jsd:,:), intent(in) :: ea + !> The amount of fluid entrained from the layer below, in H. + real, dimension(g_tracer_com%isd:,g_tracer_com%jsd:,:), intent(in) :: eb + real, intent(in) :: dt !< The amount of time covered by this call, in s. + real, intent(in) :: kg_m2_to_H !< A conversion factor that translates kg m-2 into + !! the units of h_old (H) + real, intent(in) :: m_to_H !< A conversion factor that translates m into the units + !! of h_old (H). + integer, intent(in) :: tau !< Unknown + logical, intent(in), optional :: mom !< Unknown + end subroutine g_tracer_vertdiff_G + +end module g_tracer_utils