From 7091a09c1c0f77e86efdaf08b928d210400dc6dd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 8 Jan 2021 10:42:56 -0500 Subject: [PATCH] +Add MOM_write_field Moved rotated_write_field from MOM_transform_FMS.F90 to MOM_io.F90 and renamed it to MOM_write_field, with the mpp_domain argument replaced with a MOM_domain argument. Also changed the calls in save_restart to reflect these changes. All answers and output files are identical. --- src/framework/MOM_io.F90 | 144 ++++++++++++++++++++++++--- src/framework/MOM_restart.F90 | 45 +++++---- src/framework/MOM_transform_FMS.F90 | 148 +--------------------------- 3 files changed, 156 insertions(+), 181 deletions(-) diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 529c725274..eda00bfda0 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -3,13 +3,13 @@ module MOM_io ! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_error_handler, only : MOM_error, NOTE, FATAL, WARNING +use MOM_array_transform, only : allocate_rotated_array, rotate_array use MOM_domains, only : MOM_domain_type, AGRID, BGRID_NE, CGRID_NE use MOM_domains, only : get_simple_array_i_ind, get_simple_array_j_ind +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_error_handler, only : MOM_error, NOTE, FATAL, WARNING use MOM_file_parser, only : log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_dyn_horgrid, only : dyn_horgrid_type use MOM_string_functions, only : lowercase, slasher use MOM_verticalGrid, only : verticalGrid_type @@ -41,7 +41,7 @@ module MOM_io public :: close_file, create_file, field_exists, field_size, fieldtype, get_filename_appendix public :: file_exists, flush_file, get_file_info, get_file_atts, get_file_fields public :: get_file_times, open_file, read_axis_data, read_data, read_field_chksum -public :: num_timelevels, MOM_read_data, MOM_read_vector, ensembler +public :: num_timelevels, MOM_read_data, MOM_read_vector, MOM_write_field, ensembler public :: reopen_file, slasher, write_field, write_version_number, MOM_io_init public :: open_namelist_file, check_nml_error, io_infra_init, io_infra_end public :: APPEND_FILE, ASCII_FILE, MULTIPLE, NETCDF_FILE, OVERWRITE_FILE @@ -80,6 +80,15 @@ module MOM_io module procedure MOM_read_data_0d end interface +!> Write a registered field to an output file +interface MOM_write_field + module procedure MOM_write_field_4d + module procedure MOM_write_field_3d + module procedure MOM_write_field_2d + module procedure MOM_write_field_1d + module procedure MOM_write_field_0d +end interface MOM_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 @@ -621,7 +630,7 @@ function var_desc(name, units, longname, hor_grid, z_grid, t_grid, & character(len=*), intent(in) :: name !< variable name character(len=*), optional, intent(in) :: units !< variable units character(len=*), optional, intent(in) :: longname !< variable long name - character(len=*), optional, intent(in) :: hor_grid !< variable horizonal staggering + character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1 character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name @@ -662,7 +671,7 @@ subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & character(len=*), optional, intent(in) :: name !< name of variable character(len=*), optional, intent(in) :: units !< units of variable character(len=*), optional, intent(in) :: longname !< long name of variable - character(len=*), optional, intent(in) :: hor_grid !< horizonal staggering of variable + character(len=*), optional, intent(in) :: hor_grid !< horizontal staggering of variable character(len=*), optional, intent(in) :: z_grid !< vertical staggering of variable character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1 character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name @@ -721,8 +730,8 @@ subroutine query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & character(len=*), optional, intent(out) :: name !< name of variable character(len=*), optional, intent(out) :: units !< units of variable character(len=*), optional, intent(out) :: longname !< long name of variable - character(len=*), optional, intent(out) :: hor_grid !< horiz staggering of variable - character(len=*), optional, intent(out) :: z_grid !< vert staggering of variable + character(len=*), optional, intent(out) :: hor_grid !< horizontal staggering of variable + character(len=*), optional, intent(out) :: z_grid !< verticle staggering of variable character(len=*), optional, intent(out) :: t_grid !< time description: s, p, or 1 character(len=*), optional, intent(out) :: cmor_field_name !< CMOR name character(len=*), optional, intent(out) :: cmor_units !< CMOR physical dimensions of variable @@ -1002,7 +1011,7 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: stagger !< A flag indicating where this vector is discretized - logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized + logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read real, optional, intent(in) :: scale !< A scaling factor that the fields are multiplied !! by before they are returned. integer :: is, ie, js, je @@ -1078,13 +1087,126 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data end subroutine MOM_read_vector_3d +!> Write a 4d field to an output file, potentially with rotation +subroutine MOM_write_field_4d(io_unit, field_md, MOM_domain, field, tstamp, tile_count, & + fill_value, turns) + integer, intent(in) :: io_unit !< File I/O unit handle + type(fieldtype), intent(in) :: field_md !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition + real, dimension(:,:,:,:), intent(inout) :: field !< Unrotated field to write + real, optional, intent(in) :: tstamp !< Model timestamp + integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value !< Missing data fill value + integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data + + real, allocatable :: field_rot(:,:,:,:) ! A rotated version of field, with the same units + integer :: qturns ! The number of quarter turns through which to rotate field + + qturns = 0 + if (present(turns)) qturns = modulo(turns, 4) + + if (qturns == 0) then + call write_field(io_unit, field_md, MOM_domain%mpp_domain, field, tstamp=tstamp, & + tile_count=tile_count, default_data=fill_value) + else + call allocate_rotated_array(field, [1,1,1,1], qturns, field_rot) + call rotate_array(field, qturns, field_rot) + call write_field(io_unit, field_md, MOM_domain%mpp_domain, field_rot, tstamp=tstamp, & + tile_count=tile_count, default_data=fill_value) + deallocate(field_rot) + endif +end subroutine MOM_write_field_4d + +!> Write a 3d field to an output file, potentially with rotation +subroutine MOM_write_field_3d(io_unit, field_md, MOM_domain, field, tstamp, tile_count, & + fill_value, turns) + integer, intent(in) :: io_unit !< File I/O unit handle + type(fieldtype), intent(in) :: field_md !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition + real, dimension(:,:,:), intent(inout) :: field !< Unrotated field to write + real, optional, intent(in) :: tstamp !< Model timestamp + integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value !< Missing data fill value + integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data + + real, allocatable :: field_rot(:,:,:) ! A rotated version of field, with the same units + integer :: qturns ! The number of quarter turns through which to rotate field + + qturns = 0 + if (present(turns)) qturns = modulo(turns, 4) + + if (qturns == 0) then + call write_field(io_unit, field_md, MOM_domain%mpp_domain, field, tstamp=tstamp, & + tile_count=tile_count, default_data=fill_value) + else + call allocate_rotated_array(field, [1,1,1], qturns, field_rot) + call rotate_array(field, qturns, field_rot) + call write_field(io_unit, field_md, MOM_domain%mpp_domain, field_rot, tstamp=tstamp, & + tile_count=tile_count, default_data=fill_value) + deallocate(field_rot) + endif +end subroutine MOM_write_field_3d + +!> Write a 2d field to an output file, potentially with rotation +subroutine MOM_write_field_2d(io_unit, field_md, MOM_domain, field, tstamp, tile_count, & + fill_value, turns) + integer, intent(in) :: io_unit !< File I/O unit handle + type(fieldtype), intent(in) :: field_md !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition + real, dimension(:,:), intent(inout) :: field !< Unrotated field to write + real, optional, intent(in) :: tstamp !< Model timestamp + integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value !< Missing data fill value + integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data + + real, allocatable :: field_rot(:,:) ! A rotated version of field, with the same units + integer :: qturns ! The number of quarter turns through which to rotate field + + qturns = 0 + if (present(turns)) qturns = modulo(turns, 4) + + if (qturns == 0) then + call write_field(io_unit, field_md, MOM_domain%mpp_domain, field, tstamp=tstamp, & + tile_count=tile_count, default_data=fill_value) + else + call allocate_rotated_array(field, [1,1], qturns, field_rot) + call rotate_array(field, qturns, field_rot) + call write_field(io_unit, field_md, MOM_domain%mpp_domain, field_rot, tstamp=tstamp, & + tile_count=tile_count, default_data=fill_value) + deallocate(field_rot) + endif +end subroutine MOM_write_field_2d + +!> Write a 1d field to an output file +subroutine MOM_write_field_1d(io_unit, field_md, field, tstamp, fill_value) + integer, intent(in) :: io_unit !< File I/O unit handle + type(fieldtype), intent(in) :: field_md !< Field type with metadata + real, dimension(:), intent(inout) :: field !< Field to write + real, optional, intent(in) :: tstamp !< Model timestamp + real, optional, intent(in) :: fill_value !< Missing data fill value + + call write_field(io_unit, field_md, field, tstamp=tstamp) +end subroutine MOM_write_field_1d + +!> Write a 0d field to an output file +subroutine MOM_write_field_0d(io_unit, field_md, field, tstamp, fill_value) + integer, intent(in) :: io_unit !< File I/O unit handle + type(fieldtype), intent(in) :: field_md !< Field type with metadata + real, intent(inout) :: field !< Field to write + real, optional, intent(in) :: tstamp !< Model timestamp + real, optional, intent(in) :: fill_value !< Missing data fill value + + call write_field(io_unit, field_md, field, tstamp=tstamp) +end subroutine MOM_write_field_0d + + !> Initialize the MOM_io module subroutine MOM_io_init(param_file) type(param_file_type), intent(in) :: param_file !< structure indicating the open file to !! parse for model parameter values. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_io" ! This module's name. call log_version(param_file, mdl, version) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index d9206f5bef..73c5cc94e1 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -9,15 +9,14 @@ module MOM_restart use MOM_string_functions, only : lowercase use MOM_grid, only : ocean_grid_type use MOM_io, only : create_file, fieldtype, file_exists, open_file, close_file -use MOM_io, only : MOM_read_data, read_data, get_filename_appendix, read_field_chksum +use MOM_io, only : MOM_read_data, read_data, MOM_write_field, read_field_chksum use MOM_io, only : get_file_info, get_file_atts, get_file_fields, get_file_times -use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc +use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc, get_filename_appendix use MOM_io, only : MULTIPLE, NETCDF_FILE, READONLY_FILE, SINGLE_FILE use MOM_io, only : CENTER, CORNER, NORTH_FACE, EAST_FACE use MOM_time_manager, only : time_type, time_type_to_real, real_to_time use MOM_time_manager, only : days_in_month, get_date, set_date use MOM_transform_FMS, only : chksum => rotated_mpp_chksum -use MOM_transform_FMS, only : write_field => rotated_write_field use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -370,7 +369,7 @@ subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units - character(len=*), optional, intent(in) :: hor_grid !< variable horizonal staggering, 'h' if absent + character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, 'L' if absent character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent @@ -397,7 +396,7 @@ subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units - character(len=*), optional, intent(in) :: hor_grid !< variable horizonal staggering, 'h' if absent + character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, 'L' if absent character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent @@ -424,7 +423,7 @@ subroutine register_restart_field_2d(f_ptr, name, mandatory, CS, longname, units type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units - character(len=*), optional, intent(in) :: hor_grid !< variable horizonal staggering, 'h' if absent + character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, '1' if absent character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent @@ -452,7 +451,7 @@ subroutine register_restart_field_1d(f_ptr, name, mandatory, CS, longname, units type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units - character(len=*), optional, intent(in) :: hor_grid !< variable horizonal staggering, '1' if absent + character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, '1' if absent character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, 'L' if absent character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent @@ -503,7 +502,7 @@ function query_initialized_name(name, CS) result(query_initialized) ! This subroutine returns .true. if the field referred to by name has ! initialized from a restart file, and .false. otherwise. - integer :: m,n + integer :: m, n if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -537,7 +536,7 @@ function query_initialized_0d(f_ptr, CS) result(query_initialized) ! This subroutine tests whether the field pointed to by f_ptr has ! been initialized from a restart file. - integer :: m,n + integer :: m, n if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -564,7 +563,7 @@ function query_initialized_1d(f_ptr, CS) result(query_initialized) ! This subroutine tests whether the field pointed to by f_ptr has ! been initialized from a restart file. - integer :: m,n + integer :: m, n if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -592,7 +591,7 @@ function query_initialized_2d(f_ptr, CS) result(query_initialized) ! This subroutine tests whether the field pointed to by f_ptr has ! been initialized from a restart file. - integer :: m,n + integer :: m, n if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -620,7 +619,7 @@ function query_initialized_3d(f_ptr, CS) result(query_initialized) ! This subroutine tests whether the field pointed to by f_ptr has ! been initialized from a restart file. - integer :: m,n + integer :: m, n if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -648,7 +647,7 @@ function query_initialized_4d(f_ptr, CS) result(query_initialized) ! This subroutine tests whether the field pointed to by f_ptr has ! been initialized from a restart file. - integer :: m,n + integer :: m, n if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -677,7 +676,7 @@ function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized) ! This subroutine tests whether the field pointed to by f_ptr or with the ! specified variable name has been initialized from a restart file. - integer :: m,n + integer :: m, n if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -713,7 +712,7 @@ function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized) ! This subroutine tests whether the field pointed to by f_ptr or with the ! specified variable name has been initialized from a restart file. - integer :: m,n + integer :: m, n if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -749,7 +748,7 @@ function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized) ! This subroutine tests whether the field pointed to by f_ptr or with the ! specified variable name has been initialized from a restart file. - integer :: m,n + integer :: m, n if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -908,10 +907,10 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ restartname = trim(CS%restartfile) if (present(filename)) restartname = trim(filename) if (PRESENT(time_stamped)) then ; if (time_stamped) then - call get_date(time,year,month,days,hour,minute,seconds) + call get_date(time, year, month, days, hour, minute, seconds) ! Compute the year-day, because I don't like months. - RWH do m=1,month-1 - days = days + days_in_month(set_date(year,m,2,0,0,0)) + days = days + days_in_month(set_date(year, m, 2, 0, 0, 0)) enddo seconds = seconds + 60*minute + 3600*hour if (year <= 9999) then @@ -1030,19 +1029,19 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ do m=start_var,next_var-1 if (associated(CS%var_ptr3d(m)%p)) then - call write_field(unit,fields(m-start_var+1), G%Domain%mpp_domain, & + call MOM_write_field(unit,fields(m-start_var+1), G%Domain, & CS%var_ptr3d(m)%p, restart_time, turns=-turns) elseif (associated(CS%var_ptr2d(m)%p)) then - call write_field(unit,fields(m-start_var+1), G%Domain%mpp_domain, & + call MOM_write_field(unit,fields(m-start_var+1), G%Domain, & CS%var_ptr2d(m)%p, restart_time, turns=-turns) elseif (associated(CS%var_ptr4d(m)%p)) then - call write_field(unit,fields(m-start_var+1), G%Domain%mpp_domain, & + call MOM_write_field(unit,fields(m-start_var+1), G%Domain, & CS%var_ptr4d(m)%p, restart_time, turns=-turns) elseif (associated(CS%var_ptr1d(m)%p)) then - call write_field(unit, fields(m-start_var+1), CS%var_ptr1d(m)%p, & + call MOM_write_field(unit, fields(m-start_var+1), CS%var_ptr1d(m)%p, & restart_time) elseif (associated(CS%var_ptr0d(m)%p)) then - call write_field(unit, fields(m-start_var+1), CS%var_ptr0d(m)%p, & + call MOM_write_field(unit, fields(m-start_var+1), CS%var_ptr0d(m)%p, & restart_time) endif enddo diff --git a/src/framework/MOM_transform_FMS.F90 b/src/framework/MOM_transform_FMS.F90 index 572a9717dc..a6c28717b3 100644 --- a/src/framework/MOM_transform_FMS.F90 +++ b/src/framework/MOM_transform_FMS.F90 @@ -5,19 +5,15 @@ module MOM_transform_FMS use horiz_interp_mod, only : horiz_interp_type use MOM_error_handler, only : MOM_error, FATAL -use MOM_io, only : fieldtype, write_field -use mpp_domains_mod, only : domain2D use mpp_mod, only : mpp_chksum use time_manager_mod, only : time_type use time_interp_external_mod, only : time_interp_external use MOM_array_transform, only : allocate_rotated_array, rotate_array -implicit none +implicit none ; private -private public rotated_mpp_chksum -public rotated_write_field public rotated_time_interp_external !> Rotate and compute the FMS (mpp) checksum of a field @@ -29,15 +25,6 @@ module MOM_transform_FMS module procedure rotated_mpp_chksum_real_4d end interface rotated_mpp_chksum -!> Rotate and write a registered field to an FMS output file -interface rotated_write_field - module procedure rotated_write_field_real_0d - module procedure rotated_write_field_real_1d - module procedure rotated_write_field_real_2d - module procedure rotated_write_field_real_3d - module procedure rotated_write_field_real_4d -end interface rotated_write_field - !> Read a field based on model time, and rotate to the model domain interface rotated_time_interp_external module procedure rotated_time_interp_external_0d @@ -166,139 +153,6 @@ function rotated_mpp_chksum_real_4d(field, pelist, mask_val, turns) & end function rotated_mpp_chksum_real_4d -! NOTE: In MOM_io, write_field points to mpp_write, which supports a very broad -! range of interfaces. Here, we only support the much more narrow family of -! mpp_write_2ddecomp functions used to write tiled data. - - -!> Write the rotation of a 1d field to an FMS output file -!! This function is provided to support the full FMS write_field interface. -subroutine rotated_write_field_real_0d(io_unit, field_md, field, tstamp, turns) - integer, intent(in) :: io_unit !> File I/O unit handle - type(fieldtype), intent(in) :: field_md !> FMS field metadata - real, intent(inout) :: field !> Unrotated field array - real, optional, intent(in) :: tstamp !> Model timestamp - integer, optional, intent(in) :: turns !> Number of quarter-turns - - if (present(turns)) & - call MOM_error(FATAL, "Rotation not supported for 0d fields.") - - call write_field(io_unit, field_md, field, tstamp=tstamp) -end subroutine rotated_write_field_real_0d - - -!> Write the rotation of a 1d field to an FMS output file -!! This function is provided to support the full FMS write_field interface. -subroutine rotated_write_field_real_1d(io_unit, field_md, field, tstamp, turns) - integer, intent(in) :: io_unit !> File I/O unit handle - type(fieldtype), intent(in) :: field_md !> FMS field metadata - real, intent(inout) :: field(:) !> Unrotated field array - real, optional, intent(in) :: tstamp !> Model timestamp - integer, optional, intent(in) :: turns !> Number of quarter-turns - - if (present(turns)) & - call MOM_error(FATAL, "Rotation not supported for 0d fields.") - - call write_field(io_unit, field_md, field, tstamp=tstamp) -end subroutine rotated_write_field_real_1d - - -!> Write the rotation of a 2d field to an FMS output file -subroutine rotated_write_field_real_2d(io_unit, field_md, domain, field, & - tstamp, tile_count, default_data, turns) - integer, intent(in) :: io_unit !> File I/O unit handle - type(fieldtype), intent(in) :: field_md !> FMS field metadata - type(domain2D), intent(inout) :: domain !> FMS MPP domain - real, intent(inout) :: field(:,:) !> Unrotated field array - real, optional, intent(in) :: tstamp !> Model timestamp - integer, optional, intent(in) :: tile_count !> PEs per tile (default: 1) - real, optional, intent(in) :: default_data !> Default fill value - integer, optional, intent(in) :: turns !> Number of quarter-turns - - real, allocatable :: field_rot(:,:) - integer :: qturns - - qturns = 0 - if (present(turns)) & - qturns = modulo(turns, 4) - - if (qturns == 0) then - call write_field(io_unit, field_md, domain, field, tstamp=tstamp, & - tile_count=tile_count, default_data=default_data) - else - call allocate_rotated_array(field, [1,1], qturns, field_rot) - call rotate_array(field, qturns, field_rot) - call write_field(io_unit, field_md, domain, field_rot, tstamp=tstamp, & - tile_count=tile_count, default_data=default_data) - deallocate(field_rot) - endif -end subroutine rotated_write_field_real_2d - - -!> Write the rotation of a 3d field to an FMS output file -subroutine rotated_write_field_real_3d(io_unit, field_md, domain, field, & - tstamp, tile_count, default_data, turns) - integer, intent(in) :: io_unit !> File I/O unit handle - type(fieldtype), intent(in) :: field_md !> FMS field metadata - type(domain2D), intent(inout) :: domain !> FMS MPP domain - real, intent(inout) :: field(:,:,:) !> Unrotated field array - real, optional, intent(in) :: tstamp !> Model timestamp - integer, optional, intent(in) :: tile_count !> PEs per tile (default: 1) - real, optional, intent(in) :: default_data !> Default fill value - integer, optional, intent(in) :: turns !> Number of quarter-turns - - real, allocatable :: field_rot(:,:,:) - integer :: qturns - - qturns = 0 - if (present(turns)) & - qturns = modulo(turns, 4) - - if (qturns == 0) then - call write_field(io_unit, field_md, domain, field, tstamp=tstamp, & - tile_count=tile_count, default_data=default_data) - else - call allocate_rotated_array(field, [1,1,1], qturns, field_rot) - call rotate_array(field, qturns, field_rot) - call write_field(io_unit, field_md, domain, field_rot, tstamp=tstamp, & - tile_count=tile_count, default_data=default_data) - deallocate(field_rot) - endif -end subroutine rotated_write_field_real_3d - - -!> Write the rotation of a 4d field to an FMS output file -subroutine rotated_write_field_real_4d(io_unit, field_md, domain, field, & - tstamp, tile_count, default_data, turns) - integer, intent(in) :: io_unit !> File I/O unit handle - type(fieldtype), intent(in) :: field_md !> FMS field metadata - type(domain2D), intent(inout) :: domain !> FMS MPP domain - real, intent(inout) :: field(:,:,:,:) !> Unrotated field array - real, optional, intent(in) :: tstamp !> Model timestamp - integer, optional, intent(in) :: tile_count !> PEs per tile (default: 1) - real, optional, intent(in) :: default_data !> Default fill value - integer, optional, intent(in) :: turns !> Number of quarter-turns - - real, allocatable :: field_rot(:,:,:,:) - integer :: qturns - - qturns = 0 - if (present(turns)) & - qturns = modulo(turns, 4) - - if (qturns == 0) then - call write_field(io_unit, field_md, domain, field, tstamp=tstamp, & - tile_count=tile_count, default_data=default_data) - else - call allocate_rotated_array(field, [1,1,1,1], qturns, field_rot) - call rotate_array(field, qturns, field_rot) - call write_field(io_unit, field_md, domain, field_rot, tstamp=tstamp, & - tile_count=tile_count, default_data=default_data) - deallocate(field_rot) - endif -end subroutine rotated_write_field_real_4d - - !> Read a scalar field based on model time !! This function is provided to support the full FMS time_interp_external !! interface.