Skip to content

Commit 6d39682

Browse files
abbottsmax-Hawkins
abbotts
authored and
max-Hawkins
committed
Cray workaround removal (MFlowCode#700)
1 parent ad5e331 commit 6d39682

24 files changed

+417
-932
lines changed

‎CMakeLists.txt‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -147,11 +147,11 @@ if (CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
147147
endif()
148148
elseif (CMAKE_Fortran_COMPILER_ID STREQUAL "Cray")
149149
add_compile_options(
150-
"SHELL:-h nomessage=296:878:1391:1069"
150+
"SHELL:-M 296,878,1391,1069,5025"
151151
"SHELL:-h static" "SHELL:-h keepfiles"
152152
"SHELL:-h acc_model=auto_async_none"
153153
"SHELL: -h acc_model=no_fast_addr"
154-
"SHELL: -h list=adm" "-DCRAY_ACC_SIMPLIFY" "-DCRAY_ACC_WAR"
154+
"SHELL: -h list=adm"
155155
)
156156

157157
add_link_options("SHELL:-hkeepfiles")

‎src/common/include/macros.fpp‎

Lines changed: 7 additions & 47 deletions
Original file line numberDiff line numberDiff line change
@@ -13,71 +13,31 @@
1313
#:def ALLOCATE(*args)
1414
@:LOG({'@:ALLOCATE(${re.sub(' +', ' ', ', '.join(args))}$)'})
1515
allocate (${', '.join(args)}$)
16-
#ifndef CRAY_ACC_WAR
17-
!$acc enter data create(${', '.join(args)}$)
18-
#endif
16+
!$acc enter data create(${', '.join(args)}$)
1917
#:enddef ALLOCATE
2018

2119
#:def DEALLOCATE(*args)
2220
@:LOG({'@:DEALLOCATE(${re.sub(' +', ' ', ', '.join(args))}$)'})
2321
deallocate (${', '.join(args)}$)
24-
#ifndef CRAY_ACC_WAR
25-
!$acc exit data delete(${', '.join(args)}$)
26-
#endif
22+
!$acc exit data delete(${', '.join(args)}$)
2723
#:enddef DEALLOCATE
2824

2925
#:def ALLOCATE_GLOBAL(*args)
3026
@:LOG({'@:ALLOCATE_GLOBAL(${re.sub(' +', ' ', ', '.join(args))}$)'})
31-
#ifdef CRAY_ACC_WAR
32-
allocate (${', '.join(('p_' + arg.strip() for arg in args))}$)
33-
#:for arg in args
34-
${re.sub('\\(.*\\)','',arg)}$ => ${ 'p_' + re.sub('\\(.*\\)','',arg.strip()) }$
35-
#:endfor
36-
!$acc enter data create(${', '.join(('p_' + re.sub('\\(.*\\)','',arg.strip()) for arg in args))}$) &
37-
!$acc& attach(${', '.join(map(lambda x: re.sub('\\(.*\\)','',x), args))}$)
38-
#else
27+
3928
allocate (${', '.join(args)}$)
40-
!$acc enter data create(${', '.join(args)}$)
41-
#endif
4229

4330
#:enddef ALLOCATE_GLOBAL
4431

4532
#:def DEALLOCATE_GLOBAL(*args)
4633
@:LOG({'@:DEALLOCATE_GLOBAL(${re.sub(' +', ' ', ', '.join(args))}$)'})
47-
#ifdef CRAY_ACC_WAR
48-
!$acc exit data delete(${', '.join(('p_' + arg.strip() for arg in args))}$) &
49-
!$acc& detach(${', '.join(args)}$)
50-
#:for arg in args
51-
nullify (${arg}$)
52-
#:endfor
53-
deallocate (${', '.join(('p_' + arg.strip() for arg in args))}$)
54-
#else
34+
5535
deallocate (${', '.join(args)}$)
56-
!$acc exit data delete(${', '.join(args)}$)
57-
#endif
5836

5937
#:enddef DEALLOCATE_GLOBAL
6038

61-
#:def CRAY_DECLARE_GLOBAL(intype, dim, *args)
62-
#ifdef CRAY_ACC_WAR
63-
${intype}$, ${dim}$, allocatable, target :: ${', '.join(('p_' + arg.strip() for arg in args))}$
64-
${intype}$, ${dim}$, pointer :: ${', '.join(args)}$
65-
#else
66-
${intype}$, ${dim}$, allocatable :: ${', '.join(args)}$
67-
#endif
68-
#:enddef CRAY_DECLARE_GLOBAL
69-
70-
#:def CRAY_DECLARE_GLOBAL_SCALAR(intype, *args)
71-
#ifdef CRAY_ACC_WAR
72-
${intype}$, target :: ${', '.join(('p_' + arg.strip() for arg in args))}$
73-
${intype}$, pointer :: ${', '.join(args)}$
74-
#else
75-
${intype}$::${', '.join(args)}$
76-
#endif
77-
#:enddef CRAY_DECLARE_GLOBAL_SCALAR
78-
7939
#:def ACC_SETUP_VFs(*args)
80-
#ifdef CRAY_ACC_WAR
40+
#ifdef _CRAYFTN
8141
block
8242
integer :: macros_setup_vfs_i
8343

@@ -100,7 +60,7 @@
10060
#:enddef
10161

10262
#:def ACC_SETUP_SFs(*args)
103-
#ifdef CRAY_ACC_WAR
63+
#ifdef _CRAYFTN
10464
block
10565

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

11878
#:def ACC_SETUP_source_spatials(*args)
119-
#ifdef CRAY_ACC_WAR
79+
#ifdef _CRAYFTN
12080
block
12181

12282
@:LOG({'@:ACC_SETUP_source_spatials(${', '.join(args)}$)'})

‎src/common/m_phase_change.fpp‎

Lines changed: 21 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -34,21 +34,6 @@ module m_phase_change
3434
s_infinite_relaxation_k, &
3535
s_finalize_relaxation_solver_module
3636

37-
!> @name Abstract interface for creating function pointers
38-
!> @{
39-
abstract interface
40-
41-
!> @name Abstract subroutine for the infinite relaxation solver
42-
!> @{
43-
subroutine s_abstract_relaxation_solver(q_cons_vf)
44-
import :: scalar_field, sys_size
45-
type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
46-
end subroutine
47-
!> @}
48-
49-
end interface
50-
!> @}
51-
5237
!> @name Parameters for the first order transition phase change
5338
!> @{
5439
integer, parameter :: max_iter = 1e8 !< max # of iterations
@@ -66,10 +51,18 @@ module m_phase_change
6651

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

69-
procedure(s_abstract_relaxation_solver), pointer :: s_relaxation_solver => null()
70-
7154
contains
7255

56+
!> This subroutine should dispatch to the correct relaxation solver based
57+
!! some parameter. It replaces the procedure pointer, which CCE
58+
!! is breaking on.
59+
subroutine s_relaxation_solver(q_cons_vf)
60+
type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
61+
! This is empty because in current master the procedure pointer
62+
! was never assigned
63+
@:ASSERT(.false., "s_relaxation_solver called but it currently does nothing")
64+
end subroutine s_relaxation_solver
65+
7366
!> The purpose of this subroutine is to initialize the phase change module
7467
!! by setting the parameters needed for phase change and
7568
!! selecting the phase change module that will be used
@@ -298,8 +291,9 @@ contains
298291
!! @param rhoe mixture energy
299292
!! @param TS equilibrium temperature at the interface
300293
subroutine s_infinite_pt_relaxation_k(j, k, l, MFL, pS, p_infpT, rM, q_cons_vf, rhoe, TS)
301-
#ifdef CRAY_ACC_WAR
302-
!DIR$ INLINEALWAYS s_compute_speed_of_sound
294+
295+
#ifdef _CRAYFTN
296+
!DIR$ INLINEALWAYS s_infinite_pt_relaxation_k
303297
#else
304298
!$acc routine seq
305299
#endif
@@ -404,7 +398,7 @@ contains
404398
!! @param TS equilibrium temperature at the interface
405399
subroutine s_infinite_ptg_relaxation_k(j, k, l, pS, p_infpT, rhoe, q_cons_vf, TS)
406400

407-
#ifdef CRAY_ACC_WAR
401+
#ifdef _CRAYFTN
408402
!DIR$ INLINEALWAYS s_infinite_ptg_relaxation_k
409403
#else
410404
!$acc routine seq
@@ -528,7 +522,8 @@ contains
528522
!! @param k generic loop iterator for y direction
529523
!! @param l generic loop iterator for z direction
530524
subroutine s_correct_partial_densities(MCT, q_cons_vf, rM, j, k, l)
531-
#ifdef CRAY_ACC_WAR
525+
526+
#ifdef _CRAYFTN
532527
!DIR$ INLINEALWAYS s_correct_partial_densities
533528
#else
534529
!$acc routine seq
@@ -591,7 +586,7 @@ contains
591586
!! @param TJac Transpose of the Jacobian Matrix
592587
subroutine s_compute_jacobian_matrix(InvJac, j, Jac, k, l, mCPD, mCVGP, mCVGP2, pS, q_cons_vf, TJac)
593588
594-
#ifdef CRAY_ACC_WAR
589+
#ifdef _CRAYFTN
595590
!DIR$ INLINEALWAYS s_compute_jacobian_matrix
596591
#else
597592
!$acc routine seq
@@ -698,7 +693,7 @@ contains
698693
!! @param R2D (2D) residue array
699694
subroutine s_compute_pTg_residue(j, k, l, mCPD, mCVGP, mQD, q_cons_vf, pS, rhoe, R2D)
700695
701-
#ifdef CRAY_ACC_WAR
696+
#ifdef _CRAYFTN
702697
!DIR$ INLINEALWAYS s_compute_pTg_residue
703698
#else
704699
!$acc routine seq
@@ -748,8 +743,9 @@ contains
748743
!! @param TSat Saturation Temperature
749744
!! @param TSIn equilibrium Temperature
750745
subroutine s_TSat(pSat, TSat, TSIn)
751-
#ifdef CRAY_ACC_WAR
752-
!DIR$ INLINEALWAYS s_compute_speed_of_sound
746+
747+
#ifdef _CRAYFTN
748+
!DIR$ INLINEALWAYS s_TSat
753749
#else
754750
!$acc routine seq
755751
#endif

‎src/common/m_variables_conversion.fpp‎

Lines changed: 42 additions & 67 deletions
Original file line numberDiff line numberDiff line change
@@ -49,57 +49,17 @@ module m_variables_conversion
4949
#endif
5050
s_finalize_variables_conversion_module
5151

52-
!> Abstract interface to two subroutines designed for the transfer/conversion
53-
!! of the mixture/species variables to the mixture variables
54-
55-
abstract interface ! =======================================================
56-
57-
!> Structure of the s_convert_mixture_to_mixture_variables
58-
!! and s_convert_species_to_mixture_variables subroutines
59-
!! @param q_vf Conservative or primitive variables
60-
!! @param i First-coordinate cell index
61-
!! @param j First-coordinate cell index
62-
!! @param k First-coordinate cell index
63-
!! @param rho Density
64-
!! @param gamma Specific heat ratio function
65-
!! @param pi_inf Liquid stiffness function
66-
!! @param qv Fluid reference energy
67-
subroutine s_convert_xxxxx_to_mixture_variables(q_vf, i, j, k, &
68-
rho, gamma, pi_inf, qv, Re_K, G_K, G)
69-
70-
! Importing the derived type scalar_field from m_derived_types.f90
71-
! and global variable sys_size, from m_global_variables.f90, as
72-
! the abstract interface does not inherently have access to them
73-
import :: scalar_field, sys_size, num_fluids
74-
75-
type(scalar_field), dimension(sys_size), intent(in) :: q_vf
76-
integer, intent(in) :: i, j, k
77-
real(kind(0d0)), intent(out), target :: rho, gamma, pi_inf, qv
78-
real(kind(0d0)), optional, dimension(2), intent(out) :: Re_K
79-
real(kind(0d0)), optional, intent(out) :: G_K
80-
real(kind(0d0)), optional, dimension(num_fluids), intent(in) :: G
81-
82-
end subroutine s_convert_xxxxx_to_mixture_variables
83-
84-
end interface ! ============================================================
85-
8652
!! In simulation, gammas, pi_infs, and qvs are already declared in m_global_variables
8753
#ifndef MFC_SIMULATION
8854
real(kind(0d0)), allocatable, public, dimension(:) :: gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps
8955
!$acc declare create(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps)
9056
#endif
9157

92-
#ifdef CRAY_ACC_WAR
93-
@:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), Gs)
94-
@:CRAY_DECLARE_GLOBAL(integer, dimension(:), bubrs)
95-
@:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), Res)
96-
!$acc declare link(bubrs, Gs, Res)
97-
#else
9858
real(kind(0d0)), allocatable, dimension(:) :: Gs
9959
integer, allocatable, dimension(:) :: bubrs
10060
real(kind(0d0)), allocatable, dimension(:, :) :: Res
10161
!$acc declare create(bubrs, Gs, Res)
102-
#endif
62+
10363
integer :: is1b, is2b, is3b, is1e, is2e, is3e
10464
!$acc declare create(is1b, is2b, is3b, is1e, is2e, is3e)
10565

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

111-
procedure(s_convert_xxxxx_to_mixture_variables), &
112-
pointer :: s_convert_to_mixture_variables => null() !<
113-
!! Pointer referencing the subroutine s_convert_mixture_to_mixture_variables
114-
!! or s_convert_species_to_mixture_variables, based on model equations choice
115-
11671
contains
11772

73+
!> Dispatch to the s_convert_mixture_to_mixture_variables
74+
!! and s_convert_species_to_mixture_variables subroutines.
75+
!! Replaces a procedure pointer.
76+
!! @param q_vf Conservative or primitive variables
77+
!! @param i First-coordinate cell index
78+
!! @param j First-coordinate cell index
79+
!! @param k First-coordinate cell index
80+
!! @param rho Density
81+
!! @param gamma Specific heat ratio function
82+
!! @param pi_inf Liquid stiffness function
83+
!! @param qv Fluid reference energy
84+
subroutine s_convert_to_mixture_variables(q_vf, i, j, k, &
85+
rho, gamma, pi_inf, qv, Re_K, G_K, G)
86+
87+
type(scalar_field), dimension(sys_size), intent(in) :: q_vf
88+
integer, intent(in) :: i, j, k
89+
real(kind(0d0)), intent(out), target :: rho, gamma, pi_inf, qv
90+
real(kind(0d0)), optional, dimension(2), intent(out) :: Re_K
91+
real(kind(0d0)), optional, intent(out) :: G_K
92+
real(kind(0d0)), optional, dimension(num_fluids), intent(in) :: G
93+
94+
if (model_eqns == 1) then ! Gamma/pi_inf model
95+
call s_convert_mixture_to_mixture_variables(q_vf, i, j, k, &
96+
rho, gamma, pi_inf, qv, Re_K, G_K, G)
97+
98+
else if (bubbles) then
99+
call s_convert_species_to_mixture_variables_bubbles(q_vf, i, j, k, &
100+
rho, gamma, pi_inf, qv, Re_K, G_K, G)
101+
else
102+
! Volume fraction model
103+
call s_convert_species_to_mixture_variables(q_vf, i, j, k, &
104+
rho, gamma, pi_inf, qv, Re_K, G_K, G)
105+
end if
106+
107+
end subroutine s_convert_to_mixture_variables
108+
118109
!> This procedure conditionally calculates the appropriate pressure
119110
!! @param energy Energy
120111
!! @param alf Void Fraction
@@ -128,7 +119,7 @@ contains
128119
!! @param mom Momentum
129120
subroutine s_compute_pressure(energy, alf, dyn_p, pi_inf, gamma, rho, qv, rhoYks, pres, T, stress, mom, G)
130121

131-
#ifdef CRAY_ACC_WAR
122+
#ifdef _CRAYFTN
132123
!DIR$ INLINEALWAYS s_compute_pressure
133124
#else
134125
!$acc routine seq
@@ -473,7 +464,7 @@ contains
473464
gamma_K, pi_inf_K, qv_K, &
474465
alpha_K, alpha_rho_K, Re_K, k, l, r, &
475466
G_K, G)
476-
#ifdef CRAY_ACC_WAR
467+
#ifdef _CRAYFTN
477468
!DIR$ INLINEALWAYS s_convert_species_to_mixture_variables_acc
478469
#else
479470
!$acc routine seq
@@ -555,7 +546,7 @@ contains
555546
subroutine s_convert_species_to_mixture_variables_bubbles_acc(rho_K, &
556547
gamma_K, pi_inf_K, qv_K, &
557548
alpha_K, alpha_rho_K, Re_K, k, l, r)
558-
#ifdef CRAY_ACC_WAR
549+
#ifdef _CRAYFTN
559550
!DIR$ INLINEALWAYS s_convert_species_to_mixture_variables_bubbles_acc
560551
#else
561552
!$acc routine seq
@@ -748,18 +739,6 @@ contains
748739
end if
749740
#endif
750741

751-
if (model_eqns == 1) then ! Gamma/pi_inf model
752-
s_convert_to_mixture_variables => &
753-
s_convert_mixture_to_mixture_variables
754-
755-
else if (bubbles) then
756-
s_convert_to_mixture_variables => &
757-
s_convert_species_to_mixture_variables_bubbles
758-
else
759-
! Volume fraction model
760-
s_convert_to_mixture_variables => &
761-
s_convert_species_to_mixture_variables
762-
end if
763742
end subroutine s_initialize_variables_conversion_module
764743

765744
!Initialize mv at the quadrature nodes based on the initialized moments and sigma
@@ -1393,15 +1372,11 @@ contains
13931372
end if
13941373
#endif
13951374

1396-
! Nullifying the procedure pointer to the subroutine transferring/
1397-
! computing the mixture/species variables to the mixture variables
1398-
s_convert_to_mixture_variables => null()
1399-
14001375
end subroutine s_finalize_variables_conversion_module
14011376

14021377
#ifndef MFC_PRE_PROCESS
1403-
subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c_c, c)
1404-
#ifdef CRAY_ACC_WAR
1378+
pure subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c_c, c)
1379+
#ifdef _CRAYFTN
14051380
!DIR$ INLINEALWAYS s_compute_speed_of_sound
14061381
#else
14071382
!$acc routine seq

0 commit comments

Comments
 (0)