diff --git a/coupler/coupler_types.F90 b/coupler/coupler_types.F90 index 24431197ec..e78770bb40 100644 --- a/coupler/coupler_types.F90 +++ b/coupler/coupler_types.F90 @@ -75,300 +75,259 @@ 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 + !> Coupler values abstract type !> @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 + 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 abstract type + !> @ingroup coupler_types_mod + 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, has_flag + procedure :: get_atm_tr_index + procedure :: get_ice_restart_file + procedure :: get_ocean_restart_file + !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, has_param + procedure :: get_mol_wt + end type coupler_field_type + + !> Coupler bc abstract type + !> @ingroup coupler_types_mod + type, abstract, private :: coupler_bc_type + 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 + 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 + procedure :: has_values => has_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 + procedure :: has_field => has_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 + procedure :: has_values => has_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 + procedure :: has_field => has_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 :: has_bc => has_bc_3d + procedure :: get_bc_r4 => get_bc_r4_3d + 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 !> 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 + procedure :: has_values => has_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 + procedure :: has_field => has_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 + procedure :: has_values => has_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 + procedure :: has_field => has_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 :: has_bc => has_bc_2d + procedure :: get_bc_r4 => get_bc_r4_2d + 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 !> @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 + procedure :: has_values => has_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 + procedure :: has_field => has_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 + procedure :: has_values => has_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 + procedure :: has_field => has_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 :: 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 @@ -516,6 +475,708 @@ 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 + type(coupler_3d_real8_field_type), pointer :: 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 + + 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 + type(coupler_3d_real4_field_type), pointer :: 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 + + 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 + type(coupler_2d_real8_field_type), pointer :: 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 + + 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 + type(coupler_2d_real4_field_type), pointer :: 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 + + 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 + type(coupler_1d_real8_field_type), pointer :: 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 + + 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 + type(coupler_1d_real4_field_type), pointer :: 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + ke = this%ke + end function get_ke + + !> 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 + + num_bcs = this%num_bcs + end function get_num_bcs + + !> Returns true if coupler_bc_type is set + function get_set(this) result(set) + class(coupler_bc_type), intent(in) :: this + logical :: set + + set = this%set + end function get_set + + !> 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 + + field_name = this%name + end function get_field_name + + !> 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 + + num_fields = this%num_fields + end function get_num_fields + + !> 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 + + flux_type = this%flux_type + end function get_flux_type + + !> Returns 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 + + !> 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 + + 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 + + has = associated(this%flag) + end function has_flag + + !> 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 + + atm_tr_index = this%atm_tr_index + end function get_atm_tr_index + + !> 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 + + ice_restart_file = this%ice_restart_file + end function get_ice_restart_file + + !> 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 + + ocean_restart_file = this%ocean_restart_file + end function get_ocean_restart_file + + !> 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 + + 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 + + has = associated(this%fms2_io_rest_type) + end function has_fms2_io_rest_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 + + use_atm_pressure = this%use_atm_pressure + end function get_use_atm_pressure + + !> 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 + + use_10m_wind_speed = this%use_10m_wind_speed + end function get_use_10m_wind_speed + + !> 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 + + 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 + type(coupler_3d_real8_values_type), pointer :: 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 + + 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 + type(coupler_3d_real4_values_type), pointer :: 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 + + 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 + type(coupler_2d_real8_values_type), pointer :: 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 + + 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 + type(coupler_2d_real4_values_type), pointer :: 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 + + 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 + type(coupler_1d_real8_values_type), pointer :: 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 + + 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 + type(coupler_1d_real4_values_type), pointer :: 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 + + has = associated(this%field) + end function has_field_1d_r4 + + !> 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 + + 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 + + has = associated(this%param) + end function has_param + + !> 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 + + mol_wt = this%mol_wt + end function get_mol_wt + + !> 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 + + values_name = this%name + end function get_values_name + + !> 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 + + long_name = this%long_name + end function get_long_name + + !> Returnsunits 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 + + !> Returns true if mean = .true. 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 + + !> 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 + + may_init = this%may_init + end function get_may_init + + !> Returns true if override = .true. 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 + + !> 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 + + id_diag = this%id_diag + end function get_id_diag + + !> 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 + + 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 + + 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 + + !> 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 + + 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 + + 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 + + !> 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 + + 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 + + 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 + + !> 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 + + 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 + + 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 + + !> 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 + + 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 + + integer :: ni + + ni = size(this%values,1) + + allocate(values(ni)) + + 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 + + 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 + + integer :: ni + + ni = size(this%values,1) + + allocate(values(ni)) + + 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 + + has = associated(this%values) + end function has_values_1d_r4 + !> @brief Initialize the coupler types subroutine coupler_types_init diff --git a/drifters/drifters.F90 b/drifters/drifters.F90 index 4f5110cbdd..1e3d19f9ca 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 diff --git a/horiz_interp/horiz_interp_type.F90 b/horiz_interp/horiz_interp_type.F90 index a2bc90a821..66e7f7b966 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