diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90
index d6078b653..436a629ed 100644
--- a/diag_manager/diag_manager.F90
+++ b/diag_manager/diag_manager.F90
@@ -369,11 +369,8 @@ MODULE diag_manager_mod
!> @brief Add a attribute to the output field
!> @ingroup diag_manager_mod
INTERFACE diag_field_add_attribute
- MODULE PROCEDURE diag_field_add_attribute_scalar_r
- MODULE PROCEDURE diag_field_add_attribute_scalar_i
- MODULE PROCEDURE diag_field_add_attribute_scalar_c
- MODULE PROCEDURE diag_field_add_attribute_r1d
- MODULE PROCEDURE diag_field_add_attribute_i1d
+ MODULE PROCEDURE diag_field_add_attribute_1d
+ MODULE PROCEDURE diag_field_add_attribute_0d
END INTERFACE diag_field_add_attribute
!> @addtogroup diag_manager_mod
@@ -4496,70 +4493,66 @@ SUBROUTINE diag_field_attribute_init(diag_field_id, name, type, cval, ival, rval
END IF
END SUBROUTINE diag_field_attribute_init
- !> @brief Add a scalar real attribute to the diag field corresponding to a given id
- SUBROUTINE diag_field_add_attribute_scalar_r(diag_field_id, att_name, att_value)
- INTEGER, INTENT(in) :: diag_field_id !< ID number for field to add attribute to
- CHARACTER(len=*), INTENT(in) :: att_name !< new attribute name
- REAL, INTENT(in) :: att_value !< new attribute value
+ !> @brief Add a scalr attribute to the diag field corresponding to a given id
+ subroutine diag_field_add_attribute_0d(diag_field_id, att_name, att_value)
+ INTEGER, INTENT(in) :: diag_field_id !< ID number for field to add attribute to
+ CHARACTER(len=*), INTENT(in) :: att_name !< new attribute name
+ class(*), INTENT(in) :: att_value !< new attribute value
if (use_modern_diag) then
- call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, (/att_value /))
- else
- CALL diag_field_add_attribute_r1d(diag_field_id, att_name, (/ att_value /))
- endif
- END SUBROUTINE diag_field_add_attribute_scalar_r
-
- !> @brief Add a scalar integer attribute to the diag field corresponding to a given id
- SUBROUTINE diag_field_add_attribute_scalar_i(diag_field_id, att_name, att_value)
- INTEGER, INTENT(in) :: diag_field_id !< ID number for field to add attribute to
- CHARACTER(len=*), INTENT(in) :: att_name !< new attribute name
- INTEGER, INTENT(in) :: att_value !< new attribute value
-
- if (use_modern_diag) then
- call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, (/att_value /))
- else
- CALL diag_field_add_attribute_i1d(diag_field_id, att_name, (/ att_value /))
- endif
- END SUBROUTINE diag_field_add_attribute_scalar_i
-
- !> @brief Add a scalar character attribute to the diag field corresponding to a given id
- SUBROUTINE diag_field_add_attribute_scalar_c(diag_field_id, att_name, att_value)
- INTEGER, INTENT(in) :: diag_field_id !< ID number for field to add attribute to
- CHARACTER(len=*), INTENT(in) :: att_name !< new attribute name
- CHARACTER(len=*), INTENT(in) :: att_value !< new attribute value
-
- if (use_modern_diag) then
- call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, (/att_value /))
+ select type(att_value)
+ type is (real(kind=r4_kind))
+ call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, (/att_value /))
+ type is (real(kind=r8_kind))
+ call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, (/att_value /))
+ type is (integer(kind=i4_kind))
+ call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, (/att_value /))
+ type is (character(len=*))
+ call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, (/att_value /))
+ class default
+ call mpp_error(FATAL, "Diag_field_add_attribute 0d:: unsupported type. The acceptable types "//&
+ "are float, double, integer, and string")
+ end select
else
- CALL diag_field_attribute_init(diag_field_id, att_name, NF90_CHAR, cval=att_value)
+ select type(att_value)
+ type is (real(kind=r4_kind))
+ CALL diag_field_attribute_init(diag_field_id, att_name, NF90_FLOAT, rval=real((/att_value/)))
+ type is (real(kind=r8_kind))
+ CALL diag_field_attribute_init(diag_field_id, att_name, NF90_FLOAT, rval=real((/att_value/)))
+ type is (integer(kind=i4_kind))
+ CALL diag_field_attribute_init(diag_field_id, att_name, NF90_INT, ival=(/att_value/))
+ type is (character(len=*))
+ CALL diag_field_attribute_init(diag_field_id, att_name, NF90_CHAR, cval=att_value)
+ class default
+ call mpp_error(FATAL, "Diag_field_add_attribute 0d:: unsupported type. The acceptable types "//&
+ "are float, double, integer, and string")
+ end select
endif
- END SUBROUTINE diag_field_add_attribute_scalar_c
- !> @brief Add a real 1D array attribute to the diag field corresponding to a given id
- SUBROUTINE diag_field_add_attribute_r1d(diag_field_id, att_name, att_value)
- INTEGER, INTENT(in) :: diag_field_id !< ID number for field to add attribute to
- CHARACTER(len=*), INTENT(in) :: att_name !< new attribute name
- REAL, DIMENSION(:), INTENT(in) :: att_value !< new attribute value
+ end subroutine diag_field_add_attribute_0d
- if (use_modern_diag) then
- call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, att_value)
- else
- CALL diag_field_attribute_init(diag_field_id, att_name, NF90_FLOAT, rval=att_value)
- endif
- END SUBROUTINE diag_field_add_attribute_r1d
-
- !> @brief Add an integer 1D array attribute to the diag field corresponding to a given id
- SUBROUTINE diag_field_add_attribute_i1d(diag_field_id, att_name, att_value)
- INTEGER, INTENT(in) :: diag_field_id !< ID number for field to add attribute to
- CHARACTER(len=*), INTENT(in) :: att_name !< new attribute name
- INTEGER, DIMENSION(:), INTENT(in) :: att_value !< new attribute value
+ !> @brief Add an 1D array attribute to the diag field corresponding to a given id
+ subroutine diag_field_add_attribute_1d(diag_field_id, att_name, att_value)
+ INTEGER, INTENT(in) :: diag_field_id !< ID number for field to add attribute to
+ CHARACTER(len=*), INTENT(in) :: att_name !< new attribute name
+ class(*), INTENT(in) :: att_value(:) !< new attribute value
if (use_modern_diag) then
call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, att_value)
else
- CALL diag_field_attribute_init(diag_field_id, att_name, NF90_INT, ival=att_value)
+ select type(att_value)
+ type is (real(kind=r4_kind))
+ CALL diag_field_attribute_init(diag_field_id, att_name, NF90_FLOAT, rval=real(att_value))
+ type is (real(kind=r8_kind))
+ CALL diag_field_attribute_init(diag_field_id, att_name, NF90_FLOAT, rval=real(att_value))
+ type is (integer(kind=i4_kind))
+ CALL diag_field_attribute_init(diag_field_id, att_name, NF90_INT, ival=att_value)
+ class default
+ call mpp_error(FATAL, "Diag_field_add_attribute 1d:: unsupported type. The acceptable types "//&
+ "are float, double, and integer")
+ end select
endif
- END SUBROUTINE diag_field_add_attribute_i1d
+ end subroutine diag_field_add_attribute_1d
!> @brief Add the cell_measures attribute to a diag out field
!!
diff --git a/test_fms/diag_manager/Makefile.am b/test_fms/diag_manager/Makefile.am
index 2d7d6440a..94d41a12a 100644
--- a/test_fms/diag_manager/Makefile.am
+++ b/test_fms/diag_manager/Makefile.am
@@ -34,7 +34,7 @@ check_PROGRAMS = test_diag_manager test_diag_manager_time \
check_time_min check_time_max check_time_sum check_time_avg test_diag_diurnal check_time_diurnal \
check_time_pow check_time_rms check_subregional test_cell_measures test_var_masks \
check_var_masks test_multiple_send_data test_diag_out_yaml test_output_every_freq \
- test_dm_weights test_prepend_date test_ens_runs
+ test_dm_weights test_prepend_date test_ens_runs test_diag_attribute_add
# This is the source code for the test.
test_output_every_freq_SOURCES = test_output_every_freq.F90
@@ -66,6 +66,7 @@ check_var_masks_SOURCES = check_var_masks.F90
test_multiple_send_data_SOURCES = test_multiple_send_data.F90
test_prepend_date_SOURCES = test_prepend_date.F90
test_ens_runs_SOURCES = test_ens_runs.F90
+test_diag_attribute_add_SOURCES = test_diag_attribute_add.F90
TEST_EXTENSIONS = .sh
SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \
@@ -75,7 +76,7 @@ SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \
TESTS = test_diag_manager2.sh test_time_none.sh test_time_min.sh test_time_max.sh test_time_sum.sh \
test_time_avg.sh test_time_pow.sh test_time_rms.sh test_time_diurnal.sh test_cell_measures.sh \
test_subregional.sh test_var_masks.sh test_multiple_send_data.sh test_output_every_freq.sh \
- test_dm_weights.sh test_flush_nc_file.sh test_prepend_date.sh test_ens_runs.sh
+ test_dm_weights.sh test_flush_nc_file.sh test_prepend_date.sh test_ens_runs.sh test_diag_attribute_add.sh
testing_utils.mod: testing_utils.$(OBJEXT)
@@ -84,7 +85,7 @@ EXTRA_DIST = test_diag_manager2.sh check_crashes.sh test_time_none.sh test_time_
test_time_sum.sh test_time_avg.sh test_time_pow.sh test_time_rms.sh test_time_diurnal.sh \
test_cell_measures.sh test_subregional.sh test_var_masks.sh test_multiple_send_data.sh \
test_flush_nc_file.sh test_dm_weights.sh test_output_every_freq.sh test_prepend_date.sh \
- test_ens_runs.sh
+ test_ens_runs.sh test_diag_attribute_add.sh
if USING_YAML
skipflag=""
diff --git a/test_fms/diag_manager/test_diag_attribute_add.F90 b/test_fms/diag_manager/test_diag_attribute_add.F90
new file mode 100644
index 000000000..e7a756b47
--- /dev/null
+++ b/test_fms/diag_manager/test_diag_attribute_add.F90
@@ -0,0 +1,120 @@
+!***********************************************************************
+!* 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_diag_attribute_add
+ use platform_mod, only: r4_kind, r8_kind
+ use mpp_mod, only: FATAL, mpp_error
+ use fms_mod, only: fms_init, fms_end
+ use diag_manager_mod, only: diag_axis_init, register_static_field, diag_send_complete, send_data
+ use diag_manager_mod, only: register_diag_field, diag_field_add_attribute
+ use diag_manager_mod, only: diag_manager_init, diag_manager_end, diag_manager_set_time_end
+ use time_manager_mod, only: time_type, set_calendar_type, set_date, JULIAN, set_time, OPERATOR(+)
+ use fms2_io_mod
+
+ implicit none
+
+ integer :: id_potatoes
+ integer :: i
+ type(time_type) :: Time
+ type(time_type) :: Time_step
+ logical :: used
+ real(kind=r4_kind) :: fbuffer(2) = (/ 13., 14./)
+ real(kind=r8_kind) :: dbuffer(2) = (/ 23., 24./)
+ integer :: ibuffer(2) = (/ 551, 552/)
+ character(len=20) :: cbuffer = "Hello World"
+
+ call fms_init()
+ call set_calendar_type(JULIAN)
+ call diag_manager_init()
+
+ Time = set_date(2,1,1,0,0,0)
+ Time_step = set_time (3600*4,0)
+ call diag_manager_set_time_end(set_date(2,1,2,0,0,0))
+
+ id_potatoes = register_diag_field ('food_mod', 'potatoes', init_time=Time)
+ call diag_field_add_attribute(id_potatoes, "real_32", fbuffer(1))
+ call diag_field_add_attribute(id_potatoes, "real_32_1d", fbuffer)
+ call diag_field_add_attribute(id_potatoes, "real_64", dbuffer(1))
+ call diag_field_add_attribute(id_potatoes, "real_64_1d", dbuffer )
+ call diag_field_add_attribute(id_potatoes, "integer", ibuffer(1))
+ call diag_field_add_attribute(id_potatoes, "integer_1d", ibuffer)
+ call diag_field_add_attribute(id_potatoes, "some_string", cbuffer)
+
+ do i = 1, 6
+ Time = Time + Time_step
+ used = send_data(id_potatoes, real(103.201), Time)
+ call diag_send_complete(Time_step)
+ enddo
+
+ call diag_manager_end(Time)
+
+ call check_output()
+ call fms_end()
+
+ contains
+
+ subroutine check_output()
+ type(FmsNetcdfFile_t) :: fileobj !< FMS2io fileobj
+ character(len=256) :: cbuffer_out !< Buffer to read stuff into
+ integer :: ibuffer_out(2)
+ real(kind=r4_kind) :: fbuffer_out(2)
+ real(kind=r8_kind) :: dbuffer_out(2)
+
+ if (.not. open_file(fileobj, "food_file.nc", "read")) &
+ call mpp_error(FATAL, "food_file.nc was not created by the diag manager!")
+ if (.not. variable_exists(fileobj, "potatoes")) &
+ call mpp_error(FATAL, "potatoes is not in food_file.nc")
+
+ !! Checking the string attributes
+ call get_variable_attribute(fileobj, "potatoes", "some_string", cbuffer_out)
+ if (trim(cbuffer_out) .ne. trim(cbuffer)) call mpp_error(FATAL, "some_string is not the expected attribute")
+
+ !! Checking the integer attributes
+ ibuffer_out = -999
+ call get_variable_attribute(fileobj, "potatoes", "integer", ibuffer_out(1))
+ if (ibuffer(1) .ne. ibuffer_out(1)) call mpp_error(FATAL, "integer is not the expected attribute")
+
+ ibuffer_out = -999
+ call get_variable_attribute(fileobj, "potatoes", "integer_1d", ibuffer_out)
+ if (ibuffer(1) .ne. ibuffer_out(1)) call mpp_error(FATAL, "integer_1d is not the expected attribute")
+ if (ibuffer(2) .ne. ibuffer_out(2)) call mpp_error(FATAL, "integer_1d is not the expected attribute")
+
+ !! Checking the double attributes
+ dbuffer_out = -999
+ call get_variable_attribute(fileobj, "potatoes", "real_64", dbuffer_out(1))
+ if (dbuffer(1) .ne. dbuffer_out(1)) call mpp_error(FATAL, "real_64 is not the expected attribute")
+
+ dbuffer_out = -999
+ call get_variable_attribute(fileobj, "potatoes", "real_64_1d", dbuffer_out)
+ if (dbuffer(1) .ne. dbuffer_out(1)) call mpp_error(FATAL, "real_64_1d is not the expected attribute")
+ if (dbuffer(2) .ne. dbuffer_out(2)) call mpp_error(FATAL, "real_64_1d is not the expected attribute")
+
+ !! Checking the float attributes
+ fbuffer_out = -999
+ call get_variable_attribute(fileobj, "potatoes", "real_32", fbuffer_out(1))
+ if (fbuffer(1) .ne. fbuffer_out(1)) call mpp_error(FATAL, "real_32 is not the expected attribute")
+
+ fbuffer_out = -999
+ call get_variable_attribute(fileobj, "potatoes", "real_32_1d", fbuffer_out)
+ if (fbuffer(1) .ne. fbuffer_out(1)) call mpp_error(FATAL, "real_32_1d is not the expected attribute")
+ if (fbuffer(2) .ne. fbuffer_out(2)) call mpp_error(FATAL, "real_32_1d is not the expected attribute")
+
+ call close_file(fileobj)
+ end subroutine check_output
+end program test_diag_attribute_add
\ No newline at end of file
diff --git a/test_fms/diag_manager/test_diag_attribute_add.sh b/test_fms/diag_manager/test_diag_attribute_add.sh
new file mode 100755
index 000000000..f7f9caf92
--- /dev/null
+++ b/test_fms/diag_manager/test_diag_attribute_add.sh
@@ -0,0 +1,60 @@
+#!/bin/sh
+
+#***********************************************************************
+#* 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 .
+#***********************************************************************
+
+# Set common test settings.
+. ../test-lib.sh
+
+if [ -z "${skipflag}" ]; then
+# create and enter directory for in/output files
+output_dir
+
+cat <<_EOF > diag_table.yaml
+title: test_diag_manager
+base_date: 2 1 1 0 0 0
+
+diag_files:
+- file_name: food_file
+ freq: 4 hours
+ time_units: hours
+ unlimdim: time
+ reduction: none
+ kind: r4
+ module: food_mod
+ varlist:
+ - var_name: potatoes
+_EOF
+
+# remove any existing files that would result in false passes during checks
+rm -f *.nc
+
+my_test_count=1
+cat <<_EOF > input.nml
+&diag_manager_nml
+ use_modern_diag=.true.
+ max_field_attributes = 10
+/
+_EOF
+
+test_expect_success "Testing diag_field_attribute_add (test $my_test_count)" '
+ mpirun -n 1 ../test_diag_attribute_add
+'
+fi
+test_done