Skip to content
GitLab
Commit 60c72012 authored by Youngsung Kim's avatar Youngsung Kim
Browse files

added acc parallel to all possible loops

parent 3bbfbbbf
Hide whitespace changes
Inline Side-by-side
ocn/gm_compute_Bolus_velocity/mpas_ocn_gm.f90
View file @ 60c72012
......@@ -547,7 +547,6 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
end do
!$acc end parallel
!$omp do schedule(runtime) private(k)
!$omp end do
nEdges = nEdgesArray( 3 )
......@@ -770,21 +769,29 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
else
!$omp do schedule(runtime)
! compilation error
!!$acc parallel loop gang
do iEdge = 1, nEdges
cGMphaseSpeed(iEdge) = config_gravWaveSpeed_trunc
enddo
!!$acc end parallel
!$omp end do
endif
!$omp do schedule(runtime)
! runtime failure
!!$acc parallel loop gang
do iEdge=1,nEdges
kappaGM3D(:,iEdge) = gmBolusKappa(iEdge)
enddo
!!$acc end parallel
!$omp end do
if (config_gm_kappa_lat_depth_variable) then
!$omp do schedule(runtime) private(cell1, cell2, k, BruntVaisalaFreqTopEdge, maxN)
! compilation error
!!$acc parallel loop gang
do iEdge = 1,nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
......@@ -806,12 +813,15 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
BruntVaisalaFreqTopEdge / (maxN + 1.0E-10_RKIND))
enddo
enddo
!!$acc end parallel
!$omp end do
endif
nEdges = nEdgesArray( 3 )
!$omp do schedule(runtime)
! compilation error
!!$acc parallel loop gang
do iEdge = 1, nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
......@@ -861,23 +871,29 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
gmStreamFuncTopOfEdge(2:maxLevelEdgeTop(iEdge), iEdge), N)
end if
end do
!!$acc end parallel
!$omp end do
nEdges = nEdgesArray( 3 )
! Compute normalGMBolusVelocity from the stream function
!$omp do schedule(runtime) private(k)
!$acc parallel loop gang
do iEdge = 1, nEdges
!$acc loop vector
do k = 1, maxLevelEdgeTop(iEdge)
normalGMBolusVelocity(k,iEdge) = (gmStreamFuncTopOfEdge(k,iEdge) - gmStreamFuncTopOfEdge(k+1,iEdge)) &
/ layerThicknessEdge(k,iEdge)
end do
end do
!$acc end parallel
!$omp end do
nCells = nCellsArray( 1 )
! Interpolate gmStreamFuncTopOfEdge to cell centers for visualization
!$omp do schedule(runtime) private(i, iEdge, areaEdge, k, rtmp)
! verification failure
!!$acc parallel loop gang
do iCell = 1, nCells
gmStreamFuncTopOfCell(:, iCell) = 0.0_RKIND
do i = 1, nEdgesOnCell(iCell)
......@@ -885,18 +901,23 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
areaEdge = 0.25_RKIND * dcEdge(iEdge) * dvEdge(iEdge)
!!$acc loop vector
do k = 1, maxLevelEdgeTop(iEdge)
rtmp = 0.5_RKIND * ( gmStreamFuncTopOfEdge(k, iEdge) + gmStreamFuncTopOfEdge(k+1, iEdge) ) * areaEdge
gmStreamFuncTopOfCell(k, iCell) = gmStreamFuncTopOfCell(k, iCell) + rtmp
end do
end do
end do
!!$acc end parallel
!$omp end do
!$omp do schedule(runtime)
! execution failture
!!$acc parallel loop gang
do iCell = 1, nCells
gmStreamFuncTopOfCell(:, iCell) = gmStreamFuncTopOfCell(:,iCell) / areaCell(iCell)
end do
!!$acc end parallel
IF (kgen_mainstage) THEN
!verify init
......@@ -1008,17 +1029,22 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
! Assign a huge value to the scratch variables which may manifest itself when
! there is a bug.
!$omp do schedule(runtime) private(k)
!$acc parallel loop gang
do iEdge = 1, nEdges
!$acc loop vector
do k = 1, nVertLevels
gradDensityEdge(k, iEdge) = huge(0D0)
gradZMidEdge(k, iEdge) = huge(0D0)
normalGMBolusVelocity(k, iEdge) = 0.0_RKIND
end do
end do
!$acc end parallel
!$omp end do
!$omp do schedule(runtime) private(k)
!$acc parallel loop gang
do iEdge = 1, nEdges
!$acc loop vector
do k = 1, nVertLevels + 1
gradDensityTopOfEdge(k, iEdge) = huge(0D0)
dDensityDzTopOfEdge(k, iEdge) = huge(0D0)
......@@ -1027,10 +1053,13 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
relativeSlopeTapering(k, iEdge) = 0.0_RKIND
end do
end do
!$acc end parallel
!$omp end do
!$omp do schedule(runtime) private(k)
!$acc parallel loop gang
do iCell = 1, nCells + 1
!$acc loop vector
do k = 1, nVertLevels
dDensityDzTopOfCell(k, iCell) = huge(0D0)
k33(k, iCell) = 0.0_RKIND
......@@ -1038,6 +1067,7 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
relativeSlopeTaperingCell(k, iCell) = 0.0_RKIND
end do
end do
!$acc end parallel
!$omp end do
!--------------------------------------------------------------------
......@@ -1070,13 +1100,16 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
! Interpolate dDensityDzTopOfCell to edge and layer interface
!$omp do schedule(runtime) private(k, cell1, cell2)
!$acc parallel loop gang
do iEdge = 1, nEdges
!$acc loop vector
do k = 1, maxLevelEdgeTop(iEdge)+1
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
dDensityDzTopOfEdge(k,iEdge) = 0.5_RKIND * (dDensityDzTopOfCell(k,cell1) + dDensityDzTopOfCell(k,cell2))
end do
end do
!$acc end parallel
!$omp end do
!--------------------------------------------------------------------
......@@ -1138,14 +1171,17 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
nEdges = nEdgesArray( 3 )
!$omp do schedule(runtime) private(k)
!$acc parallel loop gang
do iEdge = 1, nEdges
if (maxLevelEdgeTop(iEdge) .GE. 1) then
!$acc loop vector
do k = 1, maxLevelEdgeTop(iEdge)+1
gradDensityConstZTopOfEdge(k,iEdge) = gradDensityTopOfEdge(k,iEdge) - dDensityDzTopOfEdge(k,iEdge) &
* gradZMidTopOfEdge(k,iEdge)
end do
end if
end do
!$acc end parallel
!$omp end do
!--------------------------------------------------------------------
......@@ -1160,10 +1196,12 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
! Compute relativeSlopeTopOfEdge at edge and layer interface
! set relativeSlopeTopOfEdge to zero for horizontal land/water edges.
!$omp do schedule(runtime) private(k)
!$acc parallel loop gang
do iEdge = 1, nEdges
relativeSlopeTopOfEdge(:, iEdge) = 0.0_RKIND
! Beside a full land cell (e.g. missing cell) maxLevelEdgeTop=0, so relativeSlopeTopOfEdge at that edge will remain zero.
!$acc loop vector
do k = 2, maxLevelEdgeTop(iEdge)
relativeSlopeTopOfEdge(k,iEdge) = - gradDensityTopOfEdge(k,iEdge) / min(dDensityDzTopOfEdge(k,iEdge),-epsGM)
end do
......@@ -1179,6 +1217,7 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
relativeSlopeTopOfEdge( maxLevelEdgeTop(iEdge)+1, iEdge ) = relativeSlopeTopOfEdge( max(1,maxLevelEdgeTop(iEdge)), iEdge )
end do
!$acc end parallel
!$omp end do
nEdges = nEdgesArray( 3 )
......@@ -1186,11 +1225,14 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
! slope can be unbounded in regions of neutral stability, reset to the large, but bounded, value
! values is hardwrite to 1.0, this is equivalent to a slope of 45 degrees
!$omp do schedule(runtime) private(k)
!$acc parallel loop gang
do iEdge = 1, nEdges
!$acc loop vector
do k = 1, nVertLevels
relativeSlopeTopOfEdge(k, iEdge) = max( min( relativeSlopeTopOfEdge(k, iEdge), 1.0_RKIND), -1.0_RKIND)
end do
end do
!$acc end parallel
!$omp end do
! average relative slope to cell centers
......@@ -1199,6 +1241,7 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
nCells = nCellsArray( 2 )
!$omp do schedule(runtime) private(i, iEdge, areaEdge, rtmp, k)
!$acc parallel loop gang
do iCell = 1, nCells
areaCellSum(:, iCell) = 1.0e-34_RKIND
do i = 1, nEdgesOnCell(iCell)
......@@ -1206,6 +1249,7 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
!contribution of cell area from this edge * 2.0
areaEdge = 0.5_RKIND * dcEdge(iEdge) * dvEdge(iEdge)
!$acc loop vector
do k = 1, maxLevelEdgeTop(iEdge)
rtmp = areaEdge * relativeSlopeTopOfEdge(k, iEdge)**2
relativeSlopeTopOfCell(k, iCell) = relativeSlopeTopOfCell(k, iCell) + rtmp
......@@ -1213,16 +1257,20 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
end do
end do
end do
!$acc end parallel
!$omp end do
nCells = nCellsArray( 2 )
!$omp do schedule(runtime) private(k)
!$acc parallel loop gang
do iCell=1,nCells
!$acc loop vector
do k = 1, maxLevelCell(iCell)
relativeSlopeTopOfCell(k,iCell) = sqrt( relativeSlopeTopOfCell(k,iCell)/areaCellSum(k,iCell) )
end do
end do
!$acc end parallel
!$omp end do
! Compute tapering function
......@@ -1302,34 +1350,42 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
nCells = nCellsArray( 2 )
!$omp do schedule(runtime) private(k)
!$acc parallel loop gang
do iCell=1,nCells
k33(:, iCell) = 0.0_RKIND
!$acc loop vector
do k = 2, maxLevelCell(iCell)
k33(k,iCell) = ( relativeSlopeTaperingCell(k,iCell) * relativeSlopeTopOfCell(k,iCell) )**2
end do
end do
!$acc end parallel
!$omp end do
nEdges = nEdgesArray( 3 )
! average tapering function to layer edges
!$omp do schedule(runtime) private(cell1, cell2, k)
!$acc parallel loop gang
do iEdge = 1, nEdges
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
!$acc loop vector
do k = 1, maxLevelEdgeTop(iEdge)
relativeSlopeTapering(k,iEdge) = 0.5_RKIND * (relativeSlopeTaperingCell(k,cell1) + relativeSlopeTaperingCell(k,cell2))
enddo
enddo
!$acc end parallel
!$omp end do
! allow disabling of K33 for testing
if(config_disable_redi_k33) then
nCells = nCellsArray( size(nCellsArray) )
!$omp do schedule(runtime)
!$acc parallel loop gang
do iCell = 1, nCells
k33(:, iCell) = 0.0_RKIND
end do
!$acc end parallel
!$omp end do
end if
......@@ -1462,12 +1518,15 @@ SUBROUTINE ocn_gm_compute_bolus_velocity(kgen_unit, kgen_measure, kgen_isverifie
nEdges = nEdgesArray( 3 )
! Compute normalGMBolusVelocity from the stream function
!$omp do schedule(runtime) private(k)
!$acc parallel loop gang
do iEdge = 1, nEdges
!$acc loop vector
do k = 1, maxLevelEdgeTop(iEdge)
normalGMBolusVelocity(k,iEdge) = (gmStreamFuncTopOfEdge(k,iEdge) - gmStreamFuncTopOfEdge(k+1,iEdge)) &
/ layerThicknessEdge(k,iEdge)
end do
end do
!$acc end parallel
!$omp end do
nCells = nCellsArray( 1 )
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment