FMS  2024.03
Flexible Modeling System
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 !> @{
24 subroutine 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
66 end subroutine
67 
68 subroutine 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
110 end subroutine
111 
112 subroutine 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
154 end subroutine
155 
156 subroutine 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
198 end subroutine
199 
200 subroutine 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
242 end subroutine
243 
244 subroutine 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
286 end subroutine
unpack_data_2d
subroutine unpack_data_2d(fileobj, varid, varname, var_data)
Definition: unpack_data.inc:113
unpack_data_1d
subroutine unpack_data_1d(fileobj, varid, varname, var_data)
Definition: unpack_data.inc:69
unpack_data_5d
subroutine unpack_data_5d(fileobj, varid, varname, var_data)
Definition: unpack_data.inc:245
unpack_data_0d
subroutine unpack_data_0d(fileobj, varid, varname, var_data)
Definition: unpack_data.inc:25
unpack_data_3d
subroutine unpack_data_3d(fileobj, varid, varname, var_data)
Definition: unpack_data.inc:157
unpack_data_4d
subroutine unpack_data_4d(fileobj, varid, varname, var_data)
Definition: unpack_data.inc:201