Skip to content

Commit

Permalink
Fix deallocation issue on restart. Clean up code.
Browse files Browse the repository at this point in the history
  • Loading branch information
cianciosa committed Feb 23, 2024
1 parent b7be385 commit 9c11faa
Show file tree
Hide file tree
Showing 4 changed files with 107 additions and 84 deletions.
4 changes: 3 additions & 1 deletion Sources/hessian.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1626,7 +1626,9 @@ SUBROUTINE block_precond(gc)

IF (l_backslv) THEN
istat = 0
IF (.NOT.ALLOCATED(gc_s)) ALLOCATE (gc_s(mblk_size,ns), stat=istat)
IF (.NOT.ALLOCATED(gc_s)) THEN
ALLOCATE (gc_s(mblk_size,ns), stat=istat)
END IF
CALL ASSERT(istat.EQ.0,'Allocation error0 in block_precond')
gc_s = gc
END IF
Expand Down
137 changes: 73 additions & 64 deletions Sources/prof_mod.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -84,14 +84,14 @@ subroutine profstart(rname)
enddo

if (.not.found) then
nroutine = nroutine + 1
isok = (nroutine .le. maxroutines)
call assert(isok, '** profstart: nroutine > maxroutines')

ipos = nroutine
dictname(ipos) = name
dictcount(ipos) = 0
dicttotal(ipos) = 0.0
nroutine = nroutine + 1
isok = (nroutine .le. maxroutines)
call assert(isok, '** profstart: nroutine > maxroutines')

ipos = nroutine
dictname(ipos) = name
dictcount(ipos) = 0
dicttotal(ipos) = 0.0
endif

dictstart(ipos) = dclock()
Expand Down Expand Up @@ -119,30 +119,30 @@ subroutine profend(rname)

isok = (name .eq. lastroutine(nlevels))
if (.not.isok) then
print*,'** profend name != lastroutine(',nlevels,') '
print*,'name: ', name
print*,'lastroutine(nlevels): ', lastroutine(nlevels)
print*,'** profend name != lastroutine(',nlevels,') '
print*,'name: ', name
print*,'lastroutine(nlevels): ', lastroutine(nlevels)

stop '** error ** '
stop '** error ** '
endif

found = .false.
do j=1,nroutine
do j = 1, nroutine
i = nroutine - j + 1

if (dictname(i)(1:1) .eq. name(1:1)) then
found = (dictname(i) .eq. name)
if (found) then
ipos = i
exit
endif
found = (dictname(i) .eq. name)
if (found) then
ipos = i
exit
endif
endif
enddo

if (.not.found) then
print*,'** profend: routine name not found '
print*,'name: ',name
stop '** error ** '
print*,'** profend: routine name not found '
print*,'name: ',name
stop '** error ** '
endif

dicttotal(ipos) = dicttotal(ipos) + (tend - dictstart(ipos));
Expand All @@ -167,7 +167,7 @@ subroutine profstat(outdev_in)
endif

fname = 'profstat.dat'
open(outdev, file=fname, form='formatted', &
open(outdev, file=fname, form='formatted', &
& access='sequential',status='unknown')
rewind(outdev)

Expand All @@ -179,7 +179,9 @@ subroutine profstat(outdev_in)

close(outdev)

IF (ALLOCATED(scalcounts)) DEALLOCATE (scalcounts, scaldisps)
IF (ALLOCATED(scalcounts)) THEN
DEALLOCATE (scalcounts, scaldisps)
END IF

return
end subroutine profstat
Expand All @@ -191,35 +193,39 @@ SUBROUTINE SetUpScalingAllGather(mblk_size)
INTEGER :: i, numroc
EXTERNAL :: numroc, blacs_gridinfo

IF (.NOT.ALLOCATED(scalcounts)) ALLOCATE (scalcounts(nprocs))
IF (.NOT.ALLOCATED(scaldisps)) ALLOCATE (scaldisps(nprocs))
IF (.NOT.ALLOCATED(scalcounts)) THEN
ALLOCATE (scalcounts(nprocs))
END IF
IF (.NOT.ALLOCATED(scaldisps)) THEN
ALLOCATE (scaldisps(nprocs))
END IF

CALL numrocMapping(iam, nprocs, mblk_size)

DO i=1,nprocs
scalcounts(i)=(EndBlockProc(i)-StartBlockProc(i)+1)
DO i = 1, nprocs
scalcounts(i) = (EndBlockProc(i) - StartBlockProc(i) + 1)
END DO

DEALLOCATE (StartBlockProc, EndBlockProc)

!Sanity consistency check
!!!!!!!!!!!!!!!!!!!!!!!!!
CALL blacs_gridinfo(icontxt_1xp,nprow,npcol,myrow,mycol)
CALL blacs_gridinfo(icontxt_1xp, nprow, npcol, myrow, mycol)
mb = mblk_size
nb = 1

rsrc = 0
csrc = 0
Locq = numroc( mblk_size, nb, mycol, csrc, npcol )
! Locp = numroc( mblk_size, mb, myrow, rsrc, nprow )
mblk_size2 = MAX(1,Locq)
CALL ASSERT(scalcounts(iam+1).EQ.mblk_size2, &
'scalcounts != mblk_size2 in SetupScalingAllGather')
mblk_size2 = MAX(1, Locq)
CALL ASSERT(scalcounts(iam + 1) .EQ. mblk_size2, &
'scalcounts != mblk_size2 in SetupScalingAllGather')
!!!!!!!!!!!!!!!!!!!!!!!!!

scaldisps(1)=0
DO i=2,nprocs
scaldisps(i)=scaldisps(i-1)+scalcounts(i-1)
DO i = 2, nprocs
scaldisps(i) = scaldisps(i - 1) + scalcounts(i - 1)
END DO

END SUBROUTINE SetUpScalingAllGather
Expand All @@ -233,53 +239,56 @@ SUBROUTINE numrocMapping(rank, activeranks, N)
INTEGER :: numL, numS, mpi_err
INTEGER :: r, c

IF (.NOT.ALLOCATED(StartBlockProc)) ALLOCATE (StartBlockProc(activeranks))
IF (.NOT.ALLOCATED(EndBlockProc)) ALLOCATE (EndBlockProc(activeranks))
IF (.NOT.ALLOCATED(StartBlockProc)) THEN
ALLOCATE (StartBlockProc(activeranks))
END IF
IF (.NOT.ALLOCATED(EndBlockProc)) THEN
ALLOCATE (EndBlockProc(activeranks))
END IF

lload=CEILING(REAL(N)/activeranks)
sload=FLOOR(REAL(N)/activeranks)
lload = CEILING(REAL(N)/activeranks)
sload = FLOOR(REAL(N)/activeranks)

IF (lload.EQ.sload) THEN
myload=lload
IF (lload .EQ. sload) THEN
myload = lload
ELSE
IF (rank.LT.MOD(N,activeranks)) THEN
myload=lload
ELSE
myload=sload
END IF
IF (rank .LT. MOD(N, activeranks)) THEN
myload = lload
ELSE
myload = sload
END IF
END IF

IF (sload.EQ.lload) THEN
numS=0
numL=rank
numS = 0
numL = rank
ELSE
IF (myload.EQ.lload) THEN
numL=rank
numS=0
ELSE
numL=MOD(N,activeranks)
numS=rank-numL
END IF
IF (myload.EQ.lload) THEN
numL = rank
numS = 0
ELSE
numL = MOD(N, activeranks)
numS = rank - numL
END IF
END IF

IF (rank.LT.activeranks) THEN !active ranks
startblock=numL*lload+numS*sload
endblock=startblock+myload-1
startblock = numL*lload + numS*sload
endblock = startblock + myload - 1
ELSE !idle ranks
startblock=-2
endblock=-3
startblock = -2
endblock = -3
END IF

! Fortranized indices
startblock=startblock+1
endblock=endblock+1

CALL MPI_Allgather(startblock,1,MPI_INTEGER,StartBlockProc, &
1,MPI_INTEGER,SIESTA_COMM,MPI_ERR)
startblock = startblock + 1
endblock = endblock + 1

CALL MPI_Allgather(endblock,1,MPI_INTEGER,EndBlockProc, &
1,MPI_INTEGER,SIESTA_COMM,MPI_ERR)
CALL MPI_Allgather(startblock, 1, MPI_INTEGER, StartBlockProc, &
1, MPI_INTEGER, SIESTA_COMM, MPI_ERR)

CALL MPI_Allgather(endblock, 1, MPI_INTEGER, EndBlockProc, &
1, MPI_INTEGER, SIESTA_COMM, MPI_ERR)

END SUBROUTINE numrocMapping
#endif
Expand Down
48 changes: 30 additions & 18 deletions Sources/quantities.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -403,23 +403,23 @@ SUBROUTINE Init_Fields
chiph(1) = 0

IF (.not.l_vessel .and. l_lambda) THEN
CALL ReCompute_Lambda(lmns_i, lmnc_i, jacobh, &
fourier_context%orthonorm, phiph, chiph, &
nsmin, nsmax)
CALL ReCompute_Lambda(lmns_i, lmnc_i, jacobh, &
fourier_context%orthonorm, phiph, chiph, &
nsmin, nsmax)
END IF

CALL Init_Bfield(jbsupsmnsh, jbsupumnch, jbsupvmnch, &
lmns_i, phiph, chiph, nsmin, nsmax, f_sin)
IF (lasym) THEN
CALL Init_Bfield(jbsupsmnch, jbsupumnsh, jbsupvmnsh, &
lmnc_i, phiph, chiph, nsmin, nsmax, f_cos)
CALL Init_Bfield(jbsupsmnch, jbsupumnsh, jbsupvmnsh, &
lmnc_i, phiph, chiph, nsmin, nsmax, f_cos)
END IF

DEALLOCATE (phiph, chiph, stat=istat)
CALL ASSERT(istat.EQ.0,'Deallocate error #1 in init_fields')

! Initialize half mesh pressure
nloc = MAX(1,startglobrow - 1)
nloc = MAX(1, startglobrow - 1)
ALLOCATE(presih(ntheta,nzeta,nloc:nsmax), &
presif(ntheta,nzeta,nloc:nsmax), stat=istat)
CALL ASSERT(istat.EQ.0, 'Allocate error #1 in init_fields')
Expand Down Expand Up @@ -702,7 +702,7 @@ SUBROUTINE ReCompute_Lambda(lmns, lmnc, jacobh, orthonorm, &
END DO

! Compute lambda from sqrt(g)*J^s == mB_v - nB_u = 0
DO js = MAX(nsmin,2), nsmax
DO js = MAX(nsmin, 2), nsmax
mn = 0

DO n = -ntor, ntor
Expand Down Expand Up @@ -853,16 +853,24 @@ SUBROUTINE dealloc_quantities

! Start of executable code
! Quantities allocated in alloc_quantities
DEALLOCATE(jpmnch, jbsupsmnsh, jbsupumnch, jbsupvmnch)
DEALLOCATE(pwr_spec_s, pwr_spec_a)
IF (ALLOCATED(jpmnch)) THEN
DEALLOCATE(jpmnch, jbsupsmnsh, jbsupumnch, jbsupvmnch)
END IF
IF (ALLOCATED(pwr_spec_s)) THEN
DEALLOCATE(pwr_spec_s, pwr_spec_a)
END IF

! Other quantities
DEALLOCATE(djpmnch, djbsupsmnsh, djbsupumnch, djbsupvmnch, &
ksupsmnsf, ksupumncf, ksupvmncf)
DEALLOCATE(jacobh, jacobf, jvsupsijf, jvsupuijf, jvsupvijf, &
ksubsijf, ksubuijf, ksubvijf, pijh0, pijf0, &
pijf0_ds, bsupuijf0, vp_f, bsq, wint, &
bsupvijf0, bsupsijf0, pijh0_du, pijh0_dv)
IF (ALLOCATED(jpmnch)) THEN
DEALLOCATE(djpmnch, djbsupsmnsh, djbsupumnch, djbsupvmnch, &
ksupsmnsf, ksupumncf, ksupvmncf)
END IF
IF (ALLOCATED(jpmnch)) THEN
DEALLOCATE(jacobh, jacobf, jvsupsijf, jvsupuijf, jvsupvijf, &
ksubsijf, ksubuijf, ksubvijf, pijh0, pijf0, &
pijf0_ds, bsupuijf0, vp_f, bsq, wint, &
bsupvijf0, bsupsijf0, pijh0_du, pijh0_dv)
END IF
IF (ALLOCATED(bsupsijf0)) THEN
DEALLOCATE(bsupsijf0, bsupuijf0, bsupvijf0)
END IF
Expand All @@ -885,10 +893,14 @@ SUBROUTINE dealloc_quantities
! Asymmetric quantities.
IF (lasym) THEN
! Quantities allocated in alloc_quantities
DEALLOCATE(jpmnsh, jbsupsmnch, jbsupumnsh, jbsupvmnsh)
IF (ALLOCATED(jpmnsh)) THEN
DEALLOCATE(jpmnsh, jbsupsmnch, jbsupumnsh, jbsupvmnsh)
END IF
! Other quantities
DEALLOCATE(djpmnsh, djbsupsmnch, djbsupumnsh, djbsupvmnsh, &
ksupsmncf, ksupumnsf, ksupvmnsf)
IF (ALLOCATED(djpmnsh)) THEN
DEALLOCATE(djpmnsh, djbsupsmnch, djbsupumnsh, djbsupvmnsh, &
ksupsmncf, ksupumnsf, ksupvmnsf)
END IF
END IF

END SUBROUTINE
Expand Down
2 changes: 1 addition & 1 deletion Sources/shared_functions.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -250,7 +250,7 @@ SUBROUTINE LineSearch(xcmin, fsq_min)
INTEGER :: iter
! INTEGER :: j

! Start if executable code.
! Start of executable code.
facmin = 1 !3 !mrc
l_init_state = .false.
l_getfsq = .true.
Expand Down

0 comments on commit 9c11faa

Please sign in to comment.