Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
4 changes: 2 additions & 2 deletions CMakeLists.txt
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
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
Original file line number Diff line number Diff line change
Expand Up @@ -34,21 +34,6 @@
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 @@

!$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)

Check warning on line 59 in src/common/m_phase_change.fpp

View check run for this annotation

Codecov / codecov/patch

src/common/m_phase_change.fpp#L59

Added line #L59 was not covered by tests
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

Check warning on line 64 in src/common/m_phase_change.fpp

View check run for this annotation

Codecov / codecov/patch

src/common/m_phase_change.fpp#L63-L64

Added lines #L63 - L64 were not covered by tests

!> 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 @@
!! @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 @@ -406,7 +400,7 @@
!! @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 @@ -530,7 +524,8 @@
!! @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 @@ -593,7 +588,7 @@
!! @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 @@ -700,7 +695,7 @@
!! @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 @@ -750,8 +745,9 @@
!! @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
Original file line number Diff line number Diff line change
Expand Up @@ -49,57 +49,17 @@
#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 @@
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)

Check warning on line 96 in src/common/m_variables_conversion.fpp

View check run for this annotation

Codecov / codecov/patch

src/common/m_variables_conversion.fpp#L96

Added line #L96 was not covered by tests

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 @@
!! @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 @@
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 @@
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 @@
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 @@
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
Loading