diff --git a/config_src/infra/FMS1/MOM_domain_infra.F90 b/config_src/infra/FMS1/MOM_domain_infra.F90 index 029561946b..590637158f 100644 --- a/config_src/infra/FMS1/MOM_domain_infra.F90 +++ b/config_src/infra/FMS1/MOM_domain_infra.F90 @@ -156,6 +156,9 @@ module MOM_domain_infra !! would be contain only land points and are not !! assigned to actual processors. This need not be !! assigned if all logical processors are used. + integer :: turns !< Number of quarter-turns from input to this grid. + type(MOM_domain_type), pointer :: domain_in => NULL() + !< Reference to unrotated domain (if turned) end type MOM_domain_type integer, parameter :: To_All = To_East + To_West + To_North + To_South !< A flag for passing in all directions @@ -1396,6 +1399,9 @@ subroutine create_MOM_domain(MOM_dom, n_global, n_halo, reentrant, tripolar_N, l mask_table_exists = .false. endif + ! Initialize as an unrotated domain + MOM_dom%turns = 0 + call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain) !For downsampled domain, recommend a halo of 1 (or 0?) since we're not doing wide-stencil computations. @@ -1487,8 +1493,9 @@ end subroutine get_domain_components_d2D !! some properties of the new type to differ from the original one. subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain_name, & turns, refine, extra_halo) - type(MOM_domain_type), intent(in) :: MD_in !< An existing MOM_domain - type(MOM_domain_type), pointer :: MOM_dom !< A pointer to a MOM_domain that will be + type(MOM_domain_type), target, intent(in) :: MD_in !< An existing MOM_domain + type(MOM_domain_type), pointer :: MOM_dom + !< A pointer to a MOM_domain that will be !! allocated if it is unassociated, and will have data !! copied from MD_in integer, dimension(2), & @@ -1619,8 +1626,12 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain MOM_dom%name = MD_in%name endif - call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain, xextent=exni, yextent=exnj) + MOM_dom%turns = qturns + if (qturns /= 0) then + MOM_dom%domain_in => MD_in + endif + call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain, xextent=exni, yextent=exnj) call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain_d2, domain_name=MOM_dom%name, coarsen=2) end subroutine clone_MD_to_MD diff --git a/config_src/infra/FMS1/MOM_interp_infra.F90 b/config_src/infra/FMS1/MOM_interp_infra.F90 index 170573f7ec..774f6a67d2 100644 --- a/config_src/infra/FMS1/MOM_interp_infra.F90 +++ b/config_src/infra/FMS1/MOM_interp_infra.F90 @@ -231,7 +231,7 @@ end subroutine time_interp_extern_3d !> initialize an external field integer function init_extern_field(file, fieldname, MOM_domain, domain, verbose, & - threading, ierr, ignore_axis_atts ) + threading, ierr, ignore_axis_atts, correct_leap_year_inconsistency ) character(len=*), intent(in) :: file !< The name of the file to read character(len=*), intent(in) :: fieldname !< The name of the field in the file @@ -246,13 +246,20 @@ integer function init_extern_field(file, fieldname, MOM_domain, domain, verbose, logical, optional, intent(in) :: ignore_axis_atts !< If present and true, do not issue a !! fatal error if the axis Cartesian attribute is !! not set to a recognized value. + logical, optional, intent(in) :: correct_leap_year_inconsistency !< If present and true, + !! then if, (1) a calendar containing leap years + !! is in use, and (2) the modulo time period of the + !! data is an integer number of years, then map + !! a model date of Feb 29. onto a common year on Feb. 28. if (present(MOM_Domain)) then init_extern_field = init_external_field(file, fieldname, domain=MOM_domain%mpp_domain, & - verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts) + verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts, & + correct_leap_year_inconsistency=correct_leap_year_inconsistency) else init_extern_field = init_external_field(file, fieldname, domain=domain, & - verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts) + verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts, & + correct_leap_year_inconsistency=correct_leap_year_inconsistency) endif end function init_extern_field diff --git a/config_src/infra/FMS1/MOM_io_infra.F90 b/config_src/infra/FMS1/MOM_io_infra.F90 index dcbd80e723..1501f3171b 100644 --- a/config_src/infra/FMS1/MOM_io_infra.F90 +++ b/config_src/infra/FMS1/MOM_io_infra.F90 @@ -31,7 +31,7 @@ module MOM_io_infra ! These interfaces are actually implemented or have explicit interfaces in this file. public :: open_file, open_ASCII_file, file_is_open, close_file, flush_file, file_exists public :: get_file_info, get_file_fields, get_file_times, get_filename_suffix -public :: MOM_read_data, MOM_read_vector, write_metadata, write_field +public :: read_field, read_vector, write_metadata, write_field public :: field_exists, get_field_atts, get_field_size, get_axis_data, read_field_chksum public :: io_infra_init, io_infra_end, MOM_namelist_file, check_namelist_error, write_version public :: stdout_if_root @@ -55,13 +55,13 @@ module MOM_io_infra end interface open_file !> Read a data field from a file -interface MOM_read_data - module procedure MOM_read_data_4d - module procedure MOM_read_data_3d - module procedure MOM_read_data_2d, MOM_read_data_2d_region - module procedure MOM_read_data_1d, MOM_read_data_1d_int - module procedure MOM_read_data_0d, MOM_read_data_0d_int -end interface +interface read_field + module procedure read_field_4d + module procedure read_field_3d + module procedure read_field_2d, read_field_2d_region + module procedure read_field_1d, read_field_1d_int + module procedure read_field_0d, read_field_0d_int +end interface read_field !> Write a registered field to an output file interface write_field @@ -74,10 +74,10 @@ module MOM_io_infra end interface write_field !> Read a pair of data fields representing the two components of a vector from a file -interface MOM_read_vector +interface read_vector module procedure MOM_read_vector_3d module procedure MOM_read_vector_2d -end interface MOM_read_vector +end interface read_vector !> Write metadata about a variable or axis to a file and store it for later reuse interface write_metadata @@ -416,8 +416,8 @@ end subroutine get_axis_data !> This routine uses the fms_io subroutine read_data to read a scalar named !! "fieldname" from a single or domain-decomposed file "filename". -subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Domain, & - global_file, file_may_be_4d) +subroutine read_field_0d(filename, fieldname, data, timelevel, scale, MOM_Domain, & + global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, intent(inout) :: data !< The 1-dimensional array into which the data @@ -471,12 +471,11 @@ subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Dom if (present(scale)) then ; if (scale /= 1.0) then data = scale*data endif ; endif - -end subroutine MOM_read_data_0d +end subroutine read_field_0d !> This routine uses the fms_io subroutine read_data to read a 1-D data field named !! "fieldname" from a single or domain-decomposed file "filename". -subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Domain, & +subroutine read_field_1d(filename, fieldname, data, timelevel, scale, MOM_Domain, & global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file @@ -521,7 +520,7 @@ subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Dom endif enddo if ((n == nvar+1) .or. (nvar < 1)) call MOM_error(WARNING, & - "MOM_read_data apparently did not find 1-d variable "//trim(fieldname)//" in file "//trim(filename)) + "read_field apparently did not find 1-d variable "//trim(fieldname)//" in file "//trim(filename)) deallocate(fields) call mpp_close(unit) @@ -534,14 +533,13 @@ subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Dom if (present(scale)) then ; if (scale /= 1.0) then data(:) = scale*data(:) endif ; endif - -end subroutine MOM_read_data_1d +end subroutine read_field_1d !> This routine uses the fms_io subroutine read_data to read a distributed !! 2-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. -subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & - timelevel, position, scale, global_file, file_may_be_4d) +subroutine read_field_2d(filename, fieldname, data, MOM_Domain, & + timelevel, position, scale, global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:), intent(inout) :: data !< The 2-dimensional array into which the data @@ -589,7 +587,7 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & endif enddo if ((n == nvar+1) .or. (nvar < 1)) call MOM_error(WARNING, & - "MOM_read_data apparently did not find 2-d variable "//trim(fieldname)//" in file "//trim(filename)) + "read_field apparently did not find 2-d variable "//trim(fieldname)//" in file "//trim(filename)) deallocate(fields) call mpp_close(unit) @@ -598,13 +596,12 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & if (present(scale)) then ; if (scale /= 1.0) then call rescale_comp_data(MOM_Domain, data, scale) endif ; endif - -end subroutine MOM_read_data_2d +end subroutine read_field_2d !> This routine uses the fms_io subroutine read_data to read a region from a distributed or !! global 2-D data field named "fieldname" from file "filename". -subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_domain, & - no_domain, scale) +subroutine read_field_2d_region(filename, fieldname, data, start, nread, MOM_domain, & + no_domain, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:), intent(inout) :: data !< The 2-dimensional array into which the data @@ -637,13 +634,12 @@ subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_ data(:,:) = scale*data(:,:) endif endif ; endif - -end subroutine MOM_read_data_2d_region +end subroutine read_field_2d_region !> This routine uses the fms_io subroutine read_data to read a distributed !! 3-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. -subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & +subroutine read_field_3d(filename, fieldname, data, MOM_Domain, & timelevel, position, scale, global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file @@ -692,7 +688,7 @@ subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & endif enddo if ((n == nvar+1) .or. (nvar < 1)) call MOM_error(WARNING, & - "MOM_read_data apparently did not find 3-d variable "//trim(fieldname)//" in file "//trim(filename)) + "read_field apparently did not find 3-d variable "//trim(fieldname)//" in file "//trim(filename)) deallocate(fields) call mpp_close(unit) @@ -701,13 +697,12 @@ subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & if (present(scale)) then ; if (scale /= 1.0) then call rescale_comp_data(MOM_Domain, data, scale) endif ; endif - -end subroutine MOM_read_data_3d +end subroutine read_field_3d !> This routine uses the fms_io subroutine read_data to read a distributed !! 4-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. -subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & +subroutine read_field_4d(filename, fieldname, data, MOM_Domain, & timelevel, position, scale, global_file) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file @@ -754,7 +749,7 @@ subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & endif enddo if ((n == nvar+1) .or. (nvar < 1)) call MOM_error(WARNING, & - "MOM_read_data apparently did not find 4-d variable "//trim(fieldname)//" in file "//trim(filename)) + "read_field apparently did not find 4-d variable "//trim(fieldname)//" in file "//trim(filename)) deallocate(fields) call mpp_close(unit) @@ -762,32 +757,29 @@ subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & if (present(scale)) then ; if (scale /= 1.0) then call rescale_comp_data(MOM_Domain, data, scale) endif ; endif - -end subroutine MOM_read_data_4d +end subroutine read_field_4d !> This routine uses the fms_io subroutine read_data to read a scalar integer !! data field named "fieldname" from file "filename". -subroutine MOM_read_data_0d_int(filename, fieldname, data, timelevel) +subroutine read_field_0d_int(filename, fieldname, data, timelevel) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file integer, intent(inout) :: data !< The 1-dimensional array into which the data integer, optional, intent(in) :: timelevel !< The time level in the file to read call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) - -end subroutine MOM_read_data_0d_int +end subroutine read_field_0d_int !> This routine uses the fms_io subroutine read_data to read a 1-D integer !! data field named "fieldname" from file "filename". -subroutine MOM_read_data_1d_int(filename, fieldname, data, timelevel) +subroutine read_field_1d_int(filename, fieldname, data, timelevel) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file integer, dimension(:), intent(inout) :: data !< The 1-dimensional array into which the data integer, optional, intent(in) :: timelevel !< The time level in the file to read call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) - -end subroutine MOM_read_data_1d_int +end subroutine read_field_1d_int !> This routine uses the fms_io subroutine read_data to read a pair of distributed diff --git a/config_src/infra/FMS2/MOM_domain_infra.F90 b/config_src/infra/FMS2/MOM_domain_infra.F90 index 029561946b..5f8d5fb20b 100644 --- a/config_src/infra/FMS2/MOM_domain_infra.F90 +++ b/config_src/infra/FMS2/MOM_domain_infra.F90 @@ -156,6 +156,9 @@ module MOM_domain_infra !! would be contain only land points and are not !! assigned to actual processors. This need not be !! assigned if all logical processors are used. + integer :: turns !< Number of quarter-turns from input to this grid. + type(MOM_domain_type), pointer :: domain_in => NULL() + !< Reference to unrotated domain (if turned) end type MOM_domain_type integer, parameter :: To_All = To_East + To_West + To_North + To_South !< A flag for passing in all directions @@ -1396,6 +1399,9 @@ subroutine create_MOM_domain(MOM_dom, n_global, n_halo, reentrant, tripolar_N, l mask_table_exists = .false. endif + ! Initialize as an unrotated domain + MOM_dom%turns = 0 + call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain) !For downsampled domain, recommend a halo of 1 (or 0?) since we're not doing wide-stencil computations. @@ -1403,7 +1409,6 @@ subroutine create_MOM_domain(MOM_dom, n_global, n_halo, reentrant, tripolar_N, l !error: downsample_diag_indices_get: peculiar size 28 in i-direction\ndoes not match one of 24 25 26 27 ! call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain_d2, halo_size=(MOM_dom%nihalo/2), coarsen=2) call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain_d2, coarsen=2) - end subroutine create_MOM_domain !> dealloc_MOM_domain deallocates memory associated with a pointer to a MOM_domain_type @@ -1487,8 +1492,9 @@ end subroutine get_domain_components_d2D !! some properties of the new type to differ from the original one. subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain_name, & turns, refine, extra_halo) - type(MOM_domain_type), intent(in) :: MD_in !< An existing MOM_domain - type(MOM_domain_type), pointer :: MOM_dom !< A pointer to a MOM_domain that will be + type(MOM_domain_type), target, intent(in) :: MD_in !< An existing MOM_domain + type(MOM_domain_type), pointer :: MOM_dom + !< A pointer to a MOM_domain that will be !! allocated if it is unassociated, and will have data !! copied from MD_in integer, dimension(2), & @@ -1619,8 +1625,12 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain MOM_dom%name = MD_in%name endif - call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain, xextent=exni, yextent=exnj) + MOM_dom%turns = qturns + if (qturns /= 0) then + MOM_dom%domain_in => MD_in + endif + call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain, xextent=exni, yextent=exnj) call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain_d2, domain_name=MOM_dom%name, coarsen=2) end subroutine clone_MD_to_MD diff --git a/config_src/infra/FMS2/MOM_interp_infra.F90 b/config_src/infra/FMS2/MOM_interp_infra.F90 index 170573f7ec..b02beca313 100644 --- a/config_src/infra/FMS2/MOM_interp_infra.F90 +++ b/config_src/infra/FMS2/MOM_interp_infra.F90 @@ -231,7 +231,7 @@ end subroutine time_interp_extern_3d !> initialize an external field integer function init_extern_field(file, fieldname, MOM_domain, domain, verbose, & - threading, ierr, ignore_axis_atts ) + threading, ierr, ignore_axis_atts, correct_leap_year_inconsistency ) character(len=*), intent(in) :: file !< The name of the file to read character(len=*), intent(in) :: fieldname !< The name of the field in the file @@ -246,13 +246,22 @@ integer function init_extern_field(file, fieldname, MOM_domain, domain, verbose, logical, optional, intent(in) :: ignore_axis_atts !< If present and true, do not issue a !! fatal error if the axis Cartesian attribute is !! not set to a recognized value. + logical, optional, intent(in) :: correct_leap_year_inconsistency !< If present and true, + !! then if, (1) a calendar containing leap years + !! is in use, and (2) the modulo time period of the + !! data is an integer number of years, then map + !! a model date of Feb 29. onto a common year on Feb. 28. + + if (present(MOM_Domain)) then init_extern_field = init_external_field(file, fieldname, domain=MOM_domain%mpp_domain, & - verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts) + verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts, & + correct_leap_year_inconsistency=correct_leap_year_inconsistency) else init_extern_field = init_external_field(file, fieldname, domain=domain, & - verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts) + verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts, & + correct_leap_year_inconsistency=correct_leap_year_inconsistency) endif end function init_extern_field diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index 6f08065f57..0b8c19d836 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -42,7 +42,7 @@ module MOM_io_infra ! These interfaces are actually implemented or have explicit interfaces in this file. public :: open_file, open_ASCII_file, file_is_open, close_file, flush_file, file_exists public :: get_file_info, get_file_fields, get_file_times, get_filename_suffix -public :: MOM_read_data, MOM_read_vector, write_metadata, write_field +public :: read_field, read_vector, write_metadata, write_field public :: field_exists, get_field_atts, get_field_size, get_axis_data, read_field_chksum public :: io_infra_init, io_infra_end, MOM_namelist_file, check_namelist_error, write_version public :: stdout_if_root @@ -66,12 +66,12 @@ module MOM_io_infra end interface open_file !> Read a data field from a file -interface MOM_read_data - module procedure MOM_read_data_4d - module procedure MOM_read_data_3d - module procedure MOM_read_data_2d, MOM_read_data_2d_region - module procedure MOM_read_data_1d, MOM_read_data_1d_int - module procedure MOM_read_data_0d, MOM_read_data_0d_int +interface read_field + module procedure read_field_4d + module procedure read_field_3d + module procedure read_field_2d, read_field_2d_region + module procedure read_field_1d, read_field_1d_int + module procedure read_field_0d, read_field_0d_int end interface !> Write a registered field to an output file @@ -85,10 +85,10 @@ module MOM_io_infra end interface write_field !> Read a pair of data fields representing the two components of a vector from a file -interface MOM_read_vector - module procedure MOM_read_vector_3d - module procedure MOM_read_vector_2d -end interface MOM_read_vector +interface read_vector + module procedure read_vector_3d + module procedure read_vector_2d +end interface read_vector !> Write metadata about a variable or axis to a file and store it for later reuse interface write_metadata @@ -659,8 +659,8 @@ end subroutine get_axis_data !> This routine uses the fms_io subroutine read_data to read a scalar named !! "fieldname" from a single or domain-decomposed file "filename". -subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Domain, & - global_file, file_may_be_4d) +subroutine read_field_0d(filename, fieldname, data, timelevel, scale, MOM_Domain, & + global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, intent(inout) :: data !< The 1-dimensional array into which the data @@ -686,7 +686,7 @@ subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Dom if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive variable name in the file and prepare to read it. - call prepare_to_read_var(fileobj_DD, fieldname, "MOM_read_data_0d: ", filename, & + call prepare_to_read_var(fileobj_DD, fieldname, "read_field_0d: ", filename, & var_to_read, has_time_dim, timelevel) ! Read the data. @@ -705,7 +705,7 @@ subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Dom ! Find the matching case-insensitive variable name in the file, and determine whether it ! has a time dimension. - call find_varname_in_file(fileObj, fieldname, "MOM_read_data_0d: ", filename, & + call find_varname_in_file(fileObj, fieldname, "read_field_0d: ", filename, & var_to_read, has_time_dim, timelevel) ! Read the data. @@ -727,12 +727,12 @@ subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Dom data = scale*data endif ; endif -end subroutine MOM_read_data_0d +end subroutine read_field_0d !> This routine uses the fms_io subroutine read_data to read a 1-D data field named !! "fieldname" from a single or domain-decomposed file "filename". -subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Domain, & - global_file, file_may_be_4d) +subroutine read_field_1d(filename, fieldname, data, timelevel, scale, MOM_Domain, & + global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:), intent(inout) :: data !< The 1-dimensional array into which the data @@ -758,7 +758,7 @@ subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Dom if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive variable name in the file and prepare to read it. - call prepare_to_read_var(fileobj_DD, fieldname, "MOM_read_data_1d: ", filename, & + call prepare_to_read_var(fileobj_DD, fieldname, "read_field_1d: ", filename, & var_to_read, has_time_dim, timelevel) ! Read the data. @@ -777,7 +777,7 @@ subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Dom ! Find the matching case-insensitive variable name in the file, and determine whether it ! has a time dimension. - call find_varname_in_file(fileObj, fieldname, "MOM_read_data_1d: ", filename, & + call find_varname_in_file(fileObj, fieldname, "read_field_1d: ", filename, & var_to_read, has_time_dim, timelevel) ! Read the data. @@ -799,13 +799,13 @@ subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Dom data(:) = scale*data(:) endif ; endif -end subroutine MOM_read_data_1d +end subroutine read_field_1d !> This routine uses the fms_io subroutine read_data to read a distributed !! 2-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. -subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & - timelevel, position, scale, global_file, file_may_be_4d) +subroutine read_field_2d(filename, fieldname, data, MOM_Domain, & + timelevel, position, scale, global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:), intent(inout) :: data !< The 2-dimensional array into which the data @@ -831,7 +831,7 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive variable name in the file and prepare to read it. - call prepare_to_read_var(fileobj, fieldname, "MOM_read_data_2d: ", filename, & + call prepare_to_read_var(fileobj, fieldname, "read_field_2d: ", filename, & var_to_read, has_time_dim, timelevel, position) ! Read the data. @@ -852,12 +852,12 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & call rescale_comp_data(MOM_Domain, data, scale) endif ; endif -end subroutine MOM_read_data_2d +end subroutine read_field_2d !> This routine uses the fms_io subroutine read_data to read a region from a distributed or !! global 2-D data field named "fieldname" from file "filename". -subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_domain, & - no_domain, scale) +subroutine read_field_2d_region(filename, fieldname, data, start, nread, MOM_domain, & + no_domain, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:), intent(inout) :: data !< The 2-dimensional array into which the data @@ -887,7 +887,7 @@ subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_ if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive variable name in the file and prepare to read it. - call prepare_to_read_var(fileobj_DD, fieldname, "MOM_read_data_2d_region: ", & + call prepare_to_read_var(fileobj_DD, fieldname, "read_field_2d_region: ", & filename, var_to_read) ! Read the data. @@ -902,7 +902,7 @@ subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_ ! Find the matching case-insensitive variable name in the file, and determine whether it ! has a time dimension. - call find_varname_in_file(fileObj, fieldname, "MOM_read_data_2d_region: ", filename, var_to_read) + call find_varname_in_file(fileObj, fieldname, "read_field_2d_region: ", filename, var_to_read) ! Read the data. call fms2_read_data(fileobj, var_to_read, data, corner=start(1:2), edge_lengths=nread(1:2)) @@ -925,13 +925,13 @@ subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_ endif endif ; endif -end subroutine MOM_read_data_2d_region +end subroutine read_field_2d_region !> This routine uses the fms_io subroutine read_data to read a distributed !! 3-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. -subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & - timelevel, position, scale, global_file, file_may_be_4d) +subroutine read_field_3d(filename, fieldname, data, MOM_Domain, & + timelevel, position, scale, global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:,:), intent(inout) :: data !< The 3-dimensional array into which the data @@ -957,7 +957,7 @@ subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive variable name in the file and prepare to read it. - call prepare_to_read_var(fileobj, fieldname, "MOM_read_data_3d: ", filename, & + call prepare_to_read_var(fileobj, fieldname, "read_field_3d: ", filename, & var_to_read, has_time_dim, timelevel, position) ! Read the data. @@ -978,13 +978,13 @@ subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & call rescale_comp_data(MOM_Domain, data, scale) endif ; endif -end subroutine MOM_read_data_3d +end subroutine read_field_3d !> This routine uses the fms_io subroutine read_data to read a distributed !! 4-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. -subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & - timelevel, position, scale, global_file) +subroutine read_field_4d(filename, fieldname, data, MOM_Domain, & + timelevel, position, scale, global_file) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:,:,:), intent(inout) :: data !< The 4-dimensional array into which the data @@ -1009,7 +1009,7 @@ subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive variable name in the file and prepare to read it. - call prepare_to_read_var(fileobj, fieldname, "MOM_read_data_4d: ", filename, & + call prepare_to_read_var(fileobj, fieldname, "read_field_4d: ", filename, & var_to_read, has_time_dim, timelevel, position) ! Read the data. @@ -1030,11 +1030,11 @@ subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & call rescale_comp_data(MOM_Domain, data, scale) endif ; endif -end subroutine MOM_read_data_4d +end subroutine read_field_4d !> This routine uses the fms_io subroutine read_data to read a scalar integer !! data field named "fieldname" from file "filename". -subroutine MOM_read_data_0d_int(filename, fieldname, data, timelevel) +subroutine read_field_0d_int(filename, fieldname, data, timelevel) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file integer, intent(inout) :: data !< The 1-dimensional array into which the data @@ -1054,7 +1054,7 @@ subroutine MOM_read_data_0d_int(filename, fieldname, data, timelevel) ! Find the matching case-insensitive variable name in the file, and determine whether it ! has a time dimension. - call find_varname_in_file(fileObj, fieldname, "MOM_read_data_0d_int: ", filename, & + call find_varname_in_file(fileObj, fieldname, "read_field_0d_int: ", filename, & var_to_read, has_time_dim, timelevel) ! Read the data. @@ -1070,11 +1070,11 @@ subroutine MOM_read_data_0d_int(filename, fieldname, data, timelevel) call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) endif -end subroutine MOM_read_data_0d_int +end subroutine read_field_0d_int !> This routine uses the fms_io subroutine read_data to read a 1-D integer !! data field named "fieldname" from file "filename". -subroutine MOM_read_data_1d_int(filename, fieldname, data, timelevel) +subroutine read_field_1d_int(filename, fieldname, data, timelevel) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file integer, dimension(:), intent(inout) :: data !< The 1-dimensional array into which the data @@ -1095,7 +1095,7 @@ subroutine MOM_read_data_1d_int(filename, fieldname, data, timelevel) ! Find the matching case-insensitive variable name in the file, and determine whether it ! has a time dimension. - call find_varname_in_file(fileObj, fieldname, "MOM_read_data_1d_int: ", filename, & + call find_varname_in_file(fileObj, fieldname, "read_field_1d_int: ", filename, & var_to_read, has_time_dim, timelevel) ! Read the data. @@ -1111,14 +1111,14 @@ subroutine MOM_read_data_1d_int(filename, fieldname, data, timelevel) call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) endif -end subroutine MOM_read_data_1d_int +end subroutine read_field_1d_int !> This routine uses the fms_io subroutine read_data to read a pair of distributed !! 2-D data fields with names given by "[uv]_fieldname" from file "filename". Valid values for !! "stagger" include CGRID_NE, BGRID_NE, and AGRID. -subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & - timelevel, stagger, scalar_pair, scale) +subroutine read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & + timelevel, stagger, scalar_pair, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: u_fieldname !< The variable name of the u data in the file character(len=*), intent(in) :: v_fieldname !< The variable name of the v data in the file @@ -1152,9 +1152,9 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive u- and v-variable names in the file and prepare to read them. - call prepare_to_read_var(fileobj, u_fieldname, "MOM_read_vector_2d: ", filename, & + call prepare_to_read_var(fileobj, u_fieldname, "read_vector_2d: ", filename, & u_var, has_time_dim, timelevel, position=u_pos) - call prepare_to_read_var(fileobj, v_fieldname, "MOM_read_vector_2d: ", filename, & + call prepare_to_read_var(fileobj, v_fieldname, "read_vector_2d: ", filename, & v_var, has_time_dim, timelevel, position=v_pos) ! Read the u-data and v-data. There would already been an error message for one @@ -1181,13 +1181,13 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data call rescale_comp_data(MOM_Domain, v_data, scale) endif ; endif -end subroutine MOM_read_vector_2d +end subroutine read_vector_2d !> This routine uses the fms_io subroutine read_data to read a pair of distributed !! 3-D data fields with names given by "[uv]_fieldname" from file "filename". Valid values for !! "stagger" include CGRID_NE, BGRID_NE, and AGRID. -subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & - timelevel, stagger, scalar_pair, scale) +subroutine read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & + timelevel, stagger, scalar_pair, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: u_fieldname !< The variable name of the u data in the file character(len=*), intent(in) :: v_fieldname !< The variable name of the v data in the file @@ -1222,9 +1222,9 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive u- and v-variable names in the file and prepare to read them. - call prepare_to_read_var(fileobj, u_fieldname, "MOM_read_vector_3d: ", filename, & + call prepare_to_read_var(fileobj, u_fieldname, "read_vector_3d: ", filename, & u_var, has_time_dim, timelevel, position=u_pos) - call prepare_to_read_var(fileobj, v_fieldname, "MOM_read_vector_3d: ", filename, & + call prepare_to_read_var(fileobj, v_fieldname, "read_vector_3d: ", filename, & v_var, has_time_dim, timelevel, position=v_pos) ! Read the u-data and v-data, dangerously assuming either both or neither have time dimensions. @@ -1251,7 +1251,7 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data call rescale_comp_data(MOM_Domain, v_data, scale) endif ; endif -end subroutine MOM_read_vector_3d +end subroutine read_vector_3d !> Find the case-sensitive name of the variable in a netCDF file with a case-insensitive name match. diff --git a/docs/images/background_varying.png b/docs/images/background_varying.png new file mode 100644 index 0000000000..44a65175a0 Binary files /dev/null and b/docs/images/background_varying.png differ diff --git a/docs/parameterizations_vertical.rst b/docs/parameterizations_vertical.rst index 0d22787294..c9404c5088 100644 --- a/docs/parameterizations_vertical.rst +++ b/docs/parameterizations_vertical.rst @@ -21,9 +21,12 @@ Interior and bottom-driven mixing --------------------------------- Kappa-shear - MOM_kappa_shear implement the shear-driven mixing of :cite:`jackson2008`. + MOM_kappa_shear implements the shear-driven mixing of :cite:`jackson2008`. + + :ref:`Internal_Shear_Mixing` Internal-tide driven mixing + The schemes of :cite:`st_laurent2002`, :cite:`polzin2009`, and :cite:`melet2012`, are all implemented through MOM_set_diffusivity and MOM_diabatic_driver. :ref:`Internal_Tidal_Mixing` @@ -33,6 +36,8 @@ Vertical friction Vertical viscosity is implemented in MOM_vert_frict and coefficient computed in MOM_set_viscosity, although contributions to viscosity from other parameterizations are calculated in those respective modules (e.g. MOM_kappa_shear, MOM_KPP, MOM_energetic_PBL). + :ref:`Vertical_Viscosity` + Vertical diffusion ------------------ diff --git a/docs/zotero.bib b/docs/zotero.bib index 957097f217..a00fe569bd 100644 --- a/docs/zotero.bib +++ b/docs/zotero.bib @@ -655,6 +655,30 @@ @article{killworth1992 pages = {1379--1387} } +@article{killworth1999, + doi = {10.1175/1520-0485(1999)029<1221:atbblc>2.0.co;2}, + year = 1999, + publisher = {American Meteorological Society}, + volume = {29}, + number = {6}, + pages = {1221--1238}, + author = {P. D. Killworth and N. R. Edwards}, + title = {A Turbulent Bottom Boundary Layer Code for Use in Numerical Ocean Models}, + journal = {J. Phys. Oceanography} +} + +@article{zilitinkevich1996, + doi = {10.1007/bf02430334}, + year = 1996, + publisher = {Springer Science and Business Media {LLC}}, + volume = {81}, + number = {3-4}, + pages = {325--351}, + author = {S. Zilitinkevich and D. V. Mironov}, + title = {A multi-limit formulation for the equilibrium depth of a stably stratified boundary layer}, + journal = {Boundary-Layer Meteorology} +} + @article{gent1995, title = {Parameterizing {Eddy}-{Induced} {Tracer} {Transports} in {Ocean} {Circulation} {Models}}, volume = {25}, @@ -800,6 +824,18 @@ @article{jackson2008 pages = {1033--1053} } +@article{turner1986, + doi = {10.1017/s0022112086001222}, + year = 1986, + publisher = {Cambridge University Press ({CUP})}, + volume = {173}, + pages = {431--471}, + author = {J. S. Turner}, + title = {Turbulent entrainment: the development of the entrainment assumption, and its application to geophysical flows}, + journal = {J. Fluid Mech.} +} + + @article{reichl2018, title = {A simplified energetics based planetary boundary layer ({ePBL}) approach for ocean climate simulations.}, volume = {132}, @@ -1426,6 +1462,18 @@ @article{harrison2008 pages = {1894--1912} } +@article{danabasoglu2012, + doi = {10.1175/jcli-d-11-00091.1}, + year = 2012, + publisher = {American Meteorological Society}, + volume = {25}, + number = {5}, + pages = {1361--1389}, + author = {G. Danabasoglu and S. C. Bates and B. P. Briegleb and S. R. Jayne and M. Jochum and W. G. Large and S. Peacock and S. G. Yeager}, + title = {The {CCSM}4 Ocean Component}, + journal = {J. Climate} +} + @article{henyey1986, title = {Energy and action flow through the internal wave field: {An} eikonal approach}, volume = {91}, @@ -1761,6 +1809,18 @@ @article{large1994 pages = {363--403} } +@article{pacanowski1981, + doi = {10.1175/1520-0485(1981)011<1443:povmin>2.0.co;2}, + year = 1981, + publisher = {American Meteorological Society}, + volume = {11}, + number = {11}, + pages = {1443--1451}, + author = {R. C. Pacanowski and S. G. H. Philander}, + title = {Parameterization of Vertical Mixing in Numerical Models of Tropical Oceans}, + journal = {J. Phys. Oceanography} +} + @article{van_roekel2018, title = {The {KPP} {Boundary} {Layer} {Scheme} for the {Ocean}: {Revisiting} {Its} {Formulation} and {Benchmarking} {One}-{Dimensional} {Simulations} {Relative} to {LES}}, volume = {10}, @@ -2343,6 +2403,19 @@ @article{hallberg2000 pages = {1402--1419} } +@article{umlauf2005, + doi = {10.1016/j.csr.2004.08.004}, + year = 2005, + publisher = {Elsevier {BV}}, + volume = {25}, + number = {7-8}, + pages = {795--827}, + author = {L. Umlauf and H. Burchard}, + title = {Second-order turbulence closure models for geophysical boundary layers. A review of recent work}, + journal = {Continental Shelf Res.} +} + + @article{easter1993, title = {Two Modified Versions of Bott's Positive-Definite Numerical Advection Scheme}, @@ -2545,11 +2618,60 @@ @article{hallberg2005 } @article{bell1975, - author = {T. H. Bell}, - year = {1975}, - title = {Lee wavews in stratified flows with simple harmonic time dependence"}, - journal = {J. Fluid Mech.}, + doi = {10.1017/s0022112075000560}, + year = 1975, + publisher = {Cambridge University Press ({CUP})}, volume = {67}, - pages = {705--722} + number = {4}, + pages = {705--722}, + author = {T. H. Bell}, + title = {Lee waves in stratified flows with simple harmonic time dependence}, + journal = {J. Fluid Mech.} +} + +@article{nikurashin2010a, + doi = {10.1175/2009jpo4199.1}, + year = 2010, + publisher = {American Meteorological Society}, + volume = {40}, + number = {5}, + pages = {1055--1074}, + author = {M. Nikurashin and R. Ferrari}, + title = {Radiation and Dissipation of Internal Waves Generated by Geostrophic Motions Impinging on Small-Scale Topography: Theory}, + journal = {J. Phys. Oceanography} +} + +@article{nikurashin2010b, + doi = {10.1175/2010jpo4315.1}, + year = 2010, + publisher = {American Meteorological Society}, + volume = {40}, + number = {9}, + pages = {2025--2042}, + author = {M. Nikurashin and R. Ferrari}, + title = {Radiation and Dissipation of Internal Waves Generated by Geostrophic Motions Impinging on Small-Scale Topography: Application to the Southern Ocean}, + journal = {J. Phys. Oceanography} +} + +@article{miles1961, + title = {On the stability of heterogeneous shear flows}, + author = {JW Miles}, + year = {1961}, + journal = {J. of Fluid Mech.}, + volume = {10}, + pages = {496--508}, + doi = {10.1017/S0022112061000305} +} + +@article{bryan1979, + doi = {10.1029/jc084ic05p02503}, + year = 1979, + publisher = {American Geophysical Union ({AGU})}, + volume = {84}, + number = {C5}, + pages = {2503}, + author = {K. Bryan and L. J. Lewis}, + title = {A water mass model of the World Ocean}, + journal = {J. Geophys. Res.} } diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 63f8193b33..93696d3879 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -351,7 +351,7 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, tv%T, CS%diag) if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, tv%S, CS%diag) if (CS%id_e_preale > 0) then - call find_eta(h, tv, G, GV, US, eta_preale) + call find_eta(h, tv, G, GV, US, eta_preale, dZref=G%Z_ref) call post_data(CS%id_e_preale, eta_preale, CS%diag) endif @@ -1304,7 +1304,7 @@ subroutine ALE_initThicknessToCoord( CS, G, GV, h ) integer :: i, j, k do j = G%jsd,G%jed ; do i = G%isd,G%ied - h(i,j,:) = GV%Z_to_H * getStaticThickness( CS%regridCS, 0., G%bathyT(i,j) ) + h(i,j,:) = GV%Z_to_H * getStaticThickness( CS%regridCS, 0., G%bathyT(i,j)+G%Z_ref ) enddo ; enddo end subroutine ALE_initThicknessToCoord diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 5b19a7549c..e215fde06f 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1113,7 +1113,7 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) endif ! Local depth (G%bathyT is positive downward) - nominalDepth = G%bathyT(i,j)*GV%Z_to_H + nominalDepth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H ! Determine water column thickness totalThickness = 0.0 @@ -1203,7 +1203,7 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) endif ! The rest of the model defines grids integrating up from the bottom - nominalDepth = G%bathyT(i,j)*GV%Z_to_H + nominalDepth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H ! Determine water column height totalThickness = 0.0 @@ -1314,7 +1314,7 @@ subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS, frac_shel ! Local depth (G%bathyT is positive downward) - nominalDepth = G%bathyT(i,j)*GV%Z_to_H + nominalDepth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H ! Determine total water column thickness totalThickness = 0.0 @@ -1444,7 +1444,7 @@ subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, CS, frac_she do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 if (G%mask2dT(i,j)>0.) then - nominalDepth = G%bathyT(i,j) * GV%Z_to_H + nominalDepth = (G%bathyT(i,j)+G%Z_ref) * GV%Z_to_H if (ice_shelf) then totalThickness = 0.0 @@ -1592,7 +1592,7 @@ subroutine build_grid_SLight(G, GV, US, h, tv, dzInterface, CS) do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 if (G%mask2dT(i,j)>0.) then - depth = G%bathyT(i,j) * GV%Z_to_H + depth = (G%bathyT(i,j)+G%Z_ref) * GV%Z_to_H z_col(1) = 0. ! Work downward rather than bottom up do K=1,nz z_col(K+1) = z_col(K) + h(i,j,k) @@ -1718,7 +1718,7 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) do i = G%isc-1,G%iec+1 ! Local depth - local_depth = G%bathyT(i,j)*GV%Z_to_H + local_depth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H ! Determine water column height total_height = 0.0 diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index 8fa4b09fc5..fe3864fc7a 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -144,7 +144,7 @@ subroutine build_adapt_column(CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNex zNext(nz+1) = zInt(i,j,nz+1) ! local depth for scaling diffusivity - depth = G%bathyT(i,j) * GV%Z_to_H + depth = (G%bathyT(i,j) + G%Z_ref) * GV%Z_to_H ! initialize del2sigma and the thickness change response to it zero del2sigma(:) = 0.0 ; dh_d2s(:) = 0.0 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 06850dca97..eea888cd70 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -850,7 +850,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS ! Determining the time-average sea surface height is part of the algorithm. ! This may be eta_av if Boussinesq, or need to be diagnosed if not. CS%time_in_cycle = CS%time_in_cycle + dt - call find_eta(h, CS%tv, G, GV, US, ssh, CS%eta_av_bc, eta_to_m=1.0) + call find_eta(h, CS%tv, G, GV, US, ssh, CS%eta_av_bc, eta_to_m=1.0, dZref=G%Z_ref) do j=js,je ; do i=is,ie CS%ssh_rint(i,j) = CS%ssh_rint(i,j) + dt*ssh(i,j) enddo ; enddo @@ -1276,7 +1276,13 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call enable_averages(dtdia, Time_end_thermo, CS%diag) if (associated(CS%odaCS)) then - call apply_oda_tracer_increments(US%T_to_s*dtdia, G, GV, tv, h, CS%odaCS) + if (CS%debug) then + call MOM_thermo_chksum("Pre-oda ", tv, G, US, haloshift=0) + endif + call apply_oda_tracer_increments(US%T_to_s*dtdia, Time_end_thermo, G, GV, tv, h, CS%odaCS) + if (CS%debug) then + call MOM_thermo_chksum("Post-oda ", tv, G, US, haloshift=0) + endif endif if (associated(fluxes%p_surf) .or. associated(fluxes%p_surf_full)) then @@ -2109,7 +2115,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Swap axes for quarter and 3-quarter turns if (CS%rotate_index) then allocate(CS%G) - call clone_MOM_domain(G_in%Domain, CS%G%Domain, turns=turns) + call clone_MOM_domain(G_in%Domain, CS%G%Domain, turns=turns, & + domain_name="MOM_rot") first_direction = modulo(first_direction + turns, 2) else CS%G => G_in @@ -2278,7 +2285,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ALLOC_(CS%ssh_rint(isd:ied,jsd:jed)) ; CS%ssh_rint(:,:) = 0.0 ALLOC_(CS%ave_ssh_ibc(isd:ied,jsd:jed)) ; CS%ave_ssh_ibc(:,:) = 0.0 - ALLOC_(CS%eta_av_bc(isd:ied,jsd:jed)) ; CS%eta_av_bc(:,:) = 0.0 + ALLOC_(CS%eta_av_bc(isd:ied,jsd:jed)) ; CS%eta_av_bc(:,:) = 0.0 ! -G%Z_ref CS%time_in_cycle = 0.0 ; CS%time_in_thermo_cycle = 0.0 ! Use the Wright equation of state by default, unless otherwise specified @@ -2789,9 +2796,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (.not.query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then if (CS%split) then - call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta, eta_to_m=1.0) + call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta, eta_to_m=1.0, dZref=G%Z_ref) else - call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta_to_m=1.0) + call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta_to_m=1.0, dZref=G%Z_ref) endif endif if (CS%split) deallocate(eta) @@ -2807,7 +2814,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & (LEN_TRIM(dirs%input_filename) == 1)) if (CS%ensemble_ocean) then - call init_oda(Time, G, GV, CS%odaCS) + call init_oda(Time, G, GV, CS%diag, CS%odaCS) endif !### This could perhaps go here instead of in finish_MOM_initialization? @@ -2852,7 +2859,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) restart_CSp_tmp = restart_CSp call restart_registry_lock(restart_CSp_tmp, unlocked=.true.) allocate(z_interface(SZI_(G),SZJ_(G),SZK_(GV)+1)) - call find_eta(CS%h, CS%tv, G, GV, US, z_interface, eta_to_m=1.0) + call find_eta(CS%h, CS%tv, G, GV, US, z_interface, eta_to_m=1.0, dZref=G%Z_ref) call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, & "Interface heights", "meter", z_grid='i') ! NOTE: write_ic=.true. routes routine to fms2 IO write_initial_conditions interface @@ -3401,10 +3408,10 @@ subroutine extract_surface_state(CS, sfc_state_in) numberOfErrors=0 ! count number of errors do j=js,je ; do i=is,ie if (G%mask2dT(i,j)>0.) then - localError = sfc_state%sea_lev(i,j) <= -G%bathyT(i,j) & + localError = sfc_state%sea_lev(i,j) <= -G%bathyT(i,j) - G%Z_ref & .or. sfc_state%sea_lev(i,j) >= CS%bad_val_ssh_max & .or. sfc_state%sea_lev(i,j) <= -CS%bad_val_ssh_max & - .or. sfc_state%sea_lev(i,j) + G%bathyT(i,j) < CS%bad_val_col_thick + .or. sfc_state%sea_lev(i,j) + G%bathyT(i,j) + G%Z_ref < CS%bad_val_col_thick if (use_temperature) localError = localError & .or. sfc_state%SSS(i,j)<0. & .or. sfc_state%SSS(i,j)>=CS%bad_val_sss_max & @@ -3420,7 +3427,7 @@ subroutine extract_surface_state(CS, sfc_state_in) 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & 'x=',G%gridLonT(ig), 'y=',G%gridLatT(jg), & - 'D=',CS%US%Z_to_m*G%bathyT(i,j), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & + 'D=',CS%US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & 'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), & 'U-=',US%L_T_to_m_s*sfc_state%u(I-1,j), 'U+=',US%L_T_to_m_s*sfc_state%u(I,j), & 'V-=',US%L_T_to_m_s*sfc_state%v(i,J-1), 'V+=',US%L_T_to_m_s*sfc_state%v(i,J) @@ -3429,7 +3436,7 @@ subroutine extract_surface_state(CS, sfc_state_in) 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & 'x=',G%gridLonT(i), 'y=',G%gridLatT(j), & - 'D=',CS%US%Z_to_m*G%bathyT(i,j), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & + 'D=',CS%US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & 'U-=',US%L_T_to_m_s*sfc_state%u(I-1,j), 'U+=',US%L_T_to_m_s*sfc_state%u(I,j), & 'V-=',US%L_T_to_m_s*sfc_state%v(i,J-1), 'V+=',US%L_T_to_m_s*sfc_state%v(i,J) endif diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 89a7a1faff..23e58272ed 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -90,10 +90,9 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies - !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. - real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal - !! contributions or compressibility compensation. + !! [L2 T-2 H-1 ~> m4 s-2 kg-1]. + real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The total column mass used to + !! calculate PFu and PFv [H ~> kg m-2]. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: p ! Interface pressure [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: & @@ -301,7 +300,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ ! Find and add the tidal geopotential anomaly. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth + SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth - G%Z_ref enddo ; enddo call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) !$OMP parallel do default(shared) @@ -430,15 +429,16 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies - !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. - real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv [H ~> m or kg m-2], with any - !! tidal contributions or compressibility compensation. + !! [L2 T-2 H-1 ~> m s-2]. + real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The sea-surface height used to + !! calculate PFu and PFv [H ~> m], with any + !! tidal contributions. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: e ! Interface height in depth units [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. + SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G)) :: & @@ -451,7 +451,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm dpa, & ! The change in pressure anomaly between the top and bottom ! of a layer [R L2 T-2 ~> Pa]. intz_dpa ! The vertical integral in depth of the pressure anomaly less the - ! pressure anomaly at the top of the layer [H R L2 T-2 ~> m Pa or kg m-2 Pa]. + ! pressure anomaly at the top of the layer [H R L2 T-2 ~> m Pa]. real, dimension(SZIB_(G),SZJ_(G)) :: & intx_pa, & ! The zonal integral of the pressure anomaly along the interface ! atop a layer, divided by the grid spacing [R L2 T-2 ~> Pa]. @@ -485,7 +485,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. real :: Tl(5) ! copy and T in local stencil [degC] real :: mn_T ! mean of T in local stencil [degC] - real :: mn_T2 ! mean of T**2 in local stencil [degC] + real :: mn_T2 ! mean of T**2 in local stencil [degC2] real :: hl(5) ! Copy of local stencil of H [H ~> m] real :: r_sm_H ! Reciprocal of sum of H in local stencil [H-1 ~> m-1] real, parameter :: C1_6 = 1.0/6.0 @@ -565,13 +565,13 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - e(i,j,1) = -G%bathyT(i,j) + SSH(i,j) = -G%bathyT(i,j) - G%Z_ref enddo do k=1,nz ; do i=Isq,Ieq+1 - e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z + SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) endif ! Here layer interface heights, e, are calculated. @@ -637,13 +637,13 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm tv%eqn_of_state, EOSdom) endif do i=Isq,Ieq+1 - dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * rho_in_situ(i)) * e(i,j,1) + dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * rho_in_situ(i)) * (e(i,j,1) - G%Z_ref) enddo enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * GV%Rlay(1)) * e(i,j,1) + dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * GV%Rlay(1)) * (e(i,j,1) - G%Z_ref) enddo ; enddo endif endif @@ -667,12 +667,12 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm if (use_p_atm) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*GV%g_Earth)*e(i,j,1) + p_atm(i,j) + pa(i,j) = (rho_ref*GV%g_Earth)*(e(i,j,1) - G%Z_ref) + p_atm(i,j) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*GV%g_Earth)*e(i,j,1) + pa(i,j) = (rho_ref*GV%g_Earth)*(e(i,j,1) - G%Z_ref) enddo ; enddo endif !$OMP parallel do default(shared) @@ -700,17 +700,17 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, & G%HI, GV, tv%eqn_of_state, US, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp=CS%useMassWghtInterp, & - use_inaccurate_form=CS%use_inaccurate_pgf_rho_anom) + use_inaccurate_form=CS%use_inaccurate_pgf_rho_anom, Z_0p=G%Z_ref) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, & G%HI, GV, tv%eqn_of_state, US, dpa, intz_dpa, intx_dpa, inty_dpa, & - useMassWghtInterp=CS%useMassWghtInterp) + useMassWghtInterp=CS%useMassWghtInterp, Z_0p=G%Z_ref) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, G%HI, tv%eqn_of_state, US, dpa, & - intz_dpa, intx_dpa, inty_dpa, G%bathyT, dz_neglect, CS%useMassWghtInterp) + intz_dpa, intx_dpa, inty_dpa, G%bathyT, dz_neglect, CS%useMassWghtInterp, Z_0p=G%Z_ref) endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index ac5cb6c84c..05e68aef12 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -77,8 +77,8 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb optional, intent(out) :: pbce !< The baroclinic pressure anomaly in !! each layer due to free surface height anomalies, !! [L2 T-2 H-1 ~> m s-2 or m4 kg-1 s-2]. - real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height [H ~> kg m-1]. - + real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The total column mass used to calculate + !! PFu and PFv [H ~> kg m-2]. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & M, & ! The Montgomery potential, M = (p/rho + gz) [L2 T-2 ~> m2 s-2]. @@ -104,7 +104,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. e_tidal, & ! Bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. - geopot_bot ! Bottom geopotential relative to time-mean sea level, + geopot_bot ! Bottom geopotential relative to a temporally fixed reference value, ! including any tidal contributions [L2 T-2 ~> m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). @@ -183,7 +183,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! of self-attraction and loading. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - SSH(i,j) = -G%bathyT(i,j) + SSH(i,j) = -G%bathyT(i,j) - G%Z_ref enddo ; enddo if (use_EOS) then !$OMP parallel do default(shared) @@ -393,6 +393,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! the deepest variable density near-surface layer [R ~> kg m-3]. real :: h_star(SZI_(G),SZJ_(G)) ! Layer thickness after compensation ! for compressibility [Z ~> m]. + real :: SSH(SZI_(G),SZJ_(G)) ! The sea surface height anomaly, in depth units [Z ~> m]. real :: e_tidal(SZI_(G),SZJ_(G)) ! Bottom geopotential anomaly due to tidal ! forces from astronomical sources and self- ! attraction and loading, in depth units [Z ~> m]. @@ -444,12 +445,12 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! barotropic tides. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 - do i=Isq,Ieq+1 ; e(i,j,1) = -G%bathyT(i,j) ; enddo + do i=Isq,Ieq+1 ; SSH(i,j) = -G%bathyT(i,j) - G%Z_ref ; enddo do k=1,nz ; do i=Isq,Ieq+1 - e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z + SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) endif ! Here layer interface heights, e, are calculated. @@ -664,7 +665,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) - press(i) = -Rho0xG*e(i,j,1) + press(i) = -Rho0xG*(e(i,j,1) - G%Z_ref) enddo call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, & tv%eqn_of_state, EOSdom) @@ -673,7 +674,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) enddo do k=2,nz do i=Isq,Ieq+1 - press(i) = -Rho0xG*e(i,j,K) + press(i) = -Rho0xG*(e(i,j,K) - G%Z_ref) T_int(i) = 0.5*(tv%T(i,j,k-1)+tv%T(i,j,k)) S_int(i) = 0.5*(tv%S(i,j,k-1)+tv%S(i,j,k)) enddo diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 51f9a5cb85..471999c60c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -685,6 +685,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, integer :: isv, iev, jsv, jev ! The valid array size at the end of a step. integer :: stencil ! The stencil size of the algorithm, often 1 or 2. integer :: isvf, ievf, jsvf, jevf, num_cycles + integer :: err_count ! A counter to limit the volume of error messages written to stdout. integer :: i, j, k, n integer :: is, ie, js, je, nz, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -700,6 +701,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB MS%isdw = CS%isdw ; MS%iedw = CS%iedw ; MS%jsdw = CS%jsdw ; MS%jedw = CS%jedw h_neglect = GV%H_subroundoff + err_count = 0 Idt = 1.0 / dt accel_underflow = CS%vel_underflow * Idt @@ -2356,13 +2358,20 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (GV%Boussinesq) then do j=js,je ; do i=is,ie - if (eta(i,j) < -GV%Z_to_H*G%bathyT(i,j)) & - call MOM_error(WARNING, "btstep: eta has dropped below bathyT.") + if ((eta(i,j) < -GV%Z_to_H*G%bathyT(i,j)) .and. (G%mask2dT(i,j) > 0.0)) then + write(mesg,'(ES24.16," vs. ",ES24.16)') GV%H_to_m*eta(i,j), -US%Z_to_m*G%bathyT(i,j) + if (err_count < 2) & + call MOM_error(WARNING, "btstep: eta has dropped below bathyT: "//trim(mesg), all_print=.true.) + err_count = err_count + 1 + endif enddo ; enddo else do j=js,je ; do i=is,ie - if (eta(i,j) < 0.0) & - call MOM_error(WARNING, "btstep: negative eta in a non-Boussinesq barotropic solver.") + if (eta(i,j) < 0.0) then + if (err_count < 2) & + call MOM_error(WARNING, "btstep: negative eta in a non-Boussinesq barotropic solver.", all_print=.true.) + err_count = err_count + 1 + endif enddo ; enddo endif @@ -2566,7 +2575,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%id_vaccel > 0) call post_data(CS%id_vaccel, v_accel_bt(isd:ied,JsdB:JedB), CS%diag) if (CS%id_eta_cor > 0) call post_data(CS%id_eta_cor, CS%eta_cor, CS%diag) - if (CS%id_eta_bt > 0) call post_data(CS%id_eta_bt, eta_out, CS%diag) + if (CS%id_eta_bt > 0) call post_data(CS%id_eta_bt, eta_out, CS%diag) ! - G%Z_ref? if (CS%id_gtotn > 0) call post_data(CS%id_gtotn, gtot_N(isd:ied,jsd:jed), CS%diag) if (CS%id_gtots > 0) call post_data(CS%id_gtots, gtot_S(isd:ied,jsd:jed), CS%diag) if (CS%id_gtote > 0) call post_data(CS%id_gtote, gtot_E(isd:ied,jsd:jed), CS%diag) @@ -2685,6 +2694,16 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ADp%diag_hv(i,J,k) = BT_cont%h_v(i,J,k) enddo ; enddo ; enddo endif + if (present(ADp) .and. (associated(ADp%visc_rem_u))) then + do k=1,nz ; do j=js,je ; do I=is-1,ie + ADp%visc_rem_u(I,j,k) = visc_rem_u(I,j,k) + enddo ; enddo ; enddo + endif + if (present(ADp) .and. (associated(ADp%visc_rem_u))) then + do k=1,nz ; do J=js-1,je ; do i=is,ie + ADp%visc_rem_v(i,J,k) = visc_rem_v(i,J,k) + enddo ; enddo ; enddo + endif if (G%nonblocking_updates) then if (find_etaav) call complete_group_pass(CS%pass_etaav, G%Domain) @@ -3139,7 +3158,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B if (segment%is_E_or_W .and. segment%Flather) then do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB BT_OBC%ubt_outer(I,j) = segment%normal_vel_bt(I,j) - BT_OBC%eta_outer_u(I,j) = segment%eta(I,j) + BT_OBC%eta_outer_u(I,j) = segment%eta(I,j) + G%Z_ref*GV%Z_to_H enddo ; enddo endif enddo @@ -3193,7 +3212,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B if (segment%is_N_or_S .and. segment%Flather) then do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied BT_OBC%vbt_outer(i,J) = segment%normal_vel_bt(i,J) - BT_OBC%eta_outer_v(i,J) = segment%eta(i,J) + BT_OBC%eta_outer_v(i,J) = segment%eta(i,J) + G%Z_ref*GV%Z_to_H enddo ; enddo endif enddo @@ -3268,8 +3287,10 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) real :: Rh ! A ratio of summed thicknesses, nondim. real :: e_u(SZIB_(G),SZK_(GV)+1) ! The interface heights at u-velocity and real :: e_v(SZI_(G),SZK_(GV)+1) ! v-velocity points [H ~> m or kg m-2]. - real :: D_shallow_u(SZI_(G)) ! The shallower of the adjacent depths [H ~> m or kg m-2]. - real :: D_shallow_v(SZIB_(G))! The shallower of the adjacent depths [H ~> m or kg m-2]. + real :: D_shallow_u(SZI_(G)) ! The height of the shallower of the adjacent bathymetric depths + ! around a u-point (positive upward) [H ~> m or kg m-2] + real :: D_shallow_v(SZIB_(G))! The height of the shallower of the adjacent bathymetric depths + ! around a v-point (positive upward) [H ~> m or kg m-2] real :: htot ! The sum of the layer thicknesses [H ~> m or kg m-2]. real :: Ihtot ! The inverse of htot [H-1 ~> m-1 or m2 kg-1]. @@ -4124,7 +4145,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, halo, add_max) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec hs = 1 ; if (present(halo)) hs = max(halo,0) -!$OMP parallel default(none) shared(is,ie,js,je,hs,eta,GV,CS,Datu,Datv,add_max) & +!$OMP parallel default(none) shared(is,ie,js,je,hs,eta,GV,G,CS,Datu,Datv,add_max) & !$OMP private(H1,H2) if (present(eta)) then ! The use of harmonic mean thicknesses ensure positive definiteness. @@ -4163,31 +4184,27 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, halo, add_max) !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs Datu(I,j) = CS%dy_Cu(I,j) * GV%Z_to_H * & - (max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) + max(max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + (G%Z_ref + add_max), 0.0) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs Datv(i,J) = CS%dx_Cv(i,J) * GV%Z_to_H * & - (max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) + max(max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + (G%Z_ref + add_max), 0.0) enddo ; enddo else !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - Datu(I, j) = 0.0 - !Would be "if (G%mask2dCu(I,j)>0.) &" is G was valid on BT domain - if (CS%bathyT(i+1,j)+CS%bathyT(i,j)>0.) & - Datu(I,j) = 2.0*CS%dy_Cu(I,j) * GV%Z_to_H * & - (CS%bathyT(i+1,j) * CS%bathyT(i,j)) / & - (CS%bathyT(i+1,j) + CS%bathyT(i,j)) + H1 = (CS%bathyT(i,j) + G%Z_ref) * GV%Z_to_H ; H2 = (CS%bathyT(i+1,j) + G%Z_ref) * GV%Z_to_H + Datu(I,j) = 0.0 + if ((H1 > 0.0) .and. (H2 > 0.0)) & + Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - Datv(i, J) = 0.0 - !Would be "if (G%mask2dCv(i,J)>0.) &" is G was valid on BT domain - if (CS%bathyT(i,j+1)+CS%bathyT(i,j)>0.) & - Datv(i,J) = 2.0*CS%dx_Cv(i,J) * GV%Z_to_H * & - (CS%bathyT(i,j+1) * CS%bathyT(i,j)) / & - (CS%bathyT(i,j+1) + CS%bathyT(i,j)) + H1 = (CS%bathyT(i,j) + G%Z_ref) * GV%Z_to_H ; H2 = (CS%bathyT(i,j+1) + G%Z_ref) * GV%Z_to_H + Datv(i,J) = 0.0 + if ((H1 > 0.0) .and. (H2 > 0.0)) & + Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2) enddo ; enddo endif !$OMP end parallel @@ -4660,7 +4677,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! IareaT, IdxCu, and IdyCv need to be allocated with wide halos. ALLOC_(CS%IareaT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IareaT(:,:) = 0.0 - ALLOC_(CS%bathyT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%bathyT(:,:) = GV%Angstrom_m !### Change to 0.0? + ALLOC_(CS%bathyT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%bathyT(:,:) = 0.0 ALLOC_(CS%IdxCu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IdxCu(:,:) = 0.0 ALLOC_(CS%IdyCv(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%IdyCv(:,:) = 0.0 ALLOC_(CS%dy_Cu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%dy_Cu(:,:) = 0.0 diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 291703a242..a168fe1319 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -169,10 +169,12 @@ module MOM_dynamics_split_RK2 integer :: id_h_PFu = -1, id_h_PFv = -1 integer :: id_hf_PFu_2d = -1, id_hf_PFv_2d = -1 integer :: id_intz_PFu_2d = -1, id_intz_PFv_2d = -1 + integer :: id_PFu_visc_rem = -1, id_PFv_visc_rem = -1 ! integer :: id_hf_CAu = -1, id_hf_CAv = -1 integer :: id_h_CAu = -1, id_h_CAv = -1 integer :: id_hf_CAu_2d = -1, id_hf_CAv_2d = -1 integer :: id_intz_CAu_2d = -1, id_intz_CAv_2d = -1 + integer :: id_CAu_visc_rem = -1, id_CAv_visc_rem = -1 ! Split scheme only. integer :: id_uav = -1, id_vav = -1 @@ -181,6 +183,7 @@ module MOM_dynamics_split_RK2 integer :: id_h_u_BT_accel = -1, id_h_v_BT_accel = -1 integer :: id_hf_u_BT_accel_2d = -1, id_hf_v_BT_accel_2d = -1 integer :: id_intz_u_BT_accel_2d = -1, id_intz_v_BT_accel_2d = -1 + integer :: id_u_BT_accel_visc_rem = -1, id_v_BT_accel_visc_rem = -1 !>@} type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the @@ -360,6 +363,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s real, dimension(SZI_(G),SZJB_(G)) :: & intz_PFv_2d, intz_CAv_2d, intz_v_BT_accel_2d ! [H L T-2 ~> m2 s-2]. + ! Diagnostics for momentum budget terms multiplied by visc_rem_[uv], + real, allocatable, dimension(:,:,:) :: & + PFu_visc_rem, PFv_visc_rem, & ! Pressure force accel. x visc_rem_[uv] [L T-2 ~> m s-2]. + CAu_visc_rem, CAv_visc_rem, & ! Coriolis force accel. x visc_rem_[uv] [L T-2 ~> m s-2]. + u_BT_accel_visc_rem, v_BT_accel_visc_rem ! barotropic correction accel. x visc_rem_[uv] [L T-2 ~> m s-2]. + real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. logical :: dyn_p_surf @@ -1108,6 +1117,61 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(h_v_BT_accel) endif + if (CS%id_PFu_visc_rem > 0) then + allocate(PFu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) + PFu_visc_rem(:,:,:) = 0.0 + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + PFu_visc_rem(I,j,k) = CS%PFu(I,j,k) * CS%ADp%visc_rem_u(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_PFu_visc_rem, PFu_visc_rem, CS%diag) + deallocate(PFu_visc_rem) + endif + if (CS%id_PFv_visc_rem > 0) then + allocate(PFv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) + PFv_visc_rem(:,:,:) = 0.0 + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + PFv_visc_rem(i,J,k) = CS%PFv(i,J,k) * CS%ADp%visc_rem_v(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_PFv_visc_rem, PFv_visc_rem, CS%diag) + deallocate(PFv_visc_rem) + endif + if (CS%id_CAu_visc_rem > 0) then + allocate(CAu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) + CAu_visc_rem(:,:,:) = 0.0 + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + CAu_visc_rem(I,j,k) = CS%CAu(I,j,k) * CS%ADp%visc_rem_u(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_CAu_visc_rem, CAu_visc_rem, CS%diag) + deallocate(CAu_visc_rem) + endif + if (CS%id_CAv_visc_rem > 0) then + allocate(CAv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) + CAv_visc_rem(:,:,:) = 0.0 + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + CAv_visc_rem(i,J,k) = CS%CAv(i,J,k) * CS%ADp%visc_rem_v(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_CAv_visc_rem, CAv_visc_rem, CS%diag) + deallocate(CAv_visc_rem) + endif + if (CS%id_u_BT_accel_visc_rem > 0) then + allocate(u_BT_accel_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) + u_BT_accel_visc_rem(:,:,:) = 0.0 + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + u_BT_accel_visc_rem(I,j,k) = CS%u_accel_bt(I,j,k) * CS%ADp%visc_rem_u(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_u_BT_accel_visc_rem, u_BT_accel_visc_rem, CS%diag) + deallocate(u_BT_accel_visc_rem) + endif + if (CS%id_v_BT_accel_visc_rem > 0) then + allocate(v_BT_accel_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) + v_BT_accel_visc_rem(:,:,:) = 0.0 + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + v_BT_accel_visc_rem(i,J,k) = CS%v_accel_bt(i,J,k) * CS%ADp%visc_rem_v(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_v_BT_accel_visc_rem, v_BT_accel_visc_rem, CS%diag) + deallocate(v_BT_accel_visc_rem) + endif + if (CS%debug) then call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym) call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) @@ -1612,6 +1676,33 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_intz_v_BT_accel_2d > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) + CS%id_PFu_visc_rem = register_diag_field('ocean_model', 'PFu_visc_rem', diag%axesCuL, Time, & + 'Zonal Pressure Force Acceleration multiplied by the viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if (CS%id_PFu_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) + CS%id_PFv_visc_rem = register_diag_field('ocean_model', 'PFv_visc_rem', diag%axesCvL, Time, & + 'Meridional Pressure Force Acceleration multiplied by the viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if(CS%id_PFv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + + CS%id_CAu_visc_rem = register_diag_field('ocean_model', 'CAu_visc_rem', diag%axesCuL, Time, & + 'Zonal Coriolis and Advective Acceleration multiplied by the viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if (CS%id_CAu_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) + CS%id_CAv_visc_rem = register_diag_field('ocean_model', 'CAv_visc_rem', diag%axesCvL, Time, & + 'Meridional Coriolis and Advective Acceleration multiplied by the viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if(CS%id_CAv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + + CS%id_u_BT_accel_visc_rem = register_diag_field('ocean_model', 'u_BT_accel_visc_rem', diag%axesCuL, Time, & + 'Barotropic Anomaly Zonal Acceleration multiplied by the viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if (CS%id_u_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) + CS%id_v_BT_accel_visc_rem = register_diag_field('ocean_model', 'v_BT_accel_visc_rem', diag%axesCvL, Time, & + 'Barotropic Anomaly Meridional Acceleration multiplied by the viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if(CS%id_v_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) id_clock_pres = cpu_clock_id('(Ocean pressure force)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 1ac5e39dd5..e672252c24 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -283,10 +283,10 @@ subroutine MOM_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_v G%bathymetry_at_vel = .false. if (present(bathymetry_at_vel)) G%bathymetry_at_vel = bathymetry_at_vel if (G%bathymetry_at_vel) then - ALLOC_(G%Dblock_u(IsdB:IedB, jsd:jed)) ; G%Dblock_u(:,:) = 0.0 - ALLOC_(G%Dopen_u(IsdB:IedB, jsd:jed)) ; G%Dopen_u(:,:) = 0.0 - ALLOC_(G%Dblock_v(isd:ied, JsdB:JedB)) ; G%Dblock_v(:,:) = 0.0 - ALLOC_(G%Dopen_v(isd:ied, JsdB:JedB)) ; G%Dopen_v(:,:) = 0.0 + ALLOC_(G%Dblock_u(IsdB:IedB, jsd:jed)) ; G%Dblock_u(:,:) = -G%Z_ref + ALLOC_(G%Dopen_u(IsdB:IedB, jsd:jed)) ; G%Dopen_u(:,:) = -G%Z_ref + ALLOC_(G%Dblock_v(isd:ied, JsdB:JedB)) ; G%Dblock_v(:,:) = -G%Z_ref + ALLOC_(G%Dopen_v(isd:ied, JsdB:JedB)) ; G%Dopen_v(:,:) = -G%Z_ref endif ! setup block indices. @@ -387,6 +387,7 @@ end subroutine MOM_grid_init subroutine rescale_grid_bathymetry(G, m_in_new_units) type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure real, intent(in) :: m_in_new_units !< The new internal representation of 1 m depth. + ! It appears that this routine is never called. ! Local variables real :: rescale @@ -578,7 +579,7 @@ subroutine allocate_metrics(G) ALLOC_(G%IareaCu(IsdB:IedB,jsd:jed)) ; G%IareaCu(:,:) = 0.0 ALLOC_(G%IareaCv(isd:ied,JsdB:JedB)) ; G%IareaCv(:,:) = 0.0 - ALLOC_(G%bathyT(isd:ied, jsd:jed)) ; G%bathyT(:,:) = 0.0 + ALLOC_(G%bathyT(isd:ied, jsd:jed)) ; G%bathyT(:,:) = -G%Z_ref ALLOC_(G%CoriolisBu(IsdB:IedB, JsdB:JedB)) ; G%CoriolisBu(:,:) = 0.0 ALLOC_(G%dF_dx(isd:ied, jsd:jed)) ; G%dF_dx(:,:) = 0.0 ALLOC_(G%dF_dy(isd:ied, jsd:jed)) ; G%dF_dy(:,:) = 0.0 diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 059677c6f7..b83c4d1be8 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -4726,6 +4726,7 @@ subroutine mask_outside_OBCs(G, US, param_file, OBC) call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & units="m", default=0.0, scale=US%m_to_Z, do_not_log=.true.) + ! The reference depth on a dyn_horgrid is 0, otherwise would need: min_depth = min_depth - G%Z_ref allocate(color(G%isd:G%ied, G%jsd:G%jed)) ; color = 0 allocate(color2(G%isd:G%ied, G%jsd:G%jed)) ; color2 = 0 diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index 51d44c1041..a9626a805c 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -20,7 +20,8 @@ module MOM_transcribe_grid contains !> Copies information from a dynamic (shared) horizontal grid type into an -!! ocean_grid_type. +!! ocean_grid_type. There may also be a change in the reference +!! height for topography between the two grids. subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) type(dyn_horgrid_type), intent(in) :: dG !< Common horizontal grid type type(ocean_grid_type), intent(inout) :: oG !< Ocean grid type @@ -54,7 +55,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) oG%dxT(i,j) = dG%dxT(i+ido,j+jdo) oG%dyT(i,j) = dG%dyT(i+ido,j+jdo) oG%areaT(i,j) = dG%areaT(i+ido,j+jdo) - oG%bathyT(i,j) = dG%bathyT(i+ido,j+jdo) + oG%bathyT(i,j) = dG%bathyT(i+ido,j+jdo) - oG%Z_ref oG%dF_dx(i,j) = dG%dF_dx(i+ido,j+jdo) oG%dF_dy(i,j) = dG%dF_dy(i+ido,j+jdo) @@ -100,12 +101,12 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) oG%bathymetry_at_vel = dG%bathymetry_at_vel if (oG%bathymetry_at_vel) then do I=IsdB,IedB ; do j=jsd,jed - oG%Dblock_u(I,j) = dG%Dblock_u(I+ido,j+jdo) - oG%Dopen_u(I,j) = dG%Dopen_u(I+ido,j+jdo) + oG%Dblock_u(I,j) = dG%Dblock_u(I+ido,j+jdo) - oG%Z_ref + oG%Dopen_u(I,j) = dG%Dopen_u(I+ido,j+jdo) - oG%Z_ref enddo ; enddo do i=isd,ied ; do J=JsdB,JedB - oG%Dblock_v(i,J) = dG%Dblock_v(i+ido,J+jdo) - oG%Dopen_v(i,J) = dG%Dopen_v(i+ido,J+jdo) + oG%Dblock_v(i,J) = dG%Dblock_v(i+ido,J+jdo) - oG%Z_ref + oG%Dopen_v(i,J) = dG%Dopen_v(i+ido,J+jdo) - oG%Z_ref enddo ; enddo endif @@ -164,7 +165,8 @@ end subroutine copy_dyngrid_to_MOM_grid !> Copies information from an ocean_grid_type into a dynamic (shared) -!! horizontal grid type. +!! horizontal grid type. There may also be a change in the reference +!! height for topography between the two grids. subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) type(ocean_grid_type), intent(in) :: oG !< Ocean grid type type(dyn_horgrid_type), intent(inout) :: dG !< Common horizontal grid type @@ -198,7 +200,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) dG%dxT(i,j) = oG%dxT(i+ido,j+jdo) dG%dyT(i,j) = oG%dyT(i+ido,j+jdo) dG%areaT(i,j) = oG%areaT(i+ido,j+jdo) - dG%bathyT(i,j) = oG%bathyT(i+ido,j+jdo) + dG%bathyT(i,j) = oG%bathyT(i+ido,j+jdo) + oG%Z_ref dG%dF_dx(i,j) = oG%dF_dx(i+ido,j+jdo) dG%dF_dy(i,j) = oG%dF_dy(i+ido,j+jdo) @@ -244,12 +246,12 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) dG%bathymetry_at_vel = oG%bathymetry_at_vel if (dG%bathymetry_at_vel) then do I=IsdB,IedB ; do j=jsd,jed - dG%Dblock_u(I,j) = oG%Dblock_u(I+ido,j+jdo) - dG%Dopen_u(I,j) = oG%Dopen_u(I+ido,j+jdo) + dG%Dblock_u(I,j) = oG%Dblock_u(I+ido,j+jdo) + oG%Z_ref + dG%Dopen_u(I,j) = oG%Dopen_u(I+ido,j+jdo) + oG%Z_ref enddo ; enddo do i=isd,ied ; do J=JsdB,JedB - dG%Dblock_v(i,J) = oG%Dblock_v(i+ido,J+jdo) - dG%Dopen_v(i,J) = oG%Dopen_v(i+ido,J+jdo) + dG%Dblock_v(i,J) = oG%Dblock_v(i+ido,J+jdo) + oG%Z_ref + dG%Dopen_v(i,J) = oG%Dopen_v(i+ido,J+jdo) + oG%Z_ref enddo ; enddo endif diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 3f98a97052..ab85db8baf 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -195,6 +195,9 @@ module MOM_variables real, pointer :: diag_hu(:,:,:) => NULL() !< layer thickness at u points real, pointer :: diag_hv(:,:,:) => NULL() !< layer thickness at v points + real, pointer :: visc_rem_u(:,:,:) => NULL() !< viscous remnant at u points + real, pointer :: visc_rem_v(:,:,:) => NULL() !< viscous remnant at v points + end type accel_diag_ptrs !> Pointers to arrays with transports, which can later be used for derived diagnostics, like energy balances. diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 45b08cc799..b5a1a6bf0c 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -248,13 +248,13 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j+1,k)); enddo - e(nz+1) = -US%Z_to_m*G%bathyT(i,j) + e(nz+1) = -US%Z_to_m*(G%bathyT(i,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k) ; enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo - e(nz+1) = -US%Z_to_m*G%bathyT(i+1,j) + e(nz+1) = -US%Z_to_m*(G%bathyT(i+1,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i+1,j,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) @@ -331,7 +331,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp (0.5*US%L_T_to_m_s*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo endif - write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*G%bathyT(i,j),US%Z_to_m*G%bathyT(i+1,j) + write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*(G%bathyT(i,j) + G%Z_ref), US%Z_to_m*(G%bathyT(i+1,j) + G%Z_ref) ! From here on, the normalized accelerations are written. if (prev_avail) then @@ -584,13 +584,13 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp write(file,'(/,"h++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i+1,j+1,k); enddo - e(nz+1) = -US%Z_to_m*G%bathyT(i,j) + e(nz+1) = -US%Z_to_m*(G%bathyT(i,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k); enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo - e(nz+1) = -US%Z_to_m*G%bathyT(i,j+1) + e(nz+1) = -US%Z_to_m*(G%bathyT(i,j+1) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j+1,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) @@ -667,7 +667,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp (CS%u_prev(I,j+1,k) * h_scale*0.5*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo endif - write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*G%bathyT(i,j),US%Z_to_m*G%bathyT(i,j+1) + write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*(G%bathyT(i,j) + G%Z_ref), US%Z_to_m*(G%bathyT(i,j+1) + G%Z_ref) ! From here on, the normalized accelerations are written. if (prev_avail) then diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 44b05cc081..b3041f5afb 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -386,14 +386,14 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif if (associated(CS%e)) then - call find_eta(h, tv, G, GV, US, CS%e) + call find_eta(h, tv, G, GV, US, CS%e, dZref=G%Z_ref) if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) endif if (associated(CS%e_D)) then if (associated(CS%e)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e(i,j,k) + G%bathyT(i,j) + CS%e_D(i,j,k) = CS%e(i,j,k) + (G%bathyT(i,j) + G%Z_ref) enddo ; enddo ; enddo else call find_eta(h, tv, G, GV, US, CS%e_D) @@ -2132,7 +2132,8 @@ subroutine write_static_fields(G, GV, US, tv, diag) type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output ! Local variables - integer :: id + real :: work_2d(SZI_(G),SZJ_(G)) ! A 2-d temporary work array. + integer :: id, i, j logical :: use_temperature id = register_static_field('ocean_model', 'geolat', diag%axesT1, & @@ -2204,7 +2205,10 @@ subroutine write_static_fields(G, GV, US, tv, diag) cmor_field_name='deptho', cmor_long_name='Sea Floor Depth', & cmor_standard_name='sea_floor_depth_below_geoid', area=diag%axesT1%id_area, & x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') - if (id > 0) call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT) + if (id > 0) then + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; work_2d(i,j) = G%bathyT(i,j)+G%Z_ref ; enddo ; enddo + call post_data(id, work_2d, diag, .true., mask=G%mask2dT) + endif id = register_static_field('ocean_model', 'wet', diag%axesT1, & '0 if land, 1 if ocean at tracer points', 'none', area=diag%axesT1%id_area) @@ -2341,7 +2345,6 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) call safe_alloc_ptr(ADp%gradKEu,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%gradKEv,isd,ied,JsdB,JedB,nz) endif - if (associated(CS%KE_visc)) then call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) @@ -2395,7 +2398,7 @@ subroutine MOM_diagnostics_end(CS, ADp, CDp) if (associated(CS%vhGM_Rlay)) deallocate(CS%vhGM_Rlay) if (associated(ADp%gradKEu)) deallocate(ADp%gradKEu) - if (associated(ADp%gradKEu)) deallocate(ADp%gradKEu) + if (associated(ADp%gradKEv)) deallocate(ADp%gradKEv) if (associated(ADp%du_dt_visc)) deallocate(ADp%du_dt_visc) if (associated(ADp%dv_dt_visc)) deallocate(ADp%dv_dt_visc) if (associated(ADp%du_dt_str)) deallocate(ADp%du_dt_str) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 72523edfd3..d190cee7a3 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -542,7 +542,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ enddo ; enddo ; enddo mass_tot = reproducing_sum(tmp1, isr, ier, jsr, jer, sums=mass_lay, EFP_sum=mass_EFP) - call find_eta(h, tv, G, GV, US, eta) + call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) do k=1,nz ; do j=js,je ; do i=is,ie tmp1(i,j,k) = US%Z_to_m*US%L_to_m**2*(eta(i,j,K)-eta(i,j,K+1)) * areaTm(i,j) enddo ; enddo ; enddo @@ -674,8 +674,8 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ hbelow = 0.0 do k=nz,1,-1 hbelow = hbelow + h(i,j,k) * GV%H_to_Z - hint = Z_0APE(K) + (hbelow - G%bathyT(i,j)) - hbot = Z_0APE(K) - G%bathyT(i,j) + hint = Z_0APE(K) + (hbelow - (G%bathyT(i,j) + G%Z_ref)) + hbot = Z_0APE(K) - (G%bathyT(i,j) + G%Z_ref) hbot = (hbot + ABS(hbot)) * 0.5 PE_pt(i,j,K) = (0.5 * PE_scale_factor * areaTm(i,j)) * (GV%Rho0*GV%g_prime(K)) * & (hint * hint - hbot * hbot) @@ -685,7 +685,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ do j=js,je ; do i=is,ie do k=nz,1,-1 hint = Z_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. - hbot = max(Z_0APE(K) - G%bathyT(i,j), 0.0) + hbot = max(Z_0APE(K) - (G%bathyT(i,j) + G%Z_ref), 0.0) PE_pt(i,j,K) = (0.5 * PE_scale_factor * areaTm(i,j) * (GV%Rho0*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo @@ -1166,7 +1166,7 @@ subroutine create_depth_list(G, DL, min_depth_inc) i_global = i + G%idg_offset - (G%isg-1) list_pos = (j_global-1)*G%Domain%niglobal + i_global - Dlist(list_pos) = G%bathyT(i,j) + Dlist(list_pos) = G%bathyT(i,j) + G%Z_ref Arealist(list_pos) = G%mask2dT(i,j) * G%areaT(i,j) enddo ; enddo @@ -1401,7 +1401,7 @@ subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) ! Depth checksum do j=G%jsc,G%jec ; do i=G%isc,G%iec - field(i,j) = G%bathyT(i,j) + field(i,j) = G%bathyT(i,j) + G%Z_ref enddo ; enddo write(depth_chksum, '(Z16)') field_chksum(field(:,:)) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index d363b185f8..6a4d9660d7 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -445,7 +445,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ gp = gprime(K) if (l_mono_N2_column_fraction>0. .or. l_mono_N2_depth>=0.) then !### Change to: if ( ((htot(i) - sum_hc < l_mono_N2_column_fraction*htot(i)) .or. & ) ) - if ( ((G%bathyT(i,j) - sum_hc < l_mono_N2_column_fraction*G%bathyT(i,j)) .or. & + if ( (((G%bathyT(i,j)+G%Z_ref) - sum_hc < l_mono_N2_column_fraction*(G%bathyT(i,j)+G%Z_ref)) .or. & ((l_mono_N2_depth >= 0.) .and. (sum_hc > l_mono_N2_depth))) .and. & (L2_to_Z2*gp > N2min*hw) ) then ! Filters out regions where N2 increases with depth but only in a lower fraction diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index d3eb21dcbe..bb11d92673 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -321,22 +321,22 @@ subroutine diag_remap_update(remap_cs, G, GV, US, h, T, S, eqn_of_state, h_targe if (remap_cs%vertical_coord == coordinateMode('ZSTAR')) then call build_zstar_column(get_zlike_CS(remap_cs%regrid_cs), & - GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), & + GV%Z_to_H*(G%bathyT(i,j)+G%Z_ref), sum(h(i,j,:)), & zInterfaces, zScale=GV%Z_to_H) elseif (remap_cs%vertical_coord == coordinateMode('SIGMA')) then call build_sigma_column(get_sigma_CS(remap_cs%regrid_cs), & - GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) + GV%Z_to_H*(G%bathyT(i,j)+G%Z_ref), sum(h(i,j,:)), zInterfaces) elseif (remap_cs%vertical_coord == coordinateMode('RHO')) then call build_rho_column(get_rho_CS(remap_cs%regrid_cs), GV%ke, & - GV%Z_to_H*G%bathyT(i,j), h(i,j,:), T(i,j,:), S(i,j,:), & + GV%Z_to_H*(G%bathyT(i,j)+G%Z_ref), h(i,j,:), T(i,j,:), S(i,j,:), & eqn_of_state, zInterfaces, h_neglect, h_neglect_edge) elseif (remap_cs%vertical_coord == coordinateMode('SLIGHT')) then ! call build_slight_column(remap_cs%regrid_cs,remap_cs%remap_cs, nz, & -! GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) +! GV%Z_to_H*(G%bathyT(i,j)+G%Z_ref), sum(h(i,j,:)), zInterfaces) call MOM_error(FATAL,"diag_remap_update: SLIGHT coordinate not coded for diagnostics yet!") elseif (remap_cs%vertical_coord == coordinateMode('HYCOM1')) then ! call build_hycom1_column(remap_cs%regrid_cs, nz, & -! GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) +! GV%Z_to_H*(G%bathyT(i,j)+G%Z_ref), sum(h(i,j,:)), zInterfaces) call MOM_error(FATAL,"diag_remap_update: HYCOM1 coordinate not coded for diagnostics yet!") endif do k = 1,nz diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index d1a4b7f45d..de2a76a746 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -263,12 +263,16 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, real, intent(in) :: conversion !< Conversion factor for tracer. integer, intent(in) :: recnum !< Record number of tracer to be read. type(ocean_grid_type), intent(inout) :: G !< Grid object - real, allocatable, dimension(:,:,:) :: tr_z !< pointer to allocatable tracer array on local + real, allocatable, dimension(:,:,:), intent(out) :: tr_z + !< pointer to allocatable tracer array on local !! model grid and input-file vertical levels. - real, allocatable, dimension(:,:,:) :: mask_z !< pointer to allocatable tracer mask array on + real, allocatable, dimension(:,:,:), intent(out) :: mask_z + !< pointer to allocatable tracer mask array on !! local model grid and input-file vertical levels. - real, allocatable, dimension(:) :: z_in !< Cell grid values for input data. - real, allocatable, dimension(:) :: z_edges_in !< Cell grid edge values for input data. + real, allocatable, dimension(:), intent(out) :: z_in + !< Cell grid values for input data. + real, allocatable, dimension(:), intent(out) :: z_edges_in + !< Cell grid edge values for input data. real, intent(out) :: missing_value !< The missing value in the returned array. logical, intent(in) :: reentrant_x !< If true, this grid is reentrant in the x-direction logical, intent(in) :: tripolar_n !< If true, this is a northern tripolar grid @@ -329,10 +333,6 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, is_ongrid = .false. if (present(ongrid)) is_ongrid = ongrid - if (allocated(tr_z)) deallocate(tr_z) - if (allocated(mask_z)) deallocate(mask_z) - if (allocated(z_edges_in)) deallocate(z_edges_in) - PI_180 = atan(1.0)/45. ! Open NetCDF file and if present, extract data and spatial coordinate information @@ -383,13 +383,6 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, rcode = NF90_GET_ATT(ncid, varid, "scale_factor", scale_factor) if (rcode /= 0) scale_factor = 1.0 - if (allocated(lon_in)) deallocate(lon_in) - if (allocated(lat_in)) deallocate(lat_in) - if (allocated(z_in)) deallocate(z_in) - if (allocated(z_edges_in)) deallocate(z_edges_in) - if (allocated(tr_z)) deallocate(tr_z) - if (allocated(mask_z)) deallocate(mask_z) - allocate(lon_in(id), lat_in(jd), z_in(kd), z_edges_in(kd+1)) allocate(tr_z(isd:ied,jsd:jed,kd), mask_z(isd:ied,jsd:jed,kd)) @@ -450,10 +443,10 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, allocate(mask_in(id,jdp)) ; mask_in(:,:) = 0.0 endif - max_depth = maxval(G%bathyT) + max_depth = maxval(G%bathyT(:,:)) + G%Z_ref call max_across_PEs(max_depth) - if (z_edges_in(kd+1) Create a 2d-mesh of grid coordinates from 1-d arrays. diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index f8cfb09382..00eeb4cf89 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -4,6 +4,7 @@ module MOM_io ! This file is part of MOM6. See LICENSE.md for the license. use MOM_array_transform, only : allocate_rotated_array, rotate_array +use MOM_array_transform, only : rotate_array_pair, rotate_vector use MOM_domains, only : MOM_domain_type, domain1D, broadcast, get_domain_components use MOM_domains, only : rescale_comp_data, AGRID, BGRID_NE, CGRID_NE use MOM_dyn_horgrid, only : dyn_horgrid_type @@ -11,8 +12,9 @@ module MOM_io use MOM_error_handler, only : MOM_error, NOTE, FATAL, WARNING, is_root_PE use MOM_file_parser, only : log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_io_infra, only : MOM_read_data, MOM_read_vector, read_field_chksum -use MOM_io_infra, only : read_data=>MOM_read_data ! read_data will be removed soon. +use MOM_io_infra, only : read_field, read_vector +use MOM_io_infra, only : read_data => read_field ! Deprecated +use MOM_io_infra, only : read_field_chksum use MOM_io_infra, only : file_type, file_exists, get_file_info, get_file_fields use MOM_io_infra, only : open_file, open_ASCII_file, close_file, flush_file, file_is_open use MOM_io_infra, only : get_field_size, fieldtype, field_exists, get_field_atts @@ -64,6 +66,24 @@ module MOM_io !> These encoding constants are used to indicate the discretization position of a variable public :: CENTER, CORNER, NORTH_FACE, EAST_FACE +!> Read a field from file using the infrastructure I/O. +interface MOM_read_data + module procedure MOM_read_data_0d + module procedure MOM_read_data_0d_int + module procedure MOM_read_data_1d + module procedure MOM_read_data_1d_int + module procedure MOM_read_data_2d + module procedure MOM_read_data_2d_region + module procedure MOM_read_data_3d + module procedure MOM_read_data_4d +end interface MOM_read_data + +!> Read a vector from file using the infrastructure I/O. +interface MOM_read_vector + module procedure MOM_read_vector_2d + module procedure MOM_read_vector_3d +end interface MOM_read_vector + !> Write a registered field to an output file, potentially with rotation interface MOM_write_field module procedure MOM_write_field_4d @@ -1619,6 +1639,293 @@ subroutine query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & end subroutine query_vardesc +!> Read a scalar from file using infrastructure I/O. +subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Domain, & + global_file, file_may_be_4d) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + real, intent(inout) :: data !< Field value + integer, optional, intent(in) :: timelevel !< Time level to read in file + real, optional, intent(in) :: scale !< Rescale factor + type(MOM_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition + logical, optional, intent(in) :: global_file !< If true, read from a single file + logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored + !! as 4d arrays in the file. + + call read_field(filename, fieldname, data, & + timelevel=timelevel, scale=scale, MOM_Domain=MOM_Domain, & + global_file=global_file, file_may_be_4d=file_may_be_4d & + ) +end subroutine MOM_read_data_0d + + +!> Read a scalar integer from file using infrastructure I/O. +subroutine MOM_read_data_0d_int(filename, fieldname, data, timelevel) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + integer, intent(inout) :: data !< Field value + integer, optional, intent(in) :: timelevel !< Time level to read in file + + call read_field(filename, fieldname, data, timelevel=timelevel) +end subroutine MOM_read_data_0d_int + + +!> Read a 1d array from file using infrastructure I/O. +subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Domain, & + global_file, file_may_be_4d) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + real, dimension(:), intent(inout) :: data !< Field value + integer, optional, intent(in) :: timelevel !< Time level to read in file + real, optional, intent(in) :: scale !< Rescale factor + type(MOM_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition + logical, optional, intent(in) :: global_file !< If true, read from a single file + logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored + !! as 4d arrays in the file. + + call read_field(filename, fieldname, data, & + timelevel=timelevel, scale=scale, MOM_Domain=MOM_Domain, & + global_file=global_file, file_may_be_4d=file_may_be_4d & + ) +end subroutine MOM_read_data_1d + + +!> Read a 1d integer array from file using infrastructure I/O. +subroutine MOM_read_data_1d_int(filename, fieldname, data, timelevel) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + integer, dimension(:), intent(inout) :: data !< Field value + integer, optional, intent(in) :: timelevel !< Time level to read in file + + call read_field(filename, fieldname, data, timelevel=timelevel) +end subroutine MOM_read_data_1d_int + + +!> Read a 2d array from file using infrastructure I/O. +subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & + timelevel, position, scale, global_file, file_may_be_4d) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + real, dimension(:,:), intent(inout) :: data !< Field value + type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition + integer, optional, intent(in) :: timelevel !< Time level to read in file + integer, optional, intent(in) :: position !< Grid positioning flag + real, optional, intent(in) :: scale !< Rescale factor + logical, optional, intent(in) :: global_file !< If true, read from a single file + logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored + !! as 4d arrays in the file. + + integer :: turns ! Number of quarter-turns from input to model grid + real, allocatable :: data_in(:,:) ! Field array on the input grid + + turns = MOM_domain%turns + if (turns == 0) then + call read_field(filename, fieldname, data, MOM_Domain, & + timelevel=timelevel, position=position, scale=scale, & + global_file=global_file, file_may_be_4d=file_may_be_4d & + ) + else + call allocate_rotated_array(data, [1,1], -turns, data_in) + call read_field(filename, fieldname, data_in, MOM_Domain%domain_in, & + timelevel=timelevel, position=position, scale=scale, & + global_file=global_file, file_may_be_4d=file_may_be_4d & + ) + call rotate_array(data_in, turns, data) + deallocate(data_in) + endif +end subroutine MOM_read_data_2d + + +!> Read a 2d region array from file using infrastructure I/O. +subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_domain, & + no_domain, scale, turns) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + real, dimension(:,:), intent(inout) :: data !< Field value + integer, dimension(:), intent(in) :: start !< Starting index for each axis. + !! In 2d, start(3:4) must be 1. + integer, dimension(:), intent(in) :: nread !< Number of values to read along each axis. + !! In 2d, nread(3:4) must be 1. + type(MOM_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition + logical, optional, intent(in) :: no_domain !< If true, field does not use + !! domain decomposion. + real, optional, intent(in) :: scale !< Rescale factor + integer, optional, intent(in) :: turns !< Number of quarter turns from + !! input to model grid + + integer :: qturns ! Number of quarter turns + real, allocatable :: data_in(:,:) ! Field array on the input grid + + qturns = 0 + if (present(turns)) qturns = modulo(turns, 4) + + if (qturns == 0) then + call read_field(filename, fieldname, data, start, nread, & + MOM_Domain=MOM_Domain, no_domain=no_domain, scale=scale & + ) + else + call allocate_rotated_array(data, [1,1], -qturns, data_in) + call read_field(filename, fieldname, data_in, start, nread, & + MOM_Domain=MOM_Domain%domain_in, no_domain=no_domain, scale=scale & + ) + call rotate_array(data_in, qturns, data) + deallocate(data_in) + endif +end subroutine MOM_read_data_2d_region + + +!> Read a 3d array from file using infrastructure I/O. +subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & + timelevel, position, scale, global_file, file_may_be_4d) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + real, dimension(:,:,:), intent(inout) :: data !< Field value + type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition + integer, optional, intent(in) :: timelevel !< Time level to read in file + integer, optional, intent(in) :: position !< Grid positioning flag + real, optional, intent(in) :: scale !< Rescale factor + logical, optional, intent(in) :: global_file !< If true, read from a single file + logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored + !! as 4d arrays in the file. + + integer :: turns ! Number of quarter-turns from input to model grid + real, allocatable :: data_in(:,:,:) ! Field array on the input grid + + turns = MOM_domain%turns + if (turns == 0) then + call read_field(filename, fieldname, data, MOM_Domain, & + timelevel=timelevel, position=position, scale=scale, & + global_file=global_file, file_may_be_4d=file_may_be_4d & + ) + else + call allocate_rotated_array(data, [1,1,1], -turns, data_in) + call read_field(filename, fieldname, data_in, MOM_Domain%domain_in, & + timelevel=timelevel, position=position, scale=scale, & + global_file=global_file, file_may_be_4d=file_may_be_4d & + ) + call rotate_array(data_in, turns, data) + deallocate(data_in) + endif +end subroutine MOM_read_data_3d + + +!> Read a 4d array from file using infrastructure I/O. +subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & + timelevel, position, scale, global_file) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + real, dimension(:,:,:,:), intent(inout) :: data !< Field value + type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition + integer, optional, intent(in) :: timelevel !< Time level to read in file + integer, optional, intent(in) :: position !< Grid positioning flag + real, optional, intent(in) :: scale !< Rescale factor + logical, optional, intent(in) :: global_file !< If true, read from a single file + + integer :: turns ! Number of quarter-turns from input to model grid + real, allocatable :: data_in(:,:,:,:) ! Field array on the input grid + + turns = MOM_domain%turns + + if (turns == 0) then + call read_field(filename, fieldname, data, MOM_Domain, & + timelevel=timelevel, position=position, scale=scale, & + global_file=global_file & + ) + else + ! Read field along the input grid and rotate to the model grid + call allocate_rotated_array(data, [1,1,1,1], -turns, data_in) + call read_field(filename, fieldname, data_in, MOM_Domain%domain_in, & + timelevel=timelevel, position=position, scale=scale, & + global_file=global_file & + ) + call rotate_array(data_in, turns, data) + deallocate(data_in) + endif +end subroutine MOM_read_data_4d + + +!> Read a 2d vector tuple from file using infrastructure I/O. +subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & + timelevel, stagger, scalar_pair, scale) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: u_fieldname !< Field variable name in u + character(len=*), intent(in) :: v_fieldname !< Field variable name in v + real, dimension(:,:), intent(inout) :: u_data !< Field value in u + real, dimension(:,:), intent(inout) :: v_data !< Field value in v + type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition + integer, optional, intent(in) :: timelevel !< Time level to read in file + integer, optional, intent(in) :: stagger !< Grid staggering flag + logical, optional, intent(in) :: scalar_pair !< True if tuple is not a vector + real, optional, intent(in) :: scale !< Rescale factor + + integer :: turns ! Number of quarter-turns from input to model grid + real, allocatable :: u_data_in(:,:), v_data_in(:,:) ! [uv] on the input grid + + turns = MOM_Domain%turns + if (turns == 0) then + call read_vector(filename, u_fieldname, v_fieldname, & + u_data, v_data, MOM_domain, timelevel=timelevel, stagger=stagger, & + scalar_pair=scalar_pair, scale=scale & + ) + else + call allocate_rotated_array(u_data, [1,1], -turns, u_data_in) + call allocate_rotated_array(v_data, [1,1], -turns, v_data_in) + call read_vector(filename, u_fieldname, v_fieldname, & + u_data_in, v_data_in, MOM_domain%domain_in, timelevel=timelevel, & + stagger=stagger, scalar_pair=scalar_pair, scale=scale & + ) + if (scalar_pair) then + call rotate_array_pair(u_data_in, v_data_in, turns, u_data, v_data) + else + call rotate_vector(u_data_in, v_data_in, turns, u_data, v_data) + endif + deallocate(v_data_in) + deallocate(u_data_in) + endif +end subroutine MOM_read_vector_2d + + +!> Read a 3d vector tuple from file using infrastructure I/O. +subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & + timelevel, stagger, scalar_pair, scale) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: u_fieldname !< Field variable name in u + character(len=*), intent(in) :: v_fieldname !< Field variable name in v + real, dimension(:,:,:), intent(inout) :: u_data !< Field value in u + real, dimension(:,:,:), intent(inout) :: v_data !< Field value in v + type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition + integer, optional, intent(in) :: timelevel !< Time level to read in file + integer, optional, intent(in) :: stagger !< Grid staggering flag + logical, optional, intent(in) :: scalar_pair !< True if tuple is not a vector + real, optional, intent(in) :: scale !< Rescale factor + + integer :: turns ! Number of quarter-turns from input to model grid + real, allocatable :: u_data_in(:,:,:), v_data_in(:,:,:) ! [uv] on the input grid + + turns = MOM_Domain%turns + if (turns == 0) then + call read_vector(filename, u_fieldname, v_fieldname, & + u_data, v_data, MOM_domain, timelevel=timelevel, stagger=stagger, & + scalar_pair=scalar_pair, scale=scale & + ) + else + call allocate_rotated_array(u_data, [1,1,1], -turns, u_data_in) + call allocate_rotated_array(v_data, [1,1,1], -turns, v_data_in) + call read_vector(filename, u_fieldname, v_fieldname, & + u_data_in, v_data_in, MOM_domain%domain_in, timelevel=timelevel, & + stagger=stagger, scalar_pair=scalar_pair, scale=scale & + ) + if (scalar_pair) then + call rotate_array_pair(u_data_in, v_data_in, turns, u_data, v_data) + else + call rotate_vector(u_data_in, v_data_in, turns, u_data, v_data) + endif + deallocate(v_data_in) + deallocate(u_data_in) + endif +end subroutine MOM_read_vector_3d + + !> Write a 4d field to an output file, potentially with rotation subroutine MOM_write_field_4d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & fill_value, turns, scale) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 7dc0124930..cdb82cdf76 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1309,7 +1309,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, ! Set up the bottom depth, G%D either analytically or from file call MOM_initialize_topography(dG%bathyT, CS%Grid%max_depth, dG, param_file) call rescale_dyn_horgrid_bathymetry(dG, CS%US%Z_to_m) - call copy_dyngrid_to_MOM_grid(dG,CS%Grid,CS%US) + call copy_dyngrid_to_MOM_grid(dG, CS%Grid, CS%US) call destroy_dyn_horgrid(dG) ! endif G => CS%Grid ; CS%Grid_in => CS%Grid diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 1f8d45e88d..c95036a83e 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -89,9 +89,10 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: h_bdry_val => NULL() !< The ice thickness at inflowing boundaries [m]. real, pointer, dimension(:,:) :: t_bdry_val => NULL() !< The ice temperature at inflowing boundaries [degC]. - real, pointer, dimension(:,:) :: bed_elev => NULL() !< The bed elevation used for ice dynamics [Z ~> m]. - !! the same as bathyT, when below sea-level. - !!Sign convention: positive below sea-level, negative above. + real, pointer, dimension(:,:) :: bed_elev => NULL() !< The bed elevation used for ice dynamics [Z ~> m], + !! relative to mean sea-level. This is + !! the same as G%bathyT+Z_ref, when below sea-level. + !! Sign convention: positive below sea-level, negative above. real, pointer, dimension(:,:) :: basal_traction => NULL() !< The area integrated nonlinear part of "linearized" !! basal stress [R Z L2 T-1 ~> kg s-1]. @@ -266,7 +267,7 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) allocate( CS%ground_frac(isd:ied,jsd:jed) ) ; CS%ground_frac(:,:) = 0.0 allocate( CS%taudx_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%taudx_shelf(:,:) = 0.0 allocate( CS%taudy_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%taudy_shelf(:,:) = 0.0 - allocate( CS%bed_elev(isd:ied,jsd:jed) ) ; CS%bed_elev(:,:)=G%bathyT(:,:)!CS%bed_elev(:,:) = 0.0 + allocate( CS%bed_elev(isd:ied,jsd:jed) ) ; CS%bed_elev(:,:) = G%bathyT(:,:) + G%Z_ref allocate( CS%u_bdry_val(IsdB:IedB,JsdB:JedB) ) ; CS%u_bdry_val(:,:) = 0.0 allocate( CS%v_bdry_val(IsdB:IedB,JsdB:JedB) ) ; CS%v_bdry_val(:,:) = 0.0 allocate( CS%u_face_mask_bdry(IsdB:IedB,JsdB:JedB) ) ; CS%u_face_mask_bdry(:,:) = -2.0 @@ -277,24 +278,24 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) "ice sheet/shelf u-velocity", "m s-1", hor_grid='Bu') call register_restart_field(CS%v_shelf, "v_shelf", .false., restart_CS, & "ice sheet/shelf v-velocity", "m s-1", hor_grid='Bu') - call register_restart_field(CS%u_bdry_val, "u_bdry", .false., restart_CS, & + call register_restart_field(CS%u_bdry_val, "u_bdry_val", .false., restart_CS, & "ice sheet/shelf boundary u-velocity", "m s-1", hor_grid='Bu') - call register_restart_field(CS%v_bdry_val, "v_bdry", .false., restart_CS, & + call register_restart_field(CS%v_bdry_val, "v_bdry_val", .false., restart_CS, & "ice sheet/shelf boundary v-velocity", "m s-1", hor_grid='Bu') - call register_restart_field(CS%u_face_mask_bdry, "u_bdry_mask", .false., restart_CS, & + call register_restart_field(CS%u_face_mask_bdry, "u_face_mask_bdry", .false., restart_CS, & "ice sheet/shelf boundary u-mask", "nondim", hor_grid='Bu') - call register_restart_field(CS%v_face_mask_bdry, "v_bdry_mask", .false., restart_CS, & + call register_restart_field(CS%v_face_mask_bdry, "v_face_mask_bdry", .false., restart_CS, & "ice sheet/shelf boundary v-mask", "nondim", hor_grid='Bu') call register_restart_field(CS%OD_av, "OD_av", .true., restart_CS, & "Average open ocean depth in a cell","m") call register_restart_field(CS%ground_frac, "ground_frac", .true., restart_CS, & "fractional degree of grounding", "nondim") - call register_restart_field(CS%C_basal_friction, "tau_b_beta", .true., restart_CS, & + call register_restart_field(CS%C_basal_friction, "C_basal_friction", .true., restart_CS, & "basal sliding coefficients", "Pa (m s-1)^n_sliding") - call register_restart_field(CS%AGlen_visc, "A_Glen", .true., restart_CS, & + call register_restart_field(CS%AGlen_visc, "AGlen_visc", .true., restart_CS, & "ice-stiffness parameter", "Pa-3 s-1") - call register_restart_field(CS%h_bdry_val, "h_bdry", .false., restart_CS, & + call register_restart_field(CS%h_bdry_val, "h_bdry_val", .false., restart_CS, & "ice thickness at the boundary","m") endif @@ -503,6 +504,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call pass_var(CS%ground_frac,G%domain) call pass_var(CS%ice_visc,G%domain) call pass_var(CS%basal_traction, G%domain) + call pass_var(CS%AGlen_visc, G%domain) call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE) endif @@ -533,30 +535,31 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ endif ! initialize basal friction coefficients - call initialize_ice_C_basal_friction(CS%C_basal_friction, G, US, param_file) - call pass_var(CS%C_basal_friction, G%domain) + if (new_sim) then + call initialize_ice_C_basal_friction(CS%C_basal_friction, G, US, param_file) + call pass_var(CS%C_basal_friction, G%domain) - ! initialize ice-stiffness AGlen - call initialize_ice_AGlen(CS%AGlen_visc, G, US, param_file) - call pass_var(CS%AGlen_visc, G%domain) + ! initialize ice-stiffness AGlen + call initialize_ice_AGlen(CS%AGlen_visc, G, US, param_file) + call pass_var(CS%AGlen_visc, G%domain) - !initialize boundary conditions - call initialize_ice_shelf_boundary_from_file(CS%u_face_mask_bdry, CS%v_face_mask_bdry, & + !initialize boundary conditions + call initialize_ice_shelf_boundary_from_file(CS%u_face_mask_bdry, CS%v_face_mask_bdry, & CS%u_bdry_val, CS%v_bdry_val, CS%umask, CS%vmask, CS%h_bdry_val, & CS%thickness_bdry_val, ISS%hmask, ISS%h_shelf, G, US, param_file ) - call pass_var(ISS%hmask, G%domain) - call pass_var(CS%h_bdry_val, G%domain) - call pass_var(CS%thickness_bdry_val, G%domain) - call pass_vector(CS%u_bdry_val, CS%v_bdry_val, G%domain, TO_ALL, BGRID_NE) - call pass_vector(CS%u_face_mask_bdry, CS%v_face_mask_bdry, G%domain, TO_ALL, BGRID_NE) - - !initialize ice flow velocities from file - call initialize_ice_flow_from_file(CS%bed_elev,CS%u_shelf, CS%v_shelf,CS%ground_frac, ISS%hmask,ISS%h_shelf, & + call pass_var(ISS%hmask, G%domain) + call pass_var(CS%h_bdry_val, G%domain) + call pass_var(CS%thickness_bdry_val, G%domain) + call pass_vector(CS%u_bdry_val, CS%v_bdry_val, G%domain, TO_ALL, BGRID_NE) + call pass_vector(CS%u_face_mask_bdry, CS%v_face_mask_bdry, G%domain, TO_ALL, BGRID_NE) + + !initialize ice flow velocities from file + call initialize_ice_flow_from_file(CS%bed_elev,CS%u_shelf, CS%v_shelf,CS%ground_frac, ISS%hmask,ISS%h_shelf, & G, US, param_file) - call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE) - call pass_var(CS%bed_elev, G%domain,CENTER) - call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) - + call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE) + call pass_var(CS%bed_elev, G%domain,CENTER) + call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) + endif ! Register diagnostics. CS%id_u_shelf = register_diag_field('ice_shelf_model','u_shelf',CS%diag%axesB1, Time, & 'x-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) @@ -564,16 +567,15 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) ! I think that the conversion factors for the next two diagnostics are wrong. - RWH CS%id_taudx_shelf = register_diag_field('ice_shelf_model','taudx_shelf',CS%diag%axesB1, Time, & - 'x-driving stress of ice', 'kPa', conversion=1.e-9*US%L_T_to_m_s) + 'x-driving stress of ice', 'kPa', conversion=1.e-9*US%RL2_T2_to_Pa) CS%id_taudy_shelf = register_diag_field('ice_shelf_model','taudy_shelf',CS%diag%axesB1, Time, & - 'y-driving stress of ice', 'kPa', conversion=1.e-9*US%L_T_to_m_s) + 'y-driving stress of ice', 'kPa', conversion=1.e-9*US%RL2_T2_to_Pa) CS%id_u_mask = register_diag_field('ice_shelf_model','u_mask',CS%diag%axesB1, Time, & 'mask for u-nodes', 'none') CS%id_v_mask = register_diag_field('ice_shelf_model','v_mask',CS%diag%axesB1, Time, & 'mask for v-nodes', 'none') CS%id_ground_frac = register_diag_field('ice_shelf_model','ice_ground_frac',CS%diag%axesT1, Time, & 'fraction of cell that is grounded', 'none') -! CS%id_col_thick = register_diag_field('ice_shelf_model','col_thick',CS%diag%axesT1, Time, & 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_visc_shelf = register_diag_field('ice_shelf_model','ice_visc',CS%diag%axesT1, Time, & @@ -582,12 +584,10 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ 'taub', 'Pa yr m-1', conversion=1e-6*US%Z_to_m) CS%id_OD_av = register_diag_field('ice_shelf_model','OD_av',CS%diag%axesT1, Time, & 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) - if (new_sim) then - call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") - call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) - endif endif + call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") + call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) end subroutine initialize_ice_shelf_dyn @@ -611,7 +611,7 @@ subroutine initialize_diagnostic_fields(CS, ISS, G, US, Time) do j=jsd,jed do i=isd,ied - OD = G%bathyT(i,j) - rhoi_rhow * ISS%h_shelf(i,j) + OD = CS%bed_elev(i,j) - rhoi_rhow * ISS%h_shelf(i,j) if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating CS%OD_av(i,j) = OD @@ -683,46 +683,46 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled coupled_GL = .false. if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding ! - call ice_shelf_advect(CS, ISS, G, time_step, Time) - CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step - if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. - - if (coupled_GL) then - call update_OD_ffrac(CS, G, US, ocean_mass, update_ice_vel) - elseif (update_ice_vel) then - call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) - endif + call ice_shelf_advect(CS, ISS, G, time_step, Time) + CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step + if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. + if (coupled_GL) then + call update_OD_ffrac(CS, G, US, ocean_mass, update_ice_vel) + elseif (update_ice_vel) then + call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) + endif - if (update_ice_vel) then - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) - endif + + if (update_ice_vel) then + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) + endif ! call ice_shelf_temp(CS, ISS, G, US, time_step, ISS%water_flux, Time) - if (update_ice_vel) then - call enable_averages(CS%elapsed_velocity_time, Time, CS%diag) - if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%OD_av, CS%diag) - if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) - if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf, CS%diag) + if (update_ice_vel) then + call enable_averages(CS%elapsed_velocity_time, Time, CS%diag) + if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%OD_av, CS%diag) + if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) + if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf, CS%diag) ! if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,CS%t_shelf,CS%diag) - if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf, CS%diag) - if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf, CS%diag) - if (CS%id_ground_frac > 0) call post_data(CS%id_ground_frac, CS%ground_frac,CS%diag) - if (CS%id_OD_av >0) call post_data(CS%id_OD_av, CS%OD_av,CS%diag) - if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) - if (CS%id_taub > 0) call post_data(CS%id_taub, CS%basal_traction,CS%diag) + if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf, CS%diag) + if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf, CS%diag) + if (CS%id_ground_frac > 0) call post_data(CS%id_ground_frac, CS%ground_frac,CS%diag) + if (CS%id_OD_av >0) call post_data(CS%id_OD_av, CS%OD_av,CS%diag) + if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) + if (CS%id_taub > 0) call post_data(CS%id_taub, CS%basal_traction,CS%diag) !! - if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) - if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) - if (CS%id_ufb_mask > 0) call post_data(CS%id_ufb_mask,CS%u_face_mask_bdry,CS%diag) - if (CS%id_vfb_mask > 0) call post_data(CS%id_vfb_mask,CS%v_face_mask_bdry,CS%diag) + if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) + if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) + if (CS%id_ufb_mask > 0) call post_data(CS%id_ufb_mask,CS%u_face_mask_bdry,CS%diag) + if (CS%id_vfb_mask > 0) call post_data(CS%id_vfb_mask,CS%v_face_mask_bdry,CS%diag) ! if (CS%id_t_mask > 0) call post_data(CS%id_t_mask,CS%tmask,CS%diag) - call disable_averaging(CS%diag) + call disable_averaging(CS%diag) - CS%elapsed_velocity_time = 0.0 - endif + CS%elapsed_velocity_time = 0.0 + endif end subroutine update_ice_shelf @@ -816,7 +816,7 @@ end subroutine ice_shelf_advect !>This subroutine computes u- and v-velocities of the ice shelf iterating on non-linear ice viscosity !subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) - subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, iters, Time) + subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, iters, Time) type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state @@ -869,13 +869,13 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite CS%ground_frac(:,:) = 0.0 allocate(Phisub(nsub,nsub,2,2,2,2)) ; Phisub(:,:,:,:,:,:) = 0.0 - do j=G%jsc,G%jec - do i=G%isc,G%iec - if (rhoi_rhow * ISS%h_shelf(i,j) - G%bathyT(i,j) > 0) then - float_cond(i,j) = 1.0 - CS%ground_frac(i,j) = 1.0 - endif - enddo + do j=G%jsc,G%jec + do i=G%isc,G%iec + if (rhoi_rhow * ISS%h_shelf(i,j) - CS%bed_elev(i,j) > 0) then + float_cond(i,j) = 1.0 + CS%ground_frac(i,j) = 1.0 + endif + enddo enddo call calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, CS%OD_av) @@ -896,7 +896,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite do l=0,1 ; do k=0,1 if ((ISS%hmask(i,j) == 1) .and. & - (rhoi_rhow * H_node(i-1+k,j-1+l) - G%bathyT(i,j) <= 0)) then + (rhoi_rhow * H_node(i-1+k,j-1+l) - CS%bed_elev(i,j) <= 0)) then nodefloat = nodefloat + 1 endif enddo ; enddo @@ -936,7 +936,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite Au(:,:) = 0.0 ; Av(:,:) = 0.0 call CG_action(Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT, CS%basal_traction, & + CS%ice_visc, float_cond, CS%bed_elev, CS%basal_traction, & G, US, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) call pass_vector(Au,Av,G%domain,TO_ALL,BGRID_NE) @@ -992,7 +992,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite Au(:,:) = 0 ; Av(:,:) = 0 call CG_action(Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT, CS%basal_traction, & + CS%ice_visc, float_cond, CS%bed_elev, CS%basal_traction, & G, US, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) err_max = 0 @@ -1043,16 +1043,15 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite call MOM_mesg(mesg, 5) if (err_max <= CS%nonlinear_tolerance * err_init) then - write(mesg,*) "ice_shelf_solve_outer: nonlinear fractional residual = ", err_max/err_init - call MOM_mesg(mesg) - write(mesg,*) "ice_shelf_solve_outer: exiting nonlinear solve after ",iter," iterations" -! call MOM_mesg(mesg, 5) - call MOM_mesg(mesg) exit endif enddo + write(mesg,*) "ice_shelf_solve_outer: nonlinear fractional residual = ", err_max/err_init + call MOM_mesg(mesg) + write(mesg,*) "ice_shelf_solve_outer: exiting nonlinear solve after ",iter," iterations" + call MOM_mesg(mesg) deallocate(Phi) deallocate(Phisub) @@ -1086,6 +1085,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H !! iterations have converged to the specified tolerance integer, intent(out) :: iters !< The number of iterations used in the solver. type(time_type), intent(in) :: Time !< The current model time + character(len=160) :: mesg ! The text of an error message real, dimension(8,4,SZDI_(G),SZDJ_(G)), & intent(in) :: Phi !< The gradients of bilinear basis elements at Gaussian !! quadrature points surrounding the cell vertices [L-1 ~> m-1]. @@ -1162,7 +1162,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H call pass_vector(DIAGu, DIAGv, G%domain, TO_ALL, BGRID_NE) call CG_action(Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, hmask, & - H_node, CS%ice_visc, float_cond, G%bathyT, CS%basal_traction, & + H_node, CS%ice_visc, float_cond, CS%bed_elev, CS%basal_traction, & G, US, isc-1, iec+1, jsc-1, jec+1, rhoi_rhow) call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE) @@ -1216,7 +1216,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H Au(:,:) = 0 ; Av(:,:) = 0 call CG_action(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, & - H_node, CS%ice_visc, float_cond, G%bathyT, CS%basal_traction, & + H_node, CS%ice_visc, float_cond, CS%bed_elev, CS%basal_traction, & G, US, is, ie, js, je, rhoi_rhow) ! Au, Av valid region moves in by 1 @@ -1820,21 +1820,16 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! prelim - go through and calculate S ! or is this faster? - !BASE(:,:) = -G%bathyT(:,:) + OD(:,:) BASE(:,:) = -CS%bed_elev(:,:) + OD(:,:) S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) ! check whether the ice is floating or grounded do j=jsc-G%domain%njhalo,jec+G%domain%njhalo - do i=isc-G%domain%nihalo,iec+G%domain%nihalo - -! if (ISS%h_shelf(i,j) < rhow/rho * G%bathyT(i,j)) then - if (rhoi_rhow * ISS%h_shelf(i,j) - G%bathyT(i,j) <= 0) then - S(i,j)=(1 - rhoi_rhow)*ISS%h_shelf(i,j) - endif - - - enddo + do i=isc-G%domain%nihalo,iec+G%domain%nihalo + if (rhoi_rhow * ISS%h_shelf(i,j) - CS%bed_elev(i,j) <= 0) then + S(i,j) = (1 - rhoi_rhow)*ISS%h_shelf(i,j) + endif + enddo enddo do j=jsc-1,jec+1 do i=isc-1,iec+1 @@ -1935,7 +1930,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) endif if (CS%ground_frac(i,j) == 1) then -! neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * G%bathyT(i,j)**2) +! neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * CS%bed_elev(i,j)**2) neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 else neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 @@ -2086,8 +2081,9 @@ subroutine CG_action(uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmas intent(in) :: float_cond !< An array indicating where the ice !! shelf is floating: 0 if floating, 1 if not. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points [Z ~> m]. - real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points + !! relative to sea-level [Z ~> m]. + real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: basal_trac !< A field related to the nonlinear part of the !! "linearized" basal stress [R Z T-1 ~> kg m-2 s-1]. @@ -2206,7 +2202,8 @@ subroutine CG_action_subgrid_basal(Phisub, H, U, V, bathyT, dens_ratio, Ucontr, real, dimension(2,2), intent(in) :: H !< The ice shelf thickness at nodal (corner) points [Z ~> m]. real, dimension(2,2), intent(in) :: U !< The zonal ice shelf velocity at vertices [L T-1 ~> m s-1] real, dimension(2,2), intent(in) :: V !< The meridional ice shelf velocity at vertices [L T-1 ~> m s-1] - real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points [Z ~> m]. + real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points + !! relative to sea-level [Z ~> m]. real, intent(in) :: dens_ratio !< The density of ice divided by the density !! of seawater [nondim] real, dimension(2,2), intent(out) :: Ucontr !< The areal average of u-velocities where the ice shelf @@ -2338,7 +2335,7 @@ subroutine matrix_diagonal(CS, G, US, float_cond, H_node, ice_visc, basal_trac, if (float_cond(i,j) == 1) then Hcell(:,:) = H_node(i-1:i,j-1:j) - call CG_diagonal_subgrid_basal(Phisub, Hcell, G%bathyT(i,j), dens_ratio, sub_ground) + call CG_diagonal_subgrid_basal(Phisub, Hcell, CS%bed_elev(i,j), dens_ratio, sub_ground) do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi if (CS%umask(Itgt,Jtgt) == 1) then u_diagonal(Itgt,Jtgt) = u_diagonal(Itgt,Jtgt) + sub_ground(iphi,jphi) * basal_trac(i,j) @@ -2512,7 +2509,7 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, if (float_cond(i,j) == 1) then Ucell(:,:) = CS%u_bdry_val(i-1:i,j-1:j) ; Vcell(:,:) = CS%v_bdry_val(i-1:i,j-1:j) Hcell(:,:) = H_node(i-1:i,j-1:j) - call CG_action_subgrid_basal(Phisub, Hcell, Ucell, Vcell, G%bathyT(i,j), & + call CG_action_subgrid_basal(Phisub, Hcell, Ucell, Vcell, CS%bed_elev(i,j), & dens_ratio, Usubcontr, Vsubcontr) if (CS%umask(I-1,J-1)==1) u_bdry_contr(I-1,J-1) = u_bdry_contr(I-1,J-1) + Usubcontr(1,1) * basal_trac(i,j) @@ -2586,7 +2583,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) (u_shlf(I,J-1) + (u_shlf(I-1,J-1) + u_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) vy = ((v_shlf(I,J) + (v_shlf(I-1,J)+ v_shlf(I+1,J))) - & (v_shlf(I,J-1) + (v_shlf(I-1,J-1)+ v_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) -! CS%ice_visc(i,j) =1e14*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging +! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) endif @@ -2693,7 +2690,7 @@ subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) do j=jsd,jed do i=isd,ied - OD = G%bathyT(i,j) - rhoi_rhow * h_shelf(i,j) + OD = CS%bed_elev(i,j) - rhoi_rhow * h_shelf(i,j) if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating CS%OD_av(i,j) = OD @@ -2938,7 +2935,7 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face do j=js,G%jed do i=is,G%ied - if (hmask(i,j) == 1) then + if ((hmask(i,j) == 1) .OR. (hmask(i,j) == 3)) then umask(I,j) = 1. vmask(I,j) = 1. @@ -2947,10 +2944,10 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face select case (int(CS%u_face_mask_bdry(I-1+k,j))) case (3) - ! vmask(I-1+k,J-1)=0. + vmask(I-1+k,J-1)=3. u_face_mask(I-1+k,j)=3. umask(I-1+k,J)=3. - !vmask(I-1+k,J)=0. + vmask(I-1+k,J)=3. vmask(I-1+k,J)=3. case (2) u_face_mask(I-1+k,j)=2. @@ -2973,9 +2970,9 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face select case (int(CS%v_face_mask_bdry(i,J-1+k))) case (3) vmask(I-1,J-1+k)=3. - umask(I-1,J-1+k)=0. + umask(I-1,J-1+k)=3. vmask(I,J-1+k)=3. - umask(I,J-1+k)=0. + umask(I,J-1+k)=3. v_face_mask(i,J-1+k)=3. case (2) v_face_mask(i,J-1+k)=2. diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index f3a5f210fc..73db36596e 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -101,7 +101,7 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U ! This subroutine reads ice thickness and area from a file and puts it into ! h_shelf [Z ~> m] and area_shelf_h [L2 ~> m2] (and dimensionless) and updates hmask character(len=200) :: filename,thickness_file,inputdir ! Strings for file/path - character(len=200) :: thickness_varname, area_varname ! Variable name in file + character(len=200) :: thickness_varname, area_varname, hmask_varname ! Variable name in file character(len=40) :: mdl = "initialize_ice_thickness_from_file" ! This subroutine's name. integer :: i, j, isc, jsc, iec, jec real :: len_sidestress, mask, udh @@ -125,45 +125,46 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U call get_param(PF, mdl, "ICE_AREA_VARNAME", area_varname, & "The name of the area variable in ICE_THICKNESS_FILE.", & default="area_shelf_h") - + hmask_varname="h_mask" if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_topography_from_file: Unable to open "//trim(filename)) call MOM_read_data(filename, trim(thickness_varname), h_shelf, G%Domain, scale=US%m_to_Z) call MOM_read_data(filename,trim(area_varname), area_shelf_h, G%Domain, scale=US%m_to_L**2) - + call MOM_read_data(filename, trim(hmask_varname), hmask, G%Domain) isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - do j=jsc,jec - do i=isc,iec + if (len_sidestress > 0.) then + do j=jsc,jec + do i=isc,iec ! taper ice shelf in area where there is no sidestress - ! but do not interfere with hmask - if ((G%geoLonCv(i,j) > len_sidestress).and. & - (len_sidestress > 0.)) then - udh = exp(-(G%geoLonCv(i,j)-len_sidestress)/5.0) * h_shelf(i,j) - if (udh <= 25.0) then - h_shelf(i,j) = 0.0 - area_shelf_h(i,j) = 0.0 - else + if (G%geoLonCv(i,j) > len_sidestress) then + udh = exp(-(G%geoLonCv(i,j)-len_sidestress)/5.0) * h_shelf(i,j) + if (udh <= 25.0) then + h_shelf(i,j) = 0.0 + area_shelf_h(i,j) = 0.0 + else h_shelf(i,j) = udh + endif endif - endif ! update thickness mask - if (area_shelf_h (i,j) >= G%areaT(i,j)) then - hmask(i,j) = 1. - elseif (area_shelf_h (i,j) == 0.0) then - hmask(i,j) = 0. - elseif ((area_shelf_h(i,j) > 0) .and. (area_shelf_h(i,j) <= G%areaT(i,j))) then - hmask(i,j) = 2. - else - call MOM_error(FATAL,mdl// " AREA IN CELL OUT OF RANGE") - endif + if (area_shelf_h (i,j) >= G%areaT(i,j)) then + hmask(i,j) = 1. + area_shelf_h(i,j)=G%areaT(i,j) + elseif (area_shelf_h (i,j) == 0.0) then + hmask(i,j) = 0. + elseif ((area_shelf_h(i,j) > 0) .and. (area_shelf_h(i,j) <= G%areaT(i,j))) then + hmask(i,j) = 2. + else + call MOM_error(FATAL,mdl// " AREA IN CELL OUT OF RANGE") + endif + enddo enddo - enddo - + endif end subroutine initialize_ice_thickness_from_file !> Initialize ice shelf thickness for a channel configuration diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 55d7acaff2..b2ac8f0e35 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -333,7 +333,8 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) start(2) = 2 ; nread(1) = ni+1 ; nread(2) = 2 allocate( tmpGlbl(ni+1,2) ) if (is_root_PE()) & - call MOM_read_data(filename, "x", tmpGlbl, start, nread, no_domain=.TRUE.) + call MOM_read_data(filename, "x", tmpGlbl, start, nread, & + no_domain=.TRUE., turns=G%HI%turns) call broadcast(tmpGlbl, 2*(ni+1), root_PE()) ! I don't know why the second axis is 1 or 2 here. -RWH @@ -351,7 +352,8 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) start(:) = 1 ; nread(:) = 1 start(1) = int(ni/4)+1 ; nread(2) = nj+1 if (is_root_PE()) & - call MOM_read_data(filename, "y", tmpGlbl, start, nread, no_domain=.TRUE.) + call MOM_read_data(filename, "y", tmpGlbl, start, nread, & + no_domain=.TRUE., turns=G%HI%turns) call broadcast(tmpGlbl, nj+1, root_PE()) do j=G%jsg,G%jeg diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 1907a75c74..56a15c4091 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -232,7 +232,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! geopotential height, for use by the various initialization routines. G%bathyT has ! already been initialized in previous calls. do j=jsd,jed ; do i=isd,ied - depth_tot(i,j) = G%bathyT(i,j) + depth_tot(i,j) = G%bathyT(i,j) + G%Z_ref enddo ; enddo ! The remaining initialization calls are done, regardless of whether the @@ -706,7 +706,7 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain, scale=US%m_to_Z) if (correct_thickness) then - call adjustEtaToFitBathymetry(G, GV, US, eta, h, dZ_ref_eta=0.0) + call adjustEtaToFitBathymetry(G, GV, US, eta, h, dZ_ref_eta=G%Z_ref) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then @@ -1086,7 +1086,7 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) ! Convert thicknesses to interface heights. - call find_eta(h, tv, G, GV, US, eta) + call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then ! if (eta_sfc(i,j) < eta(i,j,nz+1)) then @@ -1199,7 +1199,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) endif do j=G%jsc,G%jec ; do i=G%isc,G%iec - call cut_off_column_top(GV%ke, tv, GV, US, GV%g_Earth, G%bathyT(i,j), & + call cut_off_column_top(GV%ke, tv, GV, US, GV%g_Earth, G%bathyT(i,j)+G%Z_ref, & min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS, & z_tol=1.0e-5*US%m_to_Z, remap_answers_2018=remap_answers_2018) @@ -2658,7 +2658,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just Hmix_depth, eps_z, eps_rho, density_extrap_bug) if (correct_thickness) then - call adjustEtaToFitBathymetry(G, GV, US, zi, h, dZ_ref_eta=0.0) + call adjustEtaToFitBathymetry(G, GV, US, zi, h, dZ_ref_eta=G%Z_ref) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_Z)) then @@ -2824,23 +2824,35 @@ subroutine find_interfaces(rho, zin, nk_data, Rb, Z_bot, zi, G, GV, US, nlevs, n ! Find and store the interface depths. zi_(1) = 0.0 - do K=2,nz - ! Find the value of k_int in the list of rho_ where rho_(k_int) <= Rb(K) < rho_(k_int+1). - ! This might be made a little faster by exploiting the fact that Rb is - ! monotonically increasing and not resetting lo_int back to 1 inside the K loop. - lo_int = 1 ; hi_int = nlevs_data - do while (lo_int < hi_int) - mid = (lo_int+hi_int) / 2 - if (Rb(K) < rho_(mid)) then ; hi_int = mid - else ; lo_int = mid+1 ; endif + if (nlevs_data < 1) then + ! There is no data to use, so set the interfaces at the bottom. + do K=2,nz ; zi_(K) = Z_bot(i,j) ; enddo + elseif (nlevs_data == 1) then + ! There is data for only one input layer, so set the interfaces at the bottom or top, + ! depending on how their target densities compare with the one data point. + do K=2,nz + if (Rb(K) < rho_(1)) then ; zi_(K) = 0.0 + else ; zi_(K) = Z_bot(i,j) ; endif enddo - k_int = max(1, lo_int-1) + else + do K=2,nz + ! Find the value of k_int in the list of rho_ where rho_(k_int) <= Rb(K) < rho_(k_int+1). + ! This might be made a little faster by exploiting the fact that Rb is + ! monotonically increasing and not resetting lo_int back to 1 inside the K loop. + lo_int = 1 ; hi_int = nlevs_data + do while (lo_int < hi_int) + mid = (lo_int+hi_int) / 2 + if (Rb(K) < rho_(mid)) then ; hi_int = mid + else ; lo_int = mid+1 ; endif + enddo + k_int = max(1, lo_int-1) - ! Linearly interpolate to find the depth, zi_, where Rb would be found. - slope = (zin(k_int+1) - zin(k_int)) / max(rho_(k_int+1) - rho_(k_int), eps_rho) - zi_(K) = -1.0*(zin(k_int) + slope*(Rb(K)-rho_(k_int))) - zi_(K) = min(max(zi_(K), Z_bot(i,j)), -1.0*hml) - enddo + ! Linearly interpolate to find the depth, zi_, where Rb would be found. + slope = (zin(k_int+1) - zin(k_int)) / max(rho_(k_int+1) - rho_(k_int), eps_rho) + zi_(K) = -1.0*(zin(k_int) + slope*(Rb(K)-rho_(k_int))) + zi_(K) = min(max(zi_(K), Z_bot(i,j)), -1.0*hml) + enddo + endif zi_(nz+1) = Z_bot(i,j) if (nkml > 0) then ; do K=2,nkml+1 zi_(K) = max(hml*((1.0-real(K))/real(nkml)), Z_bot(i,j)) diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 48b67bf295..8a67d71fe2 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -152,7 +152,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ if (G%mask2dT(i,j)>0.) then ! Build the source grid zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0 - z_bathy = G%bathyT(i,j) + z_bathy = G%bathyT(i,j) + G%Z_ref do k = 1, kd if (mask_z(i,j,k) > 0.) then zBottomOfCell = -min( z_edges_in(k+1), z_bathy ) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 8057234cdc..dd9c46ff90 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -9,23 +9,32 @@ module MOM_oda_driver_mod use MOM_domains, only : domain2d, global_field, get_domain_extent use MOM_domains, only : pass_var, redistribute_array, broadcast_domain use MOM_diag_mediator, only : register_diag_field, diag_axis_init, post_data +use MOM_diag_mediator, only : enable_averaging, disable_averaging +use MOM_diag_mediator, only : diag_update_remap_grids use MOM_ensemble_manager, only : get_ensemble_id, get_ensemble_size use MOM_ensemble_manager, only : get_ensemble_pelist, get_ensemble_filter_pelist use MOM_error_handler, only : stdout, stdlog, MOM_error use MOM_io, only : SINGLE_FILE +use MOM_interp_infra, only : init_extern_field, get_external_field_info +use MOM_interp_infra, only : time_interp_extern use MOM_time_manager, only : time_type, real_to_time, get_date use MOM_time_manager, only : operator(+), operator(>=), operator(/=) use MOM_time_manager, only : operator(==), operator(<) - +use MOM_cpu_clock, only : cpu_clock_begin, cpu_clock_end, cpu_clock_id +use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer ! ODA Modules use ocean_da_types_mod, only : grid_type, ocean_profile_type, ocean_control_struct use ocean_da_core_mod, only : ocean_da_core_init, get_profiles +!This preprocessing directive enables the SPEAR online ensemble data assimilation +!configuration. Existing community based APIs for data assimilation are currently +!called offline for forecast applications using information read from a MOM6 state file. +!The SPEAR configuration (https://doi.org/10.1029/2020MS002149) calculated increments +!efficiently online. A community-based set of APIs should be implemented in place +!of the CPP directive when this is available. #ifdef ENABLE_ECDA use eakf_oda_mod, only : ensemble_filter #endif -use write_ocean_obs_mod, only : open_profile_file -use write_ocean_obs_mod, only : write_profile,close_profile_file -use kdtree, only : kd_root !# JEDI +use kdtree, only : kd_root !# A kd-tree object using JEDI APIs ! MOM Modules use MOM_io, only : slasher, MOM_read_data use MOM_diag_mediator, only : diag_ctrl, set_axes_info @@ -52,7 +61,16 @@ module MOM_oda_driver_mod implicit none ; private public :: init_oda, oda_end, set_prior_tracer, get_posterior_tracer -public :: set_analysis_time, oda, save_obs_diff, apply_oda_tracer_increments +public :: set_analysis_time, oda, apply_oda_tracer_increments + +!>@{ CPU time clock ID +integer :: id_clock_oda_init +integer :: id_clock_oda_filter +integer :: id_clock_bias_adjustment +integer :: id_clock_apply_increments +integer :: id_clock_oda_prior +integer :: id_clock_oda_posterior +!>@} #include @@ -61,13 +79,23 @@ module MOM_oda_driver_mod type(domain2d), pointer :: mpp_domain => NULL() !< pointer to a domain2d end type ptr_mpp_domain +!> A structure containing integer handles for bias adjustment of tracers +type :: INC_CS + integer :: fldno = 0 !< The number of tracers + integer :: T_id !< The integer handle for the temperature file + integer :: S_id !< The integer handle for the salinity file +end type INC_CS + !> Control structure that contains a transpose of the ocean state across ensemble members. type, public :: ODA_CS ; private type(ocean_control_struct), pointer :: Ocean_prior=> NULL() !< ensemble ocean prior states in DA space type(ocean_control_struct), pointer :: Ocean_posterior=> NULL() !< ensemble ocean posterior states !! or increments to prior in DA space + type(ocean_control_struct), pointer :: Ocean_increment=> NULL() !< A separate structure for + !! increment diagnostics integer :: nk !< number of vertical layers used for DA type(ocean_grid_type), pointer :: Grid => NULL() !< MOM6 grid type and decomposition for the DA + type(ocean_grid_type), pointer :: G => NULL() !< MOM6 grid type and decomposition for the model type(MOM_domain_type), pointer, dimension(:) :: domains => NULL() !< Pointer to mpp_domain objects !! for ensemble members type(verticalGrid_type), pointer :: GV => NULL() !< vertical grid for DA @@ -78,12 +106,17 @@ module MOM_oda_driver_mod type(grid_type), pointer :: oda_grid !< local tracer grid real, pointer, dimension(:,:,:) :: h => NULL() ! m or kg m-2] for DA type(thermo_var_ptrs), pointer :: tv => NULL() !< pointer to thermodynamic variables + type(thermo_var_ptrs), pointer :: tv_bc => NULL() !< pointer to thermodynamic bias correction integer :: ni !< global i-direction grid size integer :: nj !< global j-direction grid size logical :: reentrant_x !< grid is reentrant in the x direction logical :: reentrant_y !< grid is reentrant in the y direction logical :: tripolar_N !< grid is folded at its north edge logical :: symmetric !< Values at C-grid locations are symmetric + logical :: use_basin_mask !< If true, use a basin file to delineate weakly coupled ocean basins + logical :: do_bias_adjustment !< If true, use spatio-temporally varying climatological tendency + !! adjustment for Temperature and Salinity + real :: bias_adjustment_multiplier !< A scaling for the bias adjustment integer :: assim_method !< Method: NO_ASSIM,EAKF_ASSIM or OI_ASSIM integer :: ensemble_size !< Size of the ensemble integer :: ensemble_id = 0 !< id of the current ensemble member @@ -99,7 +132,10 @@ module MOM_oda_driver_mod type(regridding_CS) :: regridCS !< ALE control structure for regridding type(remapping_CS) :: remapCS !< ALE control structure for remapping type(time_type) :: Time !< Current Analysis time - type(diag_ctrl) :: diag_cs ! NULL() ! initialize First_guess (prior) and Analysis grid !! information for all ensemble members -subroutine init_oda(Time, G, GV, CS) +subroutine init_oda(Time, G, GV, diag_CS, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(diag_ctrl), target, intent(inout) :: diag_CS !< A pointer to a diagnostic control structure type(ODA_CS), pointer, intent(inout) :: CS !< The DA control structure ! Local variables @@ -133,6 +170,7 @@ subroutine init_oda(Time, G, GV, CS) integer :: isg,ieg,jsg,jeg integer :: idg_offset, jdg_offset integer :: stdout_unit + integer, dimension(4) :: fld_sz character(len=32) :: assim_method integer :: npes_pm, ens_info(6), ni, nj character(len=128) :: mesg @@ -140,14 +178,21 @@ subroutine init_oda(Time, G, GV, CS) character(len=30) :: coord_mode character(len=200) :: inputdir, basin_file logical :: reentrant_x, reentrant_y, tripolar_N, symmetric + character(len=80) :: bias_correction_file, inc_file if (associated(CS)) call MOM_error(FATAL, 'Calling oda_init with associated control structure') allocate(CS) + + id_clock_oda_init=cpu_clock_id('(ODA initialization)') + id_clock_oda_prior=cpu_clock_id('(ODA setting prior)') + id_clock_oda_filter=cpu_clock_id('(ODA filter computation)') + id_clock_oda_posterior=cpu_clock_id('(ODA getting posterior)') + call cpu_clock_begin(id_clock_oda_init) + ! Use ens1 parameters , this could be changed at a later time ! if it were desirable to have alternate parameters, e.g. for the grid ! for the analysis call get_MOM_input(PF,dirs,ensemble_num=0) - call unit_scaling_init(PF, CS%US) call get_param(PF, "MOM", "ASSIM_METHOD", assim_method, & @@ -167,6 +212,20 @@ subroutine init_oda(Time, G, GV, CS) "Use tripolar connectivity at the northern edge of the "//& "domain. With TRIPOLAR_N, NIGLOBAL must be even.", & default=.false.) + call get_param(PF,"MOM", "APPLY_TRACER_TENDENCY_ADJUSTMENT", CS%do_bias_adjustment, & + "If true, add a spatio-temporally varying climatological adjustment "//& + "to temperature and salinity.", & + default=.false.) + if (CS%do_bias_adjustment) then + call get_param(PF,"MOM", "TRACER_ADJUSTMENT_FACTOR", CS%bias_adjustment_multiplier, & + "A multiplicative scaling factor for the climatological tracer tendency adjustment ", & + default=1.0) + endif + call get_param(PF,"MOM", "USE_BASIN_MASK", CS%use_basin_mask, & + "If true, add a basin mask to delineate weakly connected "//& + "ocean basins for the purpose of data assimilation.", & + default=.false.) + call get_param(PF,"MOM", "NIGLOBAL", CS%ni, & "The total number of thickness grid points in the "//& "x-direction in the physical domain.") @@ -200,19 +259,19 @@ subroutine init_oda(Time, G, GV, CS) call set_PElist(CS%filter_pelist) allocate(CS%domains(CS%ensemble_size)) - CS%domains(CS%ensemble_id)%mpp_domain => G%Domain%mpp_domain + CS%domains(CS%ensemble_id)%mpp_domain => G%Domain%mpp_domain ! this should go away do n=1,CS%ensemble_size if (.not. associated(CS%domains(n)%mpp_domain)) allocate(CS%domains(n)%mpp_domain) - call set_rootPE(CS%ensemble_pelist(n,1)) + call set_rootPE(CS%ensemble_pelist(n,1)) ! this line is not in Feiyu's version (needed?) call broadcast_domain(CS%domains(n)%mpp_domain) enddo - call set_rootPE(CS%filter_pelist(1)) + call set_rootPE(CS%filter_pelist(1)) ! this line is not in Feiyu's version (needed?) + CS%G => G allocate(CS%Grid) ! params NIHALO_ODA, NJHALO_ODA set the DA halo size call MOM_domains_init(CS%Grid%Domain,PF,param_suffix='_ODA') allocate(HI) - call hor_index_init(CS%Grid%Domain, HI, PF, & - local_indexing=.false.) ! Use global indexing for DA + call hor_index_init(CS%Grid%Domain, HI, PF) call verticalGridInit( PF, CS%GV, CS%US ) allocate(dG) call create_dyn_horgrid(dG, HI) @@ -222,7 +281,7 @@ subroutine init_oda(Time, G, GV, CS) call MOM_initialize_coord(CS%GV, CS%US, PF, .false., & dirs%output_directory, tv_dummy, dG%max_depth) call ALE_init(PF, CS%GV, CS%US, dG%max_depth, CS%ALE_CS) - call MOM_grid_init(CS%Grid, PF, global_indexing=.true.) + call MOM_grid_init(CS%Grid, PF) call ALE_updateVerticalGridType(CS%ALE_CS, CS%GV) call copy_dyngrid_to_MOM_grid(dG, CS%Grid, CS%US) CS%mpp_domain => CS%Grid%Domain%mpp_domain @@ -233,7 +292,9 @@ subroutine init_oda(Time, G, GV, CS) call init_ocean_ensemble(CS%Ocean_prior,CS%Grid,CS%GV,CS%ensemble_size) allocate(CS%Ocean_posterior) call init_ocean_ensemble(CS%Ocean_posterior,CS%Grid,CS%GV,CS%ensemble_size) - allocate(CS%tv) + allocate(CS%Ocean_increment) + call init_ocean_ensemble(CS%Ocean_increment,CS%Grid,CS%GV,CS%ensemble_size) + call get_param(PF, 'oda_driver', "REGRIDDING_COORDINATE_MODE", coord_mode, & "Coordinate mode for vertical regridding.", & @@ -241,76 +302,80 @@ subroutine init_oda(Time, G, GV, CS) call initialize_regridding(CS%regridCS, CS%GV, CS%US, dG%max_depth,PF,'oda_driver',coord_mode,'','') call initialize_remapping(CS%remapCS,'PLM') call set_regrid_params(CS%regridCS, min_thickness=0.) + isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed + ! breaking with the MOM6 convention and using global indices - call get_domain_extent(G%Domain,is,ie,js,je,isd,ied,jsd,jed,& - isg,ieg,jsg,jeg,idg_offset,jdg_offset,symmetric) - isd=isd+idg_offset; ied=ied+idg_offset - jsd=jsd+jdg_offset; jed=jed+jdg_offset - !call mpp_get_data_domain(G%Domain%mpp_domain,isd,ied,jsd,jed) + !call get_domain_extent(G%Domain,is,ie,js,je,isd,ied,jsd,jed,& + ! isg,ieg,jsg,jeg,idg_offset,jdg_offset,symmetric) + !isd=isd+idg_offset; ied=ied+idg_offset ! using global indexing within the DA module + !jsd=jsd+jdg_offset; jed=jed+jdg_offset ! TODO: switch to local indexing? (mjh) + if (.not. associated(CS%h)) then - allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke)); CS%h(:,:,:)=0.0 + allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke)); CS%h(:,:,:)=CS%GV%Angstrom_m*CS%GV%H_to_m ! assign thicknesses call ALE_initThicknessToCoord(CS%ALE_CS,G,CS%GV,CS%h) endif + allocate(CS%tv) allocate(CS%tv%T(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%T(:,:,:)=0.0 allocate(CS%tv%S(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%S(:,:,:)=0.0 - call set_axes_info(CS%Grid, CS%GV, CS%US, PF, CS%diag_cs, set_vertical=.true.) - ! get domain extents for the analysis grid and use global indexing - !call get_domain_extent(CS%Grid%Domain,is,ie,js,je,isd,ied,jsd,jed,& - ! isg,ieg,jsg,jeg,idg_offset,jdg_offset,symmetric) - !isd=isd+idg_offset; ied=ied+idg_offset - !jsd=jsd+jdg_offset; jed=jed+jdg_offset - !call mpp_get_data_domain(CS%mpp_domain,isd,ied,jsd,jed) +! call set_axes_info(CS%Grid, CS%GV, CS%US, PF, CS%diag_cs, set_vertical=.true.) ! missing in Feiyu's fork allocate(CS%oda_grid) CS%oda_grid%x => CS%Grid%geolonT CS%oda_grid%y => CS%Grid%geolatT - call get_param(PF, 'oda_driver', "BASIN_FILE", basin_file, & + + if (CS%use_basin_mask) then + call get_param(PF, 'oda_driver', "BASIN_FILE", basin_file, & "A file in which to find the basin masks, in variable 'basin'.", & default="basin.nc") - basin_file = trim(inputdir) // trim(basin_file) - allocate(CS%oda_grid%basin_mask(isd:ied,jsd:jed)) - CS%oda_grid%basin_mask(:,:) = 0.0 - call MOM_read_data(basin_file,'basin',CS%oda_grid%basin_mask,CS%Grid%domain, timelevel=1) - -! get global grid information from ocean_model - allocate(T_grid) - allocate(T_grid%x(CS%ni,CS%nj)) - allocate(T_grid%y(CS%ni,CS%nj)) - allocate(T_grid%basin_mask(CS%ni,CS%nj)) - call global_field(CS%mpp_domain, CS%Grid%geolonT, T_grid%x) - call global_field(CS%mpp_domain, CS%Grid%geolatT, T_grid%y) - call global_field(CS%mpp_domain, CS%oda_grid%basin_mask, T_grid%basin_mask) - T_grid%ni = CS%ni - T_grid%nj = CS%nj - T_grid%nk = CS%nk - allocate(T_grid%mask(CS%ni,CS%nj,CS%nk)) - allocate(T_grid%z(CS%ni,CS%nj,CS%nk)) - allocate(global2D(CS%ni,CS%nj)) - allocate(global2D_old(CS%ni,CS%nj)) - T_grid%mask(:,:,:) = 0.0 - T_grid%z(:,:,:) = 0.0 - - do k = 1, CS%nk - call global_field(G%Domain%mpp_domain, CS%h(:,:,k), global2D) - do i=1,CS%ni ; do j=1,CS%nj - if ( global2D(i,j) > 1 ) then - T_grid%mask(i,j,k) = 1.0 - endif - enddo ; enddo - if (k == 1) then - T_grid%z(:,:,k) = global2D/2 - else - T_grid%z(:,:,k) = T_grid%z(:,:,k-1) + (global2D + global2D_old)/2 - endif - global2D_old = global2D - enddo + basin_file = trim(inputdir) // trim(basin_file) + allocate(CS%oda_grid%basin_mask(isd:ied,jsd:jed)) + CS%oda_grid%basin_mask(:,:) = 0.0 + call MOM_read_data(basin_file,'basin',CS%oda_grid%basin_mask,CS%Grid%domain, timelevel=1) + endif - call ocean_da_core_init(CS%mpp_domain, T_grid, CS%Profiles, Time) + ! set up diag variables for analysis increments + CS%diag_CS => diag_CS + CS%id_inc_t=register_diag_field('ocean_model','temp_increment',diag_CS%axesTL,& + Time,'ocean potential temperature increments','degC') + CS%id_inc_s=register_diag_field('ocean_model','salt_increment',diag_CS%axesTL,& + Time,'ocean salinity increments','psu') + + !! get global grid information from ocean model needed for ODA initialization + T_grid=>NULL() + call set_up_global_tgrid(T_grid, CS, G) + call ocean_da_core_init(CS%mpp_domain, T_grid, CS%Profiles, Time) + deallocate(T_grid) CS%Time=Time !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) + + if (CS%do_bias_adjustment) then + call get_param(PF, "MOM", "TEMP_SALT_ADJUSTMENT_FILE", bias_correction_file, & + "The name of the file containing temperature and salinity "//& + "tendency adjustments", default='temp_salt_adjustment.nc') + + inc_file = trim(inputdir) // trim(bias_correction_file) + CS%INC_CS%T_id = init_extern_field(inc_file, "temp_increment", & + correct_leap_year_inconsistency=.true.,verbose=.true.,domain=G%Domain%mpp_domain) + CS%INC_CS%S_id = init_extern_field(inc_file, "salt_increment", & + correct_leap_year_inconsistency=.true.,verbose=.true.,domain=G%Domain%mpp_domain) + call get_external_field_info(CS%INC_CS%T_id,size=fld_sz) + CS%INC_CS%fldno = 2 + if (CS%nk .ne. fld_sz(3)) call MOM_error(FATAL,'Increment levels /= ODA levels') + allocate(CS%tv_bc) ! storage for increment + allocate(CS%tv_bc%T(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke)); CS%tv_bc%T(:,:,:)=0.0 + allocate(CS%tv_bc%S(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke)); CS%tv_bc%S(:,:,:)=0.0 + endif + + call cpu_clock_end(id_clock_oda_init) + +! if (CS%write_obs) then +! temp_fid = open_profile_file("temp_"//trim(obs_file)) +! salt_fid = open_profile_file("salt_"//trim(obs_file)) +! end if + end subroutine init_oda !> Copy ensemble member tracers to ensemble vector. @@ -340,7 +405,8 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) !! switch to global pelist call set_PElist(CS%filter_pelist) - call MOM_mesg('Setting prior') + !call MOM_mesg('Setting prior') + call cpu_clock_begin(id_clock_oda_prior) ! computational domain for the analysis grid isc=CS%Grid%isc;iec=CS%Grid%iec;jsc=CS%Grid%jsc;jec=CS%Grid%jec @@ -367,6 +433,7 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) call pass_var(CS%Ocean_prior%S(:,:,:,m),CS%Grid%domain) enddo + call cpu_clock_end(id_clock_oda_prior) !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) @@ -379,28 +446,31 @@ end subroutine set_prior_tracer subroutine get_posterior_tracer(Time, CS, h, tv, increment) type(time_type), intent(in) :: Time !< the current model time type(ODA_CS), pointer :: CS !< ocean DA control structure - real, dimension(:,:,:), pointer :: h !< Layer thicknesses [H ~> m or kg m-2] - type(thermo_var_ptrs), pointer :: tv !< A structure pointing to various thermodynamic variables + real, dimension(:,:,:), pointer, optional :: h !< Layer thicknesses [H ~> m or kg m-2] + type(thermo_var_ptrs), pointer, optional :: tv !< A structure pointing to various thermodynamic variables logical, optional, intent(in) :: increment !< True if returning increment only type(ocean_control_struct), pointer :: Ocean_increment=>NULL() integer :: i, j, m logical :: used, get_inc + integer :: seconds_per_hour = 3600. ! return if not analysis time (retain pointers for h and tv) - if (Time < CS%Time) return + if (Time < CS%Time .or. CS%assim_method .eq. NO_ASSIM) return !! switch to global pelist call set_PElist(CS%filter_pelist) call MOM_mesg('Getting posterior') - + call cpu_clock_begin(id_clock_oda_posterior) + if (present(h)) h => CS%h ! get analysis thickness + !! Calculate and redistribute increments to CS%tv right after assimilation + !! Retain CS%tv to calculate increments for IAU updates CS%tv_inc otherwise get_inc = .true. if (present(increment)) get_inc = increment if (get_inc) then allocate(Ocean_increment) - call init_ocean_ensemble(Ocean_increment,CS%Grid,CS%GV,CS%ensemble_size) Ocean_increment%T = CS%Ocean_posterior%T - CS%Ocean_prior%T Ocean_increment%S = CS%Ocean_posterior%S - CS%Ocean_prior%S endif @@ -418,17 +488,28 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) endif enddo - tv => CS%tv - h => CS%h + if (present(tv)) tv => CS%tv + if (present(h)) h => CS%h + + call cpu_clock_end(id_clock_oda_posterior) + !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) + call pass_var(CS%tv%T,CS%domains(CS%ensemble_id)) + call pass_var(CS%tv%S,CS%domains(CS%ensemble_id)) + + !convert to a tendency (degC or PSU per second) + CS%tv%T = CS%tv%T / (CS%assim_frequency * seconds_per_hour) + CS%tv%S = CS%tv%S / (CS%assim_frequency * seconds_per_hour) + + end subroutine get_posterior_tracer !> Gather observations and call ODA routines subroutine oda(Time, CS) type(time_type), intent(in) :: Time !< the current model time - type(oda_CS), intent(inout) :: CS !< the ocean DA control structure + type(oda_CS), pointer :: CS !< A pointer the ocean DA control structure integer :: i, j integer :: m @@ -438,20 +519,61 @@ subroutine oda(Time, CS) !! switch to global pelist call set_PElist(CS%filter_pelist) - + call cpu_clock_begin(id_clock_oda_filter) call get_profiles(Time, CS%Profiles, CS%CProfiles) #ifdef ENABLE_ECDA call ensemble_filter(CS%Ocean_prior, CS%Ocean_posterior, CS%CProfiles, CS%kdroot, CS%mpp_domain, CS%oda_grid) #endif - + call cpu_clock_end(id_clock_oda_filter) !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) + call get_posterior_tracer(Time, CS, increment=.true.) + if (CS%do_bias_adjustment) call get_bias_correction_tracer(Time, CS) endif return end subroutine oda +subroutine get_bias_correction_tracer(Time, CS) + type(time_type), intent(in) :: Time !< the current model time + type(ODA_CS), pointer :: CS !< ocean DA control structure + + integer :: i,j,k + real, allocatable, dimension(:,:,:) :: T_bias, S_bias + real, allocatable, dimension(:,:,:) :: mask_z + real, allocatable, dimension(:), target :: z_in, z_edges_in + real :: missing_value + integer,dimension(3) :: fld_sz + + call cpu_clock_begin(id_clock_bias_adjustment) + call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id,Time,1.0,CS%G,T_bias,& + mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) + call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id,Time,1.0,CS%G,S_bias,& + mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) + + ! This should be replaced to use mask_z instead of the following lines + ! which are intended to zero land values using an arbitrary limit. + fld_sz=shape(T_bias) + do i=1,fld_sz(1) + do j=1,fld_sz(2) + do k=1,fld_sz(3) + if (T_bias(i,j,k) .gt. 1.0E-3) T_bias(i,j,k) = 0.0 + if (S_bias(i,j,k) .gt. 1.0E-3) S_bias(i,j,k) = 0.0 + enddo + enddo + enddo + + CS%tv_bc%T = T_bias * CS%bias_adjustment_multiplier + CS%tv_bc%S = S_bias * CS%bias_adjustment_multiplier + + call pass_var(CS%tv_bc%T, CS%domains(CS%ensemble_id)) + call pass_var(CS%tv_bc%S, CS%domains(CS%ensemble_id)) + + call cpu_clock_end(id_clock_bias_adjustment) + + end subroutine get_bias_correction_tracer + !> Finalize DA module subroutine oda_end(CS) type(ODA_CS), intent(inout) :: CS !< the ocean DA control structure @@ -513,45 +635,127 @@ subroutine set_analysis_time(Time,CS) end subroutine set_analysis_time -!> Write observation differences to a file -subroutine save_obs_diff(filename,CS) - character(len=*), intent(in) :: filename !< name of output file - type(ODA_CS), pointer, intent(in) :: CS !< pointer to DA control structure - - integer :: fid ! profile file handle - type(ocean_profile_type), pointer :: Prof=>NULL() - - fid = open_profile_file(trim(filename), nvar=2, thread=SINGLE_FILE, fset=SINGLE_FILE) - Prof=>CS%CProfiles - - !! switch to global pelist - !call set_PElist(CS%filter_pelist) - - do while (associated(Prof)) - call write_profile(fid,Prof) - Prof=>Prof%cnext - enddo - call close_profile_file(fid) - - !! switch back to ensemble member pelist - !call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) - - return -end subroutine save_obs_diff - !> Apply increments to tracers -subroutine apply_oda_tracer_increments(dt, G, GV, tv, h, CS) +subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) real, intent(in) :: dt !< The tracer timestep [s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< layer thickness [H ~> m or kg m-2] - type(ODA_CS), intent(inout) :: CS !< the data assimilation structure + type(ODA_CS), pointer :: CS !< the data assimilation structure + + !! local variables + integer :: yr, mon, day, hr, min, sec + integer :: i, j, k + integer :: isc, iec, jsc, jec + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_inc !< an adjustment to the temperature + !! tendency [degC T-1 -> degC s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_inc !< an adjustment to the salinity + !! tendency [g kg-1 T-1 -> g kg-1 s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: T !< The updated temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: S !< The updated salinity [g kg-1] + real :: missing_value + + if (.not. associated(CS)) return + if (CS%assim_method .eq. NO_ASSIM .and. (.not. CS%do_bias_adjustment)) return + + call cpu_clock_begin(id_clock_apply_increments) + + T_inc(:,:,:) = 0.0; S_inc(:,:,:) = 0.0; T(:,:,:) = 0.0; S(:,:,:) = 0.0 + if (CS%assim_method > 0 ) then + T = T + CS%tv%T + S = S + CS%tv%S + endif + if (CS%do_bias_adjustment ) then + T = T + CS%tv_bc%T + S = S + CS%tv_bc%S + endif + + isc=G%isc; iec=G%iec; jsc=G%jsc; jec=G%jec + do j=jsc,jec; do i=isc,iec + call remapping_core_h(CS%remapCS, CS%nk, CS%h(i,j,:), T(i,j,:), & + G%ke, h(i,j,:), T_inc(i,j,:)) + call remapping_core_h(CS%remapCS, CS%nk, CS%h(i,j,:), S(i,j,:), & + G%ke, h(i,j,:), S_inc(i,j,:)) + enddo; enddo + + + call pass_var(T_inc, G%Domain) + call pass_var(S_inc, G%Domain) + + tv%T(isc:iec,jsc:jec,:)=tv%T(isc:iec,jsc:jec,:)+T_inc(isc:iec,jsc:jec,:)*dt + tv%S(isc:iec,jsc:jec,:)=tv%S(isc:iec,jsc:jec,:)+S_inc(isc:iec,jsc:jec,:)*dt + + call pass_var(tv%T, G%Domain) + call pass_var(tv%S, G%Domain) + + call enable_averaging(dt, Time_end, CS%diag_CS) + if (CS%id_inc_t > 0) call post_data(CS%id_inc_t, T_inc, CS%diag_CS) + if (CS%id_inc_s > 0) call post_data(CS%id_inc_s, S_inc, CS%diag_CS) + call disable_averaging(CS%diag_CS) + + call diag_update_remap_grids(CS%diag_CS) + call cpu_clock_end(id_clock_apply_increments) + end subroutine apply_oda_tracer_increments + subroutine set_up_global_tgrid(T_grid, CS, G) + type(grid_type), pointer :: T_grid !< global tracer grid + type(ODA_CS), pointer, intent(in) :: CS !< A pointer to DA control structure. + type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model + + ! local variables + real, dimension(:,:), allocatable :: global2D, global2D_old + integer :: i, j, k + + ! get global grid information from ocean_model + T_grid=>NULL() + !if (associated(T_grid)) call MOM_error(FATAL,'MOM_oda_driver:set_up_global_tgrid called with associated T_grid') + + allocate(T_grid) + T_grid%ni = CS%ni + T_grid%nj = CS%nj + T_grid%nk = CS%nk + allocate(T_grid%x(CS%ni,CS%nj)) + allocate(T_grid%y(CS%ni,CS%nj)) + allocate(T_grid%bathyT(CS%ni,CS%nj)) + call global_field(CS%mpp_domain, CS%Grid%geolonT, T_grid%x) + call global_field(CS%mpp_domain, CS%Grid%geolatT, T_grid%y) + call global_field(CS%domains(CS%ensemble_id)%mpp_domain, G%bathyT, T_grid%bathyT) + if (CS%use_basin_mask) then + allocate(T_grid%basin_mask(CS%ni,CS%nj)) + call global_field(CS%mpp_domain, CS%oda_grid%basin_mask, T_grid%basin_mask) + endif + allocate(T_grid%mask(CS%ni,CS%nj,CS%nk)) + allocate(T_grid%z(CS%ni,CS%nj,CS%nk)) + allocate(global2D(CS%ni,CS%nj)) + allocate(global2D_old(CS%ni,CS%nj)) + T_grid%mask(:,:,:) = 0.0 + T_grid%z(:,:,:) = 0.0 + + do k = 1, CS%nk + call global_field(G%Domain%mpp_domain, CS%h(:,:,k), global2D) + do i=1,CS%ni ; do j=1,CS%nj + if ( global2D(i,j) > 1 ) then + T_grid%mask(i,j,k) = 1.0 + endif + enddo; enddo + if (k == 1) then + T_grid%z(:,:,k) = global2D/2 + else + T_grid%z(:,:,k) = T_grid%z(:,:,k-1) + (global2D + global2D_old)/2 + endif + global2D_old = global2D + enddo + + deallocate(global2D) + deallocate(global2D_old) + end subroutine set_up_global_tgrid + !> \namespace MOM_oda_driver_mod !! !! \section section_ODA The Ocean data assimilation (DA) and Ensemble Framework diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 8206fd9717..a179613f57 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -133,8 +133,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h MEKE_decay, & ! A diagnostic of the MEKE decay timescale [T-1 ~> s-1]. drag_rate_visc, & ! Near-bottom velocity contribution to bottom dratg [L T-1 ~> m s-1] drag_rate, & ! The MEKE spindown timescale due to bottom drag [T-1 ~> s-1]. - drag_rate_J15, & ! The MEKE spindown timescale due to bottom drag with the Jansen 2015 scheme. - ! Unfortunately, as written the units seem inconsistent. [T-1 ~> s-1]. del2MEKE, & ! Laplacian of MEKE, used for bi-harmonic diffusion [T-2 ~> s-2]. del4MEKE, & ! Time-integrated MEKE tendency arising from the biharmonic of MEKE [L2 T-2 ~> m2 s-2]. LmixScale, & ! Eddy mixing length [L ~> m]. @@ -179,8 +177,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (.not.associated(MEKE)) call MOM_error(FATAL, & "MOM_MEKE: MEKE must be initialized before it is used.") - if ((CS%MEKE_damping > 0.0) .or. (CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) & - .or. CS%visc_drag) then + if ((CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) .or. CS%visc_drag) then use_drag_rate = .true. else use_drag_rate = .false. @@ -236,12 +233,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo endif - if (CS%MEKE_Cd_scale == 0.0 .and. .not. CS%visc_drag) then - !$OMP parallel do default(shared) private(ldamping) - do j=js,je ; do i=is,ie - drag_rate(i,j) = 0. ; drag_rate_J15(i,j) = 0. - enddo ; enddo - endif ! Calculate drag_rate_visc(i,j) which accounts for the model bottom mean flow if (CS%visc_drag) then @@ -288,7 +279,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%fixed_total_depth) then !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 - depth_tot(i,j) = G%bathyT(i,j) + depth_tot(i,j) = G%bathyT(i,j) + G%Z_ref enddo ; enddo else !$OMP parallel do default(shared) @@ -370,6 +361,11 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h drag_rate(i,j) = (US%L_to_Z*Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + & cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) enddo ; enddo + else + !$OMP parallel do default(shared) + do j=js,je ; do i=is,ie + drag_rate(i,j) = 0. + enddo ; enddo endif ! First stage of Strang splitting @@ -538,23 +534,19 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h drag_rate(i,j) = (US%L_to_Z*Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + & cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) enddo ; enddo - !$OMP parallel do default(shared) - do j=js,je ; do i=is,ie - ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) - if (MEKE%MEKE(i,j) < 0.) ldamping = 0. - ! notice that the above line ensures a damping only if MEKE is positive, - ! while leaving MEKE unchanged if it is negative - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) - MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) - enddo ; enddo endif + !$OMP parallel do default(shared) + do j=js,je ; do i=is,ie + ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) + if (MEKE%MEKE(i,j) < 0.) ldamping = 0. + ! notice that the above line ensures a damping only if MEKE is positive, + ! while leaving MEKE unchanged if it is negative + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) + MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) + enddo ; enddo endif endif ! MEKE_KH>=0 - ! do j=js,je ; do i=is,ie - ! MEKE%MEKE(i,j) = MAX(MEKE%MEKE(i,j),0.0) - ! enddo ; enddo - call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_MEKE, G%Domain) call cpu_clock_end(CS%id_clock_pass) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index cf1712afc6..84eabc9317 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -190,6 +190,7 @@ module MOM_hor_visc integer :: id_h_diffu = -1, id_h_diffv = -1 integer :: id_hf_diffu_2d = -1, id_hf_diffv_2d = -1 integer :: id_intz_diffu_2d = -1, id_intz_diffv_2d = -1 + integer :: id_diffu_visc_rem = -1, id_diffv_visc_rem = -1 integer :: id_Ah_h = -1, id_Ah_q = -1 integer :: id_Kh_h = -1, id_Kh_q = -1 integer :: id_GME_coeff_h = -1, id_GME_coeff_q = -1 @@ -282,6 +283,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real, allocatable, dimension(:,:,:) :: h_diffu ! h x diffu [H L T-2 ~> m2 s-2] real, allocatable, dimension(:,:,:) :: h_diffv ! h x diffv [H L T-2 ~> m2 s-2] + real, allocatable, dimension(:,:,:) :: diffu_visc_rem ! diffu x visc_rem_u [L T-2 ~> m s-2] + real, allocatable, dimension(:,:,:) :: diffv_visc_rem ! diffv x visc_rem_v [L T-2 ~> m s-2] real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain [T-1 ~> s-1] @@ -1726,6 +1729,25 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, deallocate(h_diffv) endif + if (present(ADp) .and. (CS%id_diffu_visc_rem > 0)) then + allocate(diffu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) + diffu_visc_rem(:,:,:) = 0.0 + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + diffu_visc_rem(I,j,k) = diffu(I,j,k) * ADp%visc_rem_u(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_diffu_visc_rem, diffu_visc_rem, CS%diag) + deallocate(diffu_visc_rem) + endif + if (present(ADp) .and. (CS%id_diffv_visc_rem > 0)) then + allocate(diffv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) + diffv_visc_rem(:,:,:) = 0.0 + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + diffv_visc_rem(i,J,k) = diffv(i,J,k) * ADp%visc_rem_v(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_diffv_visc_rem, diffv_visc_rem, CS%diag) + deallocate(diffv_visc_rem) + endif + end subroutine horizontal_viscosity !> Allocates space for and calculates static variables used by horizontal_viscosity(). @@ -2470,6 +2492,20 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) call safe_alloc_ptr(ADp%diag_hv,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) endif + CS%id_diffu_visc_rem = register_diag_field('ocean_model', 'diffu_visc_rem', diag%axesCuL, Time, & + 'Zonal Acceleration from Horizontal Viscosity multiplied by viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if ((CS%id_diffu_visc_rem > 0) .and. (present(ADp))) then + call safe_alloc_ptr(ADp%visc_rem_u,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) + endif + + CS%id_diffv_visc_rem = register_diag_field('ocean_model', 'diffv_visc_rem', diag%axesCvL, Time, & + 'Meridional Acceleration from Horizontal Viscosity multiplied by viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if ((CS%id_diffv_visc_rem > 0) .and. (present(ADp))) then + call safe_alloc_ptr(ADp%visc_rem_v,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) + endif + if (CS%biharmonic) then CS%id_Ah_h = register_diag_field('ocean_model', 'Ahh', diag%axesTL, Time, & 'Biharmonic Horizontal Viscosity at h Points', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T, & diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 0e3ae5ab71..6ca6f27ee0 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -216,6 +216,10 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & I_rho0 = 1.0 / GV%Rho0 cn_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. + ! init local arrays + drag_scale(:,:) = 0. + Ub(:,:,:,:) = 0. + ! Set the wave speeds for the modes, using cg(n) ~ cg(1)/n.********************** ! This is wrong, of course, but it works reasonably in some cases. ! Uncomment if wave_speed is not used to calculate the true values (BDM). @@ -2213,7 +2217,10 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) ! Allocate and populate frequency array (each a multiple of first for now) allocate(CS%frequency(num_freq)) - call get_param(param_file, mdl, "FIRST_MODE_PERIOD", period_1, units="s", scale=US%s_to_T) + call get_param(param_file, mdl, "FIRST_MODE_PERIOD", period_1, & + "The period of the first mode for internal tides", default=44567., & + units="s", scale=US%s_to_T) + do fr=1,num_freq CS%frequency(fr) = (8.0*atan(1.0) * (real(fr)) / period_1) ! ADDED BDM enddo @@ -2359,7 +2366,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) do j=G%jsc,G%jec ; do i=G%isc,G%iec ! Restrict RMS topographic roughness to a fraction (10 percent by default) of the column depth. if (RMS_roughness_frac >= 0.0) then - h2(i,j) = max(min((RMS_roughness_frac*G%bathyT(i,j))**2, h2(i,j)), 0.0) + h2(i,j) = max(min((RMS_roughness_frac*(G%bathyT(i,j)+G%Z_ref))**2, h2(i,j)), 0.0) else h2(i,j) = max(h2(i,j), 0.0) endif @@ -2532,8 +2539,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) do a=1,num_angle ; angles(a) = (real(a) - 1) * Angle_size ; enddo id_ang = diag_axis_init("angle", angles, "Radians", "N", "Angular Orienation of Fluxes") - call define_axes_group(diag, (/ diag%axesT1%handles(1), diag%axesT1%handles(2), id_ang /), axes_ang) - + call define_axes_group(diag, (/ diag%axesT1%handles(1), diag%axesT1%handles(2), id_ang /), & + axes_ang, is_h_point=.true.) do fr=1,CS%nFreq ; write(freq_name(fr), '("freq",i1)') fr ; enddo do m=1,CS%nMode ; do fr=1,CS%nFreq ! Register 2-D energy density (summed over angles) for each freq and mode diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index fb70f5d679..9af47b3cea 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -184,11 +184,11 @@ subroutine calc_depth_function(G, CS) expo = CS%depth_scaled_khth_exp !$OMP do do j=js,je ; do I=is-1,Ieq - CS%Depth_fn_u(I,j) = (MIN(1.0, 0.5*(G%bathyT(i,j) + G%bathyT(i+1,j))/H0))**expo + CS%Depth_fn_u(I,j) = (MIN(1.0, (0.5*(G%bathyT(i,j) + G%bathyT(i+1,j)) + G%Z_ref)/H0))**expo enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - CS%Depth_fn_v(i,J) = (MIN(1.0, 0.5*(G%bathyT(i,j) + G%bathyT(i,j+1))/H0))**expo + CS%Depth_fn_v(i,J) = (MIN(1.0, (0.5*(G%bathyT(i,j) + G%bathyT(i,j+1)) + G%Z_ref)/H0))**expo enddo ; enddo end subroutine calc_depth_function @@ -958,11 +958,12 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop enddo ; enddo ! SN above contains S^2*N^2*H, convert to vertical average of S*N do I=is-1,ie - !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_Z ) )) + !### Replace G%bathT+G%Z_ref here with (e(i,j,1) - e(i,j,nz+1)). + !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(i,j), G%bathyT(i+1,j)) + (G%Z_ref + GV%Angstrom_Z) ) ) !The code below behaves better than the line above. Not sure why? AJA - if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then + if ( min(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref > H_cutoff*GV%H_to_Z ) then CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( CS%SN_u(I,j) / & - (max(G%bathyT(I,j), G%bathyT(I+1,j))) ) + (max(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref) ) else CS%SN_u(I,j) = 0.0 endif @@ -984,20 +985,21 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop CS%SN_v(i,J) = CS%SN_v(i,J) + S2N2_v_local(i,J,k) enddo ; enddo do i=is,ie - !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_Z ) )) + !### Replace G%bathT+G%Z_ref here with (e(i,j,1) - e(i,j,nz+1)). + !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + (G%Z_ref + GV%Angstrom_Z) ) ) !The code below behaves better than the line above. Not sure why? AJA - if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then + if ( min(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref > H_cutoff*GV%H_to_Z ) then CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( CS%SN_v(i,J) / & - (max(G%bathyT(i,J), G%bathyT(i,J+1))) ) + (max(G%bathyT(i,j), G%bathyT(i,j+1)) + G%Z_ref) ) else - CS%SN_v(I,j) = 0.0 + CS%SN_v(i,J) = 0.0 endif if (local_open_v_BC) then - l_seg = OBC%segnum_v(I,j) + l_seg = OBC%segnum_v(i,J) if (l_seg /= OBC_NONE) then - if (OBC%segment(OBC%segnum_v(I,j))%open) then - CS%SN_v(I,j) = 0. + if (OBC%segment(OBC%segnum_v(i,J))%open) then + CS%SN_v(i,J) = 0. endif endif endif diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index be1d265620..5847b13fa8 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -863,8 +863,6 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) real, dimension(SZK_(GV)) :: tmp_val1 ! data values remapped to model grid real, dimension(SZK_(GV)) :: h_col ! A column of thicknesses at h, u or v points [H ~> m or kg m-2] real, allocatable, dimension(:,:,:) :: sp_val ! A temporary array for fields - real, allocatable, dimension(:,:,:) :: sp_val_u ! A temporary array for fields - real, allocatable, dimension(:,:,:) :: sp_val_v ! A temporary array for fields real, allocatable, dimension(:,:,:) :: mask_z ! A temporary array for field mask at h pts real, allocatable, dimension(:,:,:) :: mask_u ! A temporary array for field mask at u pts real, allocatable, dimension(:,:,:) :: mask_v ! A temporary array for field mask at v pts @@ -883,6 +881,8 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) real :: Idt ! The inverse of the timestep [T-1 ~> s-1] real :: h_neglect, h_neglect_edge ! Negligible thicknesses [H ~> m or kg m-2] real :: zTopOfCell, zBottomOfCell ! Interface heights (positive upward) in the input dataset [Z ~> m]. + real :: sp_val_u ! Interpolation of sp_val to u-points + real :: sp_val_v ! Interpolation of sp_val to v-points integer :: nPoints is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -903,8 +903,6 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) call MOM_error(FATAL,"apply_ALE_sponge: No time information provided") do m=1,CS%fldno nz_data = CS%Ref_val(m)%nz_data - allocate(sp_val(G%isd:G%ied,G%jsd:G%jed,1:nz_data)); sp_val(:,:,:) = 0.0 - allocate(mask_z(G%isd:G%ied,G%jsd:G%jed,1:nz_data)); mask_z(:,:,:) = 0.0 call horiz_interp_and_extrap_tracer(CS%Ref_val(m)%id, Time, 1.0, G, sp_val, mask_z, z_in, & z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z, & @@ -918,7 +916,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0; tmpT1d(:) = -99.9 do k=1,nz_data if (mask_z(CS%col_i(c),CS%col_j(c),k) == 1.0) then - zBottomOfCell = -min( z_edges_in(k+1), G%bathyT(CS%col_i(c),CS%col_j(c)) ) + zBottomOfCell = -min( z_edges_in(k+1) - G%Z_ref, G%bathyT(CS%col_i(c),CS%col_j(c)) ) tmpT1d(k) = sp_val(CS%col_i(c),CS%col_j(c),k) elseif (k>1) then zBottomOfCell = -G%bathyT(CS%col_i(c),CS%col_j(c)) @@ -991,24 +989,20 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) call MOM_error(FATAL,"apply_ALE_sponge: No time information provided") nz_data = CS%Ref_val_u%nz_data - allocate(sp_val(G%isd:G%ied,G%jsd:G%jed,1:nz_data)) - allocate(sp_val_u(G%isdB:G%iedB,G%jsd:G%jed,1:nz_data)) - allocate(mask_u(G%isdB:G%iedB,G%jsd:G%jed,1:nz_data)) - allocate(mask_z(G%isd:G%ied,G%jsd:G%jed,1:nz_data)) - sp_val(:,:,:) = 0.0 - sp_val_u(:,:,:) = 0.0 - mask_u(:,:,:) = 0.0 - mask_z(:,:,:) = 0.0 ! Interpolate from the external horizontal grid and in time call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id, Time, 1.0, G, sp_val, mask_z, z_in, & z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& answers_2018=CS%hor_regrid_answers_2018) + ! Initialize mask_z halos to zero before pass_var, in case of no update + mask_z(G%isc-1, G%jsc:G%jec, :) = 0. + mask_z(G%iec+1, G%jsc:G%jec, :) = 0. call pass_var(sp_val, G%Domain) call pass_var(mask_z, G%Domain) + + allocate(mask_u(G%isdB:G%iedB,G%jsd:G%jed,1:nz_data)) do j=G%jsc,G%jec; do I=G%iscB,G%iecB - sp_val_u(I,j,1:nz_data) = 0.5*(sp_val(i,j,1:nz_data)+sp_val(i+1,j,1:nz_data)) mask_u(I,j,1:nz_data) = min(mask_z(i,j,1:nz_data),mask_z(i+1,j,1:nz_data)) enddo ; enddo @@ -1018,7 +1012,10 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) ! Therefore we use c as per C code and increment the index where necessary. i = CS%col_i_u(c) ; j = CS%col_j_u(c) if (mask_u(i,j,1) == 1.0) then - CS%Ref_val_u%p(1:nz_data,c) = sp_val_u(i,j,1:nz_data) + do k=1,nz_data + sp_val_u = 0.5 * (sp_val(i,j,k) + sp_val(i+1,j,k)) + CS%Ref_val_u%p(k,c) = sp_val_u + enddo else CS%Ref_val_u%p(1:nz_data,c) = 0.0 endif @@ -1026,7 +1023,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0 do k=1,nz_data if (mask_u(i,j,k) == 1.0) then - zBottomOfCell = -min( z_edges_in(k+1), G%bathyT(i,j) ) + zBottomOfCell = -min( z_edges_in(k+1) - G%Z_ref, G%bathyT(i,j) ) elseif (k>1) then zBottomOfCell = -G%bathyT(i,j) else ! This next block should only ever be reached over land @@ -1039,24 +1036,21 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(i,j) ) CS%Ref_val_u%h(1:nz_data,c) = GV%Z_to_H*hsrc(1:nz_data) enddo - deallocate(sp_val, sp_val_u, mask_u, mask_z, hsrc) + deallocate(sp_val, mask_u, mask_z, hsrc) nz_data = CS%Ref_val_v%nz_data - allocate(sp_val( G%isd:G%ied,G%jsd:G%jed,1:nz_data)) - allocate(sp_val_v(G%isd:G%ied,G%jsdB:G%jedB,1:nz_data)) - allocate(mask_v(G%isd:G%ied,G%jsdB:G%jedB,1:nz_data)) - allocate(mask_z(G%isd:G%ied,G%jsd:G%jed,1:nz_data)) - sp_val(:,:,:) = 0.0 - sp_val_v(:,:,:) = 0.0 - mask_z(:,:,:) = 0.0 ! Interpolate from the external horizontal grid and in time call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id, Time, 1.0, G, sp_val, mask_z, z_in, & z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& answers_2018=CS%hor_regrid_answers_2018) + ! Initialize mask_z halos to zero before pass_var, in case of no update + mask_z(G%isc:G%iec, G%jsc-1, :) = 0. + mask_z(G%isc:G%iec, G%jec+1, :) = 0. call pass_var(sp_val, G%Domain) call pass_var(mask_z, G%Domain) + + allocate(mask_v(G%isd:G%ied,G%jsdB:G%jedB,1:nz_data)) do J=G%jscB,G%jecB; do i=G%isc,G%iec - sp_val_v(i,J,1:nz_data) = 0.5*(sp_val(i,j,1:nz_data)+sp_val(i,j+1,1:nz_data)) mask_v(i,J,1:nz_data) = min(mask_z(i,j,1:nz_data),mask_z(i,j+1,1:nz_data)) enddo ; enddo !call pass_var(mask_z,G%Domain) @@ -1066,7 +1060,10 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) ! Therefore we use c as per C code and increment the index where necessary. i = CS%col_i_v(c) ; j = CS%col_j_v(c) if (mask_v(i,j,1) == 1.0) then - CS%Ref_val_v%p(1:nz_data,c) = sp_val_v(i,j,1:nz_data) + do k=1,nz_data + sp_val_v = 0.5 * (sp_val(i,j,k) + sp_val(i,j+1,k)) + CS%Ref_val_v%p(k,c) = sp_val_v + enddo else CS%Ref_val_v%p(1:nz_data,c) = 0.0 endif @@ -1074,7 +1071,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0 do k=1,nz_data if (mask_v(i,j,k) == 1.0) then - zBottomOfCell = -min( z_edges_in(k+1), G%bathyT(i,j) ) + zBottomOfCell = -min( z_edges_in(k+1) - G%Z_ref, G%bathyT(i,j) ) elseif (k>1) then zBottomOfCell = -G%bathyT(i,j) else ! This next block should only ever be reached over land @@ -1087,7 +1084,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(i,j) ) CS%Ref_val_v%h(1:nz_data,c) = GV%Z_to_H*hsrc(1:nz_data) enddo - deallocate(sp_val, sp_val_v, mask_v, mask_z, hsrc) + deallocate(sp_val, mask_v, mask_z, hsrc) endif call pass_var(h,G%Domain) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 040f3c4ecb..f8e071e41d 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -316,7 +316,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0) + call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0, dZref=G%Z_ref) call post_data(CS%id_e_predia, eta, CS%diag) endif diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 68e2f39f0e..a6835d42ed 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -435,13 +435,13 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) do j=js,je ; do i=is,ie mask_itidal = 1.0 - if (G%bathyT(i,j) < min_zbot_itides) mask_itidal = 0.0 + if (G%bathyT(i,j) + G%Z_ref < min_zbot_itides) mask_itidal = 0.0 itide%tideamp(i,j) = itide%tideamp(i,j) * mask_itidal * G%mask2dT(i,j) ! Restrict rms topo to a fraction (often 10 percent) of the column depth. if (max_frac_rough >= 0.0) & - itide%h2(i,j) = min((max_frac_rough*G%bathyT(i,j))**2, itide%h2(i,j)) + itide%h2(i,j) = min((max_frac_rough*(G%bathyT(i,j)+G%Z_ref))**2, itide%h2(i,j)) ! Compute the fixed part of internal tidal forcing; units are [R Z3 T-2 ~> J m-2] here. CS%TKE_itidal_coef(i,j) = 0.5*US%L_to_Z*kappa_h2_factor*GV%Rho0*& diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index f4874252f4..0d07f0fea4 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -198,16 +198,6 @@ module MOM_set_diffusivity contains -!> Sets the interior vertical diffusion of scalars due to the following processes: -!! 1. Shear-driven mixing: two options, Jackson et at. and KPP interior; -!! 2. Background mixing via CVMix (Bryan-Lewis profile) or the scheme described by -!! Harrison & Hallberg, JPO 2008; -!! 3. Double-diffusion, old method and new method via CVMix; -!! 4. Tidal mixing: many options available, see MOM_tidal_mixing.F90; -!! In addition, this subroutine has the option to set the interior vertical -!! viscosity associated with processes 1,2 and 4 listed above, which is stored in -!! visc%Kv_slow. Vertical viscosity due to shear-driven mixing is passed via -!! visc%Kv_shear subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & G, GV, US, CS, Kd_lay, Kd_int, Kd_extra_T, Kd_extra_S) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 99bd91d8f8..138ba9c79f 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -115,80 +115,6 @@ module MOM_set_visc contains !> Calculates the thickness of the bottom boundary layer and the viscosity within that layer. -!! -!! A drag law is used, either linearized about an assumed bottom velocity or using the -!! actual near-bottom velocities combined with an assumed unresolved velocity. The bottom -!! boundary layer thickness is limited by a combination of stratification and rotation, as -!! in the paper of Killworth and Edwards, JPO 1999. It is not necessary to calculate the -!! thickness and viscosity every time step; instead previous values may be used. -!! -!! \section set_viscous_BBL Viscous Bottom Boundary Layer -!! -!! If set_visc_cs.bottomdraglaw is True then a bottom boundary layer viscosity and thickness -!! are calculated so that the bottom stress is -!! \f[ -!! \mathbf{\tau}_b = C_d | U_{bbl} | \mathbf{u}_{bbl} -!! \f] -!! If set_visc_cs.bottomdraglaw is True then the term \f$|U_{bbl}|\f$ is set equal to the -!! value in set_visc_cs.drag_bg_vel so that \f$C_d |U_{bbl}|\f$ becomes a Rayleigh bottom drag. -!! Otherwise \f$|U_{bbl}|\f$ is found by averaging the flow over the bottom set_visc_cs.hbbl -!! of the model, adding the amplitude of tides set_visc_cs.tideamp and a constant -!! set_visc_cs.drag_bg_vel. For these calculations the vertical grid at the velocity -!! component locations is found by -!! \f[ -!! \begin{array}{ll} -!! \frac{2 h^- h^+}{h^- + h^+} & u \left( h^+ - h^-\right) >= 0 -!! \\ -!! \frac{1}{2} \left( h^- + h^+ \right) & u \left( h^+ - h^-\right) < 0 -!! \end{array} -!! \f] -!! which biases towards the thin cell if the thin cell is upwind. Biasing the grid toward -!! thin upwind cells helps increase the effect of viscosity and inhibits flow out of these -!! thin cells. -!! -!! After diagnosing \f$|U_{bbl}|\f$ over a fixed depth an active viscous boundary layer -!! thickness is found using the ideas of Killworth and Edwards, 1999 (hereafter KW99). -!! KW99 solve the equation -!! \f[ -!! \left( \frac{h_{bbl}}{h_f} \right)^2 + \frac{h_{bbl}}{h_N} = 1 -!! \f] -!! for the boundary layer depth \f$h_{bbl}\f$. Here -!! \f[ -!! h_f = \frac{C_n u_*}{f} -!! \f] -!! is the rotation controlled boundary layer depth in the absence of stratification. -!! \f$u_*\f$ is the surface friction speed given by -!! \f[ -!! u_*^2 = C_d |U_{bbl}|^2 -!! \f] -!! and is a function of near bottom model flow. -!! \f[ -!! h_N = \frac{C_i u_*}{N} = \frac{ (C_i u_* )^2 }{g^\prime} -!! \f] -!! is the stratification controlled boundary layer depth. The non-dimensional parameters -!! \f$C_n=0.5\f$ and \f$C_i=20\f$ are suggested by Zilitinkevich and Mironov, 1996. -!! -!! If a Richardson number dependent mixing scheme is being used, as indicated by -!! set_visc_cs.rino_mix, then the boundary layer thickness is bounded to be no larger -!! than a half of set_visc_cs.hbbl . -!! -!! \todo Channel drag needs to be explained -!! -!! A BBL viscosity is calculated so that the no-slip boundary condition in the vertical -!! viscosity solver implies the stress \f$\mathbf{\tau}_b\f$. -!! -!! \subsection set_viscous_BBL_ref References -!! -!! \arg Killworth, P. D., and N. R. Edwards, 1999: -!! A Turbulent Bottom Boundary Layer Code for Use in Numerical Ocean Models. -!! J. Phys. Oceanogr., 29, 1221-1238, -!! doi:10.1175/1520-0485(1999)029<1221:ATBBLC>2.0.CO;2 -!! \arg Zilitinkevich, S., Mironov, D.V., 1996: -!! A multi-limit formulation for the equilibrium depth of a stably stratified boundary layer. -!! Boundary-Layer Meteorology 81, 325-351. -!! doi:10.1007/BF02430334 -!! subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -228,11 +154,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: Rhtot ! Running sum of thicknesses times the layer potential ! densities [H R ~> kg m-2 or kg2 m-5]. real, dimension(SZIB_(G),SZJ_(G)) :: & - D_u, & ! Bottom depth interpolated to u points [Z ~> m]. + D_u, & ! Bottom depth linearly interpolated to u points [Z ~> m]. mask_u ! A mask that disables any contributions from u points that ! are land or past open boundary conditions [nondim], 0 or 1. real, dimension(SZI_(G),SZJB_(G)) :: & - D_v, & ! Bottom depth interpolated to v points [Z ~> m]. + D_v, & ! Bottom depth linearly interpolated to v points [Z ~> m]. mask_v ! A mask that disables any contributions from v points that ! are land or past open boundary conditions [nondim], 0 or 1. real, dimension(SZIB_(G),SZK_(GV)) :: & @@ -399,12 +325,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) !$OMP parallel do default(shared) do J=js-1,je ; do i=is-1,ie+1 - D_v(i,J) = 0.5*(G%bathyT(i,j) + G%bathyT(i,j+1)) + D_v(i,J) = 0.5*(G%bathyT(i,j) + G%bathyT(i,j+1)) + G%Z_ref mask_v(i,J) = G%mask2dCv(i,J) enddo ; enddo !$OMP parallel do default(shared) do j=js-1,je+1 ; do I=is-1,ie - D_u(I,j) = 0.5*(G%bathyT(i,j) + G%bathyT(i+1,j)) + D_u(I,j) = 0.5*(G%bathyT(i,j) + G%bathyT(i+1,j)) + G%Z_ref mask_u(I,j) = G%mask2dCu(I,j) enddo ; enddo @@ -414,13 +340,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) I = OBC%segment(n)%HI%IsdB ; J = OBC%segment(n)%HI%JsdB if (OBC%segment(n)%is_N_or_S .and. (J >= js-1) .and. (J <= je)) then do i = max(is-1,OBC%segment(n)%HI%isd), min(ie+1,OBC%segment(n)%HI%ied) - if (OBC%segment(n)%direction == OBC_DIRECTION_N) D_v(i,J) = G%bathyT(i,j) - if (OBC%segment(n)%direction == OBC_DIRECTION_S) D_v(i,J) = G%bathyT(i,j+1) + if (OBC%segment(n)%direction == OBC_DIRECTION_N) D_v(i,J) = G%bathyT(i,j) + G%Z_ref + if (OBC%segment(n)%direction == OBC_DIRECTION_S) D_v(i,J) = G%bathyT(i,j+1) + G%Z_ref enddo elseif (OBC%segment(n)%is_E_or_W .and. (I >= is-1) .and. (I <= ie)) then do j = max(js-1,OBC%segment(n)%HI%jsd), min(je+1,OBC%segment(n)%HI%jed) - if (OBC%segment(n)%direction == OBC_DIRECTION_E) D_u(I,j) = G%bathyT(i,j) - if (OBC%segment(n)%direction == OBC_DIRECTION_W) D_u(I,j) = G%bathyT(i+1,j) + if (OBC%segment(n)%direction == OBC_DIRECTION_E) D_u(I,j) = G%bathyT(i,j) + G%Z_ref + if (OBC%segment(n)%direction == OBC_DIRECTION_W) D_u(I,j) = G%bathyT(i+1,j) + G%Z_ref enddo endif enddo ; endif @@ -809,6 +735,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! The drag within the bottommost bbl_thick is applied as a part of ! an enhanced bottom viscosity, while above this the drag is applied ! directly to the layers in question as a Rayleigh drag term. + + !### The harmonic mean edge depths here are not invariant to offsets! if (m==1) then D_vel = D_u(I,j) tmp = G%mask2dCu(I,j+1) * D_u(I,j+1) diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 25b5406449..ebb9575974 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -409,17 +409,17 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) enddo ; enddo ; enddo do j=js,je do i=is,ie - dilate(i) = G%bathyT(i,j) / (e_D(i,j,1) + G%bathyT(i,j)) + dilate(i) = (G%bathyT(i,j) + G%Z_ref) / (e_D(i,j,1) + G%bathyT(i,j)) enddo do k=1,nz+1 ; do i=is,ie - e_D(i,j,K) = dilate(i) * (e_D(i,j,K) + G%bathyT(i,j)) - G%bathyT(i,j) + e_D(i,j,K) = dilate(i) * (e_D(i,j,K) + G%bathyT(i,j)) - (G%bathyT(i,j) + G%Z_ref) enddo ; enddo enddo do k=2,nz do j=js,je ; do i=is,ie eta_anom(i,j) = e_D(i,j,k) - CS%Ref_eta_im(j,k) - if (CS%Ref_eta_im(j,K) < -G%bathyT(i,j)) eta_anom(i,j) = 0.0 + if (CS%Ref_eta_im(j,K) < -(G%bathyT(i,j) + G%Z_ref)) eta_anom(i,j) = 0.0 enddo ; enddo call global_i_mean(eta_anom(:,:), eta_mean_anom(:,K), G, tmp_scale=US%Z_to_m) enddo diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 21562817c0..797ceb9a35 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -484,16 +484,16 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) units="nondim", default=0.1) do j=js,je ; do i=is,ie - if (G%bathyT(i,j) < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 + if (G%bathyT(i,j)+G%Z_ref < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 CS%tideamp(i,j) = CS%tideamp(i,j) * CS%mask_itidal(i,j) * G%mask2dT(i,j) ! Restrict rms topo to a fraction (often 10 percent) of the column depth. if (CS%answers_2018 .and. (max_frac_rough >= 0.0)) then - hamp = min(max_frac_rough*G%bathyT(i,j), sqrt(CS%h2(i,j))) + hamp = min(max_frac_rough*(G%bathyT(i,j)+G%Z_ref), sqrt(CS%h2(i,j))) CS%h2(i,j) = hamp*hamp else if (max_frac_rough >= 0.0) & - CS%h2(i,j) = min((max_frac_rough*G%bathyT(i,j))**2, CS%h2(i,j)) + CS%h2(i,j) = min((max_frac_rough*(G%bathyT(i,j)+G%Z_ref))**2, CS%h2(i,j)) endif utide = CS%tideamp(i,j) @@ -1678,7 +1678,7 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) CS%h_src(k) = US%Z_to_m*(z_t(k)-z_w(k))*2.0 ! form tidal_qe_3d_in from weighted tidal constituents do j=js,je ; do i=is,ie - if ((z_t(k) <= G%bathyT(i,j)) .and. (z_w(k) > CS%tidal_diss_lim_tc)) & + if ((z_t(k) <= G%bathyT(i,j) + G%Z_ref) .and. (z_w(k) > CS%tidal_diss_lim_tc)) & CS%tidal_qe_3d_in(i,j,k) = C1_3*tc_m2(i,j,k) + C1_3*tc_s2(i,j,k) + & tidal_qk1(i,j)*tc_k1(i,j,k) + tidal_qo1(i,j)*tc_o1(i,j,k) enddo ; enddo @@ -1692,7 +1692,7 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) ! do k=50,nz_in(1) ! write(1905,*) i,j,k ! write(1905,*) CS%tidal_qe_3d_in(i,j,k), tc_m2(i,j,k) - ! write(1905,*) z_t(k), G%bathyT(i,j), z_w(k),CS%tidal_diss_lim_tc + ! write(1905,*) z_t(k), G%bathyT(i,j)+G%Z_ref, z_w(k),CS%tidal_diss_lim_tc ! end do ! endif ! enddo @@ -1707,7 +1707,7 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) !! collapse 3D q*E to 2D q*E !CS%tidal_qe_2d(:,:) = 0.0 !do k=1,nz_in(1) ; do j=js,je ; do i=is,ie - ! if (z_t(k) <= G%bathyT(i,j)) & + ! if (z_t(k) <= G%bathyT(i,j) + G%Z_ref) & ! CS%tidal_qe_2d(i,j) = CS%tidal_qe_2d(i,j) + CS%tidal_qe_3d_in(i,j,k) !enddo ; enddo ; enddo diff --git a/src/parameterizations/vertical/_Internal_tides.dox b/src/parameterizations/vertical/_Internal_tides.dox index 882b73dd1b..a07663d4a1 100644 --- a/src/parameterizations/vertical/_Internal_tides.dox +++ b/src/parameterizations/vertical/_Internal_tides.dox @@ -4,7 +4,7 @@ Two parameterizations of vertical mixing due to internal tides are available with the option INT_TIDE_DISSIPATION. The first is that of \cite st_laurent2002 while the second is that of \cite polzin2009. Choose between them with the INT_TIDE_PROFILE option. There are other relevant -paramters which can be seen in MOM_parameter_doc.all once the main tidal +parameters which can be seen in MOM_parameter_doc.all once the main tidal dissipation switch is turned on. \section section_st_laurent St Laurent et al. @@ -69,7 +69,7 @@ case the maximum of all the contributions is used. The vertical diffusion profile of \cite polzin2009 is a WKB-stretched algebraic decay profile. It is based on a radiation balance equation, -which links the dissipation profile associtated with internal breaking to +which links the dissipation profile associated with internal breaking to the finescale internal wave shear producing that dissipation. The vertical profile of internal-tide driven energy dissipation can then vary in time and space, and evolve in a changing climate (\cite melet2012). \cite melet2012 @@ -135,9 +135,9 @@ at the ocean floor, so that in both formulations: \int_{0}^{H} \epsilon (z) dz = \frac{qE}{\rho} . \f] -Whereas \cite polzin2009 assumed tthat the total dissipation was locally in balance with the +Whereas \cite polzin2009 assumed that the total dissipation was locally in balance with the barotropic to baroclinic energy conversion rate \f$(q=1)\f$, here we use the \cite simmons2004 value -of \f$q=1/3\f$ to retain as much consistency as passible between both parameterizations. +of \f$q=1/3\f$ to retain as much consistency as possible between both parameterizations. \subsection subsection_vertical_decay_scale Vertical decay-scale reformulation @@ -212,5 +212,16 @@ of the Earth. This allows the buoyancy fluxes to tend to zero in regions of very weak stratification, allowing a no-flux bottom boundary condition to be satisfied. +\section Nikurashin Lee Wave Mixing + +If one has the INT_TIDE_DISSIPATION flag on, there is an option to also turn on +LEE_WAVE_DISSIPATION. The theory is presented in \cite nikurashin2010a +while the application of it is presented in \cite nikurashin2010b. For +the implementation in MOM6, it is required that you provide an estimate +of the TKE loss due to the Lee waves which is then applied with either +the St. Laurent or the Polzin vertical profile. + +\todo Is there a script to produce this somewhere or what??? + */ diff --git a/src/parameterizations/vertical/_V_diffusivity.dox b/src/parameterizations/vertical/_V_diffusivity.dox new file mode 100644 index 0000000000..4d671fec88 --- /dev/null +++ b/src/parameterizations/vertical/_V_diffusivity.dox @@ -0,0 +1,284 @@ +/*! \page Internal_Shear_Mixing Internal Vertical Mixing + +Sets the interior vertical diffusion of scalars due to the following processes: + +-# Shear-driven mixing: two options, \cite jackson2008 and KPP interior; +-# Background mixing via CVMix (Bryan-Lewis profile), the scheme described by + \cite harrison2008, or that in \cite danabasoglu2012. +-# Double-diffusion, old method and new method via CVMix; +-# Tidal mixing: many options available, see \ref Internal_Tidal_Mixing. + +In addition, the MOM_set_diffusivity has the option to set the interior vertical +viscosity associated with processes 1,2 and 4 listed above, which is stored in +visc\%Kv\_slow. Vertical viscosity due to shear-driven mixing is passed via +visc\%Kv\_shear + +The resulting diffusivity, \f$K_d\f$, is the sum of all the contributions +unless you set BBL_MIXING_AS_MAX to True, in which case the maximum of +all the contributions is used. + +In addition, \f$K_d\f$ is multiplied by the term: + +\f[ + \frac{N^2}{N^2 + \Omega^2} +\f] + +where \f$N\f$ is the buoyancy frequency and \f$\Omega\f$ is the angular velocity +of the Earth. This allows the buoyancy fluxes to tend to zero in regions +of very weak stratification, allowing a no-flux bottom boundary condition +to be satisfied. + +\section section_Shear Shear-driven Mixing + +Below the surface mixed layer, there are places in the world's oceans +where shear mixing is known to take place. This shear-driven mixing can +be represented in MOM6 through either CVMix or the parameterization of +\cite jackson2008. + +\subsection subsection_CVMix_shear Shear-driven mixing in CVMix + +The community vertical mixing (CVMix) code contains options for shear +mixing from either \cite large1994 or from \cite pacanowski1981. In MOM6, +CVMix is included via a git submodule which loads the external CVMix +package. The shear mixing routine in CVMix was developed to reproduce the +observed mixing of the equatorial undercurrent in the Pacific. + +We first compute the gradient Richardson number \f$\mbox{Ri} = N^2 / S^2\f$, +where \f$S\f$ is the vertical shear (\f$S = ||\bf{u}_z ||\f$) and \f$N\f$ +is the buoyancy frequency (\f$N^2 = -g \rho_z / \rho_0\f$). The +parameterization of \cite large1994 is as follows, where the diffusivity \f$\kappa\f$ +is given by + +\f[ + \kappa = \kappa_0 \left[ 1 - \min \left( 1, \frac{\mbox{Ri}}{\mbox{Ri}_c} \right) ^2 \right] ^3 ,\ +\f] + +with \f$\kappa_0 = 5 \times 10^{-3}\, \mbox{m}^2 \,\mbox{s}^{-1}\f$ and \f$\mbox{Ri}_c = 0.7\f$. + +One can instead select the \cite pacanowski1981 scheme within CVMix. Unlike +the \cite large1994 scheme, they propose that the\ vertical shear +viscosity \f$\nu_{\mbox{shear}}\f$ be different from the vertical shear +diffusivity \f$\kappa_{\mbox{shear}}\f$. For gravitationally stable +profiles (i.e., \f$N^2 > 0\f$), they chose + +\f[ + \nu_{\mbox{shear}} = \frac{\nu_0}{(1 + a \mbox{Ri})^n} +\f] + +\f[ + \kappa_{\mbox{shear}} = \frac{\nu_0}{(1 + a \mbox{Ri})^{n+1}} +\f] + +where \f$\nu_0\f$, \f$a\f$ and \f$n\f$ are adjustable parameters. Common settings are \f$a = 5\f$ +and \f$n = 2\f$. + +For both CVMix shear mixing schemes, the mixing coefficients are set to +a large value for gravitationally unstable profiles. + +\subsection subsection_kappa_shear Shear-driven mixing in Jackson + +While the above parameterization works well enough in the equatorial +Pacific, another place one can expect shear-mixing to matter is +in overflows of dense water. \cite jackson2008 proposes a new shear +parameterization with the goal of working in both the equatorial undercurrent +and for overflows, also to have smooth transitions between unstable and +stable regions. Their scheme looks like: + +\f{eqnarray} + \frac{\partial^2 \kappa}{\partial z^2} - \frac{\kappa}{L^2_d} &= - 2 SF(\mbox{Ri}) . + \label{eq:Jackson_10} +\f} + +This is similar to the locally constant stratification limit of +\cite turner1986, but with the addition of a decay length scale +\f$L_d = \lambda L_b\f$. Here \f$L_b = Q^{1/2} / N\f$ is the buoyancy +length scale where \f$Q\f$ is the turbulent kinetic energy (TKE) per +unit mass, and \f$\lambda\f$ is a nondimensional constant. The function +\f$F(\mbox{Ri})\f$ is a function of the Richardson number that remains +to be determined. As in \cite turner1986, there must be a critical +value of \f$\mbox{Ri}\f$ above which \f$F(\mbox{Ri}) = 0\f$. +For better agreement with observations in a law-of-the-wall configuration, +we modify \f$L_d\f$ to be \f$\min (\lambda L_b, L_z)\f$, where \f$L_z\f$ +is the distance to the nearest solid boundary. This can be understood by +considering \f$L_d\f$ to be the size of the largest turbulent eddies, +whether they are constrained by the stratification (through \f$L_b\f$) +or through the geometry (through \f$L_z\f$). + +There are two length scales: the width of the low Richardson number region +as in \cite turner1986, and the buoyancy length scale, which is the +length scale over which the TKE is affected by the stratification (see +\cite jackson2008 for more details). In particular, the inclusion of a +decay length scale means that the diffusivity decays exponentially away +from the mixing region with a length scale of \f$L_d\f$. This is important +since turbulent eddies generated in the low \f$\mbox{Ri}\f$ layer can +be vertically self-advected and mix nearby regions. This method yields +a smoother diffusivity than that in \cite hallberg2000, especially in +areas where the Richardson number is noisy. + +This parameterization predicts the turbulent eddy diffusivity in terms +of the vertical profiles of velocity and density, providing that the +TKE is known. To complete the parameterization we use a TKE \f$Q\f$ +budget such as that used in second-order turbulence closure models +(\cite umlauf2005). We make a few additional assumptions, however, +and use the simplified form + +\f{eqnarray} + \frac{\partial}{\partial z} \left[ (\kappa + \nu_0) \frac{\partial Q} + {\partial z} \right] + \kappa (S^2 - N^2) - Q(c_N N + c_S S) &= 0. + \label{eq:Jackson_11} +\f} + +The system is therefore in balance between a vertical diffusion of +TKE caused by both the eddy and molecular viscosity \f$(\nu_0)\f$, +the production of TKE by shear, a sink due to stratification, and the +dissipation. Note that we are assuming a Prandtl number of 1, although a +parameterization for the Prandtl number could be added. We have assumed +that the TKE reaches a quasi-steady state faster than the flow is evolving +and faster than it can be affected by mean-flow advection so that \f$DQ/Dt = +0\f$. Since this parameterization is meant to be used in climate models +with low horizontal resolution and large time steps compared to the +mixing time scales, this is a reasonable assumption. The most tenuous +assumption is in the form of the dissipation \f$\epsilon = Q(C_N N + +c_S S)\f$ (where \f$c_N\f$ and \f$c_S\f$ are to be determined), +which is assumed to be dependent on the buoyancy frequency (through loss +of energy to internal waves) and the velocity shear (through the energy +cascade to smaller scales). + +We can rewrite \eqref{eq:Jackson_10} as the steady "transport" equation +for the turbulent diffusivity (i.e., with \f$D\kappa/Dt = 0\f$), + +\f[ + \frac{\partial}{\partial z} \left( \kappa \frac{\partial \kappa}{\partial z} + \right) + 2\kappa SF(\mbox{Ri}) - \left( \frac{\kappa}{L_d} \right)^2 - + \left( \frac{\partial \kappa}{\partial z} \right) ^2 = 0 . +\f] + +The first term on the left can be regarded as a vertical transport of +diffusivity, the second term as a source, and the final two as sinks. +This equation with \eqref{eq:Jackson_11} are simple enough to solve quickly +using an iterative technique. + +We also need boundary conditions for \eqref{eq:Jackson_10} +and \eqref{eq:Jackson_11}. For the turbulent diffusivity we use +\f$\kappa = 0\f$ since our diffusivity is numerically defined on +layer interfaces. This ensures that there is no turbulent flux across +boundaries. For the TKE we use boundary conditions of \f$Q = Q_0\f$ where +\f$Q_0\f$ is a constant value of TKE, used to prevent a singularity +in \eqref{eq:Jackson_10}, that is chosen to be small enough to not +influence results. Note that the value of \f$\kappa\f$ calculated here +reflects shear-driven turbulent mixing only; the total diffusivity would +be this value plus any diffusivities due to other turbulent processes +or a background value. + +Based on \cite turner1986, we choose \f$F(\mbox{Ri})\f$ of the form + +\f[ + F(\mbox{Ri}) = F_0 \left( \frac{1 - \mbox{Ri} / \mbox{Ri}_c} + {1 + \alpha \mbox{Ri} / \mbox{Ri}_c} \right) , +\f] + +where \f$\alpha\f$ is the curvature parameter. This table shows the default +values of the relevant parameters: + + + +
Shear mixing parameters
Parameter Default value MOM6 parameter +
\f$\mbox{Ri}_c\f$ 0.25 RINO_CRIT +
\f$\nu_0\f$ \f$1.5 \times 10^{-5}\f$ KD_KAPPA_SHEAR_0 +
\f$F_0\f$ 0.089 SHEARMIX_RATE +
\f$\alpha\f$ -0.97 FRI_CURVATURE +
\f$\lambda\f$ 0.82 KAPPA_BUOY_SCALE_COEF +
\f$c_N\f$ 0.24 TKE_N_DECAY_CONST +
\f$c_S\f$ 0.14 TKE_SHEAR_DECAY_CONST +
+ +These can all be adjusted at run time, plus some other parameters such as the maximum number of iterations +to perform. + +\section section_Background Background Mixing + +There are three choices for the vertical background mixing: that in +CVMix (\cite bryan1979), that in \cite harrison2008, and that in +\cite danabasoglu2012. + +\subsection subsection_bryan_lewis CVMix background mixing + +The background vertical mixing in \cite bryan1979 is of the form: + +\f[ + \kappa = C_1 + C_2 \mbox{atan} [ C_3 ( |z| - C_4 )] +\f] + +where the constants are runtime parameters as shown here: + + + +
Bryan Lewis parameters
Parameter Units MOM6 parameter +
\f$C_1\f$ m2 s-1 BRYAN_LEWIS_C1 +
\f$C_2\f$ m2 s-1 BRYAN_LEWIS_C2 +
\f$C_3\f$ m-1 BRYAN_LEWIS_C3 +
\f$C_4\f$ m BRYAN_LEWIS_C4 +
+ +\subsection subsection_henyey Henyey IGW background mixing + +\cite harrison2008 choose a vertical background mixing with a latitudinal +dependence based on \cite henyey1986. Specifically, theory predicts +a minimum in mixing due to wave-wave interactions at the equator and +observations support that theory. In this option, the surface background +diffusivity is + +\f[ + \kappa_s (\phi) = \max \left[ 10^{-7}, \kappa_0 \left| \frac{f}{f_{30}} \right| + \frac{ \cosh^{-1} (1/f) }{ \cosh^{-1} (1/f_{30})} \right] , +\f] + +where \f$f_{30}\f$ is the Coriolis frequency at \f$30^\circ\f$ latitude. The two-dimensional equation for +the diffusivity is + +\f[ + \kappa(\phi, z) = \kappa_s + \Gamma \mbox{atan} \left( \frac{H_t}{\delta_t} \right) + + \Gamma \mbox{atan} \left( \frac{z - H_t}{\delta_t} \right) , +\f] +\f[ + \Gamma = \frac{(\kappa_d - \kappa_s) }{\left[ 0.5 \pi + \mbox{atan} \left( \frac{H_t}{\delta_t} \right) + \right] }, +\f] + +where \f$H_t = 2500\, \mbox{m}\f$, \f$\delta_t = 222\, \mbox{m}\f$, and +\f$\kappa_d\f$ is the deep ocean diffusivity of \f$10^{-4}\, \mbox{m}^2 +\, \mbox{s}^{-1}\f$. Note that this is the vertical structure described +in \cite harrison2008, but that isn't what is in the code. Instead, the surface +value is propagated down, with the assumption that the tidal mixing parameterization +will provide the deep mixing: \ref Internal_Tidal_Mixing. + +There is also a "new" Henyey version, taking into account the effect of stratification on +TKE dissipation, + +\f[ + \epsilon = \epsilon_0 \frac{f}{f_0} \frac{\mbox{acosh} (N/f)}{\mbox{acosh} (N_0 / f_0)} +\f] + +where \f$N_0\f$ and \f$f_0\f$ are the reference buoyancy frequency and inertial frequencies, respectively +and \f$\epsilon_0\f$ is the reference dissipation at \f$(N_0, f_0)\f$. In the previous version, \f$N = +N_0\f$. Additionally, the relationship between diapycnal diffusivities and stratification is included: + +\f[ + \kappa = \frac{\epsilon}{N^2} +\f] +This approach assumes that work done against gravity is uniformly distributed throughout the water column. +The original version concentrates buoyancy work in regions of strong stratification. + +\subsection subsection_danabasoglu_back Danabasoglu background mixing + +The shape of the \cite danabasoglu2012 background mixing has a uniform background value, with a dip +at the equator and a bump at \f$\pm 30^{\circ}\f$ degrees latitude. The form is shown in this figure + +\image html background_varying.png "Form of the vertically uniform background mixing in \cite danabasoglu2012. The values are symmetric about the equator." +\imagelatex{background_varying.png,Form of the vertically uniform background mixing in \cite danabasoglu2012. The values are symmetric about the equator.,\includegraphics[width=\textwidth\,height=\textheight/2\,keepaspectratio=true]} + +Some parameters of this curve are set in the input file, some are hard-coded in calculate_bkgnd_mixing. + +\section section_Double_Diff Double Diffusion + +*/ diff --git a/src/parameterizations/vertical/_V_viscosity.dox b/src/parameterizations/vertical/_V_viscosity.dox new file mode 100644 index 0000000000..cc59e83457 --- /dev/null +++ b/src/parameterizations/vertical/_V_viscosity.dox @@ -0,0 +1,64 @@ +/*! \page Vertical_Viscosity Viscous Bottom Boundary Layer + +A drag law is used, either linearized about an assumed bottom velocity or using the +actual near-bottom velocities combined with an assumed unresolved velocity. The bottom +boundary layer thickness is limited by a combination of stratification and rotation, as +in the paper of \cite killworth1999. It is not necessary to calculate the +thickness and viscosity every time step; instead previous values may be used. + +\section set_viscous_BBL Viscous Bottom Boundary Layer + +If set_visc_CS\%bottomdraglaw is True then a bottom boundary layer viscosity and thickness +are calculated so that the bottom stress is +\f[ +\mathbf{\tau}_b = C_d | U_{bbl} | \mathbf{u}_{bbl} +\f] +If set_visc_CS\%bottomdraglaw is True then the term \f$|U_{bbl}|\f$ is set equal to the +value in set_visc_CS.drag_bg_vel so that \f$C_d |U_{bbl}|\f$ becomes a Rayleigh bottom drag. +Otherwise \f$|U_{bbl}|\f$ is found by averaging the flow over the bottom set_visc_CS\%hbbl +of the model, adding the amplitude of tides set_visc_CS\%tideamp and a constant +set_visc_CS\%drag_bg_vel. For these calculations the vertical grid at the velocity +component locations is found by +\f[ +\begin{array}{ll} +\frac{2 h^- h^+}{h^- + h^+} & u \left( h^+ - h^-\right) >= 0 +\\ +\frac{1}{2} \left( h^- + h^+ \right) & u \left( h^+ - h^-\right) < 0 +\end{array} +\f] +which biases towards the thin cell if the thin cell is upwind. Biasing the grid toward +thin upwind cells helps increase the effect of viscosity and inhibits flow out of these +thin cells. + +After diagnosing \f$|U_{bbl}|\f$ over a fixed depth an active viscous boundary layer +thickness is found using the ideas of Killworth and Edwards, 1999 (hereafter KW99). +KW99 solve the equation +\f[ +\left( \frac{h_{bbl}}{h_f} \right)^2 + \frac{h_{bbl}}{h_N} = 1 +\f] +for the boundary layer depth \f$h_{bbl}\f$. Here +\f[ +h_f = \frac{C_n u_*}{f} +\f] +is the rotation controlled boundary layer depth in the absence of stratification. +\f$u_*\f$ is the surface friction speed given by +\f[ +u_*^2 = C_d |U_{bbl}|^2 +\f] +and is a function of near bottom model flow. +\f[ +h_N = \frac{C_i u_*}{N} = \frac{ (C_i u_* )^2 }{g^\prime} +\f] +is the stratification controlled boundary layer depth. The non-dimensional parameters +\f$C_n=0.5\f$ and \f$C_i=20\f$ are suggested by \cite zilitinkevich1996. + +If a Richardson number dependent mixing scheme is being used, as indicated by +set_visc_CS\%rino_mix, then the boundary layer thickness is bounded to be no larger +than a half of set_visc_CS\%hbbl . + +\todo Channel drag needs to be explained + +A BBL viscosity is calculated so that the no-slip boundary condition in the vertical +viscosity solver implies the stress \f$\mathbf{\tau}_b\f$. + +*/ diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index ad0a997cc4..7fb71f9773 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -137,8 +137,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, GV, US, missing_val, land_va do i=is,ie ; if (G%mask2dT(i,j)*htot(i) > 0.0) then ! Determine the z* heights of the model interfaces. - dilate = (G%bathyT(i,j) - 0.0) / htot(i) - e(nz+1) = -G%bathyT(i,j) + dilate = (G%bathyT(i,j) + G%Z_ref) / htot(i) + e(nz+1) = -G%bathyT(i,j) - G%Z_ref do k=nz,1,-1 ; e(K) = e(K+1) + dilate * h(i,j,k) ; enddo ! Create a single-column copy of tr_in. Efficiency is not an issue here. @@ -212,8 +212,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, GV, US, missing_val, land_va do i=is,ie ; if (G%mask2dT(i,j)*htot(i) > 0.0) then ! Determine the z* heights of the model interfaces. - dilate = (G%bathyT(i,j) - 0.0) / htot(i) - e(nz+1) = -G%bathyT(i,j) + dilate = (G%bathyT(i,j) + G%Z_ref) / htot(i) + e(nz+1) = -G%bathyT(i,j) - G%Z_ref do k=nz,1,-1 ; e(K) = e(K+1) + dilate * h(i,j,k) ; enddo ! Create a single-column copy of tr_in. Efficiency is not an issue here. diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 26ef197ae2..60ff9c981c 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -62,6 +62,8 @@ module MOM_tracer_flow_control 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 @@ -84,6 +86,7 @@ module MOM_tracer_flow_control 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 ideal age 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() @@ -98,6 +101,7 @@ module MOM_tracer_flow_control 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 @@ -206,6 +210,9 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) 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 @@ -249,7 +256,8 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) if (CS%use_dyed_obc_tracer) CS%use_dyed_obc_tracer = & register_dyed_obc_tracer(HI, GV, param_file, CS%dyed_obc_tracer_CSp, & tr_Reg, restart_CS) - + if (CS%use_nw2_tracers) CS%use_ideal_age = & + register_nw2_tracers(HI, GV, param_file, CS%nw2_tracers_CSp, tr_Reg, restart_CS) end subroutine call_tracer_register @@ -328,6 +336,8 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag 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 @@ -486,8 +496,11 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, 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, & @@ -532,10 +545,10 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, 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 @@ -776,6 +789,7 @@ subroutine tracer_flow_control_end(CS) 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 diff --git a/src/tracer/nw2_tracers.F90 b/src/tracer/nw2_tracers.F90 new file mode 100644 index 0000000000..e75c5c5d38 --- /dev/null +++ b/src/tracer/nw2_tracers.F90 @@ -0,0 +1,314 @@ +!> Ideal tracers designed to help diagnose a tracer diffusivity tensor in NeverWorld2 +module nw2_tracers + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : diag_ctrl +use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing +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, vardesc, var_desc +use MOM_restart, only : query_initialized, MOM_restart_CS +use MOM_time_manager, only : time_type, time_type_to_real +use MOM_tracer_registry, only : register_tracer, tracer_registry_type +use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut +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 + +#include + +public register_nw2_tracers +public initialize_nw2_tracers +public nw2_tracer_column_physics +public nw2_tracers_end + +!> The control structure for the nw2_tracers package +type, public :: nw2_tracers_CS ; private + integer :: ntr = 0 !< The number of tracers that are actually used. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package, in g m-3? + real, allocatable , dimension(:) :: restore_rate !< The exponential growth rate for restoration value [year-1]. + 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() !< A pointer to the restart controls structure +end type nw2_tracers_CS + +contains + +!> Register the NW2 tracer fields to be used with MOM. +logical function register_nw2_tracers(HI, GV, param_file, CS, tr_Reg, restart_CS) + type(hor_index_type), intent(in) :: HI !< A horizontal index type 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(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_nw2_tracer. + 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), pointer :: 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 = "nw2_tracers" ! This module's name. + character(len=200) :: inputdir ! The directory where the input files are. + character(len=8) :: var_name ! The variable's name. + real, pointer :: tr_ptr(:,:,:) => NULL() + logical :: do_nw2 + integer :: isd, ied, jsd, jed, nz, m, ig + integer :: n_groups ! Number of groups of three tracers (i.e. # tracers/3) + real, allocatable, dimension(:) :: timescale_in_days + type(vardesc) :: tr_desc ! Descriptions and metadata for the tracers + isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke + + if (associated(CS)) then + call MOM_error(FATAL, "register_nw2_tracer called with an "// & + "associated control structure.") + return + endif + allocate(CS) + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "NW2_TRACER_GROUPS", n_groups, & + "The number of tracer groups where a group is of three tracers "//& + "initialized and restored to sin(x), y and z, respectively. Each "//& + "group is restored with an independent restoration rate.", & + default=3) + allocate(timescale_in_days(n_groups)) + timescale_in_days = (/365., 730., 1460./) + call get_param(param_file, mdl, "NW2_TRACER_RESTORE_TIMESCALE", timescale_in_days, & + "A list of timescales, one for each tracer group.", & + units="days") + + CS%ntr = 3 * n_groups + allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%restore_rate(CS%ntr)) + + do m=1,CS%ntr + write(var_name(1:8),'(a6,i2.2)') 'tracer',m + tr_desc = var_desc(var_name, "1", "Ideal Tracer", caller=mdl) + ! This is needed to force the compiler not to do a copy in the registration + ! calls. Curses on the designers and implementers of Fortran90. + tr_ptr => CS%tr(:,:,:,m) + ! Register the tracer for horizontal advection, diffusion, and restarts. + call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, tr_desc=tr_desc, & + registry_diags=.true., restart_CS=restart_CS, mandatory=.false.) + ig = int( (m+2)/3 ) ! maps (1,2,3)->1, (4,5,6)->2, ... + CS%restore_rate(m) = 1.0 / ( timescale_in_days(ig) * 86400.0 ) + enddo + + CS%tr_Reg => tr_Reg + CS%restart_CSp => restart_CS + register_nw2_tracers = .true. +end function register_nw2_tracers + +!> Sets the NW2 traces to their initial values and sets up the tracer output +subroutine initialize_nw2_tracers(restart, day, G, GV, US, h, tv, diag, CS) + 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(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 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate + !! diagnostic output. + type(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_nw2_tracer. + ! Local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights + real :: rscl ! z* scaling factor + character(len=8) :: var_name ! The variable's name. + integer :: i, j, k, m + + if (.not.associated(CS)) return + + CS%Time => day + CS%diag => diag + + ! Calculate z* interface positions + if (GV%Boussinesq) then + ! First calculate interface positions in z-space (m) + do j=G%jsc,G%jec ; do i=G%isc,G%iec + eta(i,j,GV%ke+1) = - G%mask2dT(i,j) * G%bathyT(i,j) + enddo ; enddo + do k=GV%ke,1,-1 ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h(i,j,k) * GV%H_to_Z + enddo ; enddo ; enddo + ! Re-calculate for interface positions in z*-space (m) + do j=G%jsc,G%jec ; do i=G%isc,G%iec + if (G%bathyT(i,j)>0.) then + rscl = G%bathyT(i,j) / ( eta(i,j,1) + G%bathyT(i,j) ) + do K=GV%ke, 1, -1 + eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h(i,j,k) * GV%H_to_Z * rscl + enddo + endif + enddo ; enddo + else + call MOM_error(FATAL, "NW2 tracers assume Boussinesq mode") + endif + + do m=1,CS%ntr + ! Initialize only if this is not a restart or we are using a restart + ! in which the tracers were not present + write(var_name(1:8),'(a6,i2.2)') 'tracer',m + if ((.not.restart) .or. & + (.not. query_initialized(CS%tr(:,:,:,m),var_name,CS%restart_CSp))) then + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + CS%tr(i,j,k,m) = nw2_tracer_dist(m, G, GV, eta, i, j, k) + enddo ; enddo ; enddo + endif ! restart + enddo ! Tracer loop + +end subroutine initialize_nw2_tracers + +!> Applies diapycnal diffusion, aging and regeneration at the surface to the NW2 tracers +subroutine nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, tv, CS, & + 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_(G)), & + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + 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_(G)), & + 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 thermodynamic + !! and tracer forcing fields. Unused fields have NULL ptrs. + 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(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_nw2_tracer. + 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] +! This subroutine applies diapycnal diffusion and any other column +! tracer physics or chemistry to the tracers from this file. +! This is a simple example of a set of advected passive tracers. + +! 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 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights + integer :: i, j, k, m + real :: dt_x_rate ! dt * restoring rate + real :: rscl ! z* scaling factor + real :: target_value ! tracer value + +! if (.not.associated(CS)) return + + if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then + do m=1,CS%ntr + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + h_work(i,j,k) = h_old(i,j,k) + enddo ; enddo ; enddo + call applyTracerBoundaryFluxesInOut(G, GV, CS%tr(:,:,:,m), dt, fluxes, h_work, & + evap_CFL_limit, minimum_forcing_depth) + call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,m), G, GV) + enddo + else + do m=1,CS%ntr + call tracer_vertdiff(h_old, ea, eb, dt, CS%tr(:,:,:,m), G, GV) + enddo + endif + + ! Calculate z* interface positions + if (GV%Boussinesq) then + ! First calculate interface positions in z-space (m) + do j=G%jsc,G%jec ; do i=G%isc,G%iec + eta(i,j,GV%ke+1) = - G%mask2dT(i,j) * G%bathyT(i,j) + enddo ; enddo + do k=GV%ke,1,-1 ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h_new(i,j,k) * GV%H_to_Z + enddo ; enddo ; enddo + ! Re-calculate for interface positions in z*-space (m) + do j=G%jsc,G%jec ; do i=G%isc,G%iec + if (G%bathyT(i,j)>0.) then + rscl = G%bathyT(i,j) / ( eta(i,j,1) + G%bathyT(i,j) ) + do K=GV%ke, 1, -1 + eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h_new(i,j,k) * GV%H_to_Z * rscl + enddo + endif + enddo ; enddo + else + call MOM_error(FATAL, "NW2 tracers assume Boussinesq mode") + endif + + do m=1,CS%ntr + dt_x_rate = ( dt * CS%restore_rate(m) ) * US%T_to_s +!$OMP parallel do default(private) shared(CS,G,dt,dt_x_rate) + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + target_value = nw2_tracer_dist(m, G, GV, eta, i, j, k) + CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + G%mask2dT(i,j) * dt_x_rate * ( target_value - CS%tr(i,j,k,m) ) + enddo ; enddo ; enddo + enddo + +end subroutine nw2_tracer_column_physics + +!> The target value of a NeverWorld2 tracer label m at non-dimensional +!! position x=lon/Lx, y=lat/Ly, z=eta/H +real function nw2_tracer_dist(m, G, GV, eta, i, j, k) + integer, intent(in) :: m !< Indicates the NW2 tracer + 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),0:SZK_(G)), & + intent(in) :: eta !< Interface position [m] + integer, intent(in) :: i !< Cell index i + integer, intent(in) :: j !< Cell index j + integer, intent(in) :: k !< Layer index k + ! Local variables + real :: pi ! 3.1415... + real :: x, y, z ! non-dimensional positions + pi = 2.*acos(0.) + x = ( G%geolonT(i,j) - G%west_lon ) / G%len_lon ! 0 ... 1 + y = -G%geolatT(i,j) / G%south_lat ! -1 ... 1 + z = - 0.5 * ( eta(i,j,K-1) + eta(i,j,K) ) / GV%max_depth ! 0 ... 1 + select case ( mod(m-1,3) ) + case (0) ! sin(2 pi x/L) + nw2_tracer_dist = sin( 2.0 * pi * x ) + case (1) ! y/L + nw2_tracer_dist = y + case (2) ! -z/L + nw2_tracer_dist = -z + case default + stop 'This should not happen. Died in nw2_tracer_dist()!' + end select + nw2_tracer_dist = nw2_tracer_dist * G%mask2dT(i,j) +end function nw2_tracer_dist + +!> Deallocate any memory associated with this tracer package +subroutine nw2_tracers_end(CS) + type(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_nw2_tracers. + + integer :: m + + if (associated(CS)) then + if (associated(CS%tr)) deallocate(CS%tr) + deallocate(CS) + endif +end subroutine nw2_tracers_end + +!> \namespace nw2_tracers +!! +!! TBD + +end module nw2_tracers