From e8ec93910248ae9eb0299a69ffdbd14b57b7f1df Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 7 Jul 2022 17:25:49 -0400 Subject: [PATCH] FMS2: open_ASCII_file and open_namelist_file This patch re-implements the FMS2 implementations of `open_ASCII_file` and `open_namelist_file` to remove their dependency on FMS1 functions which have been staged for deletion. Note that if a file is opened with `mpp_open` but closed with `close_file_unit`, then it will raise an error in `fms_io_exit`. This will no longer be an issue after all references to `mpp_open` have been removed. But in the meantime, we will need to ensure that all unit-based `close_file` calls were not opened with `mpp_open`. There is also a minor patch to `.testing/Makefile` which selects the framework ("infra") source dependency, rather than hard-set to FMS1. --- .testing/Makefile | 19 +++- config_src/infra/FMS2/MOM_io_infra.F90 | 132 ++++++++++++++++++++++--- 2 files changed, 136 insertions(+), 15 deletions(-) diff --git a/.testing/Makefile b/.testing/Makefile index 2bd9c6f39d..530a552181 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -182,14 +182,25 @@ endif SOURCE = \ $(foreach ext,F90 inc c h,$(wildcard $(1)/*/*.$(ext) $(1)/*/*/*.$(ext))) -MOM_SOURCE = $(call SOURCE,../src) \ - $(wildcard ../config_src/infra/FMS1/*.F90) \ +MOM_SOURCE = \ + $(call SOURCE,../src) \ $(wildcard ../config_src/drivers/solo_driver/*.F90) \ $(wildcard ../config_src/ext*/*/*.F90) -TARGET_SOURCE = $(call SOURCE,build/target_codebase/src) \ - $(wildcard build/target_codebase/config_src/infra/FMS1/*.F90) \ + +TARGET_SOURCE = \ + $(call SOURCE,build/target_codebase/src) \ $(wildcard build/target_codebase/config_src/drivers/solo_driver/*.F90) \ $(wildcard build/target_codebase/config_src/ext*/*.F90) + +# NOTE: Current default framework is FMS1, but this could change. +ifeq ($(FRAMEWORK), fms2) + MOM_SOURCE +=$(wildcard ../config_src/infra/FMS2/*.F90) + TARGET_SOURCE += $(wildcard build/target_codebase/config_src/infra/FMS2/*.F90) +else + MOM_SOURCE += $(wildcard ../config_src/infra/FMS1/*.F90) + TARGET_SOURCE += $(wildcard build/target_codebase/config_src/infra/FMS1/*.F90) +endif + FMS_SOURCE = $(call SOURCE,deps/fms/src) diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index c8c55524f8..dc8a9af3d5 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -19,7 +19,7 @@ module MOM_io_infra use fms2_io_mod, only : get_global_io_domain_indices use fms_io_utils_mod, only : fms2_file_exist => file_exists -use fms_mod, only : write_version_number, open_namelist_file, check_nml_error +use fms_mod, only : write_version_number, check_nml_error use fms_io_mod, only : file_exist, field_exist, field_size, read_data use fms_io_mod, only : fms_io_exit, get_filename_appendix use mpp_domains_mod, only : mpp_get_compute_domain, mpp_get_global_domain @@ -31,6 +31,8 @@ module MOM_io_infra 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 +use mpp_mod, only : mpp_pe, mpp_root_pe, mpp_npes +use mpp_mod, only : mpp_get_current_pelist_name ! 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 @@ -205,10 +207,20 @@ end subroutine close_file_type !> closes a file. If the unit does not point to an open file, !! close_file_unit simply returns without doing anything. -subroutine close_file_unit(unit) - integer, intent(inout) :: unit !< The I/O unit for the file to be closed - - call mpp_close(unit) +subroutine close_file_unit(iounit) + integer, intent(inout) :: iounit !< The I/O unit for the file to be closed + + logical :: unit_is_open + + ! NOTE: Files opened by `mpp_open` must be closed by `mpp_close`. Otherwise, + ! an error will occur during `fms_io_exit`. + ! + ! Since there is no way to check if `fms_io_init` was called, we are forced + ! to visually confirm that the input unit was not created by `mpp_open`. + ! + ! After `mpp_open` has been removed, this message can be deleted. + inquire(iounit, opened=unit_is_open) + if (unit_is_open) close(iounit) end subroutine close_file_unit !> Ensure that the output stream associated with a file handle is fully sent to disk. @@ -242,10 +254,30 @@ subroutine io_infra_end() end subroutine io_infra_end !> Open a single namelist file that is potentially readable by all PEs. -function MOM_namelist_file(file) result(unit) - character(len=*), optional, intent(in) :: file !< The file to open, by default "input.nml". - integer :: unit !< The opened unit number of the namelist file - unit = open_namelist_file(file) +function MOM_namelist_file(filepath) result(iounit) + character(len=*), optional, intent(in) :: filepath + !< The file to open, by default "input.nml". + integer :: iounit + !< The opened unit number of the namelist file + + character(len=:), allocatable :: nmlpath + ! Namelist path + character(len=:), allocatable :: nmlpath_pe + ! Hypothetical namelist path exclusive to the current PE list + + if (present(filepath)) then + nmlpath = trim(filepath) + else + ! FMS1 first checks for a namelist unique to the PE list, `input_{}.nml`. + ! If not found, it defaults to `input.nml`. + nmlpath_pe = 'input_' // trim(mpp_get_current_pelist_name()) // '.nml' + if (file_exists(nmlpath_pe)) then + nmlpath = nmlpath_pe + else + nmlpath = 'input.nml' + endif + endif + call open_ASCII_file(iounit, nmlpath, action=READONLY_FILE) end function MOM_namelist_file !> Checks the iostat argument that is returned after reading a namelist variable and writes a @@ -403,9 +435,87 @@ subroutine open_ASCII_file(unit, file, action, threading, fileset) !! to threading=MULTIPLE write to the same file (SINGLE_FILE) !! or to one file per PE (MULTIPLE, the default). - call mpp_open(unit, file, action=action, form=ASCII_FILE, threading=threading, fileset=fileset, & - nohdrs=.true.) + integer :: action_flag + integer :: threading_flag + integer :: fileset_flag + logical :: exists + logical :: is_open + character(len=6) :: action_arg, position_arg + character(len=:), allocatable :: filename + + ! NOTE: This function is written to emulate the original behavior of mpp_open + ! from the FMS1 library, on which the MOM API is still based. Much of this + ! can be removed if we choose to drop this compatibility, but for now we + ! try to retain as much as possible. + + ! NOTE: Default FMS1 I/O settings are summarized below. + ! + ! access: Fortran and mpp_open default to SEQUENTIAL. + ! form: The Fortran and mpp_open default (for MPP_ASCII) is FORMATTED. + ! recl: mpp_open uses Fortran defaults when unset, so can be ignored. + ! ios: FMS1 allowed this to be caught, but we do not support it. + ! action/position: In mpp_open, these are inferred from `action`. + ! + ! MOM flag FMS1 flag action position + ! -------- -------- ------ -------- + ! READONLY_FILE MPP_RDONLY READ REWIND + ! WRITEONLY_FILE MPP_WRONLY WRITE REWIND + ! OVERWRITE_FILE MPP_OVERWR WRITE REWIND + ! APPEND_FILE MPP_APPEND WRITE APPEND + ! + ! From this, we can omit `access`, `form`, and `recl`, and can construct + ! `action` and `position` from the input arguments. + + ! I/O configuration + + action_flag = WRITEONLY_FILE + if (present(action)) action_flag = action + + action_arg = 'write' + if (action_flag == READONLY_FILE) action_arg = 'read' + + position_arg = 'rewind' + if (action_flag == APPEND_FILE) position_arg = 'append' + + ! Threading configuration + + threading_flag = SINGLE_FILE + if (present(threading)) threading_flag = threading + + fileset_flag = MULTIPLE + if (present(fileset)) fileset_flag = fileset + + ! Force fileset to be consistent with threading (as in FMS1) + if (threading_flag == SINGLE_FILE) fileset_flag = SINGLE_FILE + + ! Construct the distributed filename, if needed + filename = file + if (fileset_flag == MULTIPLE) then + if (mpp_npes() > 10000) then + write(filename, '(a,".",i6.6)') trim(filename), mpp_pe() - mpp_root_pe() + else + write(filename, '(a,".",i4.4)') trim(filename), mpp_pe() - mpp_root_pe() + endif + endif + + inquire(file=filename, exist=exists) + if (exists .and. action_flag == WRITEONLY_FILE) & + call MOM_error(WARNING, 'open_ASCII_file: File ' // trim(filename) // & + ' opened WRITEONLY already exists!') + + open(newunit=unit, file=filename, action=trim(action_arg), & + position=trim(position_arg)) + + ! This checks if open() failed but did not raise a runtime error. + inquire(unit, opened=is_open) + if (.not. is_open) & + call MOM_error(FATAL, 'open_ASCII_file: File ' // trim(filename) // & + ' failed to open.') + ! NOTE: There are two possible mpp_write_meta functions in FMS1: + ! - call mpp_write_meta( unit, 'filename', cval=mpp_file(unit)%name) + ! - call mpp_write_meta( unit, 'NumFilesInSet', ival=nfiles) + ! I'm not convinced we actually want these, but note them here in case. end subroutine open_ASCII_file