Skip to content

Feature/speedup #463

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
ywkawai merged 5 commits into from
Jul 2, 2025
Merged

Feature/speedup #463

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
14776dc
Improve computational performance of RK module
ywkawai Jul 2, 2025
93e63ee
Avoid to use second temporary buffers for delayed MPI_wait calls
ywkawai Jul 2, 2025
7b8ba93
Refactoring
ywkawai Jul 2, 2025
2bd02cb
Introduce an array to save a hydrostatic part of RHOT
ywkawai Jul 2, 2025
9d7fd2e
Modify the statement of implicit none
ywkawai Jul 2, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1,237 changes: 950 additions & 287 deletions FElib/src/common/scale_timeint_rk.F90
View file
Open in desktop

Large diffs are not rendered by default.

450 changes: 356 additions & 94 deletions FElib/src/common/scale_timeint_rk.F90.erb
View file
Open in desktop

Large diffs are not rendered by default.

157 changes: 138 additions & 19 deletions FElib/src/data/scale_meshfieldcomm_base.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -90,14 +90,15 @@ module scale_meshfieldcomm_base
public :: MeshFieldCommBase_exchange_core
public :: MeshFieldCommBase_wait_core
public :: MeshFieldCommBase_extract_bounddata
public :: MeshFieldCommBase_extract_bounddata_2
public :: MeshFieldCommBase_set_bounddata

!> Container to save a pointer of MeshField(1D, 2D, 3D) object
type, public :: MeshFieldContainer
class(MeshField1D), pointer :: field1d
class(MeshField2D), pointer :: field2d
class(MeshField3D), pointer :: field3d
end type
end type

interface
subroutine MeshFieldCommBase_put(this, field_list, varid_s)
Expand Down Expand Up @@ -391,7 +392,8 @@ end subroutine MeshFieldCommBase_exchange_core
!!
!! @param commdata_list Array of LocalMeshCommData objects which manage information and halo data
!OCL SERIAL
subroutine MeshFieldCommBase_wait_core( this, commdata_list )
subroutine MeshFieldCommBase_wait_core( this, commdata_list, &
field_list, dim, varid_s, lcmesh_list )
use mpi, only: &
! MPI_waitall, &
MPI_STATUS_SIZE
Expand All @@ -400,18 +402,25 @@ subroutine MeshFieldCommBase_wait_core( this, commdata_list )

class(MeshFieldCommBase), intent(inout) :: this
type(LocalMeshCommData), intent(inout), target :: commdata_list(this%nfaces_comm, this%mesh%LOCAL_MESH_NUM)
type(MeshFieldContainer), intent(inout), optional :: field_list(:)
integer, intent(in), optional :: dim
integer, intent(in), optional :: varid_s
class(LocalMeshBase), intent(in), optional, target :: lcmesh_list(:)

integer :: ierr
integer :: stat_send(MPI_STATUS_SIZE, this%req_counter)
integer :: stat_recv(MPI_STATUS_SIZE, this%req_counter)
integer :: stat_pc(MPI_STATUS_SIZE, this%req_counter)

integer :: n, f
integer :: var_id
integer :: irs, ire
integer :: i, var_id
integer :: irs(this%nfaces_comm,this%mesh%LOCAL_MESH_NUM), ire(this%nfaces_comm,this%mesh%LOCAL_MESH_NUM)

class(LocalMeshBase), pointer :: lcmesh
integer :: val_size(this%mesh%LOCAL_MESH_NUM)
!----------------------------

! call PROF_rapstart( 'meshfiled_comm_wait_core', 3)
! call PROF_rapstart( 'meshfiled_comm_wait_core', 2)
if ( this%MPI_pc_flag ) then
if (this%req_counter > 0) then
call MPI_waitall( this%req_counter, this%request_pc(1:this%req_counter), stat_pc, ierr )
Expand All @@ -422,25 +431,70 @@ subroutine MeshFieldCommBase_wait_core( this, commdata_list )
call MPI_waitall( this%req_counter, this%request_send(1:this%req_counter), stat_send, ierr )
end if
end if
! call PROF_rapend( 'meshfiled_comm_wait_core', 3)
! call PROF_rapend( 'meshfiled_comm_wait_core', 2)

!---------------------

! call PROF_rapstart( 'meshfiled_comm_wait_post', 3)
do n=1, this%mesh%LOCAL_MESH_NUM
!$omp parallel do private(var_id,f,irs,ire)
do var_id=1, this%field_num_tot
irs = 1
! call PROF_rapstart( 'meshfiled_comm_wait_post', 2)

if ( present(field_list) ) then
do n=1, this%mesh%LOCAL_MESH_NUM
lcmesh => lcmesh_list(n)
val_size(n) = lcmesh%refElem%Np * lcmesh%NeA
irs(1,n) = lcmesh%refElem%Np * lcmesh%Ne + 1
do f=1, this%nfaces_comm
ire = irs + commdata_list(f,n)%Nnode_LCMeshFace - 1
this%recv_buf(irs:ire,var_id,n) = commdata_list(f,n)%recv_buf(:,var_id)
irs = ire + 1
end do ! end loop for face
ire(f,n) = irs(f,n) + commdata_list(f,n)%Nnode_LCMeshFace - 1
if (f<this%nfaces_comm) irs(f+1,n) = ire(f,n) + 1
end do
end do

!$omp parallel do private(var_id,n,i,f) collapse(3)
do n=1, this%mesh%LOCAL_MESH_NUM
do i=1, size(field_list)
do f=1, this%nfaces_comm
var_id = varid_s + i - 1
if (dim==1) then
call set_bounddata( field_list(var_id)%field1d%local(n)%val, val_size(n), irs(f,n), ire(f,n), commdata_list(f,n)%recv_buf(:,var_id) )
else if (dim==2) then
call set_bounddata( field_list(var_id)%field2d%local(n)%val, val_size(n), irs(f,n), ire(f,n), commdata_list(f,n)%recv_buf(:,var_id) )
else if (dim==3) then
call set_bounddata( field_list(var_id)%field3d%local(n)%val, val_size(n), irs(f,n), ire(f,n), commdata_list(f,n)%recv_buf(:,var_id) )
end if
end do ! end loop for face
end do
end do
else
do n=1, this%mesh%LOCAL_MESH_NUM
irs(1,n) = 1
do f=1, this%nfaces_comm
ire(f,n) = irs(f,n) + commdata_list(f,n)%Nnode_LCMeshFace - 1
if (f<this%nfaces_comm) irs(f+1,n) = ire(f,n) + 1
end do
end do
end do
! call PROF_rapend( 'meshfiled_comm_wait_post', 3)

!$omp parallel do private(n,var_id,f) collapse(3)
do n=1, this%mesh%LOCAL_MESH_NUM
do var_id=1, this%field_num_tot
do f=1, this%nfaces_comm
this%recv_buf(irs(f,n):ire(f,n),var_id,n) = commdata_list(f,n)%recv_buf(:,var_id)
end do ! end loop for face
end do
end do
end if
! call PROF_rapend( 'meshfiled_comm_wait_post', 2)
return
contains
!OCL SERIAL
subroutine set_bounddata( var, IA, irs_, ire_, recv_buf )
implicit none
integer, intent(in) :: IA
real(RP), intent(inout) :: var(IA)
integer, intent(in) :: irs_, ire_
real(RP), intent(in) :: recv_buf(ire_-irs_+1)
!-----------------------------
var(irs_:ire_) = recv_buf(:)
return
end subroutine set_bounddata
end subroutine MeshFieldCommBase_wait_core

!> Extract halo data from data array with MeshField object and set it to the recieving buffer
Expand All @@ -463,6 +517,71 @@ subroutine MeshFieldCommBase_extract_bounddata(var, refElem, mesh, buf)
return
end subroutine MeshFieldCommBase_extract_bounddata

!> Extract halo data from data array with MeshField object and set it to the recieving buffer
!OCL SERIAL
subroutine MeshFieldCommBase_extract_bounddata_2(field_list, dim, varid_s, lcmesh_list, buf)
implicit none
class(MeshFieldContainer), intent(in), target :: field_list(:)
integer, intent(in) :: varid_s
integer, intent(in) :: dim
class(LocalMeshBase), intent(in), target :: lcmesh_list(:)
real(RP), intent(out) :: buf(size(lcmesh_list(1)%VmapB),size(field_list),size(lcmesh_list))

class(LocalMeshBase), pointer :: lcmesh
integer :: varid
integer :: i, n
!-----------------------------------------------------------------------------

do n=1, size(lcmesh_list)
lcmesh => lcmesh_list(n)
i = 1
do while( i <= size(field_list) )
varid = varid_s + i - 1
if ( i+1 <= n ) then
if (dim==1) then
call extract_bounddata_var2( buf(:,varid,n), buf(:,varid+1,n), field_list(varid)%field1d%local(n)%val, field_list(varid+1)%field1d%local(n)%val, lcmesh, lcmesh%refElem )
else if(dim==2) then
call extract_bounddata_var2( buf(:,varid,n), buf(:,varid+1,n), field_list(varid)%field2d%local(n)%val, field_list(varid+1)%field2d%local(n)%val, lcmesh, lcmesh%refElem )
else if(dim==3) then
call extract_bounddata_var2( buf(:,varid,n), buf(:,varid+1,n), field_list(varid)%field3d%local(n)%val, field_list(varid+1)%field3d%local(n)%val, lcmesh, lcmesh%refElem )
end if
i = i + 2
else
if (dim==1) then
call MeshFieldCommBase_extract_bounddata( field_list(varid)%field1d%local(n)%val, lcmesh%refElem, lcmesh, buf(:,varid,n) )
else if(dim==2) then
call MeshFieldCommBase_extract_bounddata( field_list(varid)%field2d%local(n)%val, lcmesh%refElem, lcmesh, buf(:,varid,n) )
else if(dim==3) then
call MeshFieldCommBase_extract_bounddata( field_list(varid)%field3d%local(n)%val, lcmesh%refElem, lcmesh, buf(:,varid,n) )
end if
i = i + 1
end if
end do
end do
return
contains
!OCL SERIAL
subroutine extract_bounddata_var2( buf1_, buf2_, var1, var2, lmesh, elem )
implicit none
class(LocalMeshBase), intent(in) :: lmesh
class(ElementBase), intent(in) :: elem
real(RP), intent(out) :: buf1_(size(lmesh%VMapB))
real(RP), intent(out) :: buf2_(size(lmesh%VMapB))
real(RP), intent(inout) :: var1(elem%Np*lmesh%NeA)
real(RP), intent(inout) :: var2(elem%Np*lmesh%NeA)

integer :: ii
!-----------------------------
!$omp parallel do
!OCL PREFETCH
do ii=1, size(buf)
buf1_(ii) = var1(lmesh%vmapB(ii))
buf2_(ii) = var2(lmesh%vmapB(ii))
end do
return
end subroutine extract_bounddata_var2
end subroutine MeshFieldCommBase_extract_bounddata_2

!> Extract halo data from the recieving buffer and set it to data array with MeshField object
subroutine MeshFieldCommBase_set_bounddata(buf, refElem, mesh, var)
implicit none
Expand Down Expand Up @@ -506,8 +625,8 @@ subroutine LocalMeshCommData_Init( this, comm, lcmesh, faceID, Nnode_LCMeshFace
end subroutine LocalMeshCommData_Init

subroutine LocalMeshCommData_SendRecv( this, &
req_counter, req_send, req_recv, &
lccommdat_list )
req_counter, req_send, req_recv, &
lccommdat_list )

use scale_prc, only: &
PRC_LOCAL_COMM_WORLD
Expand Down
53 changes: 28 additions & 25 deletions FElib/src/data/scale_meshfieldcomm_cubedom3d.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,7 @@ module scale_meshfieldcomm_cubedom3d
MeshFieldCommBase, &
MeshFieldCommBase_Init, MeshFieldCommBase_Final, &
MeshFieldCommBase_extract_bounddata, &
MeshFieldCommBase_extract_bounddata_2, &
MeshFieldCommBase_set_bounddata, &
MeshFieldContainer
use scale_localmesh_3d, only: Localmesh3d
Expand Down Expand Up @@ -117,21 +118,22 @@ subroutine MeshFieldCommCubeDom3D_put(this, field_list, varid_s)
type(MeshFieldContainer), intent(in) :: field_list(:)
integer, intent(in) :: varid_s

integer :: i
integer :: n
type(LocalMesh3d), pointer :: lcmesh
integer :: field_num
! integer :: i
! integer :: n
! type(LocalMesh3d), pointer :: lcmesh
! integer :: field_num
!-----------------------------------------------------------------------------

! call PROF_rapstart( 'meshfiled_comm_put', 3)
field_num = size(field_list)
do n=1, this%mesh%LOCAL_MESH_NUM
lcmesh => this%mesh3d%lcmesh_list(n)
do i=1, field_num
call MeshFieldCommBase_extract_bounddata( field_list(i)%field3d%local(n)%val, lcmesh%refElem, lcmesh, & ! (in)
this%send_buf(:,varid_s+i-1,n) ) ! (out)
end do
end do
! field_num = size(field_list)
! do n=1, this%mesh%LOCAL_MESH_NUM
! lcmesh => this%mesh3d%lcmesh_list(n)
! do i=1, field_num
! call MeshFieldCommBase_extract_bounddata( field_list(i)%field3d%local(n)%val, lcmesh%refElem, lcmesh, & ! (in)
! this%send_buf(:,varid_s+i-1,n) ) ! (out)
! end do
! end do
call MeshFieldCommBase_extract_bounddata_2( field_list, 3, varid_s, this%mesh3d%lcmesh_list, this%send_buf )
! call PROF_rapend( 'meshfiled_comm_put', 3)

return
Expand All @@ -152,21 +154,22 @@ subroutine MeshFieldCommCubeDom3D_get(this, field_list, varid_s)
!-----------------------------------------------------------------------------

if ( this%call_wait_flag_sub_get ) then
! call PROF_rapstart( 'meshfiled_comm_get_wait', 3)
call MeshFieldCommBase_wait_core( this, this%commdata_list )
! call PROF_rapend( 'meshfiled_comm_get_wait', 3)
! call PROF_rapstart( 'meshfiled_comm_wait_get', 2)
call MeshFieldCommBase_wait_core( this, this%commdata_list, &
field_list, 3, varid_s, this%mesh3d%lcmesh_list )
! call PROF_rapend( 'meshfiled_comm_wait_get', 2)
else
! call PROF_rapstart( 'meshfiled_comm_get', 2)
do i=1, size(field_list)
do n=1, this%mesh3d%LOCAL_MESH_NUM
lcmesh => this%mesh3d%lcmesh_list(n)
call MeshFieldCommBase_set_bounddata( this%recv_buf(:,varid_s+i-1,n), lcmesh%refElem, lcmesh, & !(in)
field_list(i)%field3d%local(n)%val ) !(out)
end do
end do
! call PROF_rapend( 'meshfiled_comm_get', 2)
end if

! call PROF_rapstart( 'meshfiled_comm_get', 3)
do i=1, size(field_list)
do n=1, this%mesh3d%LOCAL_MESH_NUM
lcmesh => this%mesh3d%lcmesh_list(n)
call MeshFieldCommBase_set_bounddata( this%recv_buf(:,varid_s+i-1,n), lcmesh%refElem, lcmesh, & !(in)
field_list(i)%field3d%local(n)%val ) !(out)
end do
end do
! call PROF_rapend( 'meshfiled_comm_get', 3)

return
end subroutine MeshFieldCommCubeDom3D_get

Expand Down
Loading