FMS  2024.03
Flexible Modeling System
mpp_io_unstructured_read.inc
1 !***********************************************************************
2 !* GNU Lesser General Public License
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* FMS is free software: you can redistribute it and/or modify it under
7 !* the terms of the GNU Lesser General Public License as published by
8 !* the Free Software Foundation, either version 3 of the License, or (at
9 !* your option) any later version.
10 !*
11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 !* for more details.
15 !*
16 !* You should have received a copy of the GNU Lesser General Public
17 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18 !***********************************************************************
19 
20 !> @file
21 !> @brief Parallel file reads for unstructured grids, used in @ref mpp_io_mod
22 
23 !> @addtogroup mpp_io_mod
24 !> @{
25 
26 !>Read in one-dimensional data for a field associated with an unstructured
27 !!mpp domain.
28 subroutine mpp_io_unstructured_read_r8_1d(funit, &
29  field, &
30  domain, &
31  fdata, &
32  tindex, &
33  start, &
34  nread, &
35  threading)
36 
37  !Inputs/outputs
38  integer(i4_kind),intent(in) :: funit !<A file unit returned by mpp_open.
39  type(fieldtype),intent(in) :: field !<A field whose data will be read in from the file.
40  type(domainug),intent(in) :: domain !<An unstructured mpp domain.
41  real(KIND=r8_kind),dimension(:),intent(inout) :: fdata !<The data that will be read in from the file.
42  integer(i4_kind),intent(in),optional :: tindex !<Time level index for a NetCDF file.
43  integer(i4_kind),dimension(:),intent(in),optional :: start !<Corner indices for a NetCDF file.
44  integer(i4_kind),dimension(:),intent(in),optional :: nread !<Edge lengths for a NetCDF file.
45  integer(i4_kind),intent(in),optional :: threading !<Flag telling whether one or multiple
46  !! ranks will read the file.
47 
48  !Local variables
49  integer(i4_kind) :: threading_flag !<Flag telling whether one or multiple
50  !! ranks will read the file. This defaults to MPP_SINGLE.
51  type(domainug),pointer :: io_domain !<Pointer to the unstructured I/O domain.
52  integer(i4_kind) :: io_domain_npes !<The total number of ranks in an I/O domain pelist.
53  integer(i4_kind),dimension(:),allocatable :: pelist !<A pelist.
54  integer(i4_kind) :: p !<Loop variable.
55  logical(l4_kind) :: compute_chksum !<Flag telling whether or not a check-sum
56  !! of the read-in data is calculated.
57  integer(i8_kind) :: chk !<Calculated check-sum for the read in data.
58 
59  !Start the mpp timer.
60  !mpp_read_clock is a module variable.
61  call mpp_clock_begin(mpp_read_clock)
62 
63  !Make sure that the module is initialized.
64  if (.not. module_is_initialized) then
65  call mpp_error(fatal, &
66  "mpp_io_unstructured_read_r_1D:" &
67  //" you must must first call mpp_io_init.")
68  endif
69 
70  !Make sure that another NetCDF file is not currently using the inputted
71  !file unit.
72  if (.not. mpp_file(funit)%valid) then
73  call mpp_error(fatal, &
74  "mpp_io_unstructured_read_r_1D:" &
75  //" the inputted file unit is already in use.")
76  endif
77 
78  !If the data array has more than zero elements, then read in the data.
79  if (size(fdata) .gt. 0) then
80 
81  !Initialize the data to zero.
82  fdata = 0
83 
84  !Get the value for the "threading" flag.
85  threading_flag = mpp_single
86  if (present(threading)) then
87  threading_flag = threading
88  endif
89 
90  !Read in the data.
91  if (threading_flag .eq. mpp_multi) then
92 
93  !For the multi-rank case, directly read in the data.
94  call read_record_r8(funit, &
95  field, &
96  size(fdata), &
97  fdata, &
98  tindex, &
99  start_in=start, &
100  axsiz_in=nread)
101  elseif (threading_flag .eq. mpp_single) then
102 
103  !For the single-rank, first point to the I/O domain associated with
104  !the inputted unstructured mpp domain.
105  io_domain => null()
106  io_domain => mpp_get_ug_io_domain(domain)
107 
108  !Get the pelist associated with the I/O domain.
109  io_domain_npes = mpp_get_ug_domain_npes(io_domain)
110  allocate(pelist(io_domain_npes))
111  call mpp_get_ug_domain_pelist(io_domain, &
112  pelist)
113  io_domain => null()
114 
115  !Let only the root rank of the pelist read in the data.
116  if (mpp_pe() .eq. pelist(1)) then
117  call read_record_r8(funit, &
118  field, &
119  size(fdata), &
120  fdata, &
121  tindex, &
122  start_in=start, &
123  axsiz_in=nread)
124  endif
125 
126  !Send the data from the root rank to the rest of the ranks on the
127  !pelist.
128  if (mpp_pe() .eq. pelist(1)) then
129  do p = 2,io_domain_npes
130  call mpp_send(fdata, &
131  size(fdata), &
132  pelist(p), &
133  tag=comm_tag_1)
134  enddo
135  call mpp_sync_self()
136  else
137  call mpp_recv(fdata, &
138  size(fdata), &
139  pelist(1), &
140  block=.false., &
141  tag=comm_tag_1)
142  call mpp_sync_self(check=event_recv)
143  endif
144  deallocate(pelist)
145  else
146  call mpp_error(fatal, &
147  "mpp_io_unstructured_read_r_1D:" &
148  //" threading should be MPP_SINGLE or MPP_MULTI")
149  endif
150  endif
151 
152  !Decided whether or not to compute a check-sum of the read-in data. The
153  !check-sum is calculated if the inputted field's checksum values are not
154  !equal to the default checksum value for a field.
155  compute_chksum = .false.
156  if (any(field%checksum .ne. default_field%checksum)) then
157  compute_chksum = .true.
158  endif
159 
160  !If necessary, compute a check-sum of the read-in data.
161  if (compute_chksum) then
162 #ifdef use_netCDF
163  if (field%type .eq. nf_int) then
164  if (field%fill .eq. mpp_fill_double .or. field%fill .eq. &
165  real(MPP_FILL_INT)) then
166  chk = mpp_chksum(ceiling(fdata), &
167  mask_val=mpp_fill_int)
168  else
169  call mpp_error(note, &
170  "mpp_io_unstructured_read_r_1D:" &
171  //" int field "//trim(field%name) &
172  //" found fill. Icebergs, or code using" &
173  //" defaults can safely ignore." &
174  //" If manually overriding compressed" &
175  //" restart fills, confirm this is what you" &
176  //" want.")
177  chk = mpp_chksum(ceiling(fdata), &
178  mask_val=field%fill)
179  endif
180  else
181  chk = mpp_chksum(fdata, mask_val=real(field%fill,kind(fdata)))
182  endif
183 #endif
184  !Print out the computed check-sum for the field. This feature is
185  !currently turned off. Uncomment the following lines to turn it
186  !back on.
187 ! if (mpp_pe() .eq. mpp_root_pe()) then
188 ! write(stdout(),'(A,Z16)') "mpp_read_compressed_2d chksum: " &
189 ! //trim(field%name)//" = ",chk
190 ! if (mod(chk,field%checksum(1)) .ne. 0) then
191 ! write(stdout(),'(A,Z16)') "File stored checksum: " &
192 ! //trim(field%name)//" = ", &
193 ! field%checksum(1)
194 ! call mpp_error(NOTE, &
195 ! "mpp_io_unstructured_read_r_1D: " &
196 ! //trim(field%name)//" failed!")
197 ! endif
198 ! endif
199  endif
200 
201  !Stop the mpp timer.
202  call mpp_clock_end(mpp_read_clock)
203 
204  return
205 end subroutine mpp_io_unstructured_read_r8_1d
206 
207 !------------------------------------------------------------------------------
208 !>Read in two-dimensional data for a field associated with an unstructured
209 !!mpp domain.
210 subroutine mpp_io_unstructured_read_r8_2d(funit, &
211  field, &
212  domain, &
213  fdata, &
214  tindex, &
215  start, &
216  nread, &
217  threading)
218 
219  !Inputs/outputs
220  integer(i4_kind),intent(in) :: funit !<A file unit returned by mpp_open.
221  type(fieldtype),intent(in) :: field !<A field whose data will be read in from the file.
222  type(domainug),intent(in) :: domain !<An unstructured mpp domain.
223  real(KIND=r8_kind),dimension(:,:),intent(inout) :: fdata !<The data that will be read in from the file.
224  integer(i4_kind),intent(in),optional :: tindex !<Time level index for a NetCDF file.
225  integer(i4_kind),dimension(:),intent(in),optional :: start !<Corner indices for a NetCDF file.
226  integer(i4_kind),dimension(:),intent(in),optional :: nread !<Edge lengths for a NetCDF file.
227  integer(i4_kind),intent(in),optional :: threading !<Flag telling whether one or multiple
228  !! ranks will read the file.
229 
230  !Local variables
231  integer(i4_kind) :: threading_flag !<Flag telling whether one or multiple
232  !! ranks will read the file. This defaults to MPP_SINGLE.
233  type(domainug),pointer :: io_domain !<Pointer to the unstructured I/O domain.
234  integer(i4_kind) :: io_domain_npes !<The total number of ranks in an I/O domain pelist.
235  integer(i4_kind),dimension(:),allocatable :: pelist !<A pelist.
236  integer(i4_kind) :: p !<Loop variable.
237  logical(l4_kind) :: compute_chksum !<Flag telling whether or not a check-sum
238  !! of the read-in data is calculated.
239  integer(i8_kind) :: chk !<Calculated check-sum for the read in data.
240 
241  !Start the mpp timer.
242  !mpp_read_clock is a module variable.
243  call mpp_clock_begin(mpp_read_clock)
244 
245  !Make sure that the module is initialized.
246  if (.not. module_is_initialized) then
247  call mpp_error(fatal, &
248  "mpp_io_unstructured_read_r_2D:" &
249  //" you must must first call mpp_io_init.")
250  endif
251 
252  !Make sure that another NetCDF file is not currently using the inputted
253  !file unit.
254  if (.not. mpp_file(funit)%valid) then
255  call mpp_error(fatal, &
256  "mpp_io_unstructured_read_r_2D:" &
257  //" the inputted file unit is already in use.")
258  endif
259 
260  !If the data array has more than zero elements, then read in the data.
261  if (size(fdata) .gt. 0) then
262 
263  !Initialize the data to zero.
264  fdata = 0
265 
266  !Get the value for the "threading" flag.
267  threading_flag = mpp_single
268  if (present(threading)) then
269  threading_flag = threading
270  endif
271 
272  !Read in the data.
273  if (threading_flag .eq. mpp_multi) then
274 
275  !For the multi-rank case, directly read in the data.
276  call read_record_r8(funit, &
277  field, &
278  size(fdata), &
279  fdata, &
280  tindex, &
281  start_in=start, &
282  axsiz_in=nread)
283  elseif (threading_flag .eq. mpp_single) then
284 
285  !For the single-rank, first point to the I/O domain associated with
286  !the inputted unstructured mpp domain.
287  io_domain => null()
288  io_domain => mpp_get_ug_io_domain(domain)
289 
290  !Get the pelist associated with the I/O domain.
291  io_domain_npes = mpp_get_ug_domain_npes(io_domain)
292  allocate(pelist(io_domain_npes))
293  call mpp_get_ug_domain_pelist(io_domain, &
294  pelist)
295  io_domain => null()
296 
297  !Let only the root rank of the pelist read in the data.
298  if (mpp_pe() .eq. pelist(1)) then
299  call read_record_r8(funit, &
300  field, &
301  size(fdata), &
302  fdata, &
303  tindex, &
304  start_in=start, &
305  axsiz_in=nread)
306  endif
307 
308  !Send the data from the root rank to the rest of the ranks on the
309  !pelist.
310  if (mpp_pe() .eq. pelist(1)) then
311  do p = 2,io_domain_npes
312  call mpp_send(fdata, &
313  size(fdata), &
314  pelist(p), &
315  tag=comm_tag_1)
316  enddo
317  call mpp_sync_self()
318  else
319  call mpp_recv(fdata, &
320  size(fdata), &
321  pelist(1), &
322  block=.false., &
323  tag=comm_tag_1)
324  call mpp_sync_self(check=event_recv)
325  endif
326  deallocate(pelist)
327  else
328  call mpp_error(fatal, &
329  "mpp_io_unstructured_read_r_2D:" &
330  //" threading should be MPP_SINGLE or MPP_MULTI")
331  endif
332  endif
333 
334  !Decided whether or not to compute a check-sum of the read-in data. The
335  !check-sum is calculated if the inputted field's checksum values are not
336  !equal to the default checksum value for a field.
337  compute_chksum = .false.
338  if (any(field%checksum .ne. default_field%checksum)) then
339  compute_chksum = .true.
340  endif
341 
342  !If necessary, compute a check-sum of the read-in data.
343  if (compute_chksum) then
344 #ifdef use_netCDF
345  if (field%type .eq. nf_int) then
346  if (field%fill .eq. mpp_fill_double .or. field%fill .eq. &
347  real(MPP_FILL_INT)) then
348  chk = mpp_chksum(ceiling(fdata), &
349  mask_val=mpp_fill_int)
350  else
351  call mpp_error(note, &
352  "mpp_io_unstructured_read_r_2D:" &
353  //" int field "//trim(field%name) &
354  //" found fill. Icebergs, or code using" &
355  //" defaults can safely ignore." &
356  //" If manually overriding compressed" &
357  //" restart fills, confirm this is what you" &
358  //" want.")
359  chk = mpp_chksum(ceiling(fdata), &
360  mask_val=field%fill)
361  endif
362  else
363  chk = mpp_chksum(fdata, mask_val=real(field%fill,kind(fdata)))
364  endif
365 #endif
366  !Print out the computed check-sum for the field. This feature is
367  !currently turned off. Uncomment the following lines to turn it
368  !back on.
369 ! if (mpp_pe() .eq. mpp_root_pe()) then
370 ! write(stdout(),'(A,Z16)') "mpp_read_compressed_2d chksum: " &
371 ! //trim(field%name)//" = ",chk
372 ! if (mod(chk,field%checksum(1)) .ne. 0) then
373 ! write(stdout(),'(A,Z16)') "File stored checksum: " &
374 ! //trim(field%name)//" = ", &
375 ! field%checksum(1)
376 ! call mpp_error(NOTE, &
377 ! "mpp_io_unstructured_read_r_2D: " &
378 ! //trim(field%name)//" failed!")
379 ! endif
380 ! endif
381  endif
382 
383  !Stop the mpp timer.
384  call mpp_clock_end(mpp_read_clock)
385 
386  return
387 end subroutine mpp_io_unstructured_read_r8_2d
388 
389 !------------------------------------------------------------------------------
390 !>Read in three-dimensional data for a field associated with an unstructured
391 !!mpp domain.
392 subroutine mpp_io_unstructured_read_r8_3d(funit, &
393  field, &
394  domain, &
395  fdata, &
396  tindex, &
397  start, &
398  nread, &
399  threading)
400 
401  !Inputs/outputs
402  integer(i4_kind),intent(in) :: funit !<A file unit returned by mpp_open.
403  type(fieldtype),intent(in) :: field !<A field whose data will be read in from the file.
404  type(domainug),intent(in) :: domain !<An unstructured mpp domain.
405  real(KIND=r8_kind),dimension(:,:,:),intent(inout) :: fdata !<The data that will be read in from the file.
406  integer(i4_kind),intent(in),optional :: tindex !<Time level index for a NetCDF file.
407  integer(i4_kind),dimension(:),intent(in),optional :: start !<Corner indices for a NetCDF file.
408  integer(i4_kind),dimension(:),intent(in),optional :: nread !<Edge lengths for a NetCDF file.
409  integer(i4_kind),intent(in),optional :: threading !<Flag telling whether one or multiple
410  !! ranks will read the file.
411 
412  !Local variables
413  integer(i4_kind) :: threading_flag !<Flag telling whether one or multiple
414  !! ranks will read the file. This defaults to MPP_SINGLE.
415  type(domainug),pointer :: io_domain !<Pointer to the unstructured I/O domain.
416  integer(i4_kind) :: io_domain_npes !<The total number of ranks in an I/O domain pelist.
417  integer(i4_kind),dimension(:),allocatable :: pelist !<A pelist.
418  integer(i4_kind) :: p !<Loop variable.
419  logical(l4_kind) :: compute_chksum !<Flag telling whether or not a check-sum
420  !! of the read-in data is calculated.
421  integer(i8_kind) :: chk !<Calculated check-sum for the read in data.
422 
423  !Start the mpp timer.
424  !mpp_read_clock is a module variable.
425  call mpp_clock_begin(mpp_read_clock)
426 
427  !Make sure that the module is initialized.
428  if (.not. module_is_initialized) then
429  call mpp_error(fatal, &
430  "mpp_io_unstructured_read_r_3D:" &
431  //" you must must first call mpp_io_init.")
432  endif
433 
434  !Make sure that another NetCDF file is not currently using the inputted
435  !file unit.
436  if (.not. mpp_file(funit)%valid) then
437  call mpp_error(fatal, &
438  "mpp_io_unstructured_read_r_3D:" &
439  //" the inputted file unit is already in use.")
440  endif
441 
442  !If the data array has more than zero elements, then read in the data.
443  if (size(fdata) .gt. 0) then
444 
445  !Initialize the data to zero.
446  fdata = 0
447 
448  !Get the value for the "threading" flag.
449  threading_flag = mpp_single
450  if (present(threading)) then
451  threading_flag = threading
452  endif
453 
454  !Read in the data.
455  if (threading_flag .eq. mpp_multi) then
456 
457  !For the multi-rank case, directly read in the data.
458  call read_record_r8(funit, &
459  field, &
460  size(fdata), &
461  fdata, &
462  tindex, &
463  start_in=start, &
464  axsiz_in=nread)
465  elseif (threading_flag .eq. mpp_single) then
466 
467  !For the single-rank, first point to the I/O domain associated with
468  !the inputted unstructured mpp domain.
469  io_domain => null()
470  io_domain => mpp_get_ug_io_domain(domain)
471 
472  !Get the pelist associated with the I/O domain.
473  io_domain_npes = mpp_get_ug_domain_npes(io_domain)
474  allocate(pelist(io_domain_npes))
475  call mpp_get_ug_domain_pelist(io_domain, &
476  pelist)
477  io_domain => null()
478 
479  !Let only the root rank of the pelist read in the data.
480  if (mpp_pe() .eq. pelist(1)) then
481  call read_record_r8(funit, &
482  field, &
483  size(fdata), &
484  fdata, &
485  tindex, &
486  start_in=start, &
487  axsiz_in=nread)
488  endif
489 
490  !Send the data from the root rank to the rest of the ranks on the
491  !pelist.
492  if (mpp_pe() .eq. pelist(1)) then
493  do p = 2,io_domain_npes
494  call mpp_send(fdata, &
495  size(fdata), &
496  pelist(p), &
497  tag=comm_tag_1)
498  enddo
499  call mpp_sync_self()
500  else
501  call mpp_recv(fdata, &
502  size(fdata), &
503  pelist(1), &
504  block=.false., &
505  tag=comm_tag_1)
506  call mpp_sync_self(check=event_recv)
507  endif
508  deallocate(pelist)
509  else
510  call mpp_error(fatal, &
511  "mpp_io_unstructured_read_r_3D:" &
512  //" threading should be MPP_SINGLE or MPP_MULTI")
513  endif
514  endif
515 
516  !Decided whether or not to compute a check-sum of the read-in data. The
517  !check-sum is calculated if the inputted field's checksum values are not
518  !equal to the default checksum value for a field.
519  compute_chksum = .false.
520  if (any(field%checksum .ne. default_field%checksum)) then
521  compute_chksum = .true.
522  endif
523 
524  !If necessary, compute a check-sum of the read-in data.
525  if (compute_chksum) then
526 #ifdef use_netCDF
527  if (field%type .eq. nf_int) then
528  if (field%fill .eq. mpp_fill_double .or. field%fill .eq. &
529  real(MPP_FILL_INT)) then
530  chk = mpp_chksum(ceiling(fdata), &
531  mask_val=mpp_fill_int)
532  else
533  call mpp_error(note, &
534  "mpp_io_unstructured_read_r_3D:" &
535  //" int field "//trim(field%name) &
536  //" found fill. Icebergs, or code using" &
537  //" defaults can safely ignore." &
538  //" If manually overriding compressed" &
539  //" restart fills, confirm this is what you" &
540  //" want.")
541  chk = mpp_chksum(ceiling(fdata), &
542  mask_val=field%fill)
543  endif
544  else
545  chk = mpp_chksum(fdata, mask_val=real(field%fill,kind(fdata)))
546  endif
547 #endif
548  !Print out the computed check-sum for the field. This feature is
549  !currently turned off. Uncomment the following lines to turn it
550  !back on.
551 ! if (mpp_pe() .eq. mpp_root_pe()) then
552 ! write(stdout(),'(A,Z16)') "mpp_read_compressed_2d chksum: " &
553 ! //trim(field%name)//" = ",chk
554 ! if (mod(chk,field%checksum(1)) .ne. 0) then
555 ! write(stdout(),'(A,Z16)') "File stored checksum: " &
556 ! //trim(field%name)//" = ", &
557 ! field%checksum(1)
558 ! call mpp_error(NOTE, &
559 ! "mpp_io_unstructured_read_r_3D: " &
560 ! //trim(field%name)//" failed!")
561 ! endif
562 ! endif
563  endif
564 
565  !Stop the mpp timer.
566  call mpp_clock_end(mpp_read_clock)
567 
568  return
569 end subroutine mpp_io_unstructured_read_r8_3d
570 
571 !------------------------------------------------------------------------------
572 
573 !----------
574 
575 !------------------------------------------------------------------------------
576 !>Read in one-dimensional data for a field associated with an unstructured
577 !!mpp domain.
578 subroutine mpp_io_unstructured_read_r4_1d(funit, &
579  field, &
580  domain, &
581  fdata, &
582  tindex, &
583  start, &
584  nread, &
585  threading)
586 
587  !Inputs/outputs
588  integer(i4_kind),intent(in) :: funit !<A file unit returned by mpp_open.
589  type(fieldtype),intent(in) :: field !<A field whose data will be read in from the file.
590  type(domainug),intent(in) :: domain !<An unstructured mpp domain.
591  real(KIND=r4_kind),dimension(:),intent(inout) :: fdata !<The data that will be read in from the file.
592  integer(i4_kind),intent(in),optional :: tindex !<Time level index for a NetCDF file.
593  integer(i4_kind),dimension(:),intent(in),optional :: start !<Corner indices for a NetCDF file.
594  integer(i4_kind),dimension(:),intent(in),optional :: nread !<Edge lengths for a NetCDF file.
595  integer(i4_kind),intent(in),optional :: threading !<Flag telling whether one or multiple
596  !! ranks will read the file.
597 
598  !Local variables
599  integer(i4_kind) :: threading_flag !<Flag telling whether one or multiple
600  !! ranks will read the file. This defaults to MPP_SINGLE.
601  type(domainug),pointer :: io_domain !<Pointer to the unstructured I/O domain.
602  integer(i4_kind) :: io_domain_npes !<The total number of ranks in an I/O domain pelist.
603  integer(i4_kind),dimension(:),allocatable :: pelist !<A pelist.
604  integer(i4_kind) :: p !<Loop variable.
605  logical(l4_kind) :: compute_chksum !<Flag telling whether or not a check-sum
606  !! of the read-in data is calculated.
607  integer(i8_kind) :: chk !<Calculated check-sum for the read in data.
608 
609  !Start the mpp timer.
610  !mpp_read_clock is a module variable.
611  call mpp_clock_begin(mpp_read_clock)
612 
613  !Make sure that the module is initialized.
614  if (.not. module_is_initialized) then
615  call mpp_error(fatal, &
616  "mpp_io_unstructured_read_r_1D:" &
617  //" you must must first call mpp_io_init.")
618  endif
619 
620  !Make sure that another NetCDF file is not currently using the inputted
621  !file unit.
622  if (.not. mpp_file(funit)%valid) then
623  call mpp_error(fatal, &
624  "mpp_io_unstructured_read_r_1D:" &
625  //" the inputted file unit is already in use.")
626  endif
627 
628  !If the data array has more than zero elements, then read in the data.
629  if (size(fdata) .gt. 0) then
630 
631  !Initialize the data to zero.
632  fdata = 0
633 
634  !Get the value for the "threading" flag.
635  threading_flag = mpp_single
636  if (present(threading)) then
637  threading_flag = threading
638  endif
639 
640  !Read in the data.
641  if (threading_flag .eq. mpp_multi) then
642 
643  !For the multi-rank case, directly read in the data.
644  call read_record_r4(funit, &
645  field, &
646  size(fdata), &
647  fdata, &
648  tindex, &
649  start_in=start, &
650  axsiz_in=nread)
651  elseif (threading_flag .eq. mpp_single) then
652 
653  !For the single-rank, first point to the I/O domain associated with
654  !the inputted unstructured mpp domain.
655  io_domain => null()
656  io_domain => mpp_get_ug_io_domain(domain)
657 
658  !Get the pelist associated with the I/O domain.
659  io_domain_npes = mpp_get_ug_domain_npes(io_domain)
660  allocate(pelist(io_domain_npes))
661  call mpp_get_ug_domain_pelist(io_domain, &
662  pelist)
663  io_domain => null()
664 
665  !Let only the root rank of the pelist read in the data.
666  if (mpp_pe() .eq. pelist(1)) then
667  call read_record_r4(funit, &
668  field, &
669  size(fdata), &
670  fdata, &
671  tindex, &
672  start_in=start, &
673  axsiz_in=nread)
674  endif
675 
676  !Send the data from the root rank to the rest of the ranks on the
677  !pelist.
678  if (mpp_pe() .eq. pelist(1)) then
679  do p = 2,io_domain_npes
680  call mpp_send(fdata, &
681  size(fdata), &
682  pelist(p), &
683  tag=comm_tag_1)
684  enddo
685  call mpp_sync_self()
686  else
687  call mpp_recv(fdata, &
688  size(fdata), &
689  pelist(1), &
690  block=.false., &
691  tag=comm_tag_1)
692  call mpp_sync_self(check=event_recv)
693  endif
694  deallocate(pelist)
695  else
696  call mpp_error(fatal, &
697  "mpp_io_unstructured_read_r_1D:" &
698  //" threading should be MPP_SINGLE or MPP_MULTI")
699  endif
700  endif
701 
702  !Decided whether or not to compute a check-sum of the read-in data. The
703  !check-sum is calculated if the inputted field's checksum values are not
704  !equal to the default checksum value for a field.
705  compute_chksum = .false.
706  if (any(field%checksum .ne. default_field%checksum)) then
707  compute_chksum = .true.
708  endif
709 
710  !If necessary, compute a check-sum of the read-in data.
711  if (compute_chksum) then
712 #ifdef use_netCDF
713  if (field%type .eq. nf_int) then
714  if (field%fill .eq. mpp_fill_double .or. field%fill .eq. &
715  real(MPP_FILL_INT)) then
716  chk = mpp_chksum(ceiling(fdata), &
717  mask_val=mpp_fill_int)
718  else
719  call mpp_error(note, &
720  "mpp_io_unstructured_read_r_1D:" &
721  //" int field "//trim(field%name) &
722  //" found fill. Icebergs, or code using" &
723  //" defaults can safely ignore." &
724  //" If manually overriding compressed" &
725  //" restart fills, confirm this is what you" &
726  //" want.")
727  chk = mpp_chksum(ceiling(fdata), &
728  mask_val=field%fill)
729  endif
730  else
731  chk = mpp_chksum(fdata, mask_val=real(field%fill,kind(fdata)))
732  endif
733 #endif
734  !Print out the computed check-sum for the field. This feature is
735  !currently turned off. Uncomment the following lines to turn it
736  !back on.
737 ! if (mpp_pe() .eq. mpp_root_pe()) then
738 ! write(stdout(),'(A,Z16)') "mpp_read_compressed_2d chksum: " &
739 ! //trim(field%name)//" = ",chk
740 ! if (mod(chk,field%checksum(1)) .ne. 0) then
741 ! write(stdout(),'(A,Z16)') "File stored checksum: " &
742 ! //trim(field%name)//" = ", &
743 ! field%checksum(1)
744 ! call mpp_error(NOTE, &
745 ! "mpp_io_unstructured_read_r_1D: " &
746 ! //trim(field%name)//" failed!")
747 ! endif
748 ! endif
749  endif
750 
751  !Stop the mpp timer.
752  call mpp_clock_end(mpp_read_clock)
753 
754  return
755 end subroutine mpp_io_unstructured_read_r4_1d
756 
757 !------------------------------------------------------------------------------
758 !>Read in two-dimensional data for a field associated with an unstructured
759 !!mpp domain.
760 subroutine mpp_io_unstructured_read_r4_2d(funit, &
761  field, &
762  domain, &
763  fdata, &
764  tindex, &
765  start, &
766  nread, &
767  threading)
768 
769  !Inputs/outputs
770  integer(i4_kind),intent(in) :: funit !<A file unit returned by mpp_open.
771  type(fieldtype),intent(in) :: field !<A field whose data will be read in from the file.
772  type(domainug),intent(in) :: domain !<An unstructured mpp domain.
773  real(KIND=r4_kind),dimension(:,:),intent(inout) :: fdata !<The data that will be read in from the file.
774  integer(i4_kind),intent(in),optional :: tindex !<Time level index for a NetCDF file.
775  integer(i4_kind),dimension(:),intent(in),optional :: start !<Corner indices for a NetCDF file.
776  integer(i4_kind),dimension(:),intent(in),optional :: nread !<Edge lengths for a NetCDF file.
777  integer(i4_kind),intent(in),optional :: threading !<Flag telling whether one or multiple
778  !! ranks will read the file.
779 
780  !Local variables
781  integer(i4_kind) :: threading_flag !<Flag telling whether one or multiple
782  !! ranks will read the file. This defaults to MPP_SINGLE.
783  type(domainug),pointer :: io_domain !<Pointer to the unstructured I/O domain.
784  integer(i4_kind) :: io_domain_npes !<The total number of ranks in an I/O domain pelist.
785  integer(i4_kind),dimension(:),allocatable :: pelist !<A pelist.
786  integer(i4_kind) :: p !<Loop variable.
787  logical(l4_kind) :: compute_chksum !<Flag telling whether or not a check-sum
788  !! of the read-in data is calculated.
789  integer(i8_kind) :: chk !<Calculated check-sum for the read in data.
790 
791  !Start the mpp timer.
792  !mpp_read_clock is a module variable.
793  call mpp_clock_begin(mpp_read_clock)
794 
795  !Make sure that the module is initialized.
796  if (.not. module_is_initialized) then
797  call mpp_error(fatal, &
798  "mpp_io_unstructured_read_r_2D:" &
799  //" you must must first call mpp_io_init.")
800  endif
801 
802  !Make sure that another NetCDF file is not currently using the inputted
803  !file unit.
804  if (.not. mpp_file(funit)%valid) then
805  call mpp_error(fatal, &
806  "mpp_io_unstructured_read_r_2D:" &
807  //" the inputted file unit is already in use.")
808  endif
809 
810  !If the data array has more than zero elements, then read in the data.
811  if (size(fdata) .gt. 0) then
812 
813  !Initialize the data to zero.
814  fdata = 0
815 
816  !Get the value for the "threading" flag.
817  threading_flag = mpp_single
818  if (present(threading)) then
819  threading_flag = threading
820  endif
821 
822  !Read in the data.
823  if (threading_flag .eq. mpp_multi) then
824 
825  !For the multi-rank case, directly read in the data.
826  call read_record_r4(funit, &
827  field, &
828  size(fdata), &
829  fdata, &
830  tindex, &
831  start_in=start, &
832  axsiz_in=nread)
833  elseif (threading_flag .eq. mpp_single) then
834 
835  !For the single-rank, first point to the I/O domain associated with
836  !the inputted unstructured mpp domain.
837  io_domain => null()
838  io_domain => mpp_get_ug_io_domain(domain)
839 
840  !Get the pelist associated with the I/O domain.
841  io_domain_npes = mpp_get_ug_domain_npes(io_domain)
842  allocate(pelist(io_domain_npes))
843  call mpp_get_ug_domain_pelist(io_domain, &
844  pelist)
845  io_domain => null()
846 
847  !Let only the root rank of the pelist read in the data.
848  if (mpp_pe() .eq. pelist(1)) then
849  call read_record_r4(funit, &
850  field, &
851  size(fdata), &
852  fdata, &
853  tindex, &
854  start_in=start, &
855  axsiz_in=nread)
856  endif
857 
858  !Send the data from the root rank to the rest of the ranks on the
859  !pelist.
860  if (mpp_pe() .eq. pelist(1)) then
861  do p = 2,io_domain_npes
862  call mpp_send(fdata, &
863  size(fdata), &
864  pelist(p), &
865  tag=comm_tag_1)
866  enddo
867  call mpp_sync_self()
868  else
869  call mpp_recv(fdata, &
870  size(fdata), &
871  pelist(1), &
872  block=.false., &
873  tag=comm_tag_1)
874  call mpp_sync_self(check=event_recv)
875  endif
876  deallocate(pelist)
877  else
878  call mpp_error(fatal, &
879  "mpp_io_unstructured_read_r_2D:" &
880  //" threading should be MPP_SINGLE or MPP_MULTI")
881  endif
882  endif
883 
884  !Decided whether or not to compute a check-sum of the read-in data. The
885  !check-sum is calculated if the inputted field's checksum values are not
886  !equal to the default checksum value for a field.
887  compute_chksum = .false.
888  if (any(field%checksum .ne. default_field%checksum)) then
889  compute_chksum = .true.
890  endif
891 
892  !If necessary, compute a check-sum of the read-in data.
893  if (compute_chksum) then
894 #ifdef use_netCDF
895  if (field%type .eq. nf_int) then
896  if (field%fill .eq. mpp_fill_double .or. field%fill .eq. &
897  real(MPP_FILL_INT)) then
898  chk = mpp_chksum(ceiling(fdata), &
899  mask_val=mpp_fill_int)
900  else
901  call mpp_error(note, &
902  "mpp_io_unstructured_read_r_2D:" &
903  //" int field "//trim(field%name) &
904  //" found fill. Icebergs, or code using" &
905  //" defaults can safely ignore." &
906  //" If manually overriding compressed" &
907  //" restart fills, confirm this is what you" &
908  //" want.")
909  chk = mpp_chksum(ceiling(fdata), &
910  mask_val=field%fill)
911  endif
912  else
913  chk = mpp_chksum(fdata, mask_val=real(field%fill,kind(fdata)))
914  endif
915 #endif
916  !Print out the computed check-sum for the field. This feature is
917  !currently turned off. Uncomment the following lines to turn it
918  !back on.
919 ! if (mpp_pe() .eq. mpp_root_pe()) then
920 ! write(stdout(),'(A,Z16)') "mpp_read_compressed_2d chksum: " &
921 ! //trim(field%name)//" = ",chk
922 ! if (mod(chk,field%checksum(1)) .ne. 0) then
923 ! write(stdout(),'(A,Z16)') "File stored checksum: " &
924 ! //trim(field%name)//" = ", &
925 ! field%checksum(1)
926 ! call mpp_error(NOTE, &
927 ! "mpp_io_unstructured_read_r_2D: " &
928 ! //trim(field%name)//" failed!")
929 ! endif
930 ! endif
931  endif
932 
933  !Stop the mpp timer.
934  call mpp_clock_end(mpp_read_clock)
935 
936  return
937 end subroutine mpp_io_unstructured_read_r4_2d
938 
939 !------------------------------------------------------------------------------
940 !>Read in three-dimensional data for a field associated with an unstructured
941 !!mpp domain.
942 subroutine mpp_io_unstructured_read_r4_3d(funit, &
943  field, &
944  domain, &
945  fdata, &
946  tindex, &
947  start, &
948  nread, &
949  threading)
950 
951  !Inputs/outputs
952  integer(i4_kind),intent(in) :: funit !<A file unit returned by mpp_open.
953  type(fieldtype),intent(in) :: field !<A field whose data will be read in from the file.
954  type(domainug),intent(in) :: domain !<An unstructured mpp domain.
955  real(KIND=r4_kind),dimension(:,:,:),intent(inout) :: fdata !<The data that will be read in from the file.
956  integer(i4_kind),intent(in),optional :: tindex !<Time level index for a NetCDF file.
957  integer(i4_kind),dimension(:),intent(in),optional :: start !<Corner indices for a NetCDF file.
958  integer(i4_kind),dimension(:),intent(in),optional :: nread !<Edge lengths for a NetCDF file.
959  integer(i4_kind),intent(in),optional :: threading !<Flag telling whether one or multiple
960  !! ranks will read the file.
961 
962  !Local variables
963  integer(i4_kind) :: threading_flag !<Flag telling whether one or multiple
964  !! ranks will read the file. This defaults to MPP_SINGLE.
965  type(domainug),pointer :: io_domain !<Pointer to the unstructured I/O domain.
966  integer(i4_kind) :: io_domain_npes !<The total number of ranks in an I/O domain pelist.
967  integer(i4_kind),dimension(:),allocatable :: pelist !<A pelist.
968  integer(i4_kind) :: p !<Loop variable.
969  logical(l4_kind) :: compute_chksum !<Flag telling whether or not a check-sum
970  !! of the read-in data is calculated.
971  integer(i8_kind) :: chk !<Calculated check-sum for the read in data.
972 
973  !Start the mpp timer.
974  !mpp_read_clock is a module variable.
975  call mpp_clock_begin(mpp_read_clock)
976 
977  !Make sure that the module is initialized.
978  if (.not. module_is_initialized) then
979  call mpp_error(fatal, &
980  "mpp_io_unstructured_read_r_3D:" &
981  //" you must must first call mpp_io_init.")
982  endif
983 
984  !Make sure that another NetCDF file is not currently using the inputted
985  !file unit.
986  if (.not. mpp_file(funit)%valid) then
987  call mpp_error(fatal, &
988  "mpp_io_unstructured_read_r_3D:" &
989  //" the inputted file unit is already in use.")
990  endif
991 
992  !If the data array has more than zero elements, then read in the data.
993  if (size(fdata) .gt. 0) then
994 
995  !Initialize the data to zero.
996  fdata = 0
997 
998  !Get the value for the "threading" flag.
999  threading_flag = mpp_single
1000  if (present(threading)) then
1001  threading_flag = threading
1002  endif
1003 
1004  !Read in the data.
1005  if (threading_flag .eq. mpp_multi) then
1006 
1007  !For the multi-rank case, directly read in the data.
1008  call read_record_r4(funit, &
1009  field, &
1010  size(fdata), &
1011  fdata, &
1012  tindex, &
1013  start_in=start, &
1014  axsiz_in=nread)
1015  elseif (threading_flag .eq. mpp_single) then
1016 
1017  !For the single-rank, first point to the I/O domain associated with
1018  !the inputted unstructured mpp domain.
1019  io_domain => null()
1020  io_domain => mpp_get_ug_io_domain(domain)
1021 
1022  !Get the pelist associated with the I/O domain.
1023  io_domain_npes = mpp_get_ug_domain_npes(io_domain)
1024  allocate(pelist(io_domain_npes))
1025  call mpp_get_ug_domain_pelist(io_domain, &
1026  pelist)
1027  io_domain => null()
1028 
1029  !Let only the root rank of the pelist read in the data.
1030  if (mpp_pe() .eq. pelist(1)) then
1031  call read_record_r4(funit, &
1032  field, &
1033  size(fdata), &
1034  fdata, &
1035  tindex, &
1036  start_in=start, &
1037  axsiz_in=nread)
1038  endif
1039 
1040  !Send the data from the root rank to the rest of the ranks on the
1041  !pelist.
1042  if (mpp_pe() .eq. pelist(1)) then
1043  do p = 2,io_domain_npes
1044  call mpp_send(fdata, &
1045  size(fdata), &
1046  pelist(p), &
1047  tag=comm_tag_1)
1048  enddo
1049  call mpp_sync_self()
1050  else
1051  call mpp_recv(fdata, &
1052  size(fdata), &
1053  pelist(1), &
1054  block=.false., &
1055  tag=comm_tag_1)
1056  call mpp_sync_self(check=event_recv)
1057  endif
1058  deallocate(pelist)
1059  else
1060  call mpp_error(fatal, &
1061  "mpp_io_unstructured_read_r_3D:" &
1062  //" threading should be MPP_SINGLE or MPP_MULTI")
1063  endif
1064  endif
1065 
1066  !Decided whether or not to compute a check-sum of the read-in data. The
1067  !check-sum is calculated if the inputted field's checksum values are not
1068  !equal to the default checksum value for a field.
1069  compute_chksum = .false.
1070  if (any(field%checksum .ne. default_field%checksum)) then
1071  compute_chksum = .true.
1072  endif
1073 
1074  !If necessary, compute a check-sum of the read-in data.
1075  if (compute_chksum) then
1076 #ifdef use_netCDF
1077  if (field%type .eq. nf_int) then
1078  if (field%fill .eq. mpp_fill_double .or. field%fill .eq. &
1079  real(MPP_FILL_INT)) then
1080  chk = mpp_chksum(ceiling(fdata), &
1081  mask_val=mpp_fill_int)
1082  else
1083  call mpp_error(note, &
1084  "mpp_io_unstructured_read_r_3D:" &
1085  //" int field "//trim(field%name) &
1086  //" found fill. Icebergs, or code using" &
1087  //" defaults can safely ignore." &
1088  //" If manually overriding compressed" &
1089  //" restart fills, confirm this is what you" &
1090  //" want.")
1091  chk = mpp_chksum(ceiling(fdata), &
1092  mask_val=field%fill)
1093  endif
1094  else
1095  chk = mpp_chksum(fdata, mask_val=real(field%fill,kind(fdata)))
1096  endif
1097 #endif
1098  !Print out the computed check-sum for the field. This feature is
1099  !currently turned off. Uncomment the following lines to turn it
1100  !back on.
1101 ! if (mpp_pe() .eq. mpp_root_pe()) then
1102 ! write(stdout(),'(A,Z16)') "mpp_read_compressed_2d chksum: " &
1103 ! //trim(field%name)//" = ",chk
1104 ! if (mod(chk,field%checksum(1)) .ne. 0) then
1105 ! write(stdout(),'(A,Z16)') "File stored checksum: " &
1106 ! //trim(field%name)//" = ", &
1107 ! field%checksum(1)
1108 ! call mpp_error(NOTE, &
1109 ! "mpp_io_unstructured_read_r_3D: " &
1110 ! //trim(field%name)//" failed!")
1111 ! endif
1112 ! endif
1113  endif
1114 
1115  !Stop the mpp timer.
1116  call mpp_clock_end(mpp_read_clock)
1117 
1118  return
1119 end subroutine mpp_io_unstructured_read_r4_3d
1120 !> @}
mpp_io_unstructured_read_r4_2d
subroutine mpp_io_unstructured_read_r4_2d(funit, field, domain, fdata, tindex, start, nread, threading)
Read in two-dimensional data for a field associated with an unstructured mpp domain.
Definition: mpp_io_unstructured_read.inc:768
mpp_io_unstructured_read_r4_1d
subroutine mpp_io_unstructured_read_r4_1d(funit, field, domain, fdata, tindex, start, nread, threading)
Read in one-dimensional data for a field associated with an unstructured mpp domain.
Definition: mpp_io_unstructured_read.inc:586
mpp_io_unstructured_read_r8_1d
subroutine mpp_io_unstructured_read_r8_1d(funit, field, domain, fdata, tindex, start, nread, threading)
Read in one-dimensional data for a field associated with an unstructured mpp domain.
Definition: mpp_io_unstructured_read.inc:36
mpp_io_unstructured_read_r8_3d
subroutine mpp_io_unstructured_read_r8_3d(funit, field, domain, fdata, tindex, start, nread, threading)
Read in three-dimensional data for a field associated with an unstructured mpp domain.
Definition: mpp_io_unstructured_read.inc:400
mpp_io_unstructured_read_r4_3d
subroutine mpp_io_unstructured_read_r4_3d(funit, field, domain, fdata, tindex, start, nread, threading)
Read in three-dimensional data for a field associated with an unstructured mpp domain.
Definition: mpp_io_unstructured_read.inc:950
mpp_io_unstructured_read_r8_2d
subroutine mpp_io_unstructured_read_r8_2d(funit, field, domain, fdata, tindex, start, nread, threading)
Read in two-dimensional data for a field associated with an unstructured mpp domain.
Definition: mpp_io_unstructured_read.inc:218
mpp_sync_self
subroutine mpp_sync_self(pelist, check, request, msg_size, msg_type)
This is to check if current PE's outstanding puts are complete but we can't use shmem_fence because w...
Definition: mpp_util_mpi.inc:172
mpp_pe
integer function mpp_pe()
Returns processor ID.
Definition: mpp_util.inc:407