The main documentation of the Initialize_Ortho_Diffusion Procedure contains additional explanation of this code listing.
subroutine Initialize_Ortho_Diffusion (Diff_Term, Coefficient, &
BC_Faces_of_Cells, &
Phi_BC_Faces_of_Cells, &
Phi_MV, Locus, Mesh, Name, &
Extrapolation, status)
! Use associations.
use Caesar_Flags_Module, only: initialized_flag
! Input variables.
type(real,1) :: Coefficient ! Diffusion coefficient.
type(character,*), intent(in) :: Locus ! Evaluation locus.
type(Multi_Mesh_type), target :: Mesh ! Diff_Term Mesh.
! Old value of the independent variable.
type(Mathematic_Vector_type), intent(inout) :: Phi_MV
type(character,*), intent(in), optional :: Name ! Diff_Term name.
type(integer,2) :: BC_Faces_of_Cells ! Boundary condition flags.
type(real,2) :: Phi_BC_Faces_of_Cells ! Boundary condition constants.
! Factor used in boundary condition calculation.
type(real), intent(in), optional :: Extrapolation
! Output variables.
! Diff_Term to be initialized.
type(Ortho_Diffusion_type), intent(out) :: Diff_Term
type(Status_type), intent(out), optional :: status ! Exit status.
! Internal variables.
type(Status_type), dimension(4) :: allocate_status ! Allocation Status.
type(Status_type) :: consolidated_status ! Consolidated Status.
type(integer) :: Faces_per_Cell ! Number of faces per cell.
type(integer) :: Length_Structure ! Length of the Structure on this PE.
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verify requirements.
VERIFY(.not.Valid_State(Diff_Term),5) ! Diff_Term is not valid.
VERIFY(Valid_State(Coefficient),5) ! Coefficient is valid.
! Set up pointers.
Diff_Term%Mesh => Mesh
select case (Locus)
case ("Cells")
Diff_Term%Structure => Cell_Structure(Mesh)
case ("Nodes")
Diff_Term%Structure => Node_Structure(Mesh)
case ("Faces")
Diff_Term%Structure => Face_Structure(Mesh)
end select
! Query the mesh.
Faces_per_Cell = Get_Faces_per_Cell(Mesh)
Length_Structure = Length_PE(Diff_Term%Structure)
! Two more requirements: Coefficient and Phi_MV are the right size.
VERIFY(SIZE(Coefficient)==Length_Structure,5)
VERIFY(Length_PE(Phi_MV)==Length_Structure,5)
! Allocations and initializations.
call Initialize (allocate_status)
call Initialize (consolidated_status)
call Initialize (Diff_Term%Coefficient, Length_Structure, &
allocate_status(1))
call Initialize (Diff_Term%Phi, Length_Structure, allocate_status(2))
call Initialize (Diff_Term%Boundary_Condition, Length_Structure, &
Faces_per_Cell, allocate_status(3))
call Initialize (Diff_Term%Phi_BC, Length_Structure, Faces_per_Cell, &
allocate_status(4))
! Set up internals.
if (PRESENT(Name)) then
Diff_Term%Name = Name
else
Diff_Term%Name = ' '
end if
Diff_Term%Coefficient = Coefficient
Diff_Term%Locus = Locus
Diff_Term%Phi = Phi_MV
Diff_Term%Boundary_Condition = BC_Faces_of_Cells
Diff_Term%Phi_BC = Phi_BC_Faces_of_Cells
if (PRESENT(Extrapolation)) then
Diff_Term%Extrapolation = Extrapolation
else
Diff_Term%Extrapolation = half
end if
! Process status variables.
consolidated_status = allocate_status
if (PRESENT(status)) then
WARN_IF(Error(consolidated_status), 5)
status = consolidated_status
else
VERIFY(Normal(consolidated_status), 5)
end if
call Finalize (consolidated_status)
call Finalize (allocate_status)
! Set initialization flag.
Diff_Term%Initialized = initialized_flag
! Verify guarantees.
VERIFY(Valid_State(Diff_Term),5) ! Diff_Term is now valid.
return
end subroutine Initialize_Ortho_Diffusion