FV3 Bundle
mpp_io.F90
Go to the documentation of this file.
1 !***********************************************************************
2 !* GNU Lesser General Public License
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* FMS is free software: you can redistribute it and/or modify it under
7 !* the terms of the GNU Lesser General Public License as published by
8 !* the Free Software Foundation, either version 3 of the License, or (at
9 !* your option) any later version.
10 !*
11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 !* for more details.
15 !*
16 !* You should have received a copy of the GNU Lesser General Public
17 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18 !***********************************************************************
19 !-----------------------------------------------------------------------
20 ! Parallel I/O for message-passing codes
21 !
22 ! AUTHOR: V. Balaji (vb@gfdl.gov)
23 ! SGI/GFDL Princeton University
24 !
25 ! This program is free software; you can redistribute it and/or modify
26 ! it under the terms of the GNU General Public License as published by
27 ! the Free Software Foundation; either version 2 of the License, or
28 ! (at your option) any later version.
29 !
30 ! This program is distributed in the hope that it will be useful,
31 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
32 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
33 ! GNU General Public License for more details.
34 !
35 ! For the full text of the GNU General Public License,
36 ! write to: Free Software Foundation, Inc.,
37 ! 675 Mass Ave, Cambridge, MA 02139, USA.
38 !-----------------------------------------------------------------------
39 
40 ! <CONTACT EMAIL="vb@gfdl.noaa.gov">
41 ! V. Balaji
42 ! </CONTACT>
43 
44 ! <HISTORY SRC="http://www.gfdl.noaa.gov/fms-cgi-bin/cvsweb.cgi/FMS/"/>
45 ! <RCSLOG SRC="http://www.gfdl.noaa.gov/~vb/changes_mpp_io.html"/>
46 
47 ! <OVERVIEW>
48 ! <TT>mpp_io_mod</TT>, is a set of simple calls for parallel I/O on
49 ! distributed systems. It is geared toward the writing of data in netCDF
50 ! format. It requires the modules <LINK
51 ! SRC="mpp_domains.html">mpp_domains_mod</LINK> and <LINK
52 ! SRC="mpp.html">mpp_mod</LINK>, upon which it is built.
53 ! </OVERVIEW>
54 
55 ! <DESCRIPTION>
56 ! In massively parallel environments, an often difficult problem is
57 ! the reading and writing of data to files on disk. MPI-IO and MPI-2 IO
58 ! are moving toward providing this capability, but are currently not
59 ! widely implemented. Further, it is a rather abstruse
60 ! API. <TT>mpp_io_mod</TT> is an attempt at a simple API encompassing a
61 ! certain variety of the I/O tasks that will be required. It does not
62 ! attempt to be an all-encompassing standard such as MPI, however, it
63 ! can be implemented in MPI if so desired. It is equally simple to add
64 ! parallel I/O capability to <TT>mpp_io_mod</TT> based on vendor-specific
65 ! APIs while providing a layer of insulation for user codes.
66 !
67 ! The <TT>mpp_io_mod</TT> parallel I/O API built on top of the <LINK
68 ! SRC="mpp_domains.html">mpp_domains_mod</LINK> and <LINK
69 ! SRC="mpp.html">mpp_mod</LINK> API for domain decomposition and
70 ! message passing. Features of <TT>mpp_io_mod</TT> include:
71 !
72 ! 1) Simple, minimal API, with free access to underlying API for more
73 ! complicated stuff.<BR/>
74 ! 2) Self-describing files: comprehensive header information
75 ! (metadata) in the file itself.<BR/>
76 ! 3) Strong focus on performance of parallel write: the climate models
77 ! for which it is designed typically read a minimal amount of data
78 ! (typically at the beginning of the run); but on the other hand, tend
79 ! to write copious amounts of data during the run. An interface for
80 ! reading is also supplied, but its performance has not yet been optimized.<BR/>
81 ! 4) Integrated netCDF capability: <LINK SRC
82 ! ="http://www.unidata.ucar.edu/packages/netcdf/">netCDF</LINK> is a
83 ! data format widely used in the climate/weather modeling
84 ! community. netCDF is considered the principal medium of data storage
85 ! for <TT>mpp_io_mod</TT>. But I provide a raw unformatted
86 ! fortran I/O capability in case netCDF is not an option, either due to
87 ! unavailability, inappropriateness, or poor performance.<BR/>
88 ! 5) May require off-line post-processing: a tool for this purpose,
89 ! <TT>mppnccombine</TT>, is available. GFDL users may use
90 ! <TT>~hnv/pub/mppnccombine</TT>. Outside users may obtain the
91 ! source <LINK SRC
92 ! ="ftp://ftp.gfdl.gov/perm/hnv/mpp/mppnccombine.c">here</LINK>. It
93 ! can be compiled on any C compiler and linked with the netCDF
94 ! library. The program is free and is covered by the <LINK SRC
95 ! ="ftp://ftp.gfdl.gov/perm/hnv/mpp/LICENSE">GPL license</LINK>.
96 !
97 ! The internal representation of the data being written out is
98 ! assumed be the default real type, which can be 4 or 8-byte. Time data
99 ! is always written as 8-bytes to avoid overflow on climatic time scales
100 ! in units of seconds.
101 !
102 ! <LINK SRC="modes"></LINK><H4>I/O modes in <TT>mpp_io_mod</TT></H4>
103 !
104 ! The I/O activity critical to performance in the models for which
105 ! <TT>mpp_io_mod</TT> is designed is typically the writing of large
106 ! datasets on a model grid volume produced at intervals during
107 ! a run. Consider a 3D grid volume, where model arrays are stored as
108 ! <TT>(i,j,k)</TT>. The domain decomposition is typically along
109 ! <TT>i</TT> or <TT>j</TT>: thus to store data to disk as a global
110 ! volume, the distributed chunks of data have to be seen as
111 ! non-contiguous. If we attempt to have all PEs write this data into a
112 ! single file, performance can be seriously compromised because of the
113 ! data reordering that will be required. Possible options are to have
114 ! one PE acquire all the data and write it out, or to have all the PEs
115 ! write independent files, which are recombined offline. These three
116 ! modes of operation are described in the <TT>mpp_io_mod</TT> terminology
117 ! in terms of two parameters, <I>threading</I> and <I>fileset</I>,
118 ! as follows:
119 !
120 ! <I>Single-threaded I/O:</I> a single PE acquires all the data
121 ! and writes it out.<BR/>
122 ! <I>Multi-threaded, single-fileset I/O:</I> many PEs write to a
123 ! single file.<BR/>
124 ! <I>Multi-threaded, multi-fileset I/O:</I> many PEs write to
125 ! independent files. This is also called <I>distributed I/O</I>.
126 !
127 ! The middle option is the most difficult to achieve performance. The
128 ! choice of one of these modes is made when a file is opened for I/O, in
129 ! <LINK SRC="#mpp_open">mpp_open</LINK>.
130 !
131 ! <LINK name="metadata"></LINK><H4>Metadata in <TT>mpp_io_mod</TT></H4>
132 !
133 ! A requirement of the design of <TT>mpp_io_mod</TT> is that the file must
134 ! be entirely self-describing: comprehensive header information
135 ! describing its contents is present in the header of every file. The
136 ! header information follows the model of netCDF. Variables in the file
137 ! are divided into <I>axes</I> and <I>fields</I>. An axis describes a
138 ! co-ordinate variable, e.g <TT>x,y,z,t</TT>. A field consists of data in
139 ! the space described by the axes. An axis is described in
140 ! <TT>mpp_io_mod</TT> using the defined type <TT>axistype</TT>:
141 !
142 ! <PRE>
143 ! type, public :: axistype
144 ! sequence
145 ! character(len=128) :: name
146 ! character(len=128) :: units
147 ! character(len=256) :: longname
148 ! character(len=8) :: cartesian
149 ! integer :: len
150 ! integer :: sense !+/-1, depth or height?
151 ! type(domain1D), pointer :: domain
152 ! real, dimension(:), pointer :: data
153 ! integer :: id, did
154 ! integer :: type ! external NetCDF type format for axis data
155 ! integer :: natt
156 ! type(atttype), pointer :: Att(:) ! axis attributes
157 ! end type axistype
158 ! </PRE>
159 !
160 ! A field is described using the type <TT>fieldtype</TT>:
161 !
162 ! <PRE>
163 ! type, public :: fieldtype
164 ! sequence
165 ! character(len=128) :: name
166 ! character(len=128) :: units
167 ! character(len=256) :: longname
168 ! real :: min, max, missing, fill, scale, add
169 ! integer :: pack
170 ! type(axistype), dimension(:), pointer :: axes
171 ! integer, dimension(:), pointer :: size
172 ! integer :: time_axis_index
173 ! integer :: id
174 ! integer :: type ! external NetCDF format for field data
175 ! integer :: natt, ndim
176 ! type(atttype), pointer :: Att(:) ! field metadata
177 ! end type fieldtype
178 ! </PRE>
179 !
180 ! An attribute (global, field or axis) is described using the <TT>atttype</TT>:
181 !
182 ! <PRE>
183 ! type, public :: atttype
184 ! sequence
185 ! integer :: type, len
186 ! character(len=128) :: name
187 ! character(len=256) :: catt
188 ! real(FLOAT_KIND), pointer :: fatt(:)
189 ! end type atttype
190 ! </PRE>
191 !
192 ! <LINK name="packing"></LINK>This default set of field attributes corresponds
193 ! closely to various conventions established for netCDF files. The
194 ! <TT>pack</TT> attribute of a field defines whether or not a
195 ! field is to be packed on output. Allowed values of
196 ! <TT>pack</TT> are 1,2,4 and 8. The value of
197 ! <TT>pack</TT> is the number of variables written into 8
198 ! bytes. In typical use, we write 4-byte reals to netCDF output; thus
199 ! the default value of <TT>pack</TT> is 2. For
200 ! <TT>pack</TT> = 4 or 8, packing uses a simple-minded linear
201 ! scaling scheme using the <TT>scale</TT> and <TT>add</TT>
202 ! attributes. There is thus likely to be a significant loss of dynamic
203 ! range with packing. When a field is declared to be packed, the
204 ! <TT>missing</TT> and <TT>fill</TT> attributes, if
205 ! supplied, are packed also.
206 !
207 ! Please note that the pack values are the same even if the default
208 ! real is 4 bytes, i.e <TT>PACK=1</TT> still follows the definition
209 ! above and writes out 8 bytes.
210 !
211 ! A set of <I>attributes</I> for each variable is also available. The
212 ! variable definitions and attribute information is written/read by calling
213 ! <LINK SRC="#mpp_write_meta">mpp_write_meta</LINK> or <LINK SRC="#mpp_read_meta">mpp_read_meta</LINK>. A typical calling
214 ! sequence for writing data might be:
215 !
216 ! <PRE>
217 ! ...
218 ! type(domain2D), dimension(:), allocatable, target :: domain
219 ! type(fieldtype) :: field
220 ! type(axistype) :: x, y, z, t
221 ! ...
222 ! call mpp_define_domains( (/1,nx,1,ny/), domain )
223 ! allocate( a(domain(pe)%x%data%start_index:domain(pe)%x%data%end_index, &
224 ! domain(pe)%y%data%start_index:domain(pe)%y%data%end_index,nz) )
225 ! ...
226 ! call mpp_write_meta( unit, x, 'X', 'km', 'X distance', &
227 ! domain=domain(pe)%x, data=(/(float(i),i=1,nx)/) )
228 ! call mpp_write_meta( unit, y, 'Y', 'km', 'Y distance', &
229 ! domain=domain(pe)%y, data=(/(float(i),i=1,ny)/) )
230 ! call mpp_write_meta( unit, z, 'Z', 'km', 'Z distance', &
231 ! data=(/(float(i),i=1,nz)/) )
232 ! call mpp_write_meta( unit, t, 'Time', 'second', 'Time' )
233 !
234 ! call mpp_write_meta( unit, field, (/x,y,z,t/), 'a', '(m/s)', AAA', &
235 ! missing=-1e36 )
236 ! ...
237 ! call mpp_write( unit, x )
238 ! call mpp_write( unit, y )
239 ! call mpp_write( unit, z )
240 ! ...
241 ! </PRE>
242 !
243 ! In this example, <TT>x</TT> and <TT>y</TT> have been
244 ! declared as distributed axes, since a domain decomposition has been
245 ! associated. <TT>z</TT> and <TT>t</TT> are undistributed
246 ! axes. <TT>t</TT> is known to be a <I>record</I> axis (netCDF
247 ! terminology) since we do not allocate the <TT>data</TT> element
248 ! of the <TT>axistype</TT>. <I>Only one record axis may be
249 ! associated with a file.</I> The call to <LINK
250 ! SRC="#mpp_write_meta">mpp_write_meta</LINK> initializes
251 ! the axes, and associates a unique variable ID with each axis. The call
252 ! to <TT>mpp_write_meta</TT> with argument <TT>field</TT>
253 ! declared <TT>field</TT> to be a 4D variable that is a function
254 ! of <TT>(x,y,z,t)</TT>, and a unique variable ID is associated
255 ! with it. A 3D field will be written at each call to
256 ! <TT>mpp_write(field)</TT>.
257 !
258 ! The data to any variable, including axes, is written by
259 ! <TT>mpp_write</TT>.
260 !
261 ! Any additional attributes of variables can be added through
262 ! subsequent <TT>mpp_write_meta</TT> calls, using the variable ID as a
263 ! handle. <I>Global</I> attributes, associated with the dataset as a
264 ! whole, can also be written thus. See the <LINK
265 ! SRC="#mpp_write_meta">mpp_write_meta</LINK> call syntax below
266 ! for further details.
267 !
268 ! You cannot interleave calls to <TT>mpp_write</TT> and
269 ! <TT>mpp_write_meta</TT>: the first call to
270 ! <TT>mpp_write</TT> implies that metadata specification is
271 ! complete.
272 !
273 ! A typical calling sequence for reading data might be:
274 !
275 ! <PRE>
276 ! ...
277 ! integer :: unit, natt, nvar, ntime
278 ! type(domain2D), dimension(:), allocatable, target :: domain
279 ! type(fieldtype), allocatable, dimension(:) :: fields
280 ! type(atttype), allocatable, dimension(:) :: global_atts
281 ! real, allocatable, dimension(:) :: times
282 ! ...
283 ! call mpp_define_domains( (/1,nx,1,ny/), domain )
284 !
285 ! call mpp_read_meta(unit)
286 ! call mpp_get_info(unit,natt,nvar,ntime)
287 ! allocate(global_atts(natt))
288 ! call mpp_get_atts(unit,global_atts)
289 ! allocate(fields(nvar))
290 ! call mpp_get_vars(unit, fields)
291 ! allocate(times(ntime))
292 ! call mpp_get_times(unit, times)
293 !
294 ! allocate( a(domain(pe)%x%data%start_index:domain(pe)%x%data%end_index, &
295 ! domain(pe)%y%data%start_index:domain(pe)%y%data%end_index,nz) )
296 ! ...
297 ! do i=1, nvar
298 ! if (fields(i)%name == 'a') call mpp_read(unit,fields(i),domain(pe), a,
299 ! tindex)
300 ! enddo
301 ! ...
302 ! </PRE>
303 !
304 ! In this example, the data are distributed as in the previous
305 ! example. The call to <LINK
306 ! SRC="#mpp_read_meta">mpp_read_meta</LINK> initializes
307 ! all of the metadata associated with the file, including global
308 ! attributes, variable attributes and non-record dimension data. The
309 ! call to <TT>mpp_get_info</TT> returns the number of global
310 ! attributes (<TT>natt</TT>), variables (<TT>nvar</TT>) and
311 ! time levels (<TT>ntime</TT>) associated with the file
312 ! identified by a unique ID (<TT>unit</TT>).
313 ! <TT>mpp_get_atts</TT> returns all global attributes for
314 ! the file in the derived type <TT>atttype(natt)</TT>.
315 ! <TT>mpp_get_vars</TT> returns variable types
316 ! (<TT>fieldtype(nvar)</TT>). Since the record dimension data are not allocated for calls to <LINK SRC="#mpp_write">mpp_write</LINK>, a separate call to <TT>mpp_get_times</TT> is required to access record dimension data. Subsequent calls to
317 ! <TT>mpp_read</TT> return the field data arrays corresponding to
318 ! the fieldtype. The <TT>domain</TT> type is an optional
319 ! argument. If <TT>domain</TT> is omitted, the incoming field
320 ! array should be dimensioned for the global domain, otherwise, the
321 ! field data is assigned to the computational domain of a local array.
322 !
323 ! <I>Multi-fileset</I> reads are not supported with <TT>mpp_read</TT>.
324 
325 ! </DESCRIPTION>
326 
328 
329 #include <fms_platform.h>
330 #define _MAX_FILE_UNITS 1024
331 
338 use mpp_mod, only : mpp_error, fatal, warning, note, stdin, stdout, stderr, stdlog
339 use mpp_mod, only : mpp_pe, mpp_root_pe, mpp_npes, lowercase, mpp_transmit, mpp_sync_self
340 use mpp_mod, only : mpp_init, mpp_sync, mpp_clock_id, mpp_clock_begin, mpp_clock_end
341 use mpp_mod, only : mpp_clock_sync, mpp_clock_detailed, clock_routine
343 use mpp_mod, only : mpp_send, mpp_recv, mpp_sync_self, event_recv, comm_tag_1
344 use mpp_domains_mod, only : domain1d, domain2d, null_domain1d, mpp_domains_init
347 use mpp_domains_mod, only : mpp_update_domains, mpp_global_field, mpp_domain_is_symmetry
348 use mpp_domains_mod, only : operator( .NE. ), mpp_get_domain_shift, mpp_get_ug_compute_domains
349 use mpp_domains_mod, only : mpp_get_io_domain, mpp_domain_is_tile_root_pe, mpp_get_domain_tile_root_pe
350 use mpp_domains_mod, only : mpp_get_tile_id, mpp_get_tile_npes, mpp_get_io_domain_layout
351 use mpp_domains_mod, only : mpp_get_domain_name, mpp_get_domain_npes
353 use mpp_mod, only : mpp_chksum
354 
355 !----------
356 !ug support
357 use mpp_domains_mod, only: domainug, &
358  mpp_get_ug_io_domain, &
359  mpp_domain_ug_is_tile_root_pe, &
360  mpp_get_ug_domain_tile_id, &
361  mpp_get_ug_domain_npes, &
362  mpp_get_io_domain_ug_layout, &
363  mpp_get_ug_compute_domain, &
364  mpp_get_ug_domain_pelist
365 !----------
366 
367 implicit none
368 private
369 
370 #ifdef use_netCDF
371 #include <netcdf.inc>
372 #endif
373 
374  !--- public parameters -----------------------------------------------
375  public :: mpp_wronly, mpp_rdonly, mpp_append, mpp_overwr, mpp_ascii, mpp_ieee32
376  public :: mpp_native, mpp_netcdf, mpp_sequential, mpp_direct, mpp_single
377  public :: mpp_multi, mpp_delete, mpp_collect
378  public :: file_type_used
379  public :: max_file_size
380  !--- public data type ------------------------------------------------
382 
383  !--- public data -----------------------------------------------------
385 
386  !--- public interface from mpp_io_util.h ----------------------
387  public :: mpp_get_iospec, mpp_get_id, mpp_get_ncid, mpp_get_unit_range, mpp_is_valid
388  public :: mpp_set_unit_range, mpp_get_info, mpp_get_atts, mpp_get_fields
389  public :: mpp_get_times, mpp_get_axes, mpp_get_recdimid, mpp_get_axis_data, mpp_get_axis_by_name
390  public :: mpp_io_set_stack_size, mpp_get_field_index, mpp_get_axis_index
391  public :: mpp_get_field_name, mpp_get_att_value, mpp_get_att_length
392  public :: mpp_get_att_type, mpp_get_att_name, mpp_get_att_real, mpp_get_att_char
393  public :: mpp_get_att_real_scalar, mpp_get_axis_length, mpp_is_dist_ioroot
394  public :: mpp_get_file_name, mpp_file_is_opened, mpp_attribute_exist
395  public :: mpp_io_clock_on, mpp_get_time_axis, mpp_get_default_calendar
396  public :: mpp_get_dimension_length, mpp_get_axis_bounds
397 
398  !--- public interface from mpp_io_misc.h ----------------------
399  public :: mpp_io_init, mpp_io_exit, netcdf_err, mpp_flush, mpp_get_maxunits, do_cf_compliance
400 
401  !--- public interface from mpp_io_write.h ---------------------
402  public :: mpp_write, mpp_write_meta, mpp_copy_meta, mpp_modify_meta, mpp_write_axis_data, mpp_def_dim
403 
404  !--- public interface from mpp_io_read.h ---------------------
405  public :: mpp_read, mpp_read_meta, mpp_get_tavg_info
407 
408  !--- public interface from mpp_io_switch.h ---------------------
409  public :: mpp_open, mpp_close
410 
411  !-----------------------------------------------------------------------------
412  !--- mpp_io data types
413  !-----------------------------------------------------------------------------
415 integer, parameter :: max_att_length = 1280
416 type :: atttype
417  private
418  integer :: type, len
419  character(len=128) :: name
420  character(len=MAX_ATT_LENGTH) :: catt
421  real, pointer :: fatt(:) =>null() ! just use type conversion for integers
422  end type atttype
423 
424  type :: axistype
425  private
426  character(len=128) :: name
427  character(len=128) :: name_bounds
428  character(len=128) :: units
429  character(len=256) :: longname
430  character(len=8) :: cartesian
431  character(len=256) :: compressed
432  character(len=24) :: calendar
433  integer :: sense, len !+/-1, depth or height?
434  type(domain1d) :: domain !if pointer is associated, it is a distributed data axis
435  real, pointer :: data(:) =>null() !axis values (not used if time axis)
436  real, pointer :: data_bounds(:) =>null() !axis bounds values
437  integer, pointer :: idata(:) =>null() !compressed axis valuesi
438  integer :: id, did, type, natt !id is the "variable ID", did is the "dimension ID":
439  !netCDF requires 2 IDs for axes
440  integer :: shift !normally is 0. when domain is symmetry, its value maybe 1.
441  type(atttype), pointer :: att(:) =>null()
442  end type axistype
443 
444  type :: validtype
445  private
446  logical :: is_range ! if true, then the data represent the valid range
447  real :: min,max ! boundaries of the valid range or missing value
448  end type validtype
449 
450  type :: fieldtype
451  private
452  character(len=128) :: name
453  character(len=128) :: units
454  character(len=256) :: longname
455  character(len=256) :: standard_name ! CF standard name
456  real :: min, max, missing, fill, scale, add
457  integer :: pack
458  integer(LONG_KIND), dimension(3) :: checksum
459  type(axistype), pointer :: axes(:) =>null() !axes associated with field size, time_axis_index redundantly
460  !hold info already contained in axes. it's clunky and inelegant,
461  !but required so that axes can be shared among multiple files
462  integer, pointer :: size(:) =>null()
463  integer :: time_axis_index
464  integer :: id, type, natt, ndim
465  type(atttype), pointer :: att(:) =>null()
466  integer :: position ! indicate the location of the data ( CENTER, NORTH, EAST, CORNER )
467  end type fieldtype
468 
469  type :: filetype
470  private
471  character(len=256) :: name
472  integer :: action, format, access, threading, fileset, record, ncid
473  logical :: opened, initialized, nohdrs
474  integer :: time_level
475  real(DOUBLE_KIND) :: time
476  logical :: valid
477  logical :: write_on_this_pe ! indicate if will write out from this pe
478  logical :: read_on_this_pe ! indicate if will read from this pe
479  logical :: io_domain_exist ! indicate if io_domain exist or not.
480  integer :: id !variable ID of time axis associated with file (only one time axis per file)
481  integer :: recdimid !dim ID of time axis associated with file (only one time axis per file)
482  real(DOUBLE_KIND), pointer :: time_values(:) =>null() ! time axis values are stored here instead of axis%data
483  ! since mpp_write assumes these values are not time values.
484  ! Not used in mpp_write
485  ! additional elements of filetype for mpp_read (ignored for mpp_write)
486  integer :: ndim, nvar, natt ! number of dimensions, non-dimension variables and global attributes
487  ! redundant axis types stored here and in associated fieldtype
488  ! some axes are not used by any fields, i.e. "edges"
489  type(axistype), pointer :: axis(:) =>null()
490  type(fieldtype), pointer :: var(:) =>null()
491  type(atttype), pointer :: att(:) =>null()
492  type(domain2d), pointer :: domain =>null()
493 !----------
494 !ug support
495  type(domainug),pointer :: domain_ug => null() !Is this actually pointed to?
496 !----------
497  end type filetype
498 
499 !***********************************************************************
500 !
501 ! public interface from mpp_io_util.h
502 !
503 !***********************************************************************
504  interface mpp_get_id
505  module procedure mpp_get_axis_id
506  module procedure mpp_get_field_id
507  end interface
508 
509 ! <INTERFACE NAME="mpp_get_atts">
510 ! <OVERVIEW>
511 ! Get file global metdata.
512 ! </OVERVIEW>
513 ! <DESCRIPTION>
514 ! Get file global metdata.
515 ! </DESCRIPTION>
516 ! <TEMPLATE>
517 ! call mpp_get_atts( unit, global_atts)
518 ! </TEMPLATE>
519 ! <IN NAME="unit"></IN>
520 ! <IN NAME="global_atts"></IN>
521 ! </INTERFACE>
522  interface mpp_get_atts
523  module procedure mpp_get_global_atts
524  module procedure mpp_get_field_atts
525  module procedure mpp_get_axis_atts
526  end interface
527 
529  module procedure mpp_get_field_att_text
530  end interface
531 
532 
533 !***********************************************************************
534 !
535 ! public interface from mpp_io_read.h
536 !
537 !***********************************************************************
538 ! <INTERFACE NAME="mpp_read">
539 ! <OVERVIEW>
540 ! Read from an open file.
541 ! </OVERVIEW>
542 ! <DESCRIPTION>
543 ! <TT>mpp_read</TT> is used to read data to the file on an I/O unit
544 ! using the file parameters supplied by <LINK
545 ! SRC="#mpp_open"><TT>mpp_open</TT></LINK>. There are two
546 ! forms of <TT>mpp_read</TT>, one to read
547 ! distributed field data, and one to read non-distributed field
548 ! data. <I>Distributed</I> data refer to arrays whose two
549 ! fastest-varying indices are domain-decomposed. Distributed data must
550 ! be 2D or 3D (in space). Non-distributed data can be 0-3D.
551 !
552 ! The <TT>data</TT> argument for distributed data is expected by
553 ! <TT>mpp_read</TT> to contain data specified on the <I>data</I> domain,
554 ! and will read the data belonging to the <I>compute</I> domain,
555 ! fetching data as required by the parallel I/O <LINK
556 ! SRC="#modes">mode</LINK> specified in the <TT>mpp_open</TT> call. This
557 ! is consistent with our definition of <LINK
558 ! SRC="http:mpp_domains.html#domains">domains</LINK>, where all arrays are
559 ! expected to be dimensioned on the data domain, and all operations
560 ! performed on the compute domain.
561 ! </DESCRIPTION>
562 ! <TEMPLATE>
563 ! call mpp_read( unit, field, data, time_index )
564 ! </TEMPLATE>
565 ! <TEMPLATE>
566 ! call mpp_read( unit, field, domain, data, time_index )
567 ! </TEMPLATE>
568 ! <IN NAME="unit"></IN>
569 ! <IN NAME="field"></IN>
570 ! <INOUT NAME="data"></INOUT>
571 ! <IN NAME="domain"></IN>
572 ! <IN NAME="time_index">
573 ! time_index is an optional argument. It is to be omitted if the
574 ! field was defined not to be a function of time. Results are
575 ! unpredictable if the argument is supplied for a time- independent
576 ! field, or omitted for a time-dependent field.
577 ! </IN>
578 ! <NOTE>
579 ! The type of read performed by <TT>mpp_read</TT> depends on
580 ! the file characteristics on the I/O unit specified at the <LINK
581 ! SRC="#mpp_open"><TT>mpp_open</TT></LINK> call. Specifically, the
582 ! format of the input data (e.g netCDF or IEEE) and the
583 ! <TT>threading</TT> flags, etc., can be changed there, and
584 ! require no changes to the <TT>mpp_read</TT>
585 ! calls. (<TT>fileset</TT> = MPP_MULTI is not supported by
586 ! <TT>mpp_read</TT>; IEEE is currently not supported).
587 !
588 ! Packed variables are unpacked using the <TT>scale</TT> and
589 ! <TT>add</TT> attributes.
590 !
591 ! <TT>mpp_read_meta</TT> must be called prior to calling <TT>mpp_read.</TT>
592 ! </NOTE>
593 ! </INTERFACE>
594  interface mpp_read
595  module procedure mpp_read_2ddecomp_r2d
596  module procedure mpp_read_2ddecomp_r3d
597  module procedure mpp_read_2ddecomp_r4d
598  module procedure mpp_read_r0d
599  module procedure mpp_read_r1d
600  module procedure mpp_read_r2d
601  module procedure mpp_read_r3d
602  module procedure mpp_read_r4d
603  module procedure mpp_read_text
604  module procedure mpp_read_region_r2d
605  module procedure mpp_read_region_r3d
606 #ifdef OVERLOAD_R8
607  module procedure mpp_read_region_r2d_r8
608  module procedure mpp_read_region_r3d_r8
609  module procedure mpp_read_2ddecomp_r2d_r8
610  module procedure mpp_read_2ddecomp_r3d_r8
611  module procedure mpp_read_2ddecomp_r4d_r8
612 #endif
613  end interface
614 
615 !***********************************************************************
616 !
617 ! public interfaces from mpp_io_read_distributed_ascii.inc
618 !
619 !***********************************************************************
620 ! <INTERFACE NAME="mpp_read_distributed_ascii">
621 ! <OVERVIEW>
622 ! Read from an opened, ascii file, translating data to the desired format
623 ! </OVERVIEW>
624 ! <DESCRIPTION>
625 ! These routines are part of the mpp_read family. It is intended to
626 ! provide a general purpose, distributed, list directed read
627 ! </DESCRIPTION>
628 ! <TEMPLATE>
629 ! call mpp_read_distributed_ascii(unit,fmt,ssize,data,iostat)
630 ! </TEMPLATE>
631 ! <IN NAME="unit"></IN>
632 ! <IN NAME="fmt"></IN>
633 ! <IN NAME="ssize"></IN>
634 ! <INOUT NAME="data"></IN>
635 ! <OUT NAME="iostat">
636 ! </IN>
637 ! <NOTE>
638 ! <TT>mpp_read_distributed_ascii</TT>
639 ! The stripe size must be greater than or equal to 1. The stripe
640 ! size does not have to be a common denominator of the number of
641 ! MPI ranks.
642 ! </NOTE>
643 ! </INTERFACE>
645  module procedure mpp_read_distributed_ascii_r1d
646  module procedure mpp_read_distributed_ascii_i1d
647  module procedure mpp_read_distributed_ascii_a1d
648  end interface
649 
650 
651 !***********************************************************************
652 !
653 ! public interfaces from mpp_io_read_compressed.h
654 !
655 !***********************************************************************
656 ! <INTERFACE NAME="mpp_read_compressed">
657 ! <OVERVIEW>
658 ! Read from an opened, sparse data, compressed file (e.g. land_model)
659 ! </OVERVIEW>
660 ! <DESCRIPTION>
661 ! These routines are similar to mpp_read except that they are designed
662 ! to handle sparse, compressed vectors of data such as from the
663 ! land model. Currently, the sparse vector may vary in z. Hence
664 ! the need for the rank 2 treatment.
665 ! </DESCRIPTION>
666 ! <TEMPLATE>
667 ! call mpp_read_compressed( unit, field, domain, data, time_index )
668 ! </TEMPLATE>
669 ! <IN NAME="unit"></IN>
670 ! <IN NAME="field"></IN>
671 ! <IN NAME="domain"></IN>
672 ! <INOUT NAME="data"></INOUT>
673 ! <IN NAME="time_index">
674 ! time_index is an optional argument. It is to be omitted if the
675 ! field was defined not to be a function of time. Results are
676 ! unpredictable if the argument is supplied for a time- independent
677 ! field, or omitted for a time-dependent field.
678 ! </IN>
679 ! <NOTE>
680 ! <TT>mpp_read_meta</TT> must be called prior to calling
681 ! <TT>mpp_read_compressed.</TT>
682 ! Since in general, the vector is distributed across the io-domain
683 ! The read expects the io_domain to be defined.
684 ! </NOTE>
685 ! </INTERFACE>
687  module procedure mpp_read_compressed_r1d
688  module procedure mpp_read_compressed_r2d
689  module procedure mpp_read_compressed_r3d
690  end interface mpp_read_compressed
691 
692 
693 !***********************************************************************
694 !
695 ! public interface from mpp_io_write.h
696 !
697 !***********************************************************************
698 
699 ! <INTERFACE NAME="mpp_write_meta">
700 ! <OVERVIEW>
701 ! Write metadata.
702 ! </OVERVIEW>
703 ! <DESCRIPTION>
704 ! This routine is used to write the <LINK SRC="#metadata">metadata</LINK>
705 ! describing the contents of a file being written. Each file can contain
706 ! any number of fields, which are functions of 0-3 space axes and 0-1
707 ! time axes. (Only one time axis can be defined per file). The basic
708 ! metadata defined <LINK SRC="#metadata">above</LINK> for <TT>axistype</TT>
709 ! and <TT>fieldtype</TT> are written in the first two forms of the call
710 ! shown below. These calls will associate a unique variable ID with each
711 ! variable (axis or field). These can be used to attach any other real,
712 ! integer or character attribute to a variable. The last form is used to
713 ! define a <I>global</I> real, integer or character attribute that
714 ! applies to the dataset as a whole.
715 ! </DESCRIPTION>
716 ! <TEMPLATE>
717 ! call mpp_write_meta( unit, axis, name, units, longname,
718 ! cartesian, sense, domain, data )
719 ! </TEMPLATE>
720 ! <NOTE>
721 ! The first form defines a time or space axis. Metadata corresponding to the type
722 ! above are written to the file on &lt;unit&gt;. A unique ID for subsequen
723 ! references to this axis is returned in axis%id. If the &lt;domain&gt;
724 ! element is present, this is recognized as a distributed data axis
725 ! and domain decomposition information is also written if required (the
726 ! domain decomposition info is required for multi-fileset multi-threaded
727 ! I/O). If the &lt;data&gt; element is allocated, it is considered to be a
728 ! space axis, otherwise it is a time axis with an unlimited dimension. Only
729 ! one time axis is allowed per file.
730 ! </NOTE>
731 ! <TEMPLATE>
732 ! call mpp_write_meta( unit, field, axes, name, units, longname,
733 ! min, max, missing, fill, scale, add, pack )
734 ! </TEMPLATE>
735 ! <NOTE>
736 ! The second form defines a field. Metadata corresponding to the type
737 ! above are written to the file on &lt;unit&gt;. A unique ID for subsequen
738 ! references to this field is returned in field%id. At least one axis
739 ! must be associated, 0D variables are not considered. mpp_write_meta
740 ! must previously have been called on all axes associated with this
741 ! field.
742 ! </NOTE>
743 ! <TEMPLATE>
744 ! call mpp_write_meta( unit, id, name, rval=rval, pack=pack )
745 ! </TEMPLATE>
746 ! <TEMPLATE>
747 ! call mpp_write_meta( unit, id, name, ival=ival )
748 ! </TEMPLATE>
749 ! <TEMPLATE>
750 ! call mpp_write_meta( unit, id, name, cval=cval )
751 ! </TEMPLATE>
752 ! <NOTE>
753 ! The third form (3 - 5) defines metadata associated with a previously defined
754 ! axis or field, identified to mpp_write_meta by its unique ID &lt;id&gt;.
755 ! The attribute is named &lt;name&gt; and can take on a real, integer
756 ! or character value. &lt;rval&gt; and &lt;ival&gt; can be scalar or 1D arrays.
757 ! This need not be called for attributes already contained in
758 ! the type.
759 ! </NOTE>
760 ! <TEMPLATE>
761 ! call mpp_write_meta( unit, name, rval=rval, pack=pack )
762 ! </TEMPLATE>
763 ! <TEMPLATE>
764 ! call mpp_write_meta( unit, name, ival=ival )
765 ! </TEMPLATE>
766 ! <TEMPLATE>
767 ! call mpp_write_meta( unit, name, cval=cval )
768 ! </TEMPLATE>
769 ! <NOTE>
770 ! The last form (6 - 8) defines global metadata associated with the file as a
771 ! whole. The attribute is named &lt;name&gt; and can take on a real, integer
772 ! or character value. &lt;rval&gt; and &lt;ival&gt; can be scalar or 1D arrays.
773 ! </NOTE>
774 ! <IN NAME="unit"></IN>
775 ! <OUT NAME="axis"></OUT>
776 ! <IN NAME="name"></IN>
777 ! <IN NAME="units"></IN>
778 ! <IN NAME="longname"></IN>
779 ! <IN NAME="cartesian"></IN>
780 ! <IN NAME="sense"></IN>
781 ! <IN NAME="domain"></IN>
782 ! <IN NAME="data"></IN>
783 ! <OUT NAME="field"></OUT>
784 ! <IN NAME="min, max"></IN>
785 ! <IN NAME="missing"></IN>
786 ! <IN NAME="fill"></IN>
787 ! <IN NAME="scale"></IN>
788 ! <IN NAME="add"></IN>
789 ! <IN NAME="pack"></IN>
790 ! <IN NAME="id"></IN>
791 ! <IN NAME="cval"></IN>
792 ! <IN NAME="ival"></IN>
793 ! <IN NAME="rval"></IN>
794 ! <NOTE>
795 ! Note that <TT>mpp_write_meta</TT> is expecting axis data on the
796 ! <I>global</I> domain even if it is a domain-decomposed axis.
797 !
798 ! You cannot interleave calls to <TT>mpp_write</TT> and
799 ! <TT>mpp_write_meta</TT>: the first call to
800 ! <TT>mpp_write</TT> implies that metadata specification is complete.
801 ! </NOTE>
802 ! </INTERFACE>
803  interface mpp_write_meta
804  module procedure mpp_write_meta_var
805  module procedure mpp_write_meta_scalar_r
806  module procedure mpp_write_meta_scalar_i
807  module procedure mpp_write_meta_axis_r1d
808  module procedure mpp_write_meta_axis_i1d
809  module procedure mpp_write_meta_axis_unlimited
810  module procedure mpp_write_meta_field
811  module procedure mpp_write_meta_global
812  module procedure mpp_write_meta_global_scalar_r
813  module procedure mpp_write_meta_global_scalar_i
814  end interface
815 
816  interface mpp_copy_meta
817  module procedure mpp_copy_meta_axis
818  module procedure mpp_copy_meta_field
819  module procedure mpp_copy_meta_global
820  end interface
821 
822  interface mpp_modify_meta
823 ! module procedure mpp_modify_att_meta
824  module procedure mpp_modify_field_meta
825  module procedure mpp_modify_axis_meta
826  end interface
827 
828 ! <INTERFACE NAME="mpp_write">
829 ! <OVERVIEW>
830 ! Write to an open file.
831 ! </OVERVIEW>
832 ! <DESCRIPTION>
833 ! <TT>mpp_write</TT> is used to write data to the file on an I/O unit
834 ! using the file parameters supplied by <LINK
835 ! SRC="#mpp_open"><TT>mpp_open</TT></LINK>. Axis and field definitions must
836 ! have previously been written to the file using <LINK
837 ! SRC="#mpp_write_meta"><TT>mpp_write_meta</TT></LINK>. There are three
838 ! forms of <TT>mpp_write</TT>, one to write axis data, one to write
839 ! distributed field data, and one to write non-distributed field
840 ! data. <I>Distributed</I> data refer to arrays whose two
841 ! fastest-varying indices are domain-decomposed. Distributed data must
842 ! be 2D or 3D (in space). Non-distributed data can be 0-3D.
843 !
844 ! The <TT>data</TT> argument for distributed data is expected by
845 ! <TT>mpp_write</TT> to contain data specified on the <I>data</I> domain,
846 ! and will write the data belonging to the <I>compute</I> domain,
847 ! fetching or sending data as required by the parallel I/O <LINK
848 ! SRC="#modes">mode</LINK> specified in the <TT>mpp_open</TT> call. This
849 ! is consistent with our definition of <LINK
850 ! SRC="http:mpp_domains.html#domains">domains</LINK>, where all arrays are
851 ! expected to be dimensioned on the data domain, and all operations
852 ! performed on the compute domain.
853 !
854 ! The type of the <TT>data</TT> argument must be a <I>default
855 ! real</I>, which can be 4 or 8 byte.
856 ! </DESCRIPTION>
857 ! <TEMPLATE>
858 ! mpp_write( unit, axis )
859 ! </TEMPLATE>
860 ! <TEMPLATE>
861 ! mpp_write( unit, field, data, tstamp )
862 ! </TEMPLATE>
863 ! <TEMPLATE>
864 ! mpp_write( unit, field, domain, data, tstamp )
865 ! </TEMPLATE>
866 ! <IN NAME="tstamp">
867 ! <TT>tstamp</TT> is an optional argument. It is to
868 ! be omitted if the field was defined not to be a function of time.
869 ! Results are unpredictable if the argument is supplied for a time-
870 ! independent field, or omitted for a time-dependent field. Repeated
871 ! writes of a time-independent field are also not recommended. One
872 ! time level of one field is written per call. tstamp must be an 8-byte
873 ! real, even if the default real type is 4-byte.
874 ! </IN>
875 ! <NOTE>
876 ! The type of write performed by <TT>mpp_write</TT> depends on the file
877 ! characteristics on the I/O unit specified at the <LINK
878 ! SRC="#mpp_open"><TT>mpp_open</TT></LINK> call. Specifically, the format of
879 ! the output data (e.g netCDF or IEEE), the <TT>threading</TT> and
880 ! <TT>fileset</TT> flags, etc., can be changed there, and require no
881 ! changes to the <TT>mpp_write</TT> calls.
882 !
883 ! Packing is currently not implemented for non-netCDF files, and the
884 ! <TT>pack</TT> attribute is ignored. On netCDF files,
885 ! <TT>NF_DOUBLE</TT>s (8-byte IEEE floating point numbers) are
886 ! written for <TT>pack</TT>=1 and <TT>NF_FLOAT</TT>s for
887 ! <TT>pack</TT>=2. (<TT>pack</TT>=2 gives the customary
888 ! and default behaviour). We write <TT>NF_SHORT</TT>s (2-byte
889 ! integers) for <TT>pack=4</TT>, or <TT>NF_BYTE</TT>s
890 ! (1-byte integers) for <TT>pack=8</TT>. Integer scaling is done
891 ! using the <TT>scale</TT> and <TT>add</TT> attributes at
892 ! <TT>pack</TT>=4 or 8, satisfying the relation
893 !
894 ! <PRE>
895 ! data = packed_data*scale + add
896 ! </PRE>
897 !
898 ! <TT>NOTE: mpp_write</TT> does not check to see if the scaled
899 ! data in fact fits into the dynamic range implied by the specified
900 ! packing. It is incumbent on the user to supply correct scaling
901 ! attributes.
902 !
903 ! You cannot interleave calls to <TT>mpp_write</TT> and
904 ! <TT>mpp_write_meta</TT>: the first call to
905 ! <TT>mpp_write</TT> implies that metadata specification is
906 ! complete.
907 ! </NOTE>
908 ! </INTERFACE>
909 
910 
911  interface write_record
912  module procedure write_record_default
913 #ifdef OVERLOAD_R8
914  module procedure write_record_r8
915 #endif
916  end interface
917 
918  interface mpp_write
919  module procedure mpp_write_2ddecomp_r2d
920  module procedure mpp_write_2ddecomp_r3d
921  module procedure mpp_write_2ddecomp_r4d
922 #ifdef OVERLOAD_R8
923  module procedure mpp_write_2ddecomp_r2d_r8
924  module procedure mpp_write_2ddecomp_r3d_r8
925  module procedure mpp_write_2ddecomp_r4d_r8
926 #endif
927  module procedure mpp_write_r0d
928  module procedure mpp_write_r1d
929  module procedure mpp_write_r2d
930  module procedure mpp_write_r3d
931  module procedure mpp_write_r4d
932  module procedure mpp_write_axis
933  end interface
934 
935 
936 !***********************************************************************
937 ! <INTERFACE NAME="mpp_write_compressed">
938 ! <OVERVIEW>
939 ! Write to an opened, sparse data, compressed file (e.g. land_model)
940 ! </OVERVIEW>
941 ! <DESCRIPTION>
942 ! These routines are similar to mpp_write except that they are
943 ! designed to handle sparse, compressed vectors of data such
944 ! as from the land model. Currently, the sparse vector may vary in z.
945 ! Hence the need for the rank 2 treatment.
946 ! </DESCRIPTION>
947 ! <TEMPLATE>
948 ! call mpp_write(unit, field, domain, data, nelems_io, tstamp, default_data )
949 ! </TEMPLATE>
950 ! <IN NAME="unit"></IN>
951 ! <IN NAME="field"></IN>
952 ! <IN NAME="domain"></IN>
953 ! <INOUT NAME="data"></INOUT>
954 ! <IN NAME="nelems_io">
955 ! <TT>nelems</TT> is a vector containing the number of elements expected
956 ! from each member of the io_domain. It MUST have the same order as
957 ! the io_domain pelist.
958 ! </IN>
959 ! <IN NAME="tstamp">
960 ! <TT>tstamp</TT> is an optional argument. It is to
961 ! be omitted if the field was defined not to be a function of time.
962 ! Results are unpredictable if the argument is supplied for a time-
963 ! independent field, or omitted for a time-dependent field. Repeated
964 ! writes of a time-independent field are also not recommended. One
965 ! time level of one field is written per call. tstamp must be an 8-byte
966 ! real, even if the default real type is 4-byte.
967 ! </IN>
968 ! <IN NAME="default_data"></IN>
969 ! <NOTE>
970 ! <TT>mpp_write_meta</TT> must be called prior to calling
971 ! <TT>mpp_write_compressed.</TT>
972 ! Since in general, the vector is distributed across the io-domain
973 ! The write expects the io_domain to be defined.
974 ! </NOTE>
975 ! </INTERFACE>
977  module procedure mpp_write_compressed_r1d
978  module procedure mpp_write_compressed_r2d
979  module procedure mpp_write_compressed_r3d
980  end interface mpp_write_compressed
981 
982 !***********************************************************************
983 ! <INTERFACE NAME="mpp_write_unlimited_axis">
984 ! <OVERVIEW>
985 ! Write to an opened file along the unlimited axis (e.g. icebergs)
986 ! </OVERVIEW>
987 ! <DESCRIPTION>
988 ! These routines are similar to mpp_write except that they are
989 ! designed to handle data written along the unlimited axis that
990 ! is not time (e.g. icebergs).
991 ! </DESCRIPTION>
992 ! <TEMPLATE>
993 ! call mpp_write(unit, field, domain, data, nelems_io)
994 ! </TEMPLATE>
995 ! <IN NAME="unit"></IN>
996 ! <IN NAME="field"></IN>
997 ! <IN NAME="domain"></IN>
998 ! <INOUT NAME="data"></INOUT>
999 ! <IN NAME="nelems">
1000 ! <TT>nelems</TT> is a vector containing the number of elements expected
1001 ! from each member of the io_domain. It MUST have the same order as
1002 ! the io_domain pelist.
1003 ! </IN>
1004 ! <NOTE>
1005 ! <TT>mpp_write_meta</TT> must be called prior to calling
1006 ! <TT>mpp_write_unlimited_axis.</TT>
1007 ! Since in general, the vector is distributed across the io-domain
1008 ! The write expects the io_domain to be defined.
1009 ! </NOTE>
1010 ! </INTERFACE>
1012  module procedure mpp_write_unlimited_axis_r1d
1013  end interface mpp_write_unlimited_axis
1014 
1015 
1016 !***********************************************************************
1017 ! <INTERFACE NAME="mpp_def_dim">
1018 ! <OVERVIEW>
1019 ! Define an dimension variable
1020 ! </OVERVIEW>
1021 ! <DESCRIPTION>
1022 ! Similar to the mpp_write_meta routines, but simply defines the
1023 ! a dimension variable with the optional attributes
1024 ! </DESCRIPTION>
1025 ! <TEMPLATE>
1026 ! call mpp_def_dim( unit, name, dsize, longname, data )
1027 ! </TEMPLATE>
1028 ! <IN NAME="unit"></IN>
1029 ! <IN NAME="name"></IN>
1030 ! <IN NAME="dsize"></IN>
1031 ! <IN NAME="data"></INOUT>
1032 ! </INTERFACE>
1033  interface mpp_def_dim
1034  module procedure mpp_def_dim_nodata
1035  module procedure mpp_def_dim_int
1036  module procedure mpp_def_dim_real
1037  end interface mpp_def_dim
1038 
1039 !***********************************************************************
1040 !
1041 ! module variables
1042 !
1043 !***********************************************************************
1044  logical :: module_is_initialized = .false.
1045  logical :: verbose =.false.
1046  logical :: debug = .false.
1049  integer :: varnum=0
1050  integer :: pe, npes
1051  character(len=256) :: text
1052  integer :: error
1053  integer :: records_per_pe
1056 
1057 
1058 !initial value of buffer between meta_data and data in .nc file
1059  integer :: header_buffer_val = 16384 ! value used in NF__ENDDEF
1060  logical :: global_field_on_root_pe = .true.
1061  logical :: io_clocks_on = .false.
1062  integer :: shuffle = 0
1063  integer :: deflate = 0
1064  integer :: deflate_level = -1
1065  logical :: cf_compliance = .false.
1066 
1067  namelist /mpp_io_nml/header_buffer_val, global_field_on_root_pe, io_clocks_on, &
1069 
1070  real(DOUBLE_KIND), allocatable :: mpp_io_stack(:)
1071  type(axistype),save :: default_axis !provided to users with default components
1072  type(fieldtype),save :: default_field !provided to users with default components
1073  type(atttype),save :: default_att !provided to users with default components
1074  type(filetype), allocatable :: mpp_file(:)
1075 
1076  integer :: pack_size ! = 1 when compiling with -r8 and = 2 when compiling with -r4.
1077 
1078 ! Include variable "version" to be written to log file.
1079 #include<file_version.h>
1080 
1081 !----------
1082 !ug support
1083 public :: mpp_io_unstructured_write
1084 public :: mpp_io_unstructured_read
1085 
1087  module procedure mpp_io_unstructured_write_r_1d
1088  module procedure mpp_io_unstructured_write_r_2d
1089  module procedure mpp_io_unstructured_write_r_3d
1090  module procedure mpp_io_unstructured_write_r_4d
1091 end interface mpp_io_unstructured_write
1092 
1094  module procedure mpp_io_unstructured_read_r_1d
1095  module procedure mpp_io_unstructured_read_r_2d
1096  module procedure mpp_io_unstructured_read_r_3d
1097 end interface mpp_io_unstructured_read
1098 !----------
1099 
1100 contains
1101 
1102 #include <mpp_io_util.inc>
1103 #include <mpp_io_misc.inc>
1104 #include <mpp_io_connect.inc>
1105 #include <mpp_io_read.inc>
1106 #include <mpp_io_write.inc>
1107 
1108 !----------
1109 !ug support
1110 #include <mpp_io_unstructured_write.inc>
1111 #include <mpp_io_unstructured_read.inc>
1112 !----------
1113 
1114 end module mpp_io_mod
integer npes
Definition: mpp_io.F90:1050
integer mpp_write_clock
Definition: mpp_io.F90:1054
integer deflate_level
Definition: mpp_io.F90:1064
integer, parameter, public mpp_wronly
integer, parameter, public mpp_ieee32
integer unit_begin
Definition: mpp_io.F90:1047
type(atttype), save, public default_att
Definition: mpp_io.F90:1073
logical module_is_initialized
Definition: mpp_io.F90:1044
integer unit_end
Definition: mpp_io.F90:1047
integer, parameter, public mpp_ascii
real(double_kind), parameter, public mpp_fill_double
integer, parameter, public nullunit
integer, parameter max_att_length
Definition: mpp_io.F90:415
integer mpp_close_clock
Definition: mpp_io.F90:1055
logical verbose
Definition: mpp_io.F90:1045
integer, parameter, public mpp_collect
integer, parameter, public corner
integer, parameter, public mpp_rdonly
integer, parameter, public mpp_delete
character(len=256) text
Definition: mpp_io.F90:1051
integer mpp_io_stack_hwm
Definition: mpp_io.F90:1048
logical global_field_on_root_pe
Definition: mpp_io.F90:1060
integer, parameter, public global_root_only
integer error
Definition: mpp_io.F90:1052
integer, parameter, public mpp_sequential
type(filetype), dimension(:), allocatable mpp_file
Definition: mpp_io.F90:1074
Definition: mpp.F90:39
integer, parameter, public yupdate
integer, parameter, public mpp_native
character(len=input_str_length), dimension(:), allocatable, target, public input_nml_file
Definition: mpp.F90:1378
integer, parameter, public mpp_single
integer, parameter, public mpp_debug
logical io_clocks_on
Definition: mpp_io.F90:1061
integer pack_size
Definition: mpp_io.F90:1076
integer, parameter, public mpp_netcdf
integer, parameter, public center
integer, parameter, public mpp_overwr
logical debug
Definition: mpp_io.F90:1046
type(axistype), save, public default_axis
Definition: mpp_io.F90:1071
integer(int_kind), parameter, public mpp_fill_int
integer, parameter, public mpp_multi
integer, parameter, public east
real(double_kind), parameter, public nulltime
integer mpp_read_clock
Definition: mpp_io.F90:1054
integer records_per_pe
Definition: mpp_io.F90:1053
integer(long_kind), parameter, public max_file_size
integer, parameter, public all_pes
integer maxunits
Definition: mpp_io.F90:1047
integer mpp_io_stack_size
Definition: mpp_io.F90:1048
integer, parameter, public mpp_verbose
integer varnum
Definition: mpp_io.F90:1049
integer, parameter, public xupdate
************************************************************************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)
integer, parameter, public north
integer mpp_open_clock
Definition: mpp_io.F90:1055
#define max(a, b)
Definition: mosaic_util.h:33
integer, parameter, public mpp_direct
integer shuffle
Definition: mpp_io.F90:1062
logical cf_compliance
Definition: mpp_io.F90:1065
integer deflate
Definition: mpp_io.F90:1063
#define min(a, b)
Definition: mosaic_util.h:32
integer header_buffer_val
Definition: mpp_io.F90:1059
type(fieldtype), save, public default_field
Definition: mpp_io.F90:1072
integer, parameter, public mpp_append
real(double_kind), dimension(:), allocatable mpp_io_stack
Definition: mpp_io.F90:1070
integer, public file_type_used
Definition: mpp_io.F90:414
type(domain1d), save, public null_domain1d