Skip to content

Commit

Permalink
use consistent 'real' values
Browse files Browse the repository at this point in the history
  • Loading branch information
@uramirez8707
uramirez8707 committed Dec 11, 2024
1 parent 4252227 commit 4829fe8
Showing 1 changed file with 44 additions and 88 deletions.
132 changes: 44 additions & 88 deletions diag_manager/diag_manager.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4493,90 +4493,42 @@ 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

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 /))
else
CALL diag_field_attribute_init(diag_field_id, att_name, NF90_CHAR, cval=att_value)
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

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

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)
endif
END SUBROUTINE diag_field_add_attribute_i1d

!> @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

select type(att_value)
type is (real(kind=r4_kind))
call diag_field_add_attribute_scalar_r(diag_field_id, att_name, real(att_value))
type is (real(kind=r8_kind))
call diag_field_add_attribute_scalar_r(diag_field_id, att_name, real(att_value))
type is (integer(kind=i4_kind))
call diag_field_add_attribute_scalar_i(diag_field_id, att_name, att_value)
type is (character(len=*))
call diag_field_add_attribute_scalar_c(diag_field_id, att_name, att_value)
class default
call mpp_error(FATAL, "Diag_field_add_attribute 0d:: unsupported type. The acceptable types "//&
if (use_modern_diag) then
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
end select
else
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_0d

!> @brief Add an 1D array attribute to the diag field corresponding to a given id
Expand All @@ -4585,17 +4537,21 @@ subroutine diag_field_add_attribute_1d(diag_field_id, att_name, att_value)
CHARACTER(len=*), INTENT(in) :: att_name !< new attribute name
class(*), INTENT(in) :: att_value(:) !< new attribute value

select type(att_value)
type is (real(kind=r4_kind))
call diag_field_add_attribute_r1d(diag_field_id, att_name, real(att_value))
type is (real(kind=r8_kind))
call diag_field_add_attribute_r1d(diag_field_id, att_name, real(att_value))
type is (integer(kind=i4_kind))
call diag_field_add_attribute_i1d(diag_field_id, att_name, 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
if (use_modern_diag) then
call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, att_value)
else
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_1d

!> @brief Add the cell_measures attribute to a diag out field
Expand Down

0 comments on commit 4829fe8

Please sign in to comment.