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