MOM6
SCM_CVMix_tests.F90
Go to the documentation of this file.
1 !> Initial conditions and forcing for the single column model (SCM) CVMix test set.
3 
4 ! This file is part of MOM6. See LICENSE.md for the license.
5 
7 use mom_error_handler, only : mom_error, fatal
10 use mom_grid, only : ocean_grid_type
14 use mom_time_manager, only : time_type, operator(+), operator(/), time_type_to_real
17 
18 implicit none ; private
19 
20 #include <MOM_memory.h>
21 
26 public scm_cvmix_tests_cs
27 
28 ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
29 ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
30 ! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units
31 ! vary with the Boussinesq approximation, the Boussinesq variant is given first.
32 
33 !> Container for surface forcing parameters
34 type scm_cvmix_tests_cs ; private
35  logical :: usewindstress !< True to use wind stress
36  logical :: useheatflux !< True to use heat flux
37  logical :: useevaporation !< True to use evaporation
38  logical :: usediurnalsw !< True to use diurnal sw radiation
39  real :: tau_x !< (Constant) Wind stress, X [Pa]
40  real :: tau_y !< (Constant) Wind stress, Y [Pa]
41  real :: surf_hf !< (Constant) Heat flux [m degC s-1]
42  real :: surf_evap !< (Constant) Evaporation rate [m s-1]
43  real :: max_sw !< maximum of diurnal sw radiation [m degC s-1]
44  real,public :: rho0 !< reference density copied for easy passing [kg m-3]
45 end type
46 
47 ! This include declares and sets the variable "version".
48 #include "version_variable.h"
49 
50 character(len=40) :: mdl = "SCM_CVMix_tests" !< This module's name.
51 
52 contains
53 
54 !> Initializes temperature and salinity for the SCM CVMix test example
55 subroutine scm_cvmix_tests_ts_init(T, S, h, G, GV, US, param_file, just_read_params)
56  real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: t !< Potential temperature [degC]
57  real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: s !< Salinity [psu]
58  real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]
59  type(ocean_grid_type), intent(in) :: g !< Grid structure
60  type(verticalgrid_type), intent(in) :: gv !< Vertical grid structure
61  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
62  type(param_file_type), intent(in) :: param_file !< Input parameter structure
63  logical, optional, intent(in) :: just_read_params !< If present and true, this call will
64  !! only read parameters without changing h.
65  ! Local variables
66  real :: upperlayertempmld !< Upper layer Temp MLD thickness [Z ~> m].
67  real :: upperlayersaltmld !< Upper layer Salt MLD thickness [Z ~> m].
68  real :: upperlayertemp !< Upper layer temperature (SST if thickness 0) [degC]
69  real :: upperlayersalt !< Upper layer salinity (SSS if thickness 0) [ppt]
70  real :: lowerlayertemp !< Temp at top of lower layer [degC]
71  real :: lowerlayersalt !< Salt at top of lower layer [ppt]
72  real :: lowerlayerdtdz !< Temp gradient in lower layer [degC / Z ~> degC m-1].
73  real :: lowerlayerdsdz !< Salt gradient in lower layer [ppt / Z ~> ppt m-1].
74  real :: lowerlayermintemp !< Minimum temperature in lower layer [degC]
75  real :: zc, dz, top, bottom ! Depths and thicknesses [Z ~> m].
76  logical :: just_read ! If true, just read parameters but set nothing.
77  integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz
78 
79  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
80  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
81 
82 
83  just_read = .false. ; if (present(just_read_params)) just_read = just_read_params
84 
85  if (.not.just_read) call log_version(param_file, mdl, version)
86  call get_param(param_file, mdl, "SCM_TEMP_MLD", upperlayertempmld, &
87  'Initial temp mixed layer depth', &
88  units='m', default=0.0, scale=us%m_to_Z, do_not_log=just_read)
89  call get_param(param_file, mdl, "SCM_SALT_MLD", upperlayersaltmld, &
90  'Initial salt mixed layer depth', &
91  units='m', default=0.0, scale=us%m_to_Z, do_not_log=just_read)
92  call get_param(param_file, mdl, "SCM_L1_SALT", upperlayersalt, &
93  'Layer 2 surface salinity', units='1e-3', default=35.0, do_not_log=just_read)
94  call get_param(param_file, mdl, "SCM_L1_TEMP", upperlayertemp, &
95  'Layer 1 surface temperature', units='C', default=20.0, do_not_log=just_read)
96  call get_param(param_file, mdl, "SCM_L2_SALT", lowerlayersalt, &
97  'Layer 2 surface salinity', units='1e-3', default=35.0, do_not_log=just_read)
98  call get_param(param_file, mdl, "SCM_L2_TEMP", lowerlayertemp, &
99  'Layer 2 surface temperature', units='C', default=20.0, do_not_log=just_read)
100  call get_param(param_file, mdl, "SCM_L2_DTDZ", lowerlayerdtdz, &
101  'Initial temperature stratification in layer 2', &
102  units='C/m', default=0.0, scale=us%Z_to_m, do_not_log=just_read)
103  call get_param(param_file, mdl, "SCM_L2_DSDZ", lowerlayerdsdz, &
104  'Initial salinity stratification in layer 2', &
105  units='PPT/m', default=0.0, scale=us%Z_to_m, do_not_log=just_read)
106  call get_param(param_file, mdl, "SCM_L2_MINTEMP",lowerlayermintemp, &
107  'Layer 2 minimum temperature', units='C', default=4.0, do_not_log=just_read)
108 
109  if (just_read) return ! All run-time parameters have been read, so return.
110 
111  do j=js,je ; do i=is,ie
112  top = 0. ! Reference to surface
113  bottom = 0.
114  do k=1,nz
115  bottom = bottom - h(i,j,k)*gv%H_to_Z ! Interface below layer [Z ~> m]
116  zc = 0.5*( top + bottom ) ! Z of middle of layer [Z ~> m]
117  dz = min(0., zc + upperlayertempmld)
118  t(i,j,k) = max(lowerlayermintemp,lowerlayertemp + lowerlayerdtdz * dz)
119  dz = min(0., zc + upperlayersaltmld)
120  s(i,j,k) = lowerlayersalt + lowerlayerdsdz * dz
121  top = bottom
122  enddo ! k
123  enddo ; enddo
124 
125 end subroutine scm_cvmix_tests_ts_init
126 
127 !> Initializes surface forcing for the CVMix test case suite
128 subroutine scm_cvmix_tests_surface_forcing_init(Time, G, param_file, CS)
129  type(time_type), intent(in) :: time !< Model time
130  type(ocean_grid_type), intent(in) :: g !< Grid structure
131  type(param_file_type), intent(in) :: param_file !< Input parameter structure
132  type(scm_cvmix_tests_cs), pointer :: cs !< Parameter container
133 
134 
135  ! This include declares and sets the variable "version".
136 # include "version_variable.h"
137  type(unit_scale_type), pointer :: us => null() !< A dimensional unit scaling type
138 
139  us => g%US
140 
141  if (associated(cs)) then
142  call mom_error(fatal, "SCM_CVMix_tests_surface_forcing_init called with an associated "// &
143  "control structure.")
144  return
145  endif
146  allocate(cs)
147 
148  ! Read all relevant parameters and write them to the model log.
149  call log_version(param_file, mdl, version, "")
150  call get_param(param_file, mdl, "SCM_USE_WIND_STRESS", &
151  cs%UseWindStress, "Wind Stress switch "// &
152  "used in the SCM CVMix surface forcing.", &
153  units='', default=.false.)
154  call get_param(param_file, mdl, "SCM_USE_HEAT_FLUX", &
155  cs%UseHeatFlux, "Heat flux switch "// &
156  "used in the SCM CVMix test surface forcing.", &
157  units='', default=.false.)
158  call get_param(param_file, mdl, "SCM_USE_EVAPORATION", &
159  cs%UseEvaporation, "Evaporation switch "// &
160  "used in the SCM CVMix test surface forcing.", &
161  units='', default=.false.)
162  call get_param(param_file, mdl, "SCM_USE_DIURNAL_SW", &
163  cs%UseDiurnalSW, "Diurnal sw radation switch "// &
164  "used in the SCM CVMix test surface forcing.", &
165  units='', default=.false.)
166  if (cs%UseWindStress) then
167  call get_param(param_file, mdl, "SCM_TAU_X", &
168  cs%tau_x, "Constant X-dir wind stress "// &
169  "used in the SCM CVMix test surface forcing.", &
170  units='N/m2', scale=us%kg_m3_to_R*us%m_s_to_L_T**2*us%L_to_Z, fail_if_missing=.true.)
171  call get_param(param_file, mdl, "SCM_TAU_Y", &
172  cs%tau_y, "Constant y-dir wind stress "// &
173  "used in the SCM CVMix test surface forcing.", &
174  units='N/m2', scale=us%kg_m3_to_R*us%m_s_to_L_T**2*us%L_to_Z, fail_if_missing=.true.)
175  endif
176  if (cs%UseHeatFlux) then
177  call get_param(param_file, mdl, "SCM_HEAT_FLUX", &
178  cs%surf_HF, "Constant surface heat flux "// &
179  "used in the SCM CVMix test surface forcing.", &
180  units='m K/s', fail_if_missing=.true.)
181  endif
182  if (cs%UseEvaporation) then
183  call get_param(param_file, mdl, "SCM_EVAPORATION", &
184  cs%surf_evap, "Constant surface evaporation "// &
185  "used in the SCM CVMix test surface forcing.", &
186  units='m/s', fail_if_missing=.true.)
187  endif
188  if (cs%UseDiurnalSW) then
189  call get_param(param_file, mdl, "SCM_DIURNAL_SW_MAX", &
190  cs%Max_sw, "Maximum diurnal sw radiation "// &
191  "used in the SCM CVMix test surface forcing.", &
192  units='m K/s', fail_if_missing=.true.)
193  endif
194 
196 
197 subroutine scm_cvmix_tests_wind_forcing(state, forces, day, G, US, CS)
198  type(surface), intent(in) :: state !< Surface state structure
199  type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces
200  type(time_type), intent(in) :: day !< Time in days
201  type(ocean_grid_type), intent(inout) :: g !< Grid structure
202  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
203  type(scm_cvmix_tests_cs), pointer :: cs !< Container for SCM parameters
204  ! Local variables
205  integer :: i, j, is, ie, js, je, isq, ieq, jsq, jeq
206  integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb
207  real :: mag_tau
208  ! Bounds for loops and memory allocation
209  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
210  isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
211  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
212  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
213 
214  do j=js,je ; do i=isq,ieq
215  forces%taux(i,j) = cs%tau_x
216  enddo ; enddo
217  do j=jsq,jeq ; do i=is,ie
218  forces%tauy(i,j) = cs%tau_y
219  enddo ; enddo
220  call pass_vector(forces%taux, forces%tauy, g%Domain, to_all)
221 
222  mag_tau = sqrt(cs%tau_x*cs%tau_x + cs%tau_y*cs%tau_y)
223  if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie
224  forces%ustar(i,j) = sqrt( us%L_to_Z * mag_tau / (us%kg_m3_to_R*cs%Rho0) )
225  enddo ; enddo ; endif
226 
227 end subroutine scm_cvmix_tests_wind_forcing
228 
229 
230 subroutine scm_cvmix_tests_buoyancy_forcing(state, fluxes, day, G, US, CS)
231  type(surface), intent(in) :: state !< Surface state structure
232  type(forcing), intent(inout) :: fluxes !< Surface fluxes structure
233  type(time_type), intent(in) :: day !< Current model time
234  type(ocean_grid_type), intent(inout) :: g !< Grid structure
235  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
236  type(scm_cvmix_tests_cs), pointer :: cs !< Container for SCM parameters
237 
238  ! Local variables
239  integer :: i, j, is, ie, js, je, isq, ieq, jsq, jeq
240  integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb
241  real :: pi
242 
243  pi = 4.0*atan(1.0)
244 
245  ! Bounds for loops and memory allocation
246  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
247  isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
248  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
249  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
250 
251  if (cs%UseHeatFlux) then
252  ! Note CVMix test inputs give Heat flux in [m K/s]
253  ! therefore must convert to W/m2 by multiplying
254  ! by Rho0*Cp
255  do j=jsq,jeq ; do i=is,ie
256  fluxes%sens(i,j) = cs%surf_HF * cs%Rho0 * fluxes%C_p
257  enddo ; enddo
258  endif
259 
260  if (cs%UseEvaporation) then
261  do j=jsq,jeq ; do i=is,ie
262  ! Note CVMix test inputs give evaporation in [m s-1]
263  ! This therefore must be converted to mass flux in [R Z T-1 ~> kg m-2 s-1]
264  ! by multiplying by density and some unit conversion factors.
265  fluxes%evap(i,j) = cs%surf_evap * us%kg_m3_to_R*us%m_to_Z*us%T_to_s * cs%Rho0
266  enddo ; enddo
267  endif
268 
269  if (cs%UseDiurnalSW) then
270  do j=jsq,jeq ; do i=is,ie
271  ! Note CVMix test inputs give max sw rad in [m K/s]
272  ! therefore must convert to W/m2 by multiplying
273  ! by Rho0*Cp
274  ! Note diurnal cycle peaks at Noon.
275  fluxes%sw(i,j) = cs%Max_sw * max(0.0,cos(2*pi* &
276  (time_type_to_real(day)/86400.-0.5))) * cs%RHO0 * fluxes%C_p
277  enddo ; enddo
278  endif
279 
281 
282 end module scm_cvmix_tests
mom_time_manager
Wraps the FMS time manager functions.
Definition: MOM_time_manager.F90:2
mom_forcing_type::mech_forcing
Structure that contains pointers to the mechanical forcing at the surface used to drive the liquid oc...
Definition: MOM_forcing_type.F90:187
mom_variables::surface
Pointers to various fields which may be used describe the surface state of MOM, and which will be ret...
Definition: MOM_variables.F90:38
mom_safe_alloc
Convenience functions for safely allocating memory without accidentally reallocating pointer and caus...
Definition: MOM_safe_alloc.F90:3
mom_verticalgrid
Provides a transparent vertical ocean grid type and supporting routines.
Definition: MOM_verticalGrid.F90:2
mom_file_parser::log_version
An overloaded interface to log version information about modules.
Definition: MOM_file_parser.F90:109
mom_variables::thermo_var_ptrs
Pointers to an assortment of thermodynamic fields that may be available, including potential temperat...
Definition: MOM_variables.F90:78
mom_domains::pass_var
Do a halo update on an array.
Definition: MOM_domains.F90:49
mom_file_parser::param_file_type
A structure that can be parsed to read and document run-time parameters.
Definition: MOM_file_parser.F90:54
mom_file_parser::get_param
An overloaded interface to read and log the values of various types of parameters.
Definition: MOM_file_parser.F90:102
mom_unit_scaling::unit_scale_type
Describes various unit conversion factors.
Definition: MOM_unit_scaling.F90:14
scm_cvmix_tests
Initial conditions and forcing for the single column model (SCM) CVMix test set.
Definition: SCM_CVMix_tests.F90:2
mom_domains::pass_vector
Do a halo update on a pair of arrays representing the two components of a vector.
Definition: MOM_domains.F90:54
mom_forcing_type
This module implements boundary forcing for MOM6.
Definition: MOM_forcing_type.F90:2
mom_domains::to_all
integer, parameter, public to_all
A flag for passing in all directions.
Definition: MOM_domains.F90:132
scm_cvmix_tests::mdl
character(len=40) mdl
This module's name.
Definition: SCM_CVMix_tests.F90:50
mom_verticalgrid::verticalgrid_type
Describes the vertical ocean grid, including unit conversion factors.
Definition: MOM_verticalGrid.F90:24
mom_domains
Describes the decomposed MOM domain and has routines for communications across PEs.
Definition: MOM_domains.F90:2
mom_variables
Provides transparent structures with groups of MOM6 variables and supporting routines.
Definition: MOM_variables.F90:2
scm_cvmix_tests::scm_cvmix_tests_surface_forcing_init
subroutine, public scm_cvmix_tests_surface_forcing_init(Time, G, param_file, CS)
Initializes surface forcing for the CVMix test case suite.
Definition: SCM_CVMix_tests.F90:129
mom_file_parser
The MOM6 facility to parse input files for runtime parameters.
Definition: MOM_file_parser.F90:2
scm_cvmix_tests::scm_cvmix_tests_buoyancy_forcing
subroutine, public scm_cvmix_tests_buoyancy_forcing(state, fluxes, day, G, US, CS)
Definition: SCM_CVMix_tests.F90:231
mom_grid
Provides the ocean grid type.
Definition: MOM_grid.F90:2
mom_unit_scaling
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Definition: MOM_unit_scaling.F90:2
mom_forcing_type::forcing
Structure that contains pointers to the boundary forcing used to drive the liquid ocean simulated by ...
Definition: MOM_forcing_type.F90:50
mom_error_handler::mom_error
subroutine, public mom_error(level, message, all_print)
This provides a convenient interface for writing an mpp_error message with run-time filter based on a...
Definition: MOM_error_handler.F90:72
scm_cvmix_tests::scm_cvmix_tests_wind_forcing
subroutine, public scm_cvmix_tests_wind_forcing(state, forces, day, G, US, CS)
Definition: SCM_CVMix_tests.F90:198
scm_cvmix_tests::scm_cvmix_tests_cs
Container for surface forcing parameters.
Definition: SCM_CVMix_tests.F90:34
scm_cvmix_tests::scm_cvmix_tests_ts_init
subroutine, public scm_cvmix_tests_ts_init(T, S, h, G, GV, US, param_file, just_read_params)
Initializes temperature and salinity for the SCM CVMix test example.
Definition: SCM_CVMix_tests.F90:56
mom_safe_alloc::safe_alloc_ptr
Allocate a pointer to a 1-d, 2-d or 3-d array.
Definition: MOM_safe_alloc.F90:12
mom_error_handler
Routines for error handling and I/O management.
Definition: MOM_error_handler.F90:2
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:26