41 type(restart_file_type),
intent(inout) :: fileobj
42 character(len=*),
intent(in) :: filename
43 character(len=*),
intent(in) :: fieldname
44 real,
intent(in),
target :: fdata_0d
45 type(domainug),
intent(in),
target :: domain
46 logical,
intent(in),
optional :: mandatory
48 real,
intent(in),
optional :: data_default
49 character(len=*),
intent(in),
optional :: longname
50 character(len=*),
intent(in),
optional :: units
51 logical(INT_KIND),
intent(in),
optional :: read_only
53 logical(INT_KIND),
intent(in),
optional :: restart_owns_data
55 integer(INT_KIND) :: restart_index
58 type(domainug),
pointer :: io_domain
59 integer(INT_KIND) :: io_domain_npes
61 integer(INT_KIND),
dimension(:),
allocatable :: pelist
62 real,
dimension(:),
allocatable :: fdata_per_rank
63 integer(INT_KIND) :: index_field
65 integer(INT_KIND),
dimension(NIDX) :: field_dimension_sizes
66 integer(INT_KIND),
dimension(1) :: field_dimension_order
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")
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, &
84 allocate(fdata_per_rank(io_domain_npes))
86 call mpp_gather((/fdata_0d/), &
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.")
100 deallocate(fdata_per_rank)
111 field_dimension_sizes = 1
114 field_dimension_order(1) = tidx
121 field_dimension_order, &
122 field_dimension_sizes, &
125 mandatory=mandatory, &
126 data_default=data_default, &
129 read_only=read_only, &
130 owns_data=restart_owns_data)
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
156 result(restart_index)
159 type(restart_file_type),
intent(inout) :: fileobj
160 character(len=*),
intent(in) :: filename
161 character(len=*),
intent(in) :: fieldname
162 real,
dimension(:),
intent(in),
target :: fdata_1d
163 integer(INT_KIND),
dimension(1) :: fdata_1d_axes
164 type(domainug),
intent(in),
target :: domain
165 logical,
intent(in),
optional :: mandatory
167 real,
intent(in),
optional :: data_default
168 character(len=*),
intent(in),
optional :: longname
169 character(len=*),
intent(in),
optional :: units
170 logical(INT_KIND),
intent(in),
optional :: read_only
172 logical(INT_KIND),
intent(in),
optional :: restart_owns_data
174 integer(INT_KIND) :: restart_index
177 integer(INT_KIND) :: index_field
178 integer(INT_KIND),
dimension(NIDX) :: field_dimension_sizes
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")
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" &
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.")
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.")
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.")
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.")
228 field_dimension_sizes(hidx) =
size(fdata_1d,1)
230 call mpp_error(fatal, &
231 "fms_io_unstructured_register_restart_field_r_1d:" &
232 //
" One dimensional fields must be compressed.")
241 field_dimension_sizes, &
244 mandatory=mandatory, &
245 data_default=data_default, &
248 read_only=read_only, &
249 owns_data=restart_owns_data)
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
276 result(restart_index)
279 type(restart_file_type),
intent(inout) :: fileobj
280 character(len=*),
intent(in) :: filename
281 character(len=*),
intent(in) :: fieldname
282 real,
dimension(:,:),
intent(in),
target :: fdata_2d
283 integer(INT_KIND),
dimension(2) :: fdata_2d_axes
284 type(domainug),
intent(in),
target :: domain
285 logical,
intent(in),
optional :: mandatory
287 real,
intent(in),
optional :: data_default
288 character(len=*),
intent(in),
optional :: longname
289 character(len=*),
intent(in),
optional :: units
290 logical(INT_KIND),
intent(in),
optional :: read_only
292 logical(INT_KIND),
intent(in),
optional :: restart_owns_data
294 integer(INT_KIND) :: restart_index
297 integer(INT_KIND) :: index_field
298 integer(INT_KIND),
dimension(NIDX) :: field_dimension_sizes
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")
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" &
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.")
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.")
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.")
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.")
348 field_dimension_sizes(hidx) =
size(fdata_2d,1)
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.")
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.")
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" &
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.")
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" &
387 field_dimension_sizes(ccidx) =
size(fdata_2d,2)
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.")
401 field_dimension_sizes, &
404 mandatory=mandatory, &
405 data_default=data_default, &
408 read_only=read_only, &
409 owns_data=restart_owns_data)
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
437 result(restart_index)
440 type(restart_file_type),
intent(inout) :: fileobj
441 character(len=*),
intent(in) :: filename
442 character(len=*),
intent(in) :: fieldname
443 real,
dimension(:,:,:),
intent(in),
target :: fdata_3d
444 integer(INT_KIND),
dimension(3) :: fdata_3d_axes
445 type(domainug),
intent(in),
target :: domain
446 logical,
intent(in),
optional :: mandatory
448 real,
intent(in),
optional :: data_default
449 character(len=*),
intent(in),
optional :: longname
450 character(len=*),
intent(in),
optional :: units
451 logical(INT_KIND),
intent(in),
optional :: read_only
453 logical(INT_KIND),
intent(in),
optional :: restart_owns_data
455 integer(INT_KIND) :: restart_index
459 integer(INT_KIND) :: index_field
460 integer(INT_KIND),
dimension(NIDX) :: field_dimension_sizes
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")
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" &
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.")
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.")
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.")
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.")
510 field_dimension_sizes(hidx) =
size(fdata_3d,1)
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.")
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.")
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.")
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" &
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" &
554 field_dimension_sizes(ccidx) =
size(fdata_3d,3)
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" &
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" &
577 field_dimension_sizes(zidx) =
size(fdata_3d,3)
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.")
592 field_dimension_sizes, &
595 mandatory=mandatory, &
596 data_default=data_default, &
599 read_only=read_only, &
600 owns_data=restart_owns_data)
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
628 result(restart_index)
631 type(restart_file_type),
intent(inout) :: fileobj
632 character(len=*),
intent(in) :: filename
633 character(len=*),
intent(in) :: fieldname
634 real(double_kind),
dimension(:,:),
intent(in),
target :: fdata_2d
635 integer(INT_KIND),
dimension(2) :: fdata_2d_axes
636 type(domainug),
intent(in),
target :: domain
637 logical,
intent(in),
optional :: mandatory
639 real(double_kind),
intent(in),
optional :: data_default
640 character(len=*),
intent(in),
optional :: longname
641 character(len=*),
intent(in),
optional :: units
642 logical(INT_KIND),
intent(in),
optional :: read_only
644 logical(INT_KIND),
intent(in),
optional :: restart_owns_data
646 integer(INT_KIND) :: restart_index
649 integer(INT_KIND) :: index_field
650 integer(INT_KIND),
dimension(NIDX) :: field_dimension_sizes
653 call mpp_error(fatal, &
654 "fms_io_unstructured_register_restart_field_r8_2d:" &
655 //
" support has not yet been fully implemented")
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")
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" &
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.")
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.")
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.")
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.")
705 field_dimension_sizes(hidx) =
size(fdata_2d,1)
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.")
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.")
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" &
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.")
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" &
744 field_dimension_sizes(ccidx) =
size(fdata_2d,2)
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.")
758 field_dimension_sizes, &
761 mandatory=mandatory, &
762 data_default=real(data_default), &
765 read_only=read_only, &
766 owns_data=restart_owns_data)
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
794 result(restart_index)
797 type(restart_file_type),
intent(inout) :: fileobj
798 character(len=*),
intent(in) :: filename
799 character(len=*),
intent(in) :: fieldname
800 real(double_kind),
dimension(:,:,:),
intent(in),
target :: fdata_3d
801 integer(INT_KIND),
dimension(3) :: fdata_3d_axes
802 type(domainug),
intent(in),
target :: domain
803 logical,
intent(in),
optional :: mandatory
805 real(double_kind),
intent(in),
optional :: data_default
806 character(len=*),
intent(in),
optional :: longname
807 character(len=*),
intent(in),
optional :: units
808 logical(INT_KIND),
intent(in),
optional :: read_only
810 logical(INT_KIND),
intent(in),
optional :: restart_owns_data
812 integer(INT_KIND) :: restart_index
816 integer(INT_KIND) :: index_field
817 integer(INT_KIND),
dimension(NIDX) :: field_dimension_sizes
820 call mpp_error(fatal, &
821 "fms_io_unstructured_register_restart_field_r8_3d:" &
822 //
" support has not yet been fully implemented")
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")
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" &
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.")
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.")
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.")
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.")
872 field_dimension_sizes(hidx) =
size(fdata_3d,1)
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.")
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.")
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.")
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" &
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" &
916 field_dimension_sizes(ccidx) =
size(fdata_3d,3)
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" &
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" &
939 field_dimension_sizes(zidx) =
size(fdata_3d,3)
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.")
954 field_dimension_sizes, &
957 mandatory=mandatory, &
958 data_default=real(data_default), &
961 read_only=read_only, &
962 owns_data=restart_owns_data)
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
987 result(restart_index)
990 type(restart_file_type),
intent(inout) :: fileobj
991 character(len=*),
intent(in) :: filename
992 character(len=*),
intent(in) :: fieldname
993 integer,
intent(in),
target :: fdata_0d
994 type(domainug),
intent(in),
target :: domain
995 logical,
intent(in),
optional :: mandatory
997 real,
intent(in),
optional :: data_default
998 character(len=*),
intent(in),
optional :: longname
999 character(len=*),
intent(in),
optional :: units
1000 logical(INT_KIND),
intent(in),
optional :: read_only
1002 logical(INT_KIND),
intent(in),
optional :: restart_owns_data
1004 integer(INT_KIND) :: restart_index
1007 type(domainug),
pointer :: io_domain
1008 integer(INT_KIND) :: io_domain_npes
1010 integer(INT_KIND),
dimension(:),
allocatable :: pelist
1011 integer,
dimension(:),
allocatable :: fdata_per_rank
1012 integer(INT_KIND) :: index_field
1014 integer(INT_KIND),
dimension(NIDX) :: field_dimension_sizes
1015 integer(INT_KIND),
dimension(1) :: field_dimension_order
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")
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, &
1033 allocate(fdata_per_rank(io_domain_npes))
1034 fdata_per_rank = 0.0
1035 call mpp_gather((/fdata_0d/), &
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.")
1049 deallocate(fdata_per_rank)
1060 field_dimension_sizes = 1
1063 field_dimension_order(1) = tidx
1070 field_dimension_order, &
1071 field_dimension_sizes, &
1074 mandatory=mandatory, &
1075 data_default=data_default, &
1076 longname=longname, &
1078 read_only=read_only, &
1079 owns_data=restart_owns_data)
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
1104 restart_owns_data) &
1105 result(restart_index)
1108 type(restart_file_type),
intent(inout) :: fileobj
1109 character(len=*),
intent(in) :: filename
1110 character(len=*),
intent(in) :: fieldname
1111 integer,
dimension(:),
intent(in),
target :: fdata_1d
1112 integer(INT_KIND),
dimension(1) :: fdata_1d_axes
1113 type(domainug),
intent(in),
target :: domain
1114 logical,
intent(in),
optional :: mandatory
1116 real,
intent(in),
optional :: data_default
1117 character(len=*),
intent(in),
optional :: longname
1118 character(len=*),
intent(in),
optional :: units
1119 logical(INT_KIND),
intent(in),
optional :: read_only
1121 logical(INT_KIND),
intent(in),
optional :: restart_owns_data
1123 integer(INT_KIND) :: restart_index
1126 integer(INT_KIND) :: index_field
1127 integer(INT_KIND),
dimension(NIDX) :: field_dimension_sizes
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")
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" &
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.")
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.")
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.")
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.")
1177 field_dimension_sizes(hidx) =
size(fdata_1d,1)
1179 call mpp_error(fatal, &
1180 "fms_io_unstructured_register_restart_field_i_1d:" &
1181 //
" One dimensional fields must be compressed.")
1190 field_dimension_sizes, &
1193 mandatory=mandatory, &
1194 data_default=data_default, &
1195 longname=longname, &
1197 read_only=read_only, &
1198 owns_data=restart_owns_data)
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
1224 restart_owns_data) &
1225 result(restart_index)
1228 type(restart_file_type),
intent(inout) :: fileobj
1229 character(len=*),
intent(in) :: filename
1230 character(len=*),
intent(in) :: fieldname
1231 integer,
dimension(:,:),
intent(in),
target :: fdata_2d
1232 integer(INT_KIND),
dimension(2) :: fdata_2d_axes
1233 type(domainug),
intent(in),
target :: domain
1234 logical,
intent(in),
optional :: mandatory
1236 real,
intent(in),
optional :: data_default
1237 character(len=*),
intent(in),
optional :: longname
1238 character(len=*),
intent(in),
optional :: units
1239 logical(INT_KIND),
intent(in),
optional :: read_only
1241 logical(INT_KIND),
intent(in),
optional :: restart_owns_data
1243 integer(INT_KIND) :: restart_index
1247 integer(INT_KIND) :: index_field
1248 integer(INT_KIND),
dimension(NIDX) :: field_dimension_sizes
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")
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" &
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.")
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.")
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.")
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.")
1298 field_dimension_sizes(hidx) =
size(fdata_2d,1)
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.")
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.")
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" &
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.")
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" &
1337 field_dimension_sizes(ccidx) =
size(fdata_2d,2)
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.")
1351 field_dimension_sizes, &
1354 mandatory=mandatory, &
1355 data_default=data_default, &
1356 longname=longname, &
1358 read_only=read_only, &
1359 owns_data=restart_owns_data)
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
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.