From fdfef3934560877c8b85d644f1c87ad45a010944 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 17 Apr 2025 10:47:39 -0400 Subject: [PATCH 01/10] Refactor coupler types: introduce abstract base types and add getters - Created abstract types for core coupler functionality - Refactored original coupler types to extend the new abstract types - Implemented type-bound getter functions for all coupler types --- coupler/coupler_types.F90 | 819 ++++++++++++++++++++++++++++---------- 1 file changed, 619 insertions(+), 200 deletions(-) diff --git a/coupler/coupler_types.F90 b/coupler/coupler_types.F90 index 24431197ec..da723b1aa3 100644 --- a/coupler/coupler_types.F90 +++ b/coupler/coupler_types.F90 @@ -75,300 +75,238 @@ module coupler_types_mod !! Arrays (values + field) are typically directly allocated and then 'spawn' can be used to create a new type !! from a previously allocated 'template' type - !> Coupler data for 3D values - !> @ingroup coupler_types_mod - type, public :: coupler_3d_real8_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - integer :: id_rest = 0 !< The id of this array in the restart field - logical :: may_init = .true. !< If true, there is an internal method + !> Coupler values class + type, abstract, private :: coupler_values_type + character(len=48) :: name = ' ' !< The diagnostic name for this array + character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array + character(len=128) :: units = ' ' !< The units for this array + logical :: mean = .true. !< mean + logical :: override = .false. !< override + logical :: may_init = .true. !< If true, there is an internal method !! that can be used to initialize this field !! if it can not be read from a restart file + integer :: id_diag = 0 !< The diagnostic id for this array + integer :: id_rest = 0 !< The id of this array in the restart field + contains + procedure :: get_values_name + procedure :: get_long_name + procedure :: get_units + procedure :: get_mean + procedure :: get_override + procedure :: get_may_init + procedure :: get_id_diag + procedure :: get_id_rest + end type coupler_values_type + + !> Coupler field class + type, abstract, private :: coupler_field_type + character(len=48) :: name = ' ' !< name + integer :: num_fields = 0 !< num_fields + character(len=128) :: flux_type = ' ' !< flux_type + character(len=128) :: implementation = ' ' !< implementation + logical, pointer, dimension(:) :: flag => NULL() !< flag + integer :: atm_tr_index = 0 !< atm_tr_index + character(len=128) :: ice_restart_file = ' ' !< ice_restart_file + character(len=128) :: ocean_restart_file = ' ' !< ocean_restart_file +#ifdef use_deprecated_io + type(restart_file_type), pointer :: rest_type => NULL() !< A pointer to the restart_file_type + !! That is used for this field +#endif + type(FmsNetcdfDomainFile_t), pointer :: fms2_io_rest_type => NULL() !< A pointer to the restart_file_type + !! That is used for this field + logical :: use_atm_pressure !< use_atm_pressure + logical :: use_10m_wind_speed !< use_10m_wind_speed + logical :: pass_through_ice !< pass_through_ice + real(r8_kind), pointer, dimension(:) :: param => NULL() !< param + real(r8_kind) :: mol_wt = 0.0_r8_kind !< mol_wt + contains + procedure :: get_field_name + procedure :: get_num_fields + procedure :: get_flux_type + procedure :: get_implementation + procedure :: get_flag + procedure :: get_atm_tr_index + procedure :: get_ice_restart_file + procedure :: get_ocean_restart_file + !procedure :: get_rest_type + procedure :: get_fms2_io_rest_type + procedure :: get_use_atm_pressure + procedure :: get_use_10m_wind_speed + procedure :: get_pass_through_ice + procedure :: get_param + procedure :: get_mol_wt + end type coupler_field_type + + !> Coupler bc class + type, abstract, private :: coupler_bc_type + integer :: num_bcs = 0 + logical :: set = .false. + contains + procedure :: get_num_bcs + procedure :: get_set + end type coupler_bc_type + + !> Coupler data for 3D values + !> @ingroup coupler_types_mod + type, public, extends(coupler_values_type) :: coupler_3d_real8_values_type real(r8_kind), pointer, contiguous, dimension(:,:,:) :: values => NULL() !< The pointer to the !! array of values for this field; this !! should be changed to allocatable + contains + procedure :: get_values => get_values_3d_r8 end type coupler_3d_real8_values_type !> Coupler data for 3D fields !> @ingroup coupler_types_mod - type, public :: coupler_3d_real8_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields + type, public, extends(coupler_field_type) :: coupler_3d_real8_field_type type(coupler_3d_real8_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=FMS_FILE_LEN) :: ice_restart_file = ' ' !< ice_restart_file - character(len=FMS_FILE_LEN) :: ocean_restart_file = ' ' !< ocean_restart_file -#ifdef use_deprecated_io - type(restart_file_type), pointer :: rest_type => NULL() !< A pointer to the restart_file_type - !! that is used for this field. -#endif - type(FmsNetcdfDomainFile_t), pointer :: fms2_io_rest_type => NULL() !< A pointer to the restart_file_type - !! That is used for this field - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real(r8_kind), pointer, dimension(:) :: param => NULL() !< param - real(r8_kind) :: mol_wt = 0.0_r8_kind !< mol_wt + contains + procedure :: get_field => get_field_3d_r8 end type coupler_3d_real8_field_type !> Coupler data for 3D values !> @ingroup coupler_types_mod - type, public :: coupler_3d_real4_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - integer :: id_rest = 0 !< The id of this array in the restart field - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file + type, public, extends(coupler_values_type) :: coupler_3d_real4_values_type real(r4_kind), pointer, contiguous, dimension(:,:,:) :: values => NULL() !< The pointer to the !! array of values for this field; this !! should be changed to allocatable + contains + procedure :: get_values => get_values_3d_r4 end type coupler_3d_real4_values_type !> Coupler data for 3D fields !> @ingroup coupler_types_mod - type, public :: coupler_3d_real4_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields + type, public, extends(coupler_field_type) :: coupler_3d_real4_field_type type(coupler_3d_real4_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=FMS_FILE_LEN) :: ice_restart_file = ' ' !< ice_restart_file - character(len=FMS_FILE_LEN) :: ocean_restart_file = ' ' !< ocean_restart_file -#ifdef use_deprecated_io - type(restart_file_type), pointer :: rest_type => NULL() !< A pointer to the restart_file_type - !! that is used for this field. -#endif - type(FmsNetcdfDomainFile_t), pointer :: fms2_io_rest_type => NULL() !< A pointer to the restart_file_type - !! That is used for this field - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - !> precision needs to be r8_kind since this array is retrieved from the field_manager routine - !! fm_util_get_real_array which only returns a r8_kind - !! Might be able to change to allocatable(?) to do a conversion - real(r8_kind), pointer, dimension(:) :: param => NULL() !< param - real(r8_kind) :: mol_wt = 0.0_r8_kind !< mol_wt + contains + procedure :: get_field => get_field_3d_r4 end type coupler_3d_real4_field_type !> Coupler data for 3D boundary conditions !> @ingroup coupler_types_mod - type, public :: coupler_3d_bc_type - integer :: num_bcs = 0 !< The number of boundary condition fields + type, public, extends(coupler_bc_type) :: coupler_3d_bc_type type(coupler_3d_real8_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary !! TODO above should be renamed eventually to indicate kind=8 type(coupler_3d_real4_field_type), dimension(:), pointer :: bc_r4 => NULL() !< A pointer to the array of boundary - logical :: set = .false. !< If true, this type has been initialized integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type integer :: ks, ke !< The k-direction index ranges for this type + contains + procedure :: get_bc => get_bc_3d + procedure :: get_bc_r4 => get_bc_r4_3d + procedure :: get_isd + procedure :: get_isc + procedure :: get_iec + procedure :: get_ied + procedure :: get_jsd + procedure :: get_jsc + procedure :: get_jec + procedure :: get_jed + procedure :: get_ks + procedure :: get_ke end type coupler_3d_bc_type !> Coupler data for 2D values !> @ingroup coupler_types_mod - type, public :: coupler_2d_real8_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array + type, public, extends(coupler_values_type) :: coupler_2d_real8_values_type real(r8_kind), pointer, contiguous, dimension(:,:) :: values => NULL() !< The pointer to the !! array of values for this field; this !! should be changed to allocatable - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - integer :: id_rest = 0 !< The id of this array in the restart field - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file + contains + procedure :: get_values => get_values_2d_r8 end type coupler_2d_real8_values_type !> Coupler data for 2D fields !> @ingroup coupler_types_mod - type, public :: coupler_2d_real8_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields + type, public, extends(coupler_field_type) :: coupler_2d_real8_field_type type(coupler_2d_real8_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - real(r8_kind), pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=FMS_FILE_LEN) :: ice_restart_file = ' ' !< ice_restart_file - character(len=FMS_FILE_LEN) :: ocean_restart_file = ' ' !< ocean_restart_file -#ifdef use_deprecated_io - type(restart_file_type), pointer :: rest_type => NULL() !< A pointer to the restart_file_type - !! that is used for this field. -#endif - type(FmsNetcdfDomainFile_t), pointer :: fms2_io_rest_type => NULL() !< A pointer to the restart_file_type - !! That is used for this field - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real(r8_kind) :: mol_wt = 0.0_r8_kind !< mol_wt + contains + procedure :: get_field => get_field_2d_r8 end type coupler_2d_real8_field_type !> Coupler data for 2D values !> @ingroup coupler_types_mod - type, public :: coupler_2d_real4_values_type - character(len=44) :: name = ' ' !< The diagnostic name for this array + type, public, extends(coupler_values_type) :: coupler_2d_real4_values_type real(r4_kind), pointer, contiguous, dimension(:,:) :: values => NULL() !< The pointer to the !! array of values for this field; this !! should be changed to allocatable - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=124) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=124) :: units = ' ' !< The units for this array - integer :: id_rest = 0 !< The id of this array in the restart field - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file + contains + procedure :: get_values => get_values_2d_r4 end type coupler_2d_real4_values_type !> Coupler data for 2D fields !> @ingroup coupler_types_mod - type, public :: coupler_2d_real4_field_type - character(len=44) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields + type, public, extends(coupler_field_type) :: coupler_2d_real4_field_type type(coupler_2d_real4_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=124) :: flux_type = ' ' !< flux_type - character(len=124) :: implementation = ' ' !< implementation - !> precision needs to be r8_kind since this array is retrieved from the field_manager routine - !! fm_util_get_real_array which only returns a r8_kind - !! Might be able to change to allocatable(?) to do a conversion - real(r8_kind), pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=FMS_FILE_LEN) :: ice_restart_file = ' ' !< ice_restart_file - character(len=FMS_FILE_LEN) :: ocean_restart_file = ' ' !< ocean_restart_file -#ifdef use_deprecated_io - type(restart_file_type), pointer :: rest_type => NULL() !< A pointer to the restart_file_type - !! that is used for this field. -#endif - type(FmsNetcdfDomainFile_t), pointer :: fms2_io_rest_type => NULL() !< A pointer to the restart_file_type - !! That is used for this field - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real(r8_kind) :: mol_wt = 0.0_r8_kind !< mol_wt + contains + procedure :: get_field => get_field_2d_r4 end type coupler_2d_real4_field_type !> Coupler data for 2D boundary conditions !> @ingroup coupler_types_mod - type, public :: coupler_2d_bc_type - integer :: num_bcs = 0 !< The number of boundary condition fields + type, public, extends(coupler_bc_type) :: coupler_2d_bc_type type(coupler_2d_real8_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary !! condition fields type(coupler_2d_real4_field_type), dimension(:), pointer :: bc_r4 => NULL() !< A pointer to the array of boundary !! condition fields - logical :: set = .false. !< If true, this type has been initialized integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type + contains + procedure :: get_bc => get_bc_2d + procedure :: get_bc_r4 => get_bc_r4_2d + procedure :: get_isd + procedure :: get_isc + procedure :: get_iec + procedure :: get_ied + procedure :: get_jsd + procedure :: get_jsc + procedure :: get_jec + procedure :: get_jed end type coupler_2d_bc_type !> Coupler data for 1D values !> @ingroup coupler_types_mod - type, public :: coupler_1d_real8_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array + type, public, extends(coupler_values_type) :: coupler_1d_real8_values_type real(r8_kind), pointer, dimension(:) :: values => NULL() !< The pointer to the array of values - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file + contains + procedure :: get_values => get_values_1d_r8 end type coupler_1d_real8_values_type !> Coupler data for 1D fields !> @ingroup coupler_types_mod - type, public :: coupler_1d_real8_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields + type, public, extends(coupler_field_type) :: coupler_1d_real8_field_type type(coupler_1d_real8_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - !> precision has been explicitly defined - !! to be r8_kind during mixedmode update to field_manager - !! this explicit definition can be removed during the coupler update and be made into FMS_CP_KIND_ - real(r8_kind), pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=FMS_FILE_LEN) :: ice_restart_file = ' ' !< ice_restart_file - character(len=FMS_FILE_LEN) :: ocean_restart_file = ' ' !< ocean_restart_file - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - !> precision has been explicitly defined - !! to be r8_kind during mixedmode update to field_manager - !! this explicit definition can be removed during the coupler update and be made into FMS_CP_KIND_ - real(r8_kind) :: mol_wt = 0.0_r8_kind !< mol_wt - - end type coupler_1d_real8_field_type + contains + procedure :: get_field => get_field_1d_r8 + end type coupler_1d_real8_field_type !> Coupler data for 1D values !> @ingroup coupler_types_mod - type, public :: coupler_1d_real4_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array + type, public, extends(coupler_values_type) :: coupler_1d_real4_values_type real(r4_kind), pointer, dimension(:) :: values => NULL() !< The pointer to the array of values - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file + contains + procedure :: get_values => get_values_1d_r4 end type coupler_1d_real4_values_type !> Coupler data for 1D fields !> @ingroup coupler_types_mod - type, public :: coupler_1d_real4_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields + type, public, extends(coupler_field_type) :: coupler_1d_real4_field_type type(coupler_1d_real4_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - !> precision needs to be r8_kind since this array is retrieved from the field_manager routine - !! fm_util_get_real_array which only returns a r8_kind - !! Might be able to change to allocatable(?) to do a conversion - real(r8_kind), pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=FMS_FILE_LEN) :: ice_restart_file = ' ' !< ice_restart_file - character(len=FMS_FILE_LEN) :: ocean_restart_file = ' ' !< ocean_restart_file - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - !> This is also read in r8 from the field manager, but since its not a pointer the conversion is allowed - real(r8_kind) :: mol_wt = 0.0_r8_kind !< mol_wt - + contains + procedure :: get_field => get_field_1d_r4 end type coupler_1d_real4_field_type !> Coupler data for 1D boundary conditions !> @ingroup coupler_types_mod - type, public :: coupler_1d_bc_type - integer :: num_bcs = 0 !< The number of boundary condition fields + type, public, extends(coupler_bc_type) :: coupler_1d_bc_type type(coupler_1d_real8_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary !! condition fields type(coupler_1d_real4_field_type), dimension(:), pointer :: bc_r4 => NULL() !< A pointer to the array of boundary !! condition fields - logical :: set = .false. !< If true, this type has been initialized + contains + procedure :: get_bc => get_bc_1d + procedure :: get_bc_r4 => get_bc_r4_1d end type coupler_1d_bc_type !> @addtogroup coupler_types_mod @@ -515,6 +453,487 @@ module coupler_types_mod !> @addtogroup coupler_types_mod !> @{ + function get_bc_3d(this, bc_idx) result(bc_ptr) + class(coupler_3d_bc_type), intent(in) :: this + integer, intent(in) :: bc_idx + type(coupler_3d_real8_field_type), pointer :: bc_ptr + + bc_ptr => this%bc(bc_idx) + end function get_bc_3d + + function get_bc_r4_3d(this, bc_idx) result(bc_ptr) + class(coupler_3d_bc_type), intent(in) :: this + integer, intent(in) :: bc_idx + type(coupler_3d_real4_field_type), pointer :: bc_ptr + + bc_ptr => this%bc_r4(bc_idx) + end function get_bc_r4_3d + + function get_bc_2d(this, bc_idx) result(bc_ptr) + class(coupler_2d_bc_type), intent(in) :: this + integer, intent(in) :: bc_idx + type(coupler_2d_real8_field_type), pointer :: bc_ptr + + bc_ptr => this%bc(bc_idx) + end function get_bc_2d + + function get_bc_r4_2d(this, bc_idx) result(bc_ptr) + class(coupler_2d_bc_type), intent(in) :: this + integer, intent(in) :: bc_idx + type(coupler_2d_real4_field_type), pointer :: bc_ptr + + bc_ptr => this%bc_r4(bc_idx) + end function get_bc_r4_2d + + function get_bc_1d(this, bc_idx) result(bc_ptr) + class(coupler_1d_bc_type), intent(in) :: this + integer, intent(in) :: bc_idx + type(coupler_1d_real8_field_type), pointer :: bc_ptr + + bc_ptr => this%bc(bc_idx) + end function get_bc_1d + + function get_bc_r4_1d(this, bc_idx) result(bc_ptr) + class(coupler_1d_bc_type), intent(in) :: this + integer, intent(in) :: bc_idx + type(coupler_1d_real4_field_type), pointer :: bc_ptr + + bc_ptr => this%bc_r4(bc_idx) + end function get_bc_r4_1d + + function get_isd(this) result(isd) + class(coupler_bc_type), intent(in) :: this + integer :: isd + + SELECT TYPE(this) + TYPE IS(coupler_1d_bc_type) + isd = this%isd + TYPE IS(coupler_2d_bc_type) + isd = this%isd + END SELECT + end function get_isd + + function get_isc(this) result(isc) + class(coupler_bc_type), intent(in) :: this + integer :: isc + + SELECT TYPE(this) + TYPE IS(coupler_1d_bc_type) + isc = this%isc + TYPE IS(coupler_2d_bc_type) + isc = this%isc + END SELECT + end function get_isc + + function get_ied(this) result(ied) + class(coupler_bc_type), intent(in) :: this + integer :: ied + + SELECT TYPE(this) + TYPE IS(coupler_1d_bc_type) + ied = this%ied + TYPE IS(coupler_2d_bc_type) + ied = this%ied + END SELECT + end function get_ied + + function get_iec(this) result(iec) + class(coupler_bc_type), intent(in) :: this + integer :: iec + + SELECT TYPE(this) + TYPE IS(coupler_1d_bc_type) + iec = this%iec + TYPE IS(coupler_2d_bc_type) + iec = this%iec + END SELECT + end function get_iec + + function get_jsd(this) result(jsd) + class(coupler_bc_type), intent(in) :: this + integer :: jsd + + SELECT TYPE(this) + TYPE IS(coupler_1d_bc_type) + jsd = this%jsd + TYPE IS(coupler_2d_bc_type) + jsd = this%jsd + END SELECT + end function get_jsd + + function get_jsc(this) result(jsc) + class(coupler_bc_type), intent(in) :: this + integer :: jsc + + SELECT TYPE(this) + TYPE IS(coupler_1d_bc_type) + jsc = this%jsc + TYPE IS(coupler_2d_bc_type) + jsc = this%jsc + END SELECT + end function get_jsc + + function get_jed(this) result(jed) + class(coupler_bc_type), intent(in) :: this + integer :: jed + + SELECT TYPE(this) + TYPE IS(coupler_1d_bc_type) + jed = this%jed + TYPE IS(coupler_2d_bc_type) + jed = this%jed + END SELECT + end function get_jed + + function get_jec(this) result(jec) + class(coupler_bc_type), intent(in) :: this + integer :: jec + + SELECT TYPE(this) + TYPE IS(coupler_1d_bc_type) + jec = this%jec + TYPE IS(coupler_2d_bc_type) + jec = this%jec + END SELECT + end function get_jec + + function get_ks(this) result(ks) + class(coupler_3d_bc_type), intent(in) :: this + integer :: ks + + ks = this%ks + end function get_ks + + function get_ke(this) result(ke) + class(coupler_3d_bc_type), intent(in) :: this + integer :: ke + + ke = this%ke + end function get_ke + + !> @brief Gets num_bcs for coupler_bc_type + function get_num_bcs(this) result(num_bcs) + class(coupler_bc_type), intent(in) :: this + integer :: num_bcs + + num_bcs = this%num_bcs + end function get_num_bcs + + !> @brief Gets num_bcs for coupler_bc_type + function get_set(this) result(set) + class(coupler_bc_type), intent(in) :: this + logical :: set + + set = this%set + end function get_set + + !> @brief Gets name for coupler_field_type + function get_field_name(this) result(field_name) + class(coupler_field_type), intent(in) :: this + character(len=48) :: field_name + + field_name = this%name + end function get_field_name + + !> @brief Gets num_fields for coupler_field_type + function get_num_fields(this) result(num_fields) + class(coupler_field_type), intent(in) :: this + integer :: num_fields + + num_fields = this%num_fields + end function get_num_fields + + !> @brief Gets flux_type for coupler_field_type + function get_flux_type(this) result(flux_type) + class(coupler_field_type), intent(in) :: this + character(len=128) :: flux_type + + flux_type = this%flux_type + end function get_flux_type + + !> @brief Gets implementation for coupler_field_type + function get_implementation(this) result(implementation) + class(coupler_field_type), intent(in) :: this + character(len=128) :: implementation + + implementation = this%implementation + end function get_implementation + + !> @brief Gets flag for coupler_field_type + function get_flag(this) result(flag_ptr) + class(coupler_field_type), intent(in) :: this + logical, pointer, dimension(:) :: flag_ptr + + flag_ptr => this%flag + end function get_flag + + !> @brief Gets atm_tr_index for coupler_field_type + function get_atm_tr_index(this) result(atm_tr_index) + class(coupler_field_type), intent(in) :: this + integer :: atm_tr_index + + atm_tr_index = this%atm_tr_index + end function get_atm_tr_index + + !> @brief Gets ice_restart_file for coupler_field_type + function get_ice_restart_file(this) result(ice_restart_file) + class(coupler_field_type), intent(in) :: this + character(len=128) :: ice_restart_file + + ice_restart_file = this%ice_restart_file + end function get_ice_restart_file + + !> @brief Gets ocean_restart_file for coupler_field_type + function get_ocean_restart_file(this) result(ocean_restart_file) + class(coupler_field_type), intent(in) :: this + character(len=128) :: ocean_restart_file + + ocean_restart_file = this%ocean_restart_file + end function get_ocean_restart_file + + !> @brief Gets fms2_io_rest_type for coupler_field_type + function get_fms2_io_rest_type(this) result(fms2_io_rest_type_ptr) + class(coupler_field_type), intent(in) :: this + type(FmsNetcdfDomainFile_t), pointer :: fms2_io_rest_type_ptr + + fms2_io_rest_type_ptr => this%fms2_io_rest_type + end function get_fms2_io_rest_type + + !> @brief Gets use_atm_pressure for coupler_field_type + function get_use_atm_pressure(this) result(use_atm_pressure) + class(coupler_field_type), intent(in) :: this + logical :: use_atm_pressure + + use_atm_pressure = this%use_atm_pressure + end function get_use_atm_pressure + + !> @brief Gets use_10m_wind_speed for coupler_field_type + function get_use_10m_wind_speed(this) result(use_10m_wind_speed) + class(coupler_field_type), intent(in) :: this + logical :: use_10m_wind_speed + + use_10m_wind_speed = this%use_10m_wind_speed + end function get_use_10m_wind_speed + + !> @brief Gets pass_through_ice for coupler_field_type + function get_pass_through_ice(this) result(pass_through_ice) + class(coupler_field_type), intent(in) :: this + logical :: pass_through_ice + + pass_through_ice = this%pass_through_ice + end function get_pass_through_ice + + function get_field_3d_r8(this, field_idx) result(field_ptr) + class(coupler_3d_real8_field_type), intent(in) :: this + integer, intent(in) :: field_idx + type(coupler_3d_real8_values_type), pointer :: field_ptr + + field_ptr => this%field(field_idx) + end function get_field_3d_r8 + + function get_field_3d_r4(this, field_idx) result(field_ptr) + class(coupler_3d_real4_field_type), intent(in) :: this + integer, intent(in) :: field_idx + type(coupler_3d_real4_values_type), pointer :: field_ptr + + field_ptr => this%field(field_idx) + end function get_field_3d_r4 + + function get_field_2d_r8(this, field_idx) result(field_ptr) + class(coupler_2d_real8_field_type), intent(in) :: this + integer, intent(in) :: field_idx + type(coupler_2d_real8_values_type), pointer :: field_ptr + + field_ptr => this%field(field_idx) + end function get_field_2d_r8 + + function get_field_2d_r4(this, field_idx) result(field_ptr) + class(coupler_2d_real4_field_type), intent(in) :: this + integer, intent(in) :: field_idx + type(coupler_2d_real4_values_type), pointer :: field_ptr + + field_ptr => this%field(field_idx) + end function get_field_2d_r4 + + function get_field_1d_r8(this, field_idx) result(field_ptr) + class(coupler_1d_real8_field_type), intent(in) :: this + integer, intent(in) :: field_idx + type(coupler_1d_real8_values_type), pointer :: field_ptr + + field_ptr => this%field(field_idx) + end function get_field_1d_r8 + + function get_field_1d_r4(this, field_idx) result(field_ptr) + class(coupler_1d_real4_field_type), intent(in) :: this + integer, intent(in) :: field_idx + type(coupler_1d_real4_values_type), pointer :: field_ptr + + field_ptr => this%field(field_idx) + end function get_field_1d_r4 + + !> @brief Gets param for coupler_field_type + function get_param(this) result(param_ptr) + class(coupler_field_type), intent(in) :: this + real(r8_kind), pointer, dimension(:) :: param_ptr + + param_ptr => this%param + end function get_param + + !> @brief Gets mol_wt for coupler_field_type + function get_mol_wt(this) result(mol_wt) + class(coupler_field_type), intent(in) :: this + real(r8_kind) :: mol_wt + + mol_wt = this%mol_wt + end function get_mol_wt + + !> @brief Gets name for coupler_values_type + function get_values_name(this) result(values_name) + class(coupler_values_type), intent(in) :: this + character(len=48) :: values_name + + values_name = this%name + end function get_values_name + + !> @brief Gets long_name for coupler_values_type + function get_long_name(this) result(long_name) + class(coupler_values_type), intent(in) :: this + character(len=128) :: long_name + + long_name = this%long_name + end function get_long_name + + !> @brief Gets units for coupler_values_type + function get_units(this) result(units) + class(coupler_values_type), intent(in) :: this + character(len=128) :: units + + units = this%units + end function get_units + + !> @brief Gets mean for coupler_values_type + function get_mean(this) result(mean) + class(coupler_values_type), intent(in) :: this + logical :: mean + + mean = this%mean + end function get_mean + + !> @brief Gets may_init for coupler_values_type + function get_may_init(this) result(may_init) + class(coupler_values_type), intent(in) :: this + logical :: may_init + + may_init = this%may_init + end function get_may_init + + !> @brief Gets override for coupler_values_type + function get_override(this) result(override) + class(coupler_values_type), intent(in) :: this + logical :: override + + override = this%override + end function get_override + + !> @brief Gets id_diag for coupler_values_type + function get_id_diag(this) result(id_diag) + class(coupler_values_type), intent(in) :: this + integer :: id_diag + + id_diag = this%id_diag + end function get_id_diag + + !> @brief Gets id_rest for coupler_values_type + function get_id_rest(this) result(id_rest) + class(coupler_values_type), intent(in) :: this + integer :: id_rest + + id_rest = this%id_rest + end function get_id_rest + + function get_values_3d_r8(this) result(values) + class(coupler_3d_real8_values_type), intent(in) :: this + real(r8_kind), dimension(:,:,:), allocatable :: values + + integer :: ni, nj, nk + + ni = size(this%values,1) + nj = size(this%values,2) + nk = size(this%values,3) + + allocate(values(ni,nj,nk)) + + values = this%values + end function get_values_3d_r8 + + function get_values_3d_r4(this) result(values) + class(coupler_3d_real4_values_type), intent(in) :: this + real(r4_kind), dimension(:,:,:), allocatable :: values + + integer :: ni, nj, nk + + ni = size(this%values,1) + nj = size(this%values,2) + nk = size(this%values,3) + + allocate(values(ni,nj,nk)) + + values = this%values + end function get_values_3d_r4 + + function get_values_2d_r8(this) result(values) + class(coupler_2d_real8_values_type), intent(in) :: this + real(r8_kind), dimension(:,:), allocatable :: values + + integer :: ni, nj + + ni = size(this%values,1) + nj = size(this%values,2) + + allocate(values(ni,nj)) + + values = this%values + end function get_values_2d_r8 + + function get_values_2d_r4(this) result(values) + class(coupler_2d_real4_values_type), intent(in) :: this + real(r4_kind), dimension(:,:), allocatable :: values + + integer :: ni, nj + + ni = size(this%values,1) + nj = size(this%values,2) + + allocate(values(ni,nj)) + + values = this%values + end function get_values_2d_r4 + + function get_values_1d_r8(this) result(values) + class(coupler_1d_real8_values_type), intent(in) :: this + real(r8_kind), dimension(:), allocatable :: values + + integer :: ni + + ni = size(this%values,1) + + allocate(values(ni)) + + values = this%values + end function get_values_1d_r8 + + function get_values_1d_r4(this) result(values) + class(coupler_1d_real4_values_type), intent(in) :: this + real(r4_kind), dimension(:), allocatable :: values + + integer :: ni + + ni = size(this%values,1) + + allocate(values(ni)) + + values = this%values + end function get_values_1d_r4 !> @brief Initialize the coupler types subroutine coupler_types_init From c13bd195adda43ad52b48c68352ad19f79bd2e7c Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 17 Apr 2025 10:51:04 -0400 Subject: [PATCH 02/10] Add getter functions for public drifter types - Implemented type-bound getter methods for all public drifter types - No changes to type hierarchy; existing types remain unchanged --- drifters/drifters.F90 | 295 +++++++++++++++++++++++++++++++++++- drifters/drifters_comm.F90 | 218 ++++++++++++++++++++++++++ drifters/drifters_core.F90 | 60 ++++++++ drifters/drifters_input.F90 | 106 +++++++++++++ drifters/drifters_io.F90 | 91 +++++++++++ 5 files changed, 766 insertions(+), 4 deletions(-) diff --git a/drifters/drifters.F90 b/drifters/drifters.F90 index 4f5110cbdd..3fdd0f5f2c 100644 --- a/drifters/drifters.F90 +++ b/drifters/drifters.F90 @@ -114,10 +114,10 @@ module drifters_mod type drifters_type ! Be sure to update drifters_new, drifters_del and drifters_copy_new ! when adding members - type(drifters_core_type) :: core - type(drifters_input_type) :: input - type(drifters_io_type) :: io - type(drifters_comm_type) :: comm + type(drifters_core_type), target :: core + type(drifters_input_type), target :: input + type(drifters_io_type), target :: io + type(drifters_comm_type), target :: comm real :: dt !< total dt, over a complete step real :: time ! fields @@ -151,6 +151,35 @@ module drifters_mod logical :: rk4_completed !< Runge Kutta stuff integer :: nx, ny logical, allocatable :: remove(:) + contains + procedure :: get_core + procedure :: get_input + procedure :: get_io + procedure :: get_comm + procedure :: get_dt + procedure :: get_time + procedure :: get_fields + procedure :: get_xu + procedure :: get_yu + procedure :: get_zu + procedure :: get_xv + procedure :: get_yv + procedure :: get_zv + procedure :: get_xw + procedure :: get_yw + procedure :: get_zw + procedure :: get_temp_pos + procedure :: get_rk4_k1 + procedure :: get_rk4_k2 + procedure :: get_rk4_k3 + procedure :: get_rk4_k4 + procedure :: get_input_file + procedure :: get_output_file + procedure :: get_rk4_step + procedure :: get_rk4_completed + procedure :: get_nx + procedure :: get_ny + procedure :: get_remove end type drifters_type !> @brief Assignment override for @ref drifters_type @@ -184,6 +213,264 @@ module drifters_mod contains + function get_core(this) result(core_ptr) + class(drifters_type) :: this + type(drifters_core_type), target :: core_ptr + + core_ptr => this%core + + end function get_core + + function get_input(this) result(input_ptr) + class(drifters_type) :: this + type(drifters_input_type), target :: input_ptr + + input_ptr => this%input + + end function get_input + + function get_io(this) result(io_ptr) + class(drifters_type) :: this + type(drifters_io_type), target :: io_ptr + + io_ptr => this%io + + end function get_io + + function get_comm(this) result(comm_ptr) + class(drifters_type) :: this + type(drifters_comm_type), target :: comm_ptr + + comm_ptr => this%comm + + end function get_comm + + function get_dt(this) result(dt) + class(drifters_type) :: this + real :: dt + + dt = this%dt + + end function get_dt + + function get_time(this) result(time) + class(drifters_type) :: this + real :: time + + time = this%time + + end function get_time + + function get_fields(this) result(fields) + class(drifters_type) :: this + real, allocatable :: fields(:,:) + + if (allocated(this%fields)) then + fields = this%fields + endif + + end function get_fields + + function get_xu(this) result(xu) + class(drifters_type) :: this + real, allocatable :: xu(:) + + if (allocated(this%xu)) then + xu = this%xu + endif + + end function get_xu + + function get_yu(this) result(yu) + class(drifters_type) :: this + real, allocatable :: yu(:) + + if (allocated(this%yu)) then + yu = this%yu + endif + + end function get_yu + + function get_zu(this) result(zu) + class(drifters_type) :: this + real, allocatable :: zu(:) + + if (allocated(this%zu)) then + zu = this%zu + endif + + end function get_zu + + function get_xv(this) result(xv) + class(drifters_type) :: this + real, allocatable :: xv(:) + + if (allocated(this%xv)) then + xv = this%xv + endif + + end function get_xv + + function get_yv(this) result(yv) + class(drifters_type) :: this + real, allocatable :: yv(:) + + if (allocated(this%yv)) then + yv = this%yv + endif + + end function get_yv + + function get_zv(this) result(zv) + class(drifters_type) :: this + real, allocatable :: zv(:) + + if (allocated(this%zv)) then + zv = this%zv + endif + + end function get_zv + + function get_xw(this) result(xw) + class(drifters_type) :: this + real, allocatable :: xw(:) + + if (allocated(this%xw)) then + xw = this%xw + endif + + end function get_xw + + function get_yw(this) result(yw) + class(drifters_type) :: this + real, allocatable :: yw(:) + + if (allocated(this%yw)) then + yw = this%yw + endif + + end function get_yw + + function get_zw(this) result(zw) + class(drifters_type) :: this + real, allocatable :: zw(:) + + if (allocated(this%zw)) then + zw = this%zw + endif + + end function get_zw + + function get_temp_pos(this) result(temp_pos) + class(drifters_type) :: this + real, allocatable :: temp_pos(:,:) + + if (allocated(this%temp_pos)) then + temp_pos = this%temp_pos + endif + + end function get_temp_pos + + function get_rk4_k1(this) result(rk4_k1) + class(drifters_type) :: this + real, allocatable :: rk4_k1(:,:) + + if (allocated(this%rk4_k1)) then + rk4_k1 = this%rk4_k1 + endif + + end function get_rk4_k1 + + function get_rk4_k2(this) result(rk4_k2) + class(drifters_type) :: this + real, allocatable :: rk4_k2(:,:) + + if (allocated(this%rk4_k2)) then + rk4_k2 = this%rk4_k2 + endif + + end function get_rk4_k2 + + function get_rk4_k2(this) result(rk4_k2) + class(drifters_type) :: this + real, allocatable :: rk4_k2(:,:) + + if (allocated(this%rk4_k2)) then + rk4_k2 = this%rk4_k2 + endif + + end function get_rk4_k3 + + function get_rk4_k4(this) result(rk4_k4) + class(drifters_type) :: this + real, allocatable :: rk4_k4(:,:) + + if (allocated(this%rk4_k4)) then + rk4_k4 = this%rk4_k4 + endif + + end function get_rk4_k4 + + function get_input_file(this) result(input_file) + class(drifters_type) :: this + character(len=FMS_PATH_LEN) :: input_file + + if (allocated(this%input_file)) then + input_file = this%input_file + endif + + end function get_input_file + + function get_output_file(this) result(output_file) + class(drifters_type) :: this + character(len=FMS_PATH_LEN) :: output_file + + if (allocated(this%output_file)) then + output_file = this%output_file + endif + + end function get_output_file + + function get_rk4_step(this) result(rk4_step) + class(drifters_type) :: this + integer :: rk4_step + + rk4_step = this%rk4_step + + end function get_rk4_step + + function get_rk4_completed(this) result(rk4_completed) + class(drifters_type) :: this + logical :: rk4_completed + + rk4_completed = this%rk4_completed + + end function get_rk4_completed + + function get_nx(this) result(nx) + class(drifters_type) :: this + integer :: nx + + nx = this%nx + + end function get_nx + + function get_ny(this) result(ny) + class(drifters_type) :: this + integer :: ny + + ny = this%ny + + end function get_ny + + function get_remove(this) result(remove) + class(drifters_type) :: this + logical, allocatable :: remove(:) + + remove = this%remove + + end function get_remove + !> @brief Will read positions stored in the netCDF file input_file. !! !> The trajectories will be saved in files output_file.PE, diff --git a/drifters/drifters_comm.F90 b/drifters/drifters_comm.F90 index b5a40e82e3..e7f95f3af2 100644 --- a/drifters/drifters_comm.F90 +++ b/drifters/drifters_comm.F90 @@ -82,6 +82,31 @@ module drifters_comm_mod integer :: pe_NW !< neighbor domains integer :: pe_beg !< starting/ending pe, set this to a value /= 0 if running concurrently integer :: pe_end !< starting/ending pe, set this to a value /= 0 if running concurrently + contains + procedure :: get_xcmin + procedure :: get_xcmax + procedure :: get_ycmin + procedure :: get_ycmax + procedure :: get_xdmin + procedure :: get_xdmax + procedure :: get_ydmin + procedure :: get_ydmax + procedure :: get_xgmin + procedure :: get_xgmax + procedure :: get_ygmin + procedure :: get_ygmax + procedure :: get_xperiodic + procedure :: get_yperiodic + procedure :: get_pe_N + procedure :: get_pe_S + procedure :: get_pe_E + procedure :: get_pe_W + procedure :: get_pe_NE + procedure :: get_pe_SE + procedure :: get_pe_SW + procedure :: get_pe_NW + procedure :: get_pe_beg + procedure :: get_pe_end end type drifters_comm_type contains @@ -89,6 +114,199 @@ module drifters_comm_mod !> @addtogroup drifters_comm_mod !> @{ !=============================================================================== + + function get_xcmin(this) result(xcmin) + class(drifters_comm_type) :: this + real :: xcmin + + xcmin = this%xcmin + + end function get_xcmin + + function get_xcmax(this) result(xcmax) + class(drifters_comm_type) :: this + real :: xcmax + + xcmax = this%xcmax + + end function get_xcmax + + function get_ycmin(this) result(ycmin) + class(drifters_comm_type) :: this + real :: ycmin + + ycmin = this%ycmin + + end function get_ycmin + + function get_ycmax(this) result(ycmax) + class(drifters_comm_type) :: this + real :: ycmax + + ycmax = this%ycmax + + end function get_ycmax + + function get_xdmin(this) result(xdmin) + class(drifters_comm_type) :: this + real :: xdmin + + xdmin = this%xdmin + + end function get_xdmin + + function get_xdmax(this) result(xdmax) + class(drifters_comm_type) :: this + real :: xdmax + + xdmax = this%xdmax + + end function get_xdmax + + function get_ydmin(this) result(ydmin) + class(drifters_comm_type) :: this + real :: ydmin + + ydmin = this%ydmin + + end function get_ydmin + + function get_ydmax(this) result(ydmax) + class(drifters_comm_type) :: this + real :: ydmax + + ydmax = this%ydmax + + end function get_ydmax + + function get_xgmin(this) result(xgmin) + class(drifters_comm_type) :: this + real :: xgmin + + xgmin = this%xgmin + + end function get_xgmin + + function get_xgmax(this) result(xgmax) + class(drifters_comm_type) :: this + real :: xgmax + + xgmax = this%xgmax + + end function get_xgmax + + function get_ygmin(this) result(ygmin) + class(drifters_comm_type) :: this + real :: ygmin + + ygmin = this%ygmin + + end function get_ygmin + + function get_ygmax(this) result(ygmax) + class(drifters_comm_type) :: this + real :: ygmax + + ygmax = this%ygmax + + end function get_ygmax + + function get_xperiodic(this) result(xperiodic) + class(drifters_comm_type) :: this + logical :: xperiodic + + xperiodic = this%xperiodic + + end function get_xperiodic + + function get_yperiodic(this) result(yperiodic) + class(drifters_comm_type) :: this + logical :: yperiodic + + yperiodic = this%yperiodic + + end function get_yperiodic + + function get_pe_N(this) result(pe_N) + class(drifters_comm_type) :: this + integer :: pe_N + + pe_N = this%pe_N + + end function get_pe_N + + function get_pe_S(this) result(pe_S) + class(drifters_comm_type) :: this + integer :: pe_S + + pe_S = this%pe_S + + end function get_pe_S + + function get_pe_E(this) result(pe_E) + class(drifters_comm_type) :: this + integer :: pe_E + + pe_E = this%pe_E + + end function get_pe_E + + function get_pe_W(this) result(pe_W) + class(drifters_comm_type) :: this + integer :: pe_W + + pe_W = this%pe_W + + end function get_pe_W + + function get_pe_NE(this) result(pe_NE) + class(drifters_comm_type) :: this + integer :: pe_NE + + pe_NE = this%pe_NE + + end function get_pe_NE + + function get_pe_SE(this) result(pe_SE) + class(drifters_comm_type) :: this + integer :: pe_SE + + pe_SE = this%pe_SE + + end function get_pe_SE + + function get_pe_SW(this) result(pe_SW) + class(drifters_comm_type) :: this + integer :: pe_SW + + pe_SW = this%pe_SW + + end function get_pe_SW + + function get_pe_NW(this) result(pe_NW) + class(drifters_comm_type) :: this + integer :: pe_NW + + pe_NW = this%pe_NW + + end function get_pe_NW + + function get_pe_beg(this) result(pe_beg) + class(drifters_comm_type) :: this + integer :: pe_beg + + pe_beg = this%pe_beg + + end function get_pe_beg + + function get_pe_end(this) result(pe_end) + class(drifters_comm_type) :: this + integer :: pe_end + + pe_end = this%pe_end + + end function get_pe_end + !> @brief Initializes default values for @ref drifters_comm_type in self subroutine drifters_comm_new(self) type(drifters_comm_type) :: self !< A new @ref drifters_comm_type diff --git a/drifters/drifters_core.F90 b/drifters/drifters_core.F90 index 8d35d05cf4..1c320cb5aa 100644 --- a/drifters/drifters_core.F90 +++ b/drifters/drifters_core.F90 @@ -46,6 +46,13 @@ module drifters_core_mod integer :: npdim !< max number of particles (drifters) integer, allocatable :: ids(:) !< particle id number real , allocatable :: positions(:,:) + contains + procedure :: get_it + procedure :: get_nd + procedure :: get_np + procedure :: get_npdim + procedure :: get_ids + procedure :: get_positions end type drifters_core_type !> @brief Assignment override for @ref drifters_core_type @@ -59,6 +66,59 @@ module drifters_core_mod !> @addtogroup drifters_core_mod !> @{ !############################################################################### + + function get_it(this) result(it) + class(drifters_core_type) :: this + integer(kind=i8_kind) :: it + + it = this%it + + end function get_it + + function get_nd(this) result(nd) + class(drifters_core_type) :: this + integer :: nd + + nd = this%nd + + end function get_nd + + function get_np(this) result(np) + class(drifters_core_type) :: this + integer :: np + + np = this%np + + end function get_np + + function get_npdim(this) result(npdim) + class(drifters_core_type) :: this + integer :: npdim + + npdim = this%npdim + + end function get_npdim + + function get_ids(this) result(ids) + class(drifters_core_type) :: this + integer, allocatable :: ids(:) + + if (allocated(this%ids)) then + ids = this%ids + endif + + end function get_ids + + function get_positions(this) result(positions) + class(drifters_core_type) :: this + real, allocatable :: positions(:,:) + + if (allocated(this%positions)) then + positions = this%positions + endif + + end function get_positions + !> Create a new @ref drifters_core_type subroutine drifters_core_new(self, nd, npdim, ermesg) type(drifters_core_type) :: self !< @ref drifters_core_type to create diff --git a/drifters/drifters_input.F90 b/drifters/drifters_input.F90 index 157d12b215..711b66276d 100644 --- a/drifters/drifters_input.F90 +++ b/drifters/drifters_input.F90 @@ -54,6 +54,17 @@ module drifters_input_mod character(len=MAX_STR_LEN) :: time_units character(len=MAX_STR_LEN) :: title character(len=MAX_STR_LEN) :: version + contains + procedure :: get_position_names + procedure :: get_position_units + procedure :: get_field_names + procedure :: get_field_units + procedure :: get_velocity_names + procedure :: get_positions + procedure :: get_ids + procedure :: get_time_units + procedure :: get_title + procedure :: get_version end type drifters_input_type !> @brief Assignment override for @ref drifters_input_type @@ -69,6 +80,101 @@ module drifters_input_mod !=============================================================================== + function get_position_names(this) result(position_names) + class(drifters_input_type) :: this + character(len=MAX_STR_LEN), allocatable :: position_names(:) + + if (allocated(this%position_names)) then + position_names = this%position_names + endif + + + end function get_position_names + + function get_position_units(this) result(position_units) + class(drifters_input_type) :: this + character(len=MAX_STR_LEN), allocatable :: position_units(:) + + if (allocated(this%position_units)) then + position_units = this%position_units + endif + + end function get_position_units + + function get_field_names(this) result(field_names) + class(drifters_input_type) :: this + character(len=MAX_STR_LEN), allocatable :: field_names(:) + + if (allocated(this%field_names)) then + field_names = this%field_names + endif + + end function get_field_names + + function get_field_units(this) result(field_units) + class(drifters_input_type) :: this + character(len=MAX_STR_LEN), allocatable :: field_units(:) + + if (allocated(this%field_units)) then + field_units = this%field_units + endif + + end function get_field_units + + function get_velocity_names(this) result(velocity_names) + class(drifters_input_type) :: this + character(len=MAX_STR_LEN), allocatable :: velocity_names(:) + + if (allocated(this%velocity_names)) then + velocity_names = this%velocity_names + endif + + end function get_velocity_names + + function get_positions(this) result(positions) + class(drifters_input_type) :: this + real, allocatable :: positions(:,:) + + if (allocated(this%positions)) then + positions = this%positions + endif + + end function get_positions + + function get_ids(this) result(ids) + class(drifters_input_type) :: this + integer, allocatable :: ids(:) + + if (allocated(this%ids)) then + ids = this%ids + endif + + end function get_ids + + function get_time_units(this) result(time_units) + class(drifters_input_type) :: this + character(len=MAX_STR_LEN) :: time_units + + time_units = this%time_units + + end function get_time_units + + function get_title(this) result(title) + class(drifters_input_type) :: this + character(len=MAX_STR_LEN) :: title + + title = this%title + + end function get_title + + function get_version(this) result(version) + class(drifters_input_type) :: this + character(len=MAX_STR_LEN) :: version + + version = this%version + + end function get_version + subroutine drifters_input_new(self, filename, ermesg) use netcdf use netcdf_nf_data diff --git a/drifters/drifters_io.F90 b/drifters/drifters_io.F90 index e9754f4487..8a6e1cd9e8 100644 --- a/drifters/drifters_io.F90 +++ b/drifters/drifters_io.F90 @@ -54,12 +54,103 @@ module drifters_io_mod integer :: ncid integer :: nc_positions, nc_fields, nc_ids, nc_time, nc_index_time logical :: enddef + contains + procedure :: get_time + procedure :: get_it + procedure :: get_it_id + procedure :: get_ncid + procedure :: get_nc_positions + procedure :: get_nc_fields + procedure :: get_nc_ids + procedure :: get_nc_time + procedure :: get_nc_index_time + procedure :: get_enddef end type drifters_io_type !> @addtogroup drifters_io_mod !> @{ contains !############################################################################### + function get_time(this) result(time) + class(drifters_io_type) :: this + real :: time + + time = this%time + + end function get_time + + function get_it(this) result(it) + class(drifters_io_type) :: this + integer :: it + + it = this%it + + end function get_it + + function get_it_id(this) result(it_id) + class(drifters_io_type) :: this + integer :: it_id + + it_id = this%it_id + + end function get_it_id + + function get_ncid(this) result(ncid) + class(drifters_io_type) :: this + integer :: ncid + + ncid = this%ncid + + end function get_ncid + + function get_nc_positions(this) result(nc_positions) + class(drifters_io_type) :: this + integer :: nc_positions + + nc_positions = this%nc_positions + + end function get_nc_positions + + function get_nc_fields(this) result(nc_fields) + class(drifters_io_type) :: this + integer :: nc_fields + + nc_fields = this%nc_fields + + end function get_nc_fields + + function get_nc_ids(this) result(nc_ids) + class(drifters_io_type) :: this + integer :: nc_ids + + nc_ids = this%nc_ids + + end function get_nc_ids + + function get_nc_time(this) result(nc_time) + class(drifters_io_type) :: this + integer :: nc_time + + nc_time = this%nc_time + + end function get_nc_time + + function get_nc_index_time(this) result(nc_index_time) + class(drifters_io_type) :: this + integer :: nc_index_time + + nc_index_time = this%nc_index_time + + end function get_nc_index_time + + function get_nc_enddef(this) result(nc_enddef) + class(drifters_io_type) :: this + logical :: nc_enddef + + nc_enddef = this%nc_enddef + + end function get_nc_enddef + subroutine drifters_io_new(self, filename, nd, nf, ermesg) type(drifters_io_type) :: self character(len=*), intent(in) :: filename From 5ef6ae7179fdaa531d2dbd1067d67dbafdb815c0 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 17 Apr 2025 10:52:46 -0400 Subject: [PATCH 03/10] Add getter functions for public horiz_interp types - Implemented type-bound getter methods for all public horiz_interp types - No changes to type hierarchy; existing types remain unchanged --- horiz_interp/horiz_interp_type.F90 | 529 ++++++++++++++++++++++++++++- 1 file changed, 527 insertions(+), 2 deletions(-) diff --git a/horiz_interp/horiz_interp_type.F90 b/horiz_interp/horiz_interp_type.F90 index a2bc90a821..62c05b21bd 100644 --- a/horiz_interp/horiz_interp_type.F90 +++ b/horiz_interp/horiz_interp_type.F90 @@ -82,6 +82,22 @@ module horiz_interp_type_mod real(kind=r8_kind), dimension(:,:), allocatable :: mask_in real(kind=r8_kind) :: max_src_dist logical :: is_allocated = .false. !< set to true upon field allocation + contains + procedure :: get_faci => get_faci_r8 + procedure :: get_facj => get_facj_r8 + procedure :: get_area_src => get_area_src_r8 + procedure :: get_area_dst => get_area_dst_r8 + procedure :: get_wti => get_wti_r8 + procedure :: get_wtj => get_wtj_r8 + procedure :: get_src_dist => get_src_dist_r8 + procedure :: get_rat_x => get_rat_x_r8 + procedure :: get_rat_y => get_rat_y_r8 + procedure :: get_lon_in => get_lon_in_r8 + procedure :: get_lat_in => get_lat_in_r8 + procedure :: get_area_frac_dst => get_area_frac_dst_r8 + procedure :: get_mask_in => get_mask_in_r8 + procedure :: get_max_src_dist => get_max_src_dist_r8 + procedure :: get_is_allocated => get_is_allocated_r8 end type horizInterpReals8_type @@ -109,6 +125,22 @@ module horiz_interp_type_mod real(kind=r4_kind), dimension(:,:), allocatable :: mask_in real(kind=r4_kind) :: max_src_dist logical :: is_allocated = .false. !< set to true upon field allocation + contains + procedure :: get_faci => get_faci_r4 + procedure :: get_facj => get_facj_r4 + procedure :: get_area_src => get_area_src_r4 + procedure :: get_area_dst => get_area_dst_r4 + procedure :: get_wti => get_wti_r4 + procedure :: get_wtj => get_wtj_r4 + procedure :: get_src_dist => get_src_dist_r4 + procedure :: get_rat_x => get_rat_x_r4 + procedure :: get_rat_y => get_rat_y_r4 + procedure :: get_lon_in => get_lon_in_r4 + procedure :: get_lat_in => get_lat_in_r4 + procedure :: get_area_frac_dst => get_area_frac_dst_r4 + procedure :: get_mask_in => get_mask_in_r4 + procedure :: get_max_src_dist => get_max_src_dist_r4 + procedure :: get_is_allocated => get_is_allocated_r4 end type horizInterpReals4_type @@ -144,10 +176,31 @@ module horiz_interp_type_mod integer, dimension(:), allocatable :: j_src !< indices in source grid. integer, dimension(:), allocatable :: i_dst !< indices in destination grid. integer, dimension(:), allocatable :: j_dst !< indices in destination grid. - type(horizInterpReals8_type) :: horizInterpReals8_type !< derived type holding kind 8 real data pointers + type(horizInterpReals8_type) :: horizInterpReals8_type !< derived type holding kind 8 real data pointers !! if compiled with r8_kind - type(horizInterpReals4_type) :: horizInterpReals4_type !< derived type holding kind 4 real data pointers + type(horizInterpReals4_type) :: horizInterpReals4_type !< derived type holding kind 4 real data pointers !! if compiled with r8_kind + contains + procedure :: get_ilon + procedure :: get_jlat + procedure :: get_i_lon + procedure :: get_j_lat + procedure :: get_found_neighbors + procedure :: get_num_found + procedure :: get_nlon_src + procedure :: get_nlat_src + procedure :: get_nlon_dst + procedure :: get_nlat_dst + procedure :: get_interp_method + procedure :: get_I_am_initialized + procedure :: get_version + procedure :: get_nxgrid + procedure :: get_i_src + procedure :: get_j_src + procedure :: get_i_dst + procedure :: get_j_dst + procedure :: get_horizInterpReals8_type + procedure :: get_horizInterpReals4_type end type !> @addtogroup horiz_interp_type_mod @@ -155,6 +208,478 @@ module horiz_interp_type_mod contains !###################################################################################################################### + function get_faci_r8(this) result(faci) + class(horizInterpReals8_type) :: this + real(kind=r8_kind), dimension(:,:), allocatable :: faci + + if (allocated(this%faci)) then + faci = this%faci + endif + + end function get_faci_r8 + + function get_faci_r4(this) result(faci) + class(horizInterpReals4_type) :: this + real(kind=r4_kind), dimension(:,:), allocatable :: faci + + if (allocated(this%faci)) then + faci = this%faci + endif + + end function get_faci_r4 + + function get_facj_r8(this) result(facj) + class(horizInterpReals8_type) :: this + real(kind=r8_kind), dimension(:,:), allocatable :: facj + + if (allocated(this%facj)) then + facj = this%facj + endif + + end function get_facj_r8 + + function get_facj_r4(this) result(facj) + class(horizInterpReals4_type) :: this + real(kind=r4_kind), dimension(:,:), allocatable :: facj + + if (allocated(this%facj)) then + facj = this%facj + endif + + end function get_facj_r4 + + function get_area_src_r8(this) result(area_src) + class(horizInterpReals8_type) :: this + real(kind=r8_kind), dimension(:,:), allocatable :: area_src + + if (allocated(this%area_src)) then + area_src = this%area_src + endif + + end function get_area_src_r8 + + function get_area_src_r4(this) result(area_src) + class(horizInterpReals4_type) :: this + real(kind=r4_kind), dimension(:,:), allocatable :: area_src + + if (allocated(this%area_src)) then + area_src = this%area_src + endif + + end function get_area_src_r4 + + function get_area_dst_r8(this) result(area_dst) + class(horizInterpReals8_type) :: this + real(kind=r8_kind), dimension(:,:), allocatable :: area_dst + + if (allocated(this%area_dst)) then + area_dst = this%area_dst + endif + + end function get_area_dst_r8 + + function get_area_dst_r4(this) result(area_dst) + class(horizInterpReals4_type) :: this + real(kind=r4_kind), dimension(:,:), allocatable :: area_dst + + if (allocated(this%area_dst)) then + area_dst = this%area_dst + endif + + end function get_area_dst_r4 + + function get_wti_r8(this) result(wti) + class(horizInterpReals8_type) :: this + real(kind=r8_kind), dimension(:,:,:), allocatable :: wti + + if (allocated(this%wti)) then + wti = this%wti + endif + + end function get_wti_r8 + + function get_wti_r4(this) result(wti) + class(horizInterpReals4_type) :: this + real(kind=r4_kind), dimension(:,:,:), allocatable :: wti + + if (allocated(this%wti)) then + wti = this%wti + endif + + end function get_wti_r4 + + function get_wtj_r8(this) result(wtj) + class(horizInterpReals8_type) :: this + real(kind=r8_kind), dimension(:,:,:), allocatable :: wtj + + if (allocated(this%wtj)) then + wtj = this%wtj + endif + + end function get_wtj_r8 + + function get_wtj_r4(this) result(wtj) + class(horizInterpReals4_type) :: this + real(kind=r4_kind), dimension(:,:,:), allocatable :: wtj + + if (allocated(this%wtj)) then + wtj = this%wtj + endif + + end function get_wtj_r4 + + function get_src_dist_r8(this) result(src_dist) + class(horizInterpReals8_type) :: this + real(kind=r8_kind), dimension(:,:,:), allocatable :: src_dist + + if (allocated(this%src_dist)) then + src_dist = this%src_dist + endif + + end function get_src_dist_r8 + + function get_src_dist_r4(this) result(src_dist) + class(horizInterpReals4_type) :: this + real(kind=r4_kind), dimension(:,:,:), allocatable :: src_dist + + if (allocated(this%src_dist)) then + src_dist = this%src_dist + endif + + end function get_src_dist_r4 + + function get_rat_x_r8(this) result(rat_x) + class(horizInterpReals8_type) :: this + real(kind=r8_kind), dimension(:,:), allocatable :: rat_x + + if (allocated(this%rat_x)) then + rat_x = this%rat_x + endif + + end function get_rat_x_r8 + + function get_rat_x_r4(this) result(rat_x) + class(horizInterpReals4_type) :: this + real(kind=r4_kind), dimension(:,:), allocatable :: rat_x + + if (allocated(this%rat_x)) then + rat_x = this%rat_x + endif + + end function get_rat_x_r4 + + function get_rat_y_r8(this) result(rat_y) + class(horizInterpReals8_type) :: this + real(kind=r8_kind), dimension(:,:), allocatable :: rat_y + + if (allocated(this%rat_y)) then + rat_y = this%rat_y + endif + + end function get_rat_y_r8 + + function get_rat_y_r4(this) result(rat_y) + class(horizInterpReals4_type) :: this + real(kind=r4_kind), dimension(:,:), allocatable :: rat_y + + if (allocated(this%rat_y)) then + rat_y = this%rat_y + endif + + end function get_rat_y_r4 + + function get_lon_in_r8(this) result(lon_in) + class(horizInterpReals8_type) :: this + real(kind=r8_kind), dimension(:), allocatable :: lon_in + + if (allocated(this%lon_in)) then + lon_in = this%lon_in + endif + + end function get_lon_in_r8 + + function get_lon_in_r4(this) result(lon_in) + class(horizInterpReals4_type) :: this + real(kind=r4_kind), dimension(:), allocatable :: lon_in + + if (allocated(this%lon_in)) then + lon_in = this%lon_in + endif + + end function get_lon_in_r4 + + function get_lat_in_r8(this) result(lat_in) + class(horizInterpReals8_type) :: this + real(kind=r8_kind), dimension(:), allocatable :: lat_in + + if (allocated(this%lat_in)) then + lat_in = this%lat_in + endif + + end function get_lat_in_r8 + + function get_lat_in_r4(this) result(lat_in) + class(horizInterpReals4_type) :: this + real(kind=r4_kind), dimension(:), allocatable :: lat_in + + if (allocated(this%lat_in)) then + lat_in = this%lat_in + endif + + end function get_lat_in_r4 + + function get_area_frac_dst_r8(this) result(area_frac_dst) + class(horizInterpReals8_type) :: this + real(kind=r8_kind), dimension(:), allocatable :: area_frac_dst + + if (allocated(this%area_frac_dst)) then + area_frac_dst = this%area_frac_dst + endif + + end function get_area_frac_dst_r8 + + function get_area_frac_dst_r4(this) result(area_frac_dst) + class(horizInterpReals4_type) :: this + real(kind=r4_kind), dimension(:), allocatable :: area_frac_dst + + if (allocated(this%area_frac_dst)) then + area_frac_dst = this%area_frac_dst + endif + + end function get_area_frac_dst_r4 + + function get_mask_in_r8(this) result(mask_in) + class(horizInterpReals8_type) :: this + real(kind=r8_kind), dimension(:,:), allocatable :: mask_in + + if (allocated(this%mask_in)) then + mask_in = this%mask_in + endif + + end function get_mask_in_r8 + + function get_mask_in_r4(this) result(mask_in) + class(horizInterpReals4_type) :: this + real(kind=r4_kind), dimension(:,:), allocatable :: mask_in + + if (allocated(this%mask_in)) then + mask_in = this%mask_in + endif + + end function get_mask_in_r4 + + function get_max_src_dist_r8(this) result(max_src_dist) + class(horizInterpReals8_type) :: this + real(kind=r8_kind) :: max_src_dist + + max_src_dist = this%max_src_dist + + end function get_max_src_dist_r8 + + function get_max_src_dist_r4(this) result(max_src_dist) + class(horizInterpReals4_type) :: this + real(kind=r4_kind) :: max_src_dist + + max_src_dist = this%max_src_dist + + end function get_max_src_dist_r4 + + function get_is_allocated_r8(this) result(is_allocated) + class(horizInterpReals8_type) :: this + logical :: is_allocated + + is_allocated = this%is_allocated + + end function get_is_allocated_r8 + + function get_is_allocated_r4(this) result(is_allocated) + class(horizInterpReals4_type) :: this + logical :: is_allocated + + is_allocated = this%is_allocated + + end function get_is_allocated_r4 + + function get_ilon(this) result(ilon) + class(horiz_interp_type) :: this + integer, dimension(:,:), allocatable :: ilon + + if (allocated(this%ilon)) then + ilon = this%ilon + endif + + end function get_ilon + + function get_jlat(this) result(jlat) + class(horiz_interp_type) :: this + integer, dimension(:,:), allocatable :: jlat + + if (allocated(this%jlat)) then + jlat = this%jlat + endif + + end function get_jlat + + function get_i_lon(this) result(i_lon) + class(horiz_interp_type) :: this + integer, dimension(:,:,:), allocatable :: i_lon + + if (allocated(this%i_lon)) then + i_lon = this%i_lon + endif + + end function get_i_lon + + function get_j_lat(this) result(j_lat) + class(horiz_interp_type) :: this + integer, dimension(:,:,:), allocatable :: j_lat + + if (allocated(this%j_lat)) then + j_lat = this%j_lat + endif + + end function get_j_lat + + function get_found_neighbors(this) result(found_neighbors) + class(horiz_interp_type) :: this + logical, dimension(:,:), allocatable :: found_neighbors + + if (allocated(this%found_neighbors)) then + found_neighbors = this%found_neighbors + endif + + end function get_found_neighbors + + function get_num_found(this) result(num_found) + class(horiz_interp_type) :: this + integer, dimension(:,:), allocatable :: num_found + + if (allocated(this%num_found)) then + num_found = this%num_found + endif + + end function get_num_found + + function get_nlon_src(this) result(nlon_src) + class(horiz_interp_type) :: this + integer :: nlon_src + + nlon_src = this%nlon_src + + end function get_nlon_src + + function get_nlat_src(this) result(nlat_src) + class(horiz_interp_type) :: this + integer :: nlat_src + + nlat_src = this%nlat_src + + end function get_nlat_src + + function get_nlon_dst(this) result(nlon_dst) + class(horiz_interp_type) :: this + integer :: nlon_dst + + nlon_dst = this%nlon_dst + + end function get_nlon_dst + + function get_nlat_dst(this) result(nlat_dst) + class(horiz_interp_type) :: this + integer :: nlat_dst + + nlat_dst = this%nlat_dst + + end function get_nlat_dst + + function get_interp_method(this) result(interp_method) + class(horiz_interp_type) :: this + integer :: interp_method + + interp_method = this%interp_method + + end function get_interp_method + + function get_I_am_initialized(this) result(I_am_initialized) + class(horiz_interp_type) :: this + logical :: I_am_initialized + + I_am_initialized = this%I_am_initialized + + end function get_I_am_initialized + + function get_version(this) result(version) + class(horiz_interp_type) :: this + integer :: version + + version = this%version + + end function get_version + + function get_nxgrid(this) result(nxgrid) + class(horiz_interp_type) :: this + integer :: nxgrid + + nxgrid = this%nxgrid + + end function get_nxgrid + + function get_i_src(this) result(i_src) + class(horiz_interp_type) :: this + integer, dimension(:), allocatable :: i_src + + if (allocated(this%i_src)) then + i_src = this%i_src + endif + + end function get_i_src + + function get_j_src(this) result(j_src) + class(horiz_interp_type) :: this + integer, dimension(:), allocatable :: j_src + + if (allocated(this%j_src)) then + j_src = this%j_src + endif + + end function get_j_src + + function get_i_dst(this) result(i_dst) + class(horiz_interp_type) :: this + integer, dimension(:), allocatable :: i_dst + + if (allocated(this%i_dst)) then + i_dst = this%i_dst + endif + + end function get_i_dst + + function get_j_dst(this) result(j_dst) + class(horiz_interp_type) :: this + integer, dimension(:), allocatable :: j_dst + + if (allocated(this%j_dst)) then + j_dst = this%j_dst + endif + + end function get_j_dst + + function get_horizInterpReals8_type(this) result(horizInterpReals8_type) + class(horiz_interp_type) :: this + type(horizInterpReals8_type) :: horizInterpReals8_type + + !horizInterpReals8_type => this%horizInterpReals8_type + + end function get_horizInterpReals8_type + + function get_horizInterpReals4_type(this) result(horizInterpReals4_type) + class(horiz_interp_type) :: this + type(horizInterpReals4_type) :: horizInterpReals4_type + + !horizInterpReals4_type => this%horizInterpReals4_type + + end function get_horizInterpReals4_type + !> @brief horiz_interp_type_eq creates a copy of the horiz_interp_type object subroutine horiz_interp_type_eq(horiz_interp_out, horiz_interp_in) type(horiz_interp_type), intent(inout) :: horiz_interp_out !< Output object being set From 9066c40582e22ddbe74f57e185ed5ec424130d1a Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 17 Apr 2025 10:54:03 -0400 Subject: [PATCH 04/10] Add getter functions for public random_numbers types - Implemented type-bound getter methods for all public random_numbers types - No changes to type hierarchy; existing types remain unchanged --- random_numbers/mersennetwister.F90 | 16 ++++++++++++++++ random_numbers/random_numbers.F90 | 11 ++++++++++- 2 files changed, 26 insertions(+), 1 deletion(-) diff --git a/random_numbers/mersennetwister.F90 b/random_numbers/mersennetwister.F90 index 3561f88498..dfa1d50d34 100644 --- a/random_numbers/mersennetwister.F90 +++ b/random_numbers/mersennetwister.F90 @@ -116,6 +116,9 @@ module MersenneTwister_mod type randomNumberSequence integer :: currentElement ! = blockSize integer, dimension(0:blockSize -1) :: state ! = 0 + contains + procedure :: get_currentElement + procedure :: get_state end type randomNumberSequence !> @ingroup mersennetwister_mod @@ -130,6 +133,19 @@ module MersenneTwister_mod !> @{ ! ------------------------------------------------------------- contains + function get_currentElement(this) result(currentElement) + class(randomNumberSequence) :: this + integer :: currentElement + + currentElement = this%currentElement + end function get_currentElement + + function get_state(this) result(state) + class(randomNumberSequence) :: this + integer, dimension(0:blockSize-1) :: state + + state = this%state + end function get_state ! ------------------------------------------------------------- ! Private functions ! --------------------------- diff --git a/random_numbers/random_numbers.F90 b/random_numbers/random_numbers.F90 index 640260fc3e..e9276d93c1 100644 --- a/random_numbers/random_numbers.F90 +++ b/random_numbers/random_numbers.F90 @@ -39,7 +39,9 @@ module random_numbers_mod !> @brief Type to hold a stream of randomly generated numbers !> @ingroup random_numbers_mod type randomNumberStream - type(randomNumberSequence) :: theNumbers + type(randomNumberSequence), target :: theNumbers + contains + procedure :: get_theNumbers end type randomNumberStream !> Returns scalar, 1 or 2 D random real numbers @@ -67,6 +69,13 @@ module random_numbers_mod !> @{ contains + function get_theNumbers(this) result(theNumbers) + class(randomNumberStream) :: this + type(randomNumberSequence), target :: theNumbers + + theNumbers => this%theNumbers + + end function get_theNumbers !> Initialization function initializeRandomNumberStream_S(seed) result(new) From 6f1599b55bd2362cbed1418f80c6769e0478f742 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 24 Apr 2025 11:50:30 -0400 Subject: [PATCH 05/10] Added has type-bound function for pointer components on coupler_types. Fixed some get type-bound functions for coupler_bc_types --- coupler/coupler_types.F90 | 381 ++++++++++++++++++++++++++++---------- 1 file changed, 281 insertions(+), 100 deletions(-) diff --git a/coupler/coupler_types.F90 b/coupler/coupler_types.F90 index da723b1aa3..0f318d675e 100644 --- a/coupler/coupler_types.F90 +++ b/coupler/coupler_types.F90 @@ -124,16 +124,16 @@ module coupler_types_mod procedure :: get_num_fields procedure :: get_flux_type procedure :: get_implementation - procedure :: get_flag + procedure :: get_flag, has_flag procedure :: get_atm_tr_index procedure :: get_ice_restart_file procedure :: get_ocean_restart_file - !procedure :: get_rest_type - procedure :: get_fms2_io_rest_type + !procedure :: get_rest_type, has_rest_type + procedure :: get_fms2_io_rest_type, has_fms2_io_rest_type procedure :: get_use_atm_pressure procedure :: get_use_10m_wind_speed procedure :: get_pass_through_ice - procedure :: get_param + procedure :: get_param, has_param procedure :: get_mol_wt end type coupler_field_type @@ -154,6 +154,7 @@ module coupler_types_mod !! should be changed to allocatable contains procedure :: get_values => get_values_3d_r8 + procedure :: has_values => has_values_3d_r8 end type coupler_3d_real8_values_type !> Coupler data for 3D fields @@ -162,6 +163,7 @@ module coupler_types_mod type(coupler_3d_real8_values_type), pointer, dimension(:) :: field => NULL() !< field contains procedure :: get_field => get_field_3d_r8 + procedure :: has_field => has_field_3d_r8 end type coupler_3d_real8_field_type !> Coupler data for 3D values @@ -172,6 +174,7 @@ module coupler_types_mod !! should be changed to allocatable contains procedure :: get_values => get_values_3d_r4 + procedure :: has_values => has_values_3d_r4 end type coupler_3d_real4_values_type !> Coupler data for 3D fields @@ -180,6 +183,7 @@ module coupler_types_mod type(coupler_3d_real4_values_type), pointer, dimension(:) :: field => NULL() !< field contains procedure :: get_field => get_field_3d_r4 + procedure :: has_field => has_field_3d_r4 end type coupler_3d_real4_field_type !> Coupler data for 3D boundary conditions @@ -193,15 +197,17 @@ module coupler_types_mod integer :: ks, ke !< The k-direction index ranges for this type contains procedure :: get_bc => get_bc_3d + procedure :: has_bc => has_bc_3d procedure :: get_bc_r4 => get_bc_r4_3d - procedure :: get_isd - procedure :: get_isc - procedure :: get_iec - procedure :: get_ied - procedure :: get_jsd - procedure :: get_jsc - procedure :: get_jec - procedure :: get_jed + procedure :: has_bc_r4 => has_bc_r4_3d + procedure :: get_isd => get_isd_3d + procedure :: get_isc => get_isc_3d + procedure :: get_iec => get_iec_3d + procedure :: get_ied => get_ied_3d + procedure :: get_jsd => get_jsd_3d + procedure :: get_jsc => get_jsc_3d + procedure :: get_jec => get_jec_3d + procedure :: get_jed => get_jed_3d procedure :: get_ks procedure :: get_ke end type coupler_3d_bc_type @@ -215,6 +221,7 @@ module coupler_types_mod !! should be changed to allocatable contains procedure :: get_values => get_values_2d_r8 + procedure :: has_values => has_values_2d_r8 end type coupler_2d_real8_values_type !> Coupler data for 2D fields @@ -223,6 +230,7 @@ module coupler_types_mod type(coupler_2d_real8_values_type), pointer, dimension(:) :: field => NULL() !< field contains procedure :: get_field => get_field_2d_r8 + procedure :: has_field => has_field_2d_r8 end type coupler_2d_real8_field_type !> Coupler data for 2D values @@ -233,6 +241,7 @@ module coupler_types_mod !! should be changed to allocatable contains procedure :: get_values => get_values_2d_r4 + procedure :: has_values => has_values_2d_r4 end type coupler_2d_real4_values_type !> Coupler data for 2D fields @@ -241,6 +250,7 @@ module coupler_types_mod type(coupler_2d_real4_values_type), pointer, dimension(:) :: field => NULL() !< field contains procedure :: get_field => get_field_2d_r4 + procedure :: has_field => has_field_2d_r4 end type coupler_2d_real4_field_type !> Coupler data for 2D boundary conditions @@ -254,15 +264,17 @@ module coupler_types_mod integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type contains procedure :: get_bc => get_bc_2d + procedure :: has_bc => has_bc_2d procedure :: get_bc_r4 => get_bc_r4_2d - procedure :: get_isd - procedure :: get_isc - procedure :: get_iec - procedure :: get_ied - procedure :: get_jsd - procedure :: get_jsc - procedure :: get_jec - procedure :: get_jed + procedure :: has_bc_r4 => has_bc_r4_2d + procedure :: get_isd => get_isd_2d + procedure :: get_isc => get_isc_2d + procedure :: get_iec => get_iec_2d + procedure :: get_ied => get_ied_2d + procedure :: get_jsd => get_jsd_2d + procedure :: get_jsc => get_jsc_2d + procedure :: get_jec => get_jec_2d + procedure :: get_jed => get_jed_2d end type coupler_2d_bc_type !> Coupler data for 1D values @@ -271,6 +283,7 @@ module coupler_types_mod real(r8_kind), pointer, dimension(:) :: values => NULL() !< The pointer to the array of values contains procedure :: get_values => get_values_1d_r8 + procedure :: has_values => has_values_1d_r8 end type coupler_1d_real8_values_type !> Coupler data for 1D fields @@ -279,6 +292,7 @@ module coupler_types_mod type(coupler_1d_real8_values_type), pointer, dimension(:) :: field => NULL() !< field contains procedure :: get_field => get_field_1d_r8 + procedure :: has_field => has_field_1d_r8 end type coupler_1d_real8_field_type !> Coupler data for 1D values @@ -287,6 +301,7 @@ module coupler_types_mod real(r4_kind), pointer, dimension(:) :: values => NULL() !< The pointer to the array of values contains procedure :: get_values => get_values_1d_r4 + procedure :: has_values => has_values_1d_r4 end type coupler_1d_real4_values_type !> Coupler data for 1D fields @@ -295,6 +310,7 @@ module coupler_types_mod type(coupler_1d_real4_values_type), pointer, dimension(:) :: field => NULL() !< field contains procedure :: get_field => get_field_1d_r4 + procedure :: has_field => has_field_1d_r4 end type coupler_1d_real4_field_type !> Coupler data for 1D boundary conditions @@ -306,7 +322,9 @@ module coupler_types_mod !! condition fields contains procedure :: get_bc => get_bc_1d + procedure :: has_bc => has_bc_1d procedure :: get_bc_r4 => get_bc_r4_1d + procedure :: has_bc_r4 => has_bc_r4_1d end type coupler_1d_bc_type !> @addtogroup coupler_types_mod @@ -461,6 +479,13 @@ function get_bc_3d(this, bc_idx) result(bc_ptr) bc_ptr => this%bc(bc_idx) end function get_bc_3d + function has_bc_3d(this) result(has) + class(coupler_3d_bc_type), intent(in) :: this + logical :: has + + has = associated(this%bc) + end function has_bc_3d + function get_bc_r4_3d(this, bc_idx) result(bc_ptr) class(coupler_3d_bc_type), intent(in) :: this integer, intent(in) :: bc_idx @@ -469,6 +494,13 @@ function get_bc_r4_3d(this, bc_idx) result(bc_ptr) bc_ptr => this%bc_r4(bc_idx) end function get_bc_r4_3d + function has_bc_r4_3d(this) result(has) + class(coupler_3d_bc_type), intent(in) :: this + logical :: has + + has = associated(this%bc_r4) + end function has_bc_r4_3d + function get_bc_2d(this, bc_idx) result(bc_ptr) class(coupler_2d_bc_type), intent(in) :: this integer, intent(in) :: bc_idx @@ -477,6 +509,13 @@ function get_bc_2d(this, bc_idx) result(bc_ptr) bc_ptr => this%bc(bc_idx) end function get_bc_2d + function has_bc_2d(this) result(has) + class(coupler_2d_bc_type), intent(in) :: this + logical :: has + + has = associated(this%bc) + end function has_bc_2d + function get_bc_r4_2d(this, bc_idx) result(bc_ptr) class(coupler_2d_bc_type), intent(in) :: this integer, intent(in) :: bc_idx @@ -485,6 +524,13 @@ function get_bc_r4_2d(this, bc_idx) result(bc_ptr) bc_ptr => this%bc_r4(bc_idx) end function get_bc_r4_2d + function has_bc_r4_2d(this) result(has) + class(coupler_2d_bc_type), intent(in) :: this + logical :: has + + has = associated(this%bc_r4) + end function has_bc_r4_2d + function get_bc_1d(this, bc_idx) result(bc_ptr) class(coupler_1d_bc_type), intent(in) :: this integer, intent(in) :: bc_idx @@ -493,6 +539,13 @@ function get_bc_1d(this, bc_idx) result(bc_ptr) bc_ptr => this%bc(bc_idx) end function get_bc_1d + function has_bc_1d(this) result(has) + class(coupler_1d_bc_type), intent(in) :: this + logical :: has + + has = associated(this%bc) + end function has_bc_1d + function get_bc_r4_1d(this, bc_idx) result(bc_ptr) class(coupler_1d_bc_type), intent(in) :: this integer, intent(in) :: bc_idx @@ -501,101 +554,124 @@ function get_bc_r4_1d(this, bc_idx) result(bc_ptr) bc_ptr => this%bc_r4(bc_idx) end function get_bc_r4_1d - function get_isd(this) result(isd) - class(coupler_bc_type), intent(in) :: this - integer :: isd + function has_bc_r4_1d(this) result(has) + class(coupler_1d_bc_type), intent(in) :: this + logical :: has - SELECT TYPE(this) - TYPE IS(coupler_1d_bc_type) - isd = this%isd - TYPE IS(coupler_2d_bc_type) - isd = this%isd - END SELECT - end function get_isd + has = associated(this%bc_r4) + end function has_bc_r4_1d - function get_isc(this) result(isc) - class(coupler_bc_type), intent(in) :: this - integer :: isc + function get_isd_2d(this) result(isd) + class(coupler_2d_bc_type), intent(in) :: this + integer :: isd - SELECT TYPE(this) - TYPE IS(coupler_1d_bc_type) - isc = this%isc - TYPE IS(coupler_2d_bc_type) - isc = this%isc - END SELECT - end function get_isc + isd = this%isd + end function get_isd_2d - function get_ied(this) result(ied) - class(coupler_bc_type), intent(in) :: this - integer :: ied + function get_isd_3d(this) result(isd) + class(coupler_3d_bc_type), intent(in) :: this + integer :: isd - SELECT TYPE(this) - TYPE IS(coupler_1d_bc_type) - ied = this%ied - TYPE IS(coupler_2d_bc_type) - ied = this%ied - END SELECT - end function get_ied + isd = this%isd + end function get_isd_3d - function get_iec(this) result(iec) - class(coupler_bc_type), intent(in) :: this - integer :: iec + function get_isc_2d(this) result(isc) + class(coupler_2d_bc_type), intent(in) :: this + integer :: isc - SELECT TYPE(this) - TYPE IS(coupler_1d_bc_type) - iec = this%iec - TYPE IS(coupler_2d_bc_type) - iec = this%iec - END SELECT - end function get_iec + isc = this%isc + end function get_isc_2d - function get_jsd(this) result(jsd) - class(coupler_bc_type), intent(in) :: this - integer :: jsd + function get_isc_3d(this) result(isc) + class(coupler_3d_bc_type), intent(in) :: this + integer :: isc - SELECT TYPE(this) - TYPE IS(coupler_1d_bc_type) - jsd = this%jsd - TYPE IS(coupler_2d_bc_type) - jsd = this%jsd - END SELECT - end function get_jsd + isc = this%isc + end function get_isc_3d - function get_jsc(this) result(jsc) - class(coupler_bc_type), intent(in) :: this - integer :: jsc + function get_ied_2d(this) result(ied) + class(coupler_2d_bc_type), intent(in) :: this + integer :: ied - SELECT TYPE(this) - TYPE IS(coupler_1d_bc_type) - jsc = this%jsc - TYPE IS(coupler_2d_bc_type) - jsc = this%jsc - END SELECT - end function get_jsc + ied = this%ied + end function get_ied_2d - function get_jed(this) result(jed) - class(coupler_bc_type), intent(in) :: this - integer :: jed + function get_ied_3d(this) result(ied) + class(coupler_3d_bc_type), intent(in) :: this + integer :: ied - SELECT TYPE(this) - TYPE IS(coupler_1d_bc_type) - jed = this%jed - TYPE IS(coupler_2d_bc_type) - jed = this%jed - END SELECT - end function get_jed + ied = this%ied + end function get_ied_3d - function get_jec(this) result(jec) - class(coupler_bc_type), intent(in) :: this - integer :: jec + function get_iec_2d(this) result(iec) + class(coupler_2d_bc_type), intent(in) :: this + integer :: iec + + iec = this%iec + end function get_iec_2d + + function get_iec_3d(this) result(iec) + class(coupler_3d_bc_type), intent(in) :: this + integer :: iec + + iec = this%iec + end function get_iec_3d + + function get_jsd_2d(this) result(jsd) + class(coupler_2d_bc_type), intent(in) :: this + integer :: jsd + + jsd = this%jsd + end function get_jsd_2d + + function get_jsd_3d(this) result(jsd) + class(coupler_3d_bc_type), intent(in) :: this + integer :: jsd + + jsd = this%jsd + end function get_jsd_3d - SELECT TYPE(this) - TYPE IS(coupler_1d_bc_type) - jec = this%jec - TYPE IS(coupler_2d_bc_type) - jec = this%jec - END SELECT - end function get_jec + function get_jsc_2d(this) result(jsc) + class(coupler_2d_bc_type), intent(in) :: this + integer :: jsc + + jsc = this%jsc + end function get_jsc_2d + + function get_jsc_3d(this) result(jsc) + class(coupler_3d_bc_type), intent(in) :: this + integer :: jsc + + jsc = this%jsc + end function get_jsc_3d + + function get_jed_2d(this) result(jed) + class(coupler_2d_bc_type), intent(in) :: this + integer :: jed + + jed = this%jed + end function get_jed_2d + + function get_jed_3d(this) result(jed) + class(coupler_3d_bc_type), intent(in) :: this + integer :: jed + + jed = this%jed + end function get_jed_3d + + function get_jec_2d(this) result(jec) + class(coupler_2d_bc_type), intent(in) :: this + integer :: jec + + jec = this%jec + end function get_jec_2d + + function get_jec_3d(this) result(jec) + class(coupler_3d_bc_type), intent(in) :: this + integer :: jec + + jec = this%jec + end function get_jec_3d function get_ks(this) result(ks) class(coupler_3d_bc_type), intent(in) :: this @@ -667,6 +743,13 @@ function get_flag(this) result(flag_ptr) flag_ptr => this%flag end function get_flag + function has_flag(this) result(has) + class(coupler_field_type), intent(in) :: this + logical :: has + + has = associated(this%flag) + end function has_flag + !> @brief Gets atm_tr_index for coupler_field_type function get_atm_tr_index(this) result(atm_tr_index) class(coupler_field_type), intent(in) :: this @@ -699,6 +782,13 @@ function get_fms2_io_rest_type(this) result(fms2_io_rest_type_ptr) fms2_io_rest_type_ptr => this%fms2_io_rest_type end function get_fms2_io_rest_type + function has_fms2_io_rest_type(this) result(has) + class(coupler_field_type), intent(in) :: this + logical :: has + + has = associated(this%fms2_io_rest_type) + end function has_fms2_io_rest_type + !> @brief Gets use_atm_pressure for coupler_field_type function get_use_atm_pressure(this) result(use_atm_pressure) class(coupler_field_type), intent(in) :: this @@ -731,6 +821,13 @@ function get_field_3d_r8(this, field_idx) result(field_ptr) field_ptr => this%field(field_idx) end function get_field_3d_r8 + function has_field_3d_r8(this) result(has) + class(coupler_3d_real8_field_type), intent(in) :: this + logical :: has + + has = associated(this%field) + end function has_field_3d_r8 + function get_field_3d_r4(this, field_idx) result(field_ptr) class(coupler_3d_real4_field_type), intent(in) :: this integer, intent(in) :: field_idx @@ -739,6 +836,13 @@ function get_field_3d_r4(this, field_idx) result(field_ptr) field_ptr => this%field(field_idx) end function get_field_3d_r4 + function has_field_3d_r4(this) result(has) + class(coupler_3d_real4_field_type), intent(in) :: this + logical :: has + + has = associated(this%field) + end function has_field_3d_r4 + function get_field_2d_r8(this, field_idx) result(field_ptr) class(coupler_2d_real8_field_type), intent(in) :: this integer, intent(in) :: field_idx @@ -747,6 +851,13 @@ function get_field_2d_r8(this, field_idx) result(field_ptr) field_ptr => this%field(field_idx) end function get_field_2d_r8 + function has_field_2d_r8(this) result(has) + class(coupler_2d_real8_field_type), intent(in) :: this + logical :: has + + has = associated(this%field) + end function has_field_2d_r8 + function get_field_2d_r4(this, field_idx) result(field_ptr) class(coupler_2d_real4_field_type), intent(in) :: this integer, intent(in) :: field_idx @@ -755,6 +866,13 @@ function get_field_2d_r4(this, field_idx) result(field_ptr) field_ptr => this%field(field_idx) end function get_field_2d_r4 + function has_field_2d_r4(this) result(has) + class(coupler_2d_real4_field_type), intent(in) :: this + logical :: has + + has = associated(this%field) + end function has_field_2d_r4 + function get_field_1d_r8(this, field_idx) result(field_ptr) class(coupler_1d_real8_field_type), intent(in) :: this integer, intent(in) :: field_idx @@ -763,6 +881,13 @@ function get_field_1d_r8(this, field_idx) result(field_ptr) field_ptr => this%field(field_idx) end function get_field_1d_r8 + function has_field_1d_r8(this) result(has) + class(coupler_1d_real8_field_type), intent(in) :: this + logical :: has + + has = associated(this%field) + end function has_field_1d_r8 + function get_field_1d_r4(this, field_idx) result(field_ptr) class(coupler_1d_real4_field_type), intent(in) :: this integer, intent(in) :: field_idx @@ -771,6 +896,13 @@ function get_field_1d_r4(this, field_idx) result(field_ptr) field_ptr => this%field(field_idx) end function get_field_1d_r4 + function has_field_1d_r4(this) result(has) + class(coupler_1d_real4_field_type), intent(in) :: this + logical :: has + + has = associated(this%field) + end function has_field_1d_r4 + !> @brief Gets param for coupler_field_type function get_param(this) result(param_ptr) class(coupler_field_type), intent(in) :: this @@ -779,6 +911,13 @@ function get_param(this) result(param_ptr) param_ptr => this%param end function get_param + function has_param(this) result(has) + class(coupler_field_type), intent(in) :: this + logical :: has + + has = associated(this%param) + end function has_param + !> @brief Gets mol_wt for coupler_field_type function get_mol_wt(this) result(mol_wt) class(coupler_field_type), intent(in) :: this @@ -866,6 +1005,13 @@ function get_values_3d_r8(this) result(values) values = this%values end function get_values_3d_r8 + function has_values_3d_r8(this) result(has) + class(coupler_3d_real8_values_type), intent(in) :: this + logical :: has + + has = associated(this%values) + end function has_values_3d_r8 + function get_values_3d_r4(this) result(values) class(coupler_3d_real4_values_type), intent(in) :: this real(r4_kind), dimension(:,:,:), allocatable :: values @@ -881,6 +1027,13 @@ function get_values_3d_r4(this) result(values) values = this%values end function get_values_3d_r4 + function has_values_3d_r4(this) result(has) + class(coupler_3d_real4_values_type), intent(in) :: this + logical :: has + + has = associated(this%values) + end function has_values_3d_r4 + function get_values_2d_r8(this) result(values) class(coupler_2d_real8_values_type), intent(in) :: this real(r8_kind), dimension(:,:), allocatable :: values @@ -895,6 +1048,13 @@ function get_values_2d_r8(this) result(values) values = this%values end function get_values_2d_r8 + function has_values_2d_r8(this) result(has) + class(coupler_2d_real8_values_type), intent(in) :: this + logical :: has + + has = associated(this%values) + end function has_values_2d_r8 + function get_values_2d_r4(this) result(values) class(coupler_2d_real4_values_type), intent(in) :: this real(r4_kind), dimension(:,:), allocatable :: values @@ -909,6 +1069,13 @@ function get_values_2d_r4(this) result(values) values = this%values end function get_values_2d_r4 + function has_values_2d_r4(this) result(has) + class(coupler_2d_real4_values_type), intent(in) :: this + logical :: has + + has = associated(this%values) + end function has_values_2d_r4 + function get_values_1d_r8(this) result(values) class(coupler_1d_real8_values_type), intent(in) :: this real(r8_kind), dimension(:), allocatable :: values @@ -922,6 +1089,13 @@ function get_values_1d_r8(this) result(values) values = this%values end function get_values_1d_r8 + function has_values_1d_r8(this) result(has) + class(coupler_1d_real8_values_type), intent(in) :: this + logical :: has + + has = associated(this%values) + end function has_values_1d_r8 + function get_values_1d_r4(this) result(values) class(coupler_1d_real4_values_type), intent(in) :: this real(r4_kind), dimension(:), allocatable :: values @@ -935,6 +1109,13 @@ function get_values_1d_r4(this) result(values) values = this%values end function get_values_1d_r4 + function has_values_1d_r4(this) result(has) + class(coupler_1d_real4_values_type), intent(in) :: this + logical :: has + + has = associated(this%values) + end function has_values_1d_r4 + !> @brief Initialize the coupler types subroutine coupler_types_init From 4b9375b10690c3af852fd55f67e68f3aceb65537 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 24 Apr 2025 11:52:37 -0400 Subject: [PATCH 06/10] Revert Changes. Removed type-bound getter since getters already exist --- random_numbers/mersennetwister.F90 | 16 ---------------- random_numbers/random_numbers.F90 | 11 +---------- 2 files changed, 1 insertion(+), 26 deletions(-) diff --git a/random_numbers/mersennetwister.F90 b/random_numbers/mersennetwister.F90 index dfa1d50d34..3561f88498 100644 --- a/random_numbers/mersennetwister.F90 +++ b/random_numbers/mersennetwister.F90 @@ -116,9 +116,6 @@ module MersenneTwister_mod type randomNumberSequence integer :: currentElement ! = blockSize integer, dimension(0:blockSize -1) :: state ! = 0 - contains - procedure :: get_currentElement - procedure :: get_state end type randomNumberSequence !> @ingroup mersennetwister_mod @@ -133,19 +130,6 @@ module MersenneTwister_mod !> @{ ! ------------------------------------------------------------- contains - function get_currentElement(this) result(currentElement) - class(randomNumberSequence) :: this - integer :: currentElement - - currentElement = this%currentElement - end function get_currentElement - - function get_state(this) result(state) - class(randomNumberSequence) :: this - integer, dimension(0:blockSize-1) :: state - - state = this%state - end function get_state ! ------------------------------------------------------------- ! Private functions ! --------------------------- diff --git a/random_numbers/random_numbers.F90 b/random_numbers/random_numbers.F90 index e9276d93c1..640260fc3e 100644 --- a/random_numbers/random_numbers.F90 +++ b/random_numbers/random_numbers.F90 @@ -39,9 +39,7 @@ module random_numbers_mod !> @brief Type to hold a stream of randomly generated numbers !> @ingroup random_numbers_mod type randomNumberStream - type(randomNumberSequence), target :: theNumbers - contains - procedure :: get_theNumbers + type(randomNumberSequence) :: theNumbers end type randomNumberStream !> Returns scalar, 1 or 2 D random real numbers @@ -69,13 +67,6 @@ module random_numbers_mod !> @{ contains - function get_theNumbers(this) result(theNumbers) - class(randomNumberStream) :: this - type(randomNumberSequence), target :: theNumbers - - theNumbers => this%theNumbers - - end function get_theNumbers !> Initialization function initializeRandomNumberStream_S(seed) result(new) From 927da294c3e87b0439b23185b89bd19c9c243d6e Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 24 Apr 2025 11:58:15 -0400 Subject: [PATCH 07/10] Remove trailing WS --- coupler/coupler_types.F90 | 2 +- drifters/drifters.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/coupler/coupler_types.F90 b/coupler/coupler_types.F90 index 0f318d675e..9042db930a 100644 --- a/coupler/coupler_types.F90 +++ b/coupler/coupler_types.F90 @@ -79,7 +79,7 @@ module coupler_types_mod type, abstract, private :: coupler_values_type character(len=48) :: name = ' ' !< The diagnostic name for this array character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array + character(len=128) :: units = ' ' !< The units for this array logical :: mean = .true. !< mean logical :: override = .false. !< override logical :: may_init = .true. !< If true, there is an internal method diff --git a/drifters/drifters.F90 b/drifters/drifters.F90 index 3fdd0f5f2c..1e3d19f9ca 100644 --- a/drifters/drifters.F90 +++ b/drifters/drifters.F90 @@ -400,7 +400,7 @@ function get_rk4_k2(this) result(rk4_k2) endif end function get_rk4_k3 - + function get_rk4_k4(this) result(rk4_k4) class(drifters_type) :: this real, allocatable :: rk4_k4(:,:) From 6a12820c67427950f6a243b48513c8d8d8bbbe7e Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 8 May 2025 11:00:54 -0400 Subject: [PATCH 08/10] Update documentation for coupler types --- coupler/coupler_types.F90 | 119 ++++++++++++++++++++++++++++---------- 1 file changed, 90 insertions(+), 29 deletions(-) diff --git a/coupler/coupler_types.F90 b/coupler/coupler_types.F90 index 9042db930a..92c9acd501 100644 --- a/coupler/coupler_types.F90 +++ b/coupler/coupler_types.F90 @@ -75,7 +75,8 @@ module coupler_types_mod !! Arrays (values + field) are typically directly allocated and then 'spawn' can be used to create a new type !! from a previously allocated 'template' type - !> Coupler values class + !> Coupler values abstract type + !> @ingroup coupler_types_mod type, abstract, private :: coupler_values_type character(len=48) :: name = ' ' !< The diagnostic name for this array character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array @@ -98,7 +99,8 @@ module coupler_types_mod procedure :: get_id_rest end type coupler_values_type - !> Coupler field class + !> Coupler field abstract type + !> @ingroup coupler_types_mod type, abstract, private :: coupler_field_type character(len=48) :: name = ' ' !< name integer :: num_fields = 0 !< num_fields @@ -137,10 +139,11 @@ module coupler_types_mod procedure :: get_mol_wt end type coupler_field_type - !> Coupler bc class + !> Coupler bc abstract type + !> @ingroup coupler_types_mod type, abstract, private :: coupler_bc_type - integer :: num_bcs = 0 - logical :: set = .false. + integer :: num_bcs = 0 !< The number of boundary condition fields + logical :: set = .false. !< If true, this type has been initialized contains procedure :: get_num_bcs procedure :: get_set @@ -471,6 +474,8 @@ module coupler_types_mod !> @addtogroup coupler_types_mod !> @{ + + !> Return a pointer to the 3D boundary condition field at the given index. function get_bc_3d(this, bc_idx) result(bc_ptr) class(coupler_3d_bc_type), intent(in) :: this integer, intent(in) :: bc_idx @@ -479,6 +484,7 @@ function get_bc_3d(this, bc_idx) result(bc_ptr) bc_ptr => this%bc(bc_idx) end function get_bc_3d + !> Return true if the 3D real*8 boundary condition field is associated. function has_bc_3d(this) result(has) class(coupler_3d_bc_type), intent(in) :: this logical :: has @@ -486,6 +492,7 @@ function has_bc_3d(this) result(has) has = associated(this%bc) end function has_bc_3d + !> Return a pointer to the 3D boundary condition field (real*4) at the given index. function get_bc_r4_3d(this, bc_idx) result(bc_ptr) class(coupler_3d_bc_type), intent(in) :: this integer, intent(in) :: bc_idx @@ -494,6 +501,7 @@ function get_bc_r4_3d(this, bc_idx) result(bc_ptr) bc_ptr => this%bc_r4(bc_idx) end function get_bc_r4_3d + !> Return true if the 3D real*4 boundary condition field is associated. function has_bc_r4_3d(this) result(has) class(coupler_3d_bc_type), intent(in) :: this logical :: has @@ -501,6 +509,7 @@ function has_bc_r4_3d(this) result(has) has = associated(this%bc_r4) end function has_bc_r4_3d + !> Return a pointer to the 2D boundary condition field at the given index. function get_bc_2d(this, bc_idx) result(bc_ptr) class(coupler_2d_bc_type), intent(in) :: this integer, intent(in) :: bc_idx @@ -509,6 +518,7 @@ function get_bc_2d(this, bc_idx) result(bc_ptr) bc_ptr => this%bc(bc_idx) end function get_bc_2d + !> Return true if the 2D real*8 boundary condition field is associated. function has_bc_2d(this) result(has) class(coupler_2d_bc_type), intent(in) :: this logical :: has @@ -516,6 +526,7 @@ function has_bc_2d(this) result(has) has = associated(this%bc) end function has_bc_2d + !> Return a pointer to the 2D boundary condition field (real*4) at the given index. function get_bc_r4_2d(this, bc_idx) result(bc_ptr) class(coupler_2d_bc_type), intent(in) :: this integer, intent(in) :: bc_idx @@ -524,6 +535,7 @@ function get_bc_r4_2d(this, bc_idx) result(bc_ptr) bc_ptr => this%bc_r4(bc_idx) end function get_bc_r4_2d + !> Return true if the 2D real*4 boundary condition field is associated. function has_bc_r4_2d(this) result(has) class(coupler_2d_bc_type), intent(in) :: this logical :: has @@ -531,6 +543,7 @@ function has_bc_r4_2d(this) result(has) has = associated(this%bc_r4) end function has_bc_r4_2d + !> Return a pointer to the 1D boundary condition field at the given index. function get_bc_1d(this, bc_idx) result(bc_ptr) class(coupler_1d_bc_type), intent(in) :: this integer, intent(in) :: bc_idx @@ -539,6 +552,7 @@ function get_bc_1d(this, bc_idx) result(bc_ptr) bc_ptr => this%bc(bc_idx) end function get_bc_1d + !> Return true if the 1D real*8 boundary condition field is associated. function has_bc_1d(this) result(has) class(coupler_1d_bc_type), intent(in) :: this logical :: has @@ -546,6 +560,7 @@ function has_bc_1d(this) result(has) has = associated(this%bc) end function has_bc_1d + !> Return a pointer to the 1D boundary condition field (real*4) at the given index. function get_bc_r4_1d(this, bc_idx) result(bc_ptr) class(coupler_1d_bc_type), intent(in) :: this integer, intent(in) :: bc_idx @@ -554,6 +569,7 @@ function get_bc_r4_1d(this, bc_idx) result(bc_ptr) bc_ptr => this%bc_r4(bc_idx) end function get_bc_r4_1d + !> Return true if the 1D real*4 boundary condition field is associated. function has_bc_r4_1d(this) result(has) class(coupler_1d_bc_type), intent(in) :: this logical :: has @@ -561,6 +577,7 @@ function has_bc_r4_1d(this) result(has) has = associated(this%bc_r4) end function has_bc_r4_1d + !> Return the starting index (isd) for 2D boundary condition fields. function get_isd_2d(this) result(isd) class(coupler_2d_bc_type), intent(in) :: this integer :: isd @@ -568,6 +585,7 @@ function get_isd_2d(this) result(isd) isd = this%isd end function get_isd_2d + !> Return the starting index (isd) for 3D boundary condition fields. function get_isd_3d(this) result(isd) class(coupler_3d_bc_type), intent(in) :: this integer :: isd @@ -575,6 +593,7 @@ function get_isd_3d(this) result(isd) isd = this%isd end function get_isd_3d + !> Return the starting index (isc) for 2D core data fields. function get_isc_2d(this) result(isc) class(coupler_2d_bc_type), intent(in) :: this integer :: isc @@ -582,6 +601,7 @@ function get_isc_2d(this) result(isc) isc = this%isc end function get_isc_2d + !> Return the starting index (isc) for 3D core data fields. function get_isc_3d(this) result(isc) class(coupler_3d_bc_type), intent(in) :: this integer :: isc @@ -589,6 +609,7 @@ function get_isc_3d(this) result(isc) isc = this%isc end function get_isc_3d + !> Return the ending index (ied) for 2D boundary condition fields. function get_ied_2d(this) result(ied) class(coupler_2d_bc_type), intent(in) :: this integer :: ied @@ -596,6 +617,7 @@ function get_ied_2d(this) result(ied) ied = this%ied end function get_ied_2d + !> Return the ending index (ied) for 3D boundary condition fields. function get_ied_3d(this) result(ied) class(coupler_3d_bc_type), intent(in) :: this integer :: ied @@ -603,6 +625,7 @@ function get_ied_3d(this) result(ied) ied = this%ied end function get_ied_3d + !> Return the ending index (iec) for 2D core data fields. function get_iec_2d(this) result(iec) class(coupler_2d_bc_type), intent(in) :: this integer :: iec @@ -610,6 +633,7 @@ function get_iec_2d(this) result(iec) iec = this%iec end function get_iec_2d + !> Return the ending index (iec) for 3D core data fields. function get_iec_3d(this) result(iec) class(coupler_3d_bc_type), intent(in) :: this integer :: iec @@ -617,6 +641,7 @@ function get_iec_3d(this) result(iec) iec = this%iec end function get_iec_3d + !> Return the starting j-index (jsd) for 2D boundary condition fields. function get_jsd_2d(this) result(jsd) class(coupler_2d_bc_type), intent(in) :: this integer :: jsd @@ -624,6 +649,7 @@ function get_jsd_2d(this) result(jsd) jsd = this%jsd end function get_jsd_2d + !> Return the starting j-index (jsd) for 3D boundary condition fields. function get_jsd_3d(this) result(jsd) class(coupler_3d_bc_type), intent(in) :: this integer :: jsd @@ -631,6 +657,7 @@ function get_jsd_3d(this) result(jsd) jsd = this%jsd end function get_jsd_3d + !> Return the starting j-index (jsc) for 2D core data fields. function get_jsc_2d(this) result(jsc) class(coupler_2d_bc_type), intent(in) :: this integer :: jsc @@ -638,6 +665,7 @@ function get_jsc_2d(this) result(jsc) jsc = this%jsc end function get_jsc_2d + !> Return the starting j-index (jsc) for 3D core data fields. function get_jsc_3d(this) result(jsc) class(coupler_3d_bc_type), intent(in) :: this integer :: jsc @@ -645,6 +673,7 @@ function get_jsc_3d(this) result(jsc) jsc = this%jsc end function get_jsc_3d + !> Return the ending j-index (jed) for 2D boundary condition fields. function get_jed_2d(this) result(jed) class(coupler_2d_bc_type), intent(in) :: this integer :: jed @@ -652,6 +681,7 @@ function get_jed_2d(this) result(jed) jed = this%jed end function get_jed_2d + !> Return the ending j-index (jed) for 3D boundary condition fields. function get_jed_3d(this) result(jed) class(coupler_3d_bc_type), intent(in) :: this integer :: jed @@ -659,6 +689,7 @@ function get_jed_3d(this) result(jed) jed = this%jed end function get_jed_3d + !> Return the ending j-index (jec) for 2D core data fields. function get_jec_2d(this) result(jec) class(coupler_2d_bc_type), intent(in) :: this integer :: jec @@ -666,6 +697,7 @@ function get_jec_2d(this) result(jec) jec = this%jec end function get_jec_2d + !> Return the ending j-index (jec) for 3D core data fields. function get_jec_3d(this) result(jec) class(coupler_3d_bc_type), intent(in) :: this integer :: jec @@ -673,6 +705,7 @@ function get_jec_3d(this) result(jec) jec = this%jec end function get_jec_3d + !> Return the starting k-index (ks) for 3D fields. function get_ks(this) result(ks) class(coupler_3d_bc_type), intent(in) :: this integer :: ks @@ -680,6 +713,7 @@ function get_ks(this) result(ks) ks = this%ks end function get_ks + !> Return the ending k-index (ke) for 3D fields. function get_ke(this) result(ke) class(coupler_3d_bc_type), intent(in) :: this integer :: ke @@ -687,7 +721,7 @@ function get_ke(this) result(ke) ke = this%ke end function get_ke - !> @brief Gets num_bcs for coupler_bc_type + !> Return num_bcs for coupler_bc_type function get_num_bcs(this) result(num_bcs) class(coupler_bc_type), intent(in) :: this integer :: num_bcs @@ -695,7 +729,7 @@ function get_num_bcs(this) result(num_bcs) num_bcs = this%num_bcs end function get_num_bcs - !> @brief Gets num_bcs for coupler_bc_type + !> Returns true if coupler_bc_type is set function get_set(this) result(set) class(coupler_bc_type), intent(in) :: this logical :: set @@ -703,7 +737,7 @@ function get_set(this) result(set) set = this%set end function get_set - !> @brief Gets name for coupler_field_type + !> Returns name for coupler_field_type function get_field_name(this) result(field_name) class(coupler_field_type), intent(in) :: this character(len=48) :: field_name @@ -711,7 +745,7 @@ function get_field_name(this) result(field_name) field_name = this%name end function get_field_name - !> @brief Gets num_fields for coupler_field_type + !> Returns num_fields for coupler_field_type function get_num_fields(this) result(num_fields) class(coupler_field_type), intent(in) :: this integer :: num_fields @@ -719,7 +753,7 @@ function get_num_fields(this) result(num_fields) num_fields = this%num_fields end function get_num_fields - !> @brief Gets flux_type for coupler_field_type + !> Returns flux_type for coupler_field_type function get_flux_type(this) result(flux_type) class(coupler_field_type), intent(in) :: this character(len=128) :: flux_type @@ -727,7 +761,7 @@ function get_flux_type(this) result(flux_type) flux_type = this%flux_type end function get_flux_type - !> @brief Gets implementation for coupler_field_type + !> Returns implementation for coupler_field_type function get_implementation(this) result(implementation) class(coupler_field_type), intent(in) :: this character(len=128) :: implementation @@ -735,7 +769,7 @@ function get_implementation(this) result(implementation) implementation = this%implementation end function get_implementation - !> @brief Gets flag for coupler_field_type + !> Returns pointer to coupler_field_type flag function get_flag(this) result(flag_ptr) class(coupler_field_type), intent(in) :: this logical, pointer, dimension(:) :: flag_ptr @@ -743,6 +777,7 @@ function get_flag(this) result(flag_ptr) flag_ptr => this%flag end function get_flag + !> Returns true if the field has an associated flag. function has_flag(this) result(has) class(coupler_field_type), intent(in) :: this logical :: has @@ -750,7 +785,7 @@ function has_flag(this) result(has) has = associated(this%flag) end function has_flag - !> @brief Gets atm_tr_index for coupler_field_type + !> Returns atm_tr_index for coupler_field_type function get_atm_tr_index(this) result(atm_tr_index) class(coupler_field_type), intent(in) :: this integer :: atm_tr_index @@ -758,7 +793,7 @@ function get_atm_tr_index(this) result(atm_tr_index) atm_tr_index = this%atm_tr_index end function get_atm_tr_index - !> @brief Gets ice_restart_file for coupler_field_type + !> Returns ice_restart_file for coupler_field_type function get_ice_restart_file(this) result(ice_restart_file) class(coupler_field_type), intent(in) :: this character(len=128) :: ice_restart_file @@ -766,7 +801,7 @@ function get_ice_restart_file(this) result(ice_restart_file) ice_restart_file = this%ice_restart_file end function get_ice_restart_file - !> @brief Gets ocean_restart_file for coupler_field_type + !> Returns ocean_restart_file for coupler_field_type function get_ocean_restart_file(this) result(ocean_restart_file) class(coupler_field_type), intent(in) :: this character(len=128) :: ocean_restart_file @@ -774,7 +809,7 @@ function get_ocean_restart_file(this) result(ocean_restart_file) ocean_restart_file = this%ocean_restart_file end function get_ocean_restart_file - !> @brief Gets fms2_io_rest_type for coupler_field_type + !> Returns fms2_io_rest_type for coupler_field_type function get_fms2_io_rest_type(this) result(fms2_io_rest_type_ptr) class(coupler_field_type), intent(in) :: this type(FmsNetcdfDomainFile_t), pointer :: fms2_io_rest_type_ptr @@ -782,6 +817,7 @@ function get_fms2_io_rest_type(this) result(fms2_io_rest_type_ptr) fms2_io_rest_type_ptr => this%fms2_io_rest_type end function get_fms2_io_rest_type + !> Returns true if fms2_io_rest_type for coupler_field_type is associated function has_fms2_io_rest_type(this) result(has) class(coupler_field_type), intent(in) :: this logical :: has @@ -789,7 +825,7 @@ function has_fms2_io_rest_type(this) result(has) has = associated(this%fms2_io_rest_type) end function has_fms2_io_rest_type - !> @brief Gets use_atm_pressure for coupler_field_type + !> Returns true if use_atm_pressure = .true. for coupler_field_type function get_use_atm_pressure(this) result(use_atm_pressure) class(coupler_field_type), intent(in) :: this logical :: use_atm_pressure @@ -797,7 +833,7 @@ function get_use_atm_pressure(this) result(use_atm_pressure) use_atm_pressure = this%use_atm_pressure end function get_use_atm_pressure - !> @brief Gets use_10m_wind_speed for coupler_field_type + !> Returns true if use_10m_wind_speed = .true. for coupler_field_type function get_use_10m_wind_speed(this) result(use_10m_wind_speed) class(coupler_field_type), intent(in) :: this logical :: use_10m_wind_speed @@ -805,7 +841,7 @@ function get_use_10m_wind_speed(this) result(use_10m_wind_speed) use_10m_wind_speed = this%use_10m_wind_speed end function get_use_10m_wind_speed - !> @brief Gets pass_through_ice for coupler_field_type + !> Returns true if pass_through_ice = .true. for coupler_field_type function get_pass_through_ice(this) result(pass_through_ice) class(coupler_field_type), intent(in) :: this logical :: pass_through_ice @@ -813,6 +849,7 @@ function get_pass_through_ice(this) result(pass_through_ice) pass_through_ice = this%pass_through_ice end function get_pass_through_ice + !> Returns pointer to field for field index (field_idx) for coupler_3d_r8_field_type function get_field_3d_r8(this, field_idx) result(field_ptr) class(coupler_3d_real8_field_type), intent(in) :: this integer, intent(in) :: field_idx @@ -821,6 +858,7 @@ function get_field_3d_r8(this, field_idx) result(field_ptr) field_ptr => this%field(field_idx) end function get_field_3d_r8 + !> Returns true if field array is associated for coupler_3d_r8_field_type function has_field_3d_r8(this) result(has) class(coupler_3d_real8_field_type), intent(in) :: this logical :: has @@ -828,6 +866,7 @@ function has_field_3d_r8(this) result(has) has = associated(this%field) end function has_field_3d_r8 + !> Returns pointer to field for field index (field_idx) for coupler_3d_r4_field_type function get_field_3d_r4(this, field_idx) result(field_ptr) class(coupler_3d_real4_field_type), intent(in) :: this integer, intent(in) :: field_idx @@ -836,6 +875,7 @@ function get_field_3d_r4(this, field_idx) result(field_ptr) field_ptr => this%field(field_idx) end function get_field_3d_r4 + !> Returns true if field array is associated for coupler_3d_r4_field_type function has_field_3d_r4(this) result(has) class(coupler_3d_real4_field_type), intent(in) :: this logical :: has @@ -843,6 +883,7 @@ function has_field_3d_r4(this) result(has) has = associated(this%field) end function has_field_3d_r4 + !> Returns pointer to field for field index (field_idx) for coupler_2d_r8_field_type function get_field_2d_r8(this, field_idx) result(field_ptr) class(coupler_2d_real8_field_type), intent(in) :: this integer, intent(in) :: field_idx @@ -851,6 +892,7 @@ function get_field_2d_r8(this, field_idx) result(field_ptr) field_ptr => this%field(field_idx) end function get_field_2d_r8 + !> Returns true if field array is associated for coupler_2d_r8_field_type function has_field_2d_r8(this) result(has) class(coupler_2d_real8_field_type), intent(in) :: this logical :: has @@ -858,6 +900,7 @@ function has_field_2d_r8(this) result(has) has = associated(this%field) end function has_field_2d_r8 + !> Returns pointer to field for field index (field_idx) for coupler_2d_r4_field_type function get_field_2d_r4(this, field_idx) result(field_ptr) class(coupler_2d_real4_field_type), intent(in) :: this integer, intent(in) :: field_idx @@ -866,6 +909,7 @@ function get_field_2d_r4(this, field_idx) result(field_ptr) field_ptr => this%field(field_idx) end function get_field_2d_r4 + !> Returns true if field array is associated for coupler_2d_r4_field_type function has_field_2d_r4(this) result(has) class(coupler_2d_real4_field_type), intent(in) :: this logical :: has @@ -873,6 +917,7 @@ function has_field_2d_r4(this) result(has) has = associated(this%field) end function has_field_2d_r4 + !> Returns pointer to field for field index (field_idx) for coupler_1d_r8_field_type function get_field_1d_r8(this, field_idx) result(field_ptr) class(coupler_1d_real8_field_type), intent(in) :: this integer, intent(in) :: field_idx @@ -881,6 +926,7 @@ function get_field_1d_r8(this, field_idx) result(field_ptr) field_ptr => this%field(field_idx) end function get_field_1d_r8 + !> Returns true if field array is associated for coupler_2d_r8_field_type function has_field_1d_r8(this) result(has) class(coupler_1d_real8_field_type), intent(in) :: this logical :: has @@ -888,6 +934,7 @@ function has_field_1d_r8(this) result(has) has = associated(this%field) end function has_field_1d_r8 + !> Returns pointer to field for field index (field_idx) for coupler_1d_r4_field_type function get_field_1d_r4(this, field_idx) result(field_ptr) class(coupler_1d_real4_field_type), intent(in) :: this integer, intent(in) :: field_idx @@ -896,6 +943,7 @@ function get_field_1d_r4(this, field_idx) result(field_ptr) field_ptr => this%field(field_idx) end function get_field_1d_r4 + !> Returns true if field array is associated for coupler_1d_r4_field_type function has_field_1d_r4(this) result(has) class(coupler_1d_real4_field_type), intent(in) :: this logical :: has @@ -903,7 +951,7 @@ function has_field_1d_r4(this) result(has) has = associated(this%field) end function has_field_1d_r4 - !> @brief Gets param for coupler_field_type + !> Returns pointer to param for coupler_field_type function get_param(this) result(param_ptr) class(coupler_field_type), intent(in) :: this real(r8_kind), pointer, dimension(:) :: param_ptr @@ -911,6 +959,7 @@ function get_param(this) result(param_ptr) param_ptr => this%param end function get_param + !> Returns true if param is associated for coupler_field_type function has_param(this) result(has) class(coupler_field_type), intent(in) :: this logical :: has @@ -918,7 +967,7 @@ function has_param(this) result(has) has = associated(this%param) end function has_param - !> @brief Gets mol_wt for coupler_field_type + !> Returns mol_wt for coupler_field_type function get_mol_wt(this) result(mol_wt) class(coupler_field_type), intent(in) :: this real(r8_kind) :: mol_wt @@ -926,7 +975,7 @@ function get_mol_wt(this) result(mol_wt) mol_wt = this%mol_wt end function get_mol_wt - !> @brief Gets name for coupler_values_type + !> Returns name for coupler_values_type function get_values_name(this) result(values_name) class(coupler_values_type), intent(in) :: this character(len=48) :: values_name @@ -934,7 +983,7 @@ function get_values_name(this) result(values_name) values_name = this%name end function get_values_name - !> @brief Gets long_name for coupler_values_type + !> Returns long_name for coupler_values_type function get_long_name(this) result(long_name) class(coupler_values_type), intent(in) :: this character(len=128) :: long_name @@ -942,7 +991,7 @@ function get_long_name(this) result(long_name) long_name = this%long_name end function get_long_name - !> @brief Gets units for coupler_values_type + !> Returnsunits for coupler_values_type function get_units(this) result(units) class(coupler_values_type), intent(in) :: this character(len=128) :: units @@ -950,7 +999,7 @@ function get_units(this) result(units) units = this%units end function get_units - !> @brief Gets mean for coupler_values_type + !> Returns true if mean = .true. for coupler_values_type function get_mean(this) result(mean) class(coupler_values_type), intent(in) :: this logical :: mean @@ -958,7 +1007,7 @@ function get_mean(this) result(mean) mean = this%mean end function get_mean - !> @brief Gets may_init for coupler_values_type + !> Returns true if may_init = .true. for coupler_values_type function get_may_init(this) result(may_init) class(coupler_values_type), intent(in) :: this logical :: may_init @@ -966,7 +1015,7 @@ function get_may_init(this) result(may_init) may_init = this%may_init end function get_may_init - !> @brief Gets override for coupler_values_type + !> Returns true if override = .true. for coupler_values_type function get_override(this) result(override) class(coupler_values_type), intent(in) :: this logical :: override @@ -974,7 +1023,7 @@ function get_override(this) result(override) override = this%override end function get_override - !> @brief Gets id_diag for coupler_values_type + !> Returns id_diag for coupler_values_type function get_id_diag(this) result(id_diag) class(coupler_values_type), intent(in) :: this integer :: id_diag @@ -982,7 +1031,7 @@ function get_id_diag(this) result(id_diag) id_diag = this%id_diag end function get_id_diag - !> @brief Gets id_rest for coupler_values_type + !> Returns id_rest for coupler_values_type function get_id_rest(this) result(id_rest) class(coupler_values_type), intent(in) :: this integer :: id_rest @@ -990,6 +1039,7 @@ function get_id_rest(this) result(id_rest) id_rest = this%id_rest end function get_id_rest + !> Returns values for coupler_3d_r8_values_type function get_values_3d_r8(this) result(values) class(coupler_3d_real8_values_type), intent(in) :: this real(r8_kind), dimension(:,:,:), allocatable :: values @@ -1005,6 +1055,7 @@ function get_values_3d_r8(this) result(values) values = this%values end function get_values_3d_r8 + !> Returns true if values is associated for coupler_3d_r8_values_type function has_values_3d_r8(this) result(has) class(coupler_3d_real8_values_type), intent(in) :: this logical :: has @@ -1012,6 +1063,7 @@ function has_values_3d_r8(this) result(has) has = associated(this%values) end function has_values_3d_r8 + !> Returns values for coupler_3d_r4_values_type function get_values_3d_r4(this) result(values) class(coupler_3d_real4_values_type), intent(in) :: this real(r4_kind), dimension(:,:,:), allocatable :: values @@ -1027,6 +1079,7 @@ function get_values_3d_r4(this) result(values) values = this%values end function get_values_3d_r4 + !> Returns true if values is associated for coupler_3d_r4_values_type function has_values_3d_r4(this) result(has) class(coupler_3d_real4_values_type), intent(in) :: this logical :: has @@ -1034,6 +1087,7 @@ function has_values_3d_r4(this) result(has) has = associated(this%values) end function has_values_3d_r4 + !> Returns values for coupler_2d_r8_values_type function get_values_2d_r8(this) result(values) class(coupler_2d_real8_values_type), intent(in) :: this real(r8_kind), dimension(:,:), allocatable :: values @@ -1048,6 +1102,7 @@ function get_values_2d_r8(this) result(values) values = this%values end function get_values_2d_r8 + !> Returns true if values is associated for coupler_2d_r8_values_type function has_values_2d_r8(this) result(has) class(coupler_2d_real8_values_type), intent(in) :: this logical :: has @@ -1055,6 +1110,7 @@ function has_values_2d_r8(this) result(has) has = associated(this%values) end function has_values_2d_r8 + !> Returns values for coupler_2d_r4_values_type function get_values_2d_r4(this) result(values) class(coupler_2d_real4_values_type), intent(in) :: this real(r4_kind), dimension(:,:), allocatable :: values @@ -1069,6 +1125,7 @@ function get_values_2d_r4(this) result(values) values = this%values end function get_values_2d_r4 + !> Returns true if values is associated for coupler_2d_r4_values_type function has_values_2d_r4(this) result(has) class(coupler_2d_real4_values_type), intent(in) :: this logical :: has @@ -1076,6 +1133,7 @@ function has_values_2d_r4(this) result(has) has = associated(this%values) end function has_values_2d_r4 + !> Returns values for coupler_1d_r8_values_type function get_values_1d_r8(this) result(values) class(coupler_1d_real8_values_type), intent(in) :: this real(r8_kind), dimension(:), allocatable :: values @@ -1089,6 +1147,7 @@ function get_values_1d_r8(this) result(values) values = this%values end function get_values_1d_r8 + !> Returns true if values is associated for coupler_1d_r8_values_type function has_values_1d_r8(this) result(has) class(coupler_1d_real8_values_type), intent(in) :: this logical :: has @@ -1096,6 +1155,7 @@ function has_values_1d_r8(this) result(has) has = associated(this%values) end function has_values_1d_r8 + !> Returns values for coupler_1d_r4_values_type function get_values_1d_r4(this) result(values) class(coupler_1d_real4_values_type), intent(in) :: this real(r4_kind), dimension(:), allocatable :: values @@ -1109,6 +1169,7 @@ function get_values_1d_r4(this) result(values) values = this%values end function get_values_1d_r4 + !> Returns true if values is associated for coupler_1d_r4_values_type function has_values_1d_r4(this) result(has) class(coupler_1d_real4_values_type), intent(in) :: this logical :: has From bbc7d2ada38aed2008f8fa2759d0c98649414efc Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 8 May 2025 11:05:36 -0400 Subject: [PATCH 09/10] Remove trailing WS --- coupler/coupler_types.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/coupler/coupler_types.F90 b/coupler/coupler_types.F90 index 92c9acd501..e78770bb40 100644 --- a/coupler/coupler_types.F90 +++ b/coupler/coupler_types.F90 @@ -80,7 +80,7 @@ module coupler_types_mod type, abstract, private :: coupler_values_type character(len=48) :: name = ' ' !< The diagnostic name for this array character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array + character(len=128) :: units = ' ' !< The units for this array logical :: mean = .true. !< mean logical :: override = .false. !< override logical :: may_init = .true. !< If true, there is an internal method From a9ad0c9dd03ff59384434cee77359d2f36a7a796 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 8 May 2025 11:16:05 -0400 Subject: [PATCH 10/10] Remove getters for private components --- horiz_interp/horiz_interp_type.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/horiz_interp/horiz_interp_type.F90 b/horiz_interp/horiz_interp_type.F90 index 62c05b21bd..66e7f7b966 100644 --- a/horiz_interp/horiz_interp_type.F90 +++ b/horiz_interp/horiz_interp_type.F90 @@ -199,8 +199,8 @@ module horiz_interp_type_mod procedure :: get_j_src procedure :: get_i_dst procedure :: get_j_dst - procedure :: get_horizInterpReals8_type - procedure :: get_horizInterpReals4_type + !procedure :: get_horizInterpReals8_type + !procedure :: get_horizInterpReals4_type end type !> @addtogroup horiz_interp_type_mod @@ -664,21 +664,21 @@ function get_j_dst(this) result(j_dst) end function get_j_dst - function get_horizInterpReals8_type(this) result(horizInterpReals8_type) - class(horiz_interp_type) :: this - type(horizInterpReals8_type) :: horizInterpReals8_type + !function get_horizInterpReals8_type(this) result(horizInterpReals8_type) + ! class(horiz_interp_type) :: this + ! type(horizInterpReals8_type) :: horizInterpReals8_type !horizInterpReals8_type => this%horizInterpReals8_type - end function get_horizInterpReals8_type + !end function get_horizInterpReals8_type - function get_horizInterpReals4_type(this) result(horizInterpReals4_type) - class(horiz_interp_type) :: this - type(horizInterpReals4_type) :: horizInterpReals4_type + !function get_horizInterpReals4_type(this) result(horizInterpReals4_type) + ! class(horiz_interp_type) :: this + ! type(horizInterpReals4_type) :: horizInterpReals4_type !horizInterpReals4_type => this%horizInterpReals4_type - end function get_horizInterpReals4_type + !end function get_horizInterpReals4_type !> @brief horiz_interp_type_eq creates a copy of the horiz_interp_type object subroutine horiz_interp_type_eq(horiz_interp_out, horiz_interp_in)