The main documentation of the Get_DeltaR21_Cells_of_Cells_Multi_Mesh Procedure contains additional explanation of this code listing.
subroutine Get_DeltaR21_C_of_C_MMesh (DeltaR21_Cells_of_Cells, Mesh) ! Input variable. type(Multi_Mesh_type), intent(inout) :: Mesh ! Mesh object. ! Input/Output variable. type(real,2) :: DeltaR21_Cells_of_Cells ! DeltaR21_Cells_of_Cells BNV. ! Internal variables. type(integer) :: cell, other_cell ! Loop variables. type(real,2) :: Coordinates_Cells ! Coordinates of the cell centers. type(real,3) :: Coordinates_Cells_of_Cells ! Coordinates of other cells. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! Verify requirements. VERIFY(Valid_State(Mesh),5) ! Mesh is valid. ! DeltaR21_Cells_of_Cells is valid. VERIFY(Valid_State(DeltaR21_Cells_of_Cells),5) ! DeltaR21_Cells_of_Cells has correct dimensions. VERIFY(SIZE(DeltaR21_Cells_of_Cells,1) == Mesh%NCells_PE,5) VERIFY(SIZE(DeltaR21_Cells_of_Cells,2) == Mesh%Faces_per_Cell,5) ! Get cell and face coordinates. call Initialize (Coordinates_Cells, Mesh%NDimensions, Mesh%NCells_PE) call Get_Coordinates_Cells (Coordinates_Cells, Mesh) call Initialize (Coordinates_Cells_of_Cells, Mesh%NDimensions, & Mesh%NCells_PE, Mesh%Faces_per_Cell) call Get_Coordinates_Cells_of_Cells (Coordinates_Cells_of_Cells, Mesh) ! Calculate absolute distance from cell center to other cells (across ! the faces), ! ! DeltaR21 = | R_1 - R_2 |. do cell = 1, Mesh%NCells_PE do other_cell = 1, Mesh%Faces_per_Cell DeltaR21_Cells_of_Cells(cell,other_cell) = & SQRT(DOT_PRODUCT( & Coordinates_Cells(:,cell) - & Coordinates_Cells_of_Cells(:,cell,other_cell), & Coordinates_Cells(:,cell) - & Coordinates_Cells_of_Cells(:,cell,other_cell))) end do end do ! Finalizations. call Finalize (Coordinates_Cells) call Finalize (Coordinates_Cells_of_Cells) ! Verify guarantees. VERIFY(Valid_State(Mesh),5) ! Mesh is valid. ! DeltaR21_Cells_of_Cells is valid. VERIFY(Valid_State(DeltaR21_Cells_of_Cells),5) return end subroutine Get_DeltaR21_C_of_C_MMesh