In the context of MPAS, the concept of a "pool" resembles a group of
(related) variables, while the concept of a "stream" resembles a file.
This subroutine initializes an MPAS stream with an accompanying MPAS pool by
adding variable and attribute information to them. After that, MPAS is ready
to perform IO on them.
Analogous to the build_stream and mpas_stream_mgr_add_field
subroutines in MPAS stream manager.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| class(mpas_dynamical_core_type), | intent(in) | :: | self | |||
| type(mpas_pool_type), | intent(out), | pointer | :: | mpas_pool | ||
| type(mpas_stream_type), | intent(out), | pointer | :: | mpas_stream | ||
| type(file_desc_t), | intent(in), | pointer | :: | pio_file | ||
| character(len=*), | intent(in) | :: | stream_mode | |||
| character(len=*), | intent(in) | :: | stream_name |
| Type | Visibility | Attributes | Name | Initial | |||
|---|---|---|---|---|---|---|---|
| type(field0dchar), | private, | pointer | :: | field_0d_char | |||
| type(field0dinteger), | private, | pointer | :: | field_0d_integer | |||
| type(field0dreal), | private, | pointer | :: | field_0d_real | |||
| type(field1dchar), | private, | pointer | :: | field_1d_char | |||
| type(field1dinteger), | private, | pointer | :: | field_1d_integer | |||
| type(field1dreal), | private, | pointer | :: | field_1d_real | |||
| type(field2dinteger), | private, | pointer | :: | field_2d_integer | |||
| type(field2dreal), | private, | pointer | :: | field_2d_real | |||
| type(field3dinteger), | private, | pointer | :: | field_3d_integer | |||
| type(field3dreal), | private, | pointer | :: | field_3d_real | |||
| type(field4dreal), | private, | pointer | :: | field_4d_real | |||
| type(field5dreal), | private, | pointer | :: | field_5d_real | |||
| integer, | private | :: | i | ||||
| integer, | private | :: | ierr | ||||
| character(len=strkind), | private | :: | stream_filename | ||||
| integer, | private | :: | stream_format | ||||
| character(len=*), | private, | parameter | :: | subname | = | 'dyn_mpas_subdriver::dyn_mpas_init_stream_with_pool' | |
| type(var_info_type), | private, | allocatable | :: | var_info_list(:) | |||
| logical, | private, | allocatable | :: | var_is_present(:) |
Whether a variable is present on the file (i.e., |
||
| logical, | private, | allocatable | :: | var_is_tkr_compatible(:) |
Whether a variable is type, kind, and rank compatible with what MPAS expects on the file (i.e., |
Helper subroutine for adding a 0-d stream attribute by calling mpas_writestreamatt with error checking.
(KCW, 2024-03-14)
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*), | intent(in) | :: | attribute_name | |||
| class(*), | intent(in) | :: | attribute_value |
Helper subroutine for adding a 1-d stream attribute by calling mpas_writestreamatt with error checking.
(KCW, 2024-03-14)
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*), | intent(in) | :: | attribute_name | |||
| class(*), | intent(in) | :: | attribute_value(:) |
Helper subroutine for adding a 0-d stream attribute by calling mpas_writestreamatt with error checking.
(KCW, 2024-03-14)
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*), | intent(in) | :: | attribute_name | |||
| class(*), | intent(in) | :: | attribute_value |
Helper subroutine for adding a 1-d stream attribute by calling mpas_writestreamatt with error checking.
(KCW, 2024-03-14)
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*), | intent(in) | :: | attribute_name | |||
| class(*), | intent(in) | :: | attribute_value(:) |
subroutine dyn_mpas_init_stream_with_pool(self, mpas_pool, mpas_stream, pio_file, stream_mode, stream_name) ! Module(s) from external libraries. use pio, only: file_desc_t, pio_file_is_open ! Module(s) from MPAS. use mpas_derived_types, only: field0dchar, field1dchar, & field0dinteger, field1dinteger, field2dinteger, field3dinteger, & field0dreal, field1dreal, field2dreal, field3dreal, field4dreal, field5dreal, & mpas_io_native_precision, mpas_io_pnetcdf, mpas_io_read, mpas_io_write, & mpas_pool_type, mpas_stream_noerr, mpas_stream_type use mpas_io_streams, only: mpas_createstream, mpas_streamaddfield use mpas_pool_routines, only: mpas_pool_add_config, mpas_pool_create_pool, mpas_pool_get_field class(mpas_dynamical_core_type), intent(in) :: self type(mpas_pool_type), pointer, intent(out) :: mpas_pool type(mpas_stream_type), pointer, intent(out) :: mpas_stream type(file_desc_t), pointer, intent(in) :: pio_file character(*), intent(in) :: stream_mode character(*), intent(in) :: stream_name interface add_stream_attribute procedure :: add_stream_attribute_0d procedure :: add_stream_attribute_1d end interface add_stream_attribute character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_init_stream_with_pool' character(strkind) :: stream_filename integer :: i, ierr, stream_format !> Whether a variable is present on the file (i.e., `pio_file`). logical, allocatable :: var_is_present(:) !> Whether a variable is type, kind, and rank compatible with what MPAS expects on the file (i.e., `pio_file`). logical, allocatable :: var_is_tkr_compatible(:) type(field0dchar), pointer :: field_0d_char type(field1dchar), pointer :: field_1d_char type(field0dinteger), pointer :: field_0d_integer type(field1dinteger), pointer :: field_1d_integer type(field2dinteger), pointer :: field_2d_integer type(field3dinteger), pointer :: field_3d_integer type(field0dreal), pointer :: field_0d_real type(field1dreal), pointer :: field_1d_real type(field2dreal), pointer :: field_2d_real type(field3dreal), pointer :: field_3d_real type(field4dreal), pointer :: field_4d_real type(field5dreal), pointer :: field_5d_real type(var_info_type), allocatable :: var_info_list(:) call self % debug_print(log_level_debug, subname // ' entered') nullify(field_0d_char) nullify(field_1d_char) nullify(field_0d_integer) nullify(field_1d_integer) nullify(field_2d_integer) nullify(field_3d_integer) nullify(field_0d_real) nullify(field_1d_real) nullify(field_2d_real) nullify(field_3d_real) nullify(field_4d_real) nullify(field_5d_real) call mpas_pool_create_pool(mpas_pool) allocate(mpas_stream, stat=ierr) if (ierr /= 0) then call self % model_error('Failed to allocate stream "' // trim(adjustl(stream_name)) // '"', subname, __LINE__) end if ! Not actually used because a PIO file descriptor is directly supplied. stream_filename = 'external stream' stream_format = mpas_io_pnetcdf call self % debug_print(log_level_verbose, 'Checking PIO file descriptor') if (.not. associated(pio_file)) then call self % model_error('Invalid PIO file descriptor', subname, __LINE__) end if if (.not. pio_file_is_open(pio_file)) then call self % model_error('Invalid PIO file descriptor', subname, __LINE__) end if select case (trim(adjustl(stream_mode))) case ('r', 'read') call self % debug_print(log_level_verbose, 'Creating stream "' // trim(adjustl(stream_name)) // '" for reading') call mpas_createstream( & mpas_stream, self % domain_ptr % iocontext, stream_filename, stream_format, mpas_io_read, & clobberrecords=.false., clobberfiles=.false., truncatefiles=.false., & precision=mpas_io_native_precision, pio_file_desc=pio_file, ierr=ierr) case ('w', 'write') call self % debug_print(log_level_verbose, 'Creating stream "' // trim(adjustl(stream_name)) // '" for writing') call mpas_createstream( & mpas_stream, self % domain_ptr % iocontext, stream_filename, stream_format, mpas_io_write, & clobberrecords=.false., clobberfiles=.false., truncatefiles=.false., & precision=mpas_io_native_precision, pio_file_desc=pio_file, ierr=ierr) case default call self % model_error('Unsupported stream mode "' // trim(adjustl(stream_mode)) // '"', subname, __LINE__) end select if (ierr /= mpas_stream_noerr) then call self % model_error('Failed to create stream "' // trim(adjustl(stream_name)) // '"', subname, __LINE__) end if var_info_list = parse_stream_name(stream_name) ! Add variables contained in `var_info_list` to stream. do i = 1, size(var_info_list) call self % debug_print(log_level_debug, 'var_info_list(' // stringify([i]) // ') % name = ' // & stringify([var_info_list(i) % name])) call self % debug_print(log_level_debug, 'var_info_list(' // stringify([i]) // ') % type = ' // & stringify([var_info_list(i) % type])) call self % debug_print(log_level_debug, 'var_info_list(' // stringify([i]) // ') % rank = ' // & stringify([var_info_list(i) % rank])) if (trim(adjustl(stream_mode)) == 'r' .or. trim(adjustl(stream_mode)) == 'read') then call self % check_variable_status(var_is_present, var_is_tkr_compatible, pio_file, var_info_list(i)) ! Do not hard crash the model if a variable is missing and cannot be read. ! This can happen if users attempt to initialize/restart the model with data generated by ! older versions of MPAS. Print a debug message to let users decide if this is acceptable. if (.not. any(var_is_present)) then call self % debug_print(log_level_verbose, 'Skipping variable "' // trim(adjustl(var_info_list(i) % name)) // & '" due to not present') cycle end if if (any(var_is_present .and. .not. var_is_tkr_compatible)) then call self % debug_print(log_level_verbose, 'Skipping variable "' // trim(adjustl(var_info_list(i) % name)) // & '" due to not TKR compatible') cycle end if end if ! Add "<variable name>" to pool with the value of `1`. ! The existence of "<variable name>" in pool causes it to be considered for IO in MPAS. call mpas_pool_add_config(mpas_pool, trim(adjustl(var_info_list(i) % name)), 1) ! Add "<variable name>:packages" to pool with the value of an empty character string. ! This causes "<variable name>" to be always considered active for IO in MPAS. call mpas_pool_add_config(mpas_pool, trim(adjustl(var_info_list(i) % name) // ':packages'), '') ! Add "<variable name>" to stream. call self % debug_print(log_level_verbose, 'Adding variable "' // trim(adjustl(var_info_list(i) % name)) // & '" to stream "' // trim(adjustl(stream_name)) // '"') select case (trim(adjustl(var_info_list(i) % type))) case ('character') select case (var_info_list(i) % rank) case (0) call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, & trim(adjustl(var_info_list(i) % name)), field_0d_char, timelevel=1) if (.not. associated(field_0d_char)) then call self % model_error('Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // & '"', subname, __LINE__) end if call mpas_streamaddfield(mpas_stream, field_0d_char, ierr=ierr) nullify(field_0d_char) case (1) call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, & trim(adjustl(var_info_list(i) % name)), field_1d_char, timelevel=1) if (.not. associated(field_1d_char)) then call self % model_error('Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // & '"', subname, __LINE__) end if call mpas_streamaddfield(mpas_stream, field_1d_char, ierr=ierr) nullify(field_1d_char) case default call self % model_error('Unsupported variable rank ' // stringify([var_info_list(i) % rank]) // & ' for "' // trim(adjustl(var_info_list(i) % name)) // '"', subname, __LINE__) end select case ('integer') select case (var_info_list(i) % rank) case (0) call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, & trim(adjustl(var_info_list(i) % name)), field_0d_integer, timelevel=1) if (.not. associated(field_0d_integer)) then call self % model_error('Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // & '"', subname, __LINE__) end if call mpas_streamaddfield(mpas_stream, field_0d_integer, ierr=ierr) nullify(field_0d_integer) case (1) call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, & trim(adjustl(var_info_list(i) % name)), field_1d_integer, timelevel=1) if (.not. associated(field_1d_integer)) then call self % model_error('Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // & '"', subname, __LINE__) end if call mpas_streamaddfield(mpas_stream, field_1d_integer, ierr=ierr) nullify(field_1d_integer) case (2) call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, & trim(adjustl(var_info_list(i) % name)), field_2d_integer, timelevel=1) if (.not. associated(field_2d_integer)) then call self % model_error('Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // & '"', subname, __LINE__) end if call mpas_streamaddfield(mpas_stream, field_2d_integer, ierr=ierr) nullify(field_2d_integer) case (3) call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, & trim(adjustl(var_info_list(i) % name)), field_3d_integer, timelevel=1) if (.not. associated(field_3d_integer)) then call self % model_error('Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // & '"', subname, __LINE__) end if call mpas_streamaddfield(mpas_stream, field_3d_integer, ierr=ierr) nullify(field_3d_integer) case default call self % model_error('Unsupported variable rank ' // stringify([var_info_list(i) % rank]) // & ' for "' // trim(adjustl(var_info_list(i) % name)) // '"', subname, __LINE__) end select case ('real') select case (var_info_list(i) % rank) case (0) call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, & trim(adjustl(var_info_list(i) % name)), field_0d_real, timelevel=1) if (.not. associated(field_0d_real)) then call self % model_error('Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // & '"', subname, __LINE__) end if call mpas_streamaddfield(mpas_stream, field_0d_real, ierr=ierr) nullify(field_0d_real) case (1) call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, & trim(adjustl(var_info_list(i) % name)), field_1d_real, timelevel=1) if (.not. associated(field_1d_real)) then call self % model_error('Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // & '"', subname, __LINE__) end if call mpas_streamaddfield(mpas_stream, field_1d_real, ierr=ierr) nullify(field_1d_real) case (2) call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, & trim(adjustl(var_info_list(i) % name)), field_2d_real, timelevel=1) if (.not. associated(field_2d_real)) then call self % model_error('Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // & '"', subname, __LINE__) end if call mpas_streamaddfield(mpas_stream, field_2d_real, ierr=ierr) nullify(field_2d_real) case (3) call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, & trim(adjustl(var_info_list(i) % name)), field_3d_real, timelevel=1) if (.not. associated(field_3d_real)) then call self % model_error('Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // & '"', subname, __LINE__) end if call mpas_streamaddfield(mpas_stream, field_3d_real, ierr=ierr) nullify(field_3d_real) case (4) call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, & trim(adjustl(var_info_list(i) % name)), field_4d_real, timelevel=1) if (.not. associated(field_4d_real)) then call self % model_error('Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // & '"', subname, __LINE__) end if call mpas_streamaddfield(mpas_stream, field_4d_real, ierr=ierr) nullify(field_4d_real) case (5) call mpas_pool_get_field(self % domain_ptr % blocklist % allfields, & trim(adjustl(var_info_list(i) % name)), field_5d_real, timelevel=1) if (.not. associated(field_5d_real)) then call self % model_error('Failed to find variable "' // trim(adjustl(var_info_list(i) % name)) // & '"', subname, __LINE__) end if call mpas_streamaddfield(mpas_stream, field_5d_real, ierr=ierr) nullify(field_5d_real) case default call self % model_error('Unsupported variable rank ' // stringify([var_info_list(i) % rank]) // & ' for "' // trim(adjustl(var_info_list(i) % name)) // '"', subname, __LINE__) end select case default call self % model_error('Unsupported variable type "' // trim(adjustl(var_info_list(i) % type)) // & '" for "' // trim(adjustl(var_info_list(i) % name)) // '"', subname, __LINE__) end select if (ierr /= mpas_stream_noerr) then call self % model_error('Failed to add variable "' // trim(adjustl(var_info_list(i) % name)) // & '" to stream "' // trim(adjustl(stream_name)) // '"', subname, __LINE__) end if end do if (trim(adjustl(stream_mode)) == 'w' .or. trim(adjustl(stream_mode)) == 'write') then ! Add MPAS-specific attributes to stream. ! Attributes related to MPAS core (i.e., `core_type`). call add_stream_attribute('conventions', self % domain_ptr % core % conventions) call add_stream_attribute('core_name', self % domain_ptr % core % corename) call add_stream_attribute('git_version', self % domain_ptr % core % git_version) call add_stream_attribute('model_name', self % domain_ptr % core % modelname) call add_stream_attribute('source', self % domain_ptr % core % source) ! Attributes related to MPAS domain (i.e., `domain_type`). call add_stream_attribute('is_periodic', self % domain_ptr % is_periodic) call add_stream_attribute('mesh_spec', self % domain_ptr % mesh_spec) call add_stream_attribute('on_a_sphere', self % domain_ptr % on_a_sphere) call add_stream_attribute('parent_id', self % domain_ptr % parent_id) call add_stream_attribute('sphere_radius', self % domain_ptr % sphere_radius) call add_stream_attribute('x_period', self % domain_ptr % x_period) call add_stream_attribute('y_period', self % domain_ptr % y_period) end if call self % debug_print(log_level_debug, subname // ' completed') contains !> Helper subroutine for adding a 0-d stream attribute by calling `mpas_writestreamatt` with error checking. !> (KCW, 2024-03-14) subroutine add_stream_attribute_0d(attribute_name, attribute_value) ! Module(s) from MPAS. use mpas_io_streams, only: mpas_writestreamatt character(*), intent(in) :: attribute_name class(*), intent(in) :: attribute_value call self % debug_print(log_level_verbose, 'Adding attribute "' // trim(adjustl(attribute_name)) // & '" to stream "' // trim(adjustl(stream_name)) // '"') select type (attribute_value) type is (character(*)) call mpas_writestreamatt(mpas_stream, & trim(adjustl(attribute_name)), trim(adjustl(attribute_value)), syncval=.false., ierr=ierr) type is (integer) call mpas_writestreamatt(mpas_stream, & trim(adjustl(attribute_name)), attribute_value, syncval=.false., ierr=ierr) type is (logical) if (attribute_value) then ! Logical `.true.` becomes character string "YES". call mpas_writestreamatt(mpas_stream, & trim(adjustl(attribute_name)), 'YES', syncval=.false., ierr=ierr) else ! Logical `.false.` becomes character string "NO". call mpas_writestreamatt(mpas_stream, & trim(adjustl(attribute_name)), 'NO', syncval=.false., ierr=ierr) end if type is (real(rkind)) call mpas_writestreamatt(mpas_stream, & trim(adjustl(attribute_name)), attribute_value, syncval=.false., ierr=ierr) class default call self % model_error('Unsupported attribute type (Must be one of: character, integer, logical, real)', & subname, __LINE__) end select if (ierr /= mpas_stream_noerr) then call self % model_error('Failed to add attribute "' // trim(adjustl(attribute_name)) // & '" to stream "' // trim(adjustl(stream_name)) // '"', subname, __LINE__) end if end subroutine add_stream_attribute_0d !> Helper subroutine for adding a 1-d stream attribute by calling `mpas_writestreamatt` with error checking. !> (KCW, 2024-03-14) subroutine add_stream_attribute_1d(attribute_name, attribute_value) ! Module(s) from MPAS. use mpas_io_streams, only: mpas_writestreamatt character(*), intent(in) :: attribute_name class(*), intent(in) :: attribute_value(:) call self % debug_print(log_level_verbose, 'Adding attribute "' // trim(adjustl(attribute_name)) // & '" to stream "' // trim(adjustl(stream_name)) // '"') select type (attribute_value) type is (integer) call mpas_writestreamatt(mpas_stream, & trim(adjustl(attribute_name)), attribute_value, syncval=.false., ierr=ierr) type is (real(rkind)) call mpas_writestreamatt(mpas_stream, & trim(adjustl(attribute_name)), attribute_value, syncval=.false., ierr=ierr) class default call self % model_error('Unsupported attribute type (Must be one of: integer, real)', & subname, __LINE__) end select if (ierr /= mpas_stream_noerr) then call self % model_error('Failed to add attribute "' // trim(adjustl(attribute_name)) // & '" to stream "' // trim(adjustl(stream_name)) // '"', subname, __LINE__) end if end subroutine add_stream_attribute_1d end subroutine dyn_mpas_init_stream_with_pool