Skip to content

Commit

Permalink
Fixes OMP pandf1 paral for icntunk=1
Browse files Browse the repository at this point in the history
- Adds custom pandf iter prompt when OMP active
  • Loading branch information
holm10 committed Feb 1, 2025
1 parent 26421bb commit fb9fec1
Show file tree
Hide file tree
Showing 4 changed files with 32 additions and 4 deletions.
1 change: 1 addition & 0 deletions bbb/bbb.v
Original file line number Diff line number Diff line change
Expand Up @@ -3238,6 +3238,7 @@ ifexmain integer /0/ #scalar to indicate if subroutine allocate
exmain_aborted logical /.false./ # Set to .true. in Python version on control-C abort
iallcall integer /0/ #flag to signal first call to allocate
comnfe integer /0/ # Number of NK iterations for time-step
pandfitertag character*20 /'iter='/ # Flag controlling serial/parallel PANDF output

***** RZ_cell_info:
# RZ grid-cell center and face locations
Expand Down
3 changes: 3 additions & 0 deletions bbb/oderhs.m
Original file line number Diff line number Diff line change
Expand Up @@ -12329,12 +12329,15 @@ subroutine Pandf1rhs_interface(neq, time, yl, yldot)
implicit none
Use(Math_problem_size) # neqmx
Use(ParallelEval) # ParallelPandf1
Use(Cdv) # pandfitertag
integer neq
real time, yl(neqmx),yldot(neq)

c!omp if (ParallelPandf1.gt.0) then
c!omp pandfitertag = "OMP iter="
c!omp call OMPPandf1Rhs(neq, time, yl, yldot)
c!omp else
pandfitertag = "iter="
call pandf1(-1, -1, 0, neq, time, yl, yldot)
c!omp endif

Expand Down
24 changes: 24 additions & 0 deletions ppp/omp_parallel.F90
Original file line number Diff line number Diff line change
Expand Up @@ -874,6 +874,30 @@ subroutine MakeChunksPandf1()
return
end subroutine MakeChunksPandf1

subroutine set_eymask1d()
USE Gradients, only: eymask1d
USE Dim, only: nxpt
USE Xpoint_indices, only: iysptrx, ixpt1, ixpt2
USE Uepar, only: isphicore0
IMPLICIT NONE

integer :: jx, iy, ix
!... Set eymask1d to give ey=0 in core+sep for 1d SOL pot (isphicore0=1)
eymask1d = 1. ! 2D array initialization
if (isphicore0 == 1) then ! only solve pot eqn in SOL; phi_core const
do jx = 1, nxpt
do iy = 0, iysptrx
do ix = ixpt1(jx)+1, ixpt2(jx)
eymask1d(ix,iy) = 0.
enddo
enddo
enddo
endif
return
end subroutine set_eymask1d



!subroutine PrintChunks
!use OMPPandf1Settings,only: OMPPandf1Stamp
!use OMPPandf1, only: NchunksPandf1,yincchunk,xincchunk,iychunk,ixchunk,Nxchunks,Nychunks,iyminchunk,iymaxchunk
Expand Down
8 changes: 4 additions & 4 deletions svr/nksol.m
Original file line number Diff line number Diff line change
Expand Up @@ -736,7 +736,7 @@ dimension icnstr(n)
c
real zero,one,two,three
logical mxtkn
Use(Cdv)
Use(Cdv) # comnfe, pandfitertag
c+pnb
C
C Type declaration for the additional diagnostics set up to inquire ----
Expand Down Expand Up @@ -1007,7 +1007,7 @@ call f(n, u, savf)
comnfe = comnfe + 1
fnrm = vnormnk(n,savf,sf)
f1nrm = fnrm*fnrm/two
if (iprint .ge. 1) write(iunit,400) iter,fnrm,nfe
if (iprint .ge. 1) write(iunit,400) TRIM(pandfitertag), iter,fnrm,nfe
c-----------------------------------------------------------------------
c test to see if initial conditions satisfy stopping criterion.
c-----------------------------------------------------------------------
Expand Down Expand Up @@ -1096,8 +1096,8 @@ call nkstop(n,u,rwork(lup),savf,fnrm,su,sf,stptol,rwork(lx),
u(i) = rwork(i+lup-1)
300 continue
f1nrm = f1nrmp
if (iprint .ge. 1) write(iunit,400) iter,fnrm,nfe
400 format(' iter= ',i4,' fnrm= ',g26.16,' nfe= ',i6)
if (iprint .ge. 1) write(iunit,400) TRIM(pandfitertag), iter,fnrm,nfe
400 format(' ', a,i4,' fnrm= ',g26.16,' nfe= ',i6)
if (iterm .eq. 0) go to 100
c-----------------------------------------------------------------------
c load optional outputs into iwork array and return.
Expand Down

0 comments on commit fb9fec1

Please sign in to comment.