FMS 2025.01.02-dev
Flexible Modeling System
Loading...
Searching...
No Matches
register_variable_attribute.inc
1!***********************************************************************
2!* GNU Lesser General Public License
3!*
4!* This file is part of the GFDL Flexible Modeling System (FMS).
5!*
6!* FMS is free software: you can redistribute it and/or modify it under
7!* the terms of the GNU Lesser General Public License as published by
8!* the Free Software Foundation, either version 3 of the License, or (at
9!* your option) any later version.
10!*
11!* FMS is distributed in the hope that it will be useful, but WITHOUT
12!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14!* for more details.
15!*
16!* You should have received a copy of the GNU Lesser General Public
17!* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18!***********************************************************************
19!> @file
20!> @brief Routines to add variable attributes for different dimensions to be used in
21!! the @ref register_variable_attribute interface
22
23!> @addtogroup fms2_io_mod
24!> @{
25
26!> @brief Add an attribute to a variable.
27subroutine register_variable_attribute_0d(fileobj, variable_name, attribute_name, &
28 attribute_value, str_len)
29
30 class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
31 character(len=*), intent(in) :: variable_name !< Variable name.
32 character(len=*), intent(in) :: attribute_name !< Attribute name.
33 class(*), intent(in) :: attribute_value !< Attribute value
34 integer, intent(in), optional :: str_len !< Length of the string
35
36 integer :: varid
37 integer :: err
38 integer :: axtype
39 integer :: xtype
40 integer(kind=i4_kind), dimension(2) :: i32_range
41 integer(kind=i8_kind), dimension(2) :: i64_range
42 real(kind=r4_kind), dimension(2) :: r32_range
43 real(kind=r8_kind), dimension(2) :: r64_range
44 character(len=200) :: append_error_msg !< Msg to be appended to FATAL error message
45
46 append_error_msg = "register_variable_attribute_0d: file:"//trim(fileobj%path)//"- variable:"//&
47 &trim(variable_name)//" attribute: "//trim(attribute_name)
48
49 if (fileobj%is_root) then
50 call set_netcdf_mode(fileobj%ncid, define_mode)
51 varid = get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
52 select type(attribute_value)
53 type is (character(len=*))
54 if (.not. present(str_len)) call error("Need to include str length:"//trim(append_error_msg))
55 err = nf90_put_att(fileobj%ncid, varid, trim(attribute_name), &
56 trim(attribute_value(1:str_len)))
57 type is (integer(kind=i4_kind))
58 err = nf90_put_att(fileobj%ncid, varid, trim(attribute_name), &
59 attribute_value)
60 type is (integer(kind=i8_kind))
61 if ( .not. fileobj%is_netcdf4) call error(trim(fileobj%path)//&
62 & ": 64 bit integers are only supported with 'netcdf4' file format"// &
63 & ". Set netcdf_default_format='netcdf4' in the fms2_io namelist OR "//&
64 & "add nc_format='netcdf4' to your open_file call")
65 err = nf90_put_att(fileobj%ncid, varid, trim(attribute_name), &
66 attribute_value)
67 type is (real(kind=r4_kind))
68 err = nf90_put_att(fileobj%ncid, varid, trim(attribute_name), &
69 attribute_value)
70 type is (real(kind=r8_kind))
71 err = nf90_put_att(fileobj%ncid, varid, trim(attribute_name), &
72 attribute_value)
73 class default
74 call error("Unsupported attribute type:"//trim(append_error_msg))
75 end select
76 call check_netcdf_code(err, append_error_msg)
77
78 !The missing_value attribute is not NUG compliant, but is included here to support
79 !legacy model component code.
80 axtype = get_attribute_type(fileobj%ncid, varid, attribute_name, append_error_msg)
81 xtype = get_variable_type(fileobj%ncid, varid, append_error_msg)
82 if (string_compare(attribute_name, "_FillValue") .or. &
83 string_compare(attribute_name, "valid_min") .or. &
84 string_compare(attribute_name, "valid_max") .or. &
85 string_compare(attribute_name, "scale_factor") .or. &
86 string_compare(attribute_name, "add_offset") .or. &
87 string_compare(attribute_name, "missing_value")) then
88 if (axtype .ne. xtype) then
89 call error("The variable type does not match the attribute type: "//trim(append_error_msg))
90 endif
91 endif
92
93 if (string_compare(attribute_name, "_FillValue")) then
94 if (attribute_exists(fileobj%ncid, varid, "valid_range", msg=append_error_msg)) then
95 select type(attribute_value)
96 type is (integer(kind=i4_kind))
97 call get_variable_attribute(fileobj, variable_name, "valid_range", &
98 i32_range, .false.)
99 if (attribute_value .lt. i32_range(1) .or. &
100 attribute_value .gt. i32_range(2)) then
101 call error("_FillValue inside valid_range: "//trim(append_error_msg))
102 endif
103 type is (integer(kind=i8_kind))
104 call get_variable_attribute(fileobj, variable_name, "valid_range", &
105 i64_range, .false.)
106 if (attribute_value .lt. i64_range(1) .or. &
107 attribute_value .gt. i64_range(2)) then
108 call error("_FillValue inside valid_range: "//trim(append_error_msg))
109 endif
110 type is (real(kind=r4_kind))
111 call get_variable_attribute(fileobj, variable_name, "valid_range", &
112 r32_range, .false.)
113 if (attribute_value .lt. r32_range(1) .or. &
114 attribute_value .gt. r32_range(2)) then
115 call error("_FillValue inside valid_range: "//trim(append_error_msg))
116 endif
117 type is (real(kind=r8_kind))
118 call get_variable_attribute(fileobj, variable_name, "valid_range", &
119 r64_range, .false.)
120 if (attribute_value .lt. r64_range(1) .or. &
121 attribute_value .gt. r64_range(2)) then
122 call error("_FillValue inside valid_range: "//trim(append_error_msg))
123 endif
124 class default
125 call error("unsupported attribute type: "//trim(append_error_msg))
126 end select
127 endif
128 elseif (string_compare(attribute_name, "valid_min") .or. &
129 string_compare(attribute_name, "valid_max")) then
130 if (attribute_exists(fileobj%ncid, varid, "valid_range", msg=append_error_msg)) then
131 call error("cannot have attributes valid_range and valid_min/max: "//trim(append_error_msg))
132 endif
133 endif
134 endif
136
137
138!> @brief Add an attribute to a variable.
139subroutine register_variable_attribute_1d(fileobj, variable_name, attribute_name, &
140 attribute_value, str_len)
141
142 class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
143 character(len=*), intent(in) :: variable_name !< Variable name.
144 character(len=*), intent(in) :: attribute_name !< Attribute name.
145 class(*), dimension(:), intent(in) :: attribute_value !< Attribute value
146 integer, intent(in), optional :: str_len !< Length of the string
147
148 integer :: varid
149 integer :: err
150 integer :: axtype
151 integer :: xtype
152 character(len=200) :: append_error_msg !< Msg to be appended to FATAL error message
153
154 append_error_msg = "register_variable_attribute_0d: file:"//trim(fileobj%path)//"- variable:"//&
155 &trim(variable_name)//" attribute: "//trim(attribute_name)
156
157 if (fileobj%is_root) then
158 call set_netcdf_mode(fileobj%ncid, define_mode)
159 varid = get_variable_id(fileobj%ncid, trim(variable_name), msg=append_error_msg)
160 select type(attribute_value)
161 type is (integer(kind=i4_kind))
162 err = nf90_put_att(fileobj%ncid, varid, trim(attribute_name), &
163 attribute_value)
164 type is (integer(kind=i8_kind))
165 if ( .not. fileobj%is_netcdf4) call error(trim(fileobj%path)// &
166 & ": 64 bit integers are only supported with 'netcdf4' file format"// &
167 & ". Set netcdf_default_format='netcdf4' in the fms2_io namelist OR "//&
168 & "add nc_format='netcdf4' to your open_file call")
169 err = nf90_put_att(fileobj%ncid, varid, trim(attribute_name), &
170 attribute_value)
171 type is (real(kind=r4_kind))
172 err = nf90_put_att(fileobj%ncid, varid, trim(attribute_name), &
173 attribute_value)
174 type is (real(kind=r8_kind))
175 err = nf90_put_att(fileobj%ncid, varid, trim(attribute_name), &
176 attribute_value)
177 class default
178 call error("unsupported attribute type: "//trim(append_error_msg))
179 end select
180 call check_netcdf_code(err, append_error_msg)
181
182 if (string_compare(attribute_name, "_FillValue") .or. &
183 string_compare(attribute_name, "valid_min") .or. &
184 string_compare(attribute_name, "valid_max") .or. &
185 string_compare(attribute_name, "scale_factor") .or. &
186 string_compare(attribute_name, "add_offset") .or. &
187 string_compare(attribute_name, "missing_value")) then
188 call error(trim(attribute_name)//" must be a scalar.")
189 elseif (string_compare(attribute_name, "valid_range")) then
190 if (attribute_exists(fileobj%ncid, varid, "valid_min", msg=append_error_msg) .or. &
191 attribute_exists(fileobj%ncid, varid, "valid_max", msg=append_error_msg)) then
192 call error("cannot have valid_range and valid_min/max: "//trim(append_error_msg))
193 endif
194 axtype = get_attribute_type(fileobj%ncid, varid, attribute_name, append_error_msg)
195 xtype = get_variable_type(fileobj%ncid, varid, append_error_msg)
196 if (axtype .ne. xtype) then
197 call error("The type of the variable is not the same as the type of the variable: "//trim(append_error_msg))
198 endif
199 if (size(attribute_value) .ne. 2) then
200 call error("valid_range must be a vector with two values: "//trim(append_error_msg))
201 endif
202 endif
203 endif
205!> @}
subroutine register_variable_attribute_1d(fileobj, variable_name, attribute_name, attribute_value, str_len)
Add an attribute to a variable.
subroutine register_variable_attribute_0d(fileobj, variable_name, attribute_name, attribute_value, str_len)
Add an attribute to a variable.