FMS  2025.04
Flexible Modeling System
drifters_input.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_input_mod drifters_input_mod
19 !> @ingroup drifters
20 !> @brief Imports initial drifter positions from a netCDF file
21 
22 !> @addtogroup drifters_input_mod
23 !> @{
24 module drifters_input_mod
25 #ifdef use_drifters
26  implicit none
27  private
28 
29  public :: drifters_input_type, drifters_input_new, drifters_input_del, drifters_input_save, assignment(=)
30 
31  ! Globals
32  integer, parameter, private :: MAX_STR_LEN = 128
33  ! Include variable "version" to be written to log file.
34 #include<file_version.h>
35  character, parameter, private :: SEPARATOR = ' '
36  !> @}
37 
38  !> @brief Input data type for drifters.
39  !!
40  !> @note Be sure to update drifters_input_new, drifters_input_del and drifters_input_copy_new
41  !! when adding members
42  !> @ingroup drifters_input_mod
43  type drifters_input_type
44  ! Be sure to update drifters_input_new, drifters_input_del and drifters_input_copy_new
45  ! when adding members
46  character(len=MAX_STR_LEN), allocatable :: position_names(:)
47  character(len=MAX_STR_LEN), allocatable :: position_units(:)
48  character(len=MAX_STR_LEN), allocatable :: field_names(:)
49  character(len=MAX_STR_LEN), allocatable :: field_units(:)
50  character(len=MAX_STR_LEN), allocatable :: velocity_names(:)
51  real , allocatable :: positions(:,:)
52  integer , allocatable :: ids(:)
53  character(len=MAX_STR_LEN) :: time_units
54  character(len=MAX_STR_LEN) :: title
55  character(len=MAX_STR_LEN) :: version
56  end type drifters_input_type
57 
58  !> @brief Assignment override for @ref drifters_input_type
59  !> @ingroup drifters_input_mod
60  interface assignment(=)
61  module procedure drifters_input_copy_new
62  end interface
63 
64 !> @addtogroup drifters_input_mod
65 !> @{
66 
67  contains
68 
69 !===============================================================================
70 
71  subroutine drifters_input_new(self, filename, ermesg)
72  use netcdf
73  use netcdf_nf_data
74  use netcdf_nf_interfaces
75  type(drifters_input_type) :: self
76  character(len=*), intent(in) :: filename
77  character(len=*), intent(out):: ermesg
78 
79  ! Local
80  integer :: ier, ncid, nd, nf, np, ipos, j, id, i, isz
81  character(len=MAX_STR_LEN) :: attribute
82 
83  ermesg = ''
84 
85  ier = nf_open(filename, nf_nowrite, ncid)
86  if(ier/=nf_noerr) then
87  ermesg = 'drifters_input: ERROR could not open netcdf file '//filename
88  return
89  endif
90 
91  ! version
92  ier = nf_put_att_text(ncid, nf_global, 'version', len(version), version)
93 
94  ier = nf_inq_dimid(ncid, 'nd', id)
95  if(ier/=nf_noerr) then
96  ermesg = 'drifters_input: ERROR could not find "nd" (number of dimensions)'
97  ier = nf_close(ncid)
98  return
99  endif
100  ier = nf_inq_dimlen(ncid, id, nd)
101 
102  ! determine number of fields (nf)
103  attribute = ''
104  ier = nf_get_att_text(ncid, nf_global, 'field_names', attribute)
105  isz = min(len(attribute), len(trim(attribute))+1)
106  attribute(isz:isz) = ' '
107  ipos = 1
108  nf = 0
109  do i = 1, isz
110  if(attribute(i:i)==separator) then
111  nf = nf + 1
112  endif
113  enddo
114 
115  ier = nf_inq_dimid(ncid, 'np', id)
116  if(ier/=nf_noerr) then
117  ermesg = 'drifters_input: ERROR could not find "np" (number of particles)'
118  ier = nf_close(ncid)
119  return
120  endif
121  ier = nf_inq_dimlen(ncid, id, np)
122 
123  allocate(self%position_names(nd))
124  allocate(self%position_units(nd))
125  allocate(self%field_names(nf))
126  allocate(self%field_units(nf))
127  allocate(self%velocity_names(nd))
128  allocate(self%ids(np))
129  allocate(self%positions(nd, np))
130 
131  ier = nf_inq_varid(ncid, 'ids', id)
132  if(ier/=nf_noerr) then
133  ermesg = 'drifters_input: ERROR could not find "ids"'
134  ier = nf_close(ncid)
135  return
136  endif
137  ier = nf_get_var_int(ncid, id, self%ids)
138 
139  ier = nf_inq_varid(ncid, 'positions', id)
140  if(ier/=nf_noerr) then
141  ermesg = 'drifters_input: ERROR could not find "positions"'
142  ier = nf_close(ncid)
143  return
144  endif
145  ier = nf90_get_var(ncid, id, self%positions)
146 
147  attribute = ''
148  ier = nf_get_att_text(ncid, nf_global, 'version', attribute)
149  self%version = trim(attribute)
150 
151  attribute = ''
152  ier = nf_get_att_text(ncid, nf_global, 'time_units', attribute)
153  self%time_units = trim(attribute)
154 
155  attribute = ''
156  ier = nf_get_att_text(ncid, nf_global, 'title', attribute)
157  self%title = trim(attribute)
158 
159  attribute = ''
160  ier = nf_get_att_text(ncid, id, 'names', attribute)
161  isz = min(len(attribute), len(trim(attribute))+1)
162  attribute(isz:isz) = ' '
163  ipos = 1
164  j = 1
165  do i = 1, isz
166  if(attribute(i:i)==separator) then
167  self%position_names(j) = trim(adjustl(attribute(ipos:i-1)))
168  ipos = i+1
169  j = j + 1
170  if(j > nd) exit
171  endif
172  enddo
173 
174  attribute = ''
175  ier = nf_get_att_text(ncid, id, 'units', attribute)
176  isz = min(len(attribute), len(trim(attribute))+1)
177  attribute(isz:isz) = ' '
178  ipos = 1
179  j = 1
180  do i = 1, isz
181  if(attribute(i:i)==separator) then
182  self%position_units(j) = trim(adjustl(attribute(ipos:i-1)))
183  ipos = i+1
184  j = j + 1
185  if(j > nd) exit
186  endif
187  enddo
188 
189  attribute = ''
190  ier = nf_get_att_text(ncid, nf_global, 'field_names', attribute)
191  isz = min(len(attribute), len(trim(attribute))+1)
192  attribute(isz:isz) = ' '
193  ipos = 1
194  j = 1
195  do i = 1, isz
196  if(attribute(i:i)==separator) then
197  self%field_names(j) = trim(adjustl(attribute(ipos:i-1)))
198  ipos = i+1
199  j = j + 1
200  if(j > nf) exit
201  endif
202  enddo
203 
204  attribute = ''
205  ier = nf_get_att_text(ncid, nf_global, 'field_units', attribute)
206  isz = min(len(attribute), len(trim(attribute))+1)
207  attribute(isz:isz) = ' '
208  ipos = 1
209  j = 1
210  do i = 1, isz
211  if(attribute(i:i)==separator) then
212  self%field_units(j) = trim(adjustl(attribute(ipos:i-1)))
213  ipos = i+1
214  j = j + 1
215  if(j > nf) exit
216  endif
217  enddo
218 
219  attribute = ''
220  ier = nf_get_att_text(ncid, nf_global, 'velocity_names', attribute)
221  isz = min(len(attribute), len(trim(attribute))+1)
222  attribute(isz:isz) = ' '
223  ipos = 1
224  j = 1
225  do i = 1, isz
226  if(attribute(i:i)==separator) then
227  self%velocity_names(j) = trim(adjustl(attribute(ipos:i-1)))
228  ipos = i+1
229  j = j + 1
230  if(j > nd) exit
231  endif
232  enddo
233 
234  end subroutine drifters_input_new
235 
236 !===============================================================================
237  subroutine drifters_input_del(self, ermesg)
238  type(drifters_input_type) :: self
239  character(len=*), intent(out):: ermesg
240 
241  integer :: iflag
242 
243  ermesg = ''
244 
245  deallocate(self%position_names, stat=iflag)
246  deallocate(self%position_units, stat=iflag)
247  deallocate(self%field_names, stat=iflag)
248  deallocate(self%field_units, stat=iflag)
249  deallocate(self%velocity_names, stat=iflag)
250  deallocate(self%ids, stat=iflag)
251  deallocate(self%positions, stat=iflag)
252 
253  end subroutine drifters_input_del
254 
255 !===============================================================================
256  subroutine drifters_input_copy_new(new_instance, old_instance)
257 
258  type(drifters_input_type), intent(inout) :: new_instance
259  type(drifters_input_type), intent(in) :: old_instance
260 
261  allocate(new_instance%position_names( size(old_instance%position_names) ))
262  allocate(new_instance%position_units( size(old_instance%position_units) ))
263  allocate(new_instance%field_names( size(old_instance%field_names) ))
264  allocate(new_instance%field_units( size(old_instance%field_units) ))
265  allocate(new_instance%velocity_names( size(old_instance%velocity_names) ))
266  new_instance%position_names = old_instance%position_names
267  new_instance%position_units = old_instance%position_units
268  new_instance%field_names = old_instance%field_names
269  new_instance%field_units = old_instance%field_units
270  new_instance%velocity_names = old_instance%velocity_names
271  new_instance%time_units = old_instance%time_units
272  new_instance%title = old_instance%title
273  new_instance%version = old_instance%version
274  allocate(new_instance%positions( size(old_instance%positions,1),size(old_instance%positions,2) ))
275  new_instance%positions = old_instance%positions
276  allocate(new_instance%ids(size(old_instance%ids)))
277  new_instance%ids = old_instance%ids
278 
279  end subroutine drifters_input_copy_new
280 
281 !===============================================================================
282  !> @brief save state in netcdf file. can be used as restart file.
283  subroutine drifters_input_save(self, filename, geolon, geolat, ermesg)
284  ! save state in netcdf file. can be used as restart file.
285  use netcdf
286  use netcdf_nf_data
287  use netcdf_nf_interfaces
288  type(drifters_input_type) :: self
289  character(len=*), intent(in ):: filename
290  real, intent(in), optional :: geolon(:), geolat(:)
291  character(len=*), intent(out):: ermesg
292 
293 
294  integer ncid, nc_nd, nc_np, ier, nd, np, nf, nc_pos, nc_ids, i, j, n
295  integer nc_lon, nc_lat
296  character(len=MAX_STR_LEN) :: att
297 
298 
299  ermesg = ''
300 
301  ier = nf_create(filename, nf_clobber, ncid)
302  if(ier/=nf_noerr) then
303  ermesg = 'drifters_input: ERROR cannot create '//filename
304  return
305  endif
306 
307  nd = size(self%positions, 1)
308  np = size(self%positions, 2)
309  nf = size(self%field_names)
310 
311  ! dimensions
312  ier = nf_def_dim(ncid, 'nd', nd, nc_nd)
313  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR creating dim "nd" '//nf_strerror(ier)
314 
315  ier = nf_def_dim(ncid, 'np', np, nc_np)
316  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR creating dim "np" '//nf_strerror(ier)
317 
318  ! global attributes
319  ier = nf_put_att_text(ncid, nf_global, 'title', len_trim(self%title), self%title)
320  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR setting global att "title" ' &
321  & //nf_strerror(ier)
322 
323  ier = nf_put_att_text(ncid, nf_global, 'time_units', len_trim(self%time_units), self%time_units)
324  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR setting global att "time_units" ' &
325  & //nf_strerror(ier)
326 
327  att = ''
328  j = 1
329  do i = 1, nf
330  n = len_trim(self%field_units(i))
331  att(j:j+n+1) = trim(self%field_units(i)) // ' '
332  j = j + n + 1
333  enddo
334  ier = nf_put_att_text(ncid, nf_global, 'field_units', len_trim(att), &
335  & att)
336  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR setting global att "field_units" ' &
337  & //nf_strerror(ier)
338 
339  att = ''
340  j = 1
341  do i = 1, nf
342  n = len_trim(self%field_names(i))
343  att(j:j+n+1) = trim(self%field_names(i)) // ' '
344  j = j + n + 1
345  enddo
346  ier = nf_put_att_text(ncid, nf_global, 'field_names', len_trim(att), &
347  & att)
348  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR setting global att "field_names" ' &
349  & //nf_strerror(ier)
350 
351  att = ''
352  j = 1
353  do i = 1, nd
354  n = len_trim(self%velocity_names(i))
355  att(j:j+n+1) = trim(self%velocity_names(i)) // ' '
356  j = j + n + 1
357  enddo
358  ier = nf_put_att_text(ncid, nf_global, 'velocity_names', len_trim(att), &
359  & att)
360  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR setting global att "velocity_names" ' &
361  & //nf_strerror(ier)
362 
363  ! variables
364  ier = nf_def_var(ncid, 'positions', nf_double, 2, (/nc_nd, nc_np/), nc_pos)
365  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR creating var "positions" '//nf_strerror(ier)
366 
367  ier = nf_def_var(ncid, 'ids', nf_int, 1, (/nc_np/), nc_ids)
368  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR creating var "ids" '//nf_strerror(ier)
369 
370  ! optional: longitudes/latitudes in deg
371  if(present(geolon)) then
372  ier = nf_def_var(ncid, 'longitude', nf_double, 1, (/nc_np/), nc_lon)
373  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR creating var "longitude" ' &
374  & //nf_strerror(ier)
375  att = 'degrees_east'
376  ier = nf_put_att_text(ncid, nc_lon, 'units', len(trim(att)), trim(att))
377  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR setting att "units" to "longitude" ' &
378  & //nf_strerror(ier)
379  endif
380  if(present(geolat)) then
381  ier = nf_def_var(ncid, 'latitude', nf_double, 1, (/nc_np/), nc_lat)
382  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR creating var "latitude" ' &
383  & //nf_strerror(ier)
384  att = 'degrees_north'
385  ier = nf_put_att_text(ncid, nc_lat, 'units', len(trim(att)), trim(att))
386  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR setting att "units" to "latitude" ' &
387  & //nf_strerror(ier)
388  endif
389 
390  ! variable attributes
391 
392  att = ''
393  j = 1
394  do i = 1, nd
395  n = len_trim(self%position_units(i))
396  att(j:j+n+1) = trim(self%position_units(i)) // ' '
397  j = j + n + 1
398  enddo
399  ier = nf_put_att_text(ncid, nc_pos, 'units', len_trim(att), &
400  & att)
401  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR setting att "units" to "positions" ' &
402  & //nf_strerror(ier)
403 
404  att = ''
405  j = 1
406  do i = 1, nd
407  n = len_trim(self%position_names(i))
408  att(j:j+n+1) = trim(self%position_names(i)) // ' '
409  j = j + n + 1
410  enddo
411  ier = nf_put_att_text(ncid, nc_pos, 'names', len_trim(att), &
412  & att)
413  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR setting att "names" to "positions" ' &
414  & //nf_strerror(ier)
415 
416  ! end of define mode
417  ier = nf_enddef(ncid)
418  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR could not end define mode ' &
419  & //nf_strerror(ier)
420 
421  ! data
422  ier = nf90_put_var(ncid, nc_pos, self%positions)
423  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR could not write "positions" ' &
424  & //nf_strerror(ier)
425 
426  ier = nf90_put_var(ncid, nc_ids, self%ids)
427  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR could not write "ids" ' &
428  & //nf_strerror(ier)
429 
430  if(present(geolon)) then
431  ier = nf90_put_var(ncid, nc_lon, geolon)
432  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR could not write "geolon" ' &
433  & //nf_strerror(ier)
434  endif
435  if(present(geolat)) then
436  ier = nf90_put_var(ncid, nc_lat, geolat)
437  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR could not write "geolat" ' &
438  & //nf_strerror(ier)
439  endif
440 
441 
442  ier = nf_close(ncid)
443  if(ier/=nf_noerr) ermesg = 'drifters_input_save: ERROR could not close file ' &
444  & //nf_strerror(ier)
445 
446  end subroutine drifters_input_save
447 #endif
448 end module drifters_input_mod
449 !> @}
450 ! close documentation grouping