FV3 Bundle
test_unstructured_fms_io.F90
Go to the documentation of this file.
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 #ifdef TEST_UNSTRUCTURED_FMS_IO
20 program test_unstructured_fms_io
21 #include <fms_platform.h>
22  use,intrinsic :: iso_fortran_env, only: output_unit
23  use mpp_parameter_mod, only: fatal, &
24  note, &
25  mpp_debug, &
26  mpp_clock_sync
27  use mpp_mod, only: mpp_init, &
28  mpp_pe, &
29  mpp_npes, &
30  mpp_root_pe, &
31  mpp_error, &
32  mpp_set_stack_size, &
33  mpp_exit, &
34  mpp_clock_begin, &
35  mpp_clock_end, &
36  mpp_clock_id
37 #ifdef INTERNAL_FILE_NML
38  use mpp_mod, only: input_nml_file
39 #endif
40  use mpp_domains_mod, only: mpp_domains_init, &
41  mpp_domains_set_stack_size, &
42  mpp_domains_exit, &
43  domain2d, &
44  domainug
45  use mpp_io_mod, only: mpp_io_init, &
46  mpp_io_exit
47  use fms_io_mod, only: fms_io_init, &
48  fms_io_exit
49  implicit none
50 
51 #ifdef use_netCDF
52 #include <netcdf.inc>
53 #endif
54 
55  !Local variables
56  integer(INT_KIND) :: nx = 8 !<Total number of grid points in the x-dimension (longitude?)
57  integer(INT_KIND) :: ny = 8 !<Total number of grid points in the y-dimension (latitude?)
58  integer(INT_KIND) :: nz = 2 !<Total number of grid points in the z-dimension (height)
59 ! integer(INT_KIND) :: nx = 128 !<Total number of grid points in the x-dimension (longitude?)
60 ! integer(INT_KIND) :: ny = 128 !<Total number of grid points in the y-dimension (latitude?)
61 ! integer(INT_KIND) :: nz = 40 !<Total number of grid points in the z-dimension (height)
62  integer(INT_KIND) :: nt = 2 !<Total number of time grid points.
63  integer(INT_KIND) :: halo = 2 !<Number of grid points in the halo???
64  integer(INT_KIND) :: ntiles_x = 1 !<Number of tiles in the x-direction (A 2D grid of tiles is used in this test.)
65  integer(INT_KIND) :: ntiles_y = 2 !<Number of tiles in the y-direction (A 2D grid of tiles is used in this test.)
66  integer(INT_KIND) :: total_num_tiles !<The total number of tiles for the run (= ntiles_x*ntiles_y)
67  integer(INT_KIND),dimension(2) :: layout(2) = (/1,1/) !<Rank layout (x,y of a 2D grid) for each tile. Total number of ranks = total_num_tiles*layout(1)*layout(2)
68  integer(INT_KIND),dimension(2) :: io_layout(2) = (/1,1/) !<Layout (x,y of a 2D grid) for ranks that will perform I/O for each tile. These dimensions must divide equally
69  !!into the dimensions of the layout array.
70  integer(INT_KIND) :: stackmax = 1500000 !<Default size to which the mpp stack will be set.
71  integer(INT_KIND) :: stackmaxd = 500000 !<Default size to which the mpp_domains stack will be set.
72  logical(INT_KIND) :: debug = .false. !<Flag to print debugging information.
73  character(len=64) :: test_file = "test_unstructured_grid" !<Base filename for the unit tests.
74  character(len=64) :: iospec = '-F cachea' !<Something cray related ???
75  integer(INT_KIND) :: pack_size = 1 !<(Number of bits in real(DOUBLE_KIND))/(Number of bits in real)
76  integer(INT_KIND) :: npes !<Total number of ranks in the current pelist.
77  integer(INT_KIND) :: io_status !<Namelist read error code.
78  real(DOUBLE_KIND) :: doubledata = 0.0 !<Used to determine pack_size. This must be kind=DOUBLE_KIND.
79  real :: realdata = 0.0 !<Used to determine pack_size. Do not specify a kind parameter.
80  integer(INT_KIND) :: funit = 7 !<File unit.
81  logical(INT_KIND) :: fopened !<Flag telling if a file is already open.
82  type(domain2D) :: structured_domain !<A structured 2D domain.
83  type(domainUG) :: unstructured_domain !<An unstructured mpp domain.
84  integer(INT_KIND) :: test_num !<Which test to perform.
85  integer(INT_KIND),parameter :: test_1_id = 1 !<Test 1 id.
86 ! integer(INT_KIND) :: id_single_tile_mult_file !<Mpp timer id.
87 ! integer(INT_KIND) :: id_mult_tile !<Mpp timer id.
88 ! integer(INT_KIND) :: id_single_tile_with_group !<Mpp timer id.
89 ! integer(INT_KIND) :: id_mult_tile_with_group !<Mpp timer id.
90 
91  namelist /test_unstructured_io_nml/ nx, &
92  ny, &
93  nz, &
94  nt, &
95  halo, &
96  stackmax, &
97  stackmaxd, &
98  debug, &
99  test_file, &
100  iospec, &
101  ntiles_x, &
102  ntiles_y, &
103  layout, &
104  io_layout
105 
106  !Initialize mpp, get the rank of the current process and the number
107  !of ranks in the current pelist.
108  call mpp_init()
109  npes = mpp_npes()
110 
111  !Get the values from the namelist file.
112 #ifdef INTERNAL_FILE_NML
113  read (input_nml_file,test_unstructured_io_nml,iostat=io_status)
114 #else
115  do
116  inquire(unit=funit,opened=fopened)
117  if (.not. fopened) then
118  exit
119  endif
120  funit = funit + 1
121  if (funit .eq. 100) then
122  call mpp_error(fatal, &
123  "test_unstructured_io: Unable to locate unit" &
124  //" number for the input.nml file.")
125  endif
126  enddo
127  open(unit=funit,file='input.nml',iostat=io_status)
128  read(funit,test_unstructured_io_nml,iostat=io_status)
129  close(funit)
130 #endif
131 
132  !Check the namelist read error code.
133  if (io_status > 0) then
134  call mpp_error(fatal, &
135  "test_unstructured_io: Error reading input.nml")
136  endif
137 
138  !Initialize the mpp_domains module
139  if (debug) then
140  call mpp_domains_init(mpp_debug)
141  else
142  call mpp_domains_init()
143  endif
144 
145  !Initialize the mpp_io module.
146  if (debug) then
147  call mpp_io_init(mpp_debug)
148  else
149  call mpp_io_init()
150  endif
151 
152  !Initialize the fms_io module.
153  call fms_io_init()
154 
155  !Set the mpp and mpp_domains stack sizes.
156  call mpp_set_stack_size(stackmax)
157  call mpp_domains_set_stack_size(stackmaxd)
158 
159  !Write out test configuration parameters.
160  if (mpp_pe() .eq. mpp_root_pe()) then
161  write(output_unit,*)
162  write(output_unit,*) "Performing unstructured_io unit test with:"
163  write(output_unit,*) "Total number of ranks: ", &
164  npes
165  write(output_unit,*) "Total number of grid points in the x-dimension: ", &
166  nx
167  write(output_unit,*) "Total number of grid points in the y-dimension: ", &
168  ny
169  write(output_unit,*) "Total number of grid points in the z-dimension: ", &
170  nz
171  write(output_unit,*) "Total number of grid points in the t-dimension: ", &
172  nt
173  write(output_unit,*) "Halo width (# of grid points): ", &
174  halo
175  write(output_unit,*) "Using NEW domaintypes and calls..."
176  endif
177 
178  !Add a suffix to the test file.
179  write(test_file,'(a,i3.3)') trim(test_file),npes
180 
181  !Perform the chosen test.
182  test_num = test_1_id
183  select case (test_num)
184  case (test_1_id)
185  !Test 1: This test simulates the model running, saving the restart
186  ! files, and then restarting a user specified number of
187  ! times. Each time the model is "restarted", the data is
188  ! checked to make sure that it matches the data that saved
189  ! in the restart.
190  if (mpp_pe() .eq. mpp_root_pe()) then
191  write(output_unit,*)
192  write(output_unit,*) "///////////////////////////////////////"
193  write(output_unit,*) "Performing test 1: ..."
194  endif
195 
196  !Create a structured 2D mpp domain and an unstructured mpp domain
197  !for the test.
198  call create_mpp_domains(nx, &
199  ny, &
200  nz, &
201  npes, &
202  ntiles_x, &
203  ntiles_y, &
204  structured_domain, &
205  unstructured_domain)
206  !Perform test 1.
207  call test_1(unstructured_domain, &
208  10, &
209  nx, &
210  ny, &
211  nz, &
212  npes)
213 
214  !Free memory allocated to the domains for this test.
215  call destroy_mpp_domains(structured_domain, &
216  unstructured_domain)
217 
218  !Test 1 complete.
219  if (mpp_pe() .eq. mpp_root_pe()) then
220  write(output_unit,*) "Test 1 complete."
221  write(output_unit,*) "///////////////////////////////////////"
222  write(output_unit,*)
223  endif
224 
225  case default
226  !No test was selected, so throw an error
227  call mpp_error(fatal, &
228  "test_unstructured_io: invalid test specified.")
229  end select
230 
231  !Finalize the fms_io, mpp_io, mpp_domains, and mpp modules.
232  call fms_io_exit()
233  call mpp_io_exit()
234  call mpp_domains_exit()
235  call mpp_exit()
236 
237 contains
238 
239  !---------------------------------------------------------------------------
240  !Create a structured 2D mpp domain and an unstructured mpp domain.
241  subroutine create_mpp_domains(nx, &
242  ny, &
243  nz, &
244  npes, &
245  num_domain_tiles_x, &
246  num_domain_tiles_y, &
247  structured_domain, &
248  unstructured_domain)
249  use, intrinsic :: iso_fortran_env, only: output_unit
250  use mpp_parameter_mod, only: fatal
251  use mpp_mod, only: mpp_error, &
252  mpp_pe, &
253  mpp_root_pe, &
254  mpp_sync
255  use mpp_domains_mod, only: domain2d, &
256  mpp_define_mosaic, &
257  domainug, &
258  mpp_define_unstruct_domain
259 
260  !Inputs/Ouputs
261  integer(INT_KIND),intent(in) :: nx !<The number of grid points in the x-direction.
262  integer(INT_KIND),intent(in) :: ny !<The number of grid points in the y-direction.
263  integer(INT_KIND),intent(in) :: nz !<The number of grid points in the z-direction.
264  integer(INT_KIND),intent(in) :: npes !<The total number of ranks used in this test.
265  integer(INT_KIND),intent(in) :: num_domain_tiles_x !<The total number of domain tiles in the x-dimension for the 2D structured domain in this test.
266  integer(INT_KIND),intent(in) :: num_domain_tiles_y !<The total number of domain tiles in the y-dimension for the 2D structured domain in this test.
267  type(domain2D),intent(inout) :: structured_domain !<A structured 2D domain.
268  type(domainUG),intent(inout) :: unstructured_domain !<An unstructured mpp domain.
269 
270  !Local variables
271  integer(INT_KIND) :: num_domain_tiles !<The total number of domain tiles for the 2D structured domain in this test.
272  integer(INT_KIND) :: npes_per_domain_tile !<The number of ranks per domain tile for the 2D structured domain.
273  integer(INT_KIND) :: my_domain_tile_id !<The 2D structured domain tile id for the current rank.
274  logical(INT_KIND) :: is_domain_tile_root !<Flag telling if the current rank is the root rank of its associated
275  !!2D structured domain tile.
276  integer(INT_KIND),dimension(2) :: layout_for_full_domain !<Rank layout (2D grid) for the full 2D structured domain.
277  !!Example: 16 ranks -> (16,1) or (8,2) or (4,4) or (2,8) or (1,16)
278  integer(INT_KIND),dimension(:),allocatable :: pe_start !<Array holding the smallest rank id assigned to each 2D structured domain tile.
279  integer(INT_KIND),dimension(:),allocatable :: pe_end !<Array holding the largest rank id assigned to each 2D structured domain tile.
280  integer(INT_KIND) :: x_grid_points_per_domain_tile !<The number of grid points in the x-dimension on each 2D structured domain tile.
281  integer(INT_KIND) :: y_grid_points_per_domain_tile !<The number of grid points in the y-dimension on each 2D structured domain tile.
282  integer(INT_KIND),dimension(:,:),allocatable :: global_indices !<Required to define the 2D structured domain.
283  integer(INT_KIND),dimension(:,:),allocatable :: layout2D !<Required to define the 2D structured domain.
284  logical(INT_KIND),dimension(:,:,:),allocatable :: land_mask !<A toy mask.
285  integer(INT_KIND),dimension(:),allocatable :: num_non_masked_grid_points_per_domain_tile !<Total number of non-masked grid points on each 2D structured domain tile.
286  integer(INT_KIND) :: mask_counter !<Counting variable.
287  integer(INT_KIND) :: num_non_masked_grid_points !<Total number of non-masked grid points for the 2D structured domain.
288  integer(INT_KIND),dimension(:),allocatable :: num_land_tiles_per_non_masked_grid_point !<Number of land tiles per non-masked grid point for the 2D structured domain.
289  integer(INT_KIND) :: num_ranks_using_unstructured_grid !<Number of ranks using the unstructured domain.
290  integer(INT_KIND) :: io_tile_factor !<I/O tile factor. See below.
291  integer(INT_KIND),dimension(:),allocatable :: unstructured_grid_point_index_map !<Array that maps indices between the 2D structured and unstructured domains.
292  integer(INT_KIND) :: i !<Loop variable.
293  integer(INT_KIND) :: j !<Loop variable.
294  integer(INT_KIND) :: k !<Loop variable.
295  integer(INT_KIND) :: p !<Counting variable.
296 
297  !Needed to define the 2D structured domain but not otherwised used.
298  integer(INT_KIND) :: ncontacts
299  integer(INT_KIND),dimension(1) :: tile1
300  integer(INT_KIND),dimension(1) :: tile2
301  integer(INT_KIND),dimension(1) :: istart1
302  integer(INT_KIND),dimension(1) :: iend1
303  integer(INT_KIND),dimension(1) :: jstart1
304  integer(INT_KIND),dimension(1) :: jend1
305  integer(INT_KIND),dimension(1) :: istart2
306  integer(INT_KIND),dimension(1) :: iend2
307  integer(INT_KIND),dimension(1) :: jstart2
308  integer(INT_KIND),dimension(1) :: jend2
309 
310  !Print out a message that the routine is starting.
311  if (mpp_pe() .eq. mpp_root_pe()) then
312  write(output_unit,*)
313  write(output_unit,*) "Creating a structured and unstructured" &
314  //" domain ..."
315  endif
316 
317  !Synchronize all ranks.
318  call mpp_sync()
319 
320  !Make sure that valid inputs were passed in.
321  if (nx .lt. 1 .or. ny .lt. 1) then
322  call mpp_error(fatal, &
323  "create_mpp_domains:" &
324  //" there must be at least on grid point in the" &
325  //" x- and y- dimensions.")
326  endif
327  if (npes .gt. nx*ny) then
328  call mpp_error(fatal, &
329  "create_mpp_domains:" &
330  //" the total number of ranks cannot be greater" &
331  //" than the total number of grid points in the" &
332  //" x-y plane.")
333  endif
334  if (num_domain_tiles_x .lt. 1 .or. num_domain_tiles_y .lt. 1) then
335  call mpp_error(fatal, &
336  "create_mpp_domains:" &
337  //" there must be at least on domain tile in the" &
338  //" x- and y- dimensions.")
339  endif
340  if (mod(nx,num_domain_tiles_x) .ne. 0) then
341  call mpp_error(fatal, &
342  "create_mpp_domains:" &
343  //" the total number of grid points in the" &
344  //" x-dimension must be evenly divisible by the" &
345  //" total number of domain tiles in the" &
346  //" x-dimension.")
347  endif
348  if (mod(ny,num_domain_tiles_y) .ne. 0) then
349  call mpp_error(fatal, &
350  "create_mpp_domains:" &
351  //" the total number of grid points in the" &
352  //" y-dimension must be evenly divisible by the" &
353  //" total number of domain tiles in the" &
354  //" y-dimension.")
355  endif
356  if (num_domain_tiles_x*num_domain_tiles_y .gt. npes) then
357  call mpp_error(fatal, &
358  "create_mpp_domains:" &
359  //" the total number of domain tiles cannot be" &
360  //" greater than the total number of ranks.")
361  endif
362  if (mod(npes,num_domain_tiles_x) .ne. 0) then
363  call mpp_error(fatal, &
364  "create_mpp_domains:" &
365  //" the total number of ranks must be evenly" &
366  //" divisible by the total number of domain" &
367  //" tiles in the x-dimension.")
368  endif
369  if (mod(npes,num_domain_tiles_y) .ne. 0) then
370  call mpp_error(fatal, &
371  "create_mpp_domains:" &
372  //" the total number of ranks must be evenly" &
373  //" divisible by the total number of domain" &
374  //" tiles in the y-dimension.")
375  endif
376 
377  !Set domain tile values for the 2D structured domain.
378  num_domain_tiles = num_domain_tiles_x*num_domain_tiles_y
379  npes_per_domain_tile = npes/num_domain_tiles
380  my_domain_tile_id = (mpp_pe())/npes_per_domain_tile + 1
381  if (mpp_pe() .eq. (my_domain_tile_id-1)*npes_per_domain_tile) then
382  is_domain_tile_root = .true.
383  else
384  is_domain_tile_root = .false.
385  endif
386  layout_for_full_domain(1) = num_domain_tiles_x
387  layout_for_full_domain(2) = npes/layout_for_full_domain(1)
388 
389  !For each 2D structured domain tile, store the beginning and ending
390  !rank ids assigned to it. For example, if there are 8 ranks and 2
391  !domain tiles, then tile 1 will be assigned ranks 0 - 3 and tile 2
392  !will be assigned ranks 4 - 7.
393  allocate(pe_start(num_domain_tiles))
394  allocate(pe_end(num_domain_tiles))
395  do i = 1,num_domain_tiles
396  pe_start(i) = (i-1)*npes_per_domain_tile
397  pe_end(i) = i*npes_per_domain_tile - 1
398  enddo
399 
400  !Calculate parameters needed to construct the 2D structured domain.
401  !All domain tiles are assumed to be the same size.
402  x_grid_points_per_domain_tile = nx/num_domain_tiles_x
403  y_grid_points_per_domain_tile = ny/num_domain_tiles_y
404  allocate(global_indices(4,num_domain_tiles))
405  do i = 1,num_domain_tiles
406  global_indices(:,i) = (/1,x_grid_points_per_domain_tile, &
407  1,y_grid_points_per_domain_tile/)
408  enddo
409  allocate(layout2d(2,num_domain_tiles))
410  do i = 1,num_domain_tiles
411  layout2d(1,i) = layout_for_full_domain(1)/num_domain_tiles_x
412  layout2d(2,i) = layout_for_full_domain(2)/num_domain_tiles_y
413  enddo
414 
415  !This test does not use the "contact" region between tiles, but
416  !the 2D structured domain requires these inputs, so just set them
417  !all equal to 1.
418  ncontacts = 0
419  tile1 = 1
420  tile2 = 1
421  istart1 = 1
422  iend1 = 1
423  jstart1 = 1
424  jend1 = 1
425  istart2 = 1
426  iend2 = 1
427  jstart2 = 1
428  jend2 = 1
429 
430  !Define the 2D structured domain.
431  call mpp_define_mosaic(global_indices, &
432  layout2d, &
433  structured_domain, &
434  num_domain_tiles, &
435  ncontacts, &
436  tile1, &
437  tile2, &
438  istart1, &
439  iend1, &
440  jstart1, &
441  jend1, &
442  istart2, &
443  iend2, &
444  jstart2, &
445  jend2, &
446  pe_start, &
447  pe_end)
448 
449  !Define a toy mask to mimic what happens in the land model.
450  allocate(land_mask(x_grid_points_per_domain_tile, &
451  y_grid_points_per_domain_tile, &
452  num_domain_tiles))
453  allocate(num_non_masked_grid_points_per_domain_tile(num_domain_tiles))
454  land_mask = .false.
455  do k = 1,num_domain_tiles
456  mask_counter = 0
457  do j = 1,y_grid_points_per_domain_tile
458  do i = 1,x_grid_points_per_domain_tile
459  if (mod((k-1)*y_grid_points_per_domain_tile*x_grid_points_per_domain_tile + &
460  (j-1)*x_grid_points_per_domain_tile + &
461  (i-1),2) .eq. 0) then
462  land_mask(i,j,k) = .true.
463  mask_counter = mask_counter + 1
464  endif
465  enddo
466  enddo
467  num_non_masked_grid_points_per_domain_tile(k) = mask_counter
468  enddo
469 
470  !Set the number of land tiles allowed per non-masked grid point.
471  num_non_masked_grid_points = sum(num_non_masked_grid_points_per_domain_tile)
472  allocate(num_land_tiles_per_non_masked_grid_point(num_non_masked_grid_points))
473  num_land_tiles_per_non_masked_grid_point = 1
474 
475  !Set the number of ranks to use with the unstructured domain. There
476  !must be at least one grid point per rank.
477  num_ranks_using_unstructured_grid = npes
478  if (num_ranks_using_unstructured_grid .gt. num_non_masked_grid_points) then
479  call mpp_error(fatal, &
480  "create_mpp_domains:" &
481  //" the number of ranks exceeds the number of" &
482  //" non-masked grid points for the unstructured" &
483  //" domain.")
484  endif
485 
486  !Define the number of "I/O tile factor". The number of ranks that
487  !participate in I/O for a tile is equal to:
488  !
489  ! num_io_ranks_on_a_tile = num_ranks_on_the_tile / "I/O tile factor".
490  !
491  !so for:
492  !
493  ! io_tile_factor = 1, all of the ranks on a tile participate in the I/O
494  ! io_tile_factor = 2, 1/2 of the ranks on a tile participate in the I/O
495  ! io_tile_factor = 3, 1/3 of the ranks on a tile participate in the I/O
496  ! ...
497  ! io_tile_factor = 0 is a special case where only one rank participates
498  ! in the I/O for a tile.
499  io_tile_factor = 0
500 
501  !Define an array used to map grid points from the "structured" 2D grid
502  !to the "unstructured" 1D grid. The mapping goes as follows (fortran
503  !ording so first index is fastest):
504  !
505  ! 2D "structured" grid (lon,lat,tile) => 1D "unstructured" grid (p)
506  !
507  !where masked points are skipped.
508  allocate(unstructured_grid_point_index_map(num_non_masked_grid_points))
509  p = 0
510  do k = 1,num_domain_tiles
511  do j = 1,y_grid_points_per_domain_tile
512  do i = 1,x_grid_points_per_domain_tile
513  if (land_mask(i,j,k)) then
514  p = p + 1
515  unstructured_grid_point_index_map(p) = (j-1)*x_grid_points_per_domain_tile + i
516  endif
517  enddo
518  enddo
519  enddo
520 
521  !Define the "unstructured" domain decomposition.
522  call mpp_define_unstruct_domain(unstructured_domain, &
523  structured_domain, &
524  num_non_masked_grid_points_per_domain_tile, &
525  num_land_tiles_per_non_masked_grid_point, &
526  num_ranks_using_unstructured_grid, &
527  io_tile_factor, &
528  unstructured_grid_point_index_map)
529 
530  !Print out information about the unstructured domain.
531 ! if (mpp_pe() .eq. mpp_root_pe()) then
532 ! write(*,*) 'num tiles=',mpp_get_UG_domain_ntiles(domain_ug)
533 ! endif
534 
535  !Deallocate local allocatables.
536  deallocate(pe_start)
537  deallocate(pe_end)
538  deallocate(global_indices)
539  deallocate(layout2d)
540  deallocate(land_mask)
541  deallocate(num_non_masked_grid_points_per_domain_tile)
542  deallocate(num_land_tiles_per_non_masked_grid_point)
543  deallocate(unstructured_grid_point_index_map)
544 
545  !Print out a message that the routine is done.
546  call mpp_sync()
547  if (mpp_pe() .eq. mpp_root_pe()) then
548  write(output_unit,*) "Domains created."
549  write(output_unit,*)
550  endif
551 
552  return
553  end subroutine create_mpp_domains
554 
555  !---------------------------------------------------------------------------
556  !Destroy a 2D mpp domain and an unstructured mpp domain.
557  subroutine destroy_mpp_domains(structured_domain, &
558  unstructured_domain)
559  use, intrinsic :: iso_fortran_env, only: output_unit
560  use mpp_mod, only: mpp_pe, &
561  mpp_root_pe, &
562  mpp_sync
563  use mpp_domains_mod, only: domain2d, &
564  mpp_deallocate_domain, &
565  domainug, &
566  mpp_deallocate_domainug
567 
568  !Inputs/Ouputs
569  type(domain2D),intent(inout) :: structured_domain !<A structured 2D domain.
570  type(domainUG),intent(inout) :: unstructured_domain !<An unstructured mpp domain.
571 
572  !Print out a message that the routine is starting.
573  if (mpp_pe() .eq. mpp_root_pe()) then
574  write(output_unit,*)
575  write(output_unit,*) "Creating a structured and unstructured" &
576  //" domain ..."
577  endif
578 
579  !Synchronize all ranks.
580  call mpp_sync()
581 
582  !Deallocate the unstructured domain.
583  call mpp_deallocate_domainug(unstructured_domain)
584 
585  !Deallocate the 2D structured domain.
586  call mpp_deallocate_domain(structured_domain)
587 
588  !Print out a message that the routine is done.
589  call mpp_sync()
590  if (mpp_pe() .eq. mpp_root_pe()) then
591  write(output_unit,*) "Domains destroyed."
592  write(output_unit,*)
593  endif
594 
595  return
596  end subroutine destroy_mpp_domains
597 
598  !---------------------------------------------------------------------------
599  !Test 1:
600  !Register axes and fields to a restart file, and then save the restart
601  !file. After the restart file is saved, reset the data and then restore
602  !the state (i.e., read in the data from the written restart file). Make
603  !sure that the restored data matches the written data.
604  subroutine test_1(unstructured_domain, &
605  num_restarts, &
606  nx, &
607  ny, &
608  nz, &
609  npes)
610  use, intrinsic :: iso_fortran_env, only: output_unit
611  use mpp_parameter_mod, only: fatal, &
612  comm_tag_1, &
613  event_recv
614  use mpp_mod, only: mpp_error, &
615  mpp_pe, &
616  mpp_root_pe, &
617  mpp_sync, &
618  mpp_chksum, &
619  mpp_send, &
620  mpp_recv, &
621  mpp_sync_self
622  use mpp_domains_mod, only: domainug, &
623  mpp_get_ug_io_domain, &
624  mpp_get_ug_domain_npes, &
625  mpp_get_ug_domain_pelist
626  use mpp_io_mod, only: mpp_close
627  use fms_io_mod, only: restart_file_type, &
628  fms_io_unstructured_register_restart_axis, &
629  fms_io_unstructured_register_restart_field, &
630  cidx, &
631  hidx, &
632  zidx, &
633  ccidx, &
634  fms_io_unstructured_save_restart, &
635  fms_io_unstructured_get_field_size, &
636  fms_io_unstructured_read, &
637  fms_io_unstructured_file_unit
638 
639  !Inputs/Ouputs
640  type(domainUG),intent(in) :: unstructured_domain !<An unstructured mpp domain.
641  integer(INT_KIND),intent(in) :: num_restarts !<Number of times to "restart" the "model run".
642  integer(INT_KIND),intent(in) :: nx !<The number of grid points in the x-direction.
643  integer(INT_KIND),intent(in) :: ny !<The number of grid points in the y-direction.
644  integer(INT_KIND),intent(in) :: nz !<The number of grid points in the z-direction.
645  integer(INT_KIND),intent(in) :: npes !<The total number of ranks used in this test.
646 
647  !Local variables
648  type(domainUG),pointer :: io_domain !<Pointer to unstructured domain's I/O domain.
649  integer(INT_KIND) :: io_domain_npes !<The total number of ranks in the unstructured I/O domain pelist.
650  integer(INT_KIND),dimension(:),allocatable :: pelist !<A pelist.
651  character(len=256) :: restart_file_name !<Name for the restart file.
652  real,dimension(:),allocatable :: x_axis_data !<Data for the x-axis that is registered to the restart file.
653  real,dimension(:),allocatable :: y_axis_data !<Data for the y-axis that is registered to the restart file.
654  real,dimension(:),allocatable :: z_axis_data !<Data for the z-axis that is registered to the restart file.
655  integer(INT_KIND) :: cc_axis_size !<Size of the cc-axis (???).
656  real,dimension(:),allocatable :: cc_axis_data !<Data for the cc-axis (???) that is registered to the restart file.
657  integer(INT_KIND) :: compressed_c_axis_size !<Size of the compressed c (???) axis.:
658  integer(INT_KIND),dimension(:),allocatable :: compressed_c_axis_data !<Data that is registered to the restart file for the compressed c (???) axis.
659  integer(INT_KIND) :: compressed_h_axis_size !<Size of the compressed c (???) axis.:
660  integer(INT_KIND),dimension(:),allocatable :: compressed_h_axis_data !<Data that is registered to the restart file for the compressed c (???) axis.
661  integer(INT_KIND),dimension(:),allocatable :: compressed_c_axis_size_per_rank !<Array of "compressed c" axis sizes for each rank.
662  integer(INT_KIND),dimension(:),allocatable :: compressed_h_axis_size_per_rank !<Array of "compressed h" axis sizes for each rank.
663  type(restart_file_type) :: restart_file !<A restart file.
664  integer(INT_KIND) :: register_id !<Id returned from a registered field.
665  character(len=256) :: real_scalar_field_name !<Name for a real scalar field.
666  real :: real_scalar_field_data !<Data for a real scalar field.
667  character(len=256) :: compressed_c_real_1D_field_name !<Name for a "compressed c" real 1D field.
668  real,dimension(:),allocatable :: compressed_c_real_1D_field_data !<Data for a "compressed c" real 1D field.
669  character(len=256) :: compressed_h_real_1D_field_name !<Name for a "compressed h" real 1D field.
670  real,dimension(:),allocatable :: compressed_h_real_1D_field_data !<Data for a "compressed h" real 1D field.
671  character(len=256) :: compressed_c_z_real_2D_field_name !<Name for a "compressed c, z" real 2D field.
672  real,dimension(:,:),allocatable :: compressed_c_z_real_2D_field_data !<Data for a "compressed c, z" real 2D field.
673  character(len=256) :: compressed_h_z_real_2D_field_name !<Name for a "compressed h, z" real 2D field.
674  real,dimension(:,:),allocatable :: compressed_h_z_real_2D_field_data !<Data for a "compressed h, z" real 2D field.
675  character(len=256) :: compressed_c_cc_real_2D_field_name !<Name for a "compressed c, cc" real 2D field.
676  real,dimension(:,:),allocatable :: compressed_c_cc_real_2D_field_data !<Data for a "compressed c, cc" real 2D field.
677  character(len=256) :: compressed_h_cc_real_2D_field_name !<Name for a "compressed h, cc" real 2D field.
678  real,dimension(:,:),allocatable :: compressed_h_cc_real_2D_field_data !<Data for a "compressed h, cc" real 2D field.
679  character(len=256) :: compressed_c_z_cc_real_3D_field_name !<Name for a "compressed c, z, cc" real 3D field.
680  real,dimension(:,:,:),allocatable :: compressed_c_z_cc_real_3D_field_data !<Data for a "compressed c, z, cc" real 3D field.
681  character(len=256) :: compressed_h_z_cc_real_3D_field_name !<Name for a "compressed h, z, cc" real 3D field.
682  real,dimension(:,:,:),allocatable :: compressed_h_z_cc_real_3D_field_data !<Data for a "compressed h, z, cc" real 3D field.
683  character(len=256) :: compressed_c_cc_z_real_3D_field_name !<Name for a "compressed c, cc, z" real 3D field.
684  real,dimension(:,:,:),allocatable :: compressed_c_cc_z_real_3D_field_data !<Data for a "compressed c, cc, z" real 3D field.
685  character(len=256) :: compressed_h_cc_z_real_3D_field_name !<Name for a "compressed h, cc, z" real 3D field.
686  real,dimension(:,:,:),allocatable :: compressed_h_cc_z_real_3D_field_data !<Data for a "compressed h, cc, z" real 3D field.
687  character(len=256) :: int_scalar_field_name !<Name for an integer scalar field.
688  integer :: int_scalar_field_data !<Data for an integer scalar field.
689  character(len=256) :: compressed_c_int_1D_field_name !<Name for a "compressed c" integer 1D field.
690  integer,dimension(:),allocatable :: compressed_c_int_1D_field_data !<Data for a "compressed c" integer 1D field.
691  character(len=256) :: compressed_h_int_1D_field_name !<Name for a "compressed h" integer 1D field.
692  integer,dimension(:),allocatable :: compressed_h_int_1D_field_data !<Data for a "compressed h" integer 1D field.
693  character(len=256) :: compressed_c_z_int_2D_field_name !<Name for a "compressed c, z" integer 2D field.
694  integer,dimension(:,:),allocatable :: compressed_c_z_int_2D_field_data !<Data for a "compressed c, z" integer 2D field.
695  character(len=256) :: compressed_h_z_int_2D_field_name !<Name for a "compressed h, z" integer 2D field.
696  integer,dimension(:,:),allocatable :: compressed_h_z_int_2D_field_data !<Data for a "compressed h, z" integer 2D field.
697  character(len=256) :: compressed_c_cc_int_2D_field_name !<Name for a "compressed c, cc" integer 2D field.
698  integer,dimension(:,:),allocatable :: compressed_c_cc_int_2D_field_data !<Data for a "compressed c, cc" integer 2D field.
699  character(len=256) :: compressed_h_cc_int_2D_field_name !<Name for a "compressed h, cc" integer 2D field.
700  integer,dimension(:,:),allocatable :: compressed_h_cc_int_2D_field_data !<Data for a "compressed h, cc" integer 2D field.
701  real,dimension(:),allocatable :: real_scalar_field_data_ref !<Reference test data for a real scalar field.
702  real,dimension(:,:),allocatable :: compressed_c_real_1D_field_data_ref !<Reference test data for a "compressed c" real 1D field.
703  real,dimension(:,:),allocatable :: compressed_h_real_1D_field_data_ref !<Reference test data for a "compressed c" real 1D field.
704  real,dimension(:,:,:),allocatable :: compressed_c_z_real_2D_field_data_ref !<Reference test data for a "compressed c, z" real 2D field.
705  real,dimension(:,:,:),allocatable :: compressed_h_z_real_2D_field_data_ref !<Reference test data for a "compressed h, z" real 2D field.
706  real,dimension(:,:,:),allocatable :: compressed_c_cc_real_2D_field_data_ref !<Reference test data for a "compressed c, cc" real 2D field.
707  real,dimension(:,:,:),allocatable :: compressed_h_cc_real_2D_field_data_ref !<Reference test data for a "compressed h, cc" real 2D field.
708  real,dimension(:,:,:,:),allocatable :: compressed_c_z_cc_real_3D_field_data_ref !<Reference test data for a compressed real 3D field.
709  real,dimension(:,:,:,:),allocatable :: compressed_h_z_cc_real_3D_field_data_ref !<Reference test data for a compressed real 3D field.
710  real,dimension(:,:,:,:),allocatable :: compressed_c_cc_z_real_3D_field_data_ref !<Reference test data for a compressed real 3D field.
711  real,dimension(:,:,:,:),allocatable :: compressed_h_cc_z_real_3D_field_data_ref !<Reference test data for a compressed real 3D field.
712  integer,dimension(:),allocatable :: int_scalar_field_data_ref !<Reference test data for an integer scalar field.
713  integer,dimension(:,:),allocatable :: compressed_c_int_1D_field_data_ref !<Reference test data for a "compressed c" integer 1D field.
714  integer,dimension(:,:),allocatable :: compressed_h_int_1D_field_data_ref !<Reference test data for a "compressed c" integer 1D field.
715  integer,dimension(:,:,:),allocatable :: compressed_c_z_int_2D_field_data_ref !<Reference test data for a "compressed c, z" integer 2D field.
716  integer,dimension(:,:,:),allocatable :: compressed_h_z_int_2D_field_data_ref !<Reference test data for a "compressed h, z" integer 2D field.
717  integer,dimension(:,:,:),allocatable :: compressed_c_cc_int_2D_field_data_ref !<Reference test data for a "compressed c, cc" integer 2D field.
718  integer,dimension(:,:,:),allocatable :: compressed_h_cc_int_2D_field_data_ref !<Reference test data for a "compressed h, cc" integer 2D field.
719  integer(INT_KIND),dimension(5) :: field_dimension_sizes !<Array to hold the dimensions of fields when they are read back in.
720  logical(INT_KIND) :: field_found_in_file !<Flag telling if a field was found in a file.
721  real,dimension(:),allocatable :: real_buffer_1D !<Buffer used to read back in the data.
722  real,dimension(:,:),allocatable :: real_buffer_2D !<Buffer used to read back in the data.
723  real,dimension(:,:,:),allocatable :: real_buffer_3D !<Buffer used to read back in the data.
724  integer,dimension(:),allocatable :: int_buffer_1D !<Buffer used to read back in the data.
725  integer,dimension(:,:),allocatable :: int_buffer_2D !<Buffer used to read back in the data.
726  integer(INT_KIND) :: offset !<Offset used to check the read in data.
727  real :: rmax_error !<Error for real data.
728  integer :: imax_error !<Error for integer data.
729  integer(LONG_KIND) :: read_in_chksum !<Check-sum for read in data.
730  integer(LONG_KIND) :: ref_chksum !<Check-sum for reference test data.
731  integer(INT_KIND) :: funit !<File unit used to close a file.
732  integer(INT_KIND) :: i !<Loop variable.
733  integer(INT_KIND) :: j !<Loop variable.
734  integer(INT_KIND) :: k !<Loop variable.
735  integer(INT_KIND) :: q !<Loop variable.
736 
737  !Print out a message that the test is starting.
738  if (mpp_pe() .eq. mpp_root_pe()) then
739  write(output_unit,*)
740  write(output_unit,*) "Executing test 1 body ..."
741  endif
742 
743  !Make sure that the inputted number of restarts is less than or
744  !equal to 10, to keep the size of the output files reasonable.
745  if (num_restarts .gt. 10) then
746  call mpp_error(fatal, &
747  "test 1: the inputted number of restarts should" &
748  //" be less than or equal to 10.")
749  endif
750 
751  !Synchronize all ranks.
752  call mpp_sync()
753 
754  !Get the pelist associated with the unstructured I/O domain.
755  io_domain => null()
756  io_domain => mpp_get_ug_io_domain(unstructured_domain)
757  io_domain_npes = mpp_get_ug_domain_npes(io_domain)
758  allocate(pelist(io_domain_npes))
759  call mpp_get_ug_domain_pelist(io_domain, &
760  pelist)
761  io_domain => null()
762 
763  !Set the name of the restart file.
764  restart_file_name = "test_1_unstructured_restart_file.nc"
765 
766  !Add a x-axis to the restart file. This must be done before any fields
767  !are registered.
768  allocate(x_axis_data(nx))
769  do i = 1,nx
770  x_axis_data(i) = (real(i-1))*(360.0/real(nx))
771  enddo
772  call fms_io_unstructured_register_restart_axis(restart_file, &
773  restart_file_name, &
774  "lon", &
775  x_axis_data, &
776  "X", &
777  unstructured_domain)
778 
779  !Add a y-axis to the restart file. This must be done before any fields
780  !are registered.
781  allocate(y_axis_data(ny))
782  do i = 1,ny
783  y_axis_data(i) = (real(i-1))*(180.0/real(ny))
784  enddo
785  call fms_io_unstructured_register_restart_axis(restart_file, &
786  restart_file_name, &
787  "lat", &
788  y_axis_data, &
789  "Y", &
790  unstructured_domain)
791 
792  !Add a z-axis to the restart file. This must be done before any fields
793  !are registered.
794  allocate(z_axis_data(nz))
795  do i = 1,nz
796  z_axis_data(i) = real(i*5.0)
797  enddo
798  call fms_io_unstructured_register_restart_axis(restart_file, &
799  restart_file_name, &
800  "height", &
801  z_axis_data, &
802  "Z", &
803  unstructured_domain)
804 
805  !Add a cc-axis (???)to the restart file. This must be done before any
806  !fields are registered.
807  cc_axis_size = 9
808  allocate(cc_axis_data(cc_axis_size))
809  do i = 1,cc_axis_size
810  cc_axis_data(i) = real(i)*12.0 - real(i)
811  enddo
812  call fms_io_unstructured_register_restart_axis(restart_file, &
813  restart_file_name, &
814  "cc_axis", &
815  cc_axis_data, &
816  "CC", &
817  unstructured_domain)
818 
819  !Add a "C" type "compressed" axis to the restart file. This must be
820  !done before any fields are registered. Get the "compressed c" axis
821  !size from all other ranks on the same I/O domain pelist. This is
822  !needed to check to data after it is read back in.
823  compressed_c_axis_size = mpp_pe() + 1
824  allocate(compressed_c_axis_data(compressed_c_axis_size))
825  do i = 1,compressed_c_axis_size
826  compressed_c_axis_data(i) = real(mpp_pe()*mpp_pe() + i)
827  enddo
828  call fms_io_unstructured_register_restart_axis(restart_file, &
829  restart_file_name, &
830  "compressed_c_axis", &
831  compressed_c_axis_data, &
832  "compressed c", &
833  "C", &
834  compressed_c_axis_size, &
835  unstructured_domain)
836  allocate(compressed_c_axis_size_per_rank(io_domain_npes))
837  compressed_c_axis_size_per_rank = 0
838  do i = 1,io_domain_npes
839  if (pelist(i) .ne. mpp_pe()) then
840  call mpp_recv(compressed_c_axis_size_per_rank(i), &
841  pelist(i), &
842  block = .false., &
843  tag=comm_tag_1)
844  call mpp_send(compressed_c_axis_size, &
845  pelist(i), &
846  tag=comm_tag_1)
847  else
848  compressed_c_axis_size_per_rank(i) = compressed_c_axis_size
849  endif
850  enddo
851  call mpp_sync_self(check=event_recv)
852  call mpp_sync_self()
853  call mpp_sync()
854 
855  !Add a "H" type "compressed" axis to the restart file. This must be
856  !done before any fields are registered.
857  compressed_h_axis_size = npes
858  allocate(compressed_h_axis_data(compressed_h_axis_size))
859  do i = 1,compressed_h_axis_size
860  compressed_h_axis_data(i) = real((mpp_pe())*npes + i)
861  enddo
862  call fms_io_unstructured_register_restart_axis(restart_file, &
863  restart_file_name, &
864  "compressed_h_axis", &
865  compressed_h_axis_data, &
866  "compressed h", &
867  "H", &
868  compressed_h_axis_size, &
869  unstructured_domain)
870  allocate(compressed_h_axis_size_per_rank(io_domain_npes))
871  compressed_h_axis_size_per_rank = 0
872  do i = 1,io_domain_npes
873  if (pelist(i) .ne. mpp_pe()) then
874  call mpp_recv(compressed_h_axis_size_per_rank(i), &
875  pelist(i), &
876  block = .false., &
877  tag=comm_tag_1)
878  call mpp_send(compressed_h_axis_size, &
879  pelist(i), &
880  tag=comm_tag_1)
881  else
882  compressed_h_axis_size_per_rank(i) = compressed_h_axis_size
883  endif
884  enddo
885  call mpp_sync_self(check=event_recv)
886  call mpp_sync_self()
887  call mpp_sync()
888 
889  !Create a real scalar field and register it to the restart file. If
890  !a scalar field value is different across ranks, only the value on the
891  !root of the I/O domain pelist gets written to the file.
892  !Should we check for this? Should it be a fatal error?
893  real_scalar_field_name = "real_scalar_field_1"
894  real_scalar_field_data = 1234.5678
895 ! real_scalar_field_data = 1234.5678 + real(mpp_pe()*1000)
896  register_id = fms_io_unstructured_register_restart_field(restart_file, &
897  restart_file_name, &
898  real_scalar_field_name, &
899  real_scalar_field_data, &
900  unstructured_domain, &
901  longname="rsf1", &
902  units="ergs")
903 
904  !Create a "compressed c" real 1D field and register it to the restart
905  !file. This field is of the form:
906  !field = field(compressed c).
907  compressed_c_real_1d_field_name = "compressed_c_real_1D_field_1"
908  allocate(compressed_c_real_1d_field_data(compressed_c_axis_size))
909  do i = 1,compressed_c_axis_size
910  compressed_c_real_1d_field_data(i) = real(mpp_pe())
911  enddo
912  register_id = fms_io_unstructured_register_restart_field(restart_file, &
913  restart_file_name, &
914  compressed_c_real_1d_field_name, &
915  compressed_c_real_1d_field_data, &
916  (/cidx/), &
917  unstructured_domain, &
918  longname="r1Dcompcf1", &
919  units="cm")
920 
921  !Create a "compressed h" real 1D field and register it to the restart
922  !file. This field is of the form:
923  !field = field(compressed h).
924  compressed_h_real_1d_field_name = "compressed_h_real_1D_field_1"
925  allocate(compressed_h_real_1d_field_data(compressed_h_axis_size))
926  do i = 1,compressed_h_axis_size
927  compressed_h_real_1d_field_data(i) = real(i) + real(mpp_pe()) &
928  + 1111.1111
929  enddo
930  register_id = fms_io_unstructured_register_restart_field(restart_file, &
931  restart_file_name, &
932  compressed_h_real_1d_field_name, &
933  compressed_h_real_1d_field_data, &
934  (/hidx/), &
935  unstructured_domain, &
936  longname="r1Dcomphf1", &
937  units="km")
938 
939  !Create a "compressed c, z" real 2D field and register it to the restart
940  !file. The field is of the form:
941  !field = field(compressed c,z).
942  compressed_c_z_real_2d_field_name = "compressed_c_z_real_2D_field_1"
943  allocate(compressed_c_z_real_2d_field_data(compressed_c_axis_size,nz))
944  do j = 1,nz
945  do i = 1,compressed_c_axis_size
946  compressed_c_z_real_2d_field_data(i,j) = real(mpp_pe()*1000) &
947  + real(100*j) &
948  + real(10*i)
949  enddo
950  enddo
951  register_id = fms_io_unstructured_register_restart_field(restart_file, &
952  restart_file_name, &
953  compressed_c_z_real_2d_field_name, &
954  compressed_c_z_real_2d_field_data, &
955  (/cidx,zidx/), &
956  unstructured_domain, &
957  longname="r2Dcompczf1", &
958  units="N")
959 
960  !Create a "compressed h, z" real 2D field and register it to the restart
961  !file. The field is of the form:
962  !field = field(compressed h,z).
963  compressed_h_z_real_2d_field_name = "compressed_h_z_real_2D_field_1"
964  allocate(compressed_h_z_real_2d_field_data(compressed_h_axis_size,nz))
965  do j = 1,nz
966  do i = 1,compressed_h_axis_size
967  compressed_h_z_real_2d_field_data(i,j) = real(mpp_pe()*1000) &
968  - 1.0*real((j-1)* & compressed_h_axis_size+i) &
969  + 2.2222222
970  enddo
971  enddo
972  register_id = fms_io_unstructured_register_restart_field(restart_file, &
973  restart_file_name, &
974  compressed_h_z_real_2d_field_name, &
975  compressed_h_z_real_2d_field_data, &
976  (/hidx,zidx/), &
977  unstructured_domain, &
978  longname="r2Dcomphzf1", &
979  units="kN")
980 
981  !Create a "compressed c, cc" real 2D field and register it to the restart
982  !file. The field is of the form:
983  !field = field(compressed c,cc).
984  compressed_c_cc_real_2d_field_name = "compressed_c_cc_real_2D_field_1"
985  allocate(compressed_c_cc_real_2d_field_data(compressed_c_axis_size, &
986  cc_axis_size))
987  do j = 1,cc_axis_size
988  do i = 1,compressed_c_axis_size
989  compressed_c_cc_real_2d_field_data(i,j) = real(mpp_pe()*1111) &
990  + real(111*j) &
991  + real(11*i)
992  enddo
993  enddo
994  register_id = fms_io_unstructured_register_restart_field(restart_file, &
995  restart_file_name, &
996  compressed_c_cc_real_2d_field_name, &
997  compressed_c_cc_real_2d_field_data, &
998  (/cidx,ccidx/), &
999  unstructured_domain, &
1000  longname="r2Dcompcccf1", &
1001  units="T")
1002 
1003  !Create a "compressed h, z" real 2D field and register it to the restart
1004  !file. The field is of the form:
1005  !field = field(compressed h,cc).
1006  compressed_h_cc_real_2d_field_name = "compressed_h_cc_real_2D_field_1"
1007  allocate(compressed_h_cc_real_2d_field_data(compressed_h_axis_size, &
1008  cc_axis_size))
1009  do j = 1,cc_axis_size
1010  do i = 1,compressed_h_axis_size
1011  compressed_h_cc_real_2d_field_data(i,j) = real(mpp_pe()*1111) &
1012  - 5.0*real((j-1)* & compressed_h_axis_size+i) &
1013  + 2.2222222
1014  enddo
1015  enddo
1016  register_id = fms_io_unstructured_register_restart_field(restart_file, &
1017  restart_file_name, &
1018  compressed_h_cc_real_2d_field_name, &
1019  compressed_h_cc_real_2d_field_data, &
1020  (/hidx,ccidx/), &
1021  unstructured_domain, &
1022  longname="r2Dcomphccf1", &
1023  units="kT")
1024 
1025  !Create a "compressed c, z, cc" real 3D field and register it to the
1026  !restart file. This field is of the form:
1027  !field = field(compressed c,z,cc).
1028  compressed_c_z_cc_real_3d_field_name = "compressed_c_z_cc_real_3D_field_1"
1029  allocate(compressed_c_z_cc_real_3d_field_data(compressed_c_axis_size, &
1030  nz, &
1031  cc_axis_size))
1032  do k = 1,cc_axis_size
1033  do j = 1,nz
1034  do i = 1,compressed_c_axis_size
1035  compressed_c_z_cc_real_3d_field_data(i,j,k) = real(mpp_pe()*10000) &
1036  + real(k*1000) &
1037  + real(j*100) &
1038  + real(i*10)
1039  enddo
1040  enddo
1041  enddo
1042  register_id = fms_io_unstructured_register_restart_field(restart_file, &
1043  restart_file_name, &
1044  compressed_c_z_cc_real_3d_field_name, &
1045  compressed_c_z_cc_real_3d_field_data, &
1046  (/cidx,zidx,ccidx/), &
1047  unstructured_domain, &
1048  longname="r3Dcompczccf1", &
1049  units="nm")
1050 
1051  !Create a "compressed h, z, cc" real 3D field and register it to the
1052  !restart file. This field is of the form:
1053  !field = field(compressed h,z,cc).
1054  compressed_h_z_cc_real_3d_field_name = "compressed_h_z_cc_real_3D_field_1"
1055  allocate(compressed_h_z_cc_real_3d_field_data(compressed_h_axis_size, &
1056  nz, &
1057  cc_axis_size))
1058  do k = 1,cc_axis_size
1059  do j = 1,nz
1060  do i = 1,compressed_h_axis_size
1061  compressed_h_z_cc_real_3d_field_data(i,j,k) = real(mpp_pe()*1000) &
1062  - 1.0*real((j-1)* & compressed_h_axis_size+i) &
1063  + 2.2222222*(real(k-mpp_pe()))
1064  enddo
1065  enddo
1066  enddo
1067  register_id = fms_io_unstructured_register_restart_field(restart_file, &
1068  restart_file_name, &
1069  compressed_h_z_cc_real_3d_field_name, &
1070  compressed_h_z_cc_real_3d_field_data, &
1071  (/hidx,zidx,ccidx/), &
1072  unstructured_domain, &
1073  longname="r3Dcomphzccf1", &
1074  units="mB")
1075 
1076  !Create a "compressed c, cc, z" real 3D field and register it to the
1077  !restart file. This field is of the form:
1078  !field = field(compressed c,cc,z).
1079  compressed_c_cc_z_real_3d_field_name = "compressed_c_cc_z_real_3D_field_1"
1080  allocate(compressed_c_cc_z_real_3d_field_data(compressed_c_axis_size, &
1081  cc_axis_size, &
1082  nz))
1083  do k = 1,nz
1084  do j = 1,cc_axis_size
1085  do i = 1,compressed_c_axis_size
1086  compressed_c_cc_z_real_3d_field_data(i,j,k) = real(mpp_pe()*11111) &
1087  + real(k*1000) &
1088  + real(j*100) &
1089  + real(i*10)
1090  enddo
1091  enddo
1092  enddo
1093  register_id = fms_io_unstructured_register_restart_field(restart_file, &
1094  restart_file_name, &
1095  compressed_c_cc_z_real_3d_field_name, &
1096  compressed_c_cc_z_real_3d_field_data, &
1097  (/cidx,ccidx,zidx/), &
1098  unstructured_domain, &
1099  longname="r3Dcompccczf1", &
1100  units="yr")
1101 
1102  !Create a "compressed h, cc, z" real 3D field and register it to the
1103  !restart file. This field is of the form:
1104  !field = field(compressed h,cc,z).
1105  compressed_h_cc_z_real_3d_field_name = "compressed_h_cc_z_real_3D_field_1"
1106  allocate(compressed_h_cc_z_real_3d_field_data(compressed_h_axis_size, &
1107  cc_axis_size, &
1108  nz))
1109  do k = 1,nz
1110  do j = 1,cc_axis_size
1111  do i = 1,compressed_h_axis_size
1112  compressed_h_cc_z_real_3d_field_data(i,j,k) = real(mpp_pe()*11111) &
1113  - 1.0*real((j-1)* & compressed_h_axis_size+i) &
1114  + 2.2222222*(real(k-mpp_pe()))
1115  enddo
1116  enddo
1117  enddo
1118  register_id = fms_io_unstructured_register_restart_field(restart_file, &
1119  restart_file_name, &
1120  compressed_h_cc_z_real_3d_field_name, &
1121  compressed_h_cc_z_real_3d_field_data, &
1122  (/hidx,ccidx,zidx/), &
1123  unstructured_domain, &
1124  longname="r3Dcomphcczf1", &
1125  units="hour")
1126 
1127  !Create an integer scalar field and register it to the restart file. If
1128  !a scalar field value is different across ranks, only the value on the
1129  !root of the I/O domain pelist gets written to the file.
1130  !Should we check for this? Should it be a fatal error?
1131  int_scalar_field_name = "int_scalar_field_1"
1132  int_scalar_field_data = 4321
1133 ! int_scalar_field_data = 4321 + (mpp_pe()*1000)
1134  register_id = fms_io_unstructured_register_restart_field(restart_file, &
1135  restart_file_name, &
1136  int_scalar_field_name, &
1137  int_scalar_field_data, &
1138  unstructured_domain, &
1139  longname="isf1", &
1140  units="Watt")
1141 
1142  !Create a "compressed c" integer 1D field and register it to the restart
1143  !file. This field is of the form:
1144  !field = field(compressed c).
1145  compressed_c_int_1d_field_name = "compressed_c_int_1D_field_1"
1146  allocate(compressed_c_int_1d_field_data(compressed_c_axis_size))
1147  do i = 1,compressed_c_axis_size
1148  compressed_c_int_1d_field_data(i) = mpp_pe()
1149  enddo
1150  register_id = fms_io_unstructured_register_restart_field(restart_file, &
1151  restart_file_name, &
1152  compressed_c_int_1d_field_name, &
1153  compressed_c_int_1d_field_data, &
1154  (/cidx/), &
1155  unstructured_domain, &
1156  longname="i1Dcompcf1", &
1157  units="pc")
1158 
1159  !Create a "compressed h" integer 1D field and register it to the restart
1160  !file. This field is of the form:
1161  !field = field(compressed h).
1162  compressed_h_int_1d_field_name = "compressed_h_int_1D_field_1"
1163  allocate(compressed_h_int_1d_field_data(compressed_h_axis_size))
1164  do i = 1,compressed_h_axis_size
1165  compressed_h_int_1d_field_data(i) = i + mpp_pe() + 1111
1166  enddo
1167  register_id = fms_io_unstructured_register_restart_field(restart_file, &
1168  restart_file_name, &
1169  compressed_h_int_1d_field_name, &
1170  compressed_h_int_1d_field_data, &
1171  (/hidx/), &
1172  unstructured_domain, &
1173  longname="i1Dcomphf1", &
1174  units="kpc")
1175 
1176  !Create a "compressed c, z" integer 2D field and register it to the
1177  !restart file. The field is of the form:
1178  !field = field(compressed c,z).
1179  compressed_c_z_int_2d_field_name = "compressed_c_z_int_2D_field_1"
1180  allocate(compressed_c_z_int_2d_field_data(compressed_c_axis_size,nz))
1181  do j = 1,nz
1182  do i = 1,compressed_c_axis_size
1183  compressed_c_z_int_2d_field_data(i,j) = mpp_pe()*1000 &
1184  + 100*j + 10
1185  enddo
1186  enddo
1187  register_id = fms_io_unstructured_register_restart_field(restart_file, &
1188  restart_file_name, &
1189  compressed_c_z_int_2d_field_name, &
1190  compressed_c_z_int_2d_field_data, &
1191  (/cidx,zidx/), &
1192  unstructured_domain, &
1193  longname="i2Dcompczf1", &
1194  units="au")
1195 
1196  !Create a "compressed h, z" integer 2D field and register it to the
1197  !restart file. The field is of the form:
1198  !field = field(compressed h,z).
1199  compressed_h_z_int_2d_field_name = "compressed_h_z_int_2D_field_1"
1200  allocate(compressed_h_z_int_2d_field_data(compressed_h_axis_size,nz))
1201  do j = 1,nz
1202  do i = 1,compressed_h_axis_size
1203  compressed_h_z_int_2d_field_data(i,j) = mpp_pe()*1000 &
1204  - 1.0*(j-1)* &
1205  compressed_h_axis_size+i &
1206  + 2
1207  enddo
1208  enddo
1209  register_id = fms_io_unstructured_register_restart_field(restart_file, &
1210  restart_file_name, &
1211  compressed_h_z_int_2d_field_name, &
1212  compressed_h_z_int_2d_field_data, &
1213  (/hidx,zidx/), &
1214  unstructured_domain, &
1215  longname="i2Dcomphzf1", &
1216  units="kau")
1217 
1218  !Create a "compressed c, cc" integer 2D field and register it to the
1219  !restart file. The field is of the form:
1220  !field = field(compressed c,cc).
1221  compressed_c_cc_int_2d_field_name = "compressed_c_cc_int_2D_field_1"
1222  allocate(compressed_c_cc_int_2d_field_data(compressed_c_axis_size, &
1223  cc_axis_size))
1224  do j = 1,cc_axis_size
1225  do i = 1,compressed_c_axis_size
1226  compressed_c_cc_int_2d_field_data(i,j) = mpp_pe()*1111 &
1227  + 111*j + 11*i
1228  enddo
1229  enddo
1230  register_id = fms_io_unstructured_register_restart_field(restart_file, &
1231  restart_file_name, &
1232  compressed_c_cc_int_2d_field_name, &
1233  compressed_c_cc_int_2d_field_data, &
1234  (/cidx,ccidx/), &
1235  unstructured_domain, &
1236  longname="i2Dcompcccf1", &
1237  units="mol")
1238 
1239  !Create a "compressed h, z" integer 2D field and register it to the
1240  !restart file. The field is of the form:
1241  !field = field(compressed h,cc).
1242  compressed_h_cc_int_2d_field_name = "compressed_h_cc_int_2D_field_1"
1243  allocate(compressed_h_cc_int_2d_field_data(compressed_h_axis_size, &
1244  cc_axis_size))
1245  do j = 1,cc_axis_size
1246  do i = 1,compressed_h_axis_size
1247  compressed_h_cc_int_2d_field_data(i,j) = mpp_pe()*1111 &
1248  - 5.0*(j-1)* &
1249  compressed_h_axis_size+i &
1250  + 2
1251  enddo
1252  enddo
1253  register_id = fms_io_unstructured_register_restart_field(restart_file, &
1254  restart_file_name, &
1255  compressed_h_cc_int_2d_field_name, &
1256  compressed_h_cc_int_2d_field_data, &
1257  (/hidx,ccidx/), &
1258  unstructured_domain, &
1259  longname="i2Dcomphccf1", &
1260  units="kmol")
1261 
1262  !Allocate arrays used to check the results on a "restart".
1263  allocate(real_scalar_field_data_ref(num_restarts))
1264  allocate(compressed_c_real_1d_field_data_ref(compressed_c_axis_size,num_restarts))
1265  allocate(compressed_h_real_1d_field_data_ref(compressed_h_axis_size,num_restarts))
1266  allocate(compressed_c_z_real_2d_field_data_ref(compressed_c_axis_size,nz,num_restarts))
1267  allocate(compressed_h_z_real_2d_field_data_ref(compressed_h_axis_size,nz,num_restarts))
1268  allocate(compressed_c_cc_real_2d_field_data_ref(compressed_c_axis_size,cc_axis_size,num_restarts))
1269  allocate(compressed_h_cc_real_2d_field_data_ref(compressed_h_axis_size,cc_axis_size,num_restarts))
1270  allocate(compressed_c_z_cc_real_3d_field_data_ref(compressed_c_axis_size,nz,cc_axis_size,num_restarts))
1271  allocate(compressed_h_z_cc_real_3d_field_data_ref(compressed_h_axis_size,nz,cc_axis_size,num_restarts))
1272  allocate(compressed_c_cc_z_real_3d_field_data_ref(compressed_c_axis_size,cc_axis_size,nz,num_restarts))
1273  allocate(compressed_h_cc_z_real_3d_field_data_ref(compressed_h_axis_size,cc_axis_size,nz,num_restarts))
1274  allocate(int_scalar_field_data_ref(num_restarts))
1275  allocate(compressed_c_int_1d_field_data_ref(compressed_c_axis_size,num_restarts))
1276  allocate(compressed_h_int_1d_field_data_ref(compressed_h_axis_size,num_restarts))
1277  allocate(compressed_c_z_int_2d_field_data_ref(compressed_c_axis_size,nz,num_restarts))
1278  allocate(compressed_h_z_int_2d_field_data_ref(compressed_h_axis_size,nz,num_restarts))
1279  allocate(compressed_c_cc_int_2d_field_data_ref(compressed_c_axis_size,cc_axis_size,num_restarts))
1280  allocate(compressed_h_cc_int_2d_field_data_ref(compressed_h_axis_size,cc_axis_size,num_restarts))
1281  call mpp_sync()
1282 
1283  !Write out the restart data at an inputted number of time levels.
1284  do q = 1,num_restarts
1285 
1286  !Simulate the data evolving in time.
1287  if (q .gt. 1) then
1288  real_scalar_field_data = real_scalar_field_data + 8.0
1289  compressed_c_real_1d_field_data = compressed_c_real_1d_field_data + 9.0
1290  compressed_h_real_1d_field_data = compressed_h_real_1d_field_data + 10.0
1291  compressed_c_z_real_2d_field_data = compressed_c_z_real_2d_field_data + 11.0
1292  compressed_h_z_real_2d_field_data = compressed_h_z_real_2d_field_data + 12.0
1293  compressed_c_cc_real_2d_field_data = compressed_c_cc_real_2d_field_data + 13.0
1294  compressed_h_cc_real_2d_field_data = compressed_h_cc_real_2d_field_data + 14.0
1295  compressed_c_z_cc_real_3d_field_data = compressed_c_z_cc_real_3d_field_data + 15.0
1296  compressed_h_z_cc_real_3d_field_data = compressed_h_z_cc_real_3d_field_data + 16.0
1297  compressed_c_cc_z_real_3d_field_data = compressed_c_cc_z_real_3d_field_data + 17.0
1298  compressed_h_cc_z_real_3d_field_data = compressed_h_cc_z_real_3d_field_data + 18.0
1299  int_scalar_field_data = int_scalar_field_data + 19
1300  compressed_c_int_1d_field_data = compressed_c_int_1d_field_data + 20
1301  compressed_h_int_1d_field_data = compressed_h_int_1d_field_data + 21
1302  compressed_c_z_int_2d_field_data = compressed_c_z_int_2d_field_data + 22
1303  compressed_h_z_int_2d_field_data = compressed_h_z_int_2d_field_data + 23
1304  compressed_c_cc_int_2d_field_data = compressed_c_cc_int_2d_field_data + 24
1305  compressed_h_cc_int_2d_field_data = compressed_h_cc_int_2d_field_data + 25
1306  endif
1307 
1308  !Save the state that will be written to the restarts.
1309  real_scalar_field_data_ref(q) = real_scalar_field_data
1310  compressed_c_real_1d_field_data_ref(:,q) = compressed_c_real_1d_field_data
1311  compressed_h_real_1d_field_data_ref(:,q) = compressed_h_real_1d_field_data
1312  compressed_c_z_real_2d_field_data_ref(:,:,q) = compressed_c_z_real_2d_field_data
1313  compressed_h_z_real_2d_field_data_ref(:,:,q) = compressed_h_z_real_2d_field_data
1314  compressed_c_cc_real_2d_field_data_ref(:,:,q) = compressed_c_cc_real_2d_field_data
1315  compressed_h_cc_real_2d_field_data_ref(:,:,q) = compressed_h_cc_real_2d_field_data
1316  compressed_c_z_cc_real_3d_field_data_ref(:,:,:,q) = compressed_c_z_cc_real_3d_field_data
1317  compressed_h_z_cc_real_3d_field_data_ref(:,:,:,q) = compressed_h_z_cc_real_3d_field_data
1318  compressed_c_cc_z_real_3d_field_data_ref(:,:,:,q) = compressed_c_cc_z_real_3d_field_data
1319  compressed_h_cc_z_real_3d_field_data_ref(:,:,:,q) = compressed_h_cc_z_real_3d_field_data
1320  int_scalar_field_data_ref(q) = int_scalar_field_data
1321  compressed_c_int_1d_field_data_ref(:,q) = compressed_c_int_1d_field_data
1322  compressed_h_int_1d_field_data_ref(:,q) = compressed_h_int_1d_field_data
1323  compressed_c_z_int_2d_field_data_ref(:,:,q) = compressed_c_z_int_2d_field_data
1324  compressed_h_z_int_2d_field_data_ref(:,:,q) = compressed_h_z_int_2d_field_data
1325  compressed_c_cc_int_2d_field_data_ref(:,:,q) = compressed_c_cc_int_2d_field_data
1326  compressed_h_cc_int_2d_field_data_ref(:,:,q) = compressed_h_cc_int_2d_field_data
1327 
1328  !Write out the restart file.
1329  call mpp_sync()
1330  if (q .gt. 1) then
1331  call fms_io_unstructured_save_restart(restart_file, &
1332  directory="RESTART", &
1333  append=.true., &
1334  time_level=real(q))
1335  else
1336  call fms_io_unstructured_save_restart(restart_file, &
1337  directory="RESTART")
1338  endif
1339  call mpp_sync()
1340  enddo
1341 
1342  !For each time level, read the data back in and compare it to the
1343  !stored reference data.
1344  do q = 1,num_restarts
1345 
1346  !Write a message specifiying the time level at which the data
1347  !is being compared.
1348  if (mpp_pe() .eq. mpp_root_pe()) then
1349  write(output_unit,*)
1350  write(output_unit,*) "Checking restart data at timelevel:",q
1351  endif
1352 
1353  !Zero out all field data to simulate a restart run starting.
1354  call mpp_sync()
1355  real_scalar_field_data = 0.0
1356  compressed_c_real_1d_field_data = 0.0
1357  compressed_h_real_1d_field_data = 0.0
1358  compressed_c_z_real_2d_field_data = 0.0
1359  compressed_h_z_real_2d_field_data = 0.0
1360  compressed_c_cc_real_2d_field_data = 0.0
1361  compressed_h_cc_real_2d_field_data = 0.0
1362  compressed_c_z_cc_real_3d_field_data = 0.0
1363  compressed_h_z_cc_real_3d_field_data = 0.0
1364  compressed_c_cc_z_real_3d_field_data = 0.0
1365  compressed_h_cc_z_real_3d_field_data = 0.0
1366  int_scalar_field_data = 0
1367  compressed_c_int_1d_field_data = 0
1368  compressed_h_int_1d_field_data = 0
1369  compressed_c_z_int_2d_field_data = 0
1370  compressed_h_z_int_2d_field_data = 0
1371  compressed_c_cc_int_2d_field_data = 0
1372  compressed_h_cc_int_2d_field_data = 0
1373 
1374  !Read the data back in. The read will read-in an entire I/O domain
1375  !tile's worth of data. Each rank is then required to copy its own
1376  !part of that data back into the appropriate arrays so that the
1377  !data can be checked.
1378 
1379  !-------------------------------------------------------------------
1380  !Real scalar field.
1381  call mpp_sync()
1382  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
1383  real_scalar_field_name, &
1384  field_dimension_sizes, &
1385  unstructured_domain, &
1386  field_found_in_file)
1387  if (.not. field_found_in_file) then
1388  call mpp_error(fatal, &
1389  "test 1: field "//trim(real_scalar_field_name) &
1390  //" was not found in file " &
1391  //trim(restart_file_name))
1392  endif
1393  allocate(real_buffer_1d(1))
1394  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
1395  real_scalar_field_name, &
1396  real_buffer_1d, &
1397  unstructured_domain, &
1398  timelevel=q)
1399  real_scalar_field_data = real_buffer_1d(1)
1400  deallocate(real_buffer_1d)
1401  rmax_error = abs(real_scalar_field_data - &
1402  real_scalar_field_data_ref(q))
1403  if (rmax_error .ne. 0.0) then
1404  write(output_unit,*)
1405  write(output_unit,*) "My rank: ",mpp_pe()
1406  write(output_unit,*) "Restart iteration: ",q
1407  write(output_unit,*) "Max real scalar field error: ",rmax_error
1408  call mpp_error(fatal, &
1409  "test 1: real scalar field data incorrect.")
1410  else
1411  if (mpp_pe() .eq. mpp_root_pe()) then
1412  write(output_unit,*)
1413  write(output_unit,*) "Real scalar field data correct."
1414  endif
1415  endif
1416  call mpp_sync()
1417 
1418  !-------------------------------------------------------------------
1419  !Compressed c real 1D field.
1420  call mpp_sync()
1421  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
1422  compressed_c_real_1d_field_name, &
1423  field_dimension_sizes, &
1424  unstructured_domain, &
1425  field_found_in_file)
1426  if (.not. field_found_in_file) then
1427  call mpp_error(fatal, &
1428  "test 1: field "//trim(compressed_c_real_1d_field_name) &
1429  //" was not found in file " &
1430  //trim(restart_file_name))
1431  endif
1432  allocate(real_buffer_1d(field_dimension_sizes(1)))
1433  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
1434  compressed_c_real_1d_field_name, &
1435  real_buffer_1d, &
1436  unstructured_domain, &
1437  timelevel=q)
1438  if (mpp_pe() .eq. pelist(1)) then
1439  offset = 0
1440  else
1441  offset = 0
1442  do i = 1,io_domain_npes
1443  if (mpp_pe() .eq. pelist(i)) then
1444  exit
1445  else
1446  offset = offset + compressed_c_axis_size_per_rank(i)
1447  endif
1448  enddo
1449  endif
1450  do i = 1,compressed_c_axis_size
1451  compressed_c_real_1d_field_data(i) = real_buffer_1d(i+offset)
1452  enddo
1453  deallocate(real_buffer_1d)
1454  rmax_error = maxval(abs(compressed_c_real_1d_field_data - &
1455  compressed_c_real_1d_field_data_ref(:,q)))
1456  read_in_chksum = mpp_chksum(compressed_c_real_1d_field_data)
1457  ref_chksum = mpp_chksum(compressed_c_real_1d_field_data_ref(:,q))
1458  if (rmax_error .ne. 0.0 .or. read_in_chksum .ne. ref_chksum) then
1459  write(output_unit,*)
1460  write(output_unit,*) "My rank: ",mpp_pe()
1461  write(output_unit,*) "Restart iteration: ",q
1462  write(output_unit,*) "Max compressed c real 1D field error: ",rmax_error
1463  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
1464  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
1465  call mpp_error(fatal, &
1466  "test 1: compressed c real 1D field data incorrect.")
1467  else
1468  if (mpp_pe() .eq. mpp_root_pe()) then
1469  write(output_unit,*)
1470  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
1471  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
1472  write(output_unit,*) "Compressed c real 1D field data correct."
1473  endif
1474  endif
1475  call mpp_sync()
1476 
1477  !-------------------------------------------------------------------
1478  !Compressed h real 1D field.
1479  call mpp_sync()
1480  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
1481  compressed_h_real_1d_field_name, &
1482  field_dimension_sizes, &
1483  unstructured_domain, &
1484  field_found_in_file)
1485  if (.not. field_found_in_file) then
1486  call mpp_error(fatal, &
1487  "test 1: field "//trim(compressed_h_real_1d_field_name) &
1488  //" was not found in file " &
1489  //trim(restart_file_name))
1490  endif
1491  allocate(real_buffer_1d(field_dimension_sizes(1)))
1492  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
1493  compressed_h_real_1d_field_name, &
1494  real_buffer_1d, &
1495  unstructured_domain, &
1496  timelevel=q)
1497  if (mpp_pe() .eq. pelist(1)) then
1498  offset = 0
1499  else
1500  offset = 0
1501  do i = 1,io_domain_npes
1502  if (mpp_pe() .eq. pelist(i)) then
1503  exit
1504  else
1505  offset = offset + compressed_h_axis_size_per_rank(i)
1506  endif
1507  enddo
1508  endif
1509  do i = 1,compressed_h_axis_size
1510  compressed_h_real_1d_field_data(i) = real_buffer_1d(i+offset)
1511  enddo
1512  deallocate(real_buffer_1d)
1513  rmax_error = maxval(abs(compressed_h_real_1d_field_data - &
1514  compressed_h_real_1d_field_data_ref(:,q)))
1515  read_in_chksum = mpp_chksum(compressed_h_real_1d_field_data)
1516  ref_chksum = mpp_chksum(compressed_h_real_1d_field_data_ref(:,q))
1517  if (rmax_error .ne. 0.0 .or. read_in_chksum .ne. ref_chksum) then
1518  write(output_unit,*)
1519  write(output_unit,*) "My rank: ",mpp_pe()
1520  write(output_unit,*) "Restart iteration: ",q
1521  write(output_unit,*) "Max compressed h real 1D field error: ",rmax_error
1522  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
1523  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
1524  call mpp_error(fatal, &
1525  "test 1: compressed h real 1D field data incorrect.")
1526  else
1527  if (mpp_pe() .eq. mpp_root_pe()) then
1528  write(output_unit,*)
1529  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
1530  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
1531  write(output_unit,*) "Compressed h real 1D field data correct."
1532  endif
1533  endif
1534  call mpp_sync()
1535 
1536  !-------------------------------------------------------------------
1537  !Compressed c, z real 2D field.
1538  call mpp_sync()
1539  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
1540  compressed_c_z_real_2d_field_name, &
1541  field_dimension_sizes, &
1542  unstructured_domain, &
1543  field_found_in_file)
1544  if (.not. field_found_in_file) then
1545  call mpp_error(fatal, &
1546  "test 1: field "//trim(compressed_c_z_real_2d_field_name) &
1547  //" was not found in file " &
1548  //trim(restart_file_name))
1549  endif
1550  allocate(real_buffer_2d(field_dimension_sizes(1), &
1551  field_dimension_sizes(2)))
1552  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
1553  compressed_c_z_real_2d_field_name, &
1554  real_buffer_2d, &
1555  unstructured_domain, &
1556  timelevel=q)
1557  if (mpp_pe() .eq. pelist(1)) then
1558  offset = 0
1559  else
1560  offset = 0
1561  do i = 1,io_domain_npes
1562  if (mpp_pe() .eq. pelist(i)) then
1563  exit
1564  else
1565  offset = offset + compressed_c_axis_size_per_rank(i)
1566  endif
1567  enddo
1568  endif
1569  do j = 1,size(compressed_c_z_real_2d_field_data,2)
1570  do i = 1,size(compressed_c_z_real_2d_field_data,1)
1571  compressed_c_z_real_2d_field_data(i,j) = real_buffer_2d(i+offset,j)
1572  enddo
1573  enddo
1574  deallocate(real_buffer_2d)
1575  rmax_error = maxval(abs(compressed_c_z_real_2d_field_data - &
1576  compressed_c_z_real_2d_field_data_ref(:,:,q)))
1577  read_in_chksum = mpp_chksum(compressed_c_z_real_2d_field_data)
1578  ref_chksum = mpp_chksum(compressed_c_z_real_2d_field_data_ref(:,:,q))
1579  if (rmax_error .ne. 0.0 .or. read_in_chksum .ne. ref_chksum) then
1580  write(output_unit,*)
1581  write(output_unit,*) "My rank: ",mpp_pe()
1582  write(output_unit,*) "Restart iteration: ",q
1583  write(output_unit,*) "Max compressed c, z real 2D field error: ",rmax_error
1584  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
1585  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
1586  call mpp_error(fatal, &
1587  "test 1: compressed c, z real 2D field data incorrect.")
1588  else
1589  if (mpp_pe() .eq. mpp_root_pe()) then
1590  write(output_unit,*)
1591  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
1592  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
1593  write(output_unit,*) "Compressed c, z real 2D field data correct."
1594  endif
1595  endif
1596  call mpp_sync()
1597 
1598  !-------------------------------------------------------------------
1599  !Compressed h, z real 2D field.
1600  call mpp_sync()
1601  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
1602  compressed_h_z_real_2d_field_name, &
1603  field_dimension_sizes, &
1604  unstructured_domain, &
1605  field_found_in_file)
1606  if (.not. field_found_in_file) then
1607  call mpp_error(fatal, &
1608  "test 1: field "//trim(compressed_h_z_real_2d_field_name) &
1609  //" was not found in file " &
1610  //trim(restart_file_name))
1611  endif
1612  allocate(real_buffer_2d(field_dimension_sizes(1), &
1613  field_dimension_sizes(2)))
1614  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
1615  compressed_h_z_real_2d_field_name, &
1616  real_buffer_2d, &
1617  unstructured_domain, &
1618  timelevel=q)
1619  if (mpp_pe() .eq. pelist(1)) then
1620  offset = 0
1621  else
1622  offset = 0
1623  do i = 1,io_domain_npes
1624  if (mpp_pe() .eq. pelist(i)) then
1625  exit
1626  else
1627  offset = offset + compressed_h_axis_size_per_rank(i)
1628  endif
1629  enddo
1630  endif
1631  do j = 1,size(compressed_h_z_real_2d_field_data,2)
1632  do i = 1,size(compressed_h_z_real_2d_field_data,1)
1633  compressed_h_z_real_2d_field_data(i,j) = real_buffer_2d(i+offset,j)
1634  enddo
1635  enddo
1636  deallocate(real_buffer_2d)
1637  rmax_error = maxval(abs(compressed_h_z_real_2d_field_data - &
1638  compressed_h_z_real_2d_field_data_ref(:,:,q)))
1639  read_in_chksum = mpp_chksum(compressed_h_z_real_2d_field_data)
1640  ref_chksum = mpp_chksum(compressed_h_z_real_2d_field_data_ref(:,:,q))
1641  if (rmax_error .ne. 0.0 .or. read_in_chksum .ne. ref_chksum) then
1642  write(output_unit,*)
1643  write(output_unit,*) "My rank: ",mpp_pe()
1644  write(output_unit,*) "Restart iteration: ",q
1645  write(output_unit,*) "Max compressed h, z real 2D field error: ",rmax_error
1646  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
1647  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
1648  call mpp_error(fatal, &
1649  "test 1: compressed h, z real 2D field data incorrect.")
1650  else
1651  if (mpp_pe() .eq. mpp_root_pe()) then
1652  write(output_unit,*)
1653  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
1654  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
1655  write(output_unit,*) "Compressed h, z real 2D field data correct."
1656  endif
1657  endif
1658  call mpp_sync()
1659 
1660  !-------------------------------------------------------------------
1661  !Compressed c, cc real 2D field.
1662  call mpp_sync()
1663  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
1664  compressed_c_cc_real_2d_field_name, &
1665  field_dimension_sizes, &
1666  unstructured_domain, &
1667  field_found_in_file)
1668  if (.not. field_found_in_file) then
1669  call mpp_error(fatal, &
1670  "test 1: field "//trim(compressed_c_cc_real_2d_field_name) &
1671  //" was not found in file " &
1672  //trim(restart_file_name))
1673  endif
1674  allocate(real_buffer_2d(field_dimension_sizes(1), &
1675  field_dimension_sizes(2)))
1676  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
1677  compressed_c_cc_real_2d_field_name, &
1678  real_buffer_2d, &
1679  unstructured_domain, &
1680  timelevel=q)
1681  if (mpp_pe() .eq. pelist(1)) then
1682  offset = 0
1683  else
1684  offset = 0
1685  do i = 1,io_domain_npes
1686  if (mpp_pe() .eq. pelist(i)) then
1687  exit
1688  else
1689  offset = offset + compressed_c_axis_size_per_rank(i)
1690  endif
1691  enddo
1692  endif
1693  do j = 1,size(compressed_c_cc_real_2d_field_data,2)
1694  do i = 1,size(compressed_c_cc_real_2d_field_data,1)
1695  compressed_c_cc_real_2d_field_data(i,j) = real_buffer_2d(i+offset,j)
1696  enddo
1697  enddo
1698  deallocate(real_buffer_2d)
1699  rmax_error = maxval(abs(compressed_c_cc_real_2d_field_data - &
1700  compressed_c_cc_real_2d_field_data_ref(:,:,q)))
1701  read_in_chksum = mpp_chksum(compressed_c_cc_real_2d_field_data)
1702  ref_chksum = mpp_chksum(compressed_c_cc_real_2d_field_data_ref(:,:,q))
1703  if (rmax_error .ne. 0.0 .or. read_in_chksum .ne. ref_chksum) then
1704  write(output_unit,*)
1705  write(output_unit,*) "My rank: ",mpp_pe()
1706  write(output_unit,*) "Restart iteration: ",q
1707  write(output_unit,*) "Max compressed c, cc real 2D field error: ",rmax_error
1708  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
1709  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
1710  call mpp_error(fatal, &
1711  "test 1: compressed c, z real 2D field data incorrect.")
1712  else
1713  if (mpp_pe() .eq. mpp_root_pe()) then
1714  write(output_unit,*)
1715  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
1716  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
1717  write(output_unit,*) "Compressed c, cc real 2D field data correct."
1718  endif
1719  endif
1720  call mpp_sync()
1721 
1722  !-------------------------------------------------------------------
1723  !Compressed h, cc real 2D field.
1724  call mpp_sync()
1725  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
1726  compressed_h_cc_real_2d_field_name, &
1727  field_dimension_sizes, &
1728  unstructured_domain, &
1729  field_found_in_file)
1730  if (.not. field_found_in_file) then
1731  call mpp_error(fatal, &
1732  "test 1: field "//trim(compressed_h_cc_real_2d_field_name) &
1733  //" was not found in file " &
1734  //trim(restart_file_name))
1735  endif
1736  allocate(real_buffer_2d(field_dimension_sizes(1), &
1737  field_dimension_sizes(2)))
1738  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
1739  compressed_h_cc_real_2d_field_name, &
1740  real_buffer_2d, &
1741  unstructured_domain, &
1742  timelevel=q)
1743  if (mpp_pe() .eq. pelist(1)) then
1744  offset = 0
1745  else
1746  offset = 0
1747  do i = 1,io_domain_npes
1748  if (mpp_pe() .eq. pelist(i)) then
1749  exit
1750  else
1751  offset = offset + compressed_h_axis_size_per_rank(i)
1752  endif
1753  enddo
1754  endif
1755  do j = 1,size(compressed_h_cc_real_2d_field_data,2)
1756  do i = 1,size(compressed_h_cc_real_2d_field_data,1)
1757  compressed_h_cc_real_2d_field_data(i,j) = real_buffer_2d(i+offset,j)
1758  enddo
1759  enddo
1760  deallocate(real_buffer_2d)
1761  rmax_error = maxval(abs(compressed_h_cc_real_2d_field_data - &
1762  compressed_h_cc_real_2d_field_data_ref(:,:,q)))
1763  read_in_chksum = mpp_chksum(compressed_h_cc_real_2d_field_data)
1764  ref_chksum = mpp_chksum(compressed_h_cc_real_2d_field_data_ref(:,:,q))
1765  if (rmax_error .ne. 0.0 .or. read_in_chksum .ne. ref_chksum) then
1766  write(output_unit,*)
1767  write(output_unit,*) "My rank: ",mpp_pe()
1768  write(output_unit,*) "Restart iteration: ",q
1769  write(output_unit,*) "Max compressed h, cc real 2D field error: ",rmax_error
1770  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
1771  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
1772  call mpp_error(fatal, &
1773  "test 1: compressed h, z real 2D field data incorrect.")
1774  else
1775  if (mpp_pe() .eq. mpp_root_pe()) then
1776  write(output_unit,*)
1777  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
1778  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
1779  write(output_unit,*) "Compressed h, cc real 2D field data correct."
1780  endif
1781  endif
1782  call mpp_sync()
1783 
1784  !-------------------------------------------------------------------
1785  !Compressed c, z, cc real 3D field.
1786  call mpp_sync()
1787  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
1788  compressed_c_z_cc_real_3d_field_name, &
1789  field_dimension_sizes, &
1790  unstructured_domain, &
1791  field_found_in_file)
1792  if (.not. field_found_in_file) then
1793  call mpp_error(fatal, &
1794  "test 1: field "//trim(compressed_c_z_cc_real_3d_field_name) &
1795  //" was not found in file " &
1796  //trim(restart_file_name))
1797  endif
1798  allocate(real_buffer_3d(field_dimension_sizes(1), &
1799  field_dimension_sizes(2), &
1800  field_dimension_sizes(3)))
1801  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
1802  compressed_c_z_cc_real_3d_field_name, &
1803  real_buffer_3d, &
1804  unstructured_domain, &
1805  timelevel=q)
1806  if (mpp_pe() .eq. pelist(1)) then
1807  offset = 0
1808  else
1809  offset = 0
1810  do i = 1,io_domain_npes
1811  if (mpp_pe() .eq. pelist(i)) then
1812  exit
1813  else
1814  offset = offset + compressed_c_axis_size_per_rank(i)
1815  endif
1816  enddo
1817  endif
1818  do k = 1,size(compressed_c_z_cc_real_3d_field_data,3)
1819  do j = 1,size(compressed_c_z_cc_real_3d_field_data,2)
1820  do i = 1,size(compressed_c_z_cc_real_3d_field_data,1)
1821  compressed_c_z_cc_real_3d_field_data(i,j,k) = real_buffer_3d(i+offset,j,k)
1822  enddo
1823  enddo
1824  enddo
1825  deallocate(real_buffer_3d)
1826  rmax_error = maxval(abs(compressed_c_z_cc_real_3d_field_data - &
1827  compressed_c_z_cc_real_3d_field_data_ref(:,:,:,q)))
1828  read_in_chksum = mpp_chksum(compressed_c_z_cc_real_3d_field_data)
1829  ref_chksum = mpp_chksum(compressed_c_z_cc_real_3d_field_data_ref(:,:,:,q))
1830  if (rmax_error .ne. 0.0 .or. read_in_chksum .ne. ref_chksum) then
1831  write(output_unit,*)
1832  write(output_unit,*) "My rank: ",mpp_pe()
1833  write(output_unit,*) "Restart iteration: ",q
1834  write(output_unit,*) "Max compressed c, z, cc real 3D field error: ",rmax_error
1835  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
1836  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
1837  call mpp_error(fatal, &
1838  "test 1: compressed c, z, cc real 3D field data incorrect.")
1839  else
1840  if (mpp_pe() .eq. mpp_root_pe()) then
1841  write(output_unit,*)
1842  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
1843  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
1844  write(output_unit,*) "Compressed c, z, cc real 3D field data correct."
1845  endif
1846  endif
1847  call mpp_sync()
1848 
1849  !-------------------------------------------------------------------
1850  !Compressed h, z, cc real 3D field.
1851  call mpp_sync()
1852  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
1853  compressed_h_z_cc_real_3d_field_name, &
1854  field_dimension_sizes, &
1855  unstructured_domain, &
1856  field_found_in_file)
1857  if (.not. field_found_in_file) then
1858  call mpp_error(fatal, &
1859  "test 1: field "//trim(compressed_h_z_cc_real_3d_field_name) &
1860  //" was not found in file " &
1861  //trim(restart_file_name))
1862  endif
1863  allocate(real_buffer_3d(field_dimension_sizes(1), &
1864  field_dimension_sizes(2), &
1865  field_dimension_sizes(3)))
1866  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
1867  compressed_h_z_cc_real_3d_field_name, &
1868  real_buffer_3d, &
1869  unstructured_domain, &
1870  timelevel=q)
1871  if (mpp_pe() .eq. pelist(1)) then
1872  offset = 0
1873  else
1874  offset = 0
1875  do i = 1,io_domain_npes
1876  if (mpp_pe() .eq. pelist(i)) then
1877  exit
1878  else
1879  offset = offset + compressed_h_axis_size_per_rank(i)
1880  endif
1881  enddo
1882  endif
1883  do k = 1,size(compressed_h_z_cc_real_3d_field_data,3)
1884  do j = 1,size(compressed_h_z_cc_real_3d_field_data,2)
1885  do i = 1,size(compressed_h_z_cc_real_3d_field_data,1)
1886  compressed_h_z_cc_real_3d_field_data(i,j,k) = real_buffer_3d(i+offset,j,k)
1887  enddo
1888  enddo
1889  enddo
1890  deallocate(real_buffer_3d)
1891  rmax_error = maxval(abs(compressed_h_z_cc_real_3d_field_data - &
1892  compressed_h_z_cc_real_3d_field_data_ref(:,:,:,q)))
1893  read_in_chksum = mpp_chksum(compressed_h_z_cc_real_3d_field_data)
1894  ref_chksum = mpp_chksum(compressed_h_z_cc_real_3d_field_data_ref(:,:,:,q))
1895  if (rmax_error .ne. 0.0 .or. read_in_chksum .ne. ref_chksum) then
1896  write(output_unit,*)
1897  write(output_unit,*) "My rank: ",mpp_pe()
1898  write(output_unit,*) "Restart iteration: ",q
1899  write(output_unit,*) "Max compressed h, z, cc real 3D field error: ",rmax_error
1900  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
1901  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
1902  call mpp_error(fatal, &
1903  "test 1: compressed h, z, cc real 3D field data incorrect.")
1904  else
1905  if (mpp_pe() .eq. mpp_root_pe()) then
1906  write(output_unit,*)
1907  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
1908  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
1909  write(output_unit,*) "Compressed h, z, cc real 3D field data correct."
1910  endif
1911  endif
1912  call mpp_sync()
1913 
1914  !-------------------------------------------------------------------
1915  !Compressed c, cc, z real 3D field.
1916  call mpp_sync()
1917  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
1918  compressed_c_cc_z_real_3d_field_name, &
1919  field_dimension_sizes, &
1920  unstructured_domain, &
1921  field_found_in_file)
1922  if (.not. field_found_in_file) then
1923  call mpp_error(fatal, &
1924  "test 1: field "//trim(compressed_c_cc_z_real_3d_field_name) &
1925  //" was not found in file " &
1926  //trim(restart_file_name))
1927  endif
1928  allocate(real_buffer_3d(field_dimension_sizes(1), &
1929  field_dimension_sizes(2), &
1930  field_dimension_sizes(3)))
1931  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
1932  compressed_c_cc_z_real_3d_field_name, &
1933  real_buffer_3d, &
1934  unstructured_domain, &
1935  timelevel=q)
1936  if (mpp_pe() .eq. pelist(1)) then
1937  offset = 0
1938  else
1939  offset = 0
1940  do i = 1,io_domain_npes
1941  if (mpp_pe() .eq. pelist(i)) then
1942  exit
1943  else
1944  offset = offset + compressed_c_axis_size_per_rank(i)
1945  endif
1946  enddo
1947  endif
1948  do k = 1,size(compressed_c_cc_z_real_3d_field_data,3)
1949  do j = 1,size(compressed_c_cc_z_real_3d_field_data,2)
1950  do i = 1,size(compressed_c_cc_z_real_3d_field_data,1)
1951  compressed_c_cc_z_real_3d_field_data(i,j,k) = real_buffer_3d(i+offset,j,k)
1952  enddo
1953  enddo
1954  enddo
1955  deallocate(real_buffer_3d)
1956  rmax_error = maxval(abs(compressed_c_cc_z_real_3d_field_data - &
1957  compressed_c_cc_z_real_3d_field_data_ref(:,:,:,q)))
1958  read_in_chksum = mpp_chksum(compressed_c_cc_z_real_3d_field_data)
1959  ref_chksum = mpp_chksum(compressed_c_cc_z_real_3d_field_data_ref(:,:,:,q))
1960  if (rmax_error .ne. 0.0 .or. read_in_chksum .ne. ref_chksum) then
1961  write(output_unit,*)
1962  write(output_unit,*) "My rank: ",mpp_pe()
1963  write(output_unit,*) "Restart iteration: ",q
1964  write(output_unit,*) "Max compressed c, cc, z real 3D field error: ",rmax_error
1965  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
1966  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
1967  call mpp_error(fatal, &
1968  "test 1: compressed c, cc, z real 3D field data incorrect.")
1969  else
1970  if (mpp_pe() .eq. mpp_root_pe()) then
1971  write(output_unit,*)
1972  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
1973  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
1974  write(output_unit,*) "Compressed c, cc, z real 3D field data correct."
1975  endif
1976  endif
1977  call mpp_sync()
1978 
1979  !-------------------------------------------------------------------
1980  !Compressed h, cc, z real 3D field.
1981  call mpp_sync()
1982  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
1983  compressed_h_cc_z_real_3d_field_name, &
1984  field_dimension_sizes, &
1985  unstructured_domain, &
1986  field_found_in_file)
1987  if (.not. field_found_in_file) then
1988  call mpp_error(fatal, &
1989  "test 1: field "//trim(compressed_h_cc_z_real_3d_field_name) &
1990  //" was not found in file " &
1991  //trim(restart_file_name))
1992  endif
1993  allocate(real_buffer_3d(field_dimension_sizes(1), &
1994  field_dimension_sizes(2), &
1995  field_dimension_sizes(3)))
1996  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
1997  compressed_h_cc_z_real_3d_field_name, &
1998  real_buffer_3d, &
1999  unstructured_domain, &
2000  timelevel=q)
2001  if (mpp_pe() .eq. pelist(1)) then
2002  offset = 0
2003  else
2004  offset = 0
2005  do i = 1,io_domain_npes
2006  if (mpp_pe() .eq. pelist(i)) then
2007  exit
2008  else
2009  offset = offset + compressed_h_axis_size_per_rank(i)
2010  endif
2011  enddo
2012  endif
2013  do k = 1,size(compressed_h_cc_z_real_3d_field_data,3)
2014  do j = 1,size(compressed_h_cc_z_real_3d_field_data,2)
2015  do i = 1,size(compressed_h_cc_z_real_3d_field_data,1)
2016  compressed_h_cc_z_real_3d_field_data(i,j,k) = real_buffer_3d(i+offset,j,k)
2017  enddo
2018  enddo
2019  enddo
2020  deallocate(real_buffer_3d)
2021  rmax_error = maxval(abs(compressed_h_cc_z_real_3d_field_data - &
2022  compressed_h_cc_z_real_3d_field_data_ref(:,:,:,q)))
2023  read_in_chksum = mpp_chksum(compressed_h_cc_z_real_3d_field_data)
2024  ref_chksum = mpp_chksum(compressed_h_cc_z_real_3d_field_data_ref(:,:,:,q))
2025  if (rmax_error .ne. 0.0 .or. read_in_chksum .ne. ref_chksum) then
2026  write(output_unit,*)
2027  write(output_unit,*) "My rank: ",mpp_pe()
2028  write(output_unit,*) "Restart iteration: ",q
2029  write(output_unit,*) "Max compressed h, cc, z real 3D field error: ",rmax_error
2030  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
2031  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
2032  call mpp_error(fatal, &
2033  "test 1: compressed h, cc, z real 3D field data incorrect.")
2034  else
2035  if (mpp_pe() .eq. mpp_root_pe()) then
2036  write(output_unit,*)
2037  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
2038  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
2039  write(output_unit,*) "Compressed h, cc, z real 3D field data correct."
2040  endif
2041  endif
2042  call mpp_sync()
2043 
2044  !-------------------------------------------------------------------
2045  !Integer scalar field.
2046  call mpp_sync()
2047  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
2048  int_scalar_field_name, &
2049  field_dimension_sizes, &
2050  unstructured_domain, &
2051  field_found_in_file)
2052  if (.not. field_found_in_file) then
2053  call mpp_error(fatal, &
2054  "test 1: field "//trim(int_scalar_field_name) &
2055  //" was not found in file " &
2056  //trim(restart_file_name))
2057  endif
2058  allocate(int_buffer_1d(1))
2059  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
2060  int_scalar_field_name, &
2061  int_buffer_1d, &
2062  unstructured_domain, &
2063  timelevel=q)
2064  int_scalar_field_data = int_buffer_1d(1)
2065  deallocate(int_buffer_1d)
2066  imax_error = abs(int_scalar_field_data - &
2067  int_scalar_field_data_ref(q))
2068  if (imax_error .ne. 0) then
2069  write(output_unit,*)
2070  write(output_unit,*) "My rank: ",mpp_pe()
2071  write(output_unit,*) "Restart iteration: ",q
2072  write(output_unit,*) "Max integer scalar field error: ",imax_error
2073  call mpp_error(fatal, &
2074  "test 1: integer scalar field data incorrect.")
2075  else
2076  if (mpp_pe() .eq. mpp_root_pe()) then
2077  write(output_unit,*)
2078  write(output_unit,*) "Integer scalar field data correct."
2079  endif
2080  endif
2081  call mpp_sync()
2082 
2083  !-------------------------------------------------------------------
2084  !Compressed c integer 1D field.
2085  call mpp_sync()
2086  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
2087  compressed_c_int_1d_field_name, &
2088  field_dimension_sizes, &
2089  unstructured_domain, &
2090  field_found_in_file)
2091  if (.not. field_found_in_file) then
2092  call mpp_error(fatal, &
2093  "test 1: field "//trim(compressed_c_int_1d_field_name) &
2094  //" was not found in file " &
2095  //trim(restart_file_name))
2096  endif
2097  allocate(int_buffer_1d(field_dimension_sizes(1)))
2098  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
2099  compressed_c_int_1d_field_name, &
2100  int_buffer_1d, &
2101  unstructured_domain, &
2102  timelevel=q)
2103  if (mpp_pe() .eq. pelist(1)) then
2104  offset = 0
2105  else
2106  offset = 0
2107  do i = 1,io_domain_npes
2108  if (mpp_pe() .eq. pelist(i)) then
2109  exit
2110  else
2111  offset = offset + compressed_c_axis_size_per_rank(i)
2112  endif
2113  enddo
2114  endif
2115  do i = 1,compressed_c_axis_size
2116  compressed_c_int_1d_field_data(i) = int_buffer_1d(i+offset)
2117  enddo
2118  deallocate(int_buffer_1d)
2119  imax_error = maxval(abs(compressed_c_int_1d_field_data - &
2120  compressed_c_int_1d_field_data_ref(:,q)))
2121  read_in_chksum = mpp_chksum(compressed_c_int_1d_field_data)
2122  ref_chksum = mpp_chksum(compressed_c_int_1d_field_data_ref(:,q))
2123  if (imax_error .ne. 0 .or. read_in_chksum .ne. ref_chksum) then
2124  write(output_unit,*)
2125  write(output_unit,*) "My rank: ",mpp_pe()
2126  write(output_unit,*) "Restart iteration: ",q
2127  write(output_unit,*) "Max compressed c integer 1D field error: ",imax_error
2128  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
2129  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
2130  call mpp_error(fatal, &
2131  "test 1: compressed c integer 1D field data incorrect.")
2132  else
2133  if (mpp_pe() .eq. mpp_root_pe()) then
2134  write(output_unit,*)
2135  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
2136  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
2137  write(output_unit,*) "Compressed c integer 1D field data correct."
2138  endif
2139  endif
2140  call mpp_sync()
2141 
2142  !-------------------------------------------------------------------
2143  !Compressed h integer 1D field.
2144  call mpp_sync()
2145  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
2146  compressed_h_int_1d_field_name, &
2147  field_dimension_sizes, &
2148  unstructured_domain, &
2149  field_found_in_file)
2150  if (.not. field_found_in_file) then
2151  call mpp_error(fatal, &
2152  "test 1: field "//trim(compressed_h_int_1d_field_name) &
2153  //" was not found in file " &
2154  //trim(restart_file_name))
2155  endif
2156  allocate(int_buffer_1d(field_dimension_sizes(1)))
2157  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
2158  compressed_h_int_1d_field_name, &
2159  int_buffer_1d, &
2160  unstructured_domain, &
2161  timelevel=q)
2162  if (mpp_pe() .eq. pelist(1)) then
2163  offset = 0
2164  else
2165  offset = 0
2166  do i = 1,io_domain_npes
2167  if (mpp_pe() .eq. pelist(i)) then
2168  exit
2169  else
2170  offset = offset + compressed_h_axis_size_per_rank(i)
2171  endif
2172  enddo
2173  endif
2174  do i = 1,compressed_h_axis_size
2175  compressed_h_int_1d_field_data(i) = int_buffer_1d(i+offset)
2176  enddo
2177  deallocate(int_buffer_1d)
2178  imax_error = maxval(abs(compressed_h_int_1d_field_data - &
2179  compressed_h_int_1d_field_data_ref(:,q)))
2180  read_in_chksum = mpp_chksum(compressed_h_int_1d_field_data)
2181  ref_chksum = mpp_chksum(compressed_h_int_1d_field_data_ref(:,q))
2182  if (imax_error .ne. 0 .or. read_in_chksum .ne. ref_chksum) then
2183  write(output_unit,*)
2184  write(output_unit,*) "My rank: ",mpp_pe()
2185  write(output_unit,*) "Restart iteration: ",q
2186  write(output_unit,*) "Max compressed h integer 1D field error: ",imax_error
2187  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
2188  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
2189  call mpp_error(fatal, &
2190  "test 1: compressed h integer 1D field data incorrect.")
2191  else
2192  if (mpp_pe() .eq. mpp_root_pe()) then
2193  write(output_unit,*)
2194  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
2195  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
2196  write(output_unit,*) "Compressed h integer 1D field data correct."
2197  endif
2198  endif
2199  call mpp_sync()
2200 
2201  !-------------------------------------------------------------------
2202  !Compressed c, z integer 2D field.
2203  call mpp_sync()
2204  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
2205  compressed_c_z_int_2d_field_name, &
2206  field_dimension_sizes, &
2207  unstructured_domain, &
2208  field_found_in_file)
2209  if (.not. field_found_in_file) then
2210  call mpp_error(fatal, &
2211  "test 1: field "//trim(compressed_c_z_int_2d_field_name) &
2212  //" was not found in file " &
2213  //trim(restart_file_name))
2214  endif
2215  allocate(int_buffer_2d(field_dimension_sizes(1), &
2216  field_dimension_sizes(2)))
2217  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
2218  compressed_c_z_int_2d_field_name, &
2219  int_buffer_2d, &
2220  unstructured_domain, &
2221  timelevel=q)
2222  if (mpp_pe() .eq. pelist(1)) then
2223  offset = 0
2224  else
2225  offset = 0
2226  do i = 1,io_domain_npes
2227  if (mpp_pe() .eq. pelist(i)) then
2228  exit
2229  else
2230  offset = offset + compressed_c_axis_size_per_rank(i)
2231  endif
2232  enddo
2233  endif
2234  do j = 1,size(compressed_c_z_int_2d_field_data,2)
2235  do i = 1,size(compressed_c_z_int_2d_field_data,1)
2236  compressed_c_z_int_2d_field_data(i,j) = int_buffer_2d(i+offset,j)
2237  enddo
2238  enddo
2239  deallocate(int_buffer_2d)
2240  imax_error = maxval(abs(compressed_c_z_int_2d_field_data - &
2241  compressed_c_z_int_2d_field_data_ref(:,:,q)))
2242  read_in_chksum = mpp_chksum(compressed_c_z_int_2d_field_data)
2243  ref_chksum = mpp_chksum(compressed_c_z_int_2d_field_data_ref(:,:,q))
2244  if (imax_error .ne. 0 .or. read_in_chksum .ne. ref_chksum) then
2245  write(output_unit,*)
2246  write(output_unit,*) "My rank: ",mpp_pe()
2247  write(output_unit,*) "Restart iteration: ",q
2248  write(output_unit,*) "Max compressed c, z integer 2D field error: ",imax_error
2249  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
2250  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
2251  call mpp_error(fatal, &
2252  "test 1: compressed c, z integer 2D field data incorrect.")
2253  else
2254  if (mpp_pe() .eq. mpp_root_pe()) then
2255  write(output_unit,*)
2256  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
2257  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
2258  write(output_unit,*) "Compressed c, z integer 2D field data correct."
2259  endif
2260  endif
2261  call mpp_sync()
2262 
2263  !-------------------------------------------------------------------
2264  !Compressed h, z integer 2D field.
2265  call mpp_sync()
2266  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
2267  compressed_h_z_int_2d_field_name, &
2268  field_dimension_sizes, &
2269  unstructured_domain, &
2270  field_found_in_file)
2271  if (.not. field_found_in_file) then
2272  call mpp_error(fatal, &
2273  "test 1: field "//trim(compressed_h_z_int_2d_field_name) &
2274  //" was not found in file " &
2275  //trim(restart_file_name))
2276  endif
2277  allocate(int_buffer_2d(field_dimension_sizes(1), &
2278  field_dimension_sizes(2)))
2279  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
2280  compressed_h_z_int_2d_field_name, &
2281  int_buffer_2d, &
2282  unstructured_domain, &
2283  timelevel=q)
2284  if (mpp_pe() .eq. pelist(1)) then
2285  offset = 0
2286  else
2287  offset = 0
2288  do i = 1,io_domain_npes
2289  if (mpp_pe() .eq. pelist(i)) then
2290  exit
2291  else
2292  offset = offset + compressed_h_axis_size_per_rank(i)
2293  endif
2294  enddo
2295  endif
2296  do j = 1,size(compressed_h_z_int_2d_field_data,2)
2297  do i = 1,size(compressed_h_z_int_2d_field_data,1)
2298  compressed_h_z_int_2d_field_data(i,j) = int_buffer_2d(i+offset,j)
2299  enddo
2300  enddo
2301  deallocate(int_buffer_2d)
2302  imax_error = maxval(abs(compressed_h_z_int_2d_field_data - &
2303  compressed_h_z_int_2d_field_data_ref(:,:,q)))
2304  read_in_chksum = mpp_chksum(compressed_h_z_int_2d_field_data)
2305  ref_chksum = mpp_chksum(compressed_h_z_int_2d_field_data_ref(:,:,q))
2306  if (imax_error .ne. 0 .or. read_in_chksum .ne. ref_chksum) then
2307  write(output_unit,*)
2308  write(output_unit,*) "My rank: ",mpp_pe()
2309  write(output_unit,*) "Restart iteration: ",q
2310  write(output_unit,*) "Max compressed h, z integer 2D field error: ",imax_error
2311  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
2312  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
2313  call mpp_error(fatal, &
2314  "test 1: compressed h, z integer 2D field data incorrect.")
2315  else
2316  if (mpp_pe() .eq. mpp_root_pe()) then
2317  write(output_unit,*)
2318  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
2319  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
2320  write(output_unit,*) "Compressed h, z integer 2D field data correct."
2321  endif
2322  endif
2323  call mpp_sync()
2324 
2325  !-------------------------------------------------------------------
2326  !Compressed c, cc integer 2D field.
2327  call mpp_sync()
2328  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
2329  compressed_c_cc_int_2d_field_name, &
2330  field_dimension_sizes, &
2331  unstructured_domain, &
2332  field_found_in_file)
2333  if (.not. field_found_in_file) then
2334  call mpp_error(fatal, &
2335  "test 1: field "//trim(compressed_c_cc_int_2d_field_name) &
2336  //" was not found in file " &
2337  //trim(restart_file_name))
2338  endif
2339  allocate(int_buffer_2d(field_dimension_sizes(1), &
2340  field_dimension_sizes(2)))
2341  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
2342  compressed_c_cc_int_2d_field_name, &
2343  int_buffer_2d, &
2344  unstructured_domain, &
2345  timelevel=q)
2346  if (mpp_pe() .eq. pelist(1)) then
2347  offset = 0
2348  else
2349  offset = 0
2350  do i = 1,io_domain_npes
2351  if (mpp_pe() .eq. pelist(i)) then
2352  exit
2353  else
2354  offset = offset + compressed_c_axis_size_per_rank(i)
2355  endif
2356  enddo
2357  endif
2358  do j = 1,size(compressed_c_cc_int_2d_field_data,2)
2359  do i = 1,size(compressed_c_cc_int_2d_field_data,1)
2360  compressed_c_cc_int_2d_field_data(i,j) = int_buffer_2d(i+offset,j)
2361  enddo
2362  enddo
2363  deallocate(int_buffer_2d)
2364  imax_error = maxval(abs(compressed_c_cc_int_2d_field_data - &
2365  compressed_c_cc_int_2d_field_data_ref(:,:,q)))
2366  read_in_chksum = mpp_chksum(compressed_c_cc_int_2d_field_data)
2367  ref_chksum = mpp_chksum(compressed_c_cc_int_2d_field_data_ref(:,:,q))
2368  if (imax_error .ne. 0 .or. read_in_chksum .ne. ref_chksum) then
2369  write(output_unit,*)
2370  write(output_unit,*) "My rank: ",mpp_pe()
2371  write(output_unit,*) "Restart iteration: ",q
2372  write(output_unit,*) "Max compressed c, cc integer 2D field error: ",imax_error
2373  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
2374  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
2375  call mpp_error(fatal, &
2376  "test 1: compressed c, z integer 2D field data incorrect.")
2377  else
2378  if (mpp_pe() .eq. mpp_root_pe()) then
2379  write(output_unit,*)
2380  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
2381  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
2382  write(output_unit,*) "Compressed c, cc integer 2D field data correct."
2383  endif
2384  endif
2385  call mpp_sync()
2386 
2387  !-------------------------------------------------------------------
2388  !Compressed h, cc integer 2D field.
2389  call mpp_sync()
2390  call fms_io_unstructured_get_field_size("RESTART/"//trim(restart_file_name), &
2391  compressed_h_cc_int_2d_field_name, &
2392  field_dimension_sizes, &
2393  unstructured_domain, &
2394  field_found_in_file)
2395  if (.not. field_found_in_file) then
2396  call mpp_error(fatal, &
2397  "test 1: field "//trim(compressed_h_cc_int_2d_field_name) &
2398  //" was not found in file " &
2399  //trim(restart_file_name))
2400  endif
2401  allocate(int_buffer_2d(field_dimension_sizes(1), &
2402  field_dimension_sizes(2)))
2403  call fms_io_unstructured_read("RESTART/"//trim(restart_file_name), &
2404  compressed_h_cc_int_2d_field_name, &
2405  int_buffer_2d, &
2406  unstructured_domain, &
2407  timelevel=q)
2408  if (mpp_pe() .eq. pelist(1)) then
2409  offset = 0
2410  else
2411  offset = 0
2412  do i = 1,io_domain_npes
2413  if (mpp_pe() .eq. pelist(i)) then
2414  exit
2415  else
2416  offset = offset + compressed_h_axis_size_per_rank(i)
2417  endif
2418  enddo
2419  endif
2420  do j = 1,size(compressed_h_cc_int_2d_field_data,2)
2421  do i = 1,size(compressed_h_cc_int_2d_field_data,1)
2422  compressed_h_cc_int_2d_field_data(i,j) = int_buffer_2d(i+offset,j)
2423  enddo
2424  enddo
2425  deallocate(int_buffer_2d)
2426  imax_error = maxval(abs(compressed_h_cc_int_2d_field_data - &
2427  compressed_h_cc_int_2d_field_data_ref(:,:,q)))
2428  read_in_chksum = mpp_chksum(compressed_h_cc_int_2d_field_data)
2429  ref_chksum = mpp_chksum(compressed_h_cc_int_2d_field_data_ref(:,:,q))
2430  if (imax_error .ne. 0 .or. read_in_chksum .ne. ref_chksum) then
2431  write(output_unit,*)
2432  write(output_unit,*) "My rank: ",mpp_pe()
2433  write(output_unit,*) "Restart iteration: ",q
2434  write(output_unit,*) "Max compressed h, cc integer 2D field error: ",imax_error
2435  write(output_unit,'(a,z16)') "Read in checksum: ",read_in_chksum
2436  write(output_unit,'(a,z16)') "Reference checksum: ",ref_chksum
2437  call mpp_error(fatal, &
2438  "test 1: compressed h, z integer 2D field data incorrect.")
2439  else
2440  if (mpp_pe() .eq. mpp_root_pe()) then
2441  write(output_unit,*)
2442  write(output_unit,'(a,z16)') "Read-in data check-sum: ",read_in_chksum
2443  write(output_unit,'(a,z16)') "Reference data check-sum:",ref_chksum
2444  write(output_unit,*) "Compressed h, cc integer 2D field data correct."
2445  endif
2446  endif
2447  call mpp_sync()
2448  enddo
2449 
2450  !Close the file.
2451  call fms_io_unstructured_file_unit("RESTART/"//trim(restart_file_name), &
2452  funit, &
2453  unstructured_domain)
2454  call mpp_close(funit)
2455 
2456  !Deallocate local allocatables.
2457  if (allocated(pelist)) then
2458  deallocate(pelist)
2459  endif
2460  if (allocated(compressed_c_axis_size_per_rank)) then
2461  deallocate(compressed_c_axis_size_per_rank)
2462  endif
2463  if (allocated(compressed_h_axis_size_per_rank)) then
2464  deallocate(compressed_h_axis_size_per_rank)
2465  endif
2466  if (allocated(x_axis_data)) then
2467  deallocate(x_axis_data)
2468  endif
2469  if (allocated(y_axis_data)) then
2470  deallocate(y_axis_data)
2471  endif
2472  if (allocated(z_axis_data)) then
2473  deallocate(z_axis_data)
2474  endif
2475  if (allocated(cc_axis_data)) then
2476  deallocate(cc_axis_data)
2477  endif
2478  if (allocated(compressed_c_axis_data)) then
2479  deallocate(compressed_c_axis_data)
2480  endif
2481  if (allocated(compressed_h_axis_data)) then
2482  deallocate(compressed_h_axis_data)
2483  endif
2484  if (allocated(compressed_c_real_1d_field_data)) then
2485  deallocate(compressed_c_real_1d_field_data)
2486  endif
2487  if (allocated(compressed_h_real_1d_field_data)) then
2488  deallocate(compressed_h_real_1d_field_data)
2489  endif
2490  if (allocated(compressed_c_z_real_2d_field_data)) then
2491  deallocate(compressed_c_z_real_2d_field_data)
2492  endif
2493  if (allocated(compressed_h_z_real_2d_field_data)) then
2494  deallocate(compressed_h_z_real_2d_field_data)
2495  endif
2496  if (allocated(compressed_c_cc_real_2d_field_data)) then
2497  deallocate(compressed_c_cc_real_2d_field_data)
2498  endif
2499  if (allocated(compressed_h_cc_real_2d_field_data)) then
2500  deallocate(compressed_h_cc_real_2d_field_data)
2501  endif
2502  if (allocated(compressed_c_z_cc_real_3d_field_data)) then
2503  deallocate(compressed_c_z_cc_real_3d_field_data)
2504  endif
2505  if (allocated(compressed_h_z_cc_real_3d_field_data)) then
2506  deallocate(compressed_h_z_cc_real_3d_field_data)
2507  endif
2508  if (allocated(compressed_c_cc_z_real_3d_field_data)) then
2509  deallocate(compressed_c_cc_z_real_3d_field_data)
2510  endif
2511  if (allocated(compressed_h_cc_z_real_3d_field_data)) then
2512  deallocate(compressed_h_cc_z_real_3d_field_data)
2513  endif
2514  if (allocated(compressed_c_int_1d_field_data)) then
2515  deallocate(compressed_c_int_1d_field_data)
2516  endif
2517  if (allocated(compressed_h_int_1d_field_data)) then
2518  deallocate(compressed_h_int_1d_field_data)
2519  endif
2520  if (allocated(compressed_c_z_int_2d_field_data)) then
2521  deallocate(compressed_c_z_int_2d_field_data)
2522  endif
2523  if (allocated(compressed_h_z_int_2d_field_data)) then
2524  deallocate(compressed_h_z_int_2d_field_data)
2525  endif
2526  if (allocated(compressed_c_cc_int_2d_field_data)) then
2527  deallocate(compressed_c_cc_int_2d_field_data)
2528  endif
2529  if (allocated(compressed_h_cc_int_2d_field_data)) then
2530  deallocate(compressed_h_cc_int_2d_field_data)
2531  endif
2532  if (allocated(real_scalar_field_data_ref)) then
2533  deallocate(real_scalar_field_data_ref)
2534  endif
2535  if (allocated(compressed_c_real_1d_field_data_ref)) then
2536  deallocate(compressed_c_real_1d_field_data_ref)
2537  endif
2538  if (allocated(compressed_h_real_1d_field_data_ref)) then
2539  deallocate(compressed_h_real_1d_field_data_ref)
2540  endif
2541  if (allocated(compressed_c_z_real_2d_field_data_ref)) then
2542  deallocate(compressed_c_z_real_2d_field_data_ref)
2543  endif
2544  if (allocated(compressed_h_z_real_2d_field_data_ref)) then
2545  deallocate(compressed_h_z_real_2d_field_data_ref)
2546  endif
2547  if (allocated(compressed_c_cc_real_2d_field_data_ref)) then
2548  deallocate(compressed_c_cc_real_2d_field_data_ref)
2549  endif
2550  if (allocated(compressed_h_cc_real_2d_field_data_ref)) then
2551  deallocate(compressed_h_cc_real_2d_field_data_ref)
2552  endif
2553  if (allocated(compressed_c_z_cc_real_3d_field_data_ref)) then
2554  deallocate(compressed_c_z_cc_real_3d_field_data_ref)
2555  endif
2556  if (allocated(compressed_h_z_cc_real_3d_field_data_ref)) then
2557  deallocate(compressed_h_z_cc_real_3d_field_data_ref)
2558  endif
2559  if (allocated(compressed_c_cc_z_real_3d_field_data_ref)) then
2560  deallocate(compressed_c_cc_z_real_3d_field_data_ref)
2561  endif
2562  if (allocated(compressed_h_cc_z_real_3d_field_data_ref)) then
2563  deallocate(compressed_h_cc_z_real_3d_field_data_ref)
2564  endif
2565  if (allocated(int_scalar_field_data_ref)) then
2566  deallocate(int_scalar_field_data_ref)
2567  endif
2568  if (allocated(compressed_c_int_1d_field_data_ref)) then
2569  deallocate(compressed_c_int_1d_field_data_ref)
2570  endif
2571  if (allocated(compressed_h_int_1d_field_data_ref)) then
2572  deallocate(compressed_h_int_1d_field_data_ref)
2573  endif
2574  if (allocated(compressed_c_z_int_2d_field_data_ref)) then
2575  deallocate(compressed_c_z_int_2d_field_data_ref)
2576  endif
2577  if (allocated(compressed_h_z_int_2d_field_data_ref)) then
2578  deallocate(compressed_h_z_int_2d_field_data_ref)
2579  endif
2580  if (allocated(compressed_c_cc_int_2d_field_data_ref)) then
2581  deallocate(compressed_c_cc_int_2d_field_data_ref)
2582  endif
2583  if (allocated(compressed_h_cc_int_2d_field_data_ref)) then
2584  deallocate(compressed_h_cc_int_2d_field_data_ref)
2585  endif
2586 
2587  !Print out a message that the test is done.
2588  call mpp_sync()
2589  if (mpp_pe() .eq. mpp_root_pe()) then
2590  write(output_unit,*) "Test 1 body complete."
2591  write(output_unit,*)
2592  endif
2593 
2594  return
2595  end subroutine test_1
2596 
2597  !--------------------------------------------------------------------------
2598 
2599 end program test_unstructured_fms_io
2600 #endif
2601 
fms_io_mod::fms_io_unstructured_register_restart_field
Definition: fms_io.F90:573
mpp_parameter_mod
Definition: mpp_parameter.F90:19
mpp_io_mod
Definition: mpp_io.F90:327
fms_io_mod::restart_file_type
Definition: fms_io.F90:295
mpp_parameter_mod::note
integer, parameter, public note
Definition: mpp_parameter.F90:68
ioda_obsdb_mod::check
subroutine check(action, status)
Definition: ioda_obsdb_mod.F90:601
mpp_parameter_mod::mpp_clock_sync
integer, parameter, public mpp_clock_sync
Definition: mpp_parameter.F90:73
fms_io_mod
Definition: fms_io.F90:20
fms_io_mod::fms_io_unstructured_read
Definition: fms_io.F90:587
mpp_mod::mpp_chksum
Definition: mpp.F90:1232
mpp_mod
Definition: mpp.F90:39
fms_io_mod::ccidx
integer(int_kind), parameter, public ccidx
Definition: fms_io.F90:170
mpp_domains_mod
Definition: mpp_domains.F90:128
mpp_domains_mod::mpp_deallocate_domain
Definition: mpp_domains.F90:928
mpp_mod::input_nml_file
character(len=input_str_length), dimension(:), allocatable, target, public input_nml_file
Definition: mpp.F90:1378
fms_io_mod::fms_io_unstructured_register_restart_axis
Definition: fms_io.F90:567
mpp_parameter_mod::mpp_debug
integer, parameter, public mpp_debug
Definition: mpp_parameter.F90:66
mpp_domains_mod::domainug
Definition: mpp_domains.F90:289
mpp_domains_mod::domain2d
Definition: mpp_domains.F90:378
mpp_mod::mpp_recv
Definition: mpp.F90:975
fms_io_mod::fms_io_init
subroutine, public fms_io_init()
Definition: fms_io.F90:638
mpp_mod::mpp_send
Definition: mpp.F90:1033
fms_io_mod::cidx
integer(int_kind), parameter, public cidx
Definition: fms_io.F90:165
mpp_parameter_mod::event_recv
integer, parameter, public event_recv
Definition: mpp_parameter.F90:70
fms_io_mod::fms_io_exit
subroutine, public fms_io_exit()
Definition: fms_io.F90:750
mpp_mod::mpp_error
Definition: mpp.F90:402
mpp_parameter_mod::fatal
integer, parameter, public fatal
Definition: mpp_parameter.F90:68
fms_io_mod::hidx
integer(int_kind), parameter, public hidx
Definition: fms_io.F90:167
fms_io_mod::zidx
integer(int_kind), parameter, public zidx
Definition: fms_io.F90:166
mpp_parameter_mod::comm_tag_1
integer, parameter, public comm_tag_1
Definition: mpp_parameter.F90:138