FV3 Bundle
mpp_io_unstructured_read.inc
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 
20 !----------
21 !ug support
22 
23 !------------------------------------------------------------------------------
24 !>Read in one-dimensional data for a field associated with an unstructured
25 !!mpp domain.
26 subroutine mpp_io_unstructured_read_r_1D(funit, &
27  field, &
28  domain, &
29  fdata, &
30  tindex, &
31  start, &
32  nread, &
33  threading)
34 
35  !Inputs/outputs
36  integer(INT_KIND),intent(in) :: funit !<A file unit returned by mpp_open.
37  type(fieldtype),intent(in) :: field !<A field whose data will be read in from the file.
38  type(domainUG),intent(in) :: domain !<An unstructured mpp domain.
39  real,dimension(:),intent(inout) :: fdata !<The data that will be read in from the file.
40  integer(INT_KIND),intent(in),optional :: tindex !<Time level index for a NetCDF file.
41  integer(INT_KIND),dimension(:),intent(in),optional :: start !<Corner indices for a NetCDF file.
42  integer(INT_KIND),dimension(:),intent(in),optional :: nread !<Edge lengths for a NetCDF file.
43  integer(INT_KIND),intent(in),optional :: threading !<Flag telling whether one or multiple ranks will read the file.
44 
45  !Local variables
46  integer(INT_KIND) :: threading_flag !<Flag telling whether one or multiple ranks will read the file. This defaults to MPP_SINGLE.
47  type(domainUG),pointer :: io_domain !<Pointer to the unstructured I/O domain.
48  integer(INT_KIND) :: io_domain_npes !<The total number of ranks in an I/O domain pelist.
49  integer(INT_KIND),dimension(:),allocatable :: pelist !<A pelist.
50  integer(INT_KIND) :: p !<Loop variable.
51  logical(INT_KIND) :: compute_chksum !<Flag telling whether or not a check-sum of the read-in data is calculated.
52  integer(LONG_KIND) :: chk !<Calculated check-sum for the read in data.
53 
54  !Start the mpp timer.
55  !mpp_read_clock is a module variable.
56  call mpp_clock_begin(mpp_read_clock)
57 
58  !Make sure that the module is initialized.
59  if (.not. module_is_initialized) then
60  call mpp_error(FATAL, &
61  "mpp_io_unstructured_read_r_1D:" &
62  //" you must must first call mpp_io_init.")
63  endif
64 
65  !Make sure that another NetCDF file is not currently using the inputted
66  !file unit.
67  if (.not. mpp_file(funit)%valid) then
68  call mpp_error(FATAL, &
69  "mpp_io_unstructured_read_r_1D:" &
70  //" the inputted file unit is already in use.")
71  endif
72 
73  !If the data array has more than zero elements, then read in the data.
74  if (size(fdata) .gt. 0) then
75 
76  !Initialize the data to zero.
77  fdata = 0
78 
79  !Get the value for the "threading" flag.
80  threading_flag = MPP_SINGLE
81  if (present(threading)) then
82  threading_flag = threading
83  endif
84 
85  !Read in the data.
86  if (threading_flag .eq. MPP_MULTI) then
87 
88  !For the multi-rank case, directly read in the data.
89  call read_record(funit, &
90  field, &
91  size(fdata), &
92  fdata, &
93  tindex, &
94  start_in=start, &
95  axsiz_in=nread)
96  elseif (threading_flag .eq. MPP_SINGLE) then
97 
98  !For the single-rank, first point to the I/O domain associated with
99  !the inputted unstructured mpp domain.
100  io_domain => null()
101  io_domain => mpp_get_UG_io_domain(domain)
102 
103  !Get the pelist associated with the I/O domain.
104  io_domain_npes = mpp_get_UG_domain_npes(io_domain)
105  allocate(pelist(io_domain_npes))
106  call mpp_get_UG_domain_pelist(io_domain, &
107  pelist)
108  io_domain => null()
109 
110  !Let only the root rank of the pelist read in the data.
111  if (mpp_pe() .eq. pelist(1)) then
112  call read_record(funit, &
113  field, &
114  size(fdata), &
115  fdata, &
116  tindex, &
117  start_in=start, &
118  axsiz_in=nread)
119  endif
120 
121  !Send the data from the root rank to the rest of the ranks on the
122  !pelist.
123  if (mpp_pe() .eq. pelist(1)) then
124  do p = 2,io_domain_npes
125  call mpp_send(fdata, &
126  size(fdata), &
127  pelist(p), &
128  tag=COMM_TAG_1)
129  enddo
130  call mpp_sync_self()
131  else
132  call mpp_recv(fdata, &
133  size(fdata), &
134  pelist(1), &
135  block=.false., &
136  tag=COMM_TAG_1)
137  call mpp_sync_self(check=EVENT_RECV)
138  endif
139  deallocate(pelist)
140  else
141  call mpp_error(FATAL, &
142  "mpp_io_unstructured_read_r_1D:" &
143  //" threading should be MPP_SINGLE or MPP_MULTI")
144  endif
145  endif
146 
147  !Decided whether or not to compute a check-sum of the read-in data. The
148  !check-sum is calculated if the inputted field's checksum values are not
149  !equal to the default checksum value for a field.
150  compute_chksum = .false.
151  if (any(field%checksum .ne. default_field%checksum)) then
152  compute_chksum = .true.
153  endif
154 
155  !If necessary, compute a check-sum of the read-in data.
156  if (compute_chksum) then
157 #ifdef use_netCDF
158  if (field%type .eq. NF_INT) then
159  if (field%fill .eq. MPP_FILL_DOUBLE .or. field%fill .eq. &
160  real(MPP_FILL_INT)) then
161  chk = mpp_chksum(ceiling(fdata), &
162  mask_val=MPP_FILL_INT)
163  else
164  call mpp_error(NOTE, &
165  "mpp_io_unstructured_read_r_1D:" &
166  //" int field "//trim(field%name) &
167  //" found fill. Icebergs, or code using" &
168  //" defaults can safely ignore." &
169  //" If manually overriding compressed" &
170  //" restart fills, confirm this is what you" &
171  //" want.")
172  chk = mpp_chksum(ceiling(fdata), &
173  mask_val=field%fill)
174  endif
175  else
176  chk = mpp_chksum(fdata, &
177  mask_val=field%fill)
178  endif
179 #endif
180  !Print out the computed check-sum for the field. This feature is
181  !currently turned off. Uncomment the following lines to turn it
182  !back on.
183 ! if (mpp_pe() .eq. mpp_root_pe()) then
184 ! write(stdout(),'(A,Z16)') "mpp_read_compressed_2d chksum: " &
185 ! //trim(field%name)//" = ",chk
186 ! if (mod(chk,field%checksum(1)) .ne. 0) then
187 ! write(stdout(),'(A,Z16)') "File stored checksum: " &
188 ! //trim(field%name)//" = ", &
189 ! field%checksum(1)
190 ! call mpp_error(NOTE, &
191 ! "mpp_io_unstructured_read_r_1D: " &
192 ! //trim(field%name)//" failed!")
193 ! endif
194 ! endif
195  endif
196 
197  !Stop the mpp timer.
198  call mpp_clock_end(mpp_read_clock)
199 
200  return
201 end subroutine mpp_io_unstructured_read_r_1D
202 
203 !------------------------------------------------------------------------------
204 !>Read in two-dimensional data for a field associated with an unstructured
205 !!mpp domain.
206 subroutine mpp_io_unstructured_read_r_2D(funit, &
207  field, &
208  domain, &
209  fdata, &
210  tindex, &
211  start, &
212  nread, &
213  threading)
214 
215  !Inputs/outputs
216  integer(INT_KIND),intent(in) :: funit !<A file unit returned by mpp_open.
217  type(fieldtype),intent(in) :: field !<A field whose data will be read in from the file.
218  type(domainUG),intent(in) :: domain !<An unstructured mpp domain.
219  real,dimension(:,:),intent(inout) :: fdata !<The data that will be read in from the file.
220  integer(INT_KIND),intent(in),optional :: tindex !<Time level index for a NetCDF file.
221  integer(INT_KIND),dimension(:),intent(in),optional :: start !<Corner indices for a NetCDF file.
222  integer(INT_KIND),dimension(:),intent(in),optional :: nread !<Edge lengths for a NetCDF file.
223  integer(INT_KIND),intent(in),optional :: threading !<Flag telling whether one or multiple ranks will read the file.
224 
225  !Local variables
226  integer(INT_KIND) :: threading_flag !<Flag telling whether one or multiple ranks will read the file. This defaults to MPP_SINGLE.
227  type(domainUG),pointer :: io_domain !<Pointer to the unstructured I/O domain.
228  integer(INT_KIND) :: io_domain_npes !<The total number of ranks in an I/O domain pelist.
229  integer(INT_KIND),dimension(:),allocatable :: pelist !<A pelist.
230  integer(INT_KIND) :: p !<Loop variable.
231  logical(INT_KIND) :: compute_chksum !<Flag telling whether or not a check-sum of the read-in data is calculated.
232  integer(LONG_KIND) :: chk !<Calculated check-sum for the read in data.
233 
234  !Start the mpp timer.
235  !mpp_read_clock is a module variable.
236  call mpp_clock_begin(mpp_read_clock)
237 
238  !Make sure that the module is initialized.
239  if (.not. module_is_initialized) then
240  call mpp_error(FATAL, &
241  "mpp_io_unstructured_read_r_2D:" &
242  //" you must must first call mpp_io_init.")
243  endif
244 
245  !Make sure that another NetCDF file is not currently using the inputted
246  !file unit.
247  if (.not. mpp_file(funit)%valid) then
248  call mpp_error(FATAL, &
249  "mpp_io_unstructured_read_r_2D:" &
250  //" the inputted file unit is already in use.")
251  endif
252 
253  !If the data array has more than zero elements, then read in the data.
254  if (size(fdata) .gt. 0) then
255 
256  !Initialize the data to zero.
257  fdata = 0
258 
259  !Get the value for the "threading" flag.
260  threading_flag = MPP_SINGLE
261  if (present(threading)) then
262  threading_flag = threading
263  endif
264 
265  !Read in the data.
266  if (threading_flag .eq. MPP_MULTI) then
267 
268  !For the multi-rank case, directly read in the data.
269  call read_record(funit, &
270  field, &
271  size(fdata), &
272  fdata, &
273  tindex, &
274  start_in=start, &
275  axsiz_in=nread)
276  elseif (threading_flag .eq. MPP_SINGLE) then
277 
278  !For the single-rank, first point to the I/O domain associated with
279  !the inputted unstructured mpp domain.
280  io_domain => null()
281  io_domain => mpp_get_UG_io_domain(domain)
282 
283  !Get the pelist associated with the I/O domain.
284  io_domain_npes = mpp_get_UG_domain_npes(io_domain)
285  allocate(pelist(io_domain_npes))
286  call mpp_get_UG_domain_pelist(io_domain, &
287  pelist)
288  io_domain => null()
289 
290  !Let only the root rank of the pelist read in the data.
291  if (mpp_pe() .eq. pelist(1)) then
292  call read_record(funit, &
293  field, &
294  size(fdata), &
295  fdata, &
296  tindex, &
297  start_in=start, &
298  axsiz_in=nread)
299  endif
300 
301  !Send the data from the root rank to the rest of the ranks on the
302  !pelist.
303  if (mpp_pe() .eq. pelist(1)) then
304  do p = 2,io_domain_npes
305  call mpp_send(fdata, &
306  size(fdata), &
307  pelist(p), &
308  tag=COMM_TAG_1)
309  enddo
310  call mpp_sync_self()
311  else
312  call mpp_recv(fdata, &
313  size(fdata), &
314  pelist(1), &
315  block=.false., &
316  tag=COMM_TAG_1)
317  call mpp_sync_self(check=EVENT_RECV)
318  endif
319  deallocate(pelist)
320  else
321  call mpp_error(FATAL, &
322  "mpp_io_unstructured_read_r_2D:" &
323  //" threading should be MPP_SINGLE or MPP_MULTI")
324  endif
325  endif
326 
327  !Decided whether or not to compute a check-sum of the read-in data. The
328  !check-sum is calculated if the inputted field's checksum values are not
329  !equal to the default checksum value for a field.
330  compute_chksum = .false.
331  if (any(field%checksum .ne. default_field%checksum)) then
332  compute_chksum = .true.
333  endif
334 
335  !If necessary, compute a check-sum of the read-in data.
336  if (compute_chksum) then
337 #ifdef use_netCDF
338  if (field%type .eq. NF_INT) then
339  if (field%fill .eq. MPP_FILL_DOUBLE .or. field%fill .eq. &
340  real(MPP_FILL_INT)) then
341  chk = mpp_chksum(ceiling(fdata), &
342  mask_val=MPP_FILL_INT)
343  else
344  call mpp_error(NOTE, &
345  "mpp_io_unstructured_read_r_2D:" &
346  //" int field "//trim(field%name) &
347  //" found fill. Icebergs, or code using" &
348  //" defaults can safely ignore." &
349  //" If manually overriding compressed" &
350  //" restart fills, confirm this is what you" &
351  //" want.")
352  chk = mpp_chksum(ceiling(fdata), &
353  mask_val=field%fill)
354  endif
355  else
356  chk = mpp_chksum(fdata, &
357  mask_val=field%fill)
358  endif
359 #endif
360  !Print out the computed check-sum for the field. This feature is
361  !currently turned off. Uncomment the following lines to turn it
362  !back on.
363 ! if (mpp_pe() .eq. mpp_root_pe()) then
364 ! write(stdout(),'(A,Z16)') "mpp_read_compressed_2d chksum: " &
365 ! //trim(field%name)//" = ",chk
366 ! if (mod(chk,field%checksum(1)) .ne. 0) then
367 ! write(stdout(),'(A,Z16)') "File stored checksum: " &
368 ! //trim(field%name)//" = ", &
369 ! field%checksum(1)
370 ! call mpp_error(NOTE, &
371 ! "mpp_io_unstructured_read_r_2D: " &
372 ! //trim(field%name)//" failed!")
373 ! endif
374 ! endif
375  endif
376 
377  !Stop the mpp timer.
378  call mpp_clock_end(mpp_read_clock)
379 
380  return
381 end subroutine mpp_io_unstructured_read_r_2D
382 
383 !------------------------------------------------------------------------------
384 !>Read in three-dimensional data for a field associated with an unstructured
385 !!mpp domain.
386 subroutine mpp_io_unstructured_read_r_3D(funit, &
387  field, &
388  domain, &
389  fdata, &
390  tindex, &
391  start, &
392  nread, &
393  threading)
394 
395  !Inputs/outputs
396  integer(INT_KIND),intent(in) :: funit !<A file unit returned by mpp_open.
397  type(fieldtype),intent(in) :: field !<A field whose data will be read in from the file.
398  type(domainUG),intent(in) :: domain !<An unstructured mpp domain.
399  real,dimension(:,:,:),intent(inout) :: fdata !<The data that will be read in from the file.
400  integer(INT_KIND),intent(in),optional :: tindex !<Time level index for a NetCDF file.
401  integer(INT_KIND),dimension(:),intent(in),optional :: start !<Corner indices for a NetCDF file.
402  integer(INT_KIND),dimension(:),intent(in),optional :: nread !<Edge lengths for a NetCDF file.
403  integer(INT_KIND),intent(in),optional :: threading !<Flag telling whether one or multiple ranks will read the file.
404 
405  !Local variables
406  integer(INT_KIND) :: threading_flag !<Flag telling whether one or multiple ranks will read the file. This defaults to MPP_SINGLE.
407  type(domainUG),pointer :: io_domain !<Pointer to the unstructured I/O domain.
408  integer(INT_KIND) :: io_domain_npes !<The total number of ranks in an I/O domain pelist.
409  integer(INT_KIND),dimension(:),allocatable :: pelist !<A pelist.
410  integer(INT_KIND) :: p !<Loop variable.
411  logical(INT_KIND) :: compute_chksum !<Flag telling whether or not a check-sum of the read-in data is calculated.
412  integer(LONG_KIND) :: chk !<Calculated check-sum for the read in data.
413 
414  !Start the mpp timer.
415  !mpp_read_clock is a module variable.
416  call mpp_clock_begin(mpp_read_clock)
417 
418  !Make sure that the module is initialized.
419  if (.not. module_is_initialized) then
420  call mpp_error(FATAL, &
421  "mpp_io_unstructured_read_r_3D:" &
422  //" you must must first call mpp_io_init.")
423  endif
424 
425  !Make sure that another NetCDF file is not currently using the inputted
426  !file unit.
427  if (.not. mpp_file(funit)%valid) then
428  call mpp_error(FATAL, &
429  "mpp_io_unstructured_read_r_3D:" &
430  //" the inputted file unit is already in use.")
431  endif
432 
433  !If the data array has more than zero elements, then read in the data.
434  if (size(fdata) .gt. 0) then
435 
436  !Initialize the data to zero.
437  fdata = 0
438 
439  !Get the value for the "threading" flag.
440  threading_flag = MPP_SINGLE
441  if (present(threading)) then
442  threading_flag = threading
443  endif
444 
445  !Read in the data.
446  if (threading_flag .eq. MPP_MULTI) then
447 
448  !For the multi-rank case, directly read in the data.
449  call read_record(funit, &
450  field, &
451  size(fdata), &
452  fdata, &
453  tindex, &
454  start_in=start, &
455  axsiz_in=nread)
456  elseif (threading_flag .eq. MPP_SINGLE) then
457 
458  !For the single-rank, first point to the I/O domain associated with
459  !the inputted unstructured mpp domain.
460  io_domain => null()
461  io_domain => mpp_get_UG_io_domain(domain)
462 
463  !Get the pelist associated with the I/O domain.
464  io_domain_npes = mpp_get_UG_domain_npes(io_domain)
465  allocate(pelist(io_domain_npes))
466  call mpp_get_UG_domain_pelist(io_domain, &
467  pelist)
468  io_domain => null()
469 
470  !Let only the root rank of the pelist read in the data.
471  if (mpp_pe() .eq. pelist(1)) then
472  call read_record(funit, &
473  field, &
474  size(fdata), &
475  fdata, &
476  tindex, &
477  start_in=start, &
478  axsiz_in=nread)
479  endif
480 
481  !Send the data from the root rank to the rest of the ranks on the
482  !pelist.
483  if (mpp_pe() .eq. pelist(1)) then
484  do p = 2,io_domain_npes
485  call mpp_send(fdata, &
486  size(fdata), &
487  pelist(p), &
488  tag=COMM_TAG_1)
489  enddo
490  call mpp_sync_self()
491  else
492  call mpp_recv(fdata, &
493  size(fdata), &
494  pelist(1), &
495  block=.false., &
496  tag=COMM_TAG_1)
497  call mpp_sync_self(check=EVENT_RECV)
498  endif
499  deallocate(pelist)
500  else
501  call mpp_error(FATAL, &
502  "mpp_io_unstructured_read_r_3D:" &
503  //" threading should be MPP_SINGLE or MPP_MULTI")
504  endif
505  endif
506 
507  !Decided whether or not to compute a check-sum of the read-in data. The
508  !check-sum is calculated if the inputted field's checksum values are not
509  !equal to the default checksum value for a field.
510  compute_chksum = .false.
511  if (any(field%checksum .ne. default_field%checksum)) then
512  compute_chksum = .true.
513  endif
514 
515  !If necessary, compute a check-sum of the read-in data.
516  if (compute_chksum) then
517 #ifdef use_netCDF
518  if (field%type .eq. NF_INT) then
519  if (field%fill .eq. MPP_FILL_DOUBLE .or. field%fill .eq. &
520  real(MPP_FILL_INT)) then
521  chk = mpp_chksum(ceiling(fdata), &
522  mask_val=MPP_FILL_INT)
523  else
524  call mpp_error(NOTE, &
525  "mpp_io_unstructured_read_r_3D:" &
526  //" int field "//trim(field%name) &
527  //" found fill. Icebergs, or code using" &
528  //" defaults can safely ignore." &
529  //" If manually overriding compressed" &
530  //" restart fills, confirm this is what you" &
531  //" want.")
532  chk = mpp_chksum(ceiling(fdata), &
533  mask_val=field%fill)
534  endif
535  else
536  chk = mpp_chksum(fdata, &
537  mask_val=field%fill)
538  endif
539 #endif
540  !Print out the computed check-sum for the field. This feature is
541  !currently turned off. Uncomment the following lines to turn it
542  !back on.
543 ! if (mpp_pe() .eq. mpp_root_pe()) then
544 ! write(stdout(),'(A,Z16)') "mpp_read_compressed_2d chksum: " &
545 ! //trim(field%name)//" = ",chk
546 ! if (mod(chk,field%checksum(1)) .ne. 0) then
547 ! write(stdout(),'(A,Z16)') "File stored checksum: " &
548 ! //trim(field%name)//" = ", &
549 ! field%checksum(1)
550 ! call mpp_error(NOTE, &
551 ! "mpp_io_unstructured_read_r_3D: " &
552 ! //trim(field%name)//" failed!")
553 ! endif
554 ! endif
555  endif
556 
557  !Stop the mpp timer.
558  call mpp_clock_end(mpp_read_clock)
559 
560  return
561 end subroutine mpp_io_unstructured_read_r_3D
562 
563 !------------------------------------------------------------------------------
564 
565 !----------
will
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call a get means do a wait to ensure put on remote PE is complete error call increase mpp_nml request_multiply call MPP_TRANSMIT get_len end if return end subroutine MPP_TRANSMIT_ ! MPP_BROADCAST ! subroutine but that doesn t allow !broadcast to a subset of PEs This version will
Definition: mpp_transmit_mpi.h:166
time_interp_external_mod::field
type(ext_fieldtype), dimension(:), pointer, save, private field
Definition: time_interp_external.F90:137
integer
*f90 *************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_UPDATE_NEST_FINE_2D_(field, nest_domain, wbuffer, ebuffer, sbuffer, nbuffer, &flags, complete, position, extra_halo, name, tile_count) MPP_TYPE_, intent(in) ::field(:,:) type(nest_domain_type), intent(inout) ::nest_domain MPP_TYPE_, intent(inout) ::wbuffer(:,:) MPP_TYPE_, intent(inout) ::ebuffer(:,:) MPP_TYPE_, intent(inout) ::sbuffer(:,:) MPP_TYPE_, intent(inout) ::nbuffer(:,:) integer, intent(in), optional ::flags logical, intent(in), optional ::complete integer, intent(in), optional ::position integer, intent(in), optional ::extra_halo character(len= *), intent(in), optional ::name integer, intent(in), optional ::tile_count MPP_TYPE_ ::field3D(size(field, 1), size(field, 2), 1) MPP_TYPE_ ::wbuffer3D(size(wbuffer, 1), size(wbuffer, 2), 1) MPP_TYPE_ ::ebuffer3D(size(ebuffer, 1), size(ebuffer, 2), 1) MPP_TYPE_ ::sbuffer3D(size(sbuffer, 1), size(sbuffer, 2), 1) MPP_TYPE_ ::nbuffer3D(size(nbuffer, 1), size(nbuffer, 2), 1) pointer(ptr, field3D) pointer(ptr_w, wbuffer3D) pointer(ptr_e, ebuffer3D) pointer(ptr_s, sbuffer3D) pointer(ptr_n, nbuffer3D) ptr=LOC(field) ptr_w=LOC(wbuffer) ptr_e=LOC(ebuffer) ptr_s=LOC(sbuffer) ptr_n=LOC(nbuffer) call mpp_update_nest_fine(field3D, nest_domain, wbuffer3D, ebuffer3D, sbuffer3D, nbuffer3D, &flags, complete, position, extra_halo, name, tile_count) returnend subroutine MPP_UPDATE_NEST_FINE_2D_subroutine MPP_UPDATE_NEST_FINE_3D_(field, nest_domain, wbuffer, sbuffer, ebuffer, nbuffer, &flags, complete, position, extra_halo, name, tile_count) MPP_TYPE_, intent(in) ::field(:,:,:) type(nest_domain_type), intent(inout) ::nest_domain MPP_TYPE_, intent(inout) ::wbuffer(:,:,:) MPP_TYPE_, intent(inout) ::ebuffer(:,:,:) MPP_TYPE_, intent(inout) ::sbuffer(:,:,:) MPP_TYPE_, intent(inout) ::nbuffer(:,:,:) integer, intent(in), optional ::flags logical, intent(in), optional ::complete integer, intent(in), optional ::position integer, intent(in), optional ::extra_halo character(len= *), intent(in), optional ::name integer, intent(in), optional ::tile_count MPP_TYPE_ ::d_type type(nestSpec), pointer ::update=> set_mismatch integer ::tile update_position nbuffersz l_size integer
Definition: mpp_update_nest_domains.h:79
unit
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> unit
Definition: mpp_read_2Ddecomp.h:167
field_manager_mod::equal
character(len=1), parameter equal
Definition: field_manager.F90:473
crtm_aerosol_define::read_record
integer function read_record(fid, aerosol)
Definition: CRTM_Aerosol_Define.f90:1445
allocatable
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_WRITE_UNLIMITED_AXIS_1D_(unit, field, domain, data, nelems_io) integer, intent(in) ::unit type(fieldtype), intent(inout) ::field type(domain2D), intent(inout) ::domain MPP_TYPE_, intent(inout) ::data(:) integer, intent(in) ::nelems_io(:) ! number of compressed elements from each ! member of the io_domain. It MUST have the ! same order as the io_domain pelist. integer, allocatable ::pelist(:) integer ::i, j, nelems, npes type(domain2d), pointer ::io_domain=> allocatable
Definition: mpp_write_unlimited_axis.h:30
fv3jedi_increment_mod::copy
subroutine, public copy(self, rhs)
Definition: fv3jedi_increment_mod.f90:254
end
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call a get means do a wait to ensure put on remote PE is complete error call increase mpp_nml request_multiply call MPP_TRANSMIT end
Definition: mpp_transmit_mpi.h:153
binary_file_utility::true
integer(long), parameter true
Definition: Binary_File_Utility.f90:61
make_check_data.out
out
Definition: make_check_data.py:458
gsw_mod_check_data::p
real(r8), dimension(cast_m, cast_n) p
Definition: gsw_mod_check_data.f90:247
type_kinds::single
integer, parameter, public single
Definition: Type_Kinds.f90:105
binary_file_utility::false
integer(long), parameter false
Definition: Binary_File_Utility.f90:60
if
l_size ! loop over number of fields ke do je do ie to je n if(.NOT. d_comm%R_do_buf(list)) cycle from_pe
amip_interp_mod::module_is_initialized
logical module_is_initialized
Definition: amip_interp.F90:272
diag_integral_mod::version
character(len=128) version
Definition: diag_integral.F90:121
accoeff_define::zero
real(double), parameter zero
Definition: ACCoeff_Define.f90:68
is
l_size ! loop over number of fields ke do je do ie to is
Definition: mpp_do_redistribute.h:72
c2f.type
type
Definition: c2f.py:15
mpp_file
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> mpp_file(unit)%id
start
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> tlevel if(PRESENT(start_in) .AND. PRESENT(axsiz_in)) then if(size(start(! the data domain and compute domain must refer to the subdomain being passed ! In this ! since that attempts to gather all data on PE start
Definition: mpp_read_2Ddecomp.h:197
mpp_error
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call mpp_error(FATAL, 'MPP_TRANSMIT:you cannot transmit to ANY_PE using MPI.') else if(to_pe.NE.NULL_PE) then !no other valid cases except NULL_PE call mpp_error(FATAL
case
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> tlevel if(PRESENT(start_in) .AND. PRESENT(axsiz_in)) then if(size(start(! the data domain and compute domain must refer to the subdomain being passed ! In this case
Definition: mpp_read_2Ddecomp.h:169
mpp_io_mod::mpp_read_clock
integer mpp_read_clock
Definition: mpp_io.F90:1054
fv_control_nlm_mod::fill
logical, pointer fill
Definition: fv_control_nlm.F90:170
azimuth_emissivity_f6_module::three
real(fp), parameter three
Definition: Azimuth_Emissivity_F6_Module.f90:49
accoeff_define::one
real(double), parameter one
Definition: ACCoeff_Define.f90:69
type_distribution::received
logical function received(this, seqno)
Definition: m_distribution.f90:72
fv3jedi_increment_mod::check
subroutine check(self)
Definition: fv3jedi_increment_mod.f90:1932
LONG_KIND
#define LONG_KIND
field_manager_mod::root
type(field_def), target, save root
Definition: field_manager.F90:564
size
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> tlevel if(PRESENT(start_in) .AND. PRESENT(axsiz_in)) then if(size(start(! the data domain and compute domain must refer to the subdomain being passed ! In this ! since that attempts to gather all data on PE size(field%axes(:)) axsiz(i)
a
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call a get means do a wait to ensure put on remote PE is complete error call increase mpp_nml request_multiply call MPP_TRANSMIT get_len end if return end subroutine MPP_TRANSMIT_ ! MPP_BROADCAST ! subroutine but that doesn t allow !broadcast to a subset of PEs This version and mpp_transmit will remain !backward compatible intent(inout) a
Definition: mpp_transmit_mpi.h:178
dimension
*f90 *************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_UPDATE_NEST_FINE_2D_(field, nest_domain, wbuffer, ebuffer, sbuffer, nbuffer, &flags, complete, position, extra_halo, name, tile_count) MPP_TYPE_, intent(in) ::field(:,:) type(nest_domain_type), intent(inout) ::nest_domain MPP_TYPE_, intent(inout) ::wbuffer(:,:) MPP_TYPE_, intent(inout) ::ebuffer(:,:) MPP_TYPE_, intent(inout) ::sbuffer(:,:) MPP_TYPE_, intent(inout) ::nbuffer(:,:) integer, intent(in), optional ::flags logical, intent(in), optional ::complete integer, intent(in), optional ::position integer, intent(in), optional ::extra_halo character(len= *), intent(in), optional ::name integer, intent(in), optional ::tile_count MPP_TYPE_ ::field3D(size(field, 1), size(field, 2), 1) MPP_TYPE_ ::wbuffer3D(size(wbuffer, 1), size(wbuffer, 2), 1) MPP_TYPE_ ::ebuffer3D(size(ebuffer, 1), size(ebuffer, 2), 1) MPP_TYPE_ ::sbuffer3D(size(sbuffer, 1), size(sbuffer, 2), 1) MPP_TYPE_ ::nbuffer3D(size(nbuffer, 1), size(nbuffer, 2), 1) pointer(ptr, field3D) pointer(ptr_w, wbuffer3D) pointer(ptr_e, ebuffer3D) pointer(ptr_s, sbuffer3D) pointer(ptr_n, nbuffer3D) ptr=LOC(field) ptr_w=LOC(wbuffer) ptr_e=LOC(ebuffer) ptr_s=LOC(sbuffer) ptr_n=LOC(nbuffer) call mpp_update_nest_fine(field3D, nest_domain, wbuffer3D, ebuffer3D, sbuffer3D, nbuffer3D, &flags, complete, position, extra_halo, name, tile_count) returnend subroutine MPP_UPDATE_NEST_FINE_2D_subroutine MPP_UPDATE_NEST_FINE_3D_(field, nest_domain, wbuffer, sbuffer, ebuffer, nbuffer, &flags, complete, position, extra_halo, name, tile_count) MPP_TYPE_, intent(in) ::field(:,:,:) type(nest_domain_type), intent(inout) ::nest_domain MPP_TYPE_, intent(inout) ::wbuffer(:,:,:) MPP_TYPE_, intent(inout) ::ebuffer(:,:,:) MPP_TYPE_, intent(inout) ::sbuffer(:,:,:) MPP_TYPE_, intent(inout) ::nbuffer(:,:,:) integer, intent(in), optional ::flags logical, intent(in), optional ::complete integer, intent(in), optional ::position integer, intent(in), optional ::extra_halo character(len= *), intent(in), optional ::name integer, intent(in), optional ::tile_count MPP_TYPE_ ::d_type type(nestSpec), pointer ::update=> dimension(MAX_DOMAIN_FIELDS)
station_data_mod::pelist
integer, dimension(:), allocatable pelist
Definition: station_data.F90:293
not
*f90 *************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If not
Definition: drifters_compute_k.h:5
INT_KIND
#define INT_KIND
mpp_io_mod::default_field
type(fieldtype), save, public default_field
Definition: mpp_io.F90:1072
c2f.module
module
Definition: c2f.py:21
tools_repro::eq
logical function, public eq(x, y)
Definition: tools_repro.F90:28