FMS  2025.04
Flexible Modeling System
drifters_io.F90
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 !> @defgroup drifters_io_mod drifters_io_mod
19 !> @ingroup drifters
20 !> @brief Saves drifter data for postprocessing and restarts
21 
22 !> @addtogroup drifters_io_mod
23 !> @{
24 module drifters_io_mod
25 #ifdef use_drifters
26 
27  use netcdf
28  use netcdf_nf_data
29  use netcdf_nf_interfaces
30  use netcdf4_nf_interfaces
31 
32  implicit none
33  private
34 
35  public :: drifters_io_type, drifters_io_new, drifters_io_del, drifters_io_set_time_units
36  public :: drifters_io_set_position_names, drifters_io_set_position_units, drifters_io_set_field_names
37  public :: drifters_io_set_field_units, drifters_io_write
38 
39  ! Globals
40  integer, parameter, private :: MAX_STR_LEN = 128
41  ! Include variable "version" to be written to log file.
42 #include<file_version.h>
43 
44  real :: drfts_eps_t = 10.*epsilon(1.)
45 
46 !> @}
47  !> @brief IO data for drifters.
48  !> @ingroup drifters_input_mod
49  type drifters_io_type
50  real :: time
51  integer :: it !< time index
52  integer :: it_id !< infinite axis index
53  integer :: ncid
54  integer :: nc_positions, nc_fields, nc_ids, nc_time, nc_index_time
55  logical :: enddef
56  end type drifters_io_type
57 !> @addtogroup drifters_io_mod
58 !> @{
59 contains
60 
61 !###############################################################################
62  subroutine drifters_io_new(self, filename, nd, nf, ermesg)
63  type(drifters_io_type) :: self
64  character(len=*), intent(in) :: filename
65  integer, intent(in) :: nd !< number of dims
66  integer, intent(in) :: nf !< number of fields
67  character(len=*), intent(out) :: ermesg
68 
69  integer ier, nc_it_id, nc_nd, nc_nf
70  integer :: size1(1), size2(2)
71 
72  ermesg=''
73  self%enddef = .false.
74 
75  ier = nf_create(filename, nf_clobber, self%ncid)
76  if(ier/=nf_noerr) ermesg = 'drifters_io_new::nf_create ('//filename//') '//nf_strerror(ier)
77 
78  ! global attributes
79  ier = nf_put_att_text(self%ncid, nf_global, 'version', len_trim(version), trim(version))
80 
81 
82  ! dimensions
83  ier = nf_def_dim(self%ncid, 'np', nf_unlimited, nc_it_id)
84  if(ier/=nf_noerr) ermesg = 'drifters_io_new::nf_def_dim (it_id) '//nf_strerror(ier)
85 
86  ier = nf_def_dim(self%ncid, 'nf', nf, nc_nf)
87  if(ier/=nf_noerr) ermesg = 'drifters_io_new::nf_def_dim (nf) '//nf_strerror(ier)
88 
89  ier = nf_def_dim(self%ncid, 'nd', nd, nc_nd)
90  if(ier/=nf_noerr) ermesg = 'drifters_io_new::nf_def_dim (nd) '//nf_strerror(ier)
91 
92  ! variables
93  size1 = (/nc_it_id/)
94  ier = nf_def_var(self%ncid, 'index_time', nf_int, 1, size1, self%nc_index_time)
95  if(ier/=nf_noerr) ermesg = 'drifters_io_new::nf_def_var (index_time)'//nf_strerror(ier)
96 
97  ier = nf_def_var(self%ncid, 'time', nf_double, 1, size1, self%nc_time)
98  if(ier/=nf_noerr) ermesg = 'drifters_io_new::nf_def_var (time)'//nf_strerror(ier)
99 
100  ier = nf_def_var(self%ncid, 'ids', nf_int, 1, size1, self%nc_ids)
101  if(ier/=nf_noerr) ermesg = 'drifters_io_new::nf_def_var (ids)'//nf_strerror(ier)
102 
103  size2 = (/nc_nd, nc_it_id/)
104  ier = nf_def_var(self%ncid, 'positions', nf_double, 2, size2, self%nc_positions)
105  if(ier/=nf_noerr) ermesg = 'drifters_io_new::nf_def_var (positions)'//nf_strerror(ier)
106 
107  size2 = (/nc_nf, nc_it_id/)
108  ier = nf_def_var(self%ncid, 'fields', nf_double, 2, size2, self%nc_fields)
109  if(ier/=nf_noerr) ermesg = 'drifters_io_new::nf_def_var (fields)'//nf_strerror(ier)
110 
111  self%time = -huge(1.)
112  self%it = -1
113  self%it_id = 1
114 
115  end subroutine drifters_io_new
116 
117 !###############################################################################
118  subroutine drifters_io_del(self, ermesg)
119  type(drifters_io_type) :: self
120  character(len=*), intent(out) :: ermesg
121 
122  integer ier
123 
124  ermesg = ''
125 
126  ier = nf_close(self%ncid)
127  if(ier/=nf_noerr) ermesg = 'drifters_io_del::nf_close '//nf_strerror(ier)
128 
129  end subroutine drifters_io_del
130 
131 !###############################################################################
132  subroutine drifters_io_set_time_units(self, name, ermesg)
133  type(drifters_io_type) :: self
134  character(len=*), intent(in) :: name
135  character(len=*), intent(out) :: ermesg
136 
137  integer ier
138 
139  ermesg = ''
140  ier = nf_put_att_text(self%ncid, nf_global, &
141  & 'time_units', len_trim(name), trim(name))
142  if(ier/=nf_noerr) &
143  & ermesg = 'drifters_io_set_time_units::failed to add time_units attribute ' &
144  & //nf_strerror(ier)
145 
146  end subroutine drifters_io_set_time_units
147 
148 !###############################################################################
149  subroutine drifters_io_set_position_names(self, names, ermesg)
150  type(drifters_io_type) :: self
151  character(len=*), intent(in) :: names(:)
152  character(len=*), intent(out) :: ermesg
153 
154  integer n, ier, i
155  character(len=128) :: attname
156 
157  n = size(names)
158  ermesg = ''
159 
160  do i = 1, n
161  write(attname, '(i6)' ) i
162  attname = 'name_'//adjustl(attname)
163  ier = nf_put_att_text(self%ncid, self%nc_positions, &
164  & trim(attname), len_trim(names(i)), trim(names(i)))
165  if(ier/=nf_noerr) &
166  & ermesg = 'drifters_io_set_position_names::failed to add name attribute to positions '//nf_strerror(ier)
167  enddo
168 
169  end subroutine drifters_io_set_position_names
170 
171 !###############################################################################
172  subroutine drifters_io_set_position_units(self, names, ermesg)
173  type(drifters_io_type) :: self
174  character(len=*), intent(in) :: names(:)
175  character(len=*), intent(out) :: ermesg
176 
177  integer n, ier, i
178  character(len=128) :: attname
179 
180  n = size(names)
181  ermesg = ''
182 
183  do i = 1, n
184  write(attname, '(i6)' ) i
185  attname = 'unit_'//adjustl(attname)
186  ier = nf_put_att_text(self%ncid, self%nc_positions, &
187  & trim(attname), len_trim(names(i)), trim(names(i)))
188  if(ier/=nf_noerr) &
189  & ermesg = 'drifters_io_set_position_names::failed to add unit attribute to positions '//nf_strerror(ier)
190  enddo
191 
192  end subroutine drifters_io_set_position_units
193 
194 !###############################################################################
195  subroutine drifters_io_set_field_names(self, names, ermesg)
196  type(drifters_io_type) :: self
197  character(len=*), intent(in) :: names(:)
198  character(len=*), intent(out) :: ermesg
199 
200  integer n, ier, i
201  character(len=128) :: attname
202 
203  n = size(names)
204  ermesg = ''
205 
206  do i = 1, n
207  write(attname, '(i6)' ) i
208  attname = 'name_'//adjustl(attname)
209  ier = nf_put_att_text(self%ncid, self%nc_fields, &
210  & trim(attname), len_trim(names(i)), trim(names(i)))
211  if(ier/=nf_noerr) &
212  & ermesg = 'drifters_io_set_field_names::failed to add name attribute to fields '//nf_strerror(ier)
213  enddo
214 
215  end subroutine drifters_io_set_field_names
216 
217 !###############################################################################
218  subroutine drifters_io_set_field_units(self, names, ermesg)
219  type(drifters_io_type) :: self
220  character(len=*), intent(in) :: names(:)
221  character(len=*), intent(out) :: ermesg
222 
223  integer n, ier, i
224  character(len=128) :: attname
225 
226  n = size(names)
227  ermesg = ''
228 
229  do i = 1, n
230  write(attname, '(i6)' ) i
231  attname = 'unit_'//adjustl(attname)
232  ier = nf_put_att_text(self%ncid, self%nc_fields, &
233  & trim(attname), len_trim(names(i)), trim(names(i)))
234  if(ier/=nf_noerr) &
235  & ermesg = 'drifters_io_set_field_units::failed to add unit attribute to fields '//nf_strerror(ier)
236  enddo
237 
238  end subroutine drifters_io_set_field_units
239 !###############################################################################
240 
241  subroutine drifters_io_write(self, time, np, nd, nf, ids, positions, fields, ermesg)
242  type(drifters_io_type) :: self
243  real, intent(in) :: time
244  integer, intent(in) :: np !< number of dirfters
245  integer, intent(in) :: nd !< number of dimensions
246  integer, intent(in) :: nf !< number of fields
247  integer, intent(in) :: ids(np) !< of size np
248  real, intent(in) :: positions(nd,np) !< nd times np
249  real, intent(in) :: fields(nf,np) !< nf times np
250  character(len=*), intent(out) :: ermesg
251 
252  integer ier, i
253  integer :: start1(1), len1(1), start2(2), len2(2)
254  integer :: it_indices(np)
255  real :: time_array(np)
256 
257  ermesg = ''
258 
259  if(.not. self%enddef) then
260  ier = nf_enddef(self%ncid)
261  if(ier/=nf_noerr) then
262  ermesg = 'drifters_io_write::nf_enddef failure. No data will be written. '//nf_strerror(ier)
263  return
264  endif
265  self%enddef = .true.
266  endif
267 
268  if(abs(time - self%time) > drfts_eps_t) then
269  self%it = self%it + 1
270  self%time = time
271  endif
272 
273  start1(1) = self%it_id
274  len1(1) = np
275 
276  it_indices = (/(self%it,i=1,np)/)
277  ier = nf_put_vara_int( self%ncid, self%nc_index_time, start1, len1, it_indices )
278  if(ier/=nf_noerr) &
279  & ermesg = 'drifters_io_write::failed to write index_time: ' //nf_strerror(ier)
280 
281  time_array = (/(time,i=1,np)/)
282  ier = nf90_put_var( self%ncid, self%nc_time, time_array, start1, len1 )
283  if(ier/=nf_noerr) &
284  & ermesg = 'drifters_io_write::failed to write time: ' //nf_strerror(ier)
285 
286  ier = nf_put_vara_int(self%ncid, self%nc_ids, start1, len1, ids)
287  if(ier/=nf_noerr) &
288  & ermesg = 'drifters_io_write::failed to write ids: '//nf_strerror(ier)
289 
290  start2(1) = 1
291  start2(2) = self%it_id
292 
293  len2(1) = nd
294  len2(2) = np
295 
296  ier = nf90_put_var(self%ncid, self%nc_positions, positions, start2, len2)
297  if(ier/=nf_noerr) &
298  & ermesg = 'drifters_io_write::failed to write positions: '//nf_strerror(ier)
299 
300  len2(1) = nf
301  len2(2) = np
302 
303  ier = nf90_put_var(self%ncid, self%nc_fields, fields, start2, len2)
304  if(ier/=nf_noerr) &
305  & ermesg = 'drifters_io_write::failed to write fields: '//nf_strerror(ier)
306 
307  self%it_id = self%it_id + np
308 
309  end subroutine drifters_io_write
310 #endif
311 end module drifters_io_mod
312 !> @}
313 ! close documentation grouping