Skip to content

Commit

Permalink
feat: modifydiag_field_add_attribute to accept r4 and r8 (#1625)
Browse files Browse the repository at this point in the history
  • Loading branch information
uramirez8707 authored Jan 2, 2025
1 parent 9256dfd commit b77aae9
Show file tree
Hide file tree
Showing 4 changed files with 235 additions and 61 deletions.
109 changes: 51 additions & 58 deletions diag_manager/diag_manager.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
!!
Expand Down
7 changes: 4 additions & 3 deletions test_fms/diag_manager/Makefile.am
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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) \
Expand All @@ -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)

Expand All @@ -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=""
Expand Down
120 changes: 120 additions & 0 deletions test_fms/diag_manager/test_diag_attribute_add.F90
Original file line number Diff line number Diff line change
@@ -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 <http://www.gnu.org/licenses/>.
!***********************************************************************

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
60 changes: 60 additions & 0 deletions test_fms/diag_manager/test_diag_attribute_add.sh
Original file line number Diff line number Diff line change
@@ -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 <http://www.gnu.org/licenses/>.
#***********************************************************************

# 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

0 comments on commit b77aae9

Please sign in to comment.