H.2.1 Initialize_Ortho_Diffusion Procedure

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, Equation, NEquations, &
                                         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 
    type(integer), intent(in), optional :: Equation   ! Equation number.
    type(integer), intent(in), optional :: NEquations ! Number of equations.

    ! 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
    if (PRESENT(Equation)) then
      Diff_Term%Equation = Equation
    else
      Diff_Term%Equation = 1
    end if
    if (PRESENT(NEquations)) then
      Diff_Term%NEquations = NEquations
    else
      Diff_Term%NEquations = 1
    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