From 4af91db7215e07fbf6c537fd298ad66a72da0f14 Mon Sep 17 00:00:00 2001
From: Yi-Cheng Teng - NOAA GFDL
<143743249+yichengt900@users.noreply.github.com>
Date: Fri, 26 Jan 2024 14:28:37 -0500
Subject: [PATCH] Simplify changes to the generic tracer interface for
cobalt-p4: ocean_BGC side (#8)
* mod g_tracer_interface
* mod tracer interface
* Simplify g_tracer interface changes
* remove unused descriptions
* tmp changes in cobalt_ci.yml to pass ci test
* add optional for geolat and eqn_of_state
* Change branch back to dev/cefi
---
.github/workflows/cobalt_ci.yml | 5 +-
generic_tracers/generic_COBALT.F90 | 35 +-
generic_tracers/generic_tracer.F90 | 32 +-
generic_tracers/generic_tracer_utils.F90 | 20 +-
patch/MOM6/src/tracer/MOM_generic_tracer.F90 | 1024 -----------------
.../src/tracer/MOM_tracer_flow_control.F90 | 893 --------------
6 files changed, 44 insertions(+), 1965 deletions(-)
delete mode 100644 patch/MOM6/src/tracer/MOM_generic_tracer.F90
delete mode 100644 patch/MOM6/src/tracer/MOM_tracer_flow_control.F90
diff --git a/.github/workflows/cobalt_ci.yml b/.github/workflows/cobalt_ci.yml
index c0b714c..3b26b82 100644
--- a/.github/workflows/cobalt_ci.yml
+++ b/.github/workflows/cobalt_ci.yml
@@ -13,6 +13,9 @@ on:
# Allows you to run this workflow manually from the Actions tab
workflow_dispatch:
+env:
+ BRANCH_NAME: dev/cefi
+
# A workflow run is made up of one or more jobs that can run sequentially or in parallel
jobs:
# This workflow contains a single job called "build"
@@ -46,7 +49,7 @@ jobs:
- name: git clone MOM6_OBGC_examples and build mom6sis2-cobalt
run: |
cd ..
- git clone https://github.com/NOAA-CEFI-Regional-Ocean-Modeling/MOM6_OBGC_examples.git --recursive
+ git clone -b $BRANCH_NAME https://github.com/NOAA-CEFI-Regional-Ocean-Modeling/MOM6_OBGC_examples.git --recursive
rm -rf MOM6_OBGC_examples/src/ocean_BGC
cp -r ocean_BGC MOM6_OBGC_examples/src
cd MOM6_OBGC_examples/builds
diff --git a/generic_tracers/generic_COBALT.F90 b/generic_tracers/generic_COBALT.F90
index e3d578e..b6bba8f 100644
--- a/generic_tracers/generic_COBALT.F90
+++ b/generic_tracers/generic_COBALT.F90
@@ -144,8 +144,7 @@ module generic_COBALT
#ifndef INTERNAL_FILE_NML
use fms_mod, only: open_namelist_file, close_file
#endif
- use MOM_EOS, only: calculate_density
- use MOM_variables, only: thermo_var_ptrs
+ use MOM_EOS, only: calculate_density, EOS_type
use g_tracer_utils, only : g_tracer_type,g_tracer_start_param_list,g_tracer_end_param_list
use g_tracer_utils, only : g_tracer_add,g_tracer_add_param, g_tracer_set_files
@@ -7853,13 +7852,12 @@ end subroutine generic_COBALT_update_from_bottom
!subroutine generic_COBALT_update_from_source(tracer_list,Temp,Salt,rho_dzt,dzt,hblt_depth,&
! ilb,jlb,tau,dt,grid_dat,model_time,nbands,max_wavelength_band,sw_pen_band,opacity_band,internal_heat,frunoff)
! If you'd like to pass the thermodynamic variables for a mld calculation
- subroutine generic_COBALT_update_from_source(tracer_list,Temp,Salt,tv,rho_dzt,dzt,hblt_depth,&
- ilb,jlb,tau,dt,grid_dat,model_time,nbands,max_wavelength_band,sw_pen_band,opacity_band,internal_heat,frunoff)
+ subroutine generic_COBALT_update_from_source(tracer_list,Temp,Salt,rho_dzt,dzt,hblt_depth,&
+ ilb,jlb,tau,dt,grid_dat,model_time,nbands,max_wavelength_band,sw_pen_band,opacity_band,internal_heat,frunoff,geolat,eqn_of_state)
!subroutine generic_COBALT_update_from_source(tracer_list,Temp,Salt,rho_dzt,dzt,hblt_depth,&
! ilb,jlb,tau,dt,grid_dat,model_time,nbands,max_wavelength_band,sw_pen_band,opacity_band,internal_heat,frunoff)
type(g_tracer_type), pointer :: tracer_list
- type(thermo_var_ptrs), intent(in) :: tv
real, dimension(ilb:,jlb:,:), intent(in) :: Temp,Salt,rho_dzt,dzt
real, dimension(ilb:,jlb:), intent(in) :: hblt_depth
integer, intent(in) :: ilb,jlb,tau
@@ -7873,11 +7871,12 @@ subroutine generic_COBALT_update_from_source(tracer_list,Temp,Salt,tv,rho_dzt,dz
real, dimension(:,ilb:,jlb:,:), intent(in) :: opacity_band
real, dimension(ilb:,jlb:), intent(in) :: internal_heat
real, dimension(ilb:,jlb:), intent(in) :: frunoff
+ real, dimension(ilb:,jlb:), optional, intent(in) :: geolat
+ type(EOS_type), optional, intent(in) :: eqn_of_state !< Equation of state structure
character(len=fm_string_len), parameter :: sub_name = 'generic_COBALT_update_from_source'
integer :: isc,iec, jsc,jec,isd,ied,jsd,jed,nk,ntau, i, j, k , m, n, k_100, k_200, kbot
real, dimension(:,:,:) ,pointer :: grid_tmask
- real, dimension(:,:), pointer :: geolon,geolat
integer, dimension(:,:),pointer :: mask_coast,grid_kmt
!
!------------------------------------------------------------------------
@@ -7952,8 +7951,7 @@ subroutine generic_COBALT_update_from_source(tracer_list,Temp,Salt,tv,rho_dzt,dz
r_dt = 1.0 / dt
call g_tracer_get_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,&
- grid_tmask=grid_tmask,grid_mask_coast=mask_coast,grid_kmt=grid_kmt,&
- geolon=geolon,geolat=geolat)
+ grid_tmask=grid_tmask,grid_mask_coast=mask_coast,grid_kmt=grid_kmt)
call mpp_clock_begin(id_clock_carbon_calculations)
!Get necessary fields
@@ -8317,7 +8315,7 @@ subroutine generic_COBALT_update_from_source(tracer_list,Temp,Salt,tv,rho_dzt,dz
! calculate the mld for the photoacclimation calculations
- call calculate_density(Temp(i,j,kmld_ref),Salt(i,j,kmld_ref),101325.0,rho_mld_ref,tv%eqn_of_state)
+ call calculate_density(Temp(i,j,kmld_ref),Salt(i,j,kmld_ref),101325.0,rho_mld_ref,eqn_of_state)
!if ((i.eq.isc).and.(j.eq.jsc)) then
! write(outunit,*) 'rho_mld_ref = ',rho_mld_ref
!endif
@@ -8332,7 +8330,7 @@ subroutine generic_COBALT_update_from_source(tracer_list,Temp,Salt,tv,rho_dzt,dz
deltaRhoAtKm1 = deltaRhoAtK
dKm1 = dK
dK = cobalt%mld_aclm(i,j) + 0.5*dzt(i,j,k)
- call calculate_density(Temp(i,j,k),Salt(i,j,k),101325.0,rho_k,tv%eqn_of_state)
+ call calculate_density(Temp(i,j,k),Salt(i,j,k),101325.0,rho_k,eqn_of_state)
cobalt%rho_test(i,j,k) = rho_k
deltaRhoAtK = rho_k - rho_mld_ref
if (deltaRhoAtK.lt.cobalt%densdiff_mld) then
@@ -8341,14 +8339,15 @@ subroutine generic_COBALT_update_from_source(tracer_list,Temp,Salt,tv,rho_dzt,dz
afac = (cobalt%densdiff_mld - deltaRhoAtKm1)/(deltaRhoAtK - deltaRhoAtKm1)
cobalt%mld_aclm(i,j) = afac*dK + (1.0-afac)*dKm1
deltaRhoFlag = 1.0
- !if ((i.eq.isc).and.(j.eq.jsc)) then
- ! write(outunit,*) 'lat,lon=',geolat,geolon
- ! write(outunit,*) 'kmld_ref, k = ',kmld_ref, k
- ! write(outunit,*) 'rho_mld_ref = ',rho_mld_ref
- ! write(outunit,*) 'rho_k = ',rho_k
- ! write(outunit,*) 'deltaRhoAtK = ',deltaRhoAtK
- ! write(outunit,*) 'mld_aclm = ',cobalt%mld_aclm(i,j)
- !endif
+! if ((i.eq.isc).and.(j.eq.jsc)) then
+! write(outunit,*) 'i,j=',i,j
+! write(outunit,*) 'lat,lon=',geolat(i,j)
+! write(outunit,*) 'kmld_ref, k = ',kmld_ref, k
+! write(outunit,*) 'rho_mld_ref = ',rho_mld_ref
+! write(outunit,*) 'rho_k = ',rho_k
+! write(outunit,*) 'deltaRhoAtK = ',deltaRhoAtK
+! write(outunit,*) 'mld_aclm = ',cobalt%mld_aclm(i,j)
+! endif
endif
enddo !} k
diff --git a/generic_tracers/generic_tracer.F90 b/generic_tracers/generic_tracer.F90
index f39b72d..e4ec7ae 100644
--- a/generic_tracers/generic_tracer.F90
+++ b/generic_tracers/generic_tracer.F90
@@ -103,9 +103,9 @@ module generic_tracer
use generic_COBALT, only : generic_COBALT_init, generic_COBALT_update_from_source,generic_COBALT_register_diag
use generic_COBALT, only : generic_COBALT_update_from_bottom,generic_COBALT_update_from_coupler
use generic_COBALT, only : generic_COBALT_set_boundary_values, generic_COBALT_end, do_generic_COBALT
- use generic_COBALT, only : as_param_cobalt
+ use generic_COBALT, only : as_param_cobalt
- use MOM_variables, only : thermo_var_ptrs
+ use MOM_EOS, only: EOS_type
implicit none ; private
@@ -248,17 +248,16 @@ end subroutine generic_tracer_register
! Grid mask
!
!
- subroutine generic_tracer_init(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes,grid_tmask,grid_kmt,init_time,geolon,geolat)
+ 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,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes(3)
type(time_type), intent(in) :: init_time
real, dimension(:,:,:),target, intent(in) :: grid_tmask
integer, dimension(:,:) , intent(in) :: grid_kmt
- real, dimension(:,:),target, intent(in) :: geolon,geolat
type(g_tracer_type), pointer :: g_tracer,g_tracer_next
character(len=fm_string_len), parameter :: sub_name = 'generic_tracer_init'
- call g_tracer_set_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes,grid_tmask,grid_kmt,init_time,geolon,geolat)
+ call g_tracer_set_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes,grid_tmask,grid_kmt,init_time)
!Allocate and initialize all registered generic tracers
!JGJ 2013/05/31 merged COBALT into siena_201303
@@ -505,11 +504,10 @@ end subroutine generic_tracer_diag
!
!
- subroutine generic_tracer_source(Temp,Salt,tv,rho_dzt,dzt,hblt_depth,ilb,jlb,tau,dtts,&
+ 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)
+ frunoff,grid_ht, current_wave_stress, sosga, geolat, eqn_of_state)
real, dimension(ilb:,jlb:,:), intent(in) :: Temp,Salt,rho_dzt,dzt
- type(thermo_var_ptrs), intent(in) :: tv
real, dimension(ilb:,jlb:), intent(in) :: hblt_depth
integer, intent(in) :: ilb,jlb,tau
real, intent(in) :: dtts
@@ -524,7 +522,8 @@ subroutine generic_tracer_source(Temp,Salt,tv,rho_dzt,dzt,hblt_depth,ilb,jlb,tau
real, dimension(ilb:,jlb:),optional, intent(in) :: grid_ht
real, dimension(ilb:,jlb:),optional , intent(in) :: current_wave_stress
real, optional , intent(in) :: sosga ! global avg. sea surface salinity
-
+ real, dimension(ilb:,jlb:),optional, intent(in) :: geolat
+ type(EOS_type), optional, intent(in) :: eqn_of_state
character(len=fm_string_len), parameter :: sub_name = 'generic_tracer_update_from_source'
@@ -554,9 +553,18 @@ subroutine generic_tracer_source(Temp,Salt,tv,rho_dzt,dzt,hblt_depth,ilb,jlb,tau
hblt_depth,ilb,jlb,tau,dtts,grid_dat,model_time,&
nbands,max_wavelength_band,sw_pen_band,opacity_band, grid_ht)
- if(do_generic_COBALT) call generic_COBALT_update_from_source(tracer_list,Temp,Salt,tv,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)
+ if (do_generic_COBALT) then
+ if (present(geolat) .and. present(eqn_of_state)) then
+ call generic_COBALT_update_from_source(tracer_list,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,&
+ geolat,eqn_of_state)
+ else
+ call generic_COBALT_update_from_source(tracer_list,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)
+ endif
+ endif
if(do_generic_SF6) call generic_SF6_update_from_source(tracer_list,rho_dzt,dzt,hblt_depth,&
ilb,jlb,tau,dtts,grid_dat,model_time)
diff --git a/generic_tracers/generic_tracer_utils.F90 b/generic_tracers/generic_tracer_utils.F90
index f486d43..ef83680 100644
--- a/generic_tracers/generic_tracer_utils.F90
+++ b/generic_tracers/generic_tracer_utils.F90
@@ -330,9 +330,6 @@ module g_tracer_utils
!coast mask
integer, _ALLOCATABLE, dimension(:,:):: grid_mask_coast _NULL
- real, _ALLOCATABLE, dimension(:,:) :: geolon _NULL
- real, _ALLOCATABLE, dimension(:,:) :: geolat _NULL
-
! IN and OUT (restart) files
character(len=fm_string_len) :: ice_restart_file, ocean_restart_file
end type g_tracer_common
@@ -1600,19 +1597,18 @@ end subroutine g_tracer_set_csdiag
! grid_mask array and initial time.
!
!
- ! call g_tracer_set_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes,grid_tmask,grid_kmt,init_time,geolon,geolat)
+ ! call g_tracer_set_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes,grid_tmask,grid_kmt,init_time)
!
!
!
!
!
- subroutine g_tracer_set_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes,grid_tmask,grid_kmt,init_time,geolon,geolat)
+ 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,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes(3)
real, dimension(isd:,jsd:,:),intent(in) :: grid_tmask
integer,dimension(isd:,jsd:),intent(in) :: grid_kmt
type(time_type), intent(in) :: init_time
- real, dimension(isd:,jsd:), intent(in) :: geolon,geolat
character(len=fm_string_len), parameter :: sub_name = 'g_tracer_set_common'
integer :: i,j
@@ -1641,12 +1637,6 @@ subroutine g_tracer_set_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes,grid
if(.NOT. _ALLOCATED(g_tracer_com%grid_mask_coast)) allocate(g_tracer_com%grid_mask_coast(isd:ied,jsd:jed))
- if(.NOT. _ALLOCATED(g_tracer_com%geolon)) allocate(g_tracer_com%geolon(isd:ied,jsd:jed))
- g_tracer_com%geolon = geolon
-
- if(.NOT. _ALLOCATED(g_tracer_com%geolat)) allocate(g_tracer_com%geolat(isd:ied,jsd:jed))
- g_tracer_com%geolat = geolat
-
!Determine the coast line.
!In order to that grid_tmask must have the proper value on the data domain boundaries isd,ied,jsd,jed
!so that we can decide if the coast line coinsides with a point on the compute domain boundary
@@ -1681,7 +1671,7 @@ 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,geolon,geolat)
+ axes,grid_tmask,grid_mask_coast,grid_kmt,init_time,diag_CS)
integer, intent(out) :: isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau
integer,optional, intent(out) :: axes(3)
@@ -1689,8 +1679,6 @@ subroutine g_tracer_get_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,&
real, optional, dimension(:,:,:),pointer :: grid_tmask
integer, optional, dimension(:,:), pointer :: grid_mask_coast
integer, optional, dimension(:,:), pointer :: grid_kmt
- real, optional, dimension(:,:), pointer :: geolon
- real, optional, dimension(:,:), pointer :: geolat
type(g_diag_ctrl), optional, pointer :: diag_CS
character(len=fm_string_len), parameter :: sub_name = 'g_tracer_get_common'
@@ -1713,8 +1701,6 @@ subroutine g_tracer_get_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,&
if(present(grid_mask_coast)) grid_mask_coast=> g_tracer_com%grid_mask_coast
if(present(grid_kmt)) grid_kmt => g_tracer_com%grid_kmt
if(present(diag_CS)) diag_CS => g_tracer_com%diag_CS
- if(present(geolon)) geolon => g_tracer_com%geolon
- if(present(geolat)) geolat => g_tracer_com%geolat
! if(present(ice_restart_file)) ice_restart_file = g_tracer_com%ice_restart_file
! if(present(ocean_restart_file)) ocean_restart_file = g_tracer_com%ocean_restart_file
diff --git a/patch/MOM6/src/tracer/MOM_generic_tracer.F90 b/patch/MOM6/src/tracer/MOM_generic_tracer.F90
deleted file mode 100644
index e94df66..0000000
--- a/patch/MOM6/src/tracer/MOM_generic_tracer.F90
+++ /dev/null
@@ -1,1024 +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 field_manager_mod, only: fm_string_len
-
- use generic_tracer, only: generic_tracer_register, generic_tracer_get_diag_list
- use generic_tracer, only: generic_tracer_init, generic_tracer_source, generic_tracer_register_diag
- use generic_tracer, only: generic_tracer_coupler_get, generic_tracer_coupler_set
- use generic_tracer, only: generic_tracer_end, generic_tracer_get_list, do_generic_tracer
- use generic_tracer, only: generic_tracer_update_from_bottom,generic_tracer_vertdiff_G
- use generic_tracer, only: generic_tracer_coupler_accumulate
-
- use g_tracer_utils, only: g_tracer_get_name,g_tracer_set_values,g_tracer_set_common,g_tracer_get_common
- use g_tracer_utils, only: g_tracer_get_next,g_tracer_type,g_tracer_is_prog,g_tracer_flux_init
- use g_tracer_utils, only: g_tracer_send_diag,g_tracer_get_values
- use g_tracer_utils, only: g_tracer_get_pointer,g_tracer_get_alias,g_tracer_set_csdiag
- use g_tracer_utils, only: g_tracer_get_obc_segment_props
-
- use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS
- use MOM_coms, only : EFP_type, max_across_PEs, min_across_PEs, PE_here
- use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr
- use MOM_diag_mediator, only : diag_ctrl, get_diag_time_end
- use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE, is_root_pe
- use MOM_file_parser, only : get_param, log_param, log_version, 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_io, only : file_exists, MOM_read_data, slasher
- use MOM_open_boundary, only : ocean_OBC_type
- use MOM_open_boundary, only : register_obgc_segments, fill_obgc_segments
- use MOM_open_boundary, only : set_obgc_segments_props
- use MOM_restart, only : register_restart_field, query_initialized, set_initialized, MOM_restart_CS
- use MOM_spatial_means, only : global_area_mean, global_mass_int_EFP
- use MOM_sponge, only : set_up_sponge_field, sponge_CS
- use MOM_time_manager, only : time_type, set_time
- use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
- use MOM_tracer_registry, only : register_tracer, tracer_registry_type
- use MOM_tracer_Z_init, only : tracer_Z_init
- use MOM_tracer_initialization_from_Z, only : MOM_initialize_tracer_from_Z
- 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.
- real :: tracer_land_val = -1.0 !< The values of tracers used where land is masked out.
- 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, G, GV, param_file, CS, tr_Reg, restart_CS)
- type(hor_index_type), intent(in) :: HI !< Horizontal index ranges
- 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(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
- ! Local variables
- logical :: register_MOM_generic_tracer
- logical :: obc_has
- ! This include declares and sets the variable "version".
-# include "version_variable.h"
-
- character(len=128), parameter :: sub_name = 'register_MOM_generic_tracer'
- character(len=200) :: inputdir ! The directory where NetCDF input files are.
- ! These can be overridden later in via the field manager?
-
- integer :: ntau, axes(3)
- type(g_tracer_type), pointer :: g_tracer,g_tracer_next
- character(len=fm_string_len) :: g_tracer_name,longname,units
- character(len=fm_string_len) :: obc_src_file_name,obc_src_field_name
- real :: lfac_in,lfac_out
- real, dimension(:,:,:,:), pointer :: tr_field
- real, dimension(:,:,:), pointer :: tr_ptr
- real, dimension(HI%isd:HI%ied, HI%jsd:HI%jed,GV%ke) :: grid_tmask
- integer, dimension(HI%isd:HI%ied, HI%jsd:HI%jed) :: grid_kmt
-
- register_MOM_generic_tracer = .false.
- if (associated(CS)) then
- call MOM_error(FATAL, "register_MOM_generic_tracer called with an "// &
- "associated control structure.")
- endif
- allocate(CS)
-
-
- !Register all the generic tracers used and create the list of them.
- !This can be called by ALL PE's. No array fields allocated.
- if (.not. g_registered) then
- call generic_tracer_register()
- g_registered = .true.
- endif
-
-
- ! Read all relevant parameters and write them to the model log.
- call log_version(param_file, sub_name, version, "")
- call get_param(param_file, sub_name, "GENERIC_TRACER_IC_FILE", CS%IC_file, &
- "The file in which the generic trcer initial values can "//&
- "be found, or an empty string for internal initialization.", &
- default=" ")
- if ((len_trim(CS%IC_file) > 0) .and. (scan(CS%IC_file,'/') == 0)) then
- ! Add the directory if CS%IC_file is not already a complete path.
- call get_param(param_file, sub_name, "INPUTDIR", inputdir, default=".")
- CS%IC_file = trim(slasher(inputdir))//trim(CS%IC_file)
- call log_param(param_file, sub_name, "INPUTDIR/GENERIC_TRACER_IC_FILE", CS%IC_file)
- endif
- call get_param(param_file, sub_name, "GENERIC_TRACER_IC_FILE_IS_Z", CS%Z_IC_file, &
- "If true, GENERIC_TRACER_IC_FILE is in depth space, not "//&
- "layer space.",default=.false.)
- call get_param(param_file, sub_name, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, &
- "If true, tracers may go through the initialization code "//&
- "if they are not found in the restart files. Otherwise "//&
- "it is a fatal error if tracers are not found in the "//&
- "restart files of a restarted run.", default=.false.)
-
- CS%restart_CSp => restart_CS
-
- ntau=1 ! MOM needs the fields at only one time step
-
-
- ! At this point G%mask2dT and CS%diag%axesTL are not allocated.
- ! postpone diag_registeration to initialize_MOM_generic_tracer
-
- !Fields cannot be diag registered as they are allocated and have to registered later.
- grid_tmask(:,:,:) = 0.0
- grid_kmt(:,:) = 0.0
- axes(:) = -1
-
- !
- ! Initialize all generic tracers
- !
- call generic_tracer_init(HI%isc,HI%iec,HI%jsc,HI%jec,HI%isd,HI%ied,HI%jsd,HI%jed,&
- GV%ke,ntau,axes,grid_tmask,grid_kmt,set_time(0,0),G%geolonT,G%geolatT)
-
-
- !
- ! MOM-register the generic tracers
- !
-
- !Get the tracer list
- call generic_tracer_get_list(CS%g_tracer_list)
- if (.NOT. associated(CS%g_tracer_list)) call MOM_error(FATAL, trim(sub_name)//&
- ": No tracer in the list.")
- ! For each tracer name get its T_prog index and get its fields
-
- g_tracer=>CS%g_tracer_list
- do
- call g_tracer_get_alias(g_tracer,g_tracer_name)
-
- call g_tracer_get_pointer(g_tracer,g_tracer_name,'field',tr_field)
- call g_tracer_get_values(g_tracer,g_tracer_name,'longname', longname)
- call g_tracer_get_values(g_tracer,g_tracer_name,'units',units )
-
- !!nnz: MOM field is 3D. Does this affect performance? Need it be override field?
- tr_ptr => tr_field(:,:,:,1)
- ! Register prognastic tracer for horizontal advection, diffusion, and restarts.
- if (g_tracer_is_prog(g_tracer)) then
- call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, &
- name=g_tracer_name, longname=longname, units=units, &
- registry_diags=.false., & !### CHANGE TO TRUE?
- restart_CS=restart_CS, mandatory=.not.CS%tracers_may_reinit)
- else
- call register_restart_field(tr_ptr, g_tracer_name, .not.CS%tracers_may_reinit, &
- restart_CS, longname=longname, units=units)
- endif
-
- !traverse the linked list till hit NULL
- call g_tracer_get_next(g_tracer, g_tracer_next)
- if (.NOT. associated(g_tracer_next)) exit
- g_tracer=>g_tracer_next
-
- enddo
-
- register_MOM_generic_tracer = .true.
- 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
- ! Local variables
- logical :: obc_has
- ! This include declares and sets the variable "version".
-# include "version_variable.h"
-
- character(len=128), parameter :: sub_name = 'register_MOM_generic_tracer_segments'
- type(g_tracer_type), pointer :: g_tracer,g_tracer_next
- character(len=fm_string_len) :: g_tracer_name
- character(len=fm_string_len) :: obc_src_file_name,obc_src_field_name
- real :: lfac_in,lfac_out
-
- if (.NOT. associated(OBC)) return
- !Get the tracer list
- call generic_tracer_get_list(CS%g_tracer_list)
- if (.NOT. associated(CS%g_tracer_list)) call MOM_error(FATAL, trim(sub_name)//&
- ": No tracer in the list.")
-
- g_tracer=>CS%g_tracer_list
- do
- call g_tracer_get_alias(g_tracer,g_tracer_name)
- if (g_tracer_is_prog(g_tracer)) then
- call g_tracer_get_obc_segment_props(g_tracer,g_tracer_name,obc_has ,&
- obc_src_file_name,obc_src_field_name,lfac_in,lfac_out)
- if (obc_has) then
- call set_obgc_segments_props(OBC,g_tracer_name,obc_src_file_name,obc_src_field_name,lfac_in,lfac_out)
- call register_obgc_segments(GV, OBC, tr_Reg, param_file, g_tracer_name)
- endif
- endif
-
- !traverse the linked list till hit NULL
- call g_tracer_get_next(g_tracer, g_tracer_next)
- if (.NOT. associated(g_tracer_next)) exit
- g_tracer=>g_tracer_next
-
- enddo
-
- 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, 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(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.
-
- character(len=128), parameter :: sub_name = 'initialize_MOM_generic_tracer'
- logical :: OK,obc_has
- integer :: i, j, k, isc, iec, jsc, jec, nk
- type(g_tracer_type), pointer :: g_tracer,g_tracer_next
- character(len=fm_string_len) :: g_tracer_name
- real, dimension(:,:,:,:), pointer :: tr_field
- real, dimension(:,:,:), pointer :: tr_ptr
- real, dimension(G%isd:G%ied, G%jsd:G%jed, 1:GV%ke) :: grid_tmask
- integer, dimension(G%isd:G%ied, G%jsd:G%jed) :: grid_kmt
-
- !! 2010/02/04 Add code to re-initialize Generic Tracers if needed during a model simulation
- !! By default, restart cpio should not contain a Generic Tracer IC file and step below will be skipped.
- !! Ideally, the generic tracer IC file should have the tracers on Z levels.
-
- isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nk = GV%ke
-
- CS%diag=>diag
- !Get the tracer list
- if (.NOT. associated(CS%g_tracer_list)) call MOM_error(FATAL, trim(sub_name)//&
- ": No tracer in the list.")
- !For each tracer name get its fields
- g_tracer=>CS%g_tracer_list
-
- do
- if (INDEX(CS%IC_file, '_NULL_') /= 0) then
- call MOM_error(WARNING, "The name of the IC_file "//trim(CS%IC_file)//&
- " indicates no MOM initialization was asked for the generic tracers."//&
- "Bypassing the MOM initialization of ALL generic tracers!")
- exit
- endif
- call g_tracer_get_alias(g_tracer,g_tracer_name)
- call g_tracer_get_pointer(g_tracer,g_tracer_name,'field',tr_field)
- tr_ptr => tr_field(:,:,:,1)
-
- if (.not.restart .or. (CS%tracers_may_reinit .and. &
- .not.query_initialized(tr_ptr, g_tracer_name, CS%restart_CSp))) then
-
- if (g_tracer%requires_src_info ) then
- call MOM_error(NOTE,"initialize_MOM_generic_tracer: "//&
- "initializing generic tracer "//trim(g_tracer_name)//&
- " using MOM_initialize_tracer_from_Z ")
-
- call MOM_initialize_tracer_from_Z(h, tr_ptr, G, GV, US, param_file, &
- src_file = g_tracer%src_file, &
- src_var_nam = g_tracer%src_var_name, &
- src_var_unit_conversion = g_tracer%src_var_unit_conversion,&
- src_var_record = g_tracer%src_var_record, &
- src_var_gridspec = g_tracer%src_var_gridspec )
-
- !Check/apply the bounds for each g_tracer
- do k=1,nk ; do j=jsc,jec ; do i=isc,iec
- if (tr_ptr(i,j,k) /= CS%tracer_land_val) then
- if (tr_ptr(i,j,k) < g_tracer%src_var_valid_min) tr_ptr(i,j,k) = g_tracer%src_var_valid_min
- !Jasmin does not want to apply the maximum for now
- !if (tr_ptr(i,j,k) > g_tracer%src_var_valid_max) tr_ptr(i,j,k) = g_tracer%src_var_valid_max
- endif
- enddo ; enddo ; enddo
-
- !jgj: Reset CASED to 0 below K=1
- if ( (trim(g_tracer_name) == 'cased') .or. (trim(g_tracer_name) == 'ca13csed') ) then
- do k=2,nk ; do j=jsc,jec ; do i=isc,iec
- if (tr_ptr(i,j,k) /= CS%tracer_land_val) then
- tr_ptr(i,j,k) = 0.0
- endif
- enddo ; enddo ; enddo
- endif
- elseif(.not. g_tracer%requires_restart) then
- !Do nothing for this tracer, it is initialized by the tracer package
- call MOM_error(NOTE,"initialize_MOM_generic_tracer: "//&
- "skip initialization of generic tracer "//trim(g_tracer_name))
- else !Do it old way if the tracer is not registered to start from a specific source file.
- !This path should be deprecated if all generic tracers are required to start from specified sources.
- if (len_trim(CS%IC_file) > 0) then
- ! Read the tracer concentrations from a netcdf file.
- if (.not.file_exists(CS%IC_file)) call MOM_error(FATAL, &
- "initialize_MOM_Generic_tracer: Unable to open "//CS%IC_file)
- if (CS%Z_IC_file) then
- OK = tracer_Z_init(tr_ptr, h, CS%IC_file, g_tracer_name, G, GV, US)
- if (.not.OK) then
- OK = tracer_Z_init(tr_ptr, h, CS%IC_file, trim(g_tracer_name), G, GV, US)
- if (.not.OK) call MOM_error(FATAL,"initialize_MOM_Generic_tracer: "//&
- "Unable to read "//trim(g_tracer_name)//" from "//&
- trim(CS%IC_file)//".")
- endif
- call MOM_error(NOTE,"initialize_MOM_generic_tracer: "//&
- "initialized generic tracer "//trim(g_tracer_name)//&
- " using Generic Tracer File on Z: "//CS%IC_file)
- else
- ! native grid
- call MOM_error(NOTE,"initialize_MOM_generic_tracer: "//&
- "Using Generic Tracer IC file on native grid "//trim(CS%IC_file)//&
- " for tracer "//trim(g_tracer_name))
- call MOM_read_data(CS%IC_file, trim(g_tracer_name), tr_ptr, G%Domain)
- endif
- else
- call MOM_error(FATAL,"initialize_MOM_generic_tracer: "//&
- "check Generic Tracer IC filename "//trim(CS%IC_file)//&
- " for tracer "//trim(g_tracer_name))
- endif
-
- endif
-
- call set_initialized(tr_ptr, g_tracer_name, CS%restart_CSp)
- endif
-
- call g_tracer_get_obc_segment_props(g_tracer,g_tracer_name,obc_has )
- if(obc_has .and. g_tracer_is_prog(g_tracer)) call fill_obgc_segments(G, GV, OBC, tr_ptr, g_tracer_name)
- !traverse the linked list till hit NULL
- call g_tracer_get_next(g_tracer, g_tracer_next)
- if (.NOT. associated(g_tracer_next)) exit
- g_tracer=>g_tracer_next
- enddo
- !! end section to re-initialize generic tracers
-
-
- !Now we can reset the grid mask, axes and time to their true values
- !Note that grid_tmask must be set correctly on the data domain boundary
- !so that coast mask can be deduced from it.
- grid_tmask(:,:,:) = 0.0
- grid_kmt(:,:) = 0
- do j = G%jsd, G%jed ; do i = G%isd, G%ied
- if (G%mask2dT(i,j) > 0.0) then
- grid_tmask(i,j,:) = 1.0
- grid_kmt(i,j) = GV%ke ! Tell the code that a layer thicker than 1m is the bottom layer.
- endif
- enddo ; enddo
- call g_tracer_set_common(G%isc,G%iec,G%jsc,G%jec,G%isd,G%ied,G%jsd,G%jed,&
- GV%ke,1,CS%diag%axesTL%handles,grid_tmask,grid_kmt,day,G%geolonT,G%geolatT)
-
- ! Register generic tracer modules diagnostics
-
-#ifdef _USE_MOM6_DIAG
- call g_tracer_set_csdiag(CS%diag)
-#endif
- call generic_tracer_register_diag()
-#ifdef _USE_MOM6_DIAG
- call g_tracer_set_csdiag(CS%diag)
-#endif
-
- 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 !< Limits how much water can be fluxed out of
- !! the top layer 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.
- ! The arguments to this subroutine are redundant in that
- ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1)
-
- ! Local variables
- character(len=128), parameter :: sub_name = 'MOM_generic_tracer_column_physics'
-
- type(g_tracer_type), pointer :: g_tracer, g_tracer_next
- character(len=fm_string_len) :: g_tracer_name
- real, dimension(:,:), pointer :: stf_array,trunoff_array,runoff_tracer_flux_array
-
- real :: surface_field(SZI_(G),SZJ_(G))
- real :: dz_ml(SZI_(G),SZJ_(G)) ! The mixed layer depth in the MKS units used for generic tracers [m]
- real :: sosga
-
- real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke) :: rho_dzt, dzt
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work
- integer :: i, j, k, isc, iec, jsc, jec, nk
-
- isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nk = GV%ke
-
- !Get the tracer list
- if (.NOT. associated(CS%g_tracer_list)) call MOM_error(FATAL,&
- trim(sub_name)//": No tracer in the list.")
-
-#ifdef _USE_MOM6_DIAG
- call g_tracer_set_csdiag(CS%diag)
-#endif
-
- !
- !Extract the tracer surface fields from coupler and update tracer fields from sources
- !
- !call generic_tracer_coupler_get(fluxes%tr_fluxes)
- !Niki: This is moved out to ocean_model_MOM.F90 because if dt_therm>dt_cpld we need to average
- ! the fluxes without coming into this subroutine.
- ! MOM5 has to modified to conform.
-
- !
- !Add contribution of river to surface flux
- !
- g_tracer=>CS%g_tracer_list
- do
- if (_ALLOCATED(g_tracer%trunoff) .and. (.NOT. g_tracer%runoff_added_to_stf)) then
- call g_tracer_get_alias(g_tracer,g_tracer_name)
- call g_tracer_get_pointer(g_tracer,g_tracer_name,'stf', stf_array)
- call g_tracer_get_pointer(g_tracer,g_tracer_name,'trunoff',trunoff_array)
- call g_tracer_get_pointer(g_tracer,g_tracer_name,'runoff_tracer_flux',runoff_tracer_flux_array)
- !nnz: Why is fluxes%river = 0?
- runoff_tracer_flux_array(:,:) = trunoff_array(:,:) * &
- US%RZ_T_to_kg_m2s*fluxes%lrunoff(:,:)
- stf_array = stf_array + runoff_tracer_flux_array
- g_tracer%runoff_added_to_stf = .true.
- endif
-
- !traverse the linked list till hit NULL
- call g_tracer_get_next(g_tracer, g_tracer_next)
- if (.NOT. associated(g_tracer_next)) exit
- g_tracer => g_tracer_next
-
- enddo
-
- !
- !Prepare input arrays for source update
- !
-
- rho_dzt(:,:,:) = GV%H_to_kg_m2 * GV%Angstrom_H
- do k = 1, nk ; do j = jsc, jec ; do i = isc, iec !{
- rho_dzt(i,j,k) = GV%H_to_kg_m2 * h_old(i,j,k)
- enddo ; enddo ; enddo !}
-
- dzt(:,:,:) = 1.0
- do k = 1, nk ; do j = jsc, jec ; do i = isc, iec !{
- dzt(i,j,k) = GV%H_to_m * h_old(i,j,k)
- enddo ; enddo ; enddo !}
- dz_ml(:,:) = 0.0
- do j=jsc,jec ; do i=isc,iec
- surface_field(i,j) = tv%S(i,j,1)
- dz_ml(i,j) = US%Z_to_m * Hml(i,j)
- enddo ; enddo
- sosga = global_area_mean(surface_field, G, scale=US%S_to_ppt)
-
- !
- !Calculate tendencies (i.e., field changes at dt) from the sources / sinks
- !
- if ((G%US%L_to_m == 1.0) .and. (G%US%s_to_T == 1.0) .and. (G%US%Z_to_m == 1.0) .and. &
- (G%US%Q_to_J_kg == 1.0) .and. (G%US%RZ_to_kg_m2 == 1.0) .and. &
- (US%C_to_degC == 1.0) .and. (US%S_to_ppt == 1.0)) then
- ! Avoid unnecessary copies when no unit conversion is needed.
- call generic_tracer_source(tv%T, tv%S, tv, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, dt, &
- G%areaT, get_diag_time_end(CS%diag), &
- optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, &
- internal_heat=tv%internal_heat, frunoff=fluxes%frunoff, sosga=sosga)
- else
- call generic_tracer_source(US%C_to_degC*tv%T, US%S_to_ppt*tv%S, tv, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, dt, &
- G%US%L_to_m**2*G%areaT(:,:), get_diag_time_end(CS%diag), &
- optics%nbands, optics%max_wavelength_band, &
- sw_pen_band=G%US%QRZ_T_to_W_m2*optics%sw_pen_band(:,:,:), &
- opacity_band=G%US%m_to_Z*optics%opacity_band(:,:,:,:), &
- internal_heat=G%US%RZ_to_kg_m2*US%C_to_degC*tv%internal_heat(:,:), &
- frunoff=G%US%RZ_T_to_kg_m2s*fluxes%frunoff(:,:), sosga=sosga)
- endif
-
- ! This uses applyTracerBoundaryFluxesInOut to handle the change in tracer due to freshwater fluxes
- ! usually in ALE mode
- if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then
- g_tracer=>CS%g_tracer_list
- do
- if (g_tracer_is_prog(g_tracer)) then
- do k=1,nk ;do j=jsc,jec ; do i=isc,iec
- h_work(i,j,k) = h_old(i,j,k)
- enddo ; enddo ; enddo
- call applyTracerBoundaryFluxesInOut(G, GV, g_tracer%field(:,:,:,1), dt, &
- fluxes, h_work, evap_CFL_limit, minimum_forcing_depth)
- endif
-
- !traverse the linked list till hit NULL
- call g_tracer_get_next(g_tracer, g_tracer_next)
- if (.NOT. associated(g_tracer_next)) exit
- g_tracer=>g_tracer_next
- enddo
- endif
-
- !
- !Update Tr(n)%field from explicit vertical diffusion
- !
- ! Use a tridiagonal solver to determine the concentrations after the
- ! surface source is applied and diapycnal advection and diffusion occurs.
- if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then
- ! Last arg is tau which is always 1 for MOM6
- call generic_tracer_vertdiff_G(h_work, ea, eb, US%T_to_s*dt, GV%kg_m2_to_H, GV%m_to_H, 1)
- else
- ! Last arg is tau which is always 1 for MOM6
- call generic_tracer_vertdiff_G(h_old, ea, eb, US%T_to_s*dt, GV%kg_m2_to_H, GV%m_to_H, 1)
- endif
-
- ! Update bottom fields after vertical processes
-
- ! Second arg is tau which is always 1 for MOM6
- call generic_tracer_update_from_bottom(US%T_to_s*dt, 1, get_diag_time_end(CS%diag))
-
- !Output diagnostics via diag_manager for all generic tracers and their fluxes
- call g_tracer_send_diag(CS%g_tracer_list, get_diag_time_end(CS%diag), tau=1)
-#ifdef _USE_MOM6_DIAG
- call g_tracer_set_csdiag(CS%diag)
-#endif
-
- 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.
-
- ! Local variables
- type(g_tracer_type), pointer :: g_tracer, g_tracer_next
- real, dimension(:,:,:,:), pointer :: tr_field
- real, dimension(:,:,:), pointer :: tr_ptr
- character(len=128), parameter :: sub_name = 'MOM_generic_tracer_stock'
-
- integer :: m
-
- MOM_generic_tracer_stock = 0
- if (.not.associated(CS)) return
-
- if (present(stock_index)) then ; if (stock_index > 0) then
- ! Check whether this stock is available from this routine.
-
- ! No stocks from this routine are being checked yet. Return 0.
- return
- endif ; endif
-
- if (.NOT. associated(CS%g_tracer_list)) return ! No stocks.
-
- m=1 ; g_tracer=>CS%g_tracer_list
- do
- call g_tracer_get_alias(g_tracer,names(m))
- call g_tracer_get_values(g_tracer,names(m),'units',units(m))
- units(m) = trim(units(m))//" kg"
- call g_tracer_get_pointer(g_tracer,names(m),'field',tr_field)
-
- tr_ptr => tr_field(:,:,:,1)
- stocks(m) = global_mass_int_EFP(h, G, GV, tr_ptr, on_PE_only=.true.)
-
- !traverse the linked list till hit NULL
- call g_tracer_get_next(g_tracer, g_tracer_next)
- if (.NOT. associated(g_tracer_next)) exit
- g_tracer=>g_tracer_next
- m = m+1
- enddo
-
- MOM_generic_tracer_stock = m
-
- end function MOM_generic_tracer_stock
-
- !> This subroutine find 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 gone through.
- function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, ygmin, zgmin, &
- xgmax, ygmax, zgmax , G, CS, names, units)
- 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, in kg
- !! times concentration units.
- real, dimension(:), intent(out) :: gmax !< Global maximum of each tracer, in kg
- !! times concentration units.
- real, dimension(:), intent(out) :: xgmin !< The x-position of the global minimum
- real, dimension(:), intent(out) :: ygmin !< The y-position of the global minimum
- real, dimension(:), intent(out) :: zgmin !< The z-position of the global minimum
- real, dimension(:), intent(out) :: xgmax !< The x-position of the global maximum
- real, dimension(:), intent(out) :: ygmax !< The y-position of the global maximum
- real, dimension(:), intent(out) :: zgmax !< The z-position of the global maximum
- 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.
- integer :: MOM_generic_tracer_min_max !< Return value, the
- !! number of tracers done here.
-
-! Local variables
- type(g_tracer_type), pointer :: g_tracer, g_tracer_next
- real, dimension(:,:,:,:), pointer :: tr_field
- real, dimension(:,:,:), pointer :: tr_ptr
- character(len=128), parameter :: sub_name = 'MOM_generic_tracer_min_max'
-
- real, dimension(:,:,:),pointer :: grid_tmask
- integer :: isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau
-
- integer :: k, is, ie, js, je, m
- real, allocatable, dimension(:) :: geo_z
-
- is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec
-
- MOM_generic_tracer_min_max = 0
- if (.not.associated(CS)) return
-
- if (.NOT. associated(CS%g_tracer_list)) return ! No stocks.
-
-
- call g_tracer_get_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,grid_tmask=grid_tmask)
-
- ! Because the use of a simple z-coordinate can not be assumed, simply
- ! use the layer index as the vertical label.
- allocate(geo_z(nk))
- do k=1,nk ; geo_z(k) = real(k) ; enddo
-
- m=ind_start ; g_tracer=>CS%g_tracer_list
- do
- call g_tracer_get_alias(g_tracer,names(m))
- call g_tracer_get_values(g_tracer,names(m),'units',units(m))
- units(m) = trim(units(m))//" kg"
- call g_tracer_get_pointer(g_tracer,names(m),'field',tr_field)
-
- gmin(m) = -1.0
- gmax(m) = -1.0
-
- tr_ptr => tr_field(:,:,:,1)
-
- call array_global_min_max(tr_ptr, grid_tmask, isd, jsd, isc, iec, jsc, jec, nk, gmin(m), gmax(m), &
- G%geoLonT, G%geoLatT, geo_z, xgmin(m), ygmin(m), zgmin(m), &
- xgmax(m), ygmax(m), zgmax(m))
-
- got_minmax(m) = .true.
-
- !traverse the linked list till hit NULL
- call g_tracer_get_next(g_tracer, g_tracer_next)
- if (.NOT. associated(g_tracer_next)) exit
- g_tracer=>g_tracer_next
- m = m+1
- enddo
-
- MOM_generic_tracer_min_max = m
-
- end function MOM_generic_tracer_min_max
-
- !> Find the global maximum and minimum of a tracer array and return the locations of the extrema.
- subroutine array_global_min_max(tr_array, tmask, isd, jsd, isc, iec, jsc, jec, nk, g_min, g_max, &
- geo_x, geo_y, geo_z, xgmin, ygmin, zgmin, xgmax, ygmax, zgmax)
- integer, intent(in) :: isd !< The starting data domain i-index
- integer, intent(in) :: jsd !< The starting data domain j-index
- real, dimension(isd:,jsd:,:), intent(in) :: tr_array !< The tracer array to search for extrema
- real, dimension(isd:,jsd:,:), intent(in) :: tmask !< A mask that is 0 for points to exclude
- integer, intent(in) :: isc !< The starting compute domain i-index
- integer, intent(in) :: iec !< The ending compute domain i-index
- integer, intent(in) :: jsc !< The starting compute domain j-index
- integer, intent(in) :: jec !< The ending compute domain j-index
- integer, intent(in) :: nk !< The number of vertical levels
- real, intent(out) :: g_min !< The global minimum of tr_array
- real, intent(out) :: g_max !< The global maximum of tr_array
- real, dimension(isd:,jsd:), intent(in) :: geo_x !< The geographic x-positions of points
- real, dimension(isd:,jsd:), intent(in) :: geo_y !< The geographic y-positions of points
- real, dimension(:), intent(in) :: geo_z !< The vertical pseudo-positions of points
- real, intent(out) :: xgmin !< The x-position of the global minimum
- real, intent(out) :: ygmin !< The y-position of the global minimum
- real, intent(out) :: zgmin !< The z-position of the global minimum
- real, intent(out) :: xgmax !< The x-position of the global maximum
- real, intent(out) :: ygmax !< The y-position of the global maximum
- real, intent(out) :: zgmax !< The z-position of the global maximum
-
- ! This subroutine is an exact transcription (bugs and all) of mpp_array_global_min_max()
- ! from the version in FMS/mpp/mpp_utilities.F90, but with some whitespace changes to match
- ! MOM6 code styles and to use infrastructure routines via the MOM6 framework code, and with
- ! added comments to document its arguments.i
-
- !### The obvious problems with this routine as currently written include:
- ! 1. It does not return exactly the maximum and minimum values.
- ! 2. The reported maximum and minimum are dependent on PE count and layout.
- ! 3. For all-zero arrays, the reported maxima scale with the PE_count
- ! 4. For arrays with a large enough offset or scaling, so that the magnitude of values exceed
- ! 1e10, the values it returns are simply wrong.
- ! 5. The results do not scale appropriately if the argument is rescaled.
- ! 6. The extrema and locations are not rotationally invariant.
- ! 7. It is inefficient because it uses 8 blocking global reduction calls when it could use just 2 or 3.
-
- ! Local variables
- real :: tmax, tmin ! Maximum and minimum tracer values, in the same units as tr_array
- real :: tmax0, tmin0 ! First-guest values of tmax and tmin.
- integer :: itmax, jtmax, ktmax, itmin, jtmin, ktmin
- real :: fudge ! A factor that is close to 1 that is used to find the location of the extrema.
-
- ! arrays to enable vectorization
- integer :: iminarr(3), imaxarr(3)
-
- !### These dimensional constant values mean that the results can not be guaranteed to be rescalable.
- g_min = -88888888888.0 ; g_max = -999999999.0
- tmax = -1.e10 ; tmin = 1.e10
- itmax = 0 ; jtmax = 0 ; ktmax = 0
- itmin = 0 ; jtmin = 0 ; ktmin = 0
-
- if (ANY(tmask(isc:iec,jsc:jec,:) > 0.)) then
- ! Vectorized using maxloc() and minloc() intrinsic functions by Russell.Fiedler@csiro.au.
- iminarr = minloc(tr_array(isc:iec,jsc:jec,:), (tmask(isc:iec,jsc:jec,:) > 0.))
- imaxarr = maxloc(tr_array(isc:iec,jsc:jec,:), (tmask(isc:iec,jsc:jec,:) > 0.))
- itmin = iminarr(1)+isc-1
- jtmin = iminarr(2)+jsc-1
- ktmin = iminarr(3)
- itmax = imaxarr(1)+isc-1
- jtmax = imaxarr(2)+jsc-1
- ktmax = imaxarr(3)
- tmin = tr_array(itmin,jtmin,ktmin)
- tmax = tr_array(itmax,jtmax,ktmax)
- end if
-
- ! use "fudge" to distinguish processors when tracer extreme is independent of processor
- !### This fudge factor is not independent of PE layout, and while it mostly works for finding
- ! a positive maximum or a negative minimum, it could miss the true extrema in the opposite
- ! cases, for which the fudge factor should be slightly reduced. The fudge factor should
- ! be based on global index-space conventions, which are decomposition invariant, and
- ! not the PE-number!
- fudge = 1.0 + 1.e-12*real(PE_here() )
- tmax = tmax*fudge
- tmin = tmin*fudge
- if (tmax == 0.0) then
- tmax = tmax + 1.e-12*real(PE_here() )
- endif
- if (tmin == 0.0) then
- tmin = tmin + 1.e-12*real(PE_here() )
- endif
-
- tmax0 = tmax ; tmin0 = tmin
-
- call max_across_PEs(tmax)
- call min_across_PEs(tmin)
-
- g_max = tmax
- g_min = tmin
-
- ! Now find the location of the global extrema.
- !
- ! Note that the fudge factor above guarantees that the location of max (min) is uinque,
- ! since tmax0 (tmin0) has slightly different values on each processor.
- ! Otherwise, the function tr_array(i,j,k) could be equal to global max (min) at more
- ! than one point in space and this would be a much more difficult problem to solve.
- !
- !-999 on all current PE's
- xgmax = -999. ; ygmax = -999. ; zgmax = -999.
- xgmin = -999. ; ygmin = -999. ; zgmin = -999.
-
- if (tmax0 == tmax) then !This happens ONLY on ONE processor because of fudge factor above.
- xgmax = geo_x(itmax,jtmax)
- ygmax = geo_y(itmax,jtmax)
- zgmax = geo_z(ktmax)
- endif
-
- !### These three calls and the three calls that follow in about 10 lines should be combined
- ! into a single call for efficiency.
- call max_across_PEs(xgmax)
- call max_across_PEs(ygmax)
- call max_across_PEs(zgmax)
-
- if (tmin0 == tmin) then !This happens ONLY on ONE processor because of fudge factor above.
- xgmin = geo_x(itmin,jtmin)
- ygmin = geo_y(itmin,jtmin)
- zgmin = geo_z(ktmin)
- endif
-
- call max_across_PEs(xgmin)
- call max_across_PEs(ygmin)
- call max_across_PEs(zgmin)
-
- end subroutine array_global_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.
-
-! Local variables
- real :: sosga
-
- character(len=128), parameter :: sub_name = 'MOM_generic_tracer_surface_state'
- real, dimension(G%isd:G%ied,G%jsd:G%jed,1:GV%ke,1) :: rho0
- real, dimension(G%isd:G%ied,G%jsd:G%jed,1:GV%ke) :: dzt
-
- !Set coupler values
- !nnz: fake rho0
- rho0=1.0
-
- dzt(:,:,:) = GV%H_to_m * h(:,:,:)
-
- sosga = global_area_mean(sfc_state%SSS, G, scale=G%US%S_to_ppt)
-
- if ((G%US%C_to_degC == 1.0) .and. (G%US%S_to_ppt == 1.0)) then
- call generic_tracer_coupler_set(sfc_state%tr_fields, &
- ST=sfc_state%SST, SS=sfc_state%SSS, &
- rho=rho0, & !nnz: required for MOM5 and previous versions.
- ilb=G%isd, jlb=G%jsd, &
- dzt=dzt,& !This is needed for the Mocsy method of carbonate system vars
- tau=1, sosga=sosga, model_time=get_diag_time_end(CS%diag))
- else
- call generic_tracer_coupler_set(sfc_state%tr_fields, &
- ST=G%US%C_to_degC*sfc_state%SST, SS=G%US%S_to_ppt*sfc_state%SSS, &
- rho=rho0, & !nnz: required for MOM5 and previous versions.
- ilb=G%isd, jlb=G%jsd, &
- dzt=dzt,& !This is needed for the Mocsy method of carbonate system vars
- tau=1, sosga=sosga, model_time=get_diag_time_end(CS%diag))
- endif
-
- !Output diagnostics via diag_manager for all tracers in this module
-! if (.NOT. associated(CS%g_tracer_list)) call MOM_error(FATAL, trim(sub_name)//&
-! "No tracer in the list.")
-! call g_tracer_send_diag(CS%g_tracer_list, get_diag_time_end(CS%diag), tau=1)
- !Niki: The problem with calling diagnostic outputs here is that this subroutine is called every dt_cpld
- ! hence if dt_therm > dt_cpld we get output (and contribution to the mean) at times that tracers
- ! had not been updated.
- ! Moving this to the end of column physics subrotuine fixes this issue.
-
- 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.
-
- character(len=128), parameter :: sub_name = 'MOM_generic_flux_init'
- type(g_tracer_type), pointer :: g_tracer_list,g_tracer,g_tracer_next
-
- if (.not. g_registered) then
- call generic_tracer_register()
- g_registered = .true.
- endif
-
- call generic_tracer_get_list(g_tracer_list)
- if (.NOT. associated(g_tracer_list)) then
- call MOM_error(WARNING, trim(sub_name)// ": No generic tracer in the list.")
- return
- endif
-
- g_tracer=>g_tracer_list
- do
-
- call g_tracer_flux_init(g_tracer) !, verbosity=verbosity) !### Add this after ocean shared is updated.
-
- ! traverse the linked list till hit NULL
- call g_tracer_get_next(g_tracer, g_tracer_next)
- if (.NOT. associated(g_tracer_next)) exit
- g_tracer=>g_tracer_next
-
- enddo
-
- 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
-
- call generic_tracer_coupler_accumulate(flux_tmp%tr_fluxes, weight)
-
- 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.
- type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module.
-
- real, dimension(:,:,:), pointer :: array_ptr
- character(len=128), parameter :: sub_name = 'MOM_generic_tracer_get'
-
- call g_tracer_get_pointer(CS%g_tracer_list,name,member,array_ptr)
- array(:,:,:) = array_ptr(:,:,:)
-
- 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.
-
- call generic_tracer_end()
-
- if (associated(CS)) then
- deallocate(CS)
- endif
- 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/patch/MOM6/src/tracer/MOM_tracer_flow_control.F90 b/patch/MOM6/src/tracer/MOM_tracer_flow_control.F90
deleted file mode 100644
index bf416bc..0000000
--- a/patch/MOM6/src/tracer/MOM_tracer_flow_control.F90
+++ /dev/null
@@ -1,893 +0,0 @@
-!> Orchestrates the registration and calling of tracer packages
-module MOM_tracer_flow_control
-
-! This file is part of MOM6. See LICENSE.md for the license.
-
-use MOM_coms, only : EFP_type, assignment(=), EFP_to_real, real_to_EFP, EFP_sum_across_PEs
-use MOM_diag_mediator, only : time_type, diag_ctrl
-use MOM_error_handler, only : MOM_error, FATAL, WARNING
-use MOM_file_parser, only : get_param, log_version, param_file_type, close_param_file
-use MOM_forcing_type, only : forcing, optics_type
-use MOM_get_input, only : Get_MOM_input
-use MOM_grid, only : ocean_grid_type
-use MOM_hor_index, only : hor_index_type
-use MOM_CVMix_KPP, only : KPP_CS
-use MOM_open_boundary, only : ocean_OBC_type
-use MOM_restart, only : MOM_restart_CS
-use MOM_sponge, only : sponge_CS
-use MOM_ALE_sponge, only : ALE_sponge_CS
-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
-#include
-
-! Add references to other user-provide tracer modules here.
-use USER_tracer_example, only : tracer_column_physics, USER_initialize_tracer, USER_tracer_stock
-use USER_tracer_example, only : USER_register_tracer_example, USER_tracer_surface_state
-use USER_tracer_example, only : USER_tracer_example_end, USER_tracer_example_CS
-use DOME_tracer, only : register_DOME_tracer, initialize_DOME_tracer
-use DOME_tracer, only : DOME_tracer_column_physics, DOME_tracer_surface_state
-use DOME_tracer, only : DOME_tracer_end, DOME_tracer_CS
-use ISOMIP_tracer, only : register_ISOMIP_tracer, initialize_ISOMIP_tracer
-use ISOMIP_tracer, only : ISOMIP_tracer_column_physics, ISOMIP_tracer_surface_state
-use ISOMIP_tracer, only : ISOMIP_tracer_end, ISOMIP_tracer_CS
-use RGC_tracer, only : register_RGC_tracer, initialize_RGC_tracer
-use RGC_tracer, only : RGC_tracer_column_physics
-use RGC_tracer, only : RGC_tracer_end, RGC_tracer_CS
-use ideal_age_example, only : register_ideal_age_tracer, initialize_ideal_age_tracer
-use ideal_age_example, only : ideal_age_tracer_column_physics, ideal_age_tracer_surface_state
-use ideal_age_example, only : ideal_age_stock, ideal_age_example_end, ideal_age_tracer_CS
-use regional_dyes, only : register_dye_tracer, initialize_dye_tracer
-use regional_dyes, only : dye_tracer_column_physics, dye_tracer_surface_state
-use regional_dyes, only : dye_stock, regional_dyes_end, dye_tracer_CS
-use MOM_OCMIP2_CFC, only : register_OCMIP2_CFC, initialize_OCMIP2_CFC, flux_init_OCMIP2_CFC
-use MOM_OCMIP2_CFC, only : OCMIP2_CFC_column_physics, OCMIP2_CFC_surface_state
-use MOM_OCMIP2_CFC, only : OCMIP2_CFC_stock, OCMIP2_CFC_end, OCMIP2_CFC_CS
-use MOM_CFC_cap, only : register_CFC_cap, initialize_CFC_cap
-use MOM_CFC_cap, only : CFC_cap_column_physics, CFC_cap_set_forcing
-use MOM_CFC_cap, only : CFC_cap_stock, CFC_cap_end, CFC_cap_CS
-use oil_tracer, only : register_oil_tracer, initialize_oil_tracer
-use oil_tracer, only : oil_tracer_column_physics, oil_tracer_surface_state
-use oil_tracer, only : oil_stock, oil_tracer_end, oil_tracer_CS
-use advection_test_tracer, only : register_advection_test_tracer, initialize_advection_test_tracer
-use advection_test_tracer, only : advection_test_tracer_column_physics, advection_test_tracer_surface_state
-use advection_test_tracer, only : advection_test_stock, advection_test_tracer_end, advection_test_tracer_CS
-use dyed_obc_tracer, only : register_dyed_obc_tracer, initialize_dyed_obc_tracer
-use dyed_obc_tracer, only : dyed_obc_tracer_column_physics
-use dyed_obc_tracer, only : dyed_obc_tracer_end, dyed_obc_tracer_CS
-use MOM_generic_tracer, only : register_MOM_generic_tracer, initialize_MOM_generic_tracer
-use MOM_generic_tracer, only : MOM_generic_tracer_column_physics, MOM_generic_tracer_surface_state
-use MOM_generic_tracer, only : end_MOM_generic_tracer, MOM_generic_tracer_get, MOM_generic_flux_init
-use MOM_generic_tracer, only : MOM_generic_tracer_stock, MOM_generic_tracer_min_max, MOM_generic_tracer_CS
-use MOM_generic_tracer, only : register_MOM_generic_tracer_segments
-use pseudo_salt_tracer, only : register_pseudo_salt_tracer, initialize_pseudo_salt_tracer
-use pseudo_salt_tracer, only : pseudo_salt_tracer_column_physics, pseudo_salt_tracer_surface_state
-use pseudo_salt_tracer, only : pseudo_salt_stock, pseudo_salt_tracer_end, pseudo_salt_tracer_CS
-use boundary_impulse_tracer, only : register_boundary_impulse_tracer, initialize_boundary_impulse_tracer
-use boundary_impulse_tracer, only : boundary_impulse_tracer_column_physics, boundary_impulse_tracer_surface_state
-use boundary_impulse_tracer, only : boundary_impulse_stock, boundary_impulse_tracer_end
-use boundary_impulse_tracer, only : boundary_impulse_tracer_CS
-use nw2_tracers, only : nw2_tracers_CS, register_nw2_tracers, nw2_tracer_column_physics
-use nw2_tracers, only : initialize_nw2_tracers, nw2_tracers_end
-
-implicit none ; private
-
-public call_tracer_register, tracer_flow_control_init, call_tracer_set_forcing
-public call_tracer_column_fns, call_tracer_surface_state, call_tracer_stocks
-public call_tracer_flux_init, get_chl_from_model, tracer_flow_control_end
-public call_tracer_register_obc_segments
-
-!> The control structure for orchestrating the calling of tracer packages
-type, public :: tracer_flow_control_CS ; private
- logical :: use_USER_tracer_example = .false. !< If true, use the USER_tracer_example package
- logical :: use_DOME_tracer = .false. !< If true, use the DOME_tracer package
- logical :: use_ISOMIP_tracer = .false. !< If true, use the ISOMPE_tracer package
- logical :: use_RGC_tracer =.false. !< If true, use the RGC_tracer package
- logical :: use_ideal_age = .false. !< If true, use the ideal age tracer package
- logical :: use_regional_dyes = .false. !< If true, use the regional dyes tracer package
- logical :: use_oil = .false. !< If true, use the oil tracer package
- logical :: use_advection_test_tracer = .false. !< If true, use the advection_test_tracer package
- logical :: use_OCMIP2_CFC = .false. !< If true, use the OCMIP2_CFC tracer package
- logical :: use_CFC_cap = .false. !< If true, use the CFC_cap tracer package
- logical :: use_MOM_generic_tracer = .false. !< If true, use the MOM_generic_tracer packages
- logical :: use_pseudo_salt_tracer = .false. !< If true, use the psuedo_salt tracer package
- logical :: use_boundary_impulse_tracer = .false. !< If true, use the boundary impulse tracer package
- logical :: use_dyed_obc_tracer = .false. !< If true, use the dyed OBC tracer package
- logical :: use_nw2_tracers = .false. !< If true, use the NW2 tracer package
- !>@{ Pointers to the control strucures for the tracer packages
- type(USER_tracer_example_CS), pointer :: USER_tracer_example_CSp => NULL()
- type(DOME_tracer_CS), pointer :: DOME_tracer_CSp => NULL()
- type(ISOMIP_tracer_CS), pointer :: ISOMIP_tracer_CSp => NULL()
- type(RGC_tracer_CS), pointer :: RGC_tracer_CSp => NULL()
- type(ideal_age_tracer_CS), pointer :: ideal_age_tracer_CSp => NULL()
- type(dye_tracer_CS), pointer :: dye_tracer_CSp => NULL()
- type(oil_tracer_CS), pointer :: oil_tracer_CSp => NULL()
- type(advection_test_tracer_CS), pointer :: advection_test_tracer_CSp => NULL()
- type(OCMIP2_CFC_CS), pointer :: OCMIP2_CFC_CSp => NULL()
- type(CFC_cap_CS), pointer :: CFC_cap_CSp => NULL()
- type(MOM_generic_tracer_CS), pointer :: MOM_generic_tracer_CSp => NULL()
- type(pseudo_salt_tracer_CS), pointer :: pseudo_salt_tracer_CSp => NULL()
- type(boundary_impulse_tracer_CS), pointer :: boundary_impulse_tracer_CSp => NULL()
- type(dyed_obc_tracer_CS), pointer :: dyed_obc_tracer_CSp => NULL()
- type(nw2_tracers_CS), pointer :: nw2_tracers_CSp => NULL()
- !>@}
-end type tracer_flow_control_CS
-
-contains
-
-
-!> This subroutine carries out a series of calls to initialize the air-sea
-!! tracer fluxes, but it does not record the generated indicies, and it may
-!! be called _before_ the ocean model has been initialized and may be called
-!! on non-ocean PEs. It is not necessary to call this routine for ocean-only
-!! runs, because the same calls are made again inside of the routines called by
-!! call_tracer_register
-subroutine call_tracer_flux_init(verbosity)
- integer, optional, intent(in) :: verbosity !< A 0-9 integer indicating a level of verbosity.
-
- type(param_file_type) :: param_file ! A structure to parse for run-time parameters
- character(len=40) :: mdl = "call_tracer_flux_init" ! This module's name.
- logical :: use_OCMIP_CFCs, use_MOM_generic_tracer
-
- ! Determine which tracer routines with tracer fluxes are to be called. Note
- ! that not every tracer package is required to have a flux_init call.
- call get_MOM_Input(param_file, check_params=.false.)
-
- call get_param(param_file, mdl, "USE_OCMIP2_CFC", use_OCMIP_CFCs, &
- default=.false., do_not_log=.true.)
- call get_param(param_file, mdl, "USE_generic_tracer", use_MOM_generic_tracer,&
- default=.false., do_not_log=.true.)
- call close_param_file(param_file, quiet_close=.true.)
-
- if (use_OCMIP_CFCs) call flux_init_OCMIP2_CFC(verbosity=verbosity)
- if (use_MOM_generic_tracer) then
- call MOM_generic_flux_init(verbosity=verbosity)
- endif
-
-end subroutine call_tracer_flux_init
-
-! The following 5 subroutines and associated definitions provide the machinery to register and call
-! the subroutines that initialize tracers and apply vertical column processes to tracers.
-
-!> This subroutine determines which tracer packages are to be used and does the calls to
-!! register their tracers to be advected, diffused, and read from restarts.
-subroutine call_tracer_register(G, GV, US, param_file, CS, tr_Reg, restart_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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time
- !! parameters.
- type(tracer_flow_control_CS), pointer :: CS !< A pointer that is set to point to the
- !! control structure for this module.
- type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the
- !! control structure for the tracer
- !! advection and diffusion module.
- type(MOM_restart_CS), intent(inout) :: restart_CS !< A pointer to the restart control
- !! structure.
-
- ! This include declares and sets the variable "version".
-# include "version_variable.h"
- character(len=40) :: mdl = "MOM_tracer_flow_control" ! This module's name.
-
- if (associated(CS)) then
- call MOM_error(WARNING, "call_tracer_register called with an associated "// &
- "control structure.")
- return
- else ; allocate(CS) ; endif
-
- ! Read all relevant parameters and write them to the model log.
- call log_version(param_file, mdl, version, "")
- call get_param(param_file, mdl, "USE_USER_TRACER_EXAMPLE", CS%use_USER_tracer_example, &
- "If true, use the USER_tracer_example tracer package.", &
- default=.false.)
- call get_param(param_file, mdl, "USE_DOME_TRACER", CS%use_DOME_tracer, &
- "If true, use the DOME_tracer tracer package.", &
- default=.false.)
- call get_param(param_file, mdl, "USE_ISOMIP_TRACER", CS%use_ISOMIP_tracer, &
- "If true, use the ISOMIP_tracer tracer package.", &
- default=.false.)
- call get_param(param_file, mdl, "USE_RGC_TRACER", CS%use_RGC_tracer, &
- "If true, use the RGC_tracer tracer package.", &
- default=.false.)
- call get_param(param_file, mdl, "USE_IDEAL_AGE_TRACER", CS%use_ideal_age, &
- "If true, use the ideal_age_example tracer package.", &
- default=.false.)
- call get_param(param_file, mdl, "USE_REGIONAL_DYES", CS%use_regional_dyes, &
- "If true, use the regional_dyes tracer package.", &
- default=.false.)
- call get_param(param_file, mdl, "USE_OIL_TRACER", CS%use_oil, &
- "If true, use the oil_tracer tracer package.", &
- default=.false.)
- call get_param(param_file, mdl, "USE_ADVECTION_TEST_TRACER", CS%use_advection_test_tracer, &
- "If true, use the advection_test_tracer tracer package.", &
- default=.false.)
- call get_param(param_file, mdl, "USE_OCMIP2_CFC", CS%use_OCMIP2_CFC, &
- "If true, use the MOM_OCMIP2_CFC tracer package.", &
- default=.false.)
- call get_param(param_file, mdl, "USE_CFC_CAP", CS%use_CFC_cap, &
- "If true, use the MOM_CFC_cap tracer package.", &
- default=.false.)
- call get_param(param_file, mdl, "USE_generic_tracer", CS%use_MOM_generic_tracer, &
- "If true and _USE_GENERIC_TRACER is defined as a "//&
- "preprocessor macro, use the MOM_generic_tracer packages.", &
- default=.false.)
- call get_param(param_file, mdl, "USE_PSEUDO_SALT_TRACER", CS%use_pseudo_salt_tracer, &
- "If true, use the pseudo salt tracer, typically run as a diagnostic.", &
- default=.false.)
- call get_param(param_file, mdl, "USE_BOUNDARY_IMPULSE_TRACER", CS%use_boundary_impulse_tracer, &
- "If true, use the boundary impulse tracer.", &
- default=.false.)
- call get_param(param_file, mdl, "USE_DYED_OBC_TRACER", CS%use_dyed_obc_tracer, &
- "If true, use the dyed_obc_tracer tracer package.", &
- default=.false.)
- call get_param(param_file, mdl, "USE_NW2_TRACERS", CS%use_nw2_tracers, &
- "If true, use the NeverWorld2 tracers.", &
- default=.false.)
-
-! Add other user-provided calls to register tracers for restarting here. Each
-! tracer package registration call returns a logical false if it cannot be run
-! for some reason. This then overrides the run-time selection from above.
- if (CS%use_USER_tracer_example) CS%use_USER_tracer_example = &
- USER_register_tracer_example(G, GV, US, param_file, CS%USER_tracer_example_CSp, &
- tr_Reg, restart_CS)
- if (CS%use_DOME_tracer) CS%use_DOME_tracer = &
- register_DOME_tracer(G, GV, US, param_file, CS%DOME_tracer_CSp, &
- tr_Reg, restart_CS)
- if (CS%use_ISOMIP_tracer) CS%use_ISOMIP_tracer = &
- register_ISOMIP_tracer(G%HI, GV, param_file, CS%ISOMIP_tracer_CSp, &
- tr_Reg, restart_CS)
- if (CS%use_RGC_tracer) CS%use_RGC_tracer = &
- register_RGC_tracer(G, GV, param_file, CS%RGC_tracer_CSp, &
- tr_Reg, restart_CS)
- if (CS%use_ideal_age) CS%use_ideal_age = &
- register_ideal_age_tracer(G%HI, GV, param_file, CS%ideal_age_tracer_CSp, &
- tr_Reg, restart_CS)
- if (CS%use_regional_dyes) CS%use_regional_dyes = &
- register_dye_tracer(G%HI, GV, US, param_file, CS%dye_tracer_CSp, &
- tr_Reg, restart_CS)
- if (CS%use_oil) CS%use_oil = &
- register_oil_tracer(G%HI, GV, US, param_file, CS%oil_tracer_CSp, &
- tr_Reg, restart_CS)
- if (CS%use_advection_test_tracer) CS%use_advection_test_tracer = &
- register_advection_test_tracer(G, GV, param_file, CS%advection_test_tracer_CSp, &
- tr_Reg, restart_CS)
- if (CS%use_OCMIP2_CFC) CS%use_OCMIP2_CFC = &
- register_OCMIP2_CFC(G%HI, GV, param_file, CS%OCMIP2_CFC_CSp, &
- tr_Reg, restart_CS)
- if (CS%use_CFC_cap) CS%use_CFC_cap = &
- register_CFC_cap(G%HI, GV, param_file, CS%CFC_cap_CSp, &
- tr_Reg, restart_CS)
- if (CS%use_MOM_generic_tracer) CS%use_MOM_generic_tracer = &
- register_MOM_generic_tracer(G%HI, G, GV, param_file, CS%MOM_generic_tracer_CSp, &
- tr_Reg, restart_CS)
- if (CS%use_pseudo_salt_tracer) CS%use_pseudo_salt_tracer = &
- register_pseudo_salt_tracer(G%HI, GV, param_file, CS%pseudo_salt_tracer_CSp, &
- tr_Reg, restart_CS)
- if (CS%use_boundary_impulse_tracer) CS%use_boundary_impulse_tracer = &
- register_boundary_impulse_tracer(G%HI, GV, US, param_file, CS%boundary_impulse_tracer_CSp, &
- tr_Reg, restart_CS)
- if (CS%use_dyed_obc_tracer) CS%use_dyed_obc_tracer = &
- register_dyed_obc_tracer(G%HI, GV, param_file, CS%dyed_obc_tracer_CSp, &
- tr_Reg, restart_CS)
- if (CS%use_nw2_tracers) CS%use_nw2_tracers = &
- register_nw2_tracers(G%HI, GV, US, param_file, CS%nw2_tracers_CSp, tr_Reg, restart_CS)
-
-end subroutine call_tracer_register
-
-!> This subroutine calls all registered tracer initialization
-!! subroutines.
-subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag, OBC, &
- CS, sponge_CSp, ALE_sponge_CSp, tv)
- logical, intent(in) :: restart !< 1 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(param_file_type), intent(in) :: param_file !< A structure to parse for
- !! run-time parameters
- type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to
- !! regulate diagnostic output.
- type(ocean_OBC_type), pointer :: OBC !< This open boundary condition
- !! type specifies whether, where,
- !! and what open boundary
- !! conditions are used.
- type(tracer_flow_control_CS), pointer :: CS !< The control structure returned
- !! by a previous call to
- !! call_tracer_register.
- type(sponge_CS), pointer :: sponge_CSp !< A pointer to the control
- !! structure for the sponges, if they are in use.
- !! Otherwise this may be unassociated.
- type(ALE_sponge_CS), pointer :: ALE_sponge_CSp !< A pointer to the control
- !! structure for the ALE sponges, if they are in use.
- !! Otherwise this may be unassociated.
- type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
- !! thermodynamic variables
-
- if (.not. associated(CS)) call MOM_error(FATAL, "tracer_flow_control_init: "// &
- "Module must be initialized via call_tracer_register before it is used.")
-
-! Add other user-provided calls here.
- if (CS%use_USER_tracer_example) &
- call USER_initialize_tracer(restart, day, G, GV, US, h, diag, OBC, CS%USER_tracer_example_CSp, &
- sponge_CSp)
- if (CS%use_DOME_tracer) &
- call initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS%DOME_tracer_CSp, &
- sponge_CSp, tv)
- if (CS%use_ISOMIP_tracer) &
- call initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS%ISOMIP_tracer_CSp, &
- ALE_sponge_CSp)
- if (CS%use_RGC_tracer) &
- call initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS%RGC_tracer_CSp, &
- sponge_CSp, ALE_sponge_CSp)
- if (CS%use_ideal_age) &
- call initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS%ideal_age_tracer_CSp, &
- sponge_CSp)
- if (CS%use_regional_dyes) &
- call initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS%dye_tracer_CSp, sponge_CSp, tv)
- if (CS%use_oil) &
- call initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, CS%oil_tracer_CSp, sponge_CSp)
- if (CS%use_advection_test_tracer) &
- call initialize_advection_test_tracer(restart, day, G, GV, h, diag, OBC, CS%advection_test_tracer_CSp, &
- sponge_CSp)
- if (CS%use_OCMIP2_CFC) &
- call initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS%OCMIP2_CFC_CSp, sponge_CSp)
- if (CS%use_CFC_cap) &
- call initialize_CFC_cap(restart, day, G, GV, US, h, diag, OBC, CS%CFC_cap_CSp)
-
- if (CS%use_MOM_generic_tracer) &
- call initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, diag, OBC, &
- CS%MOM_generic_tracer_CSp, sponge_CSp, ALE_sponge_CSp)
- if (CS%use_pseudo_salt_tracer) &
- call initialize_pseudo_salt_tracer(restart, day, G, GV, US, h, diag, OBC, CS%pseudo_salt_tracer_CSp, &
- sponge_CSp, tv)
- if (CS%use_boundary_impulse_tracer) &
- call initialize_boundary_impulse_tracer(restart, day, G, GV, US, h, diag, OBC, CS%boundary_impulse_tracer_CSp, &
- sponge_CSp, tv)
- if (CS%use_dyed_obc_tracer) &
- call initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS%dyed_obc_tracer_CSp)
- if (CS%use_nw2_tracers) &
- call initialize_nw2_tracers(restart, day, G, GV, US, h, tv, diag, CS%nw2_tracers_CSp)
-
-end subroutine tracer_flow_control_init
-
-!> This subroutine calls all registered tracers to register their OBC segments
-!! similar to register_temp_salt_segments for T&S
-subroutine call_tracer_register_obc_segments(GV, param_file, CS, tr_Reg, OBC)
- 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(tracer_flow_control_CS), pointer :: CS !< A pointer that is set to point to the
- !! control structure for this module.
- type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the
- !! control structure for the tracer
- !! advection and diffusion module.
- type(ocean_OBC_type), pointer :: OBC !< This open boundary condition
- !! type specifies whether, where,
- !! and what open boundary
- !! conditions are used.
-
- if (CS%use_MOM_generic_tracer) &
- call register_MOM_generic_tracer_segments(CS%MOM_generic_tracer_CSp, GV, OBC, tr_Reg, param_file)
-
-end subroutine call_tracer_register_obc_segments
-
-!> This subroutine extracts the chlorophyll concentrations from the model state, if possible
-subroutine get_chl_from_model(Chl_array, 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.
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
- intent(out) :: Chl_array !< The array in which to store the model's
- !! Chlorophyll-A concentrations [mg m-3].
- type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a
- !! previous call to call_tracer_register.
-
- if (CS%use_MOM_generic_tracer) then
- call MOM_generic_tracer_get('chl', 'field', Chl_array, CS%MOM_generic_tracer_CSp)
- else
- call MOM_error(FATAL, "get_chl_from_model was called in a configuration "// &
- "that is unable to provide a sensible model-based value.\n"// &
- "CS%use_MOM_generic_tracer is false and no other viable options are on.")
- endif
-
-end subroutine get_chl_from_model
-
-!> This subroutine calls the individual tracer modules' subroutines to
-!! specify or read quantities related to their surface forcing.
-subroutine call_tracer_set_forcing(sfc_state, fluxes, day_start, day_interval, G, US, Rho0, CS)
-
- type(surface), intent(inout) :: sfc_state !< A structure containing fields that
- !! describe the surface state of the
- !! ocean.
- type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any
- !! possible forcing fields. Unused fields
- !! have NULL ptrs.
- type(time_type), intent(in) :: day_start !< Start time of the fluxes.
- type(time_type), intent(in) :: day_interval !< Length of time over which these
- !! fluxes will be applied.
- type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
- type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- real, intent(in) :: Rho0 !< The mean ocean density [R ~> kg m-3]
- type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a
- !! previous call to call_tracer_register.
-
- if (.not. associated(CS)) call MOM_error(FATAL, "call_tracer_set_forcing"// &
- "Module must be initialized via call_tracer_register before it is used.")
-! if (CS%use_ideal_age) &
-! call ideal_age_tracer_set_forcing(sfc_state, fluxes, day_start, day_interval, &
-! G, CS%ideal_age_tracer_CSp)
- if (CS%use_CFC_cap) &
- call CFC_cap_set_forcing(sfc_state, fluxes, day_start, day_interval, G, US, Rho0, &
- CS%CFC_cap_CSp)
-
-end subroutine call_tracer_set_forcing
-
-!> This subroutine calls all registered tracer column physics subroutines.
-subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, US, tv, optics, CS, &
- debug, KPP_CSp, nonLocalTrans, 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 !< an array to which the amount of
- !! fluid entrained from the layer above during this call
- !! will be added [H ~> m or kg m-2].
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: eb !< an array to which the amount of
- !! fluid entrained from the layer below during this call
- !! will be added [H ~> m or kg m-2].
- type(forcing), intent(in) :: fluxes !< A structure containing pointers to
- !! any possible forcing fields.
- !! Unused fields have NULL ptrs.
- 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(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various
- !! thermodynamic variables.
- type(optics_type), pointer :: optics !< The structure containing optical
- !! properties.
- type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by
- !! a previous call to
- !! call_tracer_register.
- logical, intent(in) :: debug !< If true calculate checksums
- type(KPP_CS), optional, pointer :: KPP_CSp !< KPP control structure
- real, optional, intent(in) :: nonLocalTrans(:,:,:) !< Non-local transport [nondim]
- 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]
- real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over
- !! which fluxes can be applied [H ~> m or kg m-2]
-
- if (.not. associated(CS)) call MOM_error(FATAL, "call_tracer_column_fns: "// &
- "Module must be initialized via call_tracer_register before it is used.")
-
- ! Use the applyTracerBoundaryFluxesInOut to handle surface fluxes
- if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then
- ! Add calls to tracer column functions here.
- if (CS%use_USER_tracer_example) &
- call tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%USER_tracer_example_CSp)
- if (CS%use_DOME_tracer) &
- call DOME_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%DOME_tracer_CSp, &
- evap_CFL_limit=evap_CFL_limit, &
- minimum_forcing_depth=minimum_forcing_depth)
- if (CS%use_ISOMIP_tracer) &
- call ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%ISOMIP_tracer_CSp, &
- evap_CFL_limit=evap_CFL_limit, &
- minimum_forcing_depth=minimum_forcing_depth)
- if (CS%use_RGC_tracer) &
- call RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%RGC_tracer_CSp, &
- evap_CFL_limit=evap_CFL_limit, &
- minimum_forcing_depth=minimum_forcing_depth)
- if (CS%use_ideal_age) &
- call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, tv, CS%ideal_age_tracer_CSp, &
- evap_CFL_limit=evap_CFL_limit, &
- minimum_forcing_depth=minimum_forcing_depth, &
- Hbl=Hml)
- if (CS%use_regional_dyes) &
- call dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, tv, CS%dye_tracer_CSp, &
- evap_CFL_limit=evap_CFL_limit, &
- minimum_forcing_depth=minimum_forcing_depth)
- if (CS%use_oil) &
- call oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%oil_tracer_CSp, tv, &
- evap_CFL_limit=evap_CFL_limit, &
- minimum_forcing_depth=minimum_forcing_depth)
-
- if (CS%use_advection_test_tracer) &
- call advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%advection_test_tracer_CSp, &
- evap_CFL_limit=evap_CFL_limit, &
- minimum_forcing_depth=minimum_forcing_depth)
- if (CS%use_OCMIP2_CFC) &
- call OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%OCMIP2_CFC_CSp, &
- evap_CFL_limit=evap_CFL_limit, &
- minimum_forcing_depth=minimum_forcing_depth)
- if (CS%use_CFC_cap) &
- call CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%CFC_cap_CSp, &
- KPP_CSp=KPP_CSp, &
- nonLocalTrans=nonLocalTrans, &
- evap_CFL_limit=evap_CFL_limit, &
- minimum_forcing_depth=minimum_forcing_depth)
- if (CS%use_MOM_generic_tracer) then
- if (US%QRZ_T_to_W_m2 /= 1.0) call MOM_error(FATAL, "MOM_generic_tracer_column_physics "//&
- "has not been written to permit dimensionsal rescaling. Set all 4 of the "//&
- "[QRZT]_RESCALE_POWER parameters to 0.")
- call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, &
- G, GV, US, CS%MOM_generic_tracer_CSp, tv, optics, &
- evap_CFL_limit=evap_CFL_limit, &
- minimum_forcing_depth=minimum_forcing_depth)
- endif
- if (CS%use_pseudo_salt_tracer) &
- call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%pseudo_salt_tracer_CSp, tv, &
- debug, &
- KPP_CSp=KPP_CSp, &
- nonLocalTrans=nonLocalTrans, &
- evap_CFL_limit=evap_CFL_limit, &
- minimum_forcing_depth=minimum_forcing_depth)
- if (CS%use_boundary_impulse_tracer) &
- call boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%boundary_impulse_tracer_CSp, tv, debug, &
- evap_CFL_limit=evap_CFL_limit, &
- minimum_forcing_depth=minimum_forcing_depth)
- if (CS%use_dyed_obc_tracer) &
- call dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%dyed_obc_tracer_CSp, &
- evap_CFL_limit=evap_CFL_limit, &
- minimum_forcing_depth=minimum_forcing_depth)
- if (CS%use_nw2_tracers) &
- call nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, tv, CS%nw2_tracers_CSp, &
- evap_CFL_limit=evap_CFL_limit, &
- minimum_forcing_depth=minimum_forcing_depth)
- else ! Apply tracer surface fluxes using ea on the first layer
- if (CS%use_USER_tracer_example) &
- call tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%USER_tracer_example_CSp)
- if (CS%use_DOME_tracer) &
- call DOME_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%DOME_tracer_CSp)
- if (CS%use_ISOMIP_tracer) &
- call ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%ISOMIP_tracer_CSp)
- if (CS%use_RGC_tracer) &
- call RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%RGC_tracer_CSp)
- if (CS%use_ideal_age) &
- call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, tv, CS%ideal_age_tracer_CSp, Hbl=Hml)
- if (CS%use_regional_dyes) &
- call dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, tv, CS%dye_tracer_CSp)
- if (CS%use_oil) &
- call oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%oil_tracer_CSp, tv)
- if (CS%use_advection_test_tracer) &
- call advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%advection_test_tracer_CSp)
- if (CS%use_OCMIP2_CFC) &
- call OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%OCMIP2_CFC_CSp)
- if (CS%use_CFC_cap) &
- call CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%CFC_cap_CSp, &
- KPP_CSp=KPP_CSp, &
- nonLocalTrans=nonLocalTrans)
- if (CS%use_MOM_generic_tracer) then
- if (US%QRZ_T_to_W_m2 /= 1.0) call MOM_error(FATAL, "MOM_generic_tracer_column_physics "//&
- "has not been written to permit dimensionsal rescaling. Set all 4 of the "//&
- "[QRZT]_RESCALE_POWER parameters to 0.")
- call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, &
- G, GV, US, CS%MOM_generic_tracer_CSp, tv, optics)
- endif
- if (CS%use_pseudo_salt_tracer) &
- call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%pseudo_salt_tracer_CSp, &
- tv, debug, &
- KPP_CSp=KPP_CSp, &
- nonLocalTrans=nonLocalTrans)
- if (CS%use_boundary_impulse_tracer) &
- call boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%boundary_impulse_tracer_CSp, tv, debug)
- if (CS%use_dyed_obc_tracer) &
- call dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%dyed_obc_tracer_CSp)
- if (CS%use_nw2_tracers) call nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, tv, CS%nw2_tracers_CSp)
- endif
-
-end subroutine call_tracer_column_fns
-
-!> This subroutine calls all registered tracer packages to enable them to
-!! add to the surface state returned to the coupler. These routines are optional.
-subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock_units, &
- num_stocks, stock_index, got_min_max, global_min, global_max, &
- xgmin, ygmin, zgmin, xgmax, ygmax, zgmax)
- 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]
- real, dimension(:), intent(out) :: stock_values !< The globally mass-integrated
- !! amount of a tracer [kg conc].
- type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a
- !! previous call to
- !! call_tracer_register.
- character(len=*), dimension(:), &
- optional, intent(out) :: stock_names !< Diagnostic names to use for each stock.
- character(len=*), dimension(:), &
- optional, intent(out) :: stock_units !< Units to use in the metadata for each stock.
- integer, optional, intent(out) :: num_stocks !< The number of tracer stocks being returned.
- integer, optional, intent(in) :: stock_index !< The integer stock index from
- !! stocks_constants_mod of the stock to be returned. If this is
- !! present and greater than 0, only a single stock can be returned.
- logical, dimension(:), &
- optional, intent(inout) :: got_min_max !< Indicates whether the global min and
- !! max are found for each tracer
- real, dimension(:), optional, intent(out) :: global_min !< The global minimum of each tracer [conc]
- real, dimension(:), optional, intent(out) :: global_max !< The global maximum of each tracer [conc]
- real, dimension(:), optional, intent(out) :: xgmin !< The x-position of the global minimum in the
- !! units of G%geoLonT, often [degrees_E] or [km]
- real, dimension(:), optional, intent(out) :: ygmin !< The y-position of the global minimum in the
- !! units of G%geoLatT, often [degrees_N] or [km]
- 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]
- real, dimension(:), optional, intent(out) :: ygmax !< The y-position of the global maximum in the
- !! units of G%geoLatT, often [degrees_N] or [km]
- real, dimension(:), optional, intent(out) :: zgmax !< The z-position of the global maximum [layer]
-
- ! Local variables
- character(len=200), dimension(MAX_FIELDS_) :: names, units
- character(len=200) :: set_pkg_name
- ! real, dimension(MAX_FIELDS_) :: values ! Globally integrated tracer amounts in a
- ! new list for each tracer package [kg conc]
- type(EFP_type), dimension(MAX_FIELDS_) :: values_EFP ! Globally integrated tracer amounts in a
- ! new list for each tracer package [kg conc]
- type(EFP_type), dimension(MAX_FIELDS_) :: stock_val_EFP ! Globally integrated tracer amounts in a
- ! single master list for all tracers [kg conc]
- integer :: max_ns, ns_tot, ns, index, nn, n
-
- if (.not. associated(CS)) call MOM_error(FATAL, "call_tracer_stocks: "// &
- "Module must be initialized via call_tracer_register before it is used.")
-
- index = -1 ; if (present(stock_index)) index = stock_index
- ns_tot = 0
- max_ns = size(stock_values)
- if (present(stock_names)) max_ns = min(max_ns,size(stock_names))
- if (present(stock_units)) max_ns = min(max_ns,size(stock_units))
-
-! Add other user-provided calls here.
- if (CS%use_USER_tracer_example) then
- ns = USER_tracer_stock(h, values_EFP, G, GV, CS%USER_tracer_example_CSp, &
- names, units, stock_index)
- call store_stocks("tracer_example", ns, names, units, values_EFP, index, stock_val_EFP, &
- set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
- endif
-! if (CS%use_DOME_tracer) then
-! ns = DOME_tracer_stock(h, values, G, GV, CS%DOME_tracer_CSp, &
-! names, units, stock_index)
-! do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo
-! call store_stocks("DOME_tracer", ns, names, units, values_EFP, index, stock_val_EFP, &
-! set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
-! endif
- if (CS%use_ideal_age) then
- ns = ideal_age_stock(h, values_EFP, G, GV, CS%ideal_age_tracer_CSp, &
- names, units, stock_index)
- call store_stocks("ideal_age_example", ns, names, units, values_EFP, index, stock_val_EFP, &
- set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
- endif
- if (CS%use_regional_dyes) then
- ns = dye_stock(h, values_EFP, G, GV, CS%dye_tracer_CSp, names, units, stock_index)
- call store_stocks("regional_dyes", ns, names, units, values_EFP, index, stock_val_EFP, &
- set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
- endif
- if (CS%use_oil) then
- ns = oil_stock(h, values_EFP, G, GV, CS%oil_tracer_CSp, names, units, stock_index)
- call store_stocks("oil_tracer", ns, names, units, values_EFP, index, stock_val_EFP, &
- set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
- endif
- if (CS%use_OCMIP2_CFC) then
- ns = OCMIP2_CFC_stock(h, values_EFP, G, GV, CS%OCMIP2_CFC_CSp, names, units, stock_index)
- call store_stocks("MOM_OCMIP2_CFC", ns, names, units, values_EFP, index, stock_val_EFP, &
- set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
- endif
-
- if (CS%use_CFC_cap) then
- ns = CFC_cap_stock(h, values_EFP, G, GV, CS%CFC_cap_CSp, names, units, stock_index)
- call store_stocks("MOM_CFC_cap", ns, names, units, values_EFP, index, stock_val_EFP, &
- set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
- endif
-
- if (CS%use_advection_test_tracer) then
- ns = advection_test_stock( h, values_EFP, G, GV, CS%advection_test_tracer_CSp, &
- names, units, stock_index )
- ! do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo
- call store_stocks("advection_test_tracer", ns, names, units, values_EFP, index, stock_val_EFP, &
- set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
- endif
-
- if (CS%use_MOM_generic_tracer) then
- ns = MOM_generic_tracer_stock(h, values_EFP, G, GV, CS%MOM_generic_tracer_CSp, &
- names, units, stock_index)
- call store_stocks("MOM_generic_tracer", ns, names, units, values_EFP, index, stock_val_EFP, &
- set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
- nn=ns_tot-ns+1
- nn=MOM_generic_tracer_min_max(nn, got_min_max, global_min, global_max, &
- xgmin, ygmin, zgmin, xgmax, ygmax, zgmax ,&
- G, CS%MOM_generic_tracer_CSp,names, units)
-
- endif
- if (CS%use_pseudo_salt_tracer) then
- ns = pseudo_salt_stock(h, values_EFP, G, GV, CS%pseudo_salt_tracer_CSp, &
- names, units, stock_index)
- call store_stocks("pseudo_salt_tracer", ns, names, units, values_EFP, index, stock_val_EFP, &
- set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
- endif
-
- if (CS%use_boundary_impulse_tracer) then
- ns = boundary_impulse_stock(h, values_EFP, G, GV, CS%boundary_impulse_tracer_CSp, &
- names, units, stock_index)
- call store_stocks("boundary_impulse_tracer", ns, names, units, values_EFP, index, stock_val_EFP, &
- set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
- endif
-
- ! Sum the various quantities across all the processors.
- if (ns_tot > 0) then
- call EFP_sum_across_PEs(stock_val_EFP, ns_tot)
- do n=1,ns_tot ; stock_values(n) = EFP_to_real(stock_val_EFP(n)) ; enddo
- else
- stock_values(1) = 0.0
- endif
-
- if (present(num_stocks)) num_stocks = ns_tot
-
-end subroutine call_tracer_stocks
-
-!> This routine stores the stocks and does error handling for call_tracer_stocks.
-subroutine store_stocks(pkg_name, ns, names, units, values, index, stock_values, &
- set_pkg_name, max_ns, ns_tot, stock_names, stock_units)
- character(len=*), intent(in) :: pkg_name !< The tracer package name
- integer, intent(in) :: ns !< The number of stocks associated with this tracer package
- character(len=*), dimension(:), &
- intent(in) :: names !< Diagnostic names to use for each stock.
- character(len=*), dimension(:), &
- intent(in) :: units !< Units to use in the metadata for each stock.
- type(EFP_type), dimension(:), &
- intent(in) :: values !< The values of the tracer stocks [conc kg]
- integer, intent(in) :: index !< The integer stock index from
- !! stocks_constants_mod of the stock to be returned. If this is
- !! present and greater than 0, only a single stock can be returned.
- type(EFP_type), dimension(:), &
- intent(inout) :: stock_values !< The master list of stock values [conc kg]
- character(len=*), intent(inout) :: set_pkg_name !< The name of the last tracer package whose
- !! stocks were stored for a specific index. This is
- !! used to trigger an error if there are redundant stocks.
- integer, intent(in) :: max_ns !< The maximum size of the master stock list
- integer, intent(inout) :: ns_tot !< The total number of stocks in the master list
- character(len=*), dimension(:), &
- optional, intent(inout) :: stock_names !< Diagnostic names to use for each stock in the master list
- character(len=*), dimension(:), &
- optional, intent(inout) :: stock_units !< Units to use in the metadata for each stock in the master list
-
-! This routine stores the stocks and does error handling for call_tracer_stocks.
- character(len=16) :: ind_text, ns_text, max_text
- integer :: n
-
- if ((index > 0) .and. (ns > 0)) then
- write(ind_text,'(i8)') index
- if (ns > 1) then
- call MOM_error(FATAL,"Tracer package "//trim(pkg_name)//&
- " is not permitted to return more than one value when queried"//&
- " for specific stock index "//trim(adjustl(ind_text))//".")
- elseif (ns+ns_tot > 1) then
- call MOM_error(FATAL,"Tracer packages "//trim(pkg_name)//" and "//&
- trim(set_pkg_name)//" both attempted to set values for"//&
- " specific stock index "//trim(adjustl(ind_text))//".")
- else
- set_pkg_name = pkg_name
- endif
- endif
-
- if (ns_tot+ns > max_ns) then
- write(ns_text,'(i8)') ns_tot+ns ; write(max_text,'(i8)') max_ns
- call MOM_error(FATAL,"Attempted to return more tracer stock values (at least "//&
- trim(adjustl(ns_text))//") than the size "//trim(adjustl(max_text))//&
- "of the smallest value, name, or units array.")
- endif
-
- do n=1,ns
- stock_values(ns_tot+n) = values(n)
- if (present(stock_names)) stock_names(ns_tot+n) = names(n)
- if (present(stock_units)) stock_units(ns_tot+n) = units(n)
- enddo
- ns_tot = ns_tot + ns
-
-end subroutine store_stocks
-
-!> This subroutine calls all registered tracer packages to enable them to
-!! add to the surface state returned to the coupler. These routines are optional.
-subroutine call_tracer_surface_state(sfc_state, h, G, GV, US, CS)
- type(surface), intent(inout) :: sfc_state !< A structure containing fields that
- !! describe the surface state of the ocean.
- 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a
- !! previous call to call_tracer_register.
-
- if (.not. associated(CS)) call MOM_error(FATAL, "call_tracer_surface_state: "// &
- "Module must be initialized via call_tracer_register before it is used.")
-
-! Add other user-provided calls here.
- if (CS%use_USER_tracer_example) &
- call USER_tracer_surface_state(sfc_state, h, G, GV, CS%USER_tracer_example_CSp)
- if (CS%use_DOME_tracer) &
- call DOME_tracer_surface_state(sfc_state, h, G, GV, CS%DOME_tracer_CSp)
- if (CS%use_ISOMIP_tracer) &
- call ISOMIP_tracer_surface_state(sfc_state, h, G, GV, CS%ISOMIP_tracer_CSp)
- if (CS%use_ideal_age) &
- call ideal_age_tracer_surface_state(sfc_state, h, G, GV, CS%ideal_age_tracer_CSp)
- if (CS%use_regional_dyes) &
- call dye_tracer_surface_state(sfc_state, h, G, GV, CS%dye_tracer_CSp)
- if (CS%use_oil) &
- call oil_tracer_surface_state(sfc_state, h, G, GV, CS%oil_tracer_CSp)
- if (CS%use_advection_test_tracer) &
- call advection_test_tracer_surface_state(sfc_state, h, G, GV, CS%advection_test_tracer_CSp)
- if (CS%use_OCMIP2_CFC) &
- call OCMIP2_CFC_surface_state(sfc_state, h, G, GV, US, CS%OCMIP2_CFC_CSp)
- if (CS%use_MOM_generic_tracer) &
- call MOM_generic_tracer_surface_state(sfc_state, h, G, GV, CS%MOM_generic_tracer_CSp)
-
-end subroutine call_tracer_surface_state
-
-subroutine tracer_flow_control_end(CS)
- type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a
- !! previous call to call_tracer_register.
-
- if (CS%use_USER_tracer_example) &
- call USER_tracer_example_end(CS%USER_tracer_example_CSp)
- if (CS%use_DOME_tracer) call DOME_tracer_end(CS%DOME_tracer_CSp)
- if (CS%use_ISOMIP_tracer) call ISOMIP_tracer_end(CS%ISOMIP_tracer_CSp)
- if (CS%use_RGC_tracer) call RGC_tracer_end(CS%RGC_tracer_CSp)
- if (CS%use_ideal_age) call ideal_age_example_end(CS%ideal_age_tracer_CSp)
- if (CS%use_regional_dyes) call regional_dyes_end(CS%dye_tracer_CSp)
- if (CS%use_oil) call oil_tracer_end(CS%oil_tracer_CSp)
- if (CS%use_advection_test_tracer) call advection_test_tracer_end(CS%advection_test_tracer_CSp)
- if (CS%use_OCMIP2_CFC) call OCMIP2_CFC_end(CS%OCMIP2_CFC_CSp)
- if (CS%use_CFC_cap) call CFC_cap_end(CS%CFC_cap_CSp)
- if (CS%use_MOM_generic_tracer) call end_MOM_generic_tracer(CS%MOM_generic_tracer_CSp)
- if (CS%use_pseudo_salt_tracer) call pseudo_salt_tracer_end(CS%pseudo_salt_tracer_CSp)
- if (CS%use_boundary_impulse_tracer) call boundary_impulse_tracer_end(CS%boundary_impulse_tracer_CSp)
- if (CS%use_dyed_obc_tracer) call dyed_obc_tracer_end(CS%dyed_obc_tracer_CSp)
- if (CS%use_nw2_tracers) call nw2_tracers_end(CS%nw2_tracers_CSp)
-
- if (associated(CS)) deallocate(CS)
-end subroutine tracer_flow_control_end
-
-!> \namespace MOM_tracer_flow_control
-!!
-!! By Will Cooke, April 2003
-!! Edited by Elizabeth Yankovsky, May 2019
-!!
-!! This module contains two subroutines into which calls to other
-!! tracer initialization (call_tracer_init_fns) and column physics
-!! routines (call_tracer_column_fns) can be inserted.
-!!
-end module MOM_tracer_flow_control