FMS 2025.01.02-dev
Flexible Modeling System
Loading...
Searching...
No Matches
unpack_data.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 for the @ref gather_data_bc interface
21
22!> @addtogroup netcdf_io_mod
23!> @{
24subroutine unpack_data_0d(fileobj, varid, varname, var_data)
25 class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
26 integer, intent(in) :: varid !< Netcdf variable ID
27 character(len=*), intent(in) :: varname !< Name of the variable (for error messages)
28 class(*), intent(inout) :: var_data !< Array that the data
29 !! will be read into.
30
31 character(len=128) :: msg !< Message to append in error message
32 real(kind=r4_kind) :: buf_r4_kind !< r4_kind buffer to read the scale_factor/add_offset to
33 real(kind=r8_kind) :: buf_r8_kind !< r8_kind buffer to read the scale_factor/add_offset to
34 integer :: err !< netcdf error code
35
36 msg = "Check your read_data call for the variable:"//trim(varname)//&
37 " in file:"//trim(fileobj%path)
38
39 if (attribute_exists(fileobj%ncid, varid, "scale_factor") .or. &
40 attribute_exists(fileobj%ncid, varid, "add_offset")) then
41
42 select type(var_data)
43 type is (real(kind=r4_kind))
44 err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r4_kind )
45 call check_netcdf_code(err, msg)
46 var_data = var_data * buf_r4_kind
47
48 err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r4_kind )
49 call check_netcdf_code(err, msg)
50 var_data = var_data + buf_r4_kind
51
52 type is (real(kind=r8_kind))
53 err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r8_kind )
54 call check_netcdf_code(err, msg)
55 var_data = var_data * buf_r8_kind
56
57 err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r8_kind )
58 call check_netcdf_code(err, msg)
59 var_data = var_data + buf_r8_kind
60
61 class default
62 call error("If using the scale_factor and add_offset variable, the buffer reading the data to needs to be &
63 &r4_kind or r8_kind."//trim(msg))
64 end select
65 end if
66end subroutine
67
68subroutine unpack_data_1d(fileobj, varid, varname, var_data)
69 class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
70 integer, intent(in) :: varid !< Netcdf variable ID
71 character(len=*), intent(in) :: varname !< Name of the variable (for error messages)
72 class(*), intent(inout) :: var_data(:) !< Array that the data
73 !! will be read into.
74
75 character(len=128) :: msg !< Message to append in error message
76 real(kind=r4_kind) :: buf_r4_kind !< r4_kind buffer to read the scale_factor/add_offset to
77 real(kind=r8_kind) :: buf_r8_kind !< r8_kind buffer to read the scale_factor/add_offset to
78 integer :: err !< netcdf error code
79
80 msg = "Check your read_data call for the variable:"//trim(varname)//&
81 " in file:"//trim(fileobj%path)
82
83 if (attribute_exists(fileobj%ncid, varid, "scale_factor") .or. &
84 attribute_exists(fileobj%ncid, varid, "add_offset")) then
85
86 select type(var_data)
87 type is (real(kind=r4_kind))
88 err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r4_kind )
89 call check_netcdf_code(err, msg)
90 var_data = var_data * buf_r4_kind
91
92 err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r4_kind )
93 call check_netcdf_code(err, msg)
94 var_data = var_data + buf_r4_kind
95
96 type is (real(kind=r8_kind))
97 err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r8_kind )
98 call check_netcdf_code(err, msg)
99 var_data = var_data * buf_r8_kind
100
101 err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r8_kind )
102 call check_netcdf_code(err, msg)
103 var_data = var_data + buf_r8_kind
104
105 class default
106 call error("If using the scale_factor and add_offset variable, the buffer reading the data to needs to be &
107 &r4_kind or r8_kind."//trim(msg))
108 end select
109 end if
110end subroutine
111
112subroutine unpack_data_2d(fileobj, varid, varname, var_data)
113 class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
114 integer, intent(in) :: varid !< Netcdf variable ID
115 character(len=*), intent(in) :: varname !< Name of the variable (for error messages)
116 class(*), intent(inout) :: var_data(:,:) !< Array that the data
117 !! will be read into.
118
119 character(len=128) :: msg !< Message to append in error message
120 real(kind=r4_kind) :: buf_r4_kind !< r4_kind buffer to read the scale_factor/add_offset to
121 real(kind=r8_kind) :: buf_r8_kind !< r8_kind buffer to read the scale_factor/add_offset to
122 integer :: err !< netcdf error code
123
124 msg = "Check your read_data call for the variable:"//trim(varname)//&
125 " in file:"//trim(fileobj%path)
126
127 if (attribute_exists(fileobj%ncid, varid, "scale_factor") .or. &
128 attribute_exists(fileobj%ncid, varid, "add_offset")) then
129
130 select type(var_data)
131 type is (real(kind=r4_kind))
132 err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r4_kind )
133 call check_netcdf_code(err, msg)
134 var_data = var_data * buf_r4_kind
135
136 err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r4_kind )
137 call check_netcdf_code(err, msg)
138 var_data = var_data + buf_r4_kind
139
140 type is (real(kind=r8_kind))
141 err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r8_kind )
142 call check_netcdf_code(err, msg)
143 var_data = var_data * buf_r8_kind
144
145 err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r8_kind )
146 call check_netcdf_code(err, msg)
147 var_data = var_data + buf_r8_kind
148
149 class default
150 call error("If using the scale_factor and add_offset variable, the buffer reading the data to needs to be &
151 &r4_kind or r8_kind."//trim(msg))
152 end select
153 end if
154end subroutine
155
156subroutine unpack_data_3d(fileobj, varid, varname, var_data)
157 class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
158 integer, intent(in) :: varid !< Netcdf variable ID
159 character(len=*), intent(in) :: varname !< Name of the variable (for error messages)
160 class(*), intent(inout) :: var_data(:,:,:) !< Array that the data
161 !! will be read into.
162
163 character(len=128) :: msg !< Message to append in error message
164 real(kind=r4_kind) :: buf_r4_kind !< r4_kind buffer to read the scale_factor/add_offset to
165 real(kind=r8_kind) :: buf_r8_kind !< r8_kind buffer to read the scale_factor/add_offset to
166 integer :: err !< netcdf error code
167
168 msg = "Check your read_data call for the variable:"//trim(varname)//&
169 " in file:"//trim(fileobj%path)
170
171 if (attribute_exists(fileobj%ncid, varid, "scale_factor") .or. &
172 attribute_exists(fileobj%ncid, varid, "add_offset")) then
173
174 select type(var_data)
175 type is (real(kind=r4_kind))
176 err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r4_kind )
177 call check_netcdf_code(err, msg)
178 var_data = var_data * buf_r4_kind
179
180 err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r4_kind )
181 call check_netcdf_code(err, msg)
182 var_data = var_data + buf_r4_kind
183
184 type is (real(kind=r8_kind))
185 err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r8_kind )
186 call check_netcdf_code(err, msg)
187 var_data = var_data * buf_r8_kind
188
189 err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r8_kind )
190 call check_netcdf_code(err, msg)
191 var_data = var_data + buf_r8_kind
192
193 class default
194 call error("If using the scale_factor and add_offset variable, the buffer reading the data to needs to be &
195 &r4_kind or r8_kind."//trim(msg))
196 end select
197 end if
198end subroutine
199
200subroutine unpack_data_4d(fileobj, varid, varname, var_data)
201 class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
202 integer, intent(in) :: varid !< Netcdf variable ID
203 character(len=*), intent(in) :: varname !< Name of the variable (for error messages)
204 class(*), intent(inout) :: var_data(:,:,:,:) !< Array that the data
205 !! will be read into.
206
207 character(len=128) :: msg !< Message to append in error message
208 real(kind=r4_kind) :: buf_r4_kind !< r4_kind buffer to read the scale_factor/add_offset to
209 real(kind=r8_kind) :: buf_r8_kind !< r8_kind buffer to read the scale_factor/add_offset to
210 integer :: err !< netcdf error code
211
212 msg = "Check your read_data call for the variable:"//trim(varname)//&
213 " in file:"//trim(fileobj%path)
214
215 if (attribute_exists(fileobj%ncid, varid, "scale_factor") .or. &
216 attribute_exists(fileobj%ncid, varid, "add_offset")) then
217
218 select type(var_data)
219 type is (real(kind=r4_kind))
220 err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r4_kind )
221 call check_netcdf_code(err, msg)
222 var_data = var_data * buf_r4_kind
223
224 err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r4_kind )
225 call check_netcdf_code(err, msg)
226 var_data = var_data + buf_r4_kind
227
228 type is (real(kind=r8_kind))
229 err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r8_kind )
230 call check_netcdf_code(err, msg)
231 var_data = var_data * buf_r8_kind
232
233 err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r8_kind )
234 call check_netcdf_code(err, msg)
235 var_data = var_data + buf_r8_kind
236
237 class default
238 call error("If using the scale_factor and add_offset variable, the buffer reading the data to needs to be &
239 &r4_kind or r8_kind."//trim(msg))
240 end select
241 end if
242end subroutine
243
244subroutine unpack_data_5d(fileobj, varid, varname, var_data)
245 class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
246 integer, intent(in) :: varid !< Netcdf variable ID
247 character(len=*), intent(in) :: varname !< Name of the variable (for error messages)
248 class(*), intent(inout) :: var_data(:,:,:,:,:) !< Array that the data
249 !! will be read into.
250
251 character(len=128) :: msg !< Message to append in error message
252 real(kind=r4_kind) :: buf_r4_kind !< r4_kind buffer to read the scale_factor/add_offset to
253 real(kind=r8_kind) :: buf_r8_kind !< r8_kind buffer to read the scale_factor/add_offset to
254 integer :: err !< netcdf error code
255
256 msg = "Check your read_data call for the variable:"//trim(varname)//&
257 " in file:"//trim(fileobj%path)
258
259 if (attribute_exists(fileobj%ncid, varid, "scale_factor") .or. &
260 attribute_exists(fileobj%ncid, varid, "add_offset")) then
261
262 select type(var_data)
263 type is (real(kind=r4_kind))
264 err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r4_kind )
265 call check_netcdf_code(err, msg)
266 var_data = var_data * buf_r4_kind
267
268 err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r4_kind )
269 call check_netcdf_code(err, msg)
270 var_data = var_data + buf_r4_kind
271
272 type is (real(kind=r8_kind))
273 err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r8_kind )
274 call check_netcdf_code(err, msg)
275 var_data = var_data * buf_r8_kind
276
277 err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r8_kind )
278 call check_netcdf_code(err, msg)
279 var_data = var_data + buf_r8_kind
280
281 class default
282 call error("If using the scale_factor and add_offset variable, the buffer reading the data to needs to be &
283 &r4_kind or r8_kind."//trim(msg))
284 end select
285 end if
286end subroutine
subroutine unpack_data_2d(fileobj, varid, varname, var_data)
subroutine unpack_data_1d(fileobj, varid, varname, var_data)
subroutine unpack_data_5d(fileobj, varid, varname, var_data)
subroutine unpack_data_0d(fileobj, varid, varname, var_data)
subroutine unpack_data_3d(fileobj, varid, varname, var_data)
subroutine unpack_data_4d(fileobj, varid, varname, var_data)