FMS  2024.03
Flexible Modeling System
fms_io_unstructured_save_restart.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 !>Write out metadata and data for axes and fields to a restart file
25 !!associated with an unstructured mpp domain.
26 subroutine fms_io_unstructured_save_restart(fileObj, &
27  time_stamp, &
28  directory, &
29  append, &
30  time_level)
31 
32  !Inputs/Outputs
33  type(restart_file_type),intent(inout),target :: fileObj !<A restart object.
34  character(len=*),intent(in),optional :: time_stamp !<A time stamp for the file.
35  character(len=*),intent(in),optional :: directory !<The directory where the restart file lives.
36  logical(INT_KIND),intent(in),optional :: append !<Flag telling whether to append to or
37  !! overwrite the restart file.
38  real,intent(in),optional :: time_level !<A time level value (do not specify a kind value).
39 
40  !Optional arguments:
41 
42  !If neither append or time_level is present:
43  ! routine writes both meta data and field data.
44 
45  !If append is present and append=.true.:
46  ! Only field data is written.
47  ! The field data is appended to a new time level.
48  ! time_level must also be present and it must be >= 0.0
49  ! The value of time_level is written as a new value of the time axis data.
50 
51  !If time_level is present and time_level < 0.0:
52  ! A new file is opened and only the meta data is written.
53 
54  !If append is present and append=.false.:
55  ! Behaves the same was as if it were not present. That is, meta data is
56  ! written and whether or not field data is written is determined by time_level.
57 
58  !Local variables
59  type(domainug),pointer :: domain !<A pointer to an unstructured mpp domain.
60  integer(INT_KIND) :: mpp_action !<Parameter specifying how the file
61  !! will be acted on (overwritten or appended to).
62  logical(INT_KIND) :: write_meta_data !<Flag telling whether or not metadata
63  !! will be written to the restart file.
64  logical(INT_KIND) :: write_field_data !<Flag telling whether or not field
65  !! data will be written to the restart file.
66  character(len=128) :: dir !<Directory where the restart file lives.
67  character(len=80) :: restartname !<The name of the restart file.
68  character(len=256) :: restartpath !<The restart file path (dir/file).
69  integer(INT_KIND) :: funit !<The file unit returned by mpp_open.
70  type(ax_type),pointer :: axis !<A pointer to an fms_io_axis_type.
71  type(axistype) :: x_axis !<An mpp_io_axis_type, used to write
72  !! the x-axis to the restart file.
73  logical(INT_KIND) :: x_axis_defined !<Flag telling whether or not a
74  !! x-axis has been define for the inputted restart object.
75  type(axistype) :: y_axis !<An mpp_io_axis_type, used to write
76  !! the y-axis to the restart file.
77  logical(INT_KIND) :: y_axis_defined !<Flag telling whether or not a
78  !! y-axis has been define for the inputted restart object.
79  type(axistype) :: z_axis !<An mpp_io_axis_type, used to write
80  !! the z-axis to the restart file.
81  logical(INT_KIND) :: z_axis_defined !<Flag telling whether or not a
82  !! z-axis has been define for the inputted restart object.
83  type(axistype) :: cc_axis !<An mpp_io_axis_type, used to write
84  !! the cc-axis (???) to the restart file.
85  logical(INT_KIND) :: cc_axis_defined !<Flag telling whether or not a
86  !! cc-axis (???) has been define for the inputted restart object.
87  type(axistype) :: c_axis !<An mpp_io_axis_type, used to write
88  !! the compressed c-axis (???) to the restart file.
89  logical(INT_KIND) :: c_axis_defined !<Flag telling whether or not a
90  !! compressed c-axis (???) has been define for the inputted restart object.
91  type(axistype) :: h_axis !<An mpp_io_axis_type, used to write
92  !! the compressed h-axis (???) to the restart file.
93  logical(INT_KIND) :: h_axis_defined !<Flag telling whether or not a
94  !! compressed h-axis (???) has been define for the inputted restart object.
95  type(axistype) :: t_axis !<An mpp_io_axis_type, used to write
96  !! the t-axis to the restart file.
97  type(var_type),pointer :: cur_var !<A pointer to an fms_io_field_type.
98  integer(INT_KIND) :: num_var_axes !<Number of dimensions for a field.
99  type(axistype),dimension(4) :: var_axes !<Array of axis for each field.
100  integer(INT_KIND) :: cpack !<(Number of bits in a real(8))/(Number
101  !! of bits in a real)
102  integer(LONG_KIND),dimension(:),allocatable :: check_val !<An array of check-sums of a field
103  !! at each time level.
104  real :: tlev !<Time value for a time level (do
105  !! not specify a kind value).
106  real :: r0d !<Used to convert a scalar integer
107  !! field into a scalar real field.
108  real,dimension(:),allocatable :: r1d !<Used to convert a 1D integer field
109  !! into a 1D real field.
110  real,dimension(:,:),allocatable :: r2d !<Used to convert a 2D integer field
111  !! into a 2D real field.
112  integer(INT_KIND) :: i !<Loop variable.
113  integer(INT_KIND) :: j !<Loop variable.
114  integer(INT_KIND) :: k !<Loop variable.
115 
116  !Make sure at least one field was registered to the restart object.
117  if (.not. associated(fileobj%var)) then
118  call mpp_error(fatal, &
119  "fms_io_unstructured_save_restart:" &
120  //" the restart object does not conatin any fields.")
121  endif
122 
123  !If all fields in the file are read only, then simply return without
124  !writing any data to the restart file. If the restart file does not yet
125  !exist, it is not created.
126  if (all_field_read_only(fileobj)) then
127  return
128  endif
129 
130  !Make sure that at least one axis was registered to the restart object.
131  if (.not. allocated(fileobj%axes)) then
132  call mpp_error(fatal, &
133  "fms_io_unstructured_save_restart: there are no" &
134  //" registered axes for the file "//trim(fileobj%name))
135  endif
136 
137  !Make sure that all registered axes are associated with the same
138  !unstructured domain.
139  domain => null()
140  do j = 1,size(fileobj%axes)
141  if (j .eq. cidx .or. j .eq. hidx .or. j .eq. uidx) then
142  if (allocated(fileobj%axes(j)%idx)) then
143  if (.not. associated(fileobj%axes(j)%domain_ug)) then
144  call mpp_error(fatal, &
145  "fms_io_unstructured_save_restart:" &
146  //" the axis "//trim(fileobj%axes(j)%name) &
147  //" in the file "//trim(fileobj%name) &
148  //" was not registered with an unstructured" &
149  //" mpp domain.")
150  endif
151  if (associated(domain)) then
152  if (.not. (domain .EQ. fileobj%axes(j)%domain_ug)) then
153  call mpp_error(fatal, &
154  "fms_io_unstructured_save_restart:" &
155  //" two axes registered to same" &
156  //" restart file are associated with" &
157  //" different unstructured mpp domains.")
158  endif
159  else
160  domain => fileobj%axes(j)%domain_ug
161  endif
162  endif
163  else
164  if (associated(fileobj%axes(j)%data)) then
165  if (.not. associated(fileobj%axes(j)%domain_ug)) then
166  call mpp_error(fatal, &
167  "fms_io_unstructured_save_restart:" &
168  //" the axis "//trim(fileobj%axes(j)%name) &
169  //" in the file "//trim(fileobj%name) &
170  //" was not registered with an unstructured" &
171  //" mpp domain.")
172  endif
173  if (associated(domain)) then
174  if (.not. (domain .EQ. fileobj%axes(j)%domain_ug)) then
175  call mpp_error(fatal, &
176  "fms_io_unstructured_save_restart:" &
177  //" two axes registered to same" &
178  //" restart file are associated with" &
179  //" different unstructured mpp domains.")
180  endif
181  else
182  domain => fileobj%axes(j)%domain_ug
183  endif
184  endif
185  endif
186  enddo
187 
188  !Make sure that all registered fields are associated with the same
189  !unstructured domain that all axes were registered with.
190  do j = 1,fileobj%nvar
191  if (.not. associated(fileobj%var(j)%domain_ug)) then
192  call mpp_error(fatal, &
193  "fms_io_unstructured_save_restart:" &
194  //" the field "//trim(fileobj%var(j)%name) &
195  //" in the file "//trim(fileobj%name) &
196  //" was not registered with an unstructured" &
197  //" mpp domain.")
198  endif
199  if (.not. (domain .EQ. fileobj%var(j)%domain_ug)) then
200  call mpp_error(fatal, &
201  "fms_io_unstructured_save_restart:" &
202  //" the unstructured domain associated with" &
203  //" field "//trim(fileobj%var(j)%name) &
204  //" in the file "//trim(fileobj%name) &
205  //" does not match the unstructured domain" &
206  //" associated with the registered axes.")
207  endif
208  enddo
209 
210  !If necessary, make sure a valid set of optional arguments was provided.
211  if (present(append)) then
212  if (append .and. .not. present(time_level)) then
213  call mpp_error(fatal, &
214  "fms_io_unstructured_save_compressed_restart:" &
215  //" a time_level must be present when" &
216  //" append=.true. for file "//trim(fileobj%name))
217  endif
218  endif
219 
220  !Determine whether or not metadata will be written to the restart file. If
221  !no optional arguments are specified, metadata will be written to the file,
222  !with any old data overwritten. If the optional append flag is true, then
223  !it is assumed that the metadata already exists in the file, and thus
224  !metadata will not be written to the file.
225  mpp_action = mpp_overwr
226  write_meta_data = .true.
227  if (present(append)) then
228  if (append) then
229  mpp_action = mpp_append
230  write_meta_data = .false.
231  if (time_level .lt. 0.0) then
232  call mpp_error(fatal, &
233  "fms_io_unstructured_save_restart:" &
234  //" the inputted time_level cannot be" &
235  //" negative when append is .true." &
236  //" for file "//trim(fileobj%name))
237  endif
238  endif
239  endif
240 
241  !Determine whether or not field data will be written to the restart file.
242  !Field data will be written to the restart file unless a negative
243  !time_level value is passed in.
244  write_field_data = .true.
245  if (present(time_level)) then
246  if (time_level .lt. 0) then
247  write_field_data = .false.
248  endif
249  endif
250 
251  !Set the directory where the restart file lives. This defaults to
252  !"./RESTART".
253  dir = "RESTART"
254  if (present(directory)) then
255  dir = trim(directory)
256  endif
257 
258  !Set the name of the restart file excluding its path.
259  !time_stamp_restart is a module variable.
260  restartname = trim(fileobj%name)
261  if (time_stamp_restart) then
262  if (present(time_stamp)) then
263  if (len_trim(restartname) + len_trim(time_stamp) .gt. 79) then
264  call mpp_error(fatal, &
265  "fms_io_unstructured_save_restart:" &
266  //" length of restart file name including" &
267  //" time stamp is greater than allowed" &
268  //" restart file name length.")
269  endif
270  restartname = trim(time_stamp)//"."//trim(restartname)
271  endif
272  endif
273 
274  !Set the name of the restart file including the path to it.
275  if (len_trim(dir) .gt. 0) then
276  restartpath = trim(dir)//"/"//trim(restartname)
277  else
278  restartpath = trim(restartname)
279  endif
280 
281  !Open the restart file.
282  call mpp_open(funit, &
283  trim(restartpath), &
284  action=mpp_action, &
285  form=form, &
286  is_root_pe=fileobj%is_root_pe, &
287  domain_ug=domain)
288 
289  !Write out the metadata for the axes and fields.
290  axis => null()
291  cur_var => null()
292  if (write_meta_data) then
293 
294  !If it is registered, then write out the metadata for the x-axis
295  !to the restart file.
296  if (associated(fileobj%axes(xidx)%data)) then
297  axis => fileobj%axes(xidx)
298  call mpp_write_meta(funit, &
299  x_axis, &
300  axis%name, &
301  axis%units, &
302  axis%longname, &
303  data=axis%data, &
304  cartesian="X")
305  axis => null()
306  x_axis_defined = .true.
307  else
308  x_axis_defined = .false.
309  endif
310 
311  !If it is registered, then write out the metadata for the y-axis
312  !to the restart file.
313  if (associated(fileobj%axes(yidx)%data)) then
314  axis => fileobj%axes(yidx)
315  call mpp_write_meta(funit, &
316  y_axis, &
317  axis%name, &
318  axis%units, &
319  axis%longname, &
320  data=axis%data, &
321  cartesian="Y")
322  axis => null()
323  y_axis_defined = .true.
324  else
325  y_axis_defined = .false.
326  endif
327 
328  !If it is registered, then write out the metadata for the z-axis
329  !to the restart file.
330  if (associated(fileobj%axes(zidx)%data)) then
331  axis => fileobj%axes(zidx)
332  call mpp_write_meta(funit, &
333  z_axis, &
334  axis%name, &
335  axis%units, &
336  axis%longname, &
337  data=axis%data, &
338  cartesian="Z")
339  axis => null()
340  z_axis_defined = .true.
341  else
342  z_axis_defined = .false.
343  endif
344 
345  !If it is registered, then write out the metadata for the cc-axis (???)
346  !to the restart file.
347  if (associated(fileobj%axes(ccidx)%data)) then
348  axis => fileobj%axes(ccidx)
349  call mpp_write_meta(funit, &
350  cc_axis, &
351  axis%name, &
352  axis%units, &
353  axis%longname, &
354  data=axis%data, &
355  cartesian="CC")
356  axis => null()
357  cc_axis_defined = .true.
358  else
359  cc_axis_defined = .false.
360  endif
361 
362  !If it is registered, then write out the metadata for the compressed
363  !c-axis to the restart file.
364  if (allocated(fileobj%axes(cidx)%idx)) then
365  axis => fileobj%axes(cidx)
366  call mpp_def_dim(funit, &
367  trim(axis%dimlen_name), &
368  axis%dimlen, &
369  trim(axis%dimlen_lname), &
370  (/(i,i=1,axis%dimlen)/))
371  call mpp_write_meta(funit, &
372  c_axis, &
373  axis%name, &
374  axis%units, &
375  axis%longname, &
376  data=axis%idx, &
377  compressed=axis%compressed, &
378  min=axis%imin)
379  axis => null()
380  c_axis_defined = .true.
381  else
382  c_axis_defined = .false.
383  endif
384 
385  !If it is registered, then write out the metadata for the compressed
386  !h-axis to the restart file.
387  if (allocated(fileobj%axes(hidx)%idx)) then
388  axis => fileobj%axes(hidx)
389  call mpp_def_dim(funit, &
390  trim(axis%dimlen_name), &
391  axis%dimlen, &
392  trim(axis%dimlen_lname), &
393  (/(i,i=1,axis%dimlen)/))
394  call mpp_write_meta(funit, &
395  h_axis, &
396  axis%name, &
397  axis%units, &
398  axis%longname, &
399  data=axis%idx, &
400  compressed=axis%compressed, &
401  min=axis%imin)
402  axis => null()
403  h_axis_defined = .true.
404  else
405  h_axis_defined = .false.
406  endif
407 
408  !Write out the time axis to the restart file.
409  if (associated(fileobj%axes(tidx)%data)) then
410  axis => fileobj%axes(tidx)
411  call mpp_write_meta(funit, &
412  t_axis, &
413  axis%name, &
414  units=axis%units, &
415  longname=axis%longname, &
416  cartesian="T", &
417  calendar=axis%calendar)
418  axis => null()
419  else
420  call mpp_write_meta(funit, &
421  t_axis, &
422  "Time", &
423  "time level", &
424  "Time", &
425  cartesian="T")
426  endif
427 
428  !Loop through the fields and write out the metadata.
429  do j = 1,fileobj%nvar
430 
431  !Point to the current field.
432  cur_var => fileobj%var(j)
433 
434  !Cycle to the next field if the current field is read only.
435  if (cur_var%read_only) then
436  cur_var => null()
437  cycle
438  endif
439 
440  !Make sure the field has a valid number of time levels.
441  if (cur_var%siz(4) .gt. 1 .and. cur_var%siz(4) .ne. &
442  fileobj%max_ntime) then
443  call mpp_error(fatal, &
444  "fms_io_unstructured_save_restart: " &
445  //trim(cur_var%name)//" in file " &
446  //trim(fileobj%name)//" has more than one" &
447  //" time level, but the number of time levels" &
448  //" is not equal to max_ntime.")
449  endif
450 
451  !Determine the dimensions for the field. For a scalar field foo,
452  !it is assumed that foo = foo(t). For non-scalar fields, time
453  !maybe added as the last dimension.
454  if (cur_var%ndim .eq. 0) then
455  num_var_axes = 1
456  var_axes(1) = t_axis
457  else
458  num_var_axes = cur_var%ndim
459  do k = 1,cur_var%ndim
460  select case (cur_var%field_dimension_order(k))
461  case (xidx)
462  var_axes(k) = x_axis
463  case (yidx)
464  var_axes(k) = y_axis
465  case (zidx)
466  var_axes(k) = z_axis
467  case (ccidx)
468  var_axes(k) = cc_axis
469  case (cidx)
470  var_axes(k) = c_axis
471  case (hidx)
472  var_axes(k) = h_axis
473  case default
474  call mpp_error(fatal, &
475  "fms_io_unstructured_save_restart:" &
476  //" unsupported dimension type for" &
477  //" field "//trim(cur_var%name) &
478  //" in file "//trim(fileobj%name))
479  end select
480  enddo
481  if (cur_var%siz(4) .eq. fileobj%max_ntime) then
482  num_var_axes = num_var_axes + 1
483  var_axes(num_var_axes) = t_axis
484  endif
485  endif
486 
487  !Get the "pack size" for default real types, where
488  !pack_size = (Number of bits in a real(8))/(Number of bits in a real).
489  cpack = pack_size
490 
491  !For each time level, calculate a check-sum of the field data.
492  !Fields with integer(4) data are handled differently then real
493  !fields. To signify an integer(4) field, set cpack = 0.
494  allocate(check_val(max(1,cur_var%siz(4))))
495  do k = 1,cur_var%siz(4)
496  if (associated(fileobj%p0dr(k,j)%p)) then
497  check_val(k) = mpp_chksum(fileobj%p0dr(k,j)%p, &
498  (/mpp_pe()/), &
499  mask_val=cur_var%default_data)
500  elseif (associated(fileobj%p1dr(k,j)%p)) then
501  check_val(k) = mpp_chksum(fileobj%p1dr(k,j)%p, &
502  mask_val=cur_var%default_data)
503  elseif (associated(fileobj%p2dr(k,j)%p)) then
504  check_val(k) = mpp_chksum(fileobj%p2dr(k,j)%p, &
505  mask_val=cur_var%default_data)
506  elseif (associated(fileobj%p3dr(k,j)%p)) then
507  check_val(k) = mpp_chksum(fileobj%p3dr(k,j)%p, &
508  mask_val=cur_var%default_data)
509  elseif (associated(fileobj%p0di(k,j)%p)) then
510  check_val(k) = int(fileobj%p0di(k,j)%p,kind=long_kind)
511  cpack = 0
512  elseif (associated(fileobj%p1di(k,j)%p)) then
513  check_val(k) = mpp_chksum(fileobj%p1di(k,j)%p, &
514  mask_val=cur_var%default_data)
515  cpack = 0
516  elseif (associated(fileobj%p2di(k,j)%p)) then
517  check_val(k) = mpp_chksum(fileobj%p2di(k,j)%p, &
518  mask_val=cur_var%default_data)
519  cpack = 0
520  elseif (associated(fileobj%p3di(k,j)%p)) then
521  call mpp_error(fatal, &
522  "fms_io_unstructured_save_restart:" &
523  //" 3D integer restart fields are not" &
524  //" currently supported. (" &
525  //trim(cur_var%name)//" of file " &
526  //trim(fileobj%name)//")")
527  else
528  call mpp_error(fatal, &
529  "fms_io_unstructured_save_restart:" &
530  //" there is no pointer associated with " &
531  //" the data of field " &
532  //trim(cur_var%name)//" of file " &
533  //trim(fileobj%name))
534  endif
535  enddo
536 
537  !Write out the metadata from a field. Check-sums are only written
538  !if field data is written to the restart file.
539  if (write_field_data) then ! Write checksums only if valid field data exists
540  call mpp_write_meta(funit, &
541  cur_var%field, &
542  var_axes(1:num_var_axes), &
543  cur_var%name, &
544  cur_var%units, &
545  cur_var%longname, &
546  pack=cpack, &
547  checksum=check_val, &
548  fill=cur_var%default_data)
549  else
550  call mpp_write_meta(funit, &
551  cur_var%field, &
552  var_axes(1:num_var_axes), &
553  cur_var%name, &
554  cur_var%units, &
555  cur_var%longname, &
556  pack=cpack, &
557  fill=cur_var%default_data)
558  endif
559  deallocate(check_val)
560  cur_var => null()
561  enddo
562 
563  !Write the axis data to the restart file.
564  if (x_axis_defined) then
565  call mpp_write(funit, &
566  x_axis)
567  endif
568  if (y_axis_defined) then
569  call mpp_write(funit, &
570  y_axis)
571  endif
572  if (c_axis_defined) then
573  call mpp_write(funit, &
574  c_axis)
575  endif
576  if (h_axis_defined) then
577  call mpp_write(funit, &
578  h_axis)
579  endif
580  if (cc_axis_defined) then
581  call mpp_write(funit, &
582  cc_axis)
583  endif
584  if (z_axis_defined) then
585  call mpp_write(funit, &
586  z_axis)
587  endif
588  endif
589 
590  !Write out field data to the restart file.
591  if (write_field_data) then
592 
593  !Loop through all time levels.
594  do k = 1,fileobj%max_ntime
595 
596  !Get the time value for the time level.
597  if (present(time_level)) then
598  tlev = time_level
599  else
600  tlev = real(k)
601  endif
602 
603  !Loop through the fields.
604  do j = 1,fileobj%nvar
605 
606  !Point to the current field.
607  cur_var => fileobj%var(j)
608 
609  !Cycle to the next field if the current field is read only.
610  if (cur_var%read_only) then
611  cur_var => null()
612  cycle
613  endif
614 
615  !Write out the field data to the file.
616  if (k .le. cur_var%siz(4)) then
617  if (associated(fileobj%p0dr(k,j)%p)) then
618  call mpp_write(funit, &
619  cur_var%field, &
620  fileobj%p0dr(k,j)%p, &
621  tlev)
622  elseif (associated(fileobj%p1dr(k,j)%p)) then
623  call mpp_io_unstructured_write(funit, &
624  cur_var%field, &
625  domain, &
626  fileobj%p1dr(k,j)%p, &
627  fileobj%axes(cur_var%field_dimension_order(1))%nelems, &
628  tstamp=tlev, &
629  default_data=cur_var%default_data)
630  elseif (associated(fileobj%p2dr(k,j)%p)) then
631  call mpp_io_unstructured_write(funit, &
632  cur_var%field, &
633  domain, &
634  fileobj%p2dr(k,j)%p, &
635  fileobj%axes(cur_var%field_dimension_order(1))%nelems, &
636  tstamp=tlev, &
637  default_data=cur_var%default_data)
638  elseif (associated(fileobj%p3dr(k,j)%p)) then
639  call mpp_io_unstructured_write(funit, &
640  cur_var%field, &
641  domain, &
642  fileobj%p3dr(k,j)%p, &
643  fileobj%axes(cur_var%field_dimension_order(1))%nelems, &
644  tstamp=tlev, &
645  default_data=cur_var%default_data)
646  elseif (associated(fileobj%p0di(k,j)%p)) then
647  r0d = real(fileobj%p0di(k,j)%p)
648  call mpp_write(funit, &
649  cur_var%field, &
650  r0d, &
651  tlev)
652  elseif (associated(fileobj%p1di(k,j)%p)) then
653  allocate(r1d(size(fileobj%p1di(k,j)%p,1)))
654  r1d = real(fileobj%p1di(k,j)%p)
655  call mpp_io_unstructured_write(funit, &
656  cur_var%field, &
657  domain, &
658  r1d, &
659  fileobj%axes(cur_var%field_dimension_order(1))%nelems, &
660  tstamp=tlev, &
661  default_data=cur_var%default_data)
662  deallocate(r1d)
663  elseif (associated(fileobj%p2di(k,j)%p)) then
664  allocate(r2d(size(fileobj%p2di(k,j)%p,1),size(fileobj%p2di(k,j)%p,2)))
665  r2d = real(fileobj%p2di(k,j)%p)
666  call mpp_io_unstructured_write(funit, &
667  cur_var%field, &
668  domain, &
669  r2d, &
670  fileobj%axes(cur_var%field_dimension_order(1))%nelems, &
671  tstamp=tlev, &
672  default_data=cur_var%default_data)
673  deallocate(r2d)
674  else
675  call mpp_error(fatal, &
676  "fms_io_unstructured_save_restart:" &
677  //" there is no pointer associated" &
678  //" with the data of field " &
679  //trim(cur_var%name)//" of file " &
680  //trim(fileobj%name))
681  endif
682  endif
683  cur_var => null()
684  enddo
685  enddo
686  endif
687 
688  !Close the restart file.
689  call mpp_close(funit)
690 
691  !Nullify local pointers.
692  domain => null()
693  axis => null()
694  cur_var => null()
695 
696  return
697 end subroutine fms_io_unstructured_save_restart
698 !> @}
fms_io_unstructured_save_restart
subroutine fms_io_unstructured_save_restart(fileObj, time_stamp, directory, append, time_level)
Write out metadata and data for axes and fields to a restart file associated with an unstructured mpp...
Definition: fms_io_unstructured_save_restart.inc:31
mpp_pe
integer function mpp_pe()
Returns processor ID.
Definition: mpp_util.inc:407