FMS  2025.04
Flexible Modeling System
unpack_data.inc
1 !***********************************************************************
2 !* Apache License 2.0
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* Licensed under the Apache License, Version 2.0 (the "License");
7 !* you may not use this file except in compliance with the License.
8 !* You may obtain a copy of the License at
9 !*
10 !* http://www.apache.org/licenses/LICENSE-2.0
11 !*
12 !* FMS is distributed in the hope that it will be useful, but WITHOUT
13 !* WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied;
14 !* without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
15 !* PARTICULAR PURPOSE. See the License for the specific language
16 !* governing permissions and limitations under the License.
17 !***********************************************************************
18 !> @file
19 !> @brief Routines for the @ref gather_data_bc interface
20 
21 !> @addtogroup netcdf_io_mod
22 !> @{
23 subroutine unpack_data_0d(fileobj, varid, varname, var_data)
24  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
25  integer, intent(in) :: varid !< Netcdf variable ID
26  character(len=*), intent(in) :: varname !< Name of the variable (for error messages)
27  class(*), intent(inout) :: var_data !< Array that the data
28  !! will be read into.
29 
30  character(len=128) :: msg !< Message to append in error message
31  real(kind=r4_kind) :: buf_r4_kind !< r4_kind buffer to read the scale_factor/add_offset to
32  real(kind=r8_kind) :: buf_r8_kind !< r8_kind buffer to read the scale_factor/add_offset to
33  integer :: err !< netcdf error code
34 
35  msg = "Check your read_data call for the variable:"//trim(varname)//&
36  " in file:"//trim(fileobj%path)
37 
38  if (attribute_exists(fileobj%ncid, varid, "scale_factor") .or. &
39  attribute_exists(fileobj%ncid, varid, "add_offset")) then
40 
41  select type(var_data)
42  type is (real(kind=r4_kind))
43  err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r4_kind )
44  call check_netcdf_code(err, msg)
45  var_data = var_data * buf_r4_kind
46 
47  err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r4_kind )
48  call check_netcdf_code(err, msg)
49  var_data = var_data + buf_r4_kind
50 
51  type is (real(kind=r8_kind))
52  err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r8_kind )
53  call check_netcdf_code(err, msg)
54  var_data = var_data * buf_r8_kind
55 
56  err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r8_kind )
57  call check_netcdf_code(err, msg)
58  var_data = var_data + buf_r8_kind
59 
60  class default
61  call error("If using the scale_factor and add_offset variable, the buffer reading the data to needs to be &
62  &r4_kind or r8_kind."//trim(msg))
63  end select
64  end if
65 end subroutine
66 
67 subroutine unpack_data_1d(fileobj, varid, varname, var_data)
68  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
69  integer, intent(in) :: varid !< Netcdf variable ID
70  character(len=*), intent(in) :: varname !< Name of the variable (for error messages)
71  class(*), intent(inout) :: var_data(:) !< Array that the data
72  !! will be read into.
73 
74  character(len=128) :: msg !< Message to append in error message
75  real(kind=r4_kind) :: buf_r4_kind !< r4_kind buffer to read the scale_factor/add_offset to
76  real(kind=r8_kind) :: buf_r8_kind !< r8_kind buffer to read the scale_factor/add_offset to
77  integer :: err !< netcdf error code
78 
79  msg = "Check your read_data call for the variable:"//trim(varname)//&
80  " in file:"//trim(fileobj%path)
81 
82  if (attribute_exists(fileobj%ncid, varid, "scale_factor") .or. &
83  attribute_exists(fileobj%ncid, varid, "add_offset")) then
84 
85  select type(var_data)
86  type is (real(kind=r4_kind))
87  err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r4_kind )
88  call check_netcdf_code(err, msg)
89  var_data = var_data * buf_r4_kind
90 
91  err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r4_kind )
92  call check_netcdf_code(err, msg)
93  var_data = var_data + buf_r4_kind
94 
95  type is (real(kind=r8_kind))
96  err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r8_kind )
97  call check_netcdf_code(err, msg)
98  var_data = var_data * buf_r8_kind
99 
100  err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r8_kind )
101  call check_netcdf_code(err, msg)
102  var_data = var_data + buf_r8_kind
103 
104  class default
105  call error("If using the scale_factor and add_offset variable, the buffer reading the data to needs to be &
106  &r4_kind or r8_kind."//trim(msg))
107  end select
108  end if
109 end subroutine
110 
111 subroutine unpack_data_2d(fileobj, varid, varname, var_data)
112  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
113  integer, intent(in) :: varid !< Netcdf variable ID
114  character(len=*), intent(in) :: varname !< Name of the variable (for error messages)
115  class(*), intent(inout) :: var_data(:,:) !< Array that the data
116  !! will be read into.
117 
118  character(len=128) :: msg !< Message to append in error message
119  real(kind=r4_kind) :: buf_r4_kind !< r4_kind buffer to read the scale_factor/add_offset to
120  real(kind=r8_kind) :: buf_r8_kind !< r8_kind buffer to read the scale_factor/add_offset to
121  integer :: err !< netcdf error code
122 
123  msg = "Check your read_data call for the variable:"//trim(varname)//&
124  " in file:"//trim(fileobj%path)
125 
126  if (attribute_exists(fileobj%ncid, varid, "scale_factor") .or. &
127  attribute_exists(fileobj%ncid, varid, "add_offset")) then
128 
129  select type(var_data)
130  type is (real(kind=r4_kind))
131  err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r4_kind )
132  call check_netcdf_code(err, msg)
133  var_data = var_data * buf_r4_kind
134 
135  err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r4_kind )
136  call check_netcdf_code(err, msg)
137  var_data = var_data + buf_r4_kind
138 
139  type is (real(kind=r8_kind))
140  err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r8_kind )
141  call check_netcdf_code(err, msg)
142  var_data = var_data * buf_r8_kind
143 
144  err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r8_kind )
145  call check_netcdf_code(err, msg)
146  var_data = var_data + buf_r8_kind
147 
148  class default
149  call error("If using the scale_factor and add_offset variable, the buffer reading the data to needs to be &
150  &r4_kind or r8_kind."//trim(msg))
151  end select
152  end if
153 end subroutine
154 
155 subroutine unpack_data_3d(fileobj, varid, varname, var_data)
156  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
157  integer, intent(in) :: varid !< Netcdf variable ID
158  character(len=*), intent(in) :: varname !< Name of the variable (for error messages)
159  class(*), intent(inout) :: var_data(:,:,:) !< Array that the data
160  !! will be read into.
161 
162  character(len=128) :: msg !< Message to append in error message
163  real(kind=r4_kind) :: buf_r4_kind !< r4_kind buffer to read the scale_factor/add_offset to
164  real(kind=r8_kind) :: buf_r8_kind !< r8_kind buffer to read the scale_factor/add_offset to
165  integer :: err !< netcdf error code
166 
167  msg = "Check your read_data call for the variable:"//trim(varname)//&
168  " in file:"//trim(fileobj%path)
169 
170  if (attribute_exists(fileobj%ncid, varid, "scale_factor") .or. &
171  attribute_exists(fileobj%ncid, varid, "add_offset")) then
172 
173  select type(var_data)
174  type is (real(kind=r4_kind))
175  err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r4_kind )
176  call check_netcdf_code(err, msg)
177  var_data = var_data * buf_r4_kind
178 
179  err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r4_kind )
180  call check_netcdf_code(err, msg)
181  var_data = var_data + buf_r4_kind
182 
183  type is (real(kind=r8_kind))
184  err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r8_kind )
185  call check_netcdf_code(err, msg)
186  var_data = var_data * buf_r8_kind
187 
188  err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r8_kind )
189  call check_netcdf_code(err, msg)
190  var_data = var_data + buf_r8_kind
191 
192  class default
193  call error("If using the scale_factor and add_offset variable, the buffer reading the data to needs to be &
194  &r4_kind or r8_kind."//trim(msg))
195  end select
196  end if
197 end subroutine
198 
199 subroutine unpack_data_4d(fileobj, varid, varname, var_data)
200  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
201  integer, intent(in) :: varid !< Netcdf variable ID
202  character(len=*), intent(in) :: varname !< Name of the variable (for error messages)
203  class(*), intent(inout) :: var_data(:,:,:,:) !< Array that the data
204  !! will be read into.
205 
206  character(len=128) :: msg !< Message to append in error message
207  real(kind=r4_kind) :: buf_r4_kind !< r4_kind buffer to read the scale_factor/add_offset to
208  real(kind=r8_kind) :: buf_r8_kind !< r8_kind buffer to read the scale_factor/add_offset to
209  integer :: err !< netcdf error code
210 
211  msg = "Check your read_data call for the variable:"//trim(varname)//&
212  " in file:"//trim(fileobj%path)
213 
214  if (attribute_exists(fileobj%ncid, varid, "scale_factor") .or. &
215  attribute_exists(fileobj%ncid, varid, "add_offset")) then
216 
217  select type(var_data)
218  type is (real(kind=r4_kind))
219  err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r4_kind )
220  call check_netcdf_code(err, msg)
221  var_data = var_data * buf_r4_kind
222 
223  err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r4_kind )
224  call check_netcdf_code(err, msg)
225  var_data = var_data + buf_r4_kind
226 
227  type is (real(kind=r8_kind))
228  err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r8_kind )
229  call check_netcdf_code(err, msg)
230  var_data = var_data * buf_r8_kind
231 
232  err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r8_kind )
233  call check_netcdf_code(err, msg)
234  var_data = var_data + buf_r8_kind
235 
236  class default
237  call error("If using the scale_factor and add_offset variable, the buffer reading the data to needs to be &
238  &r4_kind or r8_kind."//trim(msg))
239  end select
240  end if
241 end subroutine
242 
243 subroutine unpack_data_5d(fileobj, varid, varname, var_data)
244  class(fmsnetcdffile_t), intent(in) :: fileobj !< File object.
245  integer, intent(in) :: varid !< Netcdf variable ID
246  character(len=*), intent(in) :: varname !< Name of the variable (for error messages)
247  class(*), intent(inout) :: var_data(:,:,:,:,:) !< Array that the data
248  !! will be read into.
249 
250  character(len=128) :: msg !< Message to append in error message
251  real(kind=r4_kind) :: buf_r4_kind !< r4_kind buffer to read the scale_factor/add_offset to
252  real(kind=r8_kind) :: buf_r8_kind !< r8_kind buffer to read the scale_factor/add_offset to
253  integer :: err !< netcdf error code
254 
255  msg = "Check your read_data call for the variable:"//trim(varname)//&
256  " in file:"//trim(fileobj%path)
257 
258  if (attribute_exists(fileobj%ncid, varid, "scale_factor") .or. &
259  attribute_exists(fileobj%ncid, varid, "add_offset")) then
260 
261  select type(var_data)
262  type is (real(kind=r4_kind))
263  err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r4_kind )
264  call check_netcdf_code(err, msg)
265  var_data = var_data * buf_r4_kind
266 
267  err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r4_kind )
268  call check_netcdf_code(err, msg)
269  var_data = var_data + buf_r4_kind
270 
271  type is (real(kind=r8_kind))
272  err = nf90_get_att(fileobj%ncid, varid, "scale_factor", buf_r8_kind )
273  call check_netcdf_code(err, msg)
274  var_data = var_data * buf_r8_kind
275 
276  err = nf90_get_att(fileobj%ncid, varid, "add_offset", buf_r8_kind )
277  call check_netcdf_code(err, msg)
278  var_data = var_data + buf_r8_kind
279 
280  class default
281  call error("If using the scale_factor and add_offset variable, the buffer reading the data to needs to be &
282  &r4_kind or r8_kind."//trim(msg))
283  end select
284  end if
285 end subroutine
unpack_data_2d
subroutine unpack_data_2d(fileobj, varid, varname, var_data)
Definition: unpack_data.inc:112
unpack_data_1d
subroutine unpack_data_1d(fileobj, varid, varname, var_data)
Definition: unpack_data.inc:68
unpack_data_5d
subroutine unpack_data_5d(fileobj, varid, varname, var_data)
Definition: unpack_data.inc:244
unpack_data_0d
subroutine unpack_data_0d(fileobj, varid, varname, var_data)
Definition: unpack_data.inc:24
unpack_data_3d
subroutine unpack_data_3d(fileobj, varid, varname, var_data)
Definition: unpack_data.inc:156
unpack_data_4d
subroutine unpack_data_4d(fileobj, varid, varname, var_data)
Definition: unpack_data.inc:200