Skip to content

Commit

Permalink
Cray workaround removal (#700)
Browse files Browse the repository at this point in the history
  • Loading branch information
@abbotts
abbotts authored Nov 8, 2024
1 parent 9700eb5 commit 1e27e8b
Show file tree
Hide file tree
Showing 24 changed files with 417 additions and 932 deletions.
4 changes: 2 additions & 2 deletions CMakeLists.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -147,11 +147,11 @@ if (CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
endif()
elseif (CMAKE_Fortran_COMPILER_ID STREQUAL "Cray")
add_compile_options(
"SHELL:-h nomessage=296:878:1391:1069"
"SHELL:-M 296,878,1391,1069,5025"
"SHELL:-h static" "SHELL:-h keepfiles"
"SHELL:-h acc_model=auto_async_none"
"SHELL: -h acc_model=no_fast_addr"
"SHELL: -h list=adm" "-DCRAY_ACC_SIMPLIFY" "-DCRAY_ACC_WAR"
"SHELL: -h list=adm"
)

add_link_options("SHELL:-hkeepfiles")
Expand Down
54 changes: 7 additions & 47 deletions src/common/include/macros.fpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,71 +13,31 @@
#:def ALLOCATE(*args)
@:LOG({'@:ALLOCATE(${re.sub(' +', ' ', ', '.join(args))}$)'})
allocate (${', '.join(args)}$)
#ifndef CRAY_ACC_WAR
!$acc enter data create(${', '.join(args)}$)
#endif
!$acc enter data create(${', '.join(args)}$)
#:enddef ALLOCATE

#:def DEALLOCATE(*args)
@:LOG({'@:DEALLOCATE(${re.sub(' +', ' ', ', '.join(args))}$)'})
deallocate (${', '.join(args)}$)
#ifndef CRAY_ACC_WAR
!$acc exit data delete(${', '.join(args)}$)
#endif
!$acc exit data delete(${', '.join(args)}$)
#:enddef DEALLOCATE

#:def ALLOCATE_GLOBAL(*args)
@:LOG({'@:ALLOCATE_GLOBAL(${re.sub(' +', ' ', ', '.join(args))}$)'})
#ifdef CRAY_ACC_WAR
allocate (${', '.join(('p_' + arg.strip() for arg in args))}$)
#:for arg in args
${re.sub('\\(.*\\)','',arg)}$ => ${ 'p_' + re.sub('\\(.*\\)','',arg.strip()) }$
#:endfor
!$acc enter data create(${', '.join(('p_' + re.sub('\\(.*\\)','',arg.strip()) for arg in args))}$) &
!$acc& attach(${', '.join(map(lambda x: re.sub('\\(.*\\)','',x), args))}$)
#else

allocate (${', '.join(args)}$)
!$acc enter data create(${', '.join(args)}$)
#endif

#:enddef ALLOCATE_GLOBAL

#:def DEALLOCATE_GLOBAL(*args)
@:LOG({'@:DEALLOCATE_GLOBAL(${re.sub(' +', ' ', ', '.join(args))}$)'})
#ifdef CRAY_ACC_WAR
!$acc exit data delete(${', '.join(('p_' + arg.strip() for arg in args))}$) &
!$acc& detach(${', '.join(args)}$)
#:for arg in args
nullify (${arg}$)
#:endfor
deallocate (${', '.join(('p_' + arg.strip() for arg in args))}$)
#else

deallocate (${', '.join(args)}$)
!$acc exit data delete(${', '.join(args)}$)
#endif

#:enddef DEALLOCATE_GLOBAL

#:def CRAY_DECLARE_GLOBAL(intype, dim, *args)
#ifdef CRAY_ACC_WAR
${intype}$, ${dim}$, allocatable, target :: ${', '.join(('p_' + arg.strip() for arg in args))}$
${intype}$, ${dim}$, pointer :: ${', '.join(args)}$
#else
${intype}$, ${dim}$, allocatable :: ${', '.join(args)}$
#endif
#:enddef CRAY_DECLARE_GLOBAL

#:def CRAY_DECLARE_GLOBAL_SCALAR(intype, *args)
#ifdef CRAY_ACC_WAR
${intype}$, target :: ${', '.join(('p_' + arg.strip() for arg in args))}$
${intype}$, pointer :: ${', '.join(args)}$
#else
${intype}$::${', '.join(args)}$
#endif
#:enddef CRAY_DECLARE_GLOBAL_SCALAR

#:def ACC_SETUP_VFs(*args)
#ifdef CRAY_ACC_WAR
#ifdef _CRAYFTN
block
integer :: macros_setup_vfs_i

Expand All @@ -100,7 +60,7 @@
#:enddef

#:def ACC_SETUP_SFs(*args)
#ifdef CRAY_ACC_WAR
#ifdef _CRAYFTN
block

@:LOG({'@:ACC_SETUP_SFs(${', '.join(args)}$)'})
Expand All @@ -116,7 +76,7 @@
#:enddef

#:def ACC_SETUP_source_spatials(*args)
#ifdef CRAY_ACC_WAR
#ifdef _CRAYFTN
block

@:LOG({'@:ACC_SETUP_source_spatials(${', '.join(args)}$)'})
Expand Down
46 changes: 21 additions & 25 deletions src/common/m_phase_change.fpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,21 +34,6 @@ module m_phase_change
s_infinite_relaxation_k, &
s_finalize_relaxation_solver_module

!> @name Abstract interface for creating function pointers
!> @{
abstract interface

!> @name Abstract subroutine for the infinite relaxation solver
!> @{
subroutine s_abstract_relaxation_solver(q_cons_vf)
import :: scalar_field, sys_size
type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
end subroutine
!> @}

end interface
!> @}

!> @name Parameters for the first order transition phase change
!> @{
integer, parameter :: max_iter = 1e8 !< max # of iterations
Expand All @@ -66,10 +51,18 @@ module m_phase_change

!$acc declare create(max_iter,pCr,TCr,mixM,lp,vp,A,B,C,D)

procedure(s_abstract_relaxation_solver), pointer :: s_relaxation_solver => null()

contains

!> This subroutine should dispatch to the correct relaxation solver based
!! some parameter. It replaces the procedure pointer, which CCE
!! is breaking on.
subroutine s_relaxation_solver(q_cons_vf)
type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
! This is empty because in current master the procedure pointer
! was never assigned
@:ASSERT(.false., "s_relaxation_solver called but it currently does nothing")
end subroutine s_relaxation_solver

!> The purpose of this subroutine is to initialize the phase change module
!! by setting the parameters needed for phase change and
!! selecting the phase change module that will be used
Expand Down Expand Up @@ -298,8 +291,9 @@ contains
!! @param rhoe mixture energy
!! @param TS equilibrium temperature at the interface
subroutine s_infinite_pt_relaxation_k(j, k, l, MFL, pS, p_infpT, rM, q_cons_vf, rhoe, TS)
#ifdef CRAY_ACC_WAR
!DIR$ INLINEALWAYS s_compute_speed_of_sound

#ifdef _CRAYFTN
!DIR$ INLINEALWAYS s_infinite_pt_relaxation_k
#else
!$acc routine seq
#endif
Expand Down Expand Up @@ -404,7 +398,7 @@ contains
!! @param TS equilibrium temperature at the interface
subroutine s_infinite_ptg_relaxation_k(j, k, l, pS, p_infpT, rhoe, q_cons_vf, TS)

#ifdef CRAY_ACC_WAR
#ifdef _CRAYFTN
!DIR$ INLINEALWAYS s_infinite_ptg_relaxation_k
#else
!$acc routine seq
Expand Down Expand Up @@ -528,7 +522,8 @@ contains
!! @param k generic loop iterator for y direction
!! @param l generic loop iterator for z direction
subroutine s_correct_partial_densities(MCT, q_cons_vf, rM, j, k, l)
#ifdef CRAY_ACC_WAR
#ifdef _CRAYFTN
!DIR$ INLINEALWAYS s_correct_partial_densities
#else
!$acc routine seq
Expand Down Expand Up @@ -591,7 +586,7 @@ contains
!! @param TJac Transpose of the Jacobian Matrix
subroutine s_compute_jacobian_matrix(InvJac, j, Jac, k, l, mCPD, mCVGP, mCVGP2, pS, q_cons_vf, TJac)
#ifdef CRAY_ACC_WAR
#ifdef _CRAYFTN
!DIR$ INLINEALWAYS s_compute_jacobian_matrix
#else
!$acc routine seq
Expand Down Expand Up @@ -698,7 +693,7 @@ contains
!! @param R2D (2D) residue array
subroutine s_compute_pTg_residue(j, k, l, mCPD, mCVGP, mQD, q_cons_vf, pS, rhoe, R2D)
#ifdef CRAY_ACC_WAR
#ifdef _CRAYFTN
!DIR$ INLINEALWAYS s_compute_pTg_residue
#else
!$acc routine seq
Expand Down Expand Up @@ -748,8 +743,9 @@ contains
!! @param TSat Saturation Temperature
!! @param TSIn equilibrium Temperature
subroutine s_TSat(pSat, TSat, TSIn)
#ifdef CRAY_ACC_WAR
!DIR$ INLINEALWAYS s_compute_speed_of_sound
#ifdef _CRAYFTN
!DIR$ INLINEALWAYS s_TSat
#else
!$acc routine seq
#endif
Expand Down
109 changes: 42 additions & 67 deletions src/common/m_variables_conversion.fpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -49,57 +49,17 @@ module m_variables_conversion
#endif
s_finalize_variables_conversion_module

!> Abstract interface to two subroutines designed for the transfer/conversion
!! of the mixture/species variables to the mixture variables

abstract interface ! =======================================================

!> Structure of the s_convert_mixture_to_mixture_variables
!! and s_convert_species_to_mixture_variables subroutines
!! @param q_vf Conservative or primitive variables
!! @param i First-coordinate cell index
!! @param j First-coordinate cell index
!! @param k First-coordinate cell index
!! @param rho Density
!! @param gamma Specific heat ratio function
!! @param pi_inf Liquid stiffness function
!! @param qv Fluid reference energy
subroutine s_convert_xxxxx_to_mixture_variables(q_vf, i, j, k, &
rho, gamma, pi_inf, qv, Re_K, G_K, G)

! Importing the derived type scalar_field from m_derived_types.f90
! and global variable sys_size, from m_global_variables.f90, as
! the abstract interface does not inherently have access to them
import :: scalar_field, sys_size, num_fluids

type(scalar_field), dimension(sys_size), intent(in) :: q_vf
integer, intent(in) :: i, j, k
real(kind(0d0)), intent(out), target :: rho, gamma, pi_inf, qv
real(kind(0d0)), optional, dimension(2), intent(out) :: Re_K
real(kind(0d0)), optional, intent(out) :: G_K
real(kind(0d0)), optional, dimension(num_fluids), intent(in) :: G

end subroutine s_convert_xxxxx_to_mixture_variables

end interface ! ============================================================

!! In simulation, gammas, pi_infs, and qvs are already declared in m_global_variables
#ifndef MFC_SIMULATION
real(kind(0d0)), allocatable, public, dimension(:) :: gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps
!$acc declare create(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps)
#endif

#ifdef CRAY_ACC_WAR
@:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), Gs)
@:CRAY_DECLARE_GLOBAL(integer, dimension(:), bubrs)
@:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), Res)
!$acc declare link(bubrs, Gs, Res)
#else
real(kind(0d0)), allocatable, dimension(:) :: Gs
integer, allocatable, dimension(:) :: bubrs
real(kind(0d0)), allocatable, dimension(:, :) :: Res
!$acc declare create(bubrs, Gs, Res)
#endif

integer :: is1b, is2b, is3b, is1e, is2e, is3e
!$acc declare create(is1b, is2b, is3b, is1e, is2e, is3e)

Expand All @@ -108,13 +68,44 @@ module m_variables_conversion
real(kind(0d0)), allocatable, dimension(:, :, :), public :: pi_inf_sf !< Scalar liquid stiffness function
real(kind(0d0)), allocatable, dimension(:, :, :), public :: qv_sf !< Scalar liquid energy reference function

procedure(s_convert_xxxxx_to_mixture_variables), &
pointer :: s_convert_to_mixture_variables => null() !<
!! Pointer referencing the subroutine s_convert_mixture_to_mixture_variables
!! or s_convert_species_to_mixture_variables, based on model equations choice

contains

!> Dispatch to the s_convert_mixture_to_mixture_variables
!! and s_convert_species_to_mixture_variables subroutines.
!! Replaces a procedure pointer.
!! @param q_vf Conservative or primitive variables
!! @param i First-coordinate cell index
!! @param j First-coordinate cell index
!! @param k First-coordinate cell index
!! @param rho Density
!! @param gamma Specific heat ratio function
!! @param pi_inf Liquid stiffness function
!! @param qv Fluid reference energy
subroutine s_convert_to_mixture_variables(q_vf, i, j, k, &
rho, gamma, pi_inf, qv, Re_K, G_K, G)

type(scalar_field), dimension(sys_size), intent(in) :: q_vf
integer, intent(in) :: i, j, k
real(kind(0d0)), intent(out), target :: rho, gamma, pi_inf, qv
real(kind(0d0)), optional, dimension(2), intent(out) :: Re_K
real(kind(0d0)), optional, intent(out) :: G_K
real(kind(0d0)), optional, dimension(num_fluids), intent(in) :: G

if (model_eqns == 1) then ! Gamma/pi_inf model
call s_convert_mixture_to_mixture_variables(q_vf, i, j, k, &
rho, gamma, pi_inf, qv, Re_K, G_K, G)

else if (bubbles) then
call s_convert_species_to_mixture_variables_bubbles(q_vf, i, j, k, &
rho, gamma, pi_inf, qv, Re_K, G_K, G)
else
! Volume fraction model
call s_convert_species_to_mixture_variables(q_vf, i, j, k, &
rho, gamma, pi_inf, qv, Re_K, G_K, G)
end if

end subroutine s_convert_to_mixture_variables

!> This procedure conditionally calculates the appropriate pressure
!! @param energy Energy
!! @param alf Void Fraction
Expand All @@ -128,7 +119,7 @@ contains
!! @param mom Momentum
subroutine s_compute_pressure(energy, alf, dyn_p, pi_inf, gamma, rho, qv, rhoYks, pres, T, stress, mom, G)

#ifdef CRAY_ACC_WAR
#ifdef _CRAYFTN
!DIR$ INLINEALWAYS s_compute_pressure
#else
!$acc routine seq
Expand Down Expand Up @@ -473,7 +464,7 @@ contains
gamma_K, pi_inf_K, qv_K, &
alpha_K, alpha_rho_K, Re_K, k, l, r, &
G_K, G)
#ifdef CRAY_ACC_WAR
#ifdef _CRAYFTN
!DIR$ INLINEALWAYS s_convert_species_to_mixture_variables_acc
#else
!$acc routine seq
Expand Down Expand Up @@ -555,7 +546,7 @@ contains
subroutine s_convert_species_to_mixture_variables_bubbles_acc(rho_K, &
gamma_K, pi_inf_K, qv_K, &
alpha_K, alpha_rho_K, Re_K, k, l, r)
#ifdef CRAY_ACC_WAR
#ifdef _CRAYFTN
!DIR$ INLINEALWAYS s_convert_species_to_mixture_variables_bubbles_acc
#else
!$acc routine seq
Expand Down Expand Up @@ -748,18 +739,6 @@ contains
end if
#endif

if (model_eqns == 1) then ! Gamma/pi_inf model
s_convert_to_mixture_variables => &
s_convert_mixture_to_mixture_variables

else if (bubbles) then
s_convert_to_mixture_variables => &
s_convert_species_to_mixture_variables_bubbles
else
! Volume fraction model
s_convert_to_mixture_variables => &
s_convert_species_to_mixture_variables
end if
end subroutine s_initialize_variables_conversion_module

!Initialize mv at the quadrature nodes based on the initialized moments and sigma
Expand Down Expand Up @@ -1393,15 +1372,11 @@ contains
end if
#endif

! Nullifying the procedure pointer to the subroutine transferring/
! computing the mixture/species variables to the mixture variables
s_convert_to_mixture_variables => null()

end subroutine s_finalize_variables_conversion_module

#ifndef MFC_PRE_PROCESS
subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c_c, c)
#ifdef CRAY_ACC_WAR
pure subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c_c, c)
#ifdef _CRAYFTN
!DIR$ INLINEALWAYS s_compute_speed_of_sound
#else
!$acc routine seq
Expand Down
Loading

0 comments on commit 1e27e8b

Please sign in to comment.