FMS  2024.03
Flexible Modeling System
fms_io_unstructured_register_restart_field.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 !----------
20 !ug support
21 !> @addtogroup fms_io_mod
22 !> @{
23 
24 !------------------------------------------------------------------------------
25 !>Add a real scalar field to a restart object (restart_file_type). Return
26 !!the index of the inputted field in the fileObj%var array.
28  filename, &
29  fieldname, &
30  fdata_0d, &
31  domain, &
32  mandatory, &
33  data_default, &
34  longname, &
35  units, &
36  read_only, &
37  restart_owns_data) &
38  result(restart_index)
39 
40  !Inputs/Outputs
41  type(restart_file_type),intent(inout) :: fileobj !<A restart object.
42  character(len=*),intent(in) :: filename !<The name of a file.
43  character(len=*),intent(in) :: fieldname !<The name of a field.
44  real,intent(in),target :: fdata_0d !<Some data.
45  type(domainug),intent(in),target :: domain !<An unstructured mpp_domain.
46  logical,intent(in),optional :: mandatory !<Flag telling if the field is mandatory
47  !! for the restart.
48  real,intent(in),optional :: data_default !<A default value for the data.
49  character(len=*),intent(in),optional :: longname !<A more descriptive name of the field.
50  character(len=*),intent(in),optional :: units !<Units for the field.
51  logical(INT_KIND),intent(in),optional :: read_only !<Tells whether or not the variable
52  !! will be written to the restart file.
53  logical(INT_KIND),intent(in),optional :: restart_owns_data !<Tells if the data will be
54  !! deallocated when the restart object is deallocated.
55  integer(INT_KIND) :: restart_index !<Index of the inputted field in the fileObj%var array.
56 
57  !Local variables
58  type(domainug),pointer :: io_domain !<Pointer to an unstructured I/O domain.
59  integer(INT_KIND) :: io_domain_npes !<The number of ranks
60  !! in the unstructured I/O domain pelist.
61  integer(INT_KIND),dimension(:),allocatable :: pelist !<A pelist.
62  real,dimension(:),allocatable :: fdata_per_rank !<Array used to gather the scalar field values.
63  integer(INT_KIND) :: index_field !<Index of the inputted
64  !! field in the fileObj%var array.
65  integer(INT_KIND),dimension(NIDX) :: field_dimension_sizes !<Array of dimension sizes for the field.
66  integer(INT_KIND),dimension(1) :: field_dimension_order !<Array telling the
67  !! ordering of the dimensions for the field.
68 
69  !Make sure that the module has been initialized.
70  if (.not. module_is_initialized) then
71  call mpp_error(fatal, &
72  "fms_io_unstructured_register_restart_field_r_0d:" &
73  //" you must first call fms_io_init")
74  endif
75 
76  !Make sure that the value of the scalar field is same across all ranks
77  !in an I/O domain pelist.
78  io_domain => null()
79  io_domain => mpp_get_ug_io_domain(domain)
80  io_domain_npes = mpp_get_ug_domain_npes(io_domain)
81  allocate(pelist(io_domain_npes))
82  call mpp_get_ug_domain_pelist(io_domain, &
83  pelist)
84  allocate(fdata_per_rank(io_domain_npes))
85  fdata_per_rank = 0.0
86  call mpp_gather((/fdata_0d/), &
87  fdata_per_rank, &
88  pelist)
89  if (mpp_pe() .eq. pelist(1)) then
90  if (maxval(fdata_per_rank) .ne. fdata_0d .or. &
91  minval(fdata_per_rank) .ne. fdata_0d) then
92  call mpp_error(fatal, &
93  "fms_io_unstructured_register_restart_field_r_0d:" &
94  //" the scalar field data is not consistent across" &
95  //" all ranks in the I/O domain pelist.")
96  endif
97  endif
98  io_domain => null()
99  deallocate(pelist)
100  deallocate(fdata_per_rank)
101 
102  !Set the dimension sizes for the field. These correspond to:
103  !field_dimension_sizes(XIDX) = x-dimension size
104  !field_dimension_sizes(YIDX) = y-dimension size
105  !field_dimension_sizes(CIDX) = c-dimension size
106  !field_dimension_sizes(ZIDX) = z-dimension size
107  !field_dimension_sizes(HIDX) = h-dimension size
108  !field_dimension_sizes(TIDX) = t-dimension size
109  !field_dimension_sizes(UIDX) = u-dimension size
110  !field_dimension_sizes(CCIDX) = cc-dimension size
111  field_dimension_sizes = 1
112 
113  !Set the ordering of the dimensions for the field.
114  field_dimension_order(1) = tidx
115 
116  !Add a field to a restart object (restart_file_type). Get the index of the
117  !inputted field in the fileObj%var array.
119  filename, &
120  fieldname, &
121  field_dimension_order, &
122  field_dimension_sizes, &
123  index_field, &
124  domain, &
125  mandatory=mandatory, &
126  data_default=data_default, &
127  longname=longname, &
128  units=units, &
129  read_only=read_only, &
130  owns_data=restart_owns_data)
131 
132  !Point to the inputted data and return the "index_field" for the field.
133  fileobj%p0dr(fileobj%var(index_field)%siz(4),index_field)%p => fdata_0d
134  fileobj%var(index_field)%ndim = 0
135  restart_index = index_field
136 
137  return
139 
140 !------------------------------------------------------------------------------
141 !>Add a real 1D field to a restart object (restart_file_type), where the
142 !!field is assumed to be along the unstructured axis. Return
143 !!the index of the inputted field in the fileObj%var array.
145  filename, &
146  fieldname, &
147  fdata_1d, &
148  fdata_1d_axes, &
149  domain, &
150  mandatory, &
151  data_default, &
152  longname, &
153  units, &
154  read_only, &
155  restart_owns_data) &
156  result(restart_index)
157 
158  !Inputs/Outputs
159  type(restart_file_type),intent(inout) :: fileobj !<A restart object.
160  character(len=*),intent(in) :: filename !<The name of a file.
161  character(len=*),intent(in) :: fieldname !<The name of a field.
162  real,dimension(:),intent(in),target :: fdata_1d !<Some data.
163  integer(INT_KIND),dimension(1) :: fdata_1d_axes !<An array describing the axes for the data.
164  type(domainug),intent(in),target :: domain !<An unstructured mpp_domain.
165  logical,intent(in),optional :: mandatory !<Flag telling if the field is mandatory
166  !! for the restart.
167  real,intent(in),optional :: data_default !<A default value for the data.
168  character(len=*),intent(in),optional :: longname !<A more descriptive name of the field.
169  character(len=*),intent(in),optional :: units !<Units for the field.
170  logical(INT_KIND),intent(in),optional :: read_only !<Tells whether or not the variable
171  !! will be written to the restart file.
172  logical(INT_KIND),intent(in),optional :: restart_owns_data !<Tells if the data will be
173  !! deallocated when the restart object is deallocated.
174  integer(INT_KIND) :: restart_index !<Index of the inputted field in the fileObj%var array.
175 
176  !Local variables
177  integer(INT_KIND) :: index_field !<Index of the inputted field in the fileObj%var array.
178  integer(INT_KIND),dimension(NIDX) :: field_dimension_sizes !<Array of dimension sizes for the field.
179 
180  !Make sure that the module has been initialized.
181  if (.not. module_is_initialized) then
182  call mpp_error(fatal, &
183  "fms_io_unstructured_register_restart_field_r_1d:" &
184  //" you must first call fms_io_init")
185  endif
186 
187  !Make sure that at least one axis was registered to the restart object.
188  if (.not. allocated(fileobj%axes)) then
189  call mpp_error(fatal, &
190  "fms_io_unstructured_register_restart_field_r_1d:" &
191  //" no axes have been registered for the restart" &
192  //" object.")
193  endif
194 
195  !Make sure that the first dimension of the field is a "compressed" axis,
196  !and that it corresponds to an axis that has been registered to the
197  !restart object.
198  field_dimension_sizes = 1
199  if (fdata_1d_axes(1) .eq. cidx) then
200  if (.not. allocated(fileobj%axes(cidx)%idx)) then
201  call mpp_error(fatal, &
202  "fms_io_unstructured_register_restart_field_r_1d:" &
203  //" a compressed c-axis was not registered" &
204  //" to the restart object.")
205  endif
206  if (size(fdata_1d,1) .ne. fileobj%axes(cidx)%nelems_for_current_rank) then
207  call mpp_error(fatal, &
208  "fms_io_unstructured_register_restart_field_r_1d:" &
209  //" the size of the input data does not" &
210  //" match the size of the registered" &
211  //" compressed c-axis.")
212  endif
213  field_dimension_sizes(cidx) = size(fdata_1d,1)
214  elseif (fdata_1d_axes(1) .eq. hidx) then
215  if (.not. allocated(fileobj%axes(hidx)%idx)) then
216  call mpp_error(fatal, &
217  "fms_io_unstructured_register_restart_field_r_1d:" &
218  //" a compressed h-axis was not registered" &
219  //" to the restart object.")
220  endif
221  if (size(fdata_1d,1) .ne. fileobj%axes(hidx)%nelems_for_current_rank) then
222  call mpp_error(fatal, &
223  "fms_io_unstructured_register_restart_field_r_1d:" &
224  //" the size of the input data does not" &
225  //" match the size of the registered" &
226  //" compressed h-axis.")
227  endif
228  field_dimension_sizes(hidx) = size(fdata_1d,1)
229  else
230  call mpp_error(fatal, &
231  "fms_io_unstructured_register_restart_field_r_1d:" &
232  //" One dimensional fields must be compressed.")
233  endif
234 
235  !Add a field to a restart object (restart_file_type). Get the index of the
236  !inputted field in the fileObj%var array.
238  filename, &
239  fieldname, &
240  fdata_1d_axes, &
241  field_dimension_sizes, &
242  index_field, &
243  domain, &
244  mandatory=mandatory, &
245  data_default=data_default, &
246  longname=longname, &
247  units=units, &
248  read_only=read_only, &
249  owns_data=restart_owns_data)
250 
251  !Point to the inputted data and return the "index_field" for the field.
252  fileobj%p1dr(fileobj%var(index_field)%siz(4),index_field)%p => fdata_1d
253  fileobj%var(index_field)%ndim = 1
254  restart_index = index_field
255 
256  return
258 
259 !------------------------------------------------------------------------------
260 !>Add a real 2D field to a restart object (restart_file_type), where the
261 !!field's 1st axis assumed to be along the unstructured axis and the field's
262 !!2nd axis is assumed to be along the z-axis. Return the index of the
263 !!inputted field in the fileObj%var array.
265  filename, &
266  fieldname, &
267  fdata_2d, &
268  fdata_2d_axes, &
269  domain, &
270  mandatory, &
271  data_default, &
272  longname, &
273  units, &
274  read_only, &
275  restart_owns_data) &
276  result(restart_index)
277 
278  !Inputs/Outputs
279  type(restart_file_type),intent(inout) :: fileobj !<A restart object.
280  character(len=*),intent(in) :: filename !<The name of a file.
281  character(len=*),intent(in) :: fieldname !<The name of a field.
282  real,dimension(:,:),intent(in),target :: fdata_2d !<Some data.
283  integer(INT_KIND),dimension(2) :: fdata_2d_axes !<An array describing the axes for the data.
284  type(domainug),intent(in),target :: domain !<An unstructured mpp_domain.
285  logical,intent(in),optional :: mandatory !<Flag telling if the field is mandatory
286  !! for the restart.
287  real,intent(in),optional :: data_default !<A default value for the data.
288  character(len=*),intent(in),optional :: longname !<A more descriptive name of the field.
289  character(len=*),intent(in),optional :: units !<Units for the field.
290  logical(INT_KIND),intent(in),optional :: read_only !<Tells whether or not the variable
291  !! will be written to the restart file.
292  logical(INT_KIND),intent(in),optional :: restart_owns_data !<Tells if the data will be
293  !! deallocated when the restart object is deallocated.
294  integer(INT_KIND) :: restart_index !<Index of the inputted field in the fileObj%var array.
295 
296  !Local variables
297  integer(INT_KIND) :: index_field !<Index of the inputted field in the fileObj%var array.
298  integer(INT_KIND),dimension(NIDX) :: field_dimension_sizes !<Array of dimension sizes for the field.
299 
300  !Make sure that the module has been initialized.
301  if (.not. module_is_initialized) then
302  call mpp_error(fatal, &
303  "fms_io_unstructured_register_restart_field_r_2d:" &
304  //" you must first call fms_io_init")
305  endif
306 
307  !Make sure that at least one axis was registered to the restart object.
308  if (.not. allocated(fileobj%axes)) then
309  call mpp_error(fatal, &
310  "fms_io_unstructured_register_restart_field_r_2d:" &
311  //" no axes have been registered for the restart" &
312  //" object.")
313  endif
314 
315  !Make sure that the first dimension of the field is a "compressed" axis,
316  !and that it corresponds to an axis that has been registered to the
317  !restart object.
318  field_dimension_sizes = 1
319  if (fdata_2d_axes(1) .eq. cidx) then
320  if (.not. allocated(fileobj%axes(cidx)%idx)) then
321  call mpp_error(fatal, &
322  "fms_io_unstructured_register_restart_field_r_2d:" &
323  //" a compressed c-axis was not registered" &
324  //" to the restart object.")
325  endif
326  if (size(fdata_2d,1) .ne. fileobj%axes(cidx)%nelems_for_current_rank) then
327  call mpp_error(fatal, &
328  "fms_io_unstructured_register_restart_field_r_2d:" &
329  //" the size of the input data does not" &
330  //" match the size of the registered" &
331  //" compressed c-axis.")
332  endif
333  field_dimension_sizes(cidx) = size(fdata_2d,1)
334  elseif (fdata_2d_axes(1) .eq. hidx) then
335  if (.not. allocated(fileobj%axes(hidx)%idx)) then
336  call mpp_error(fatal, &
337  "fms_io_unstructured_register_restart_field_r_2d:" &
338  //" a compressed h-axis was not registered" &
339  //" to the restart object.")
340  endif
341  if (size(fdata_2d,1) .ne. fileobj%axes(hidx)%nelems_for_current_rank) then
342  call mpp_error(fatal, &
343  "fms_io_unstructured_register_restart_field_r_2d:" &
344  //" the size of the input data does not" &
345  //" match the size of the registered" &
346  //" compressed h-axis.")
347  endif
348  field_dimension_sizes(hidx) = size(fdata_2d,1)
349  else
350  call mpp_error(fatal, &
351  "fms_io_unstructured_register_restart_field_r_2d:" &
352  //" The first dimension of the field must be a" &
353  //" compressed dimension.")
354  endif
355 
356  !Make sure that the second dimension of the inputted field corresponds to
357  !either a registered z- or cc-axis.
358  if (fdata_2d_axes(2) .eq. zidx) then
359  if (.not. associated(fileobj%axes(zidx)%data)) then
360  call mpp_error(fatal, &
361  "fms_io_unstructured_register_restart_field_r_2d:" &
362  //" a z-axis was not registered to the" &
363  //" restart object.")
364  endif
365  if (size(fdata_2d,2) .ne. size(fileobj%axes(zidx)%data)) then
366  call mpp_error(fatal, &
367  "fms_io_unstructured_register_restart_field_r_2d:" &
368  //" the size of the input data does not" &
369  //" match the size of the registered" &
370  //" z-axis.")
371  endif
372  field_dimension_sizes(zidx) = size(fdata_2d,2)
373  elseif (fdata_2d_axes(2) .eq. ccidx) then
374  if (.not. associated(fileobj%axes(ccidx)%data)) then
375  call mpp_error(fatal, &
376  "fms_io_unstructured_register_restart_field_r_2d:" &
377  //" a cc-axis was not registered to the" &
378  //" restart object.")
379  endif
380  if (size(fdata_2d,2) .ne. size(fileobj%axes(ccidx)%data)) then
381  call mpp_error(fatal, &
382  "fms_io_unstructured_register_restart_field_r_2d:" &
383  //" the size of the input data does not" &
384  //" match the size of the registered" &
385  //" cc-axis.")
386  endif
387  field_dimension_sizes(ccidx) = size(fdata_2d,2)
388  else
389  call mpp_error(fatal, &
390  "fms_io_unstructured_register_restart_field_r_2d:" &
391  //" unsupported axis parameter for the second" &
392  //" dimension of the field.")
393  endif
394 
395  !Add a field to a restart object (restart_file_type). Get the index of the
396  !inputted field in the fileObj%var array.
398  filename, &
399  fieldname, &
400  fdata_2d_axes, &
401  field_dimension_sizes, &
402  index_field, &
403  domain, &
404  mandatory=mandatory, &
405  data_default=data_default, &
406  longname=longname, &
407  units=units, &
408  read_only=read_only, &
409  owns_data=restart_owns_data)
410 
411  !Point to the inputted data and return the "index_field" for the field.
412  fileobj%p2dr(fileobj%var(index_field)%siz(4),index_field)%p => fdata_2d
413  fileobj%var(index_field)%ndim = 2
414  restart_index = index_field
415 
416  return
418 
419 !------------------------------------------------------------------------------
420 !>Add a real 3D field to a restart object (restart_file_type), where the
421 !!field's 1st axis assumed to be along the unstructured axis, the fields's
422 !!second axis is assumed to be along the z-axis, and the field's third axis
423 !!is assumed to be along the cc-axis (???). Return the index of the
424 !!inputted field in the fileObj%var array.
426  filename, &
427  fieldname, &
428  fdata_3d, &
429  fdata_3d_axes, &
430  domain, &
431  mandatory, &
432  data_default, &
433  longname, &
434  units, &
435  read_only, &
436  restart_owns_data) &
437  result(restart_index)
438 
439  !Inputs/Outputs
440  type(restart_file_type),intent(inout) :: fileobj !<A restart object.
441  character(len=*),intent(in) :: filename !<The name of a file.
442  character(len=*),intent(in) :: fieldname !<The name of a field.
443  real,dimension(:,:,:),intent(in),target :: fdata_3d !<Some data.
444  integer(INT_KIND),dimension(3) :: fdata_3d_axes !<An array describing the axes for the data.
445  type(domainug),intent(in),target :: domain !<An unstructured mpp_domain.
446  logical,intent(in),optional :: mandatory !<Flag telling if the field
447  !! is mandatory for the restart.
448  real,intent(in),optional :: data_default !<A default value for the data.
449  character(len=*),intent(in),optional :: longname !<A more descriptive name of the field.
450  character(len=*),intent(in),optional :: units !<Units for the field.
451  logical(INT_KIND),intent(in),optional :: read_only !<Tells whether or not the
452  !! variable will be written to the restart file.
453  logical(INT_KIND),intent(in),optional :: restart_owns_data !<Tells if the data will be
454  !! deallocated when the restart object is deallocated.
455  integer(INT_KIND) :: restart_index !<Index of the inputted field in the
456  !! fileObj%var array.
457 
458  !Local variables
459  integer(INT_KIND) :: index_field !<Index of the inputted field in the fileObj%var array.
460  integer(INT_KIND),dimension(NIDX) :: field_dimension_sizes !<Array of dimension sizes for the field.
461 
462  !Make sure that the module has been initialized.
463  if (.not. module_is_initialized) then
464  call mpp_error(fatal, &
465  "fms_io_unstructured_register_restart_field_r_3d:" &
466  //" you must first call fms_io_init")
467  endif
468 
469  !Make sure that at least one axis was registered to the restart object.
470  if (.not. allocated(fileobj%axes)) then
471  call mpp_error(fatal, &
472  "fms_io_unstructured_register_restart_field_r_3d:" &
473  //" no axes have been registered for the restart" &
474  //" object.")
475  endif
476 
477  !Make sure that the first dimension of the field is a "compressed" axis,
478  !and that it corresponds to an axis that has been registered to the
479  !restart object.
480  field_dimension_sizes = 1
481  if (fdata_3d_axes(1) .eq. cidx) then
482  if (.not. allocated(fileobj%axes(cidx)%idx)) then
483  call mpp_error(fatal, &
484  "fms_io_unstructured_register_restart_field_r_3d:" &
485  //" a compressed c-axis was not registered" &
486  //" to the restart object.")
487  endif
488  if (size(fdata_3d,1) .ne. fileobj%axes(cidx)%nelems_for_current_rank) then
489  call mpp_error(fatal, &
490  "fms_io_unstructured_register_restart_field_r_3d:" &
491  //" the size of the input data does not" &
492  //" match the size of the registered" &
493  //" compressed c-axis.")
494  endif
495  field_dimension_sizes(cidx) = size(fdata_3d,1)
496  elseif (fdata_3d_axes(1) .eq. hidx) then
497  if (.not. allocated(fileobj%axes(hidx)%idx)) then
498  call mpp_error(fatal, &
499  "fms_io_unstructured_register_restart_field_r_3d:" &
500  //" a compressed h-axis was not registered" &
501  //" to the restart object.")
502  endif
503  if (size(fdata_3d,1) .ne. fileobj%axes(hidx)%nelems_for_current_rank) then
504  call mpp_error(fatal, &
505  "fms_io_unstructured_register_restart_field_r_3d:" &
506  //" the size of the input data does not" &
507  //" match the size of the registered" &
508  //" compressed h-axis.")
509  endif
510  field_dimension_sizes(hidx) = size(fdata_3d,1)
511  else
512  call mpp_error(fatal, &
513  "fms_io_unstructured_register_restart_field_r_3d:" &
514  //" The first dimension of the field must be a" &
515  //" compressed dimension.")
516  endif
517 
518  !Make sure that the second and third dimensions of the inputted field
519  !corresponds to some combination of registered z- and cc-axes.
520  if (.not. associated(fileobj%axes(zidx)%data)) then
521  call mpp_error(fatal, &
522  "fms_io_unstructured_register_restart_field_r_3d:" &
523  //" a z-axis was not registered to the" &
524  //" restart object.")
525  endif
526  if (.not. associated(fileobj%axes(ccidx)%data)) then
527  call mpp_error(fatal, &
528  "fms_io_unstructured_register_restart_field_r_3d:" &
529  //" a cc-axis was not registered to the" &
530  //" restart object.")
531  endif
532  if (fdata_3d_axes(2) .eq. zidx) then
533  if (size(fdata_3d,2) .ne. size(fileobj%axes(zidx)%data)) then
534  call mpp_error(fatal, &
535  "fms_io_unstructured_register_restart_field_r_3d:" &
536  //" the size of the input data does not" &
537  //" match the size of the registered" &
538  //" z-axis.")
539  endif
540  field_dimension_sizes(zidx) = size(fdata_3d,2)
541  if (fdata_3d_axes(3) .ne. ccidx) then
542  call mpp_error(fatal, &
543  "fms_io_unstructured_register_restart_field_r_3d:" &
544  //" unsupported axis parameter for the third" &
545  //" dimension of the field.")
546  elseif (size(fdata_3d,3) .ne. size(fileobj%axes(ccidx)%data)) then
547  call mpp_error(fatal, &
548  "fms_io_unstructured_register_restart_field_r_3d:" &
549  //" the size of the input data does not" &
550  //" match the size of the registered" &
551  //" cc-axis.")
552 
553  else
554  field_dimension_sizes(ccidx) = size(fdata_3d,3)
555  endif
556  elseif (fdata_3d_axes(2) .eq. ccidx) then
557  if (size(fdata_3d,2) .ne. size(fileobj%axes(ccidx)%data)) then
558  call mpp_error(fatal, &
559  "fms_io_unstructured_register_restart_field_r_3d:" &
560  //" the size of the input data does not" &
561  //" match the size of the registered" &
562  //" cc-axis.")
563  endif
564  field_dimension_sizes(ccidx) = size(fdata_3d,2)
565  if (fdata_3d_axes(3) .ne. zidx) then
566  call mpp_error(fatal, &
567  "fms_io_unstructured_register_restart_field_r_3d:" &
568  //" unsupported axis parameter for the third" &
569  //" dimension of the field.")
570  elseif (size(fdata_3d,3) .ne. size(fileobj%axes(zidx)%data)) then
571  call mpp_error(fatal, &
572  "fms_io_unstructured_register_restart_field_r_3d:" &
573  //" the size of the input data does not" &
574  //" match the size of the registered" &
575  //" z-axis.")
576  else
577  field_dimension_sizes(zidx) = size(fdata_3d,3)
578  endif
579  else
580  call mpp_error(fatal, &
581  "fms_io_unstructured_register_restart_field_r_3d:" &
582  //" unsupported axis parameter for the second" &
583  //" dimension of the field.")
584  endif
585 
586  !Add a field to a restart object (restart_file_type). Get the index of the
587  !inputted field in the fileObj%var array.
589  filename, &
590  fieldname, &
591  fdata_3d_axes, &
592  field_dimension_sizes, &
593  index_field, &
594  domain, &
595  mandatory=mandatory, &
596  data_default=data_default, &
597  longname=longname, &
598  units=units, &
599  read_only=read_only, &
600  owns_data=restart_owns_data)
601 
602  !Point to the inputted data and return the "index_field" for the field.
603  fileobj%p3dr(fileobj%var(index_field)%siz(4),index_field)%p => fdata_3d
604  fileobj%var(index_field)%ndim = 3
605  restart_index = index_field
606 
607  return
609 
610 #ifdef OVERLOAD_R8
611 !------------------------------------------------------------------------------
612 !>Add a double_kind 2D field to a restart object (restart_file_type), where the
613 !!field's 1st axis assumed to be along the unstructured axis and the field's
614 !!2nd axis is assumed to be along the z-axis. Return the index of the
615 !!inputted field in the fileObj%var array.
617  filename, &
618  fieldname, &
619  fdata_2d, &
620  fdata_2d_axes, &
621  domain, &
622  mandatory, &
623  data_default, &
624  longname, &
625  units, &
626  read_only, &
627  restart_owns_data) &
628  result(restart_index)
629 
630  !Inputs/Outputs
631  type(restart_file_type),intent(inout) :: fileobj !<A restart object.
632  character(len=*),intent(in) :: filename !<The name of a file.
633  character(len=*),intent(in) :: fieldname !<The name of a field.
634  real(double_kind),dimension(:,:),intent(in),target :: fdata_2d !<Some data.
635  integer(INT_KIND),dimension(2) :: fdata_2d_axes !<An array describing the axes for the data.
636  type(domainug),intent(in),target :: domain !<An unstructured mpp_domain.
637  logical,intent(in),optional :: mandatory !<Flag telling if the field is mandatory
638  !! for the restart.
639  real(double_kind),intent(in),optional :: data_default !<A default value for the data.
640  character(len=*),intent(in),optional :: longname !<A more descriptive name of the field.
641  character(len=*),intent(in),optional :: units !<Units for the field.
642  logical(INT_KIND),intent(in),optional :: read_only !<Tells whether or not the variable
643  !! will be written to the restart file.
644  logical(INT_KIND),intent(in),optional :: restart_owns_data !<Tells if the data will be
645  !! deallocated when the restart object is deallocated.
646  integer(INT_KIND) :: restart_index !<Index of the inputted field in the fileObj%var array.
647 
648  !Local variables
649  integer(INT_KIND) :: index_field !<Index of the inputted field in the fileObj%var array.
650  integer(INT_KIND),dimension(NIDX) :: field_dimension_sizes !<Array of dimension sizes for the field.
651 
652  !QUICK ERROR OUT AS SUPPORT NOT YET FULLY IMPLEMENTED
653  call mpp_error(fatal, &
654  "fms_io_unstructured_register_restart_field_r8_2d:" &
655  //" support has not yet been fully implemented")
656 
657  !Make sure that the module has been initialized.
658  if (.not. module_is_initialized) then
659  call mpp_error(fatal, &
660  "fms_io_unstructured_register_restart_field_r8_2d:" &
661  //" you must first call fms_io_init")
662  endif
663 
664  !Make sure that at least one axis was registered to the restart object.
665  if (.not. allocated(fileobj%axes)) then
666  call mpp_error(fatal, &
667  "fms_io_unstructured_register_restart_field_r8_2d:" &
668  //" no axes have been registered for the restart" &
669  //" object.")
670  endif
671 
672  !Make sure that the first dimension of the field is a "compressed" axis,
673  !and that it corresponds to an axis that has been registered to the
674  !restart object.
675  field_dimension_sizes = 1
676  if (fdata_2d_axes(1) .eq. cidx) then
677  if (.not. allocated(fileobj%axes(cidx)%idx)) then
678  call mpp_error(fatal, &
679  "fms_io_unstructured_register_restart_field_r8_2d:" &
680  //" a compressed c-axis was not registered" &
681  //" to the restart object.")
682  endif
683  if (size(fdata_2d,1) .ne. fileobj%axes(cidx)%nelems_for_current_rank) then
684  call mpp_error(fatal, &
685  "fms_io_unstructured_register_restart_field_r8_2d:" &
686  //" the size of the input data does not" &
687  //" match the size of the registered" &
688  //" compressed c-axis.")
689  endif
690  field_dimension_sizes(cidx) = size(fdata_2d,1)
691  elseif (fdata_2d_axes(1) .eq. hidx) then
692  if (.not. allocated(fileobj%axes(hidx)%idx)) then
693  call mpp_error(fatal, &
694  "fms_io_unstructured_register_restart_field_r8_2d:" &
695  //" a compressed h-axis was not registered" &
696  //" to the restart object.")
697  endif
698  if (size(fdata_2d,1) .ne. fileobj%axes(hidx)%nelems_for_current_rank) then
699  call mpp_error(fatal, &
700  "fms_io_unstructured_register_restart_field_r8_2d:" &
701  //" the size of the input data does not" &
702  //" match the size of the registered" &
703  //" compressed h-axis.")
704  endif
705  field_dimension_sizes(hidx) = size(fdata_2d,1)
706  else
707  call mpp_error(fatal, &
708  "fms_io_unstructured_register_restart_field_r8_2d:" &
709  //" The first dimension of the field must be a" &
710  //" compressed dimension.")
711  endif
712 
713  !Make sure that the second dimension of the inputted field corresponds to
714  !either a registered z- or cc-axis.
715  if (fdata_2d_axes(2) .eq. zidx) then
716  if (.not. associated(fileobj%axes(zidx)%data)) then
717  call mpp_error(fatal, &
718  "fms_io_unstructured_register_restart_field_r8_2d:" &
719  //" a z-axis was not registered to the" &
720  //" restart object.")
721  endif
722  if (size(fdata_2d,2) .ne. size(fileobj%axes(zidx)%data)) then
723  call mpp_error(fatal, &
724  "fms_io_unstructured_register_restart_field_r8_2d:" &
725  //" the size of the input data does not" &
726  //" match the size of the registered" &
727  //" z-axis.")
728  endif
729  field_dimension_sizes(zidx) = size(fdata_2d,2)
730  elseif (fdata_2d_axes(2) .eq. ccidx) then
731  if (.not. associated(fileobj%axes(ccidx)%data)) then
732  call mpp_error(fatal, &
733  "fms_io_unstructured_register_restart_field_r8_2d:" &
734  //" a cc-axis was not registered to the" &
735  //" restart object.")
736  endif
737  if (size(fdata_2d,2) .ne. size(fileobj%axes(ccidx)%data)) then
738  call mpp_error(fatal, &
739  "fms_io_unstructured_register_restart_field_r8_2d:" &
740  //" the size of the input data does not" &
741  //" match the size of the registered" &
742  //" cc-axis.")
743  endif
744  field_dimension_sizes(ccidx) = size(fdata_2d,2)
745  else
746  call mpp_error(fatal, &
747  "fms_io_unstructured_register_restart_field_r8_2d:" &
748  //" unsupported axis parameter for the second" &
749  //" dimension of the field.")
750  endif
751 
752  !Add a field to a restart object (restart_file_type). Get the index of the
753  !inputted field in the fileObj%var array.
755  filename, &
756  fieldname, &
757  fdata_2d_axes, &
758  field_dimension_sizes, &
759  index_field, &
760  domain, &
761  mandatory=mandatory, &
762  data_default=real(data_default), &
763  longname=longname, &
764  units=units, &
765  read_only=read_only, &
766  owns_data=restart_owns_data)
767 
768  !Point to the inputted data and return the "index_field" for the field.
769  fileobj%p2dr8(fileobj%var(index_field)%siz(4),index_field)%p => fdata_2d
770  fileobj%var(index_field)%ndim = 2
771  restart_index = index_field
772 
773  return
775 
776 !------------------------------------------------------------------------------
777 !>Add a double_kind 3D field to a restart object (restart_file_type), where the
778 !!field's 1st axis assumed to be along the unstructured axis, the fields's
779 !!second axis is assumed to be along the z-axis, and the field's third axis
780 !!is assumed to be along the cc-axis (???). Return the index of the
781 !!inputted field in the fileObj%var array.
783  filename, &
784  fieldname, &
785  fdata_3d, &
786  fdata_3d_axes, &
787  domain, &
788  mandatory, &
789  data_default, &
790  longname, &
791  units, &
792  read_only, &
793  restart_owns_data) &
794  result(restart_index)
795 
796  !Inputs/Outputs
797  type(restart_file_type),intent(inout) :: fileobj !<A restart object.
798  character(len=*),intent(in) :: filename !<The name of a file.
799  character(len=*),intent(in) :: fieldname !<The name of a field.
800  real(double_kind),dimension(:,:,:),intent(in),target :: fdata_3d !<Some data.
801  integer(INT_KIND),dimension(3) :: fdata_3d_axes !<An array describing the axes for the data.
802  type(domainug),intent(in),target :: domain !<An unstructured mpp_domain.
803  logical,intent(in),optional :: mandatory !<Flag telling if the field
804  !! is mandatory for the restart.
805  real(double_kind),intent(in),optional :: data_default !<A default value for the data.
806  character(len=*),intent(in),optional :: longname !<A more descriptive name of the field.
807  character(len=*),intent(in),optional :: units !<Units for the field.
808  logical(INT_KIND),intent(in),optional :: read_only !<Tells whether or not the
809  !! variable will be written to the restart file.
810  logical(INT_KIND),intent(in),optional :: restart_owns_data !<Tells if the data will be
811  !! deallocated when the restart object is deallocated.
812  integer(INT_KIND) :: restart_index !<Index of the inputted field in the
813  !! fileObj%var array.
814 
815  !Local variables
816  integer(INT_KIND) :: index_field !<Index of the inputted field in the fileObj%var array.
817  integer(INT_KIND),dimension(NIDX) :: field_dimension_sizes !<Array of dimension sizes for the field.
818 
819  !QUICK ERROR OUT AS SUPPORT NOT YET FULLY IMPLEMENTED
820  call mpp_error(fatal, &
821  "fms_io_unstructured_register_restart_field_r8_3d:" &
822  //" support has not yet been fully implemented")
823 
824  !Make sure that the module has been initialized.
825  if (.not. module_is_initialized) then
826  call mpp_error(fatal, &
827  "fms_io_unstructured_register_restart_field_r8_3d:" &
828  //" you must first call fms_io_init")
829  endif
830 
831  !Make sure that at least one axis was registered to the restart object.
832  if (.not. allocated(fileobj%axes)) then
833  call mpp_error(fatal, &
834  "fms_io_unstructured_register_restart_field_r8_3d:" &
835  //" no axes have been registered for the restart" &
836  //" object.")
837  endif
838 
839  !Make sure that the first dimension of the field is a "compressed" axis,
840  !and that it corresponds to an axis that has been registered to the
841  !restart object.
842  field_dimension_sizes = 1
843  if (fdata_3d_axes(1) .eq. cidx) then
844  if (.not. allocated(fileobj%axes(cidx)%idx)) then
845  call mpp_error(fatal, &
846  "fms_io_unstructured_register_restart_field_r8_3d:" &
847  //" a compressed c-axis was not registered" &
848  //" to the restart object.")
849  endif
850  if (size(fdata_3d,1) .ne. fileobj%axes(cidx)%nelems_for_current_rank) then
851  call mpp_error(fatal, &
852  "fms_io_unstructured_register_restart_field_r8_3d:" &
853  //" the size of the input data does not" &
854  //" match the size of the registered" &
855  //" compressed c-axis.")
856  endif
857  field_dimension_sizes(cidx) = size(fdata_3d,1)
858  elseif (fdata_3d_axes(1) .eq. hidx) then
859  if (.not. allocated(fileobj%axes(hidx)%idx)) then
860  call mpp_error(fatal, &
861  "fms_io_unstructured_register_restart_field_r8_3d:" &
862  //" a compressed h-axis was not registered" &
863  //" to the restart object.")
864  endif
865  if (size(fdata_3d,1) .ne. fileobj%axes(hidx)%nelems_for_current_rank) then
866  call mpp_error(fatal, &
867  "fms_io_unstructured_register_restart_field_r8_3d:" &
868  //" the size of the input data does not" &
869  //" match the size of the registered" &
870  //" compressed h-axis.")
871  endif
872  field_dimension_sizes(hidx) = size(fdata_3d,1)
873  else
874  call mpp_error(fatal, &
875  "fms_io_unstructured_register_restart_field_r8_3d:" &
876  //" The first dimension of the field must be a" &
877  //" compressed dimension.")
878  endif
879 
880  !Make sure that the second and third dimensions of the inputted field
881  !corresponds to some combination of registered z- and cc-axes.
882  if (.not. associated(fileobj%axes(zidx)%data)) then
883  call mpp_error(fatal, &
884  "fms_io_unstructured_register_restart_field_r8_3d:" &
885  //" a z-axis was not registered to the" &
886  //" restart object.")
887  endif
888  if (.not. associated(fileobj%axes(ccidx)%data)) then
889  call mpp_error(fatal, &
890  "fms_io_unstructured_register_restart_field_r8_3d:" &
891  //" a cc-axis was not registered to the" &
892  //" restart object.")
893  endif
894  if (fdata_3d_axes(2) .eq. zidx) then
895  if (size(fdata_3d,2) .ne. size(fileobj%axes(zidx)%data)) then
896  call mpp_error(fatal, &
897  "fms_io_unstructured_register_restart_field_r8_3d:" &
898  //" the size of the input data does not" &
899  //" match the size of the registered" &
900  //" z-axis.")
901  endif
902  field_dimension_sizes(zidx) = size(fdata_3d,2)
903  if (fdata_3d_axes(3) .ne. ccidx) then
904  call mpp_error(fatal, &
905  "fms_io_unstructured_register_restart_field_r8_3d:" &
906  //" unsupported axis parameter for the third" &
907  //" dimension of the field.")
908  elseif (size(fdata_3d,3) .ne. size(fileobj%axes(ccidx)%data)) then
909  call mpp_error(fatal, &
910  "fms_io_unstructured_register_restart_field_r8_3d:" &
911  //" the size of the input data does not" &
912  //" match the size of the registered" &
913  //" cc-axis.")
914 
915  else
916  field_dimension_sizes(ccidx) = size(fdata_3d,3)
917  endif
918  elseif (fdata_3d_axes(2) .eq. ccidx) then
919  if (size(fdata_3d,2) .ne. size(fileobj%axes(ccidx)%data)) then
920  call mpp_error(fatal, &
921  "fms_io_unstructured_register_restart_field_r8_3d:" &
922  //" the size of the input data does not" &
923  //" match the size of the registered" &
924  //" cc-axis.")
925  endif
926  field_dimension_sizes(ccidx) = size(fdata_3d,2)
927  if (fdata_3d_axes(3) .ne. zidx) then
928  call mpp_error(fatal, &
929  "fms_io_unstructured_register_restart_field_r8_3d:" &
930  //" unsupported axis parameter for the third" &
931  //" dimension of the field.")
932  elseif (size(fdata_3d,3) .ne. size(fileobj%axes(zidx)%data)) then
933  call mpp_error(fatal, &
934  "fms_io_unstructured_register_restart_field_r8_3d:" &
935  //" the size of the input data does not" &
936  //" match the size of the registered" &
937  //" z-axis.")
938  else
939  field_dimension_sizes(zidx) = size(fdata_3d,3)
940  endif
941  else
942  call mpp_error(fatal, &
943  "fms_io_unstructured_register_restart_field_r8_3d:" &
944  //" unsupported axis parameter for the second" &
945  //" dimension of the field.")
946  endif
947 
948  !Add a field to a restart object (restart_file_type). Get the index of the
949  !inputted field in the fileObj%var array.
951  filename, &
952  fieldname, &
953  fdata_3d_axes, &
954  field_dimension_sizes, &
955  index_field, &
956  domain, &
957  mandatory=mandatory, &
958  data_default=real(data_default), &
959  longname=longname, &
960  units=units, &
961  read_only=read_only, &
962  owns_data=restart_owns_data)
963 
964  !Point to the inputted data and return the "index_field" for the field.
965  fileobj%p3dr8(fileobj%var(index_field)%siz(4),index_field)%p => fdata_3d
966  fileobj%var(index_field)%ndim = 3
967  restart_index = index_field
968 
969  return
971 #endif
972 
973 !------------------------------------------------------------------------------
974 !>Add an integer scalar field to a restart object (restart_file_type). Return
975 !!the index of the inputted field in the fileObj%var array.
977  filename, &
978  fieldname, &
979  fdata_0d, &
980  domain, &
981  mandatory, &
982  data_default, &
983  longname, &
984  units, &
985  read_only, &
986  restart_owns_data) &
987  result(restart_index)
988 
989  !Inputs/Outputs
990  type(restart_file_type),intent(inout) :: fileobj !<A restart object.
991  character(len=*),intent(in) :: filename !<The name of a file.
992  character(len=*),intent(in) :: fieldname !<The name of a field.
993  integer,intent(in),target :: fdata_0d !<Some data.
994  type(domainug),intent(in),target :: domain !<An unstructured mpp_domain.
995  logical,intent(in),optional :: mandatory !<Flag telling if the field is mandatory
996  !! for the restart.
997  real,intent(in),optional :: data_default !<A default value for the data.
998  character(len=*),intent(in),optional :: longname !<A more descriptive name of the field.
999  character(len=*),intent(in),optional :: units !<Units for the field.
1000  logical(INT_KIND),intent(in),optional :: read_only !<Tells whether or not the variable
1001  !! will be written to the restart file.
1002  logical(INT_KIND),intent(in),optional :: restart_owns_data !<Tells if the data will be
1003  !! deallocated when the restart object is deallocated.
1004  integer(INT_KIND) :: restart_index !<Index of the inputted field in the fileObj%var array.
1005 
1006  !Local variables
1007  type(domainug),pointer :: io_domain !<Pointer to an unstructured I/O domain.
1008  integer(INT_KIND) :: io_domain_npes !<The number of ranks
1009  !! in the unstructured I/O domain pelist.
1010  integer(INT_KIND),dimension(:),allocatable :: pelist !<A pelist.
1011  integer,dimension(:),allocatable :: fdata_per_rank !<Array used to gather the scalar field values.
1012  integer(INT_KIND) :: index_field !<Index of the inputted
1013  !! field in the fileObj%var array.
1014  integer(INT_KIND),dimension(NIDX) :: field_dimension_sizes !<Array of dimension sizes for the field.
1015  integer(INT_KIND),dimension(1) :: field_dimension_order !<Array telling the
1016  !! ordering of the dimensions for the field.
1017 
1018  !Make sure that the module has been initialized.
1019  if (.not. module_is_initialized) then
1020  call mpp_error(fatal, &
1021  "fms_io_unstructured_register_restart_field_i_0d:" &
1022  //" you must first call fms_io_init")
1023  endif
1024 
1025  !Make sure that the value of the scalar field is same across all ranks
1026  !in an I/O domain pelist.
1027  io_domain => null()
1028  io_domain => mpp_get_ug_io_domain(domain)
1029  io_domain_npes = mpp_get_ug_domain_npes(io_domain)
1030  allocate(pelist(io_domain_npes))
1031  call mpp_get_ug_domain_pelist(io_domain, &
1032  pelist)
1033  allocate(fdata_per_rank(io_domain_npes))
1034  fdata_per_rank = 0.0
1035  call mpp_gather((/fdata_0d/), &
1036  fdata_per_rank, &
1037  pelist)
1038  if (mpp_pe() .eq. pelist(1)) then
1039  if (maxval(fdata_per_rank) .ne. fdata_0d .or. &
1040  minval(fdata_per_rank) .ne. fdata_0d) then
1041  call mpp_error(fatal, &
1042  "fms_io_unstructured_register_restart_field_i_0d:" &
1043  //" the scalar field data is not consistent across" &
1044  //" all ranks in the I/O domain pelist.")
1045  endif
1046  endif
1047  io_domain => null()
1048  deallocate(pelist)
1049  deallocate(fdata_per_rank)
1050 
1051  !Set the dimension sizes for the field. These correspond to:
1052  !field_dimension_sizes(XIDX) = x-dimension size
1053  !field_dimension_sizes(YIDX) = y-dimension size
1054  !field_dimension_sizes(CIDX) = c-dimension size
1055  !field_dimension_sizes(ZIDX) = z-dimension size
1056  !field_dimension_sizes(HIDX) = h-dimension size
1057  !field_dimension_sizes(TIDX) = t-dimension size
1058  !field_dimension_sizes(UIDX) = u-dimension size
1059  !field_dimension_sizes(CCIDX) = cc-dimension size
1060  field_dimension_sizes = 1
1061 
1062  !Set the ordering of the dimensions for the field.
1063  field_dimension_order(1) = tidx
1064 
1065  !Add a field to a restart object (restart_file_type). Get the index of the
1066  !inputted field in the fileObj%var array.
1067  call fms_io_unstructured_setup_one_field(fileobj, &
1068  filename, &
1069  fieldname, &
1070  field_dimension_order, &
1071  field_dimension_sizes, &
1072  index_field, &
1073  domain, &
1074  mandatory=mandatory, &
1075  data_default=data_default, &
1076  longname=longname, &
1077  units=units, &
1078  read_only=read_only, &
1079  owns_data=restart_owns_data)
1080 
1081  !Point to the inputted data and return the "index_field" for the field.
1082  fileobj%p0di(fileobj%var(index_field)%siz(4),index_field)%p => fdata_0d
1083  fileobj%var(index_field)%ndim = 0
1084  restart_index = index_field
1085 
1086  return
1088 
1089 !------------------------------------------------------------------------------
1090 !>Add an integer 1D field to a restart object (restart_file_type), where the
1091 !!field is assumed to be along the unstructured axis. Return
1092 !!the index of the inputted field in the fileObj%var array.
1094  filename, &
1095  fieldname, &
1096  fdata_1d, &
1097  fdata_1d_axes, &
1098  domain, &
1099  mandatory, &
1100  data_default, &
1101  longname, &
1102  units, &
1103  read_only, &
1104  restart_owns_data) &
1105  result(restart_index)
1106 
1107  !Inputs/Outputs
1108  type(restart_file_type),intent(inout) :: fileobj !<A restart object.
1109  character(len=*),intent(in) :: filename !<The name of a file.
1110  character(len=*),intent(in) :: fieldname !<The name of a field.
1111  integer,dimension(:),intent(in),target :: fdata_1d !<Some data.
1112  integer(INT_KIND),dimension(1) :: fdata_1d_axes !<An array describing the axes for the data.
1113  type(domainug),intent(in),target :: domain !<An unstructured mpp_domain.
1114  logical,intent(in),optional :: mandatory !<Flag telling if the field
1115  !! is mandatory for the restart.
1116  real,intent(in),optional :: data_default !<A default value for the data.
1117  character(len=*),intent(in),optional :: longname !<A more descriptive name of the field.
1118  character(len=*),intent(in),optional :: units !<Units for the field.
1119  logical(INT_KIND),intent(in),optional :: read_only !<Tells whether or not the
1120  !! variable will be written to the restart file.
1121  logical(INT_KIND),intent(in),optional :: restart_owns_data !<Tells if the data will be
1122  !! deallocated when the restart object is deallocated.
1123  integer(INT_KIND) :: restart_index !<Index of the inputted field in the fileObj%var array.
1124 
1125  !Local variables
1126  integer(INT_KIND) :: index_field !<Index of the inputted field in the fileObj%var array.
1127  integer(INT_KIND),dimension(NIDX) :: field_dimension_sizes !<Array of dimension sizes for the field.
1128 
1129  !Make sure that the module has been initialized.
1130  if (.not. module_is_initialized) then
1131  call mpp_error(fatal, &
1132  "fms_io_unstructured_register_restart_field_i_1d:" &
1133  //" you must first call fms_io_init")
1134  endif
1135 
1136  !Make sure that at least one axis was registered to the restart object.
1137  if (.not. allocated(fileobj%axes)) then
1138  call mpp_error(fatal, &
1139  "fms_io_unstructured_register_restart_field_i_1d:" &
1140  //" no axes have been registered for the restart" &
1141  //" object.")
1142  endif
1143 
1144  !Make sure that the first dimension of the field is a "compressed" axis,
1145  !and that it corresponds to an axis that has been registered to the
1146  !restart object.
1147  field_dimension_sizes = 1
1148  if (fdata_1d_axes(1) .eq. cidx) then
1149  if (.not. allocated(fileobj%axes(cidx)%idx)) then
1150  call mpp_error(fatal, &
1151  "fms_io_unstructured_register_restart_field_i_1d:" &
1152  //" a compressed c-axis was not registered" &
1153  //" to the restart object.")
1154  endif
1155  if (size(fdata_1d,1) .ne. fileobj%axes(cidx)%nelems_for_current_rank) then
1156  call mpp_error(fatal, &
1157  "fms_io_unstructured_register_restart_field_i_1d:" &
1158  //" the size of the input data does not" &
1159  //" match the size of the registered" &
1160  //" compressed c-axis.")
1161  endif
1162  field_dimension_sizes(cidx) = size(fdata_1d,1)
1163  elseif (fdata_1d_axes(1) .eq. hidx) then
1164  if (.not. allocated(fileobj%axes(hidx)%idx)) then
1165  call mpp_error(fatal, &
1166  "fms_io_unstructured_register_restart_field_i_1d:" &
1167  //" a compressed h-axis was not registered" &
1168  //" to the restart object.")
1169  endif
1170  if (size(fdata_1d,1) .ne. fileobj%axes(hidx)%nelems_for_current_rank) then
1171  call mpp_error(fatal, &
1172  "fms_io_unstructured_register_restart_field_i_1d:" &
1173  //" the size of the input data does not" &
1174  //" match the size of the registered" &
1175  //" compressed h-axis.")
1176  endif
1177  field_dimension_sizes(hidx) = size(fdata_1d,1)
1178  else
1179  call mpp_error(fatal, &
1180  "fms_io_unstructured_register_restart_field_i_1d:" &
1181  //" One dimensional fields must be compressed.")
1182  endif
1183 
1184  !Add a field to a restart object (restart_file_type). Get the index of the
1185  !inputted field in the fileObj%var array.
1186  call fms_io_unstructured_setup_one_field(fileobj, &
1187  filename, &
1188  fieldname, &
1189  fdata_1d_axes, &
1190  field_dimension_sizes, &
1191  index_field, &
1192  domain, &
1193  mandatory=mandatory, &
1194  data_default=data_default, &
1195  longname=longname, &
1196  units=units, &
1197  read_only=read_only, &
1198  owns_data=restart_owns_data)
1199 
1200  !Point to the inputted data and return the "index_field" for the field.
1201  fileobj%p1di(fileobj%var(index_field)%siz(4),index_field)%p => fdata_1d
1202  fileobj%var(index_field)%ndim = 1
1203  restart_index = index_field
1204 
1205  return
1207 
1208 !------------------------------------------------------------------------------
1209 !>Add an integer 2D field to a restart object (restart_file_type), where the
1210 !!field's 1st axis assumed to be along the unstructured axis and the field's
1211 !!2nd axis is assumed to be along the z-axis. Return the index of the
1212 !!inputted field in the fileObj%var array.
1214  filename, &
1215  fieldname, &
1216  fdata_2d, &
1217  fdata_2d_axes, &
1218  domain, &
1219  mandatory, &
1220  data_default, &
1221  longname, &
1222  units, &
1223  read_only, &
1224  restart_owns_data) &
1225  result(restart_index)
1226 
1227  !Inputs/Outputs
1228  type(restart_file_type),intent(inout) :: fileobj !<A restart object.
1229  character(len=*),intent(in) :: filename !<The name of a file.
1230  character(len=*),intent(in) :: fieldname !<The name of a field.
1231  integer,dimension(:,:),intent(in),target :: fdata_2d !<Some data.
1232  integer(INT_KIND),dimension(2) :: fdata_2d_axes !<An array describing the axes for the data.
1233  type(domainug),intent(in),target :: domain !<An unstructured mpp_domain.
1234  logical,intent(in),optional :: mandatory !<Flag telling if the field
1235  !! is mandatory for the restart.
1236  real,intent(in),optional :: data_default !<A default value for the data.
1237  character(len=*),intent(in),optional :: longname !<A more descriptive name of the field.
1238  character(len=*),intent(in),optional :: units !<Units for the field.
1239  logical(INT_KIND),intent(in),optional :: read_only !<Tells whether or not the
1240  !! variable will be written to the restart file.
1241  logical(INT_KIND),intent(in),optional :: restart_owns_data !<Tells if the data will
1242  !! be deallocated when the restart object is deallocated.
1243  integer(INT_KIND) :: restart_index !<Index of the inputted field
1244  !! in the fileObj%var array.
1245 
1246  !Local variables
1247  integer(INT_KIND) :: index_field !<Index of the inputted field in the fileObj%var array.
1248  integer(INT_KIND),dimension(NIDX) :: field_dimension_sizes !<Array of dimension sizes for the field.
1249 
1250  !Make sure that the module has been initialized.
1251  if (.not. module_is_initialized) then
1252  call mpp_error(fatal, &
1253  "fms_io_unstructured_register_restart_field_i_2d:" &
1254  //" you must first call fms_io_init")
1255  endif
1256 
1257  !Make sure that at least one axis was registered to the restart object.
1258  if (.not. allocated(fileobj%axes)) then
1259  call mpp_error(fatal, &
1260  "fms_io_unstructured_register_restart_field_i_2d:" &
1261  //" no axes have been registered for the restart" &
1262  //" object.")
1263  endif
1264 
1265  !Make sure that the first dimension of the field is a "compressed" axis,
1266  !and that it corresponds to an axis that has been registered to the
1267  !restart object.
1268  field_dimension_sizes = 1
1269  if (fdata_2d_axes(1) .eq. cidx) then
1270  if (.not. allocated(fileobj%axes(cidx)%idx)) then
1271  call mpp_error(fatal, &
1272  "fms_io_unstructured_register_restart_field_i_2d:" &
1273  //" a compressed c-axis was not registered" &
1274  //" to the restart object.")
1275  endif
1276  if (size(fdata_2d,1) .ne. fileobj%axes(cidx)%nelems_for_current_rank) then
1277  call mpp_error(fatal, &
1278  "fms_io_unstructured_register_restart_field_i_2d:" &
1279  //" the size of the input data does not" &
1280  //" match the size of the registered" &
1281  //" compressed c-axis.")
1282  endif
1283  field_dimension_sizes(cidx) = size(fdata_2d,1)
1284  elseif (fdata_2d_axes(1) .eq. hidx) then
1285  if (.not. allocated(fileobj%axes(hidx)%idx)) then
1286  call mpp_error(fatal, &
1287  "fms_io_unstructured_register_restart_field_i_2d:" &
1288  //" a compressed h-axis was not registered" &
1289  //" to the restart object.")
1290  endif
1291  if (size(fdata_2d,1) .ne. fileobj%axes(hidx)%nelems_for_current_rank) then
1292  call mpp_error(fatal, &
1293  "fms_io_unstructured_register_restart_field_i_2d:" &
1294  //" the size of the input data does not" &
1295  //" match the size of the registered" &
1296  //" compressed h-axis.")
1297  endif
1298  field_dimension_sizes(hidx) = size(fdata_2d,1)
1299  else
1300  call mpp_error(fatal, &
1301  "fms_io_unstructured_register_restart_field_i_2d:" &
1302  //" The first dimension of the field must be a" &
1303  //" compressed dimension.")
1304  endif
1305 
1306  !Make sure that the second dimension of the inputted field corresponds to
1307  !either a registered z- or cc-axis.
1308  if (fdata_2d_axes(2) .eq. zidx) then
1309  if (.not. associated(fileobj%axes(zidx)%data)) then
1310  call mpp_error(fatal, &
1311  "fms_io_unstructured_register_restart_field_i_2d:" &
1312  //" a z-axis was not registered to the" &
1313  //" restart object.")
1314  endif
1315  if (size(fdata_2d,2) .ne. size(fileobj%axes(zidx)%data)) then
1316  call mpp_error(fatal, &
1317  "fms_io_unstructured_register_restart_field_i_2d:" &
1318  //" the size of the input data does not" &
1319  //" match the size of the registered" &
1320  //" z-axis.")
1321  endif
1322  field_dimension_sizes(zidx) = size(fdata_2d,2)
1323  elseif (fdata_2d_axes(2) .eq. ccidx) then
1324  if (.not. associated(fileobj%axes(ccidx)%data)) then
1325  call mpp_error(fatal, &
1326  "fms_io_unstructured_register_restart_field_i_2d:" &
1327  //" a cc-axis was not registered to the" &
1328  //" restart object.")
1329  endif
1330  if (size(fdata_2d,2) .ne. size(fileobj%axes(ccidx)%data)) then
1331  call mpp_error(fatal, &
1332  "fms_io_unstructured_register_restart_field_i_2d:" &
1333  //" the size of the input data does not" &
1334  //" match the size of the registered" &
1335  //" cc-axis.")
1336  endif
1337  field_dimension_sizes(ccidx) = size(fdata_2d,2)
1338  else
1339  call mpp_error(fatal, &
1340  "fms_io_unstructured_register_restart_field_i_2d:" &
1341  //" unsupported axis parameter for the second" &
1342  //" dimension of the field.")
1343  endif
1344 
1345  !Add a field to a restart object (restart_file_type). Get the index of the
1346  !inputted field in the fileObj%var array.
1347  call fms_io_unstructured_setup_one_field(fileobj, &
1348  filename, &
1349  fieldname, &
1350  fdata_2d_axes, &
1351  field_dimension_sizes, &
1352  index_field, &
1353  domain, &
1354  mandatory=mandatory, &
1355  data_default=data_default, &
1356  longname=longname, &
1357  units=units, &
1358  read_only=read_only, &
1359  owns_data=restart_owns_data)
1360 
1361  !Point to the inputted data and return the "index_field" for the field.
1362  fileobj%p2di(fileobj%var(index_field)%siz(4),index_field)%p => fdata_2d
1363  fileobj%var(index_field)%ndim = 2
1364  restart_index = index_field
1365 
1366  return
1368 !> @}
integer(int_kind) function fms_io_unstructured_register_restart_field_i_2d(fileObj, filename, fieldname, fdata_2d, fdata_2d_axes, domain, mandatory, data_default, longname, units, read_only, restart_owns_data)
Add an integer 2D field to a restart object (restart_file_type), where the field's 1st axis assumed t...
integer(int_kind) function fms_io_unstructured_register_restart_field_i_1d(fileObj, filename, fieldname, fdata_1d, fdata_1d_axes, domain, mandatory, data_default, longname, units, read_only, restart_owns_data)
Add an integer 1D field to a restart object (restart_file_type), where the field is assumed to be alo...
integer(int_kind) function fms_io_unstructured_register_restart_field_r8_2d(fileObj, filename, fieldname, fdata_2d, fdata_2d_axes, domain, mandatory, data_default, longname, units, read_only, restart_owns_data)
Add a double_kind 2D field to a restart object (restart_file_type), where the field's 1st axis assume...
integer(int_kind) function fms_io_unstructured_register_restart_field_r_0d(fileObj, filename, fieldname, fdata_0d, domain, mandatory, data_default, longname, units, read_only, restart_owns_data)
Add a real scalar field to a restart object (restart_file_type). Return the index of the inputted fie...
integer(int_kind) function fms_io_unstructured_register_restart_field_r_2d(fileObj, filename, fieldname, fdata_2d, fdata_2d_axes, domain, mandatory, data_default, longname, units, read_only, restart_owns_data)
Add a real 2D field to a restart object (restart_file_type), where the field's 1st axis assumed to be...
integer(int_kind) function fms_io_unstructured_register_restart_field_i_0d(fileObj, filename, fieldname, fdata_0d, domain, mandatory, data_default, longname, units, read_only, restart_owns_data)
Add an integer scalar field to a restart object (restart_file_type). Return the index of the inputted...
integer(int_kind) function fms_io_unstructured_register_restart_field_r_3d(fileObj, filename, fieldname, fdata_3d, fdata_3d_axes, domain, mandatory, data_default, longname, units, read_only, restart_owns_data)
Add a real 3D field to a restart object (restart_file_type), where the field's 1st axis assumed to be...
integer(int_kind) function fms_io_unstructured_register_restart_field_r_1d(fileObj, filename, fieldname, fdata_1d, fdata_1d_axes, domain, mandatory, data_default, longname, units, read_only, restart_owns_data)
Add a real 1D field to a restart object (restart_file_type), where the field is assumed to be along t...
integer(int_kind) function fms_io_unstructured_register_restart_field_r8_3d(fileObj, filename, fieldname, fdata_3d, fdata_3d_axes, domain, mandatory, data_default, longname, units, read_only, restart_owns_data)
Add a double_kind 3D field to a restart object (restart_file_type), where the field's 1st axis assume...
subroutine fms_io_unstructured_setup_one_field(fileObj, filename, fieldname, field_dimension_order, field_dimension_sizes, index_field, domain, mandatory, data_default, longname, units, read_only, owns_data)
Add a field to a restart object (restart_file_type). Return the index of the inputted field in the fi...
integer function mpp_pe()
Returns processor ID.
Definition: mpp_util.inc:407