portedportable, not yet portedexecuted, not portableexecutable, not hit by this run
| 1 | ! This file is part of MOM6, the Modular Ocean Model version 6. | |
| 2 | ! See the LICENSE file for licensing information. | |
| 3 | ! SPDX-License-Identifier: Apache-2.0 | |
| 4 | ||
| 5 | !> A tracer package of ideal age tracers | |
| 6 | module ideal_age_example | |
| 7 | ||
| 8 | use MOM_coms, only : EFP_type | |
| 9 | use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux | |
| 10 | use MOM_diag_mediator, only : diag_ctrl | |
| 11 | use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE | |
| 12 | use MOM_file_parser, only : get_param, log_param, log_version, param_file_type | |
| 13 | use MOM_forcing_type, only : forcing | |
| 14 | use MOM_grid, only : ocean_grid_type | |
| 15 | use MOM_hor_index, only : hor_index_type | |
| 16 | use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc | |
| 17 | use MOM_open_boundary, only : ocean_OBC_type | |
| 18 | use MOM_restart, only : query_initialized, set_initialized, MOM_restart_CS | |
| 19 | use MOM_spatial_means, only : global_mass_int_EFP | |
| 20 | use MOM_sponge, only : set_up_sponge_field, sponge_CS | |
| 21 | use MOM_time_manager, only : time_type, time_to_real | |
| 22 | use MOM_tracer_registry, only : register_tracer, tracer_registry_type | |
| 23 | use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut | |
| 24 | use MOM_tracer_Z_init, only : tracer_Z_init | |
| 25 | use MOM_unit_scaling, only : unit_scale_type | |
| 26 | use MOM_variables, only : surface | |
| 27 | use MOM_verticalGrid, only : verticalGrid_type | |
| 28 | ||
| 29 | implicit none ; private | |
| 30 | ||
| 31 | #include <MOM_memory.h> | |
| 32 | ||
| 33 | public register_ideal_age_tracer, initialize_ideal_age_tracer | |
| 34 | public ideal_age_tracer_column_physics, ideal_age_tracer_surface_state | |
| 35 | public ideal_age_stock, ideal_age_example_end | |
| 36 | public count_BL_layers | |
| 37 | ||
| 38 | integer, parameter :: NTR_MAX = 4 !< the maximum number of tracers in this module. | |
| 39 | ||
| 40 | !> The control structure for the ideal_age_tracer package | |
| 41 | type, public :: ideal_age_tracer_CS ; private | |
| 42 | integer :: ntr !< The number of tracers that are actually used. | |
| 43 | logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler. | |
| 44 | integer :: nkbl !< The number of layers in the boundary layer. The ideal | |
| 45 | !1 age tracers are reset in the top nkbl layers. | |
| 46 | character(len=200) :: IC_file !< The file in which the age-tracer initial values | |
| 47 | !! can be found, or an empty string for internal initialization. | |
| 48 | logical :: Z_IC_file !< If true, the IC_file is in Z-space. The default is false. | |
| 49 | type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. | |
| 50 | type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry | |
| 51 | real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package [years] or other units | |
| 52 | real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value [years] or other units | |
| 53 | real, dimension(NTR_MAX) :: young_val = 0.0 !< The value assigned to tr at the surface [years] or other units | |
| 54 | real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out [years] or other units | |
| 55 | real, dimension(NTR_MAX) :: growth_rate !< The exponential growth rate for the young value [year-1] | |
| 56 | real, dimension(NTR_MAX) :: tracer_start_year !< The year in which tracers start aging, or at which the | |
| 57 | !! surface value equals young_val [years]. | |
| 58 | logical :: use_real_BL_depth !< If true, uses the BL scheme to determine the number of | |
| 59 | !! layers above the BL depth instead of the fixed nkbl value. | |
| 60 | integer :: BL_residence_num !< The tracer number assigned to the BL residence tracer in this module | |
| 61 | logical :: tracers_may_reinit !< If true, these tracers be set up via the initialization code if | |
| 62 | !! they are not found in the restart files. | |
| 63 | logical :: tracer_ages(NTR_MAX) !< Indicates whether each tracer ages. | |
| 64 | ||
| 65 | integer, dimension(NTR_MAX) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and the | |
| 66 | !! surface tracer concentrations are to be provided to the coupler. | |
| 67 | ||
| 68 | type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to | |
| 69 | !! regulate the timing of diagnostic output. | |
| 70 | type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart controls structure | |
| 71 | ||
| 72 | type(vardesc) :: tr_desc(NTR_MAX) !< Descriptions and metadata for the tracers | |
| 73 | ||
| 74 | end type ideal_age_tracer_CS | |
| 75 | ||
| 76 | contains | |
| 77 | ||
| 78 | !> Register the ideal age tracer fields to be used with MOM. | |
| 79 | 1 | function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) |
| 80 | type(hor_index_type), intent(in) :: HI !< A horizontal index type structure | |
| 81 | type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure | |
| 82 | type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters | |
| 83 | type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous | |
| 84 | !! call to register_ideal_age_tracer. | |
| 85 | type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control | |
| 86 | !! structure for the tracer advection and | |
| 87 | !! diffusion module | |
| 88 | type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct | |
| 89 | ||
| 90 | ! This include declares and sets the variable "version". | |
| 91 | # include "version_variable.h" | |
| 92 | character(len=40) :: mdl = "ideal_age_example" ! This module's name. | |
| 93 | character(len=200) :: inputdir ! The directory where the input files are. | |
| 94 | character(len=48) :: var_name ! The variable's name. | |
| 95 | real, pointer :: tr_ptr(:,:,:) => NULL() ! The tracer concentration [years] | |
| 96 | logical :: register_ideal_age_tracer | |
| 97 | logical :: do_ideal_age, do_vintage, do_ideal_age_dated, do_BL_residence | |
| 98 | integer :: isd, ied, jsd, jed, nz, m | |
| 99 | 1 | isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke |
| 100 | ||
| 101 | 1 | if (associated(CS)) then |
| 102 | call MOM_error(FATAL, "register_ideal_age_tracer called with an "// & | |
| 103 | 0 | "associated control structure.") |
| 104 | endif | |
| 105 | 42 | allocate(CS) |
| 106 | ||
| 107 | ! Read all relevant parameters and write them to the model log. | |
| 108 | 1 | call log_version(param_file, mdl, version, "") |
| 109 | call get_param(param_file, mdl, "DO_IDEAL_AGE", do_ideal_age, & | |
| 110 | "If true, use an ideal age tracer that is set to 0 age "//& | |
| 111 | "in the boundary layer and ages at unit rate in the interior.", & | |
| 112 | 1 | default=.true.) |
| 113 | call get_param(param_file, mdl, "DO_IDEAL_VINTAGE", do_vintage, & | |
| 114 | "If true, use an ideal vintage tracer that is set to an "//& | |
| 115 | "exponentially increasing value in the boundary layer and "//& | |
| 116 | 1 | "is conserved thereafter.", default=.false.) |
| 117 | call get_param(param_file, mdl, "DO_IDEAL_AGE_DATED", do_ideal_age_dated, & | |
| 118 | "If true, use an ideal age tracer that is everywhere 0 "//& | |
| 119 | "before IDEAL_AGE_DATED_START_YEAR, but the behaves like "//& | |
| 120 | "the standard ideal age tracer - i.e. is set to 0 age in "//& | |
| 121 | "the boundary layer and ages at unit rate in the interior.", & | |
| 122 | 1 | default=.false.) |
| 123 | call get_param(param_file, mdl, "DO_BL_RESIDENCE", do_BL_residence, & | |
| 124 | "If true, use a residence tracer that is set to 0 age "//& | |
| 125 | "in the interior and ages at unit rate in the boundary layer.", & | |
| 126 | 1 | default=.false.) |
| 127 | call get_param(param_file, mdl, "USE_REAL_BL_DEPTH", CS%use_real_BL_depth, & | |
| 128 | "If true, the ideal age tracers will use the boundary layer "//& | |
| 129 | "depth diagnosed from the BL or bulkmixedlayer scheme.", & | |
| 130 | 1 | default=.false.) |
| 131 | call get_param(param_file, mdl, "AGE_IC_FILE", CS%IC_file, & | |
| 132 | "The file in which the age-tracer initial values can be "//& | |
| 133 | "found, or an empty string for internal initialization.", & | |
| 134 | 1 | default=" ") |
| 135 | 1 | if ((len_trim(CS%IC_file) > 0) .and. (scan(CS%IC_file,'/') == 0)) then |
| 136 | ! Add the directory if CS%IC_file is not already a complete path. | |
| 137 | 0 | call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") |
| 138 | 0 | CS%IC_file = trim(slasher(inputdir))//trim(CS%IC_file) |
| 139 | 0 | call log_param(param_file, mdl, "INPUTDIR/AGE_IC_FILE", CS%IC_file) |
| 140 | endif | |
| 141 | call get_param(param_file, mdl, "AGE_IC_FILE_IS_Z", CS%Z_IC_file, & | |
| 142 | "If true, AGE_IC_FILE is in depth space, not layer space", & | |
| 143 | 1 | default=.false.) |
| 144 | call get_param(param_file, mdl, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & | |
| 145 | "If true, tracers may go through the initialization code "//& | |
| 146 | "if they are not found in the restart files. Otherwise "//& | |
| 147 | "it is a fatal error if the tracers are not found in the "//& | |
| 148 | 1 | "restart files of a restarted run.", default=.false.) |
| 149 | ||
| 150 | 1 | CS%ntr = 0 |
| 151 | 1 | if (do_ideal_age) then |
| 152 | 1 | CS%ntr = CS%ntr + 1 ; m = CS%ntr |
| 153 | 6 | CS%tr_desc(m) = var_desc("age", "yr", "Ideal Age Tracer", cmor_field_name="agessc", caller=mdl) |
| 154 | 1 | CS%tracer_ages(m) = .true. ; CS%growth_rate(m) = 0.0 |
| 155 | 1 | CS%IC_val(m) = 0.0 ; CS%young_val(m) = 0.0 ; CS%tracer_start_year(m) = 0.0 |
| 156 | endif | |
| 157 | ||
| 158 | 1 | if (do_vintage) then |
| 159 | 0 | CS%ntr = CS%ntr + 1 ; m = CS%ntr |
| 160 | CS%tr_desc(m) = var_desc("vintage", "yr", "Exponential Vintage Tracer", & | |
| 161 | 0 | caller=mdl) |
| 162 | 0 | CS%tracer_ages(m) = .false. ; CS%growth_rate(m) = 1.0/30.0 |
| 163 | 0 | CS%IC_val(m) = 0.0 ; CS%young_val(m) = 1e-20 ; CS%tracer_start_year(m) = 0.0 |
| 164 | call get_param(param_file, mdl, "IDEAL_VINTAGE_START_YEAR", CS%tracer_start_year(m), & | |
| 165 | "The date at which the ideal vintage tracer starts.", & | |
| 166 | 0 | units="years", default=0.0) |
| 167 | endif | |
| 168 | ||
| 169 | 1 | if (do_ideal_age_dated) then |
| 170 | 0 | CS%ntr = CS%ntr + 1 ; m = CS%ntr |
| 171 | CS%tr_desc(m) = var_desc("age_dated","yr","Ideal Age Tracer with a Start Date",& | |
| 172 | 0 | caller=mdl) |
| 173 | 0 | CS%tracer_ages(m) = .true. ; CS%growth_rate(m) = 0.0 |
| 174 | 0 | CS%IC_val(m) = 0.0 ; CS%young_val(m) = 0.0 ; CS%tracer_start_year(m) = 0.0 |
| 175 | call get_param(param_file, mdl, "IDEAL_AGE_DATED_START_YEAR", CS%tracer_start_year(m), & | |
| 176 | "The date at which the dated ideal age tracer starts.", & | |
| 177 | 0 | units="years", default=0.0) |
| 178 | endif | |
| 179 | ||
| 180 | 1 | CS%BL_residence_num = 0 |
| 181 | 1 | if (do_BL_residence) then |
| 182 | 0 | CS%ntr = CS%ntr + 1 ; m = CS%ntr ; CS%BL_residence_num = CS%ntr |
| 183 | 0 | CS%tr_desc(m) = var_desc("BL_age", "yr", "BL Residence Time Tracer", caller=mdl) |
| 184 | 0 | CS%tracer_ages(m) = .true. ; CS%growth_rate(m) = 0.0 |
| 185 | 0 | CS%IC_val(m) = 0.0 ; CS%young_val(m) = 0.0 ; CS%tracer_start_year(m) = 0.0 |
| 186 | endif | |
| 187 | ||
| 188 | 657977 | allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr), source=0.0) |
| 189 | ||
| 190 | 2 | do m=1,CS%ntr |
| 191 | ! This is needed to force the compiler not to do a copy in the registration | |
| 192 | ! calls. Curses on the designers and implementers of Fortran90. | |
| 193 | 1 | tr_ptr => CS%tr(:,:,:,m) |
| 194 | call query_vardesc(CS%tr_desc(m), name=var_name, & | |
| 195 | 1 | caller="register_ideal_age_tracer") |
| 196 | ! Register the tracer for horizontal advection, diffusion, and restarts. | |
| 197 | call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, tr_desc=CS%tr_desc(m), & | |
| 198 | registry_diags=.true., restart_CS=restart_CS, & | |
| 199 | mandatory=.not.CS%tracers_may_reinit, & | |
| 200 | 1 | flux_scale=GV%H_to_m) |
| 201 | ||
| 202 | ! Set coupled_tracers to be true (hard-coded above) to provide the surface | |
| 203 | ! values to the coupler (if any). This is meta-code and its arguments will | |
| 204 | ! currently (deliberately) give fatal errors if it is used. | |
| 205 | 1 | if (CS%coupled_tracers) & |
| 206 | CS%ind_tr(m) = atmos_ocn_coupler_flux(trim(var_name)//'_flux', & | |
| 207 | 1 | flux_type=' ', implementation=' ', caller="register_ideal_age_tracer") |
| 208 | enddo | |
| 209 | ||
| 210 | 1 | CS%tr_Reg => tr_Reg |
| 211 | 1 | CS%restart_CSp => restart_CS |
| 212 | 1 | register_ideal_age_tracer = .true. |
| 213 | 1 | end function register_ideal_age_tracer |
| 214 | ||
| 215 | !> Sets the ideal age traces to their initial values and sets up the tracer output | |
| 216 | 1 | subroutine initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & |
| 217 | sponge_CSp) | |
| 218 | logical, intent(in) :: restart !< .true. if the fields have already | |
| 219 | !! been read from a restart file. | |
| 220 | type(time_type), target, intent(in) :: day !< Time of the start of the run. | |
| 221 | type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure | |
| 222 | type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure | |
| 223 | type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type | |
| 224 | real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & | |
| 225 | intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] | |
| 226 | type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate | |
| 227 | !! diagnostic output. | |
| 228 | type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies | |
| 229 | !! whether, where, and what open boundary | |
| 230 | !! conditions are used. | |
| 231 | type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous | |
| 232 | !! call to register_ideal_age_tracer. | |
| 233 | type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. | |
| 234 | ||
| 235 | ! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) | |
| 236 | ! and it sets up the tracer output. | |
| 237 | ||
| 238 | ! Local variables | |
| 239 | character(len=24) :: name ! A variable's name in a NetCDF file. | |
| 240 | logical :: OK | |
| 241 | integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m | |
| 242 | integer :: IsdB, IedB, JsdB, JedB | |
| 243 | logical :: use_real_BL_depth | |
| 244 | ||
| 245 | 1 | if (.not.associated(CS)) return |
| 246 | 1 | if (CS%ntr < 1) return |
| 247 | 1 | is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke |
| 248 | 1 | isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed |
| 249 | 1 | IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB |
| 250 | ||
| 251 | 1 | CS%Time => day |
| 252 | 1 | CS%diag => diag |
| 253 | 1 | CS%nkbl = max(GV%nkml,1) |
| 254 | ||
| 255 | 2 | do m=1,CS%ntr |
| 256 | call query_vardesc(CS%tr_desc(m), name=name, & | |
| 257 | 1 | caller="initialize_ideal_age_tracer") |
| 258 | 1 | if ((.not.restart) .or. (CS%tracers_may_reinit .and. .not. & |
| 259 | 1 | query_initialized(CS%tr(:,:,:,m), name, CS%restart_CSp))) then |
| 260 | ||
| 261 | 1 | if (len_trim(CS%IC_file) > 0) then |
| 262 | ! Read the tracer concentrations from a netcdf file. | |
| 263 | 0 | if (.not.file_exists(CS%IC_file, G%Domain)) & |
| 264 | call MOM_error(FATAL, "initialize_ideal_age_tracer: "// & | |
| 265 | 0 | "Unable to open "//CS%IC_file) |
| 266 | ||
| 267 | 0 | if (CS%Z_IC_file) then |
| 268 | OK = tracer_Z_init(CS%tr(:,:,:,m), h, CS%IC_file, name,& | |
| 269 | 0 | G, GV, US, -1e34, 0.0) ! CS%land_val(m)) |
| 270 | 0 | if (.not.OK) then |
| 271 | OK = tracer_Z_init(CS%tr(:,:,:,m), h, CS%IC_file, & | |
| 272 | 0 | trim(name), G, GV, US, -1e34, 0.0) ! CS%land_val(m)) |
| 273 | 0 | if (.not.OK) call MOM_error(FATAL,"initialize_ideal_age_tracer: "//& |
| 274 | "Unable to read "//trim(name)//" from "//& | |
| 275 | 0 | trim(CS%IC_file)//".") |
| 276 | endif | |
| 277 | else | |
| 278 | 0 | call MOM_read_data(CS%IC_file, trim(name), CS%tr(:,:,:,m), G%Domain) |
| 279 | endif | |
| 280 | else | |
| 281 | 544576 | do k=1,nz ; do j=js,je ; do i=is,ie |
| 282 | 544500 | if (G%mask2dT(i,j) < 0.5) then |
| 283 | 163950 | CS%tr(i,j,k,m) = CS%land_val(m) |
| 284 | else | |
| 285 | 376050 | CS%tr(i,j,k,m) = CS%IC_val(m) |
| 286 | endif | |
| 287 | enddo ; enddo ; enddo | |
| 288 | endif | |
| 289 | ||
| 290 | 1 | call set_initialized(CS%tr(:,:,:,m), name, CS%restart_CSp) |
| 291 | endif ! restart | |
| 292 | enddo ! Tracer loop | |
| 293 | ||
| 294 | if (associated(OBC)) then | |
| 295 | ! Steal from updated DOME in the fullness of time. | |
| 296 | endif | |
| 297 | ||
| 298 | end subroutine initialize_ideal_age_tracer | |
| 299 | ||
| 300 | !> Applies diapycnal diffusion, aging and regeneration at the surface to the ideal age tracers | |
| 301 | 24 | subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, & |
| 302 | 12 | evap_CFL_limit, minimum_forcing_depth, Hbl) |
| 303 | type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure | |
| 304 | type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure | |
| 305 | real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & | |
| 306 | intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. | |
| 307 | real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & | |
| 308 | intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. | |
| 309 | real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & | |
| 310 | intent(in) :: ea !< an array to which the amount of fluid entrained | |
| 311 | !! from the layer above during this call will be | |
| 312 | !! added [H ~> m or kg m-2]. | |
| 313 | real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & | |
| 314 | intent(in) :: eb !< an array to which the amount of fluid entrained | |
| 315 | !! from the layer below during this call will be | |
| 316 | !! added [H ~> m or kg m-2]. | |
| 317 | type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic | |
| 318 | !! and tracer forcing fields. Unused fields have NULL ptrs. | |
| 319 | real, intent(in) :: dt !< The amount of time covered by this call [T ~> s] | |
| 320 | type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type | |
| 321 | type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous | |
| 322 | !! call to register_ideal_age_tracer. | |
| 323 | real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can | |
| 324 | !! be fluxed out of the top layer in a timestep [nondim] | |
| 325 | real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which | |
| 326 | !! fluxes can be applied [H ~> m or kg m-2] | |
| 327 | real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: Hbl !< Boundary layer thickness [H ~> m or kg m-2] | |
| 328 | ||
| 329 | ! This subroutine applies diapycnal diffusion and any other column | |
| 330 | ! tracer physics or chemistry to the tracers from this file. | |
| 331 | ! This is a simple example of a set of advected passive tracers. | |
| 332 | ||
| 333 | ! The arguments to this subroutine are redundant in that | |
| 334 | ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) | |
| 335 | ! Local variables | |
| 336 | 12 | real, dimension(SZI_(G),SZJ_(G)) :: BL_layers ! Stores number of layers in boundary layer [nondim] |
| 337 | 12 | real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] |
| 338 | real :: young_val ! The "young" value for the tracers [years] or other units | |
| 339 | real :: Isecs_per_year ! The inverse of the amount of time in a year [T-1 ~> s-1] | |
| 340 | real :: year ! The time in years [years] | |
| 341 | real :: layer_frac ! The fraction of the current layer that is within the mixed layer [nondim] | |
| 342 | integer :: i, j, k, is, ie, js, je, nz, m, nk | |
| 343 | character(len=255) :: msg | |
| 344 | 12 | is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke |
| 345 | ||
| 346 | 12 | if (CS%use_real_BL_depth .and. .not. present(Hbl)) then |
| 347 | call MOM_error(FATAL, "Attempting to use real boundary layer depth for ideal age tracers, " & | |
| 348 | 0 | // "but no valid boundary layer scheme was found") |
| 349 | endif | |
| 350 | ||
| 351 | 12 | if (CS%use_real_BL_depth .and. present(Hbl)) then |
| 352 | 0 | call count_BL_layers(G, GV, h_old, Hbl, BL_layers) |
| 353 | endif | |
| 354 | ||
| 355 | 12 | if (.not.associated(CS)) return |
| 356 | 12 | if (CS%ntr < 1) return |
| 357 | ||
| 358 | 12 | if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then |
| 359 | 24 | do m=1,CS%ntr |
| 360 | 6534912 | do k=1,nz ;do j=js,je ; do i=is,ie |
| 361 | 6534000 | h_work(i,j,k) = h_old(i,j,k) |
| 362 | enddo ; enddo ; enddo | |
| 363 | call applyTracerBoundaryFluxesInOut(G, GV, CS%tr(:,:,:,m), dt, fluxes, h_work, & | |
| 364 | 12 | evap_CFL_limit, minimum_forcing_depth) |
| 365 | 24 | call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,m), G, GV) |
| 366 | enddo | |
| 367 | else | |
| 368 | 0 | do m=1,CS%ntr |
| 369 | 0 | call tracer_vertdiff(h_old, ea, eb, dt, CS%tr(:,:,:,m), G, GV) |
| 370 | enddo | |
| 371 | endif | |
| 372 | ||
| 373 | 12 | Isecs_per_year = 1.0 / (365.0*86400.0*US%s_to_T) |
| 374 | ! Set the surface value of tracer 1 to increase exponentially | |
| 375 | ! with a 30 year time scale. | |
| 376 | 12 | year = time_to_real(CS%Time, scale=US%s_to_T) * Isecs_per_year |
| 377 | ||
| 378 | 24 | do m=1,CS%ntr |
| 379 | ||
| 380 | 12 | if (CS%growth_rate(m) == 0.0) then |
| 381 | 12 | young_val = CS%young_val(m) |
| 382 | else | |
| 383 | young_val = CS%young_val(m) * & | |
| 384 | 0 | exp((year-CS%tracer_start_year(m)) * CS%growth_rate(m)) |
| 385 | endif | |
| 386 | ||
| 387 | 24 | if (m == CS%BL_residence_num) then |
| 388 | ||
| 389 | 0 | if (CS%use_real_BL_depth) then |
| 390 | 0 | do j=js,je ; do i=is,ie |
| 391 | 0 | nk = floor(BL_layers(i,j)) |
| 392 | ||
| 393 | 0 | do k=1,nk |
| 394 | 0 | if (G%mask2dT(i,j) > 0.0) then |
| 395 | 0 | CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + G%mask2dT(i,j)*dt*Isecs_per_year |
| 396 | else | |
| 397 | 0 | CS%tr(i,j,k,m) = CS%land_val(m) |
| 398 | endif | |
| 399 | enddo | |
| 400 | ||
| 401 | 0 | k = MIN(nk+1,nz) |
| 402 | ||
| 403 | 0 | if (G%mask2dT(i,j) > 0.0) then |
| 404 | 0 | layer_frac = BL_layers(i,j)-nk |
| 405 | CS%tr(i,j,k,m) = layer_frac * (CS%tr(i,j,k,m) + G%mask2dT(i,j)*dt & | |
| 406 | 0 | *Isecs_per_year) + (1.-layer_frac) * young_val |
| 407 | else | |
| 408 | 0 | CS%tr(i,j,k,m) = CS%land_val(m) |
| 409 | endif | |
| 410 | ||
| 411 | ||
| 412 | 0 | do k=nk+2,nz |
| 413 | 0 | if (G%mask2dT(i,j) > 0.0) then |
| 414 | 0 | CS%tr(i,j,k,m) = young_val |
| 415 | else | |
| 416 | 0 | CS%tr(i,j,k,m) = CS%land_val(m) |
| 417 | endif | |
| 418 | enddo | |
| 419 | enddo ; enddo | |
| 420 | ||
| 421 | else ! use real BL depth | |
| 422 | 0 | do j=js,je ; do i=is,ie |
| 423 | 0 | do k=1,CS%nkbl |
| 424 | 0 | if (G%mask2dT(i,j) > 0.0) then |
| 425 | 0 | CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + G%mask2dT(i,j)*dt*Isecs_per_year |
| 426 | else | |
| 427 | 0 | CS%tr(i,j,k,m) = CS%land_val(m) |
| 428 | endif | |
| 429 | enddo | |
| 430 | ||
| 431 | 0 | do k=CS%nkbl+1,nz |
| 432 | 0 | if (G%mask2dT(i,j) > 0.0) then |
| 433 | 0 | CS%tr(i,j,k,m) = young_val |
| 434 | else | |
| 435 | 0 | CS%tr(i,j,k,m) = CS%land_val(m) |
| 436 | endif | |
| 437 | enddo | |
| 438 | enddo ; enddo | |
| 439 | ||
| 440 | endif ! use real BL depth | |
| 441 | ||
| 442 | else ! if BL residence tracer | |
| 443 | ||
| 444 | 12 | if (CS%use_real_BL_depth) then |
| 445 | 0 | do j=js,je ; do i=is,ie |
| 446 | 0 | nk = floor(BL_layers(i,j)) |
| 447 | 0 | do k=1,nk |
| 448 | 0 | if (G%mask2dT(i,j) > 0.0) then |
| 449 | 0 | CS%tr(i,j,k,m) = young_val |
| 450 | else | |
| 451 | 0 | CS%tr(i,j,k,m) = CS%land_val(m) |
| 452 | endif | |
| 453 | enddo | |
| 454 | ||
| 455 | 0 | k = MIN(nk+1,nz) |
| 456 | 0 | if (G%mask2dT(i,j) > 0.0) then |
| 457 | 0 | layer_frac = BL_layers(i,j)-nk |
| 458 | CS%tr(i,j,k,m) = (1.-layer_frac) * (CS%tr(i,j,k,m) + G%mask2dT(i,j)*dt & | |
| 459 | 0 | *Isecs_per_year) + layer_frac * young_val |
| 460 | else | |
| 461 | 0 | CS%tr(i,j,k,m) = CS%land_val(m) |
| 462 | endif | |
| 463 | ||
| 464 | 0 | do k=nk+2,nz |
| 465 | 0 | if (G%mask2dT(i,j) > 0.0) then |
| 466 | 0 | CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + G%mask2dT(i,j)*dt*Isecs_per_year |
| 467 | else | |
| 468 | 0 | CS%tr(i,j,k,m) = CS%land_val(m) |
| 469 | endif | |
| 470 | enddo | |
| 471 | enddo ; enddo | |
| 472 | ||
| 473 | else ! use real BL depth | |
| 474 | 87144 | do k=1,CS%nkbl ; do j=js,je ; do i=is,ie |
| 475 | 87120 | if (G%mask2dT(i,j) > 0.0) then |
| 476 | 60168 | CS%tr(i,j,k,m) = young_val |
| 477 | else | |
| 478 | 26232 | CS%tr(i,j,k,m) = CS%land_val(m) |
| 479 | endif | |
| 480 | enddo ; enddo ; enddo | |
| 481 | ||
| 482 | 12 | if (CS%tracer_ages(m) .and. (year>=CS%tracer_start_year(m))) then |
| 483 | !$OMP parallel do default(none) shared(is,ie,js,je,CS,nz,G,dt,Isecs_per_year,m) | |
| 484 | 6447780 | do k=CS%nkbl+1,nz ; do j=js,je ; do i=is,ie |
| 485 | 6446880 | CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + G%mask2dT(i,j)*dt*Isecs_per_year |
| 486 | enddo ; enddo ; enddo | |
| 487 | endif | |
| 488 | ||
| 489 | ||
| 490 | endif ! if use real BL depth | |
| 491 | endif ! if BL residence tracer | |
| 492 | ||
| 493 | enddo ! loop over all tracers | |
| 494 | ||
| 495 | 12 | end subroutine ideal_age_tracer_column_physics |
| 496 | ||
| 497 | !> Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it | |
| 498 | !! has calculated. If stock_index is present, only the stock corresponding to that coded index is found. | |
| 499 | 3 | function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) |
| 500 | type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure | |
| 501 | type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure | |
| 502 | real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & | |
| 503 | intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] | |
| 504 | type(EFP_type), dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each | |
| 505 | !! tracer, in kg times concentration units [kg conc]. | |
| 506 | type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous | |
| 507 | !! call to register_ideal_age_tracer. | |
| 508 | character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. | |
| 509 | character(len=*), dimension(:), intent(out) :: units !< the units of the stocks calculated. | |
| 510 | integer, optional, intent(in) :: stock_index !< the coded index of a specific stock | |
| 511 | !! being sought. | |
| 512 | integer :: ideal_age_stock !< The number of stocks calculated here. | |
| 513 | ||
| 514 | ! Local variables | |
| 515 | integer :: m | |
| 516 | ||
| 517 | 3 | ideal_age_stock = 0 |
| 518 | 3 | if (.not.associated(CS)) return |
| 519 | 3 | if (CS%ntr < 1) return |
| 520 | ||
| 521 | 3 | if (present(stock_index)) then ; if (stock_index > 0) then |
| 522 | ! Check whether this stock is available from this routine. | |
| 523 | ||
| 524 | ! No stocks from this routine are being checked yet. Return 0. | |
| 525 | 0 | return |
| 526 | endif ; endif | |
| 527 | ||
| 528 | 6 | do m=1,CS%ntr |
| 529 | 3 | call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="ideal_age_stock") |
| 530 | 3 | units(m) = trim(units(m))//" kg" |
| 531 | 6 | stocks(m) = global_mass_int_EFP(h, G, GV, CS%tr(:,:,:,m), on_PE_only=.true.) |
| 532 | enddo | |
| 533 | 3 | ideal_age_stock = CS%ntr |
| 534 | ||
| 535 | 3 | end function ideal_age_stock |
| 536 | ||
| 537 | !> This subroutine extracts the surface fields from this tracer package that | |
| 538 | !! are to be shared with the atmosphere in coupled configurations. | |
| 539 | !! This particular tracer package does not report anything back to the coupler. | |
| 540 | 13 | subroutine ideal_age_tracer_surface_state(sfc_state, h, G, GV, CS) |
| 541 | type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. | |
| 542 | type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure | |
| 543 | type(surface), intent(inout) :: sfc_state !< A structure containing fields that | |
| 544 | !! describe the surface state of the ocean. | |
| 545 | real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & | |
| 546 | intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. | |
| 547 | type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous | |
| 548 | !! call to register_ideal_age_tracer. | |
| 549 | ||
| 550 | ! This particular tracer package does not report anything back to the coupler. | |
| 551 | ! The code that is here is just a rough guide for packages that would. | |
| 552 | ||
| 553 | integer :: m, is, ie, js, je, isd, ied, jsd, jed | |
| 554 | 13 | is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec |
| 555 | 13 | isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed |
| 556 | ||
| 557 | 13 | if (.not.associated(CS)) return |
| 558 | ||
| 559 | 13 | if (CS%coupled_tracers) then |
| 560 | 0 | do m=1,CS%ntr |
| 561 | ! This call loads the surface values into the appropriate array in the | |
| 562 | ! coupler-type structure. | |
| 563 | call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & | |
| 564 | 0 | idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/), turns=G%HI%turns) |
| 565 | enddo | |
| 566 | endif | |
| 567 | ||
| 568 | end subroutine ideal_age_tracer_surface_state | |
| 569 | ||
| 570 | !> Deallocate any memory associated with this tracer package | |
| 571 | 1 | subroutine ideal_age_example_end(CS) |
| 572 | type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous | |
| 573 | !! call to register_ideal_age_tracer. | |
| 574 | ||
| 575 | 1 | if (associated(CS)) then |
| 576 | 1 | if (associated(CS%tr)) deallocate(CS%tr) |
| 577 | 25 | deallocate(CS) |
| 578 | endif | |
| 579 | 1 | end subroutine ideal_age_example_end |
| 580 | ||
| 581 | 0 | subroutine count_BL_layers(G, GV, h, Hbl, BL_layers) |
| 582 | type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure | |
| 583 | type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure | |
| 584 | real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & | |
| 585 | intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. | |
| 586 | real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Hbl !< Boundary layer thickness [H ~> m or kg m-2] | |
| 587 | real, dimension(SZI_(G),SZJ_(G)), intent(out) :: BL_layers !< Number of model layers in the boundary layer [nondim] | |
| 588 | ||
| 589 | real :: current_depth ! Distance from the free surface [H ~> m or kg m-2] | |
| 590 | integer :: i, j, k, is, ie, js, je, nz, m, nk | |
| 591 | character(len=255) :: msg | |
| 592 | 0 | is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke |
| 593 | ||
| 594 | 0 | BL_layers(:,:) = 0. |
| 595 | 0 | do j=js,je |
| 596 | 0 | do i=is,ie |
| 597 | 0 | current_depth = 0. |
| 598 | 0 | do k=1,nz |
| 599 | 0 | current_depth = current_depth + h(i,j,k) |
| 600 | 0 | if (Hbl(i,j) <= current_depth) then |
| 601 | 0 | BL_layers(i,j) = BL_layers(i,j) + (1.0 - (current_depth - Hbl(i,j)) / h(i,j,k)) |
| 602 | 0 | exit |
| 603 | else | |
| 604 | 0 | BL_layers(i,j) = BL_layers(i,j) + 1.0 |
| 605 | endif | |
| 606 | enddo | |
| 607 | enddo | |
| 608 | enddo | |
| 609 | ||
| 610 | 0 | end subroutine count_BL_layers |
| 611 | ||
| 612 | !> \namespace ideal_age_example | |
| 613 | !! | |
| 614 | !! Originally by Robert Hallberg, 2002 | |
| 615 | !! | |
| 616 | !! This file contains an example of the code that is needed to set | |
| 617 | !! up and use a set (in this case two) of dynamically passive tracers | |
| 618 | !! for diagnostic purposes. The tracers here are an ideal age tracer | |
| 619 | !! that ages at a rate of 1/year once it is isolated from the surface, | |
| 620 | !! and a vintage tracer, whose surface concentration grows exponen- | |
| 621 | !! with time with a 30-year timescale (similar to CFCs). | |
| 622 | ||
| 623 | 0 | end module ideal_age_example |