Merge branch 'MOM_wave_rescale' into MOM_wave_control

config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90

@@ -27,7 +27,8 @@ module MOM_surface_forcing_gfdl
 use MOM_grid,             only : ocean_grid_type
 use MOM_interpolate,      only : init_external_field, time_interp_external
 use MOM_interpolate,      only : time_interp_external_init
-use MOM_io,               only : slasher, write_version_number, MOM_read_data, stdout
+use MOM_io,               only : slasher, write_version_number, MOM_read_data
+use MOM_io,               only : stdout_if_root
 use MOM_restart,          only : register_restart_field, restart_init, MOM_restart_CS
 use MOM_restart,          only : restart_init_end, save_restart, restore_state
 use MOM_string_functions, only : uppercase
@@ -1628,8 +1629,8 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt)
   logical :: root    ! True only on the root PE
   integer :: outunit ! The output unit to write to
 
-  outunit = stdout
   root = is_root_pe()
+  outunit = stdout_if_root()
 
   if (root) write(outunit,*) "BEGIN CHECKSUM(ice_ocean_boundary_type):: ", id, timestep
   chks = field_chksum( iobt%u_flux         ) ; if (root) write(outunit,100) 'iobt%u_flux         ', chks

config_src/drivers/FMS_cap/ocean_model_MOM.F90

@@ -35,7 +35,7 @@ module ocean_model_mod
 use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags
 use MOM_get_input, only : Get_MOM_Input, directories
 use MOM_grid, only : ocean_grid_type
-use MOM_io, only : write_version_number, stdout
+use MOM_io, only : write_version_number, stdout_if_root
 use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS
 use MOM_restart, only : MOM_restart_CS, save_restart
 use MOM_string_functions, only : uppercase
@@ -1105,8 +1105,8 @@ subroutine ocean_public_type_chksum(id, timestep, ocn)
   logical :: root    ! True only on the root PE
   integer :: outunit ! The output unit to write to
 
-  outunit = stdout
   root = is_root_pe()
+  outunit = stdout_if_root()
 
   if (root) write(outunit,*) "BEGIN CHECKSUM(ocean_type):: ", id, timestep
   chks = field_chksum(ocn%t_surf ) ; if (root) write(outunit,100) 'ocean%t_surf   ', chks

config_src/infra/FMS1/MOM_io_infra.F90

@@ -17,6 +17,7 @@ module MOM_io_infra
 use mpp_io_mod,           only : mpp_get_fields, fieldtype
 use mpp_io_mod,           only : mpp_get_info, mpp_get_times
 use mpp_io_mod,           only : mpp_io_init
+use mpp_mod,              only : stdout_if_root=>stdout
 ! These are encoding constants.
 use mpp_io_mod,           only : APPEND_FILE=>MPP_APPEND, WRITEONLY_FILE=>MPP_WRONLY
 use mpp_io_mod,           only : OVERWRITE_FILE=>MPP_OVERWR, READONLY_FILE=>MPP_RDONLY
@@ -33,6 +34,7 @@ module MOM_io_infra
 public :: MOM_read_data, MOM_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
 ! These types are inherited from underlying infrastructure code, to act as containers for
 ! information about fields and axes, respectively, and are opaque to this module.
 public :: fieldtype, axistype

config_src/infra/FMS2/MOM_io_infra.F90

@@ -29,6 +29,7 @@ module MOM_io_infra
 use mpp_io_mod,           only : mpp_get_fields, mpp_fieldtype=>fieldtype
 use mpp_io_mod,           only : mpp_get_info, mpp_get_times
 use mpp_io_mod,           only : mpp_io_init
+use mpp_mod,              only : stdout_if_root=>stdout
 ! These are encoding constants.
 use mpp_io_mod,           only : APPEND_FILE=>MPP_APPEND, WRITEONLY_FILE=>MPP_WRONLY
 use mpp_io_mod,           only : OVERWRITE_FILE=>MPP_OVERWR, READONLY_FILE=>MPP_RDONLY
@@ -44,6 +45,7 @@ module MOM_io_infra
 public :: MOM_read_data, MOM_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
 ! These types act as containers for information about files, fields and axes, respectively,
 ! and may also wrap opaque types from the underlying infrastructure.
 public :: file_type, fieldtype, axistype

src/diagnostics/MOM_sum_output.F90

@@ -4,31 +4,30 @@ module MOM_sum_output
 ! This file is part of MOM6. See LICENSE.md for the license.
 
 use iso_fortran_env, only : int64
-use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs, field_chksum
-use MOM_coms, only : reproducing_sum, reproducing_sum_EFP, EFP_to_real, real_to_EFP
-use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=), EFP_sum_across_PEs
+use MOM_coms,          only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs, field_chksum
+use MOM_coms,          only : reproducing_sum, reproducing_sum_EFP, EFP_to_real, real_to_EFP
+use MOM_coms,          only : EFP_type, operator(+), operator(-), assignment(=), EFP_sum_across_PEs
 use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe, MOM_mesg
-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_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_interface_heights, only : find_eta
-use MOM_io, only : create_file, file_type, fieldtype, flush_file, reopen_file
-use MOM_io, only : file_exists, slasher, vardesc, var_desc, write_field, get_filename_appendix
-use MOM_io, only : field_size, read_variable, read_attribute, open_ASCII_file, stdout
-use MOM_io, only : APPEND_FILE, SINGLE_FILE, WRITEONLY_FILE
+use MOM_io,            only : create_file, file_type, fieldtype, flush_file, reopen_file, close_file
+use MOM_io,            only : file_exists, slasher, vardesc, var_desc, write_field, MOM_write_field
+use MOM_io,            only : field_size, read_variable, read_attribute, open_ASCII_file, stdout
+use MOM_io,            only : axis_info, set_axis_info, delete_axis_info, get_filename_appendix
+use MOM_io,            only : attribute_info, set_attribute_info, delete_attribute_info
+use MOM_io,            only : APPEND_FILE, SINGLE_FILE, WRITEONLY_FILE
 use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_type
 use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S
-use MOM_time_manager, only : time_type, get_time, get_date, set_time, operator(>)
-use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/)
-use MOM_time_manager, only : operator(/=), operator(<=), operator(>=), operator(<)
-use MOM_time_manager, only : get_calendar_type, time_type_to_real, NO_CALENDAR
+use MOM_time_manager,  only : time_type, get_time, get_date, set_time, operator(>)
+use MOM_time_manager,  only : operator(+), operator(-), operator(*), operator(/)
+use MOM_time_manager,  only : operator(/=), operator(<=), operator(>=), operator(<)
+use MOM_time_manager,  only : get_calendar_type, time_type_to_real, NO_CALENDAR
 use MOM_tracer_flow_control, only : tracer_flow_control_CS, call_tracer_stocks
-use MOM_unit_scaling, only : unit_scale_type
-use MOM_variables, only : surface, thermo_var_ptrs
-use MOM_verticalGrid, only : verticalGrid_type
-
-use netcdf, only : NF90_create, NF90_def_dim, NF90_def_var, NF90_enddef, NF90_put_att, NF90_put_var
-use netcdf, only : NF90_close, NF90_strerror, NF90_DOUBLE, NF90_NOERR, NF90_GLOBAL
+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
 
@@ -1265,88 +1264,44 @@ subroutine write_depth_list(G, US, DL, filename)
   character(len=*),      intent(in) :: filename !< The path to the depth list file to write.
 
   ! Local variables
-  real, allocatable :: tmp(:)
-  integer :: ncid, dimid(1), Did, Aid, Vid, status, k
+  type(vardesc), dimension(:), allocatable :: &
+    vars          ! Types that described the staggering and metadata for the fields
+  type(fieldtype), dimension(:), allocatable :: &
+    fields        ! Types with metadata about the variables that will be written
+  type(axis_info), dimension(:), allocatable :: &
+    extra_axes    ! Descriptors for extra axes that might be used
+  type(attribute_info), dimension(:), allocatable :: &
+    global_atts   ! Global attributes and their values
+  type(file_type)   :: IO_handle     ! The I/O handle of the fileset
   character(len=16) :: depth_chksum, area_chksum
 
   ! All ranks are required to compute the global checksum
   call get_depth_list_checksums(G, depth_chksum, area_chksum)
 
   if (.not.is_root_pe()) return
 
-  allocate(tmp(DL%listsize)) ; tmp(:) = 0.0
-
-  status = NF90_CREATE(filename, 0, ncid)
-  if (status /= NF90_NOERR) then
-    call MOM_error(WARNING, trim(filename)//trim(NF90_STRERROR(status)))
-    return
-  endif
-
-  status = NF90_DEF_DIM(ncid, "list", DL%listsize, dimid(1))
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//trim(NF90_STRERROR(status)))
-
-  status = NF90_DEF_VAR(ncid, "depth", NF90_DOUBLE, dimid, Did)
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//" depth "//trim(NF90_STRERROR(status)))
-  status = NF90_PUT_ATT(ncid, Did, "long_name", "Sorted depth")
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//" depth "//trim(NF90_STRERROR(status)))
-  status = NF90_PUT_ATT(ncid, Did, "units", "m")
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//" depth "//trim(NF90_STRERROR(status)))
-
-  status = NF90_DEF_VAR(ncid, "area", NF90_DOUBLE, dimid, Aid)
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//" area "//trim(NF90_STRERROR(status)))
-  status = NF90_PUT_ATT(ncid, Aid, "long_name", "Open area at depth")
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//" area "//trim(NF90_STRERROR(status)))
-  status = NF90_PUT_ATT(ncid, Aid, "units", "m2")
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//" area "//trim(NF90_STRERROR(status)))
-
-  status = NF90_DEF_VAR(ncid, "vol_below", NF90_DOUBLE, dimid, Vid)
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//" vol_below "//trim(NF90_STRERROR(status)))
-  status = NF90_PUT_ATT(ncid, Vid, "long_name", "Open volume below depth")
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//" vol_below "//trim(NF90_STRERROR(status)))
-  status = NF90_PUT_ATT(ncid, Vid, "units", "m3")
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//" vol_below "//trim(NF90_STRERROR(status)))
-
-  ! Dependency checksums
-  status = NF90_PUT_ATT(ncid, NF90_GLOBAL, depth_chksum_attr, depth_chksum)
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//" "//depth_chksum_attr//" "//trim(NF90_STRERROR(status)))
-
-  status = NF90_PUT_ATT(ncid, NF90_GLOBAL, area_chksum_attr, area_chksum)
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//" "//area_chksum_attr//" "//trim(NF90_STRERROR(status)))
-
-  status = NF90_ENDDEF(ncid)
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//trim(NF90_STRERROR(status)))
-
-  do k=1,DL%listsize ; tmp(k) = US%Z_to_m*DL%depth(k) ; enddo
-  status = NF90_PUT_VAR(ncid, Did, tmp)
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//" depth "//trim(NF90_STRERROR(status)))
-
-  do k=1,DL%listsize ; tmp(k) = US%L_to_m**2*DL%area(k) ; enddo
-  status = NF90_PUT_VAR(ncid, Aid, tmp)
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//" area "//trim(NF90_STRERROR(status)))
-
-  do k=1,DL%listsize ; tmp(k) = US%Z_to_m*US%L_to_m**2*DL%vol_below(k) ; enddo
-  status = NF90_PUT_VAR(ncid, Vid, tmp)
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//" vol_below "//trim(NF90_STRERROR(status)))
-
-  status = NF90_CLOSE(ncid)
-  if (status /= NF90_NOERR) call MOM_error(WARNING, &
-      trim(filename)//trim(NF90_STRERROR(status)))
+  allocate(vars(3))
+  allocate(fields(3))
+  allocate(extra_axes(1))
+  allocate(global_atts(2))
+
+  call set_axis_info(extra_axes(1), "list", ax_size=DL%listsize)
+  vars(1) = var_desc("depth", "m", "Sorted depth", '1', dim_names=(/"list"/), fixed=.true.)
+  vars(2) = var_desc("area", "m2", "Open area at depth", '1', dim_names=(/"list"/), fixed=.true.)
+  vars(3) = var_desc("vol_below", "m3", "Open volume below depth", '1', dim_names=(/"list"/), fixed=.true.)
+  call set_attribute_info(global_atts(1), depth_chksum_attr, depth_chksum)
+  call set_attribute_info(global_atts(2), area_chksum_attr, area_chksum)
+
+  call create_file(IO_handle, filename, vars, 3, fields, SINGLE_FILE, extra_axes=extra_axes, &
+                   global_atts=global_atts)
+  call MOM_write_field(IO_handle, fields(1), DL%depth, scale=US%Z_to_m)
+  call MOM_write_field(IO_handle, fields(2), DL%area, scale=US%L_to_m**2)
+  call MOM_write_field(IO_handle, fields(3), DL%vol_below, scale=US%Z_to_m*US%L_to_m**2)
+
+  call delete_axis_info(extra_axes)
+  call delete_attribute_info(global_atts)
+  deallocate(vars, extra_axes, fields, global_atts)
+  call close_file(IO_handle)
 
 end subroutine write_depth_list
 

src/framework/MOM_diag_mediator.F90

@@ -1051,6 +1051,7 @@ subroutine define_axes_group(diag_cs, handles, axes, nz, vertical_coordinate_num
   else
     axes%v_cell_method = ''
   endif
+
   if (present(nz)) axes%nz = nz
   if (present(vertical_coordinate_number)) axes%vertical_coordinate_number = vertical_coordinate_number
   if (present(is_h_point)) axes%is_h_point = is_h_point
@@ -1971,38 +1972,45 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time
   type(diag_ctrl), pointer :: diag_cs => NULL()
   type(axes_grp), pointer :: remap_axes => null()
   type(axes_grp), pointer :: axes => null()
+  type(axes_grp), pointer :: axes_d2 => null()
   integer :: dm_id, i, dl
   character(len=256) :: msg, cm_string
   character(len=256) :: new_module_name
   character(len=480) :: module_list, var_list
   integer :: num_modnm, num_varnm
   logical :: active
 
-  axes => axes_in
-  MOM_missing_value = axes%diag_cs%missing_value
-  if (present(missing_value)) MOM_missing_value = missing_value
-
-  diag_cs => axes%diag_cs
-  dm_id = -1
+  diag_cs => axes_in%diag_cs
 
+  ! Check if the axes match a standard grid axis.
+  ! If not, allocate the new axis and copy the contents.
   if (axes_in%id == diag_cs%axesTL%id) then
     axes => diag_cs%axesTL
   elseif (axes_in%id == diag_cs%axesBL%id) then
     axes => diag_cs%axesBL
-  elseif (axes_in%id == diag_cs%axesCuL%id ) then
+  elseif (axes_in%id == diag_cs%axesCuL%id) then
     axes => diag_cs%axesCuL
   elseif (axes_in%id == diag_cs%axesCvL%id) then
     axes => diag_cs%axesCvL
   elseif (axes_in%id == diag_cs%axesTi%id) then
     axes => diag_cs%axesTi
   elseif (axes_in%id == diag_cs%axesBi%id) then
     axes => diag_cs%axesBi
-  elseif (axes_in%id == diag_cs%axesCui%id ) then
+  elseif (axes_in%id == diag_cs%axesCui%id) then
     axes => diag_cs%axesCui
   elseif (axes_in%id == diag_cs%axesCvi%id) then
     axes => diag_cs%axesCvi
+  else
+    allocate(axes)
+    axes = axes_in
   endif
 
+  MOM_missing_value = axes%diag_cs%missing_value
+  if (present(missing_value)) MOM_missing_value = missing_value
+
+  diag_cs => axes%diag_cs
+  dm_id = -1
+
   module_list = "{"//trim(module_name)
   num_modnm = 1
 
@@ -2090,40 +2098,40 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time
     new_module_name = trim(module_name)//'_d2'
 
     if (axes_in%rank == 3 .or. axes_in%rank == 2 ) then
-      axes => null()
+      axes_d2 => null()
       if (axes_in%id == diag_cs%axesTL%id) then
-        axes => diag_cs%dsamp(dl)%axesTL
+        axes_d2 => diag_cs%dsamp(dl)%axesTL
       elseif (axes_in%id == diag_cs%axesBL%id) then
-        axes => diag_cs%dsamp(dl)%axesBL
+        axes_d2 => diag_cs%dsamp(dl)%axesBL
       elseif (axes_in%id == diag_cs%axesCuL%id ) then
-        axes => diag_cs%dsamp(dl)%axesCuL
+        axes_d2 => diag_cs%dsamp(dl)%axesCuL
       elseif (axes_in%id == diag_cs%axesCvL%id) then
-        axes => diag_cs%dsamp(dl)%axesCvL
+        axes_d2 => diag_cs%dsamp(dl)%axesCvL
       elseif (axes_in%id == diag_cs%axesTi%id) then
-        axes => diag_cs%dsamp(dl)%axesTi
+        axes_d2 => diag_cs%dsamp(dl)%axesTi
       elseif (axes_in%id == diag_cs%axesBi%id) then
-        axes => diag_cs%dsamp(dl)%axesBi
+        axes_d2 => diag_cs%dsamp(dl)%axesBi
       elseif (axes_in%id == diag_cs%axesCui%id ) then
-        axes => diag_cs%dsamp(dl)%axesCui
+        axes_d2 => diag_cs%dsamp(dl)%axesCui
       elseif (axes_in%id == diag_cs%axesCvi%id) then
-        axes => diag_cs%dsamp(dl)%axesCvi
+        axes_d2 => diag_cs%dsamp(dl)%axesCvi
       elseif (axes_in%id == diag_cs%axesT1%id) then
-        axes => diag_cs%dsamp(dl)%axesT1
+        axes_d2 => diag_cs%dsamp(dl)%axesT1
       elseif (axes_in%id == diag_cs%axesB1%id) then
-        axes => diag_cs%dsamp(dl)%axesB1
+        axes_d2 => diag_cs%dsamp(dl)%axesB1
       elseif (axes_in%id == diag_cs%axesCu1%id ) then
-        axes => diag_cs%dsamp(dl)%axesCu1
+        axes_d2 => diag_cs%dsamp(dl)%axesCu1
       elseif (axes_in%id == diag_cs%axesCv1%id) then
-        axes => diag_cs%dsamp(dl)%axesCv1
+        axes_d2 => diag_cs%dsamp(dl)%axesCv1
       else
         !Niki: Should we worry about these, e.g., diag_to_Z_CS?
         call MOM_error(WARNING,"register_diag_field: Could not find a proper axes for " &
               //trim(new_module_name)//"-"//trim(field_name))
       endif
     endif
     ! Register the native diagnostic
-    if (associated(axes)) then
-       active = register_diag_field_expand_cmor(dm_id, new_module_name, field_name, axes, &
+    if (associated(axes_d2)) then
+       active = register_diag_field_expand_cmor(dm_id, new_module_name, field_name, axes_d2, &
                 init_time, long_name=long_name, units=units, missing_value=MOM_missing_value, &
                 range=range, mask_variant=mask_variant, standard_name=standard_name, &
                 verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, &
@@ -2196,7 +2204,7 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time
                              v_extensive=v_extensive)
     module_list = trim(module_list)//"}"
     if (num_modnm <= 1) module_list = module_name
-    if (num_varnm <= 1) var_list = ""
+    if (num_varnm <= 1) var_list = ''
 
     call log_available_diag(dm_id>0, module_list, field_name, cm_string, msg, diag_CS, &
                             long_name, units, standard_name, variants=var_list)
@@ -2216,7 +2224,7 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name,
   integer,          intent(inout) :: dm_id !< The diag_mediator ID for this diagnostic group
   character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model"
   character(len=*), intent(in) :: field_name !< Name of the diagnostic field
-  type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes
+  type(axes_grp),   intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes
                                              !! for this field
   type(time_type),  intent(in) :: init_time !< Time at which a field is first available?
   character(len=*), optional, intent(in) :: long_name !< Long name of a field.