Backend structure

src/CMakeLists.txt

@@ -1,11 +1,16 @@
 set(SRC
   allocator.f90
+  backend.f90
   common.f90
+  solver.f90
   tdsops.f90
+  time_integrator.f90
+  omp/backend.f90
   omp/common.f90
   omp/kernels_dist.f90
 )
 set(CUDASRC
+  cuda/backend.f90
   cuda/common.f90
   cuda/allocator.f90
   cuda/exec_dist.f90
@@ -21,20 +26,34 @@ endif()
 add_library(x3d2 STATIC ${SRC})
 target_include_directories(x3d2 INTERFACE ${CMAKE_CURRENT_BINARY_DIR})
 
+add_executable(xcompact xcompact.f90)
+target_link_libraries(xcompact PRIVATE x3d2)
+
 target_compile_options(x3d2 PRIVATE "-O3")
+target_compile_options(xcompact PRIVATE "-O3")
+target_compile_options(xcompact PRIVATE "-cpp")
 
 if(${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI")
   target_compile_options(x3d2 PRIVATE "-cuda")
   target_compile_options(x3d2 PRIVATE "-fast")
   target_link_options(x3d2 INTERFACE "-cuda")
+  target_compile_options(xcompact PRIVATE "-cuda")
+  target_compile_options(xcompact PRIVATE "-fast")
+
+  target_compile_options(xcompact PRIVATE "-DCUDA")
+  #  target_link_options(xcompact INTERFACE "-cuda")
 endif()
 
 if(${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU")
   target_compile_options(x3d2 PRIVATE "-ffast-math")
+  target_compile_options(xcompact PRIVATE "-ffast-math")
 endif()
 
 find_package(OpenMP REQUIRED)
 target_link_libraries(x3d2 PRIVATE OpenMP::OpenMP_Fortran)
+target_link_libraries(xcompact PRIVATE OpenMP::OpenMP_Fortran)
 
 find_package(MPI REQUIRED)
 target_link_libraries(x3d2 PRIVATE MPI::MPI_Fortran)
+target_link_libraries(xcompact PRIVATE MPI::MPI_Fortran)
+

src/allocator.f90

@@ -63,6 +63,10 @@ module m_allocator
       module procedure field_constructor
    end interface field_t
 
+   type :: flist_t
+      class(field_t), pointer :: ptr
+   end type flist_t
+
 contains
 
    function field_constructor(dims, next, id) result(m)

src/backend.f90

@@ -0,0 +1,131 @@
+module m_base_backend
+   use m_allocator, only: allocator_t, field_t
+   use m_common, only: dp
+   use m_tdsops, only: tdsops_t, dirps_t
+
+   implicit none
+
+   type, abstract :: base_backend_t
+      !! base_backend class defines all the abstract operations that the
+      !! solver class requires.
+      !!
+      !! For example, transport equation in solver class evaluates the
+      !! derivatives in x, y, and z directions, and reorders the input
+      !! fields as required. Then finally, combines all the directional
+      !! derivatives to obtain the divergence of U*.
+      !!
+      !! All these high level operations solver class executes are
+      !! defined here using the abstract interfaces. Every backend
+      !! implementation extends the present abstact backend class to
+      !! define the specifics of these operations based on the target
+      !! architecture.
+
+      real(dp) :: nu
+      class(allocator_t), pointer :: allocator
+      class(dirps_t), pointer :: xdirps, ydirps, zdirps
+   contains
+      procedure(transeq_ders), deferred :: transeq_x
+      procedure(transeq_ders), deferred :: transeq_y
+      procedure(transeq_ders), deferred :: transeq_z
+      procedure(transposer), deferred :: trans_x2y
+      procedure(transposer), deferred :: trans_x2z
+      procedure(sum9into3), deferred :: sum_yzintox
+      procedure(get_fields), deferred :: get_fields
+      procedure(set_fields), deferred :: set_fields
+      procedure(alloc_tdsops), deferred :: alloc_tdsops
+   end type base_backend_t
+
+   abstract interface
+      subroutine transeq_ders(self, du, dv, dw, u, v, w, dirps)
+         !! transeq equation obtains the derivatives direction by
+         !! direction, and the exact algorithm used to obtain these
+         !! derivatives are decided at runtime. Backend implementations
+         !! are responsible from directing calls to transeq_ders into
+         !! the correct algorithm.
+         import :: base_backend_t
+         import :: field_t
+         import :: dirps_t
+         implicit none
+
+         class(base_backend_t) :: self
+         class(field_t), intent(inout) :: du, dv, dw
+         class(field_t), intent(in) :: u, v, w
+         type(dirps_t), intent(in) :: dirps
+      end subroutine transeq_ders
+   end interface
+
+   abstract interface
+      subroutine transposer(self, u_, v_, w_, u, v, w)
+         !! transposer subroutines are straightforward, they rearrange
+         !! data into our specialist data structure so that regardless
+         !! of the direction tridiagonal systems are solved efficiently
+         !! and fast.
+         import :: base_backend_t
+         import :: field_t
+         implicit none
+
+         class(base_backend_t) :: self
+         class(field_t), intent(inout) :: u_, v_, w_
+         class(field_t), intent(in) :: u, v, w
+      end subroutine transposer
+   end interface
+
+   abstract interface
+      subroutine sum9into3(self, du, dv, dw, du_y, dv_y, dw_y, du_z, dv_z, dw_z)
+         !! sum9into3 subroutine combines all the directional velocity
+         !! derivatives into the corresponding x directional fields.
+         import :: base_backend_t
+         import :: field_t
+         implicit none
+
+         class(base_backend_t) :: self
+         class(field_t), intent(inout) :: du, dv, dw
+         class(field_t), intent(in) :: du_y, dv_y, dw_y, du_z, dv_z, dw_z
+      end subroutine sum9into3
+   end interface
+
+   abstract interface
+      subroutine get_fields(self, u_out, v_out, w_out, u, v, w)
+         !! copy the specialist data structure from device or host back
+         !! to a regular 3D data structure.
+         import :: base_backend_t
+         import :: dp
+         import :: field_t
+         implicit none
+
+         class(base_backend_t) :: self
+         real(dp), dimension(:, :, :), intent(out) :: u_out, v_out, w_out
+         class(field_t), intent(in) :: u, v, w
+      end subroutine get_fields
+
+      subroutine set_fields(self, u, v, w, u_in, v_in, w_in)
+         !! copy the initial condition stored in a regular 3D data
+         !! structure into the specialist data structure arrays on the
+         !! device or host.
+         import :: base_backend_t
+         import :: dp
+         import :: field_t
+         implicit none
+
+         class(base_backend_t) :: self
+         class(field_t), intent(inout) :: u, v, w
+         real(dp), dimension(:, :, :), intent(in) :: u_in, v_in, w_in
+      end subroutine set_fields
+   end interface
+
+   abstract interface
+      subroutine alloc_tdsops(self, tdsops, n, dx, operation, scheme)
+         import :: base_backend_t
+         import :: dp
+         import :: tdsops_t
+         implicit none
+
+         class(base_backend_t) :: self
+         class(tdsops_t), allocatable, intent(inout) :: tdsops
+         integer, intent(in) :: n
+         real(dp), intent(in) :: dx
+         character(*), intent(in) :: operation, scheme
+      end subroutine alloc_tdsops
+   end interface
+
+end module m_base_backend

src/common.f90

@@ -4,4 +4,71 @@ module m_common
    integer, parameter :: dp=kind(0.0d0)
    real(dp), parameter :: pi = 4*atan(1.0_dp)
 
+   type :: globs_t
+      integer :: nx, ny, nz
+      integer :: nx_loc, ny_loc, nz_loc
+      integer :: n_groups_x, n_groups_y, n_groups_z
+      real(dp) :: Lx, Ly, Lz
+      real(dp) :: dx, dy, dz
+      integer :: nproc_x = 1, nproc_y = 1, nproc_z = 1
+      character(len=20) :: BC_x_s, BC_x_e, BC_y_s, BC_y_e, BC_z_s, BC_z_e
+   end type globs_t
+
+contains
+
+   subroutine set_pprev_pnext(xprev, xnext, yprev, ynext, zprev, znext, &
+                              xnproc, ynproc, znproc, nrank)
+      implicit none
+
+      integer, intent(out) :: xprev, xnext, yprev, ynext, zprev, znext
+      integer, intent(in) :: xnproc, ynproc, znproc, nrank
+
+      integer :: i, ix, iy, iz
+
+      ix = modulo(nrank, xnproc)
+      iy = modulo((nrank - ix)/xnproc, ynproc)
+      iz = (nrank - ix - iy*xnproc)/(xnproc*ynproc)
+      ! nrank == ix + iy*xnproc + iz*xnproc*ynproc
+
+      ! prev and next in x direction
+      if (ix == 0) then
+         xprev = nrank + (xnproc - 1)
+      else
+         xprev = nrank - 1
+      end if
+
+      if (ix == xnproc - 1) then
+         xnext = nrank - (xnproc - 1)
+      else
+         xnext = nrank + 1
+      end if
+
+      ! prev and next in y direction
+      if (iy == 0) then
+         yprev = nrank + (xnproc*(ynproc - 1))
+      else
+         yprev = nrank - xnproc
+      end if
+
+      if (iy == ynproc - 1) then
+         ynext = nrank - (xnproc*(ynproc - 1))
+      else
+         ynext = nrank + xnproc
+      end if
+
+      ! prev and next in z direction
+      if (iz == 0) then
+         zprev = nrank + (xnproc*ynproc*(znproc - 1))
+      else
+         zprev = nrank - xnproc*ynproc
+      end if
+
+      if (iz == znproc - 1) then
+         znext = nrank - (xnproc*ynproc*(znproc - 1))
+      else
+         znext = nrank + xnproc*ynproc
+      end if
+
+   end subroutine set_pprev_pnext
+
 end module m_common