Grape_ Derived Type

type, public :: Grape_


Components

Type Visibility Attributes Name Initial
type(Mesh_), public :: struct
integer(kind=int32), public, allocatable :: leaf2stem(:,:)
integer(kind=int32), public, allocatable :: stem2stem(:,:)
integer(kind=int32), public, allocatable :: root2stem(:,:)
integer(kind=int32), public, allocatable :: root2root(:,:)
real(kind=real64), public :: mainstem_length
real(kind=real64), public :: mainstem_width
integer(kind=int32), public :: mainstem_node
real(kind=real64), public :: mainroot_length
real(kind=real64), public :: mainroot_width
integer(kind=int32), public :: mainroot_node
integer(kind=int32), public :: num_branch
integer(kind=int32), public :: num_branch_node
integer(kind=int32), public :: num_branch_root
integer(kind=int32), public :: num_branch_root_node
real(kind=real64), public :: ms_angle_ave = 0.0d0
real(kind=real64), public :: ms_angle_sig = 0.0d0
real(kind=real64), public, allocatable :: br_angle_ave_x(:)
real(kind=real64), public, allocatable :: br_angle_sig_x(:)
real(kind=real64), public, allocatable :: br_angle_ave_z(:)
real(kind=real64), public, allocatable :: br_angle_sig_z(:)
real(kind=real64), public, allocatable :: peti_size_ave(:)
real(kind=real64), public, allocatable :: peti_size_sig(:)
real(kind=real64), public, allocatable :: peti_width_ave(:)
real(kind=real64), public, allocatable :: peti_width_sig(:)
real(kind=real64), public, allocatable :: peti_angle_ave(:)
real(kind=real64), public, allocatable :: peti_angle_sig(:)
real(kind=real64), public, allocatable :: leaf_thickness_ave(:)
real(kind=real64), public, allocatable :: leaf_thickness_sig(:)
real(kind=real64), public, allocatable :: leaf_angle_ave(:)
real(kind=real64), public, allocatable :: leaf_angle_sig(:)
real(kind=real64), public, allocatable :: leaf_length_ave(:)
real(kind=real64), public, allocatable :: leaf_length_sig(:)
real(kind=real64), public, allocatable :: leaf_width_ave(:)
real(kind=real64), public, allocatable :: leaf_width_sig(:)
integer(kind=int32), public, allocatable :: br_node(:)
integer(kind=int32), public, allocatable :: br_from(:)
real(kind=real64), public, allocatable :: br_length(:)
real(kind=real64), public, allocatable :: br_width(:)
integer(kind=int32), public :: num_leaf
integer(kind=int32), public :: num_stem
integer(kind=int32), public :: num_root
type(FEMDomain_), public, allocatable :: leaf_list(:)
type(FEMDomain_), public, allocatable :: stem_list(:)
type(FEMDomain_), public, allocatable :: root_list(:)
character(len=:), public, allocatable :: LeafSurfaceData
type(Leaf_), public, allocatable :: Leaf(:)
type(Stem_), public, allocatable :: Stem(:)
type(Root_), public, allocatable :: Root(:)

Type-Bound Procedures

procedure, public :: create => createGrape

  • public subroutine createGrape(obj, config, LeafSurfaceData)

    Arguments

    Type IntentOptional Attributes Name
    class(Grape_), intent(inout) :: obj
    character(len=*), intent(in) :: config
    character(len=*), intent(in), optional :: LeafSurfaceData

procedure, public :: msh => mshGrape

  • public subroutine mshGrape(obj, name, num_threads)

    Arguments

    Type IntentOptional Attributes Name
    class(Grape_), intent(inout) :: obj
    character(len=*), intent(in) :: name
    integer(kind=int32), intent(in), optional :: num_threads

procedure, public :: vtk => vtkGrape

  • public subroutine vtkGrape(obj, name, num_threads)

    Arguments

    Type IntentOptional Attributes Name
    class(Grape_), intent(inout) :: obj
    character(len=*), intent(in) :: name
    integer(kind=int32), intent(in), optional :: num_threads

procedure, public :: stl => stlGrape

  • public subroutine stlGrape(obj, name, num_threads)

    Arguments

    Type IntentOptional Attributes Name
    class(Grape_), intent(inout) :: obj
    character(len=*), intent(in) :: name
    integer(kind=int32), intent(in), optional :: num_threads

procedure, public :: json => jsonGrape

  • public subroutine jsonGrape(obj, name)

    Arguments

    Type IntentOptional Attributes Name
    class(Grape_), intent(inout) :: obj
    character(len=*), intent(in) :: name

procedure, public :: move => moveGrape

  • public subroutine moveGrape(obj, x, y, z)

    Arguments

    Type IntentOptional Attributes Name
    class(Grape_), intent(inout) :: obj
    real(kind=real64), intent(in), optional :: x
    real(kind=real64), intent(in), optional :: y
    real(kind=real64), intent(in), optional :: z