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