From 527a42f3ff36d75aac68b65757b35f73a74146bb Mon Sep 17 00:00:00 2001 From: Ryan Mulhall <35538242+rem1776@users.noreply.github.com> Date: Fri, 27 Oct 2023 10:44:25 -0400 Subject: [PATCH 1/5] chore: updates the various versions and changelog (#1395) --- CHANGELOG.md | 36 ++++++++++++++++++++++++++++++++++++ CMakeLists.txt | 2 +- configure.ac | 2 +- libFMS/Makefile.am | 2 +- 4 files changed, 39 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2c616e647d..782f940443 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,42 @@ and this project uses `yyyy.rr[.pp]`, where `yyyy` is the year a patch is releas `rr` is a sequential release number (starting from `01`), and an optional two-digit sequential patch number (starting from `01`). +## [2023.03] - 2023-10-27 +### Known Issues +- GCC 9 and below as well as GCC 11.1.0 are unsupported due to compilation issues. See prior releases for more details. +- `NO_QUAD_PRECISION` macro is no longer set by FMS, the `ENABLE_QUAD_PRECISION` macro has replaced prior usage of `NO_QUAD_PRECISION`. `-DENABLE_QUAD_PRECISION` should be set if quad precision is to be used, otherwise FMS will not use quad precision reals where applicable. + +### Added +- UNIT_TESTS: New unit tests have been created or and existing ones expanded on for any modules utilizing mixed precision support. + +### Changed +- MIXED PRECISION: Most subroutines and functions in FMS have been updated to simultaneously accept both 4 byte and 8 byte reals as arguments. This deprecates the `--enable-mixed-mode` option, which enabled similar functionality but was limited to certain directories and was not enabled by default. To facilitate easier testing of these code changes, the CMake precision options for default real size were left in (along with an equivalent `--disable-r8-default` flag for autotools). The resulting libraries will support mixed-precision real kinds regardless of default real size. It should also be noted that many routines that accept real arguments have been moved to include files along with headers in order to be compiled with both kinds. Most module level variables were explicitly declared as r8_kind for these updates. +- Some type/module changes were made to facilitate mixed precision support. They are **intended** to have minimal impact to other codebases: + - COUPLER_TYPES: In coupler_types.F90, `coupler_nd_field_type` and `coupler_nd_values_type` have been renamed to indicate real kind value: `coupler_nd_real4/8_field_type` and `coupler_nd_real4/8_values_type`. The `bc` field within `coupler_nd_bc_type` was modified to use r8_kind within the value and field types, and an additional field added `bc_r4` to use r4_kind values. + - TRIDIAGONAL: Module state between r4 and r8 calls are distinct (ie. subsequent calls will only be affected by calls of the same precision). This behaviour can be changed via the `save_both_kinds` optional argument to `tri_invert`. +- CODE_STYLE: has been updated to reflect the formatting used for the mixed precision support updates. + +### Fixed +- DIAG_MANAGER: Tile number (ie. tileX) will now be added to filenames for sub-regional diagnostics. +- MPP: Bug affecting non-intel compilers coming from uninitialized pointer in the `nest_domain_type` +- MPP: Bug fix for unallocated field causing seg faults in `mpp_check_field` +- FMS2_IO: Fixed segfault occuring from use of cray pointer remapping along with mpp_scatter/gather +- TEST_FMS: Added various fixes for different compilers within test programs for fms2_io, mpp, diag_manager, parser, and sat_vapor_pres. +- INTERPOLATOR: Deallocates fields in the type that were previously left out in `interpolator_end` + +### Removed +- CPP MACROS: + - `no_4byte_reals` was removed and will not set any additional macros if used. `no_8byte_integers` is still functional. + - `NO_QUAD_PRECISION` was removed. It was conditionally set if ENABLE_QUAD_PRECISION was undefined. ENABLE_QUAD_PRECISION should be used in model components instead (logic is flipped) + - `use_netCDF` was set by autotools previously but wasn't consistently used in the code. FMS should always be compiled with netcdf installed so this was removed with the exception of its use in deprecated IO modules. +- DRIFTERS: The drifters subdirectory has been deprecated. It will only be compiled if using the `-Duse_drifters` CPP flag. + +### Tag Commit Hashes +- 2023.03-beta1 06b94a7f574e7794684b8584391744ded68e2989 +- 2023.03-alpha3 b25a7c52a27dfd52edc10bc0ebe12776af0f03df +- 2023.03-alpha2 9983ce308e62e9f7215b04c227cebd30fd75e784 +- 2023.03-alpha1 a46bd94fd8dd1f6f021501e29179003ff28180ec + ## [2023.02] - 2023-07-27 ### Known Issues - GCC 11.1.0 is unsupported due to compilation issues with select type. The issue is resolved in later GCC releases. diff --git a/CMakeLists.txt b/CMakeLists.txt index a70abe14da..89c7eb329d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -26,7 +26,7 @@ set(CMAKE_Fortran_FLAGS_DEBUG) # Define the CMake project project(FMS - VERSION 2023.02.0 + VERSION 2023.03.0 DESCRIPTION "GFDL FMS Library" HOMEPAGE_URL "https://www.gfdl.noaa.gov/fms" LANGUAGES C Fortran) diff --git a/configure.ac b/configure.ac index 65e3c0fe73..5a9aff17c7 100644 --- a/configure.ac +++ b/configure.ac @@ -25,7 +25,7 @@ AC_PREREQ([2.69]) # Initialize with name, version, and support email address. AC_INIT([GFDL FMS Library], - [2023.02.00-dev], + [2023.03.00], [gfdl.climate.model.info@noaa.gov], [FMS], [https://www.github.com/NOAA-GFDL/FMS]) diff --git a/libFMS/Makefile.am b/libFMS/Makefile.am index db57f86562..9605216504 100644 --- a/libFMS/Makefile.am +++ b/libFMS/Makefile.am @@ -28,7 +28,7 @@ lib_LTLIBRARIES = libFMS.la # These linker flags specify libtool version info. # See http://www.gnu.org/software/libtool/manual/libtool.html#Libtool-versioning # for information regarding incrementing `-version-info`. -libFMS_la_LDFLAGS = -version-info 16:0:0 +libFMS_la_LDFLAGS = -version-info 17:0:0 # Add the convenience libraries to the FMS library. libFMS_la_LIBADD = $(top_builddir)/platform/libplatform.la From 74338de3ee45eccdc8f2b045d096ed08a7f0012e Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" <41898282+github-actions[bot]@users.noreply.github.com> Date: Fri, 27 Oct 2023 16:08:19 -0400 Subject: [PATCH 2/5] chore: add dev to version number (#1400) --- configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 5a9aff17c7..3b242c0016 100644 --- a/configure.ac +++ b/configure.ac @@ -25,7 +25,7 @@ AC_PREREQ([2.69]) # Initialize with name, version, and support email address. AC_INIT([GFDL FMS Library], - [2023.03.00], + [2023.03.00-dev], [gfdl.climate.model.info@noaa.gov], [FMS], [https://www.github.com/NOAA-GFDL/FMS]) From c70718d10bc91a27f588a63b14b7bceb292a9ed0 Mon Sep 17 00:00:00 2001 From: Ryan Mulhall <35538242+rem1776@users.noreply.github.com> Date: Wed, 1 Nov 2023 15:05:19 -0400 Subject: [PATCH 3/5] fix: allow for arguments within mpi launcher override (#1401) --- test_fms/test-lib.sh.in | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test_fms/test-lib.sh.in b/test_fms/test-lib.sh.in index b983b48d84..9be57a630a 100644 --- a/test_fms/test-lib.sh.in +++ b/test_fms/test-lib.sh.in @@ -96,8 +96,10 @@ mpirun () { # Set the name of the mpi launcher for use in test scripts. local mpi_launcher='@MPI_LAUNCHER@' local oversubscribe='@OVERSUBSCRIBE@' + # need to strip off any args that may be included with MPI_LAUNCHER arg for check below to work + local mpi_cmd="`echo $mpi_launcher | awk '{print $1;}'`" # Check if running with MPI: if so, the mpi_launcher will point to a command - command -v "$mpi_launcher" 2>&1 > /dev/null + command -v "$mpi_cmd" 2>&1 > /dev/null if test $? -eq 0 then # use `command` to keep from reusing this function From b0dbc305b585a244f19880640e0d9ed508455ed8 Mon Sep 17 00:00:00 2001 From: Bennett Chang <98476720+bcc2761@users.noreply.github.com> Date: Thu, 9 Nov 2023 10:09:19 -0500 Subject: [PATCH 4/5] feat: data_override namelist flag to enable YAML data tables (#1382) --- data_override/include/data_override.inc | 39 ++++++++++----- test_fms/data_override/Makefile.am | 2 + test_fms/data_override/test_data_override2.sh | 49 +++++++++++++++++++ .../data_override/test_data_override_init.F90 | 29 +++++++++++ 4 files changed, 107 insertions(+), 12 deletions(-) create mode 100644 test_fms/data_override/test_data_override_init.F90 diff --git a/data_override/include/data_override.inc b/data_override/include/data_override.inc index 663d2b0fcf..6d76c0d537 100644 --- a/data_override/include/data_override.inc +++ b/data_override/include/data_override.inc @@ -103,11 +103,7 @@ real(FMS_DATA_OVERRIDE_KIND_) :: min_glo_lon_lnd, max_glo_lon_lnd real(FMS_DATA_OVERRIDE_KIND_) :: min_glo_lon_ice, max_glo_lon_ice integer :: num_fields = 0 !< number of fields in override_array already processed -#ifdef use_yaml type(data_type), dimension(:), allocatable :: data_table !< user-provided data table -#else -type(data_type), dimension(max_table) :: data_table !< user-provided data table -#endif type(data_type) :: default_table type(override_type), dimension(max_array) :: override_array !< to store processed fields @@ -118,8 +114,9 @@ logical :: reproduce_null_char_bug = .false. !! to reproduce the mpp_io bug where lat/lon_bnd were !! not read correctly if null characters are present in !! the netcdf file +logical :: use_data_table_yaml = .false. -namelist /data_override_nml/ debug_data_override, grid_center_bug, reproduce_null_char_bug +namelist /data_override_nml/ debug_data_override, grid_center_bug, reproduce_null_char_bug, use_data_table_yaml public :: DATA_OVERRIDE_INIT_IMPL_, DATA_OVERRIDE_UNSET_ATM_, DATA_OVERRIDE_UNSET_OCN_, & & DATA_OVERRIDE_UNSET_LND_, DATA_OVERRIDE_UNSET_ICE_, DATA_OVERRIDE_0D_, & @@ -166,6 +163,12 @@ if (grid_center_bug) then "that is no longer supported. Please remove this namelist variable.") endif +if (use_data_table_yaml) then + call mpp_error(NOTE, "You are using YAML.") +else + call mpp_error(NOTE, "You are using the legacy table.") +end if + atm_on = PRESENT(Atm_domain_in) ocn_on = PRESENT(Ocean_domain_in) lnd_on = PRESENT(Land_domain_in) @@ -197,12 +200,25 @@ endif default_table%interpol_method = 'bilinear' #ifdef use_yaml - call read_table_yaml(data_table) + if (use_data_table_yaml) then + call read_table_yaml(data_table) + else + allocate(data_table(max_table)) + do i = 1, max_table + data_table(i) = default_table + enddo + call read_table(data_table) + end if #else - do i = 1,max_table - data_table(i) = default_table - enddo - call read_table(data_table) + if (use_data_table_yaml) then + call mpp_error(FATAL, "compilation error, need to compile with `-Duse_yaml`") + else + allocate(data_table(max_table)) + do i = 1, max_table + data_table(i) = default_table + enddo + call read_table(data_table) + end if #endif ! Initialize override array @@ -330,7 +346,6 @@ function count_ne_1(in_1, in_2, in_3) count_ne_1 = .not.(in_1.NEQV.in_2.NEQV.in_3) .OR. (in_1.AND.in_2.AND.in_3) end function count_ne_1 -#ifndef use_yaml subroutine read_table(data_table) type(data_type), dimension(max_table), intent(inout) :: data_table @@ -475,7 +490,7 @@ subroutine read_table(data_table) if(io_status/=0) call mpp_error(FATAL, 'data_override_mod: Error in closing file data_table') end subroutine read_table -#else +#ifdef use_yaml subroutine read_table_yaml(data_table) type(data_type), dimension(:), allocatable, intent(out) :: data_table diff --git a/test_fms/data_override/Makefile.am b/test_fms/data_override/Makefile.am index f5c956c446..366c773800 100644 --- a/test_fms/data_override/Makefile.am +++ b/test_fms/data_override/Makefile.am @@ -30,6 +30,7 @@ LDADD = $(top_builddir)/libFMS/libFMS.la # Build this test program. check_PROGRAMS = \ + test_data_override_init \ test_get_grid_v1_r4 \ test_get_grid_v1_r8 \ test_data_override_r4 \ @@ -38,6 +39,7 @@ check_PROGRAMS = \ test_data_override_ongrid_r8 # This is the source code for the test. +test_data_override_init_SOURCES = test_data_override_init.F90 test_data_override_r4_SOURCES = test_data_override.F90 test_data_override_r8_SOURCES = test_data_override.F90 diff --git a/test_fms/data_override/test_data_override2.sh b/test_fms/data_override/test_data_override2.sh index 35546b41d3..064b0511d4 100755 --- a/test_fms/data_override/test_data_override2.sh +++ b/test_fms/data_override/test_data_override2.sh @@ -117,4 +117,53 @@ fi done +# data_override with the default table (not setting namelist) +cat <<_EOF > data_table +"ICE", "sst_obs", "SST", "INPUT/sst_ice_clim.nc", .false., 300.0 +_EOF + +test_expect_success "data_override_init with the default table" ' + mpirun -n 1 ./test_data_override_init +' +# data_override with yaml table (setting namelist to .True.) +cat <<_EOF > input.nml +&data_override_nml +use_data_table_yaml=.true. +/ +_EOF + +cat <<_EOF > data_table.yaml +data_table: + - gridname : OCN + fieldname_code : runoff + fieldname_file : runoff + file_name : INPUT/runoff.daitren.clim.1440x1080.v20180328.nc + interpol_method : none + factor : 1.0 +_EOF + +if [ ! -z $parser_skip ]; then + test_expect_failure "data_override_init with the yaml table" ' + mpirun -n 1 ./test_data_override_init + ' +else + test_expect_success "data_override_init with the yaml table" ' + mpirun -n 1 ./test_data_override_init + ' +fi +#data_override with default table (setting namelist to .True.) +cat <<_EOF > data_table +"ICE", "sst_obs", "SST", "INPUT/sst_ice_clim.nc", .true., 300.0 +_EOF + +cat <<_EOF > input.nml +&data_override_nml +use_data_table_yaml=.false. +/ +_EOF + +test_expect_success "data_override_init with the default table" ' + mpirun -n 1 ./test_data_override_init +' + test_done diff --git a/test_fms/data_override/test_data_override_init.F90 b/test_fms/data_override/test_data_override_init.F90 new file mode 100644 index 0000000000..dceec5aca3 --- /dev/null +++ b/test_fms/data_override/test_data_override_init.F90 @@ -0,0 +1,29 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** + +program test_data_override_init + + use fms_mod, only: fms_init, fms_end + use data_override_mod + + call fms_init() + call data_override_init + call fms_end() + +end program test_data_override_init From 302e3cbffba61d77ce46860260bb5d31a8e2b956 Mon Sep 17 00:00:00 2001 From: Caitlyn McAllister <65364559+mcallic2@users.noreply.github.com> Date: Mon, 13 Nov 2023 09:26:40 -0500 Subject: [PATCH 5/5] chore: change variables named `value` to other variable names (#1377) --- axis_utils/include/axis_utils2.inc | 32 +++--- field_manager/field_manager.F90 | 76 ++++++------- field_manager/fm_util.F90 | 106 +++++++++--------- field_manager/include/field_manager.inc | 26 ++--- field_manager/include/fm_util.inc | 24 ++-- .../include/horiz_interp_bilinear.inc | 16 +-- mosaic2/mosaic2.F90 | 12 +- mpp/include/mpp_util.inc | 12 +- 8 files changed, 151 insertions(+), 153 deletions(-) diff --git a/axis_utils/include/axis_utils2.inc b/axis_utils/include/axis_utils2.inc index baad2092e5..9972831184 100644 --- a/axis_utils/include/axis_utils2.inc +++ b/axis_utils/include/axis_utils2.inc @@ -218,10 +218,10 @@ end subroutine TRANLON_ - function FRAC_INDEX_(value, array) + function FRAC_INDEX_(rval, array) integer :: ia, i, ii, unit - real(kind=FMS_AU_KIND_) :: value !< arbitrary data...same units as elements in "array" + real(kind=FMS_AU_KIND_) :: rval !< arbitrary data...same units as elements in "array" real(kind=FMS_AU_KIND_) :: FRAC_INDEX_ real(kind=FMS_AU_KIND_), dimension(:) :: array !< array of data points (must be monotonically increasing) logical :: keep_going @@ -232,7 +232,7 @@ if (array(i) < array(i-1)) then unit = stdout() write (unit,*) '=> Error: "frac_index" array must be monotonically' & - & // 'increasing when searching for nearest value to ', value + & // 'increasing when searching for nearest value to ', rval write (unit,*) ' array(i) < array(i-1) for i=',i write (unit,*) ' array(i) for i=1..ia follows:' do ii = 1, ia @@ -242,17 +242,15 @@ endif enddo - if (value < array(1) .or. value > array(ia)) then - ! if (value < array(1)) frac_index = 1. - ! if (value > array(ia)) frac_index = float(ia) + if (rval < array(1) .or. rval > array(ia)) then FRAC_INDEX_ = -1.0_lkind else i = 1 keep_going = .true. do while (i <= ia .and. keep_going) i = i+1 - if (value <= array(i)) then - FRAC_INDEX_ = real((i-1), lkind) + (value-array(i-1)) / (array(i) - array(i-1)) + if (rval <= array(i)) then + FRAC_INDEX_ = real((i-1), lkind) + (rval-array(i-1)) / (array(i) - array(i-1)) keep_going = .false. endif enddo @@ -266,7 +264,7 @@ !! !! inputs: !! - !! value = arbitrary data...same units as elements in "array" + !! rval = arbitrary data...same units as elements in "array" !! array = array of data points (must be monotonically increasing) !! ia = dimension of "array" !! @@ -298,12 +296,12 @@ - function NEAREST_INDEX_(value, array) + function NEAREST_INDEX_(rval, array) integer :: NEAREST_INDEX_ integer :: ia !< dimension of "array" integer :: i, ii, unit - real(kind=FMS_AU_KIND_) :: value !< arbitrary data...same units as elements in "array" + real(kind=FMS_AU_KIND_) :: rval !< arbitrary data...same units as elements in "array" real(kind=FMS_AU_KIND_), dimension(:) :: array !< array of data points (must be monotonically increasing) logical :: keep_going @@ -313,7 +311,7 @@ if (array(i) < array(i-1)) then unit = stdout() write (unit,*) '=> Error: "nearest_index" array must be monotonically increasing' & - & // 'when searching for nearest value to ', value + & // 'when searching for nearest value to ', rval write (unit,*) ' array(i) < array(i-1) for i=',i write (unit,*) ' array(i) for i=1..ia follows:' do ii = 1, ia @@ -323,17 +321,17 @@ endif enddo - if (value < array(1) .or. value > array(ia)) then - if (value < array(1)) NEAREST_INDEX_ = 1 - if (value > array(ia)) NEAREST_INDEX_ = ia + if (rval < array(1) .or. rval > array(ia)) then + if (rval < array(1)) NEAREST_INDEX_ = 1 + if (rval > array(ia)) NEAREST_INDEX_ = ia else i = 1 keep_going = .true. do while (i <= ia .and. keep_going) i = i+1 - if (value <= array(i)) then + if (rval <= array(i)) then NEAREST_INDEX_ = i - if (array(i)-value > value-array(i-1)) NEAREST_INDEX_ = i-1 + if (array(i)-rval > rval-array(i-1)) NEAREST_INDEX_ = i-1 keep_going = .false. endif enddo diff --git a/field_manager/field_manager.F90 b/field_manager/field_manager.F90 index 61c3e234ba..ecb04a6575 100644 --- a/field_manager/field_manager.F90 +++ b/field_manager/field_manager.F90 @@ -1512,28 +1512,28 @@ function parse_strings ( text, label, values ) result (parse) include 'parse.inc' end function parse_strings -function parse_integer ( text, label, value ) result (parse) +function parse_integer ( text, label, parse_ival ) result (parse) character(len=*), intent(in) :: text !< The text string from which the values will be parsed. character(len=*), intent(in) :: label !< A label which describes the values being decoded. -integer, intent(out) :: value !< The value or values that have been decoded. +integer, intent(out) :: parse_ival !< The value or values that have been decoded. integer :: parse integer :: values(1) parse = parse_integers ( text, label, values ) - if (parse > 0) value = values(1) + if (parse > 0) parse_ival = values(1) end function parse_integer -function parse_string ( text, label, value ) result (parse) +function parse_string ( text, label, parse_sval ) result (parse) character(len=*), intent(in) :: text !< The text string from which the values will be parsed. character(len=*), intent(in) :: label !< A label which describes the values being decoded. -character(len=*), intent(out) :: value !< The value or values that have been decoded. +character(len=*), intent(out) :: parse_sval !< The value or values that have been decoded. integer :: parse -character(len=len(value)) :: values(1) +character(len=len(parse_sval)) :: values(1) parse = parse_strings ( text, label, values ) - if (parse > 0) value = values(1) + if (parse > 0) parse_sval = values(1) end function parse_string !> @brief A function to create a field as a child of parent_p. This will return @@ -2277,11 +2277,11 @@ end function fm_get_type !> @returns A flag to indicate whether the function operated with (false) or without !! (true) errors. -function fm_get_value_integer(name, value, index) & +function fm_get_value_integer(name, get_ival, index) & result (success) logical :: success character(len=*), intent(in) :: name !< The name of a field that the user wishes to get a value for. -integer, intent(out) :: value !< The value associated with the named field. +integer, intent(out) :: get_ival !< The value associated with the named field. integer, intent(in), optional :: index !< An optional index to retrieve a single value from an array. integer :: index_t @@ -2295,7 +2295,7 @@ function fm_get_value_integer(name, value, index) & endif ! Must supply a field field name if (name .eq. ' ') then - value = 0 + get_ival = 0 success = .false. return endif @@ -2313,20 +2313,20 @@ function fm_get_value_integer(name, value, index) & if (temp_field_p%field_type .eq. integer_type) then if (index_t .lt. 1 .or. index_t .gt. temp_field_p%max_index) then ! Index is not positive or index too large - value = 0 + get_ival = 0 success = .false. else ! extract the value - value = temp_field_p%i_value(index_t) + get_ival = temp_field_p%i_value(index_t) success = .true. endif else ! Field not corrcet type - value = 0 + get_ival = 0 success = .false. endif else - value = 0 + get_ival = 0 success = .false. endif @@ -2334,11 +2334,11 @@ end function fm_get_value_integer !> @returns A flag to indicate whether the function operated with (false) or without !! (true) errors. -function fm_get_value_logical(name, value, index) & +function fm_get_value_logical(name, get_lval, index) & result (success) logical :: success character(len=*), intent(in) :: name !< The name of a field that the user wishes to get a value for. -logical, intent(out) :: value !< The value associated with the named field +logical, intent(out) :: get_lval !< The value associated with the named field integer, intent(in), optional :: index !< An optional index to retrieve a single value from an array. integer :: index_t @@ -2352,7 +2352,7 @@ function fm_get_value_logical(name, value, index) & endif ! Must supply a field field name if (name .eq. ' ') then - value = .false. + get_lval = .false. success = .false. return endif @@ -2371,20 +2371,20 @@ function fm_get_value_logical(name, value, index) & if (index_t .lt. 1 .or. index_t .gt. temp_field_p%max_index) then ! Index is not positive or too large - value = .false. + get_lval = .false. success = .false. else ! extract the value - value = temp_field_p%l_value(index_t) + get_lval = temp_field_p%l_value(index_t) success = .true. endif else ! Field not correct type - value = .false. + get_lval = .false. success = .false. endif else - value = .false. + get_lval = .false. success = .false. endif @@ -2392,11 +2392,11 @@ end function fm_get_value_logical !> @returns A flag to indicate whether the function operated with (false) or without !! (true) errors. -function fm_get_value_string(name, value, index) & +function fm_get_value_string(name, get_sval, index) & result (success) logical :: success character(len=*), intent(in) :: name !< The name of a field that the user wishes to get a value for. -character(len=*), intent(out) :: value !< The value associated with the named field +character(len=*), intent(out) :: get_sval !< The value associated with the named field integer, intent(in), optional :: index !< An optional index to retrieve a single value from an array. integer :: index_t @@ -2410,7 +2410,7 @@ function fm_get_value_string(name, value, index) & endif ! Must supply a field field name if (name .eq. ' ') then - value = '' + get_sval = '' success = .false. return endif @@ -2428,20 +2428,20 @@ function fm_get_value_string(name, value, index) & if (temp_field_p%field_type .eq. string_type) then if (index_t .lt. 1 .or. index_t .gt. temp_field_p%max_index) then ! Index is not positive or is too large - value = '' + get_sval = '' success = .false. else ! extract the value - value = temp_field_p%s_value(index_t) + get_sval = temp_field_p%s_value(index_t) success = .true. endif else ! Field not correct type - value = '' + get_sval = '' success = .false. endif else - value = '' + get_sval = '' success = .false. endif @@ -2624,12 +2624,12 @@ end function fm_new_list !> @brief Assigns a given value to a given field !> @returns An index for the named field -function fm_new_value_integer(name, value, create, index, append) & +function fm_new_value_integer(name, new_ival, create, index, append) & result (field_index) integer :: field_index character(len=*), intent(in) :: name !< The name of a field that the user wishes to create !! a value for. -integer, intent(in) :: value !< The value that the user wishes to apply to the +integer, intent(in) :: new_ival !< The value that the user wishes to apply to the !! named field. logical, intent(in), optional :: create !< If present and .true., then a value for this !! field will be created. @@ -2698,7 +2698,7 @@ function fm_new_value_integer(name, value, create, index, append) & if (temp_field_p%field_type == real_type ) then ! promote integer input to real ! all real field values are stored as r8_kind - field_index = fm_new_value(name, real(value,r8_kind), create, index, append) + field_index = fm_new_value(name, real(new_ival,r8_kind), create, index, append) return else if (temp_field_p%field_type /= integer_type ) then ! slm: why would we reset index? Is it not an error to have a "list" defined @@ -2746,7 +2746,7 @@ function fm_new_value_integer(name, value, create, index, append) & ! Assign the value and set the field_index for return ! for non-null fields (index_t > 0) if (index_t .gt. 0) then - temp_field_p%i_value(index_t) = value + temp_field_p%i_value(index_t) = new_ival if (index_t .gt. temp_field_p%max_index) then temp_field_p%max_index = index_t endif @@ -2764,12 +2764,12 @@ end function fm_new_value_integer !> @brief Assigns a given value to a given field !> @returns An index for the named field -function fm_new_value_logical(name, value, create, index, append) & +function fm_new_value_logical(name, new_lval, create, index, append) & result (field_index) integer :: field_index character(len=*), intent(in) :: name !< The name of a field that the user wishes to create !! a value for. -logical, intent(in) :: value !< The value that the user wishes to apply to the +logical, intent(in) :: new_lval !< The value that the user wishes to apply to the !! named field. logical, intent(in), optional :: create !< If present and .true., then a value for this !! field will be created. @@ -2881,7 +2881,7 @@ function fm_new_value_logical(name, value, create, index, append) & ! Assign the value and set the field_index for return ! for non-null fields (index_t > 0) if (index_t .gt. 0) then - temp_field_p%l_value(index_t) = value + temp_field_p%l_value(index_t) = new_lval if (index_t .gt. temp_field_p%max_index) then temp_field_p%max_index = index_t endif @@ -2898,12 +2898,12 @@ end function fm_new_value_logical !> @brief Assigns a given value to a given field !> @returns An index for the named field -function fm_new_value_string(name, value, create, index, append) & +function fm_new_value_string(name, new_sval, create, index, append) & result (field_index) integer :: field_index character(len=*), intent(in) :: name !< The name of a field that the user wishes to create !! a value for. -character(len=*), intent(in) :: value !< The value that the user wishes to apply to the +character(len=*), intent(in) :: new_sval !< The value that the user wishes to apply to the !! named field. logical, intent(in), optional :: create !< If present and .true., then a value for this !! field will be created. @@ -3014,7 +3014,7 @@ function fm_new_value_string(name, value, create, index, append) & ! Assign the value and set the field_index for return ! for non-null fields (index_t > 0) if (index_t .gt. 0) then - temp_field_p%s_value(index_t) = value + temp_field_p%s_value(index_t) = new_sval if (index_t .gt. temp_field_p%max_index) then temp_field_p%max_index = index_t endif diff --git a/field_manager/fm_util.F90 b/field_manager/fm_util.F90 index db729c5ef5..41432ca9e3 100644 --- a/field_manager/fm_util.F90 +++ b/field_manager/fm_util.F90 @@ -1129,7 +1129,7 @@ end function fm_util_get_string_array !} !> Get an integer value from the Field Manager tree. function fm_util_get_integer(name, caller, index, default_value, scalar) & - result (value) !{ + result (ival) !{ implicit none @@ -1137,7 +1137,7 @@ function fm_util_get_integer(name, caller, index, default_value, scalar) ! Return type ! -integer :: value +integer :: ival ! ! arguments @@ -1223,11 +1223,11 @@ function fm_util_get_integer(name, caller, index, default_value, scalar) fm_type = fm_get_type(name) if (fm_type .eq. 'integer') then !{ - if (.not. fm_get_value(name, value, index = index_t)) then !{ + if (.not. fm_get_value(name, ival, index = index_t)) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem getting ' // trim(name)) endif !} elseif (fm_type .eq. ' ' .and. present(default_value)) then !}{ - value = default_value + ival = default_value elseif (fm_type .eq. ' ') then !}{ call mpp_error(FATAL, trim(error_header) // ' Field does not exist: ' // trim(name)) else !}{ @@ -1242,7 +1242,7 @@ end function fm_util_get_integer !} !> Get a logical value from the Field Manager tree. function fm_util_get_logical(name, caller, index, default_value, scalar) & - result (value) !{ + result (lval) !{ implicit none @@ -1250,7 +1250,7 @@ function fm_util_get_logical(name, caller, index, default_value, scalar) ! Return type ! -logical :: value +logical :: lval ! ! arguments @@ -1336,11 +1336,11 @@ function fm_util_get_logical(name, caller, index, default_value, scalar) fm_type = fm_get_type(name) if (fm_type .eq. 'logical') then !{ - if (.not. fm_get_value(name, value, index = index_t)) then !{ + if (.not. fm_get_value(name, lval, index = index_t)) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem getting ' // trim(name)) endif !} elseif (fm_type .eq. ' ' .and. present(default_value)) then !}{ - value = default_value + lval = default_value elseif (fm_type .eq. ' ') then !}{ call mpp_error(FATAL, trim(error_header) // ' Field does not exist: ' // trim(name)) else !}{ @@ -1356,7 +1356,7 @@ end function fm_util_get_logical !} !> Get a real value from the Field Manager tree. function fm_util_get_real(name, caller, index, default_value, scalar) & - result (value) !{ + result (rval) !{ implicit none @@ -1364,7 +1364,7 @@ function fm_util_get_real(name, caller, index, default_value, scalar) ! Return type ! -real(r8_kind) :: value +real(r8_kind) :: rval ! ! arguments @@ -1451,16 +1451,16 @@ function fm_util_get_real(name, caller, index, default_value, scalar) fm_type = fm_get_type(name) if (fm_type .eq. 'real') then !{ - if (.not. fm_get_value(name, value, index = index_t)) then !{ + if (.not. fm_get_value(name, rval, index = index_t)) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem getting ' // trim(name)) endif !} else if (fm_type .eq. 'integer') then if (.not. fm_get_value(name, ivalue, index = index_t)) then call mpp_error(FATAL, trim(error_header) // ' Problem getting ' // trim(name)) endif - value = real(ivalue,r8_kind) + rval = real(ivalue,r8_kind) elseif (fm_type .eq. ' ' .and. present(default_value)) then !}{ - value = default_value + rval = default_value elseif (fm_type .eq. ' ') then !}{ call mpp_error(FATAL, trim(error_header) // ' Field does not exist: ' // trim(name)) else !}{ @@ -1477,7 +1477,7 @@ end function fm_util_get_real !} !> Get a string value from the Field Manager tree. function fm_util_get_string(name, caller, index, default_value, scalar) & - result (value) !{ + result (sval) !{ implicit none @@ -1485,7 +1485,7 @@ function fm_util_get_string(name, caller, index, default_value, scalar) ! Return type ! -character(len=fm_string_len) :: value +character(len=fm_string_len) :: sval ! ! arguments @@ -1571,11 +1571,11 @@ function fm_util_get_string(name, caller, index, default_value, scalar) fm_type = fm_get_type(name) if (fm_type .eq. 'string') then !{ - if (.not. fm_get_value(name, value, index = index_t)) then !{ + if (.not. fm_get_value(name, sval, index = index_t)) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem getting ' // trim(name)) endif !} elseif (fm_type .eq. ' ' .and. present(default_value)) then !}{ - value = default_value + sval = default_value elseif (fm_type .eq. ' ') then !}{ call mpp_error(FATAL, trim(error_header) // ' Field does not exist: ' // trim(name)) else !}{ @@ -1589,7 +1589,7 @@ end function fm_util_get_string !} !####################################################################### !> Set an integer array in the Field Manager tree. -subroutine fm_util_set_value_integer_array(name, value, length, caller, no_overwrite, good_name_list) !{ +subroutine fm_util_set_value_integer_array(name, ival, length, caller, no_overwrite, good_name_list) !{ implicit none @@ -1599,7 +1599,7 @@ subroutine fm_util_set_value_integer_array(name, value, length, caller, no_overw character(len=*), intent(in) :: name integer, intent(in) :: length -integer, intent(in) :: value(length) +integer, intent(in) :: ival(length) character(len=*), intent(in), optional :: caller logical, intent(in), optional :: no_overwrite character(len=fm_path_name_len), intent(in), optional :: good_name_list @@ -1698,19 +1698,19 @@ subroutine fm_util_set_value_integer_array(name, value, length, caller, no_overw call mpp_error(FATAL, trim(error_header) // ' Problem getting length of ' // trim(name)) endif !} do n = field_length + 1, length !{ - field_index = fm_new_value(name, value(n), index = n) + field_index = fm_new_value(name, ival(n), index = n) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', n call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) endif !} enddo !} n else !}{ - field_index = fm_new_value(name, value(1)) + field_index = fm_new_value(name, ival(1)) if (field_index .le. 0) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name)) endif !} do n = 2, length !{ - field_index = fm_new_value(name, value(n), index = n) + field_index = fm_new_value(name, ival(n), index = n) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', n call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) @@ -1746,7 +1746,7 @@ end subroutine fm_util_set_value_integer_array !} !####################################################################### !> Set a logical array in the Field Manager tree. -subroutine fm_util_set_value_logical_array(name, value, length, caller, no_overwrite, good_name_list) !{ +subroutine fm_util_set_value_logical_array(name, lval, length, caller, no_overwrite, good_name_list) !{ implicit none @@ -1756,7 +1756,7 @@ subroutine fm_util_set_value_logical_array(name, value, length, caller, no_overw character(len=*), intent(in) :: name integer, intent(in) :: length -logical, intent(in) :: value(length) +logical, intent(in) :: lval(length) character(len=*), intent(in), optional :: caller logical, intent(in), optional :: no_overwrite character(len=fm_path_name_len), intent(in), optional :: good_name_list @@ -1855,19 +1855,19 @@ subroutine fm_util_set_value_logical_array(name, value, length, caller, no_overw call mpp_error(FATAL, trim(error_header) // ' Problem getting length of ' // trim(name)) endif !} do n = field_length + 1, length !{ - field_index = fm_new_value(name, value(n), index = n) + field_index = fm_new_value(name, lval(n), index = n) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', n call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) endif !} enddo !} n else !}{ - field_index = fm_new_value(name, value(1)) + field_index = fm_new_value(name, lval(1)) if (field_index .le. 0) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name)) endif !} do n = 2, length !{ - field_index = fm_new_value(name, value(n), index = n) + field_index = fm_new_value(name, lval(n), index = n) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', n call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) @@ -1903,7 +1903,7 @@ end subroutine fm_util_set_value_logical_array !} !####################################################################### !> Set a string array in the Field Manager tree. -subroutine fm_util_set_value_string_array(name, value, length, caller, no_overwrite, good_name_list) !{ +subroutine fm_util_set_value_string_array(name, sval, length, caller, no_overwrite, good_name_list) !{ implicit none @@ -1913,7 +1913,7 @@ subroutine fm_util_set_value_string_array(name, value, length, caller, no_overwr character(len=*), intent(in) :: name integer, intent(in) :: length -character(len=*), intent(in) :: value(length) +character(len=*), intent(in) :: sval(length) character(len=*), intent(in), optional :: caller logical, intent(in), optional :: no_overwrite character(len=fm_path_name_len), intent(in), optional :: good_name_list @@ -2012,19 +2012,19 @@ subroutine fm_util_set_value_string_array(name, value, length, caller, no_overwr call mpp_error(FATAL, trim(error_header) // ' Problem getting length of ' // trim(name)) endif !} do n = field_length + 1, length !{ - field_index = fm_new_value(name, value(n), index = n) + field_index = fm_new_value(name, sval(n), index = n) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', n call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) endif !} enddo !} n else !}{ - field_index = fm_new_value(name, value(1)) + field_index = fm_new_value(name, sval(1)) if (field_index .le. 0) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name)) endif !} do n = 2, length !{ - field_index = fm_new_value(name, value(n), index = n) + field_index = fm_new_value(name, sval(n), index = n) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', n call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) @@ -2060,7 +2060,7 @@ end subroutine fm_util_set_value_string_array !} !####################################################################### !> Set an integer value in the Field Manager tree. -subroutine fm_util_set_value_integer(name, value, caller, index, append, no_create, & +subroutine fm_util_set_value_integer(name, ival, caller, index, append, no_create, & no_overwrite, good_name_list) !{ implicit none @@ -2070,7 +2070,7 @@ subroutine fm_util_set_value_integer(name, value, caller, index, append, no_crea ! character(len=*), intent(in) :: name -integer, intent(in) :: value +integer, intent(in) :: ival character(len=*), intent(in), optional :: caller integer, intent(in), optional :: index logical, intent(in), optional :: append @@ -2170,21 +2170,21 @@ subroutine fm_util_set_value_integer(name, value, caller, index, append, no_crea call mpp_error(FATAL, trim(error_header) // ' Problem getting length of ' // trim(name)) endif !} if (.not. (no_overwrite_use .and. field_length .ge. index)) then !{ - field_index = fm_new_value(name, value, index = index) + field_index = fm_new_value(name, ival, index = index) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', index call mpp_error(FATAL, trim(error_header) // ' Problem overwriting ' // trim(name) // trim(str_error)) endif !} endif !} else !}{ - field_index = fm_new_value(name, value, index = index) + field_index = fm_new_value(name, ival, index = index) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', index call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) endif !} endif !} elseif (present(append)) then !}{ - field_index = fm_new_value(name, value, append = append) + field_index = fm_new_value(name, ival, append = append) if (field_index .le. 0) then !{ write (str_error,*) ' with append = ', append call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) @@ -2192,13 +2192,13 @@ subroutine fm_util_set_value_integer(name, value, caller, index, append, no_crea else !}{ if (fm_exists(name)) then !{ if (.not. no_overwrite_use) then !{ - field_index = fm_new_value(name, value) + field_index = fm_new_value(name, ival) if (field_index .le. 0) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem overwriting ' // trim(name)) endif !} endif !} elseif (create) then !}{ - field_index = fm_new_value(name, value) + field_index = fm_new_value(name, ival) if (field_index .le. 0) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem creating ' // trim(name)) endif !} @@ -2232,7 +2232,7 @@ end subroutine fm_util_set_value_integer !} !####################################################################### !> Set a logical value in the Field Manager tree. -subroutine fm_util_set_value_logical(name, value, caller, index, append, no_create, & +subroutine fm_util_set_value_logical(name, lval, caller, index, append, no_create, & no_overwrite, good_name_list) !{ implicit none @@ -2242,7 +2242,7 @@ subroutine fm_util_set_value_logical(name, value, caller, index, append, no_crea ! character(len=*), intent(in) :: name -logical, intent(in) :: value +logical, intent(in) :: lval character(len=*), intent(in), optional :: caller integer, intent(in), optional :: index logical, intent(in), optional :: append @@ -2342,21 +2342,21 @@ subroutine fm_util_set_value_logical(name, value, caller, index, append, no_crea call mpp_error(FATAL, trim(error_header) // ' Problem getting length of ' // trim(name)) endif !} if (.not. (no_overwrite_use .and. field_length .ge. index)) then !{ - field_index = fm_new_value(name, value, index = index) + field_index = fm_new_value(name, lval, index = index) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', index call mpp_error(FATAL, trim(error_header) // ' Problem overwriting ' // trim(name) // trim(str_error)) endif !} endif !} else !}{ - field_index = fm_new_value(name, value, index = index) + field_index = fm_new_value(name, lval, index = index) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', index call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) endif !} endif !} elseif (present(append)) then !}{ - field_index = fm_new_value(name, value, append = append) + field_index = fm_new_value(name, lval, append = append) if (field_index .le. 0) then !{ write (str_error,*) ' with append = ', append call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) @@ -2364,13 +2364,13 @@ subroutine fm_util_set_value_logical(name, value, caller, index, append, no_crea else !}{ if (fm_exists(name)) then !{ if (.not. no_overwrite_use) then !{ - field_index = fm_new_value(name, value) + field_index = fm_new_value(name, lval) if (field_index .le. 0) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem overwriting ' // trim(name)) endif !} endif !} elseif (create) then !}{ - field_index = fm_new_value(name, value) + field_index = fm_new_value(name, lval) if (field_index .le. 0) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem creating ' // trim(name)) endif !} @@ -2403,7 +2403,7 @@ end subroutine fm_util_set_value_logical !} !####################################################################### !> Set a string value in the Field Manager tree. -subroutine fm_util_set_value_string(name, value, caller, index, append, no_create, & +subroutine fm_util_set_value_string(name, sval, caller, index, append, no_create, & no_overwrite, good_name_list) !{ implicit none @@ -2413,7 +2413,7 @@ subroutine fm_util_set_value_string(name, value, caller, index, append, no_creat ! character(len=*), intent(in) :: name -character(len=*), intent(in) :: value +character(len=*), intent(in) :: sval character(len=*), intent(in), optional :: caller integer, intent(in), optional :: index logical, intent(in), optional :: append @@ -2513,21 +2513,21 @@ subroutine fm_util_set_value_string(name, value, caller, index, append, no_creat call mpp_error(FATAL, trim(error_header) // ' Problem getting length of ' // trim(name)) endif !} if (.not. (no_overwrite_use .and. field_length .ge. index)) then !{ - field_index = fm_new_value(name, value, index = index) + field_index = fm_new_value(name, sval, index = index) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', index call mpp_error(FATAL, trim(error_header) // ' Problem overwriting ' // trim(name) // trim(str_error)) endif !} endif !} else !}{ - field_index = fm_new_value(name, value, index = index) + field_index = fm_new_value(name, sval, index = index) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', index call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) endif !} endif !} elseif (present(append)) then !}{ - field_index = fm_new_value(name, value, append = append) + field_index = fm_new_value(name, sval, append = append) if (field_index .le. 0) then !{ write (str_error,*) ' with append = ', append call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) @@ -2535,13 +2535,13 @@ subroutine fm_util_set_value_string(name, value, caller, index, append, no_creat else !}{ if (fm_exists(name)) then !{ if (.not. no_overwrite_use) then !{ - field_index = fm_new_value(name, value) + field_index = fm_new_value(name, sval) if (field_index .le. 0) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem overwriting ' // trim(name)) endif !} endif !} elseif (create) then !}{ - field_index = fm_new_value(name, value) + field_index = fm_new_value(name, sval) if (field_index .le. 0) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem creating ' // trim(name)) endif !} diff --git a/field_manager/include/field_manager.inc b/field_manager/include/field_manager.inc index bbf648d236..53f5f4bc7c 100644 --- a/field_manager/include/field_manager.inc +++ b/field_manager/include/field_manager.inc @@ -27,25 +27,25 @@ real(FMS_FM_KIND_), intent(out) :: values(:) !< The value or values that have be include 'parse.inc' end function PARSE_REALS_ -function PARSE_REAL_ ( text, label, value ) result (parse) +function PARSE_REAL_ ( text, label, parse_rval ) result (parse) character(len=*), intent(in) :: text !< The text string from which the values will be parsed. character(len=*), intent(in) :: label !< A label which describes the values being decoded. -real(FMS_FM_KIND_), intent(out) :: value !< The value or values that have been decoded. +real(FMS_FM_KIND_), intent(out) :: parse_rval !< The value or values that have been decoded. integer :: parse real(FMS_FM_KIND_) :: values(1) parse = PARSE_REALS_( text, label, values ) - if (parse > 0) value = values(1) + if (parse > 0) parse_rval = values(1) end function PARSE_REAL_ !> @returns A flag to indicate whether the function operated with (false) or without !! (true) errors. -function FM_GET_VALUE_REAL_(name, value, index) & +function FM_GET_VALUE_REAL_(name, get_rval, index) & result (success) logical :: success character(len=*), intent(in) :: name !< The name of a field that the user wishes to get a value for. -real(FMS_FM_KIND_), intent(out) :: value !< The value associated with the named field +real(FMS_FM_KIND_), intent(out) :: get_rval !< The value associated with the named field integer, intent(in), optional :: index !< An optional index to retrieve a single value from an array. integer :: index_t @@ -61,7 +61,7 @@ if (.not. module_is_initialized) then endif ! Must supply a field field name if (name .eq. ' ') then - value = 0.0_lkind + get_rval = 0.0_lkind success = .false. return endif @@ -79,19 +79,19 @@ if (associated(temp_field_p)) then if (temp_field_p%field_type .eq. real_type) then if (index_t .lt. 1 .or. index_t .gt. temp_field_p%max_index) then ! Index is not positive or is too large - value = 0.0_lkind + get_rval = 0.0_lkind success = .false. else ! extract the value; the value is stored as r8_kind - value = real(temp_field_p%r_value(index_t),lkind) + get_rval = real(temp_field_p%r_value(index_t),lkind) success = .true. endif else - value = 0.0_lkind + get_rval = 0.0_lkind success = .false. endif else - value = 0.0_lkind + get_rval = 0.0_lkind success = .false. endif @@ -99,12 +99,12 @@ end function FM_GET_VALUE_REAL_ !> @brief Assigns a given value to a given field !> @returns An index for the named field -function FM_NEW_VALUE_REAL_(name, value, create, index, append) & +function FM_NEW_VALUE_REAL_(name, new_rval, create, index, append) & result (field_index) integer :: field_index character(len=*), intent(in) :: name !< The name of a field that the user wishes to create !! a value for. -real(FMS_FM_KIND_), intent(in) :: value !< The value that the user wishes to apply to the +real(FMS_FM_KIND_), intent(in) :: new_rval !< The value that the user wishes to apply to the !! named field. logical, intent(in), optional :: create !< If present and .true., then a value for this !! field will be created. @@ -226,7 +226,7 @@ if (associated(temp_list_p)) then ! for non-null fields (index_t > 0) if (index_t .gt. 0) then ! all real field values are stored as r8_kind - temp_field_p%r_value(index_t) = real(value,r8_kind) + temp_field_p%r_value(index_t) = real(new_rval,r8_kind) if (index_t .gt. temp_field_p%max_index) then temp_field_p%max_index = index_t endif diff --git a/field_manager/include/fm_util.inc b/field_manager/include/fm_util.inc index a02011b8d5..26066ca868 100644 --- a/field_manager/include/fm_util.inc +++ b/field_manager/include/fm_util.inc @@ -23,7 +23,7 @@ !####################################################################### !> Set a real array in the Field Manager tree. -subroutine FM_UTIL_SET_VALUE_REAL_ARRAY_(name, value, length, caller, no_overwrite, good_name_list) !{ +subroutine FM_UTIL_SET_VALUE_REAL_ARRAY_(name, rval, length, caller, no_overwrite, good_name_list) !{ implicit none @@ -33,7 +33,7 @@ implicit none character(len=*), intent(in) :: name integer, intent(in) :: length -real(FMS_FM_KIND_), intent(in) :: value(length) +real(FMS_FM_KIND_), intent(in) :: rval(length) character(len=*), intent(in), optional :: caller logical, intent(in), optional :: no_overwrite character(len=fm_path_name_len), intent(in), optional :: good_name_list @@ -134,19 +134,19 @@ else !}{ call mpp_error(FATAL, trim(error_header) // ' Problem getting length of ' // trim(name)) endif !} do n = field_length + 1, length !{ - field_index = fm_new_value(name, value(n), index = n) + field_index = fm_new_value(name, rval(n), index = n) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', n call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) endif !} enddo !} n else !}{ - field_index = fm_new_value(name, value(1)) + field_index = fm_new_value(name, rval(1)) if (field_index .le. 0) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name)) endif !} do n = 2, length !{ - field_index = fm_new_value(name, value(n), index = n) + field_index = fm_new_value(name, rval(n), index = n) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', n call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) @@ -182,7 +182,7 @@ end subroutine FM_UTIL_SET_VALUE_REAL_ARRAY_ !} !####################################################################### !> Set a real value in the Field Manager tree. -subroutine FM_UTIL_SET_VALUE_REAL_(name, value, caller, index, append, no_create, & +subroutine FM_UTIL_SET_VALUE_REAL_(name, rval, caller, index, append, no_create, & no_overwrite, good_name_list) !{ implicit none @@ -192,7 +192,7 @@ implicit none ! character(len=*), intent(in) :: name -real(FMS_FM_KIND_), intent(in) :: value +real(FMS_FM_KIND_), intent(in) :: rval character(len=*), intent(in), optional :: caller integer, intent(in), optional :: index logical, intent(in), optional :: append @@ -292,21 +292,21 @@ if (present(index)) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem getting length of ' // trim(name)) endif !} if (.not. (no_overwrite_use .and. field_length .ge. index)) then !{ - field_index = fm_new_value(name, value, index = index) + field_index = fm_new_value(name, rval, index = index) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', index call mpp_error(FATAL, trim(error_header) // ' Problem overwriting ' // trim(name) // trim(str_error)) endif !} endif !} else !}{ - field_index = fm_new_value(name, value, index = index) + field_index = fm_new_value(name, rval, index = index) if (field_index .le. 0) then !{ write (str_error,*) ' with index = ', index call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) endif !} endif !} elseif (present(append)) then !}{ - field_index = fm_new_value(name, value, append = append) + field_index = fm_new_value(name, rval, append = append) if (field_index .le. 0) then !{ write (str_error,*) ' with append = ', append call mpp_error(FATAL, trim(error_header) // ' Problem setting ' // trim(name) // trim(str_error)) @@ -314,13 +314,13 @@ elseif (present(append)) then !}{ else !}{ if (fm_exists(name)) then !{ if (.not. no_overwrite_use) then !{ - field_index = fm_new_value(name, value) + field_index = fm_new_value(name, rval) if (field_index .le. 0) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem overwriting ' // trim(name)) endif !} endif !} elseif (create) then !}{ - field_index = fm_new_value(name, value) + field_index = fm_new_value(name, rval) if (field_index .le. 0) then !{ call mpp_error(FATAL, trim(error_header) // ' Problem creating ' // trim(name)) endif !} diff --git a/horiz_interp/include/horiz_interp_bilinear.inc b/horiz_interp/include/horiz_interp_bilinear.inc index 7b6fcd7ed2..b94dd0d01d 100644 --- a/horiz_interp/include/horiz_interp_bilinear.inc +++ b/horiz_interp/include/horiz_interp_bilinear.inc @@ -1187,11 +1187,11 @@ !! if "value" is outside the domain of "array" then INDP_ = 1 !! or "ia" depending on whether array(1) or array(ia) is !! closest to "value" - function INDP_ (value, array) + function INDP_ (rval, array) integer :: INDP_ !< index of nearest data point within "array" !! corresponding to "value". real(FMS_HI_KIND_), dimension(:), intent(in) :: array !< array of data points (must be monotonically increasing) - real(FMS_HI_KIND_), intent(in) :: value !< arbitrary data, same units as elements in 'array' + real(FMS_HI_KIND_), intent(in) :: rval !< arbitrary data, same units as elements in 'array' !======================================================================= @@ -1204,23 +1204,23 @@ unit = stdout() write (unit,*) & ' => Error: array must be monotonically increasing in "INDP_"' , & - ' when searching for nearest element to value=',value + ' when searching for nearest element to value=',rval write (unit,*) ' array(i) < array(i-1) for i=',i write (unit,*) ' array(i) for i=1..ia follows:' call mpp_error() endif enddo - if (value .lt. array(1) .or. value .gt. array(ia)) then - if (value .lt. array(1)) INDP_ = 1 - if (value .gt. array(ia)) INDP_ = ia + if (rval .lt. array(1) .or. rval .gt. array(ia)) then + if (rval .lt. array(1)) INDP_ = 1 + if (rval .gt. array(ia)) INDP_ = ia else i=1 keep_going = .true. do while (i .le. ia .and. keep_going) i = i+1 - if (value .le. array(i)) then + if (rval .le. array(i)) then INDP_ = i - if (array(i)-value .gt. value-array(i-1)) INDP_ = i-1 + if (array(i)-rval .gt. rval-array(i-1)) INDP_ = i-1 keep_going = .false. endif enddo diff --git a/mosaic2/mosaic2.F90 b/mosaic2/mosaic2.F90 index 0cb68f60ec..c76b30adb7 100644 --- a/mosaic2/mosaic2.F90 +++ b/mosaic2/mosaic2.F90 @@ -376,14 +376,14 @@ function transfer_to_model_index(istart, iend, refine_ratio) end function transfer_to_model_index !##################################################################### -function parse_string(string, set, value) +function parse_string(string, set, sval) character(len=*), intent(in) :: string character(len=*), intent(in) :: set - character(len=*), intent(out) :: value(:) + character(len=*), intent(out) :: sval(:) integer :: parse_string integer :: nelem, length, first, last - nelem = size(value(:)) + nelem = size(sval(:)) length = len_trim(string) first = 1; last = 0 @@ -392,17 +392,17 @@ function parse_string(string, set, value) do while(first .LE. length) parse_string = parse_string + 1 if(parse_string>nelem) then - call mpp_error(FATAL, "mosaic_mod(parse_string) : number of element is greater than size(value(:))") + call mpp_error(FATAL, "mosaic_mod(parse_string) : number of element is greater than size(sval(:))") endif last = first - 1 + scan(string(first:length), set) if(last == first-1 ) then ! not found, end of string - value(parse_string) = string(first:length) + sval(parse_string) = string(first:length) exit else if(last <= first) then call mpp_error(FATAL, "mosaic_mod(parse_string) : last <= first") endif - value(parse_string) = string(first:(last-1)) + sval(parse_string) = string(first:(last-1)) first = last + 1 ! scan to make sure the next is not the character in the set do while (first == last+1) diff --git a/mpp/include/mpp_util.inc b/mpp/include/mpp_util.inc index ee3e3dcc59..e6af1ba157 100644 --- a/mpp/include/mpp_util.inc +++ b/mpp/include/mpp_util.inc @@ -156,20 +156,20 @@ subroutine mpp_error_noargs() end subroutine mpp_error_noargs !##################################################################### -subroutine mpp_error_Is(errortype, errormsg1, value, errormsg2) +subroutine mpp_error_Is(errortype, errormsg1, mpp_ival, errormsg2) integer, intent(in) :: errortype - INTEGER, intent(in) :: value + INTEGER, intent(in) :: mpp_ival character(len=*), intent(in) :: errormsg1 character(len=*), intent(in), optional :: errormsg2 - call mpp_error( errortype, errormsg1, (/value/), errormsg2) + call mpp_error( errortype, errormsg1, (/mpp_ival/), errormsg2) end subroutine mpp_error_Is !##################################################################### -subroutine mpp_error_Rs(errortype, errormsg1, value, errormsg2) +subroutine mpp_error_Rs(errortype, errormsg1, mpp_rval, errormsg2) integer, intent(in) :: errortype - REAL, intent(in) :: value + REAL, intent(in) :: mpp_rval character(len=*), intent(in) :: errormsg1 character(len=*), intent(in), optional :: errormsg2 - call mpp_error( errortype, errormsg1, (/value/), errormsg2) + call mpp_error( errortype, errormsg1, (/mpp_rval/), errormsg2) end subroutine mpp_error_Rs !##################################################################### subroutine mpp_error_Ia(errortype, errormsg1, array, errormsg2)