FMS 2025.01-dev
Flexible Modeling System
Loading...
Searching...
No Matches
mpp_io_mod

a set of simple calls for parallel I/O on distributed systems. It is geared toward the writing of data in netCDF format More...

Data Types

type  atttype
 
type  axistype
 
type  fieldtype
 
type  filetype
 
interface  mpp_copy_meta
 
interface  mpp_def_dim
 
interface  mpp_get_att_value
 
interface  mpp_get_atts
 Get file global metadata. More...
 
interface  mpp_get_id
 
interface  mpp_io_unstructured_read
 
interface  mpp_io_unstructured_write
 
interface  mpp_modify_meta
 
interface  mpp_read
 
interface  mpp_read_compressed
 
interface  mpp_read_distributed_ascii
 
interface  mpp_write
 
interface  mpp_write_compressed
 
interface  mpp_write_meta
 Each file can contain any number of fields, which can be functions of 0-3 spatial axes and 0-1 time axes. Axis descriptors are stored in the <axistype> structure and field descriptors in the <fieldtype> structure. More...
 
interface  mpp_write_unlimited_axis
 
type  validtype
 
interface  write_record
 

Functions/Subroutines

logical function do_cf_compliance ()
 
subroutine file_size (fsize, fname, size)
 
logical function mpp_attribute_exist (field, name)
 
subroutine mpp_close (unit, action)
 
 mpp_copy_meta_axis
 
 mpp_copy_meta_field
 
 mpp_copy_meta_global
 
 mpp_def_dim_int
 
 mpp_def_dim_nodata
 
 mpp_def_dim_real
 
subroutine mpp_dist_io_pelist (ssize, pelist)
 
logical function mpp_file_is_opened (unit)
 return if certain file with unit is opened or not
 
integer function mpp_find_att (atts, name)
 
subroutine mpp_flush (unit)
 
character(len=att%len) function mpp_get_att_char (att)
 return the char value of an attribute.
 
integer function mpp_get_att_length (att)
 return the length of an attribute.
 
character(len=len(att%name)) function mpp_get_att_name (att)
 return the name of an attribute.
 
real function, dimension(size(att%fatt(:))) mpp_get_att_real (att)
 return the real array value of an attribute.
 
real function mpp_get_att_real_scalar (att)
 return the real array value of an attribute.
 
integer function mpp_get_att_type (att)
 return the type of an attribute.
 
subroutine mpp_get_axes (unit, axes, time_axis)
 Copy variable information from file (excluding data)
 
 mpp_get_axis_atts
 
subroutine mpp_get_axis_atts (axis, name, units, longname, cartesian, calendar, sense, len, natts, atts, compressed)
 
logical function mpp_get_axis_bounds (axis, data, name)
 
type(axistype) function mpp_get_axis_by_name (unit, axisname)
 
subroutine mpp_get_axis_data (axis, data)
 
 mpp_get_axis_id
 
integer function mpp_get_axis_id (axis)
 
integer function mpp_get_axis_index (axes, axisname)
 
integer function mpp_get_axis_length (axis)
 
character(len=len(default_axis%calendar)) function mpp_get_default_calendar ()
 Copy variable information from file (excluding data)
 
integer function mpp_get_dimension_length (unit, dimname, found)
 Copy variable information from file (excluding data)
 
 mpp_get_field_att_text
 
subroutine mpp_get_field_att_text (unit, fieldname, attname, attvalue)
 return the attribute value of given field name
 
 mpp_get_field_atts
 
subroutine mpp_get_field_atts (field, name, units, longname, min, max, missing, ndim, siz, axes, atts, valid, scale, add, checksum)
 
 mpp_get_field_id
 
integer function mpp_get_field_id (field)
 
integer function mpp_get_field_index (fields, fieldname)
 
character(len=len(field%name)) function mpp_get_field_name (field)
 return the name of an field
 
integer function, dimension(4) mpp_get_field_size (field)
 
subroutine mpp_get_fields (unit, variables)
 Copy variable information from file (excluding data)
 
character(len=len(mpp_file(1)%name)) function mpp_get_file_name (unit)
 return the file name of corresponding unit
 
 mpp_get_global_atts
 
subroutine mpp_get_global_atts (unit, global_atts)
 Copy global file attributes for use by user.
 
subroutine mpp_get_info (unit, ndim, nvar, natt, ntime)
 Get some general information about a file.
 
integer function mpp_get_maxunits ()
 Return the maximum number of MPP file units available.
 
integer function mpp_get_ncid (unit)
 Get netCDF ID of an open file.
 
integer function mpp_get_recdimid (unit)
 
subroutine mpp_get_time_axis (unit, time_axis)
 Copy variable information from file (excluding data)
 
subroutine mpp_get_times (unit, time_values)
 Get file time data.
 
subroutine mpp_get_valid (f, v)
 Based on presence/absence of attributes, defines valid range or missing.
 
logical function mpp_io_clock_on ()
 return mpp_io_nml variable io_clock_on
 
subroutine mpp_io_exit (string)
 
subroutine mpp_io_init (flags, maxunit)
 
subroutine mpp_io_set_stack_size (n)
 Set the mpp_io_stack variable to be at least n LONG words long.
 
 mpp_io_unstructured_read_r4_1d
 
subroutine mpp_io_unstructured_read_r4_1d (funit, field, domain, fdata, tindex, start, nread, threading)
 Read in one-dimensional data for a field associated with an unstructured mpp domain.
 
 mpp_io_unstructured_read_r4_2d
 
subroutine mpp_io_unstructured_read_r4_2d (funit, field, domain, fdata, tindex, start, nread, threading)
 Read in two-dimensional data for a field associated with an unstructured mpp domain.
 
 mpp_io_unstructured_read_r4_3d
 
subroutine mpp_io_unstructured_read_r4_3d (funit, field, domain, fdata, tindex, start, nread, threading)
 Read in three-dimensional data for a field associated with an unstructured mpp domain.
 
 mpp_io_unstructured_read_r8_1d
 
subroutine mpp_io_unstructured_read_r8_1d (funit, field, domain, fdata, tindex, start, nread, threading)
 Read in one-dimensional data for a field associated with an unstructured mpp domain.
 
 mpp_io_unstructured_read_r8_2d
 
subroutine mpp_io_unstructured_read_r8_2d (funit, field, domain, fdata, tindex, start, nread, threading)
 Read in two-dimensional data for a field associated with an unstructured mpp domain.
 
 mpp_io_unstructured_read_r8_3d
 
subroutine mpp_io_unstructured_read_r8_3d (funit, field, domain, fdata, tindex, start, nread, threading)
 Read in three-dimensional data for a field associated with an unstructured mpp domain.
 
 mpp_io_unstructured_write_r4_1d
 
subroutine mpp_io_unstructured_write_r4_1d (funit, field, domain, fdata, nelems_io, tstamp, default_data)
 Write data for a 1D field associated with an unstructured mpp domain to a restart file.
 
 mpp_io_unstructured_write_r4_2d
 
subroutine mpp_io_unstructured_write_r4_2d (funit, field, domain, fdata, nelems_io, tstamp, default_data)
 Write data for a 2D field associated with an unstructured mpp domain to a restart file.
 
 mpp_io_unstructured_write_r4_3d
 
subroutine mpp_io_unstructured_write_r4_3d (funit, field, domain, fdata, nelems_io, tstamp, default_data)
 Write data for a 3D field associated with an unstructured mpp domain to a restart file.
 
 mpp_io_unstructured_write_r4_4d
 
subroutine mpp_io_unstructured_write_r4_4d (funit, field, domain, fdata, nelems_io_in, tstamp, default_data)
 Write data for a 4D field associated with an unstructured mpp domain to a restart file.
 
 mpp_io_unstructured_write_r8_1d
 
subroutine mpp_io_unstructured_write_r8_1d (funit, field, domain, fdata, nelems_io, tstamp, default_data)
 Write data for a 1D field associated with an unstructured mpp domain to a restart file.
 
 mpp_io_unstructured_write_r8_2d
 
subroutine mpp_io_unstructured_write_r8_2d (funit, field, domain, fdata, nelems_io, tstamp, default_data)
 Write data for a 2D field associated with an unstructured mpp domain to a restart file.
 
 mpp_io_unstructured_write_r8_3d
 
subroutine mpp_io_unstructured_write_r8_3d (funit, field, domain, fdata, nelems_io, tstamp, default_data)
 Write data for a 3D field associated with an unstructured mpp domain to a restart file.
 
 mpp_io_unstructured_write_r8_4d
 
subroutine mpp_io_unstructured_write_r8_4d (funit, field, domain, fdata, nelems_io_in, tstamp, default_data)
 Write data for a 4D field associated with an unstructured mpp domain to a restart file.
 
logical function mpp_is_dist_ioroot (ssize, ioroot, lsize)
 
logical elemental function mpp_is_valid (x, v)
 
 mpp_modify_axis_meta
 
 mpp_modify_field_meta
 
subroutine mpp_open (unit, file, action, form, access, threading, fileset, iospec, nohdrs, recl, iostat, is_root_pe, domain, domain_ug)
 
 mpp_read_2ddecomp_r2d_r4
 
 mpp_read_2ddecomp_r2d_r8
 
 mpp_read_2ddecomp_r3d_r4
 
 mpp_read_2ddecomp_r3d_r8
 
 mpp_read_2ddecomp_r4d_r4
 
 mpp_read_2ddecomp_r4d_r8
 
 mpp_read_compressed_r1d_r4
 
 mpp_read_compressed_r1d_r8
 
 mpp_read_compressed_r2d_r4
 
 mpp_read_compressed_r2d_r8
 
 mpp_read_compressed_r3d_r4
 
 mpp_read_compressed_r3d_r8
 
 mpp_read_distributed_ascii_a1d
 
 mpp_read_distributed_ascii_i1d
 
 mpp_read_distributed_ascii_r1d
 
 mpp_read_r0d_r4
 
 mpp_read_r0d_r8
 
 mpp_read_r1d_r4
 
 mpp_read_r1d_r8
 
 mpp_read_r2d_r4
 
 mpp_read_r2d_r8
 
 mpp_read_r3d_r4
 
 mpp_read_r3d_r8
 
 mpp_read_r4d_r4
 
 mpp_read_r4d_r8
 
 mpp_read_region_r2d_r4
 
 mpp_read_region_r2d_r8
 
 mpp_read_region_r3d_r4
 
 mpp_read_region_r3d_r8
 
 mpp_read_text
 
 mpp_write_2ddecomp_r2d_r4
 
 mpp_write_2ddecomp_r2d_r8
 
 mpp_write_2ddecomp_r3d_r4
 
 mpp_write_2ddecomp_r3d_r8
 
 mpp_write_2ddecomp_r4d_r4
 
 mpp_write_2ddecomp_r4d_r8
 
 mpp_write_axis
 
 mpp_write_compressed_r1d_r4
 
 mpp_write_compressed_r1d_r8
 
 mpp_write_compressed_r2d_r4
 
 mpp_write_compressed_r2d_r8
 
 mpp_write_compressed_r3d_r4
 
 mpp_write_compressed_r3d_r8
 
 mpp_write_meta_axis_i1d
 
 mpp_write_meta_axis_r1d
 
 mpp_write_meta_axis_unlimited
 
 mpp_write_meta_field
 
 mpp_write_meta_global
 
 mpp_write_meta_global_scalar_i
 
 mpp_write_meta_global_scalar_r
 
 mpp_write_meta_scalar_i
 
 mpp_write_meta_scalar_r
 
 mpp_write_meta_var
 
 mpp_write_r0d_r4
 
 mpp_write_r0d_r8
 
 mpp_write_r1d_r4
 
 mpp_write_r1d_r8
 
 mpp_write_r2d_r4
 
 mpp_write_r2d_r8
 
 mpp_write_r3d_r4
 
 mpp_write_r3d_r8
 
 mpp_write_r4d_r4
 
 mpp_write_r4d_r8
 
 mpp_write_unlimited_axis_r1d
 
subroutine netcdf_err (err, file, axis, field, attr, string)
 
 write_record_r4
 
 write_record_r8
 

Variables

logical cf_compliance = .false.
 
logical debug = .FALSE.
 
type(atttype), save, public default_att
 
type(axistype), save, public default_axis
 
type(fieldtype), save, public default_field
 
integer deflate = 0
 
integer deflate_level = -1
 
integer error
 
logical global_field_on_root_pe = .true.
 
integer header_buffer_val = 16384
 
logical io_clocks_on = .false.
 
integer, parameter max_att_length = 1280
 
integer maxunits
 
logical module_is_initialized = .FALSE.
 
integer mpp_close_clock =0
 
type(filetype), dimension(:), allocatable mpp_file
 
real(r8_kind), dimension(:), allocatable mpp_io_stack
 
integer mpp_io_stack_hwm =0
 
integer mpp_io_stack_size =0
 
integer mpp_open_clock =0
 
integer mpp_read_clock =0
 
integer mpp_write_clock =0
 
integer npes
 
integer pack_size
 
integer pe
 
integer records_per_pe
 
integer shuffle = 0
 
character(len=256) text
 
integer unit_begin
 
integer unit_end
 
integer varnum =0
 
logical verbose =.FALSE.
 

Detailed Description

a set of simple calls for parallel I/O on distributed systems. It is geared toward the writing of data in netCDF format

Author
V. Balaji <"vb@gfdl.noaa.gov">

In massively parallel environments, an often difficult problem is the reading and writing of data to files on disk. MPI-IO and MPI-2 IO are moving toward providing this capability, but are currently not widely implemented. Further, it is a rather abstruse API. mpp_io_mod is an attempt at a simple API encompassing a certain variety of the I/O tasks that will be required. It does not attempt to be an all-encompassing standard such as MPI, however, it can be implemented in MPI if so desired. It is equally simple to add parallel I/O capability to mpp_io_mod based on vendor-specific APIs while providing a layer of insulation for user codes.

The mpp_io_mod parallel I/O API built on top of the <LINK SRC="mpp_domains.html">mpp_domains_mod</LINK> and <LINK SRC="mpp.html">mpp_mod</LINK> API for domain decomposition and message passing. Features of mpp_io_mod include:

1) Simple, minimal API, with free access to underlying API for more complicated stuff.
2) Self-describing files: comprehensive header information (metadata) in the file itself.
3) Strong focus on performance of parallel write: the climate models for which it is designed typically read a minimal amount of data (typically at the beginning of the run); but on the other hand, tend to write copious amounts of data during the run. An interface for reading is also supplied, but its performance has not yet been optimized.
4) Integrated netCDF capability: <LINK SRC ="http://www.unidata.ucar.edu/packages/netcdf/">netCDF</LINK> is a data format widely used in the climate/weather modeling community. netCDF is considered the principal medium of data storage for mpp_io_mod. But I provide a raw unformatted fortran I/O capability in case netCDF is not an option, either due to unavailability, inappropriateness, or poor performance.
5) May require off-line post-processing: a tool for this purpose, mppnccombine, is available. GFDL users may use ~hnv/pub/mppnccombine. Outside users may obtain the source <LINK SRC ="ftp://ftp.gfdl.gov/perm/hnv/mpp/mppnccombine.c">here</LINK>. It can be compiled on any C compiler and linked with the netCDF library. The program is free and is covered by the <LINK SRC ="ftp://ftp.gfdl.gov/perm/hnv/mpp/LICENSE">GPL license</LINK>.

The internal representation of the data being written out is assumed be the default real type, which can be 4 or 8-byte. Time data is always written as 8-bytes to avoid overflow on climatic time scales in units of seconds.

<LINK SRC="modes"></LINK>

I/O modes in @ref mpp_io_mod

The I/O activity critical to performance in the models for which mpp_io_mod is designed is typically the writing of large datasets on a model grid volume produced at intervals during a run. Consider a 3D grid volume, where model arrays are stored as (i,j,k). The domain decomposition is typically along i or j: thus to store data to disk as a global volume, the distributed chunks of data have to be seen as non-contiguous. If we attempt to have all PEs write this data into a single file, performance can be seriously compromised because of the data reordering that will be required. Possible options are to have one PE acquire all the data and write it out, or to have all the PEs write independent files, which are recombined offline. These three modes of operation are described in the mpp_io_mod terminology in terms of two parameters, threading and fileset, as follows:

Single-threaded I/O: a single PE acquires all the data and writes it out.
Multi-threaded, single-fileset I/O: many PEs write to a single file.
Multi-threaded, multi-fileset I/O: many PEs write to independent files. This is also called distributed I/O.

The middle option is the most difficult to achieve performance. The choice of one of these modes is made when a file is opened for I/O, in <LINK SRC="#mpp_open">mpp_open</LINK>.

<LINK name="metadata"></LINK>

Metadata in @ref mpp_io_mod

A requirement of the design of mpp_io_mod is that the file must be entirely self-describing: comprehensive header information describing its contents is present in the header of every file. The header information follows the model of netCDF. Variables in the file are divided into axes and fields. An axis describes a co-ordinate variable, e.g x,y,z,t. A field consists of data in the space described by the axes. An axis is described in mpp_io_mod using the defined type axistype:

   type, public :: axistype
      sequence
      character(len=128) :: name
      character(len=128) :: units
      character(len=256) :: longname
      character(len=8) :: cartesian
      integer :: len
      integer :: sense           !+/-1, depth or height?
      type(domain1D), pointer :: domain
      real, dimension(:), pointer :: data
      integer :: id, did
      integer :: type  ! external NetCDF type format for axis data
      integer :: natt
      type(atttype), pointer :: Att(:) ! axis attributes
   end type axistype
   

A field is described using the type fieldtype:

   type, public :: fieldtype
      sequence
      character(len=128) :: name
      character(len=128) :: units
      character(len=256) :: longname
      real :: min, max, missing, fill, scale, add
      integer :: pack
      type(axistype), dimension(:), pointer :: axes
      integer, dimension(:), pointer :: size
      integer :: time_axis_index
      integer :: id
      integer :: type ! external NetCDF format for field data
      integer :: natt, ndim
      type(atttype), pointer :: Att(:) ! field metadata
   end type fieldtype
   

An attribute (global, field or axis) is described using the atttype:

   type, public :: atttype
      sequence
      integer :: type, len
      character(len=128) :: name
      character(len=256)  :: catt
      real(r4_kind), pointer :: fatt(:)
   end type atttype
   

<LINK name="packing"></LINK>This default set of field attributes corresponds closely to various conventions established for netCDF files. The pack attribute of a field defines whether or not a field is to be packed on output. Allowed values of pack are 1,2,4 and 8. The value of pack is the number of variables written into 8 bytes. In typical use, we write 4-byte reals to netCDF output; thus the default value of pack is 2. For pack = 4 or 8, packing uses a simple-minded linear scaling scheme using the scale and add attributes. There is thus likely to be a significant loss of dynamic range with packing. When a field is declared to be packed, the missing and fill attributes, if supplied, are packed also.

Please note that the pack values are the same even if the default real is 4 bytes, i.e PACK=1 still follows the definition above and writes out 8 bytes.

A set of attributes for each variable is also available. The variable definitions and attribute information is written/read by calling <LINK SRC="#mpp_write_meta">mpp_write_meta</LINK> or <LINK SRC="#mpp_read_meta">mpp_read_meta</LINK>. A typical calling sequence for writing data might be:

   ...
     type(domain2D), dimension(:), allocatable, target :: domain
     type(fieldtype) :: field
     type(axistype) :: x, y, z, t
   ...
     call mpp_define_domains( (/1,nx,1,ny/), domain )
     allocate( a(domain(pe)xdatastart_index:domain(pe)xdataend_index, &
                 domain(pe)ydatastart_index:domain(pe)ydataend_index,nz) )
   ...
     call mpp_write_meta( unit, x, 'X', 'km', 'X distance', &
          domain=domain(pe)x, data=(/(float(i),i=1,nx)/) )
     call mpp_write_meta( unit, y, 'Y', 'km', 'Y distance', &
          domain=domain(pe)y, data=(/(float(i),i=1,ny)/) )
     call mpp_write_meta( unit, z, 'Z', 'km', 'Z distance', &
          data=(/(float(i),i=1,nz)/) )
     call mpp_write_meta( unit, t, 'Time', 'second', 'Time' )

     call mpp_write_meta( unit, field, (/x,y,z,t/), 'a', '(m/s)', AAA', &
          missing=-1e36 )
   ...
     call mpp_write( unit, x )
     call mpp_write( unit, y )
     call mpp_write( unit, z )
   ...
   

In this example, x and y have been declared as distributed axes, since a domain decomposition has been associated. z and t are undistributed axes. t is known to be a record axis (netCDF terminology) since we do not allocate the data element of the axistype. Only one record axis may be associated with a file. The call to <LINK SRC="#mpp_write_meta">mpp_write_meta</LINK> initializes the axes, and associates a unique variable ID with each axis. The call to mpp_write_meta with argument field declared field to be a 4D variable that is a function of (x,y,z,t), and a unique variable ID is associated with it. A 3D field will be written at each call to mpp_write(field).

The data to any variable, including axes, is written by mpp_write.

Any additional attributes of variables can be added through subsequent mpp_write_meta calls, using the variable ID as a handle. Global attributes, associated with the dataset as a whole, can also be written thus. See the <LINK SRC="#mpp_write_meta">mpp_write_meta</LINK> call syntax below for further details.

You cannot interleave calls to mpp_write and mpp_write_meta: the first call to mpp_write implies that metadata specification is complete.

A typical calling sequence for reading data might be:

   ...
     integer :: unit, natt, nvar, ntime
     type(domain2D), dimension(:), allocatable, target :: domain
     type(fieldtype), allocatable, dimension(:) :: fields
     type(atttype), allocatable, dimension(:) :: global_atts
     real, allocatable, dimension(:) :: times
   ...
     call mpp_define_domains( (/1,nx,1,ny/), domain )

     call mpp_read_meta(unit)
     call mpp_get_info(unit,natt,nvar,ntime)
     allocate(global_atts(natt))
     call mpp_get_atts(unit,global_atts)
     allocate(fields(nvar))
     call mpp_get_vars(unit, fields)
     allocate(times(ntime))
     call mpp_get_times(unit, times)

     allocate( a(domain(pe)xdatastart_index:domain(pe)xdataend_index, &
                 domain(pe)ydatastart_index:domain(pe)ydataend_index,nz) )
   ...
     do i=1, nvar
       if (fields(i)name == 'a')  call mpp_read(unit,fields(i),domain(pe), a,
                                                 tindex)
     enddo
   ...
   

In this example, the data are distributed as in the previous example. The call to <LINK SRC="#mpp_read_meta">mpp_read_meta</LINK> initializes all of the metadata associated with the file, including global attributes, variable attributes and non-record dimension data. The call to mpp_get_info returns the number of global attributes (natt), variables (nvar) and time levels (ntime) associated with the file identified by a unique ID (unit). mpp_get_atts returns all global attributes for the file in the derived type atttype(natt). mpp_get_vars returns variable types (fieldtype(nvar)). Since the record dimension data are not allocated for calls to <LINK SRC="#mpp_write">mpp_write</LINK>, a separate call to mpp_get_times is required to access record dimension data. Subsequent calls to mpp_read return the field data arrays corresponding to the fieldtype. The domain type is an optional argument. If domain is omitted, the incoming field array should be dimensioned for the global domain, otherwise, the field data is assigned to the computational domain of a local array.

Multi-fileset reads are not supported with mpp_read.


Data Type Documentation

◆ mpp_io_mod::atttype

type mpp_io_mod::atttype

Definition at line 406 of file mpp_io.F90.

Collaboration diagram for atttype:
[legend]

Public Attributes

character(len=max_att_length) catt
 
real, dimension(:), pointer fatt =>NULL()
 
integer len
 
character(len=128) name
 

Private Attributes

integer type
 

Member Data Documentation

◆ catt

character(len=max_att_length) catt

Definition at line 410 of file mpp_io.F90.

◆ fatt

real, dimension(:), pointer fatt =>NULL()

Definition at line 411 of file mpp_io.F90.

◆ len

integer len

Definition at line 408 of file mpp_io.F90.

◆ name

character(len=128) name

Definition at line 409 of file mpp_io.F90.

◆ type

integer type
private

Definition at line 408 of file mpp_io.F90.

◆ mpp_io_mod::axistype

type mpp_io_mod::axistype

Definition at line 415 of file mpp_io.F90.

Collaboration diagram for axistype:
[legend]

Public Attributes

type(atttype), dimension(:), pointer att =>NULL()
 
character(len=24) calendar
 
character(len=8) cartesian
 
character(len=256) compressed
 
real, dimension(:), pointer data =>NULL()
 
real, dimension(:), pointer data_bounds =>NULL()
 
integer did
 
type(domain1ddomain
 
integer id
 
integer, dimension(:), pointer idata =>NULL()
 
integer len
 
character(len=256) longname
 
character(len=128) name_bounds
 
integer natt
 
integer sense
 
integer shift
 
integer type
 
character(len=128) units
 

Private Attributes

character(len=128) name
 

Member Data Documentation

◆ att

type(atttype), dimension(:), pointer att =>NULL()

Definition at line 432 of file mpp_io.F90.

◆ calendar

character(len=24) calendar

Definition at line 423 of file mpp_io.F90.

◆ cartesian

character(len=8) cartesian

Definition at line 421 of file mpp_io.F90.

◆ compressed

character(len=256) compressed

Definition at line 422 of file mpp_io.F90.

◆ data

real, dimension(:), pointer data =>NULL()

Definition at line 426 of file mpp_io.F90.

◆ data_bounds

real, dimension(:), pointer data_bounds =>NULL()

Definition at line 427 of file mpp_io.F90.

◆ did

integer did

Definition at line 429 of file mpp_io.F90.

◆ domain

type(domain1d) domain

Definition at line 425 of file mpp_io.F90.

◆ id

integer id

Definition at line 429 of file mpp_io.F90.

◆ idata

integer, dimension(:), pointer idata =>NULL()

Definition at line 428 of file mpp_io.F90.

◆ len

integer len

Definition at line 424 of file mpp_io.F90.

◆ longname

character(len=256) longname

Definition at line 420 of file mpp_io.F90.

◆ name

character(len=128) name
private

Definition at line 417 of file mpp_io.F90.

◆ name_bounds

character(len=128) name_bounds

Definition at line 418 of file mpp_io.F90.

◆ natt

integer natt

Definition at line 429 of file mpp_io.F90.

◆ sense

integer sense

Definition at line 424 of file mpp_io.F90.

◆ shift

integer shift

Definition at line 431 of file mpp_io.F90.

◆ type

integer type

Definition at line 429 of file mpp_io.F90.

◆ units

character(len=128) units

Definition at line 419 of file mpp_io.F90.

◆ mpp_io_mod::fieldtype

type mpp_io_mod::fieldtype

Definition at line 443 of file mpp_io.F90.

Collaboration diagram for fieldtype:
[legend]

Public Attributes

real add
 
type(atttype), dimension(:), pointer att =>NULL()
 
type(axistype), dimension(:), pointer axes =>NULL()
 
integer(i8_kind), dimension(3) checksum
 
real fill
 
integer id
 
character(len=256) longname
 
real max
 
real min
 
real missing
 
integer natt
 
integer ndim
 
integer pack
 
integer position
 
real scale
 
integer, dimension(:), pointer size =>NULL()
 
character(len=256) standard_name
 
integer time_axis_index
 
integer type
 
character(len=128) units
 

Private Attributes

character(len=128) name
 

Member Data Documentation

◆ add

real add

Definition at line 449 of file mpp_io.F90.

◆ att

type(atttype), dimension(:), pointer att =>NULL()

Definition at line 458 of file mpp_io.F90.

◆ axes

type(axistype), dimension(:), pointer axes =>NULL()

Definition at line 452 of file mpp_io.F90.

◆ checksum

integer(i8_kind), dimension(3) checksum

Definition at line 451 of file mpp_io.F90.

◆ fill

real fill

Definition at line 449 of file mpp_io.F90.

◆ id

integer id

Definition at line 457 of file mpp_io.F90.

◆ longname

character(len=256) longname

Definition at line 447 of file mpp_io.F90.

◆ max

real max

Definition at line 449 of file mpp_io.F90.

◆ min

real min

Definition at line 449 of file mpp_io.F90.

◆ missing

real missing

Definition at line 449 of file mpp_io.F90.

◆ name

character(len=128) name
private

Definition at line 445 of file mpp_io.F90.

◆ natt

integer natt

Definition at line 457 of file mpp_io.F90.

◆ ndim

integer ndim

Definition at line 457 of file mpp_io.F90.

◆ pack

integer pack

Definition at line 450 of file mpp_io.F90.

◆ position

integer position

Definition at line 459 of file mpp_io.F90.

◆ scale

real scale

Definition at line 449 of file mpp_io.F90.

◆ size

integer, dimension(:), pointer size =>NULL()

Definition at line 455 of file mpp_io.F90.

◆ standard_name

character(len=256) standard_name

Definition at line 448 of file mpp_io.F90.

◆ time_axis_index

integer time_axis_index

Definition at line 456 of file mpp_io.F90.

◆ type

integer type

Definition at line 457 of file mpp_io.F90.

◆ units

character(len=128) units

Definition at line 446 of file mpp_io.F90.

◆ mpp_io_mod::filetype

type mpp_io_mod::filetype

Definition at line 463 of file mpp_io.F90.

Collaboration diagram for filetype:
[legend]

Public Attributes

integer access
 
integer action
 
type(atttype), dimension(:), pointer att =>NULL()
 
type(axistype), dimension(:), pointer axis =>NULL()
 
type(domain2d), pointer domain =>NULL()
 
type(domainug), pointer domain_ug => null()
 
integer fileset
 
integer format
 
integer id
 
logical initialized
 
logical io_domain_exist
 
integer natt
 
integer ncid
 
integer ndim
 
logical nohdrs
 
integer nvar
 
logical opened
 
logical read_on_this_pe
 
integer recdimid
 
integer record
 
integer threading
 
real(r8_kind) time
 
integer time_level
 
real(r8_kind), dimension(:), pointer time_values =>NULL()
 
logical valid
 
type(fieldtype), dimension(:), pointer var =>NULL()
 
logical write_on_this_pe
 

Private Attributes

character(len=256) name
 

Member Data Documentation

◆ access

integer access

Definition at line 466 of file mpp_io.F90.

◆ action

integer action

Definition at line 466 of file mpp_io.F90.

◆ att

type(atttype), dimension(:), pointer att =>NULL()

Definition at line 485 of file mpp_io.F90.

◆ axis

type(axistype), dimension(:), pointer axis =>NULL()

Definition at line 483 of file mpp_io.F90.

◆ domain

type(domain2d), pointer domain =>NULL()

Definition at line 486 of file mpp_io.F90.

◆ domain_ug

type(domainug), pointer domain_ug => null()

Definition at line 489 of file mpp_io.F90.

◆ fileset

integer fileset

Definition at line 466 of file mpp_io.F90.

◆ format

integer format

Definition at line 466 of file mpp_io.F90.

◆ id

integer id

Definition at line 474 of file mpp_io.F90.

◆ initialized

logical initialized

Definition at line 467 of file mpp_io.F90.

◆ io_domain_exist

logical io_domain_exist

Definition at line 473 of file mpp_io.F90.

◆ name

character(len=256) name
private

Definition at line 465 of file mpp_io.F90.

◆ natt

integer natt

Definition at line 480 of file mpp_io.F90.

◆ ncid

integer ncid

Definition at line 466 of file mpp_io.F90.

◆ ndim

integer ndim

Definition at line 480 of file mpp_io.F90.

◆ nohdrs

logical nohdrs

Definition at line 467 of file mpp_io.F90.

◆ nvar

integer nvar

Definition at line 480 of file mpp_io.F90.

◆ opened

logical opened

Definition at line 467 of file mpp_io.F90.

◆ read_on_this_pe

logical read_on_this_pe

Definition at line 472 of file mpp_io.F90.

◆ recdimid

integer recdimid

Definition at line 475 of file mpp_io.F90.

◆ record

integer record

Definition at line 466 of file mpp_io.F90.

◆ threading

integer threading

Definition at line 466 of file mpp_io.F90.

◆ time

real(r8_kind) time

Definition at line 469 of file mpp_io.F90.

◆ time_level

integer time_level

Definition at line 468 of file mpp_io.F90.

◆ time_values

real(r8_kind), dimension(:), pointer time_values =>NULL()

Definition at line 476 of file mpp_io.F90.

◆ valid

logical valid

Definition at line 470 of file mpp_io.F90.

◆ var

type(fieldtype), dimension(:), pointer var =>NULL()

Definition at line 484 of file mpp_io.F90.

◆ write_on_this_pe

logical write_on_this_pe

Definition at line 471 of file mpp_io.F90.

◆ mpp_io_mod::mpp_copy_meta

interface mpp_io_mod::mpp_copy_meta

Definition at line 899 of file mpp_io.F90.

Public Member Functions

 mpp_copy_meta_axis
 
 mpp_copy_meta_field
 
 mpp_copy_meta_global
 

◆ mpp_io_mod::mpp_def_dim

interface mpp_io_mod::mpp_def_dim

Definition at line 1120 of file mpp_io.F90.

Public Member Functions

 mpp_def_dim_int
 
 mpp_def_dim_nodata
 
 mpp_def_dim_real
 

◆ mpp_io_mod::mpp_get_att_value

interface mpp_io_mod::mpp_get_att_value

Definition at line 528 of file mpp_io.F90.

Public Member Functions

 mpp_get_field_att_text
 

◆ mpp_io_mod::mpp_get_atts

interface mpp_io_mod::mpp_get_atts

Get file global metadata.


Example usage: call mpp_get_atts( unit, global_atts)

Definition at line 522 of file mpp_io.F90.

Public Member Functions

 mpp_get_axis_atts
 
 mpp_get_field_atts
 
 mpp_get_global_atts
 

◆ mpp_io_mod::mpp_get_id

interface mpp_io_mod::mpp_get_id

Definition at line 500 of file mpp_io.F90.

Public Member Functions

 mpp_get_axis_id
 
 mpp_get_field_id
 

◆ mpp_io_mod::mpp_io_unstructured_read

interface mpp_io_mod::mpp_io_unstructured_read

Definition at line 1184 of file mpp_io.F90.

Public Member Functions

 mpp_io_unstructured_read_r4_1d
 
 mpp_io_unstructured_read_r4_2d
 
 mpp_io_unstructured_read_r4_3d
 
 mpp_io_unstructured_read_r8_1d
 
 mpp_io_unstructured_read_r8_2d
 
 mpp_io_unstructured_read_r8_3d
 

◆ mpp_io_mod::mpp_io_unstructured_write

interface mpp_io_mod::mpp_io_unstructured_write

Definition at line 1173 of file mpp_io.F90.

Public Member Functions

 mpp_io_unstructured_write_r4_1d
 
 mpp_io_unstructured_write_r4_2d
 
 mpp_io_unstructured_write_r4_3d
 
 mpp_io_unstructured_write_r4_4d
 
 mpp_io_unstructured_write_r8_1d
 
 mpp_io_unstructured_write_r8_2d
 
 mpp_io_unstructured_write_r8_3d
 
 mpp_io_unstructured_write_r8_4d
 

◆ mpp_io_mod::mpp_modify_meta

interface mpp_io_mod::mpp_modify_meta

Definition at line 905 of file mpp_io.F90.

Public Member Functions

 mpp_modify_axis_meta
 
 mpp_modify_field_meta
 

◆ mpp_io_mod::mpp_read

interface mpp_io_mod::mpp_read

Definition at line 594 of file mpp_io.F90.

Public Member Functions

 mpp_read_2ddecomp_r2d_r4
 
 mpp_read_2ddecomp_r2d_r8
 
 mpp_read_2ddecomp_r3d_r4
 
 mpp_read_2ddecomp_r3d_r8
 
 mpp_read_2ddecomp_r4d_r4
 
 mpp_read_2ddecomp_r4d_r8
 
 mpp_read_r0d_r4
 
 mpp_read_r0d_r8
 
 mpp_read_r1d_r4
 
 mpp_read_r1d_r8
 
 mpp_read_r2d_r4
 
 mpp_read_r2d_r8
 
 mpp_read_r3d_r4
 
 mpp_read_r3d_r8
 
 mpp_read_r4d_r4
 
 mpp_read_r4d_r8
 
 mpp_read_region_r2d_r4
 
 mpp_read_region_r2d_r8
 
 mpp_read_region_r3d_r4
 
 mpp_read_region_r3d_r8
 
 mpp_read_text
 

◆ mpp_io_mod::mpp_read_compressed

interface mpp_io_mod::mpp_read_compressed

Definition at line 689 of file mpp_io.F90.

Public Member Functions

 mpp_read_compressed_r1d_r4
 
 mpp_read_compressed_r1d_r8
 
 mpp_read_compressed_r2d_r4
 
 mpp_read_compressed_r2d_r8
 
 mpp_read_compressed_r3d_r4
 
 mpp_read_compressed_r3d_r8
 

◆ mpp_io_mod::mpp_read_distributed_ascii

interface mpp_io_mod::mpp_read_distributed_ascii

Definition at line 647 of file mpp_io.F90.

Public Member Functions

 mpp_read_distributed_ascii_a1d
 
 mpp_read_distributed_ascii_i1d
 
 mpp_read_distributed_ascii_r1d
 

◆ mpp_io_mod::mpp_write

interface mpp_io_mod::mpp_write

Definition at line 999 of file mpp_io.F90.

Public Member Functions

 mpp_write_2ddecomp_r2d_r4
 
 mpp_write_2ddecomp_r2d_r8
 
 mpp_write_2ddecomp_r3d_r4
 
 mpp_write_2ddecomp_r3d_r8
 
 mpp_write_2ddecomp_r4d_r4
 
 mpp_write_2ddecomp_r4d_r8
 
 mpp_write_axis
 
 mpp_write_r0d_r4
 
 mpp_write_r0d_r8
 
 mpp_write_r1d_r4
 
 mpp_write_r1d_r8
 
 mpp_write_r2d_r4
 
 mpp_write_r2d_r8
 
 mpp_write_r3d_r4
 
 mpp_write_r3d_r8
 
 mpp_write_r4d_r4
 
 mpp_write_r4d_r8
 

◆ mpp_io_mod::mpp_write_compressed

interface mpp_io_mod::mpp_write_compressed

Definition at line 1060 of file mpp_io.F90.

Public Member Functions

 mpp_write_compressed_r1d_r4
 
 mpp_write_compressed_r1d_r8
 
 mpp_write_compressed_r2d_r4
 
 mpp_write_compressed_r2d_r8
 
 mpp_write_compressed_r3d_r4
 
 mpp_write_compressed_r3d_r8
 

◆ mpp_io_mod::mpp_write_meta

interface mpp_io_mod::mpp_write_meta

Each file can contain any number of fields, which can be functions of 0-3 spatial axes and 0-1 time axes. Axis descriptors are stored in the <axistype> structure and field descriptors in the <fieldtype> structure.

The metadata contained in the type is always written for each axis and field. Any other metadata one wishes to attach to an axis or field can subsequently be passed to mpp_write_meta using the ID, as shown below.

mpp_write_meta can take several forms:

mpp_write_meta( unit, name, rval=rval, pack=pack ) mpp_write_meta( unit, name, ival=ival ) mpp_write_meta( unit, name, cval=cval ) integer, intent(in) :: unit character(len=*), intent(in) :: name real, intent(in), optional :: rval(:) integer, intent(in), optional :: ival(:) character(len=*), intent(in), optional :: cval

This form defines global metadata associated with the file as a whole. The attribute is named <name> and can take on a real, integer or character value. <rval> and <ival> can be scalar or 1D arrays.

mpp_write_meta( unit, id, name, rval=rval, pack=pack ) mpp_write_meta( unit, id, name, ival=ival ) mpp_write_meta( unit, id, name, cval=cval ) integer, intent(in) :: unit, id character(len=*), intent(in) :: name real, intent(in), optional :: rval(:) integer, intent(in), optional :: ival(:) character(len=*), intent(in), optional :: cval

This form defines metadata associated with a previously defined axis or field, identified to mpp_write_meta by its unique ID <id>. The attribute is named <name> and can take on a real, integer or character value. <rval> and <ival> can be scalar or 1D arrays. This need not be called for attributes already contained in the type.

PACK can take values 1,2,4,8. This only has meaning when writing floating point numbers. The value of PACK defines the number of words written into 8 bytes. For pack=4 and pack=8, an integer value is written: rval is assumed to have been scaled to the appropriate dynamic range. PACK currently only works for netCDF files, and is ignored otherwise.

subroutine mpp_write_meta_axis( unit, axis, name, units, longname, & cartesian, sense, domain, data ) integer, intent(in) :: unit type(axistype), intent(inout) :: axis character(len=*), intent(in) :: name, units, longname character(len=*), intent(in), optional :: cartesian integer, intent(in), optional :: sense type(domain1D), intent(in), optional :: domain real, intent(in), optional :: data(:)

This form defines a time or space axis. Metadata corresponding to the type above are written to the file on <unit>. A unique ID for subsequent references to this axis is returned in axisid. If the <domain> element is present, this is recognized as a distributed data axis and domain decomposition information is also written if required (the domain decomposition info is required for multi-fileset multi-threaded I/O). If the <datLINK> element is allocated, it is considered to be a space axis, otherwise it is a time axis with an unlimited dimension. Only one time axis is allowed per file.

subroutine mpp_write_meta_field( unit, field, axes, name, units, longname
standard_name, min, max, missing, fill, scale, add, pack)
integer, intent(in) :: unit
type(fieldtype), intent(out) :: field
type(axistype), intent(in) :: axes(:)
character(len=*), intent(in) :: name, units, longname, standard_name
real, intent(in), optional :: min, max, missing, fill, scale, add
integer, intent(in), optional :: pack

This form defines a field. Metadata corresponding to the type above are written to the file on <unit>. A unique ID for subsequent references to this field is returned in fieldid. At least one axis must be associated, 0D variables are not considered. mpp_write_meta must previously have been called on all axes associated with this field.

The mpp_write_meta package also includes subroutines write_attribute and write_attribute_netcdf, that are private to this module.

Definition at line 886 of file mpp_io.F90.

Public Member Functions

 mpp_write_meta_axis_i1d
 
 mpp_write_meta_axis_r1d
 
 mpp_write_meta_axis_unlimited
 
 mpp_write_meta_field
 
 mpp_write_meta_global
 
 mpp_write_meta_global_scalar_i
 
 mpp_write_meta_global_scalar_r
 
 mpp_write_meta_scalar_i
 
 mpp_write_meta_scalar_r
 
 mpp_write_meta_var
 

◆ mpp_io_mod::mpp_write_unlimited_axis

interface mpp_io_mod::mpp_write_unlimited_axis

Definition at line 1098 of file mpp_io.F90.

Public Member Functions

 mpp_write_unlimited_axis_r1d
 

◆ mpp_io_mod::validtype

type mpp_io_mod::validtype

Definition at line 436 of file mpp_io.F90.

Collaboration diagram for validtype:
[legend]

Public Attributes

real max
 
real min
 

Private Attributes

logical is_range
 

Member Data Documentation

◆ is_range

logical is_range
private

Definition at line 438 of file mpp_io.F90.

◆ max

real max

Definition at line 439 of file mpp_io.F90.

◆ min

real min

Definition at line 439 of file mpp_io.F90.

◆ mpp_io_mod::write_record

interface mpp_io_mod::write_record

Definition at line 994 of file mpp_io.F90.

Public Member Functions

 write_record_r4
 
 write_record_r8
 

Function/Subroutine Documentation

◆ do_cf_compliance()

logical function do_cf_compliance

Definition at line 304 of file mpp_io_misc.inc.

◆ file_size()

subroutine file_size ( character(len=12), intent(in)  fsize,
character(len=128), intent(in), optional  fname,
integer, intent(out)  size 
)

Definition at line 939 of file mpp_io_connect.inc.

◆ mpp_attribute_exist()

logical function mpp_attribute_exist ( type(fieldtype), intent(in)  field,
character(len=*), intent(in)  name 
)

Definition at line 838 of file mpp_io_util.inc.

◆ mpp_close()

subroutine mpp_close ( integer, intent(in)  unit,
integer, intent(in), optional  action 
)

Definition at line 801 of file mpp_io_connect.inc.

◆ mpp_dist_io_pelist()

subroutine mpp_dist_io_pelist ( integer, intent(in)  ssize,
integer, dimension(:), intent(out), allocatable  pelist 
)

Definition at line 852 of file mpp_io_util.inc.

◆ mpp_file_is_opened()

logical function mpp_file_is_opened ( integer, intent(in)  unit)

return if certain file with unit is opened or not

Definition at line 780 of file mpp_io_util.inc.

◆ mpp_find_att()

integer function mpp_find_att ( type(atttype), dimension(:), intent(in)  atts,
character(len=*)  name 
)

Definition at line 669 of file mpp_io_util.inc.

◆ mpp_flush()

subroutine mpp_flush ( integer, intent(in)  unit)

Definition at line 275 of file mpp_io_misc.inc.

◆ mpp_get_att_char()

character(len=att%len) function mpp_get_att_char ( type(atttype), intent(in)  att)

return the char value of an attribute.

Definition at line 724 of file mpp_io_util.inc.

◆ mpp_get_att_length()

integer function mpp_get_att_length ( type(atttype), intent(in)  att)

return the length of an attribute.

Definition at line 711 of file mpp_io_util.inc.

◆ mpp_get_att_name()

character(len=len(att%name)) function mpp_get_att_name ( type(atttype), intent(in)  att)

return the name of an attribute.

Definition at line 687 of file mpp_io_util.inc.

◆ mpp_get_att_real()

real function, dimension(size(att%fatt(:))) mpp_get_att_real ( type(atttype), intent(in)  att)

return the real array value of an attribute.

Definition at line 736 of file mpp_io_util.inc.

◆ mpp_get_att_real_scalar()

real function mpp_get_att_real_scalar ( type(atttype), intent(in)  att)

return the real array value of an attribute.

Definition at line 748 of file mpp_io_util.inc.

◆ mpp_get_att_type()

integer function mpp_get_att_type ( type(atttype), intent(in)  att)

return the type of an attribute.

Definition at line 699 of file mpp_io_util.inc.

◆ mpp_get_axes()

subroutine mpp_get_axes ( integer, intent(in)  unit,
type(axistype), dimension(:), intent(inout)  axes,
type(axistype), intent(inout), optional  time_axis 
)

Copy variable information from file (excluding data)

Definition at line 220 of file mpp_io_util.inc.

◆ mpp_get_axis_atts()

subroutine mpp_get_axis_atts ( type(axistype), intent(in)  axis,
character(len=*), intent(out), optional  name,
character(len=*), intent(out), optional  units,
character(len=*), intent(out), optional  longname,
character(len=*), intent(out), optional  cartesian,
character(len=*), intent(out), optional  calendar,
integer, intent(out), optional  sense,
integer, intent(out), optional  len,
integer, intent(out), optional  natts,
type(atttype), dimension(:), intent(inout), optional  atts,
character(len=*), intent(out), optional  compressed 
)

Definition at line 156 of file mpp_io_util.inc.

◆ mpp_get_axis_bounds()

logical function mpp_get_axis_bounds ( type(axistype), intent(in)  axis,
real, dimension(:), intent(out)  data,
character(len=*), intent(out), optional  name 
)

Definition at line 434 of file mpp_io_util.inc.

◆ mpp_get_axis_by_name()

type(axistype) function mpp_get_axis_by_name ( integer  unit,
character(len=*)  axisname 
)

Definition at line 385 of file mpp_io_util.inc.

◆ mpp_get_axis_data()

subroutine mpp_get_axis_data ( type(axistype), intent(in)  axis,
real, dimension(:), intent(out)  data 
)

Definition at line 454 of file mpp_io_util.inc.

◆ mpp_get_axis_id()

integer function mpp_get_axis_id ( type(axistype), intent(in)  axis)

Definition at line 520 of file mpp_io_util.inc.

◆ mpp_get_axis_index()

integer function mpp_get_axis_index ( type(axistype), dimension(:)  axes,
character(len=*)  axisname 
)

Definition at line 364 of file mpp_io_util.inc.

◆ mpp_get_axis_length()

integer function mpp_get_axis_length ( type(axistype)  axis)

Definition at line 423 of file mpp_io_util.inc.

◆ mpp_get_default_calendar()

character(len=len(default_axis%calendar)) function mpp_get_default_calendar

Copy variable information from file (excluding data)

Definition at line 297 of file mpp_io_util.inc.

◆ mpp_get_dimension_length()

integer function mpp_get_dimension_length ( integer, intent(in)  unit,
character(len=*), intent(in)  dimname,
logical, intent(out), optional  found 
)

Copy variable information from file (excluding data)

Definition at line 253 of file mpp_io_util.inc.

◆ mpp_get_field_att_text()

subroutine mpp_get_field_att_text ( integer, intent(in)  unit,
character(len=*), intent(in)  fieldname,
character(len=*), intent(in)  attname,
character(len=*), intent(out)  attvalue 
)

return the attribute value of given field name

Definition at line 791 of file mpp_io_util.inc.

◆ mpp_get_field_atts()

subroutine mpp_get_field_atts ( type(fieldtype), intent(in)  field,
character(len=*), intent(out), optional  name,
character(len=*), intent(out), optional  units,
character(len=*), intent(out), optional  longname,
real, intent(out), optional  min,
real, intent(out), optional  max,
real, intent(out), optional  missing,
integer, intent(out), optional  ndim,
integer, dimension(:), intent(out), optional  siz,
type(axistype), dimension(:), intent(inout), optional  axes,
type(atttype), dimension(:), intent(inout), optional  atts,
type(validtype), intent(out), optional  valid,
real, intent(out), optional  scale,
real, intent(out), optional  add,
integer(i8_kind), dimension(:), intent(out), optional  checksum 
)

Definition at line 79 of file mpp_io_util.inc.

◆ mpp_get_field_id()

integer function mpp_get_field_id ( type(fieldtype), intent(in)  field)

Definition at line 528 of file mpp_io_util.inc.

◆ mpp_get_field_index()

integer function mpp_get_field_index ( type(fieldtype), dimension(:)  fields,
character(len=*)  fieldname 
)

Definition at line 343 of file mpp_io_util.inc.

◆ mpp_get_field_name()

character(len=len(field%name)) function mpp_get_field_name ( type(fieldtype), intent(in)  field)

return the name of an field

Definition at line 759 of file mpp_io_util.inc.

◆ mpp_get_field_size()

integer function, dimension(4) mpp_get_field_size ( type(fieldtype)  field)

Definition at line 406 of file mpp_io_util.inc.

◆ mpp_get_fields()

subroutine mpp_get_fields ( integer, intent(in)  unit,
type(fieldtype), dimension(:), intent(inout)  variables 
)

Copy variable information from file (excluding data)

Definition at line 194 of file mpp_io_util.inc.

◆ mpp_get_file_name()

character(len=len(mpp_file(1)%name)) function mpp_get_file_name ( integer, intent(in)  unit)

return the file name of corresponding unit

Definition at line 769 of file mpp_io_util.inc.

◆ mpp_get_global_atts()

subroutine mpp_get_global_atts ( integer, intent(in)  unit,
type(atttype), dimension(:), intent(inout)  global_atts 
)

Copy global file attributes for use by user.

Parameters
[in,out]global_attsan attribute type which is allocated from the calling routine

Definition at line 52 of file mpp_io_util.inc.

◆ mpp_get_info()

subroutine mpp_get_info ( integer, intent(in)  unit,
integer, intent(out)  ndim,
integer, intent(out)  nvar,
integer, intent(out)  natt,
integer, intent(out)  ntime 
)

Get some general information about a file.


Example usage:

call mpp_get_info( unit, ndim, nvar, natt, ntime )
subroutine mpp_get_info(unit, ndim, nvar, natt, ntime)
Get some general information about a file.

Definition at line 32 of file mpp_io_util.inc.

◆ mpp_get_maxunits()

integer function mpp_get_maxunits

Return the maximum number of MPP file units available.

maxunits is a mpp_io_mod module variable and defines the maximum number of Fortran file units that can be open simultaneously. mpp_get_maxunits simply returns this number.

Definition at line 300 of file mpp_io_misc.inc.

◆ mpp_get_ncid()

integer function mpp_get_ncid ( integer, intent(in)  unit)

Get netCDF ID of an open file.

This returns the ncid associated with the open file on unit. It is used in the instance that the user desires to perform netCDF calls upon the file that are not provided by the mpp_io_mod API itself.

Definition at line 511 of file mpp_io_util.inc.

◆ mpp_get_recdimid()

integer function mpp_get_recdimid ( integer, intent(in)  unit)

Definition at line 474 of file mpp_io_util.inc.

◆ mpp_get_time_axis()

subroutine mpp_get_time_axis ( integer, intent(in)  unit,
type(axistype), intent(inout)  time_axis 
)

Copy variable information from file (excluding data)

Definition at line 282 of file mpp_io_util.inc.

◆ mpp_get_times()

subroutine mpp_get_times ( integer, intent(in)  unit,
real, dimension(:), intent(inout)  time_values 
)

Get file time data.

Copy time information from file and convert to time_type
Example usage:

call mpp_get_times( unit, time_values)
subroutine mpp_get_times(unit, time_values)
Get file time data.

Definition at line 311 of file mpp_io_util.inc.

◆ mpp_get_valid()

subroutine mpp_get_valid ( type(fieldtype), intent(in)  f,
type(validtype), intent(out)  v 
)

Based on presence/absence of attributes, defines valid range or missing.

Definition at line 555 of file mpp_io_util.inc.

◆ mpp_io_clock_on()

logical function mpp_io_clock_on

return mpp_io_nml variable io_clock_on

Definition at line 829 of file mpp_io_util.inc.

◆ mpp_io_exit()

subroutine mpp_io_exit ( character(len=*), optional  string)

Definition at line 214 of file mpp_io_misc.inc.

◆ mpp_io_init()

subroutine mpp_io_init ( integer, intent(in), optional  flags,
integer, intent(in), optional  maxunit 
)

Definition at line 52 of file mpp_io_misc.inc.

◆ mpp_io_set_stack_size()

subroutine mpp_io_set_stack_size ( integer, intent(in)  n)

Set the mpp_io_stack variable to be at least n LONG words long.

Definition at line 537 of file mpp_io_util.inc.

◆ mpp_io_unstructured_read_r4_1d()

subroutine mpp_io_unstructured_read_r4_1d ( integer(i4_kind), intent(in)  funit,
type(fieldtype), intent(in)  field,
type(domainug), intent(in)  domain,
real(kind=r4_kind), dimension(:), intent(inout)  fdata,
integer(i4_kind), intent(in), optional  tindex,
integer(i4_kind), dimension(:), intent(in), optional  start,
integer(i4_kind), dimension(:), intent(in), optional  nread,
integer(i4_kind), intent(in), optional  threading 
)

Read in one-dimensional data for a field associated with an unstructured mpp domain.

Parameters
[in]funitA file unit returned by mpp_open.
[in]fieldA field whose data will be read in from the file.
[in]domainAn unstructured mpp domain.
[in,out]fdataThe data that will be read in from the file.
[in]tindexTime level index for a NetCDF file.
[in]startCorner indices for a NetCDF file.
[in]nreadEdge lengths for a NetCDF file.
[in]threadingFlag telling whether one or multiple ranks will read the file.

Definition at line 578 of file mpp_io_unstructured_read.inc.

◆ mpp_io_unstructured_read_r4_2d()

subroutine mpp_io_unstructured_read_r4_2d ( integer(i4_kind), intent(in)  funit,
type(fieldtype), intent(in)  field,
type(domainug), intent(in)  domain,
real(kind=r4_kind), dimension(:,:), intent(inout)  fdata,
integer(i4_kind), intent(in), optional  tindex,
integer(i4_kind), dimension(:), intent(in), optional  start,
integer(i4_kind), dimension(:), intent(in), optional  nread,
integer(i4_kind), intent(in), optional  threading 
)

Read in two-dimensional data for a field associated with an unstructured mpp domain.

Parameters
[in]funitA file unit returned by mpp_open.
[in]fieldA field whose data will be read in from the file.
[in]domainAn unstructured mpp domain.
[in,out]fdataThe data that will be read in from the file.
[in]tindexTime level index for a NetCDF file.
[in]startCorner indices for a NetCDF file.
[in]nreadEdge lengths for a NetCDF file.
[in]threadingFlag telling whether one or multiple ranks will read the file.

Definition at line 760 of file mpp_io_unstructured_read.inc.

◆ mpp_io_unstructured_read_r4_3d()

subroutine mpp_io_unstructured_read_r4_3d ( integer(i4_kind), intent(in)  funit,
type(fieldtype), intent(in)  field,
type(domainug), intent(in)  domain,
real(kind=r4_kind), dimension(:,:,:), intent(inout)  fdata,
integer(i4_kind), intent(in), optional  tindex,
integer(i4_kind), dimension(:), intent(in), optional  start,
integer(i4_kind), dimension(:), intent(in), optional  nread,
integer(i4_kind), intent(in), optional  threading 
)

Read in three-dimensional data for a field associated with an unstructured mpp domain.

Parameters
[in]funitA file unit returned by mpp_open.
[in]fieldA field whose data will be read in from the file.
[in]domainAn unstructured mpp domain.
[in,out]fdataThe data that will be read in from the file.
[in]tindexTime level index for a NetCDF file.
[in]startCorner indices for a NetCDF file.
[in]nreadEdge lengths for a NetCDF file.
[in]threadingFlag telling whether one or multiple ranks will read the file.

Definition at line 942 of file mpp_io_unstructured_read.inc.

◆ mpp_io_unstructured_read_r8_1d()

subroutine mpp_io_unstructured_read_r8_1d ( integer(i4_kind), intent(in)  funit,
type(fieldtype), intent(in)  field,
type(domainug), intent(in)  domain,
real(kind=r8_kind), dimension(:), intent(inout)  fdata,
integer(i4_kind), intent(in), optional  tindex,
integer(i4_kind), dimension(:), intent(in), optional  start,
integer(i4_kind), dimension(:), intent(in), optional  nread,
integer(i4_kind), intent(in), optional  threading 
)

Read in one-dimensional data for a field associated with an unstructured mpp domain.

Parameters
[in]funitA file unit returned by mpp_open.
[in]fieldA field whose data will be read in from the file.
[in]domainAn unstructured mpp domain.
[in,out]fdataThe data that will be read in from the file.
[in]tindexTime level index for a NetCDF file.
[in]startCorner indices for a NetCDF file.
[in]nreadEdge lengths for a NetCDF file.
[in]threadingFlag telling whether one or multiple ranks will read the file.

Definition at line 28 of file mpp_io_unstructured_read.inc.

◆ mpp_io_unstructured_read_r8_2d()

subroutine mpp_io_unstructured_read_r8_2d ( integer(i4_kind), intent(in)  funit,
type(fieldtype), intent(in)  field,
type(domainug), intent(in)  domain,
real(kind=r8_kind), dimension(:,:), intent(inout)  fdata,
integer(i4_kind), intent(in), optional  tindex,
integer(i4_kind), dimension(:), intent(in), optional  start,
integer(i4_kind), dimension(:), intent(in), optional  nread,
integer(i4_kind), intent(in), optional  threading 
)

Read in two-dimensional data for a field associated with an unstructured mpp domain.

Parameters
[in]funitA file unit returned by mpp_open.
[in]fieldA field whose data will be read in from the file.
[in]domainAn unstructured mpp domain.
[in,out]fdataThe data that will be read in from the file.
[in]tindexTime level index for a NetCDF file.
[in]startCorner indices for a NetCDF file.
[in]nreadEdge lengths for a NetCDF file.
[in]threadingFlag telling whether one or multiple ranks will read the file.

Definition at line 210 of file mpp_io_unstructured_read.inc.

◆ mpp_io_unstructured_read_r8_3d()

subroutine mpp_io_unstructured_read_r8_3d ( integer(i4_kind), intent(in)  funit,
type(fieldtype), intent(in)  field,
type(domainug), intent(in)  domain,
real(kind=r8_kind), dimension(:,:,:), intent(inout)  fdata,
integer(i4_kind), intent(in), optional  tindex,
integer(i4_kind), dimension(:), intent(in), optional  start,
integer(i4_kind), dimension(:), intent(in), optional  nread,
integer(i4_kind), intent(in), optional  threading 
)

Read in three-dimensional data for a field associated with an unstructured mpp domain.

Parameters
[in]funitA file unit returned by mpp_open.
[in]fieldA field whose data will be read in from the file.
[in]domainAn unstructured mpp domain.
[in,out]fdataThe data that will be read in from the file.
[in]tindexTime level index for a NetCDF file.
[in]startCorner indices for a NetCDF file.
[in]nreadEdge lengths for a NetCDF file.
[in]threadingFlag telling whether one or multiple ranks will read the file.

Definition at line 392 of file mpp_io_unstructured_read.inc.

◆ mpp_io_unstructured_write_r4_1d()

subroutine mpp_io_unstructured_write_r4_1d ( integer(i4_kind), intent(in)  funit,
type(fieldtype), intent(inout)  field,
type(domainug), intent(inout)  domain,
real(kind=r4_kind), dimension(:), intent(inout)  fdata,
integer, dimension(:), intent(in)  nelems_io,
real(kind=r4_kind), intent(in), optional  tstamp,
real(kind=r4_kind), intent(in), optional  default_data 
)

Write data for a 1D field associated with an unstructured mpp domain to a restart file.

Parameters
[in]funitA file unit for the to which the data will be written
[in,out]fieldA field whose data will be written
[in,out]domainAn unstructured mpp domain associatd with the inputted file
[in,out]fdataThe data that will be written to the file
[in]nelems_ioNumber of grid points in the compressed dimension for each rank (correct sizes only exist for the root rank of I/O domain pelist)
[in]tstampA time value
[in]default_dataFill value for the inputted field

Definition at line 724 of file mpp_io_unstructured_write.inc.

◆ mpp_io_unstructured_write_r4_2d()

subroutine mpp_io_unstructured_write_r4_2d ( integer(i4_kind), intent(in)  funit,
type(fieldtype), intent(inout)  field,
type(domainug), intent(inout)  domain,
real(kind=r4_kind), dimension(:,:), intent(inout)  fdata,
integer, dimension(:), intent(in)  nelems_io,
real(kind=r4_kind), intent(in), optional  tstamp,
real(kind=r4_kind), intent(in), optional  default_data 
)

Write data for a 2D field associated with an unstructured mpp domain to a restart file.

Parameters
[in]funitA file unit for the to which the data will be written
[in,out]fieldA field whose data will be written
[in,out]domainAn unstructured mpp domain associatd with the inputted file
[in,out]fdataThe data that will be written to the file
[in]nelems_ioNumber of grid points in the compressed dimension for each rank (correct sizes only exist for the root rank of I/O domain pelist)
[in]tstampA time value
[in]default_dataFill value for the inputted field

Definition at line 859 of file mpp_io_unstructured_write.inc.

◆ mpp_io_unstructured_write_r4_3d()

subroutine mpp_io_unstructured_write_r4_3d ( integer(i4_kind), intent(in)  funit,
type(fieldtype), intent(inout)  field,
type(domainug), intent(inout)  domain,
real(kind=r4_kind), dimension(:,:,:), intent(inout)  fdata,
integer, dimension(:), intent(in)  nelems_io,
real(kind=r4_kind), intent(in), optional  tstamp,
real(kind=r4_kind), intent(in), optional  default_data 
)

Write data for a 3D field associated with an unstructured mpp domain to a restart file.

Parameters
[in]funitA file unit for the to which the data will be written
[in,out]fieldA field whose data will be written
[in,out]domainAn unstructured mpp domain associatd with the inputted file
[in,out]fdataThe data that will be written to the file
[in]nelems_ioNumber of grid points in the compressed dimension for each rank (correct sizes only exist for the root rank of I/O domain pelist)
[in]tstampA time value
[in]default_dataFill value for the inputted field

Definition at line 1030 of file mpp_io_unstructured_write.inc.

◆ mpp_io_unstructured_write_r4_4d()

subroutine mpp_io_unstructured_write_r4_4d ( integer(i4_kind), intent(in)  funit,
type(fieldtype), intent(inout)  field,
type(domainug), intent(inout)  domain,
real(kind=r4_kind), dimension(:,:,:,:), intent(inout)  fdata,
integer, dimension(:), intent(in), optional  nelems_io_in,
real(kind=r4_kind), intent(in), optional  tstamp,
real(kind=r4_kind), intent(in), optional  default_data 
)

Write data for a 4D field associated with an unstructured mpp domain to a restart file.

Parameters
[in]funitA file unit for the to which the data will be written
[in,out]fieldA field whose data will be written
[in,out]domainAn unstructured mpp domain associatd with the inputted file
[in,out]fdataThe data that will be written to the file
[in]nelems_io_inNumber of grid points in the unstructured dimension for each rank (correct sizes only (cexist for the root rank of I/O domain pelist
[in]tstampA time value
[in]default_dataFill value for the inputted field

Definition at line 1214 of file mpp_io_unstructured_write.inc.

◆ mpp_io_unstructured_write_r8_1d()

subroutine mpp_io_unstructured_write_r8_1d ( integer(i4_kind), intent(in)  funit,
type(fieldtype), intent(inout)  field,
type(domainug), intent(inout)  domain,
real(kind=r8_kind), dimension(:), intent(inout)  fdata,
integer, dimension(:), intent(in)  nelems_io,
real(kind=r8_kind), intent(in), optional  tstamp,
real(kind=r8_kind), intent(in), optional  default_data 
)

Write data for a 1D field associated with an unstructured mpp domain to a restart file.

Parameters
[in]funitA file unit for the to which the data will be written
[in,out]fieldA field whose data will be written
[in,out]domainAn unstructured mpp domain associatd with the inputted file
[in,out]fdataThe data that will be written to the file
[in]nelems_ioNumber of grid points in the compressed dimension for each rank (correct sizes only exist for the root rank of I/O domain pelist)
[in]tstampA time value
[in]default_dataFill value for the inputted field

Definition at line 28 of file mpp_io_unstructured_write.inc.

◆ mpp_io_unstructured_write_r8_2d()

subroutine mpp_io_unstructured_write_r8_2d ( integer(i4_kind), intent(in)  funit,
type(fieldtype), intent(inout)  field,
type(domainug), intent(inout)  domain,
real(kind=r8_kind), dimension(:,:), intent(inout)  fdata,
integer, dimension(:), intent(in)  nelems_io,
real(kind=r8_kind), intent(in), optional  tstamp,
real(kind=r8_kind), intent(in), optional  default_data 
)

Write data for a 2D field associated with an unstructured mpp domain to a restart file.

Parameters
[in]funitA file unit for the to which the data will be written
[in,out]fieldA field whose data will be written
[in,out]domainAn unstructured mpp domain associatd with the inputted file
[in,out]fdataThe data that will be written to the file
[in]nelems_ioNumber of grid points in the compressed dimension for each rank (correct sizes only exist for the root rank of I/O domain pelist)
[in]tstampA time value
[in]default_dataFill value for the inputted field

Definition at line 163 of file mpp_io_unstructured_write.inc.

◆ mpp_io_unstructured_write_r8_3d()

subroutine mpp_io_unstructured_write_r8_3d ( integer(i4_kind), intent(in)  funit,
type(fieldtype), intent(inout)  field,
type(domainug), intent(inout)  domain,
real(kind=r8_kind), dimension(:,:,:), intent(inout)  fdata,
integer, dimension(:), intent(in)  nelems_io,
real(kind=r8_kind), intent(in), optional  tstamp,
real(kind=r8_kind), intent(in), optional  default_data 
)

Write data for a 3D field associated with an unstructured mpp domain to a restart file.

Parameters
[in]funitA file unit for the to which the data will be written
[in,out]fieldA field whose data will be written
[in,out]domainAn unstructured mpp domain associatd with the inputted file
[in,out]fdataThe data that will be written to the file
[in]nelems_ioNumber of grid points in the compressed dimension for each rank (correct sizes only exist for the root rank of I/O domain pelist)
[in]tstampA time value
[in]default_dataFill value for the inputted field

Definition at line 334 of file mpp_io_unstructured_write.inc.

◆ mpp_io_unstructured_write_r8_4d()

subroutine mpp_io_unstructured_write_r8_4d ( integer(i4_kind), intent(in)  funit,
type(fieldtype), intent(inout)  field,
type(domainug), intent(inout)  domain,
real(kind=r8_kind), dimension(:,:,:,:), intent(inout)  fdata,
integer, dimension(:), intent(in), optional  nelems_io_in,
real(kind=r8_kind), intent(in), optional  tstamp,
real(kind=r8_kind), intent(in), optional  default_data 
)

Write data for a 4D field associated with an unstructured mpp domain to a restart file.

Parameters
[in]funitA file unit for the to which the data will be written
[in,out]fieldA field whose data will be written
[in,out]domainAn unstructured mpp domain associatd with the inputted file
[in,out]fdataThe data that will be written to the file
[in]nelems_io_inNumber of grid points in the unstructured dimension for each rank (correct sizes only (cexist for the root rank of I/O domain pelist
[in]tstampA time value
[in]default_dataFill value for the inputted field

Definition at line 518 of file mpp_io_unstructured_write.inc.

◆ mpp_is_dist_ioroot()

logical function mpp_is_dist_ioroot ( integer, intent(in)  ssize,
integer, intent(out), optional  ioroot,
integer, intent(out), optional  lsize 
)

Definition at line 873 of file mpp_io_util.inc.

◆ mpp_is_valid()

logical elemental function mpp_is_valid ( real, intent(in)  x,
type(validtype), intent(in)  v 
)

Definition at line 655 of file mpp_io_util.inc.

◆ mpp_open()

subroutine mpp_open ( integer, intent(out)  unit,
character(len=*), intent(in)  file,
integer, intent(in), optional  action,
integer, intent(in), optional  form,
integer, intent(in), optional  access,
integer, intent(in), optional  threading,
integer, intent(in), optional  fileset,
character(len=*), intent(in), optional  iospec,
logical, intent(in), optional  nohdrs,
integer, intent(in), optional  recl,
integer, intent(out), optional  iostat,
logical, intent(in), optional  is_root_pe,
type(domain2d), intent(in), optional  domain,
type(domainug), intent(in), optional, target  domain_ug 
)

Definition at line 162 of file mpp_io_connect.inc.

◆ netcdf_err()

subroutine netcdf_err ( integer, intent(in)  err,
type(filetype), optional  file,
type(axistype), optional  axis,
type(fieldtype), optional  field,
type(atttype), optional  attr,
character(len=*), optional  string 
)

Definition at line 251 of file mpp_io_misc.inc.

Variable Documentation

◆ cf_compliance

logical cf_compliance = .false.
private

Definition at line 1152 of file mpp_io.F90.

◆ debug

logical debug = .FALSE.
private

Definition at line 1133 of file mpp_io.F90.

◆ default_att

type(atttype), save, public default_att

Definition at line 1160 of file mpp_io.F90.

◆ default_axis

type(axistype), save, public default_axis

Definition at line 1158 of file mpp_io.F90.

◆ default_field

type(fieldtype), save, public default_field

Definition at line 1159 of file mpp_io.F90.

◆ deflate

integer deflate = 0
private

Definition at line 1150 of file mpp_io.F90.

◆ deflate_level

integer deflate_level = -1
private

Definition at line 1151 of file mpp_io.F90.

◆ error

integer error
private

Definition at line 1139 of file mpp_io.F90.

◆ global_field_on_root_pe

logical global_field_on_root_pe = .true.
private

Definition at line 1147 of file mpp_io.F90.

◆ header_buffer_val

integer header_buffer_val = 16384
private

Definition at line 1146 of file mpp_io.F90.

◆ io_clocks_on

logical io_clocks_on = .false.
private

Definition at line 1148 of file mpp_io.F90.

◆ max_att_length

integer, parameter max_att_length = 1280
private

Definition at line 403 of file mpp_io.F90.

◆ maxunits

integer maxunits
private

Definition at line 1134 of file mpp_io.F90.

◆ module_is_initialized

logical module_is_initialized = .FALSE.
private

Definition at line 1131 of file mpp_io.F90.

◆ mpp_close_clock

integer mpp_close_clock =0
private

Definition at line 1142 of file mpp_io.F90.

◆ mpp_file

type(filetype), dimension(:), allocatable mpp_file
private

Definition at line 1161 of file mpp_io.F90.

◆ mpp_io_stack

real(r8_kind), dimension(:), allocatable mpp_io_stack
private

Definition at line 1157 of file mpp_io.F90.

◆ mpp_io_stack_hwm

integer mpp_io_stack_hwm =0
private

Definition at line 1135 of file mpp_io.F90.

◆ mpp_io_stack_size

integer mpp_io_stack_size =0
private

Definition at line 1135 of file mpp_io.F90.

◆ mpp_open_clock

integer mpp_open_clock =0
private

Definition at line 1142 of file mpp_io.F90.

◆ mpp_read_clock

integer mpp_read_clock =0
private

Definition at line 1141 of file mpp_io.F90.

◆ mpp_write_clock

integer mpp_write_clock =0
private

Definition at line 1141 of file mpp_io.F90.

◆ npes

integer npes
private

Definition at line 1137 of file mpp_io.F90.

◆ pack_size

integer pack_size
private

Definition at line 1163 of file mpp_io.F90.

◆ pe

integer pe
private

Definition at line 1137 of file mpp_io.F90.

◆ records_per_pe

integer records_per_pe
private

Definition at line 1140 of file mpp_io.F90.

◆ shuffle

integer shuffle = 0
private

Definition at line 1149 of file mpp_io.F90.

◆ text

character(len=256) text
private

Definition at line 1138 of file mpp_io.F90.

◆ unit_begin

integer unit_begin
private

Definition at line 1134 of file mpp_io.F90.

◆ unit_end

integer unit_end
private

Definition at line 1134 of file mpp_io.F90.

◆ varnum

integer varnum =0
private

Definition at line 1136 of file mpp_io.F90.

◆ verbose

logical verbose =.FALSE.
private

Definition at line 1132 of file mpp_io.F90.