FMS 2025.01-dev
Flexible Modeling System
Loading...
Searching...
No Matches
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.
28subroutine 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
205end 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.
210subroutine 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
387end 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.
392subroutine 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
569end 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.
578subroutine 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
755end 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.
760subroutine 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
937end 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.
942subroutine 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
1119end 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:175