Skip to content

Commit

Permalink
feature(ims): update inner iteration summary (#389)
Browse files Browse the repository at this point in the history
  • Loading branch information
@jdhughes-usgs
jdhughes-usgs authored Apr 9, 2020
1 parent a391efb commit c173833
Show file tree
Hide file tree
Showing 3 changed files with 143 additions and 56 deletions.
130 changes: 92 additions & 38 deletions src/Solution/NumericalSolution.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1205,9 +1205,8 @@ subroutine writeCSVHeader(this)

if (this%icsvout > 0) then
write(this%icsvout, '(*(G0,:,","))', advance='NO') &
'total_iterations', 'totim', 'kper', 'kstp', 'ksub', 'nouter', &
'ninner', 'solution_dvmax', 'solution_dvmax_model', &
'solution_dvmax_node'
'total_iterations', 'totim', 'kper', 'kstp', 'nouter', 'ninner', &
'solution_dvmax', 'solution_dvmax_model', 'solution_dvmax_node'
if (this%iprims == 2) then
write(this%icsvout, '(*(G0,:,","))', advance='NO') &
'', 'solution_drmax', 'solution_drmax_model', &
Expand Down Expand Up @@ -1368,7 +1367,7 @@ subroutine doIteration(this, kiter)
call this%outertab%table_df(ntabrows, ntabcols, iout, &
finalize=.FALSE.)
tag = 'OUTER ITERATION STEP'
call this%outertab%initialize_column(tag, 15, alignment=TABLEFT)
call this%outertab%initialize_column(tag, 25, alignment=TABLEFT)
tag = 'OUTER ITERATION'
call this%outertab%initialize_column(tag, 10, alignment=TABRIGHT)
tag = 'INNER ITERATION'
Expand Down Expand Up @@ -1454,6 +1453,9 @@ subroutine doIteration(this, kiter)
CALL this%sln_ls(kiter, kstp, kper, iter, iptc, ptcf)
call code_timer(1, ttsoln, this%ttsoln)
!
! -- increment the counter storing the total number of linear iterations
this%itertot = this%itertot + iter
!
! -- save matrix to a file
! to enable set itestmat to 1 and recompile
!-------------------------------------------------------
Expand Down Expand Up @@ -1566,7 +1568,6 @@ subroutine doIteration(this, kiter)
else
cmsg = '*'
end if
!if (len_trim(this%cpak) > 0) then
if (len_trim(cpak) > 0) then
!
! -- add data to outertab
Expand All @@ -1585,9 +1586,6 @@ subroutine doIteration(this, kiter)
end if
end if
!
! -- increment the counter storing the total number of linear iterations
this%itertot = this%itertot + iter
!
! -- under-relaxation - only done if convergence not achieved
if (this%icnvg /= 1) then
if (this%nonmeth > 0) then
Expand Down Expand Up @@ -1618,6 +1616,28 @@ subroutine doIteration(this, kiter)
if (abs(dxmax) <= this%hclose .and. &
abs(this%hncg(kiter)) <= this%hclose) then
this%icnvg = 1
!
! -- write revised head change data after
! newton under-relaxation
if (this%iprims > 0) then
cval = 'Newton under-relaxation'
cmsg = '*'
call this%sln_get_loc(this%lrch(1,kiter), strh)
!
! -- add data to outertab
call this%outertab%add_term(cval)
call this%outertab%add_term(kiter)
call this%outertab%add_term(iter)
if (this%numtrack > 0) then
call this%outertab%add_term(' ')
call this%outertab%add_term(' ')
call this%outertab%add_term(' ')
call this%outertab%add_term(' ')
end if
call this%outertab%add_term(this%hncg(kiter))
call this%outertab%add_term(cmsg)
call this%outertab%add_term(trim(strh))
end if
end if
end if
end if
Expand Down Expand Up @@ -1652,18 +1672,19 @@ subroutine finalizeIteration(this, kiter, isgcnvg, isubtime, isuppress_output)
if (this%iprims > 0) then
call this%outertab%finalize_table()
end if
!
! -- write convergence info
if (this%icnvg == 1) then
!
! -- convergence was achieved
if (this%icnvg /= 0) then
if (this%iprims > 0) then
write(iout, fmtcnvg) kiter, kstp, kper, this%itertot
end if
end if

! -- Write a message if convergence was not achieved
if (this%icnvg == 0) then
!
! -- convergence was not achieved
else
write(iout, fmtnocnvg) this%id, kper, kstp
end if

!
! -- write inner iteration convergence summary
if (this%iprims == 2) then
Expand All @@ -1690,11 +1711,11 @@ subroutine finalizeIteration(this, kiter, isgcnvg, isubtime, isuppress_output)
!
! -- write line
write(this%icsvout, '(*(G0,:,","))') &
this%nitercnt, totim, kper, kstp, isubtime, kiter, this%itertot, &
this%nitercnt, totim, kper, kstp, kiter, this%itertot, &
this%hncg(kiter), im, nodeu
else
call this%csv_convergence_summary(this%icsvout, totim, kper, kstp, &
isubtime, this%itertot)
this%itertot)
end if
end if
!
Expand Down Expand Up @@ -1742,7 +1763,12 @@ subroutine convergence_summary(this, iu, im, itertot)
integer(I4B), intent(in) :: im
integer(I4B), intent(in) :: itertot
! -- local
character(len=34) :: strh, strr
character(len=LINELENGTH) :: title
character(len=LINELENGTH) :: tag
character(len=LENPAKLOC) :: strh
character(len=LENPAKLOC) :: strr
integer(I4B) :: ntabrows
integer(I4B) :: ntabcols
integer(I4B) :: i
integer(I4B) :: i0
integer(I4B) :: iouter
Expand All @@ -1753,16 +1779,43 @@ subroutine convergence_summary(this, iu, im, itertot)
real(DP) :: dv
real(DP) :: dr
! ------------------------------------------------------------------------------
!
! -- initialize local variables
iouter = 1
write(iu,"(/,1x,A)") 'INNER ITERATION SUMMARY'
write(iu,"(1x,128('-'))")
write(iu,'(1x,3a)') ' TOTAL OUTER INNER', &
' MAXIMUM CHANGE MAXIMUM', &
' MAXIMUM RESIDUAL MAXIMUM'
write(iu,'(1x,3a)') 'ITERATION ITERATION ITERATION', &
' MODEL-(CELLID) CHANGE', &
' MODEL-(CELLID) RESIDUAL'
write(iu,"(1x,128('-'))")
!
! -- initialize inner iteration summary table
if (.not. associated(this%innertab)) then
!
! -- create outer iteration table
! -- table dimensions
ntabrows = itertot
ntabcols = 7
!
! -- initialize table and define columns
title = 'INNER ITERATION SUMMARY'
call table_cr(this%innertab, this%name, title)
call this%innertab%table_df(ntabrows, ntabcols, iu)
tag = 'TOTAL ITERATION'
call this%innertab%initialize_column(tag, 10, alignment=TABRIGHT)
tag = 'OUTER ITERATION'
call this%innertab%initialize_column(tag, 10, alignment=TABRIGHT)
tag = 'INNER ITERATION'
call this%innertab%initialize_column(tag, 10, alignment=TABRIGHT)
tag = 'MAXIMUM CHANGE'
call this%innertab%initialize_column(tag, 15, alignment=TABRIGHT)
tag = 'MAXIMUM CHANGE MODEL-(CELLID)'
call this%innertab%initialize_column(tag, LENPAKLOC, alignment=TABRIGHT)
tag = 'MAXIMUM RESIDUAL'
call this%innertab%initialize_column(tag, 15, alignment=TABRIGHT)
tag = 'MAXIMUM RESIDUAL MODEL-(CELLID)'
call this%innertab%initialize_column(tag, LENPAKLOC, alignment=TABRIGHT)
!
! -- reset the output unit
else
call this%innertab%set_iout(iu)
end if
!
! -- write the inner iteration summary to unit iu
i0 = 0
do k = 1, itertot
i = this%itinner(k)
Expand Down Expand Up @@ -1790,24 +1843,26 @@ subroutine convergence_summary(this, iu, im, itertot)
end if
call this%sln_get_loc(locdv, strh)
call this%sln_get_loc(locdr, strr)
write(iu, '(1x,3i10,a34,g15.7,a34,g15.7)') k, iouter, i, &
adjustr(trim(strh)), dv, &
adjustr(trim(strr)), dr
!
! -- add data to innertab
call this%innertab%add_term(k)
call this%innertab%add_term(iouter)
call this%innertab%add_term(i)
call this%innertab%add_term(dv)
call this%innertab%add_term(adjustr(trim(strh)))
call this%innertab%add_term(dr)
call this%innertab%add_term(adjustr(trim(strr)))
!
! -- update i0
i0 = i
end do
!
! -- write blank line
if (im <= this%convnmod) then
write(iu, '(a)') ''
end if
!
! -- return
return
end subroutine convergence_summary


subroutine csv_convergence_summary(this, iu, totim, kper, kstp, isubtime, &
itertot)
subroutine csv_convergence_summary(this, iu, totim, kper, kstp, itertot)
! ******************************************************************************
! csv_convergence_summary -- Save convergence summary to a csv file
! ******************************************************************************
Expand All @@ -1822,7 +1877,6 @@ subroutine csv_convergence_summary(this, iu, totim, kper, kstp, isubtime, &
real(DP), intent(in) :: totim
integer(I4B), intent(in) :: kper
integer(I4B), intent(in) :: kstp
integer(I4B), intent(in) :: isubtime
integer(I4B), intent(in) :: itertot
! -- local
integer(I4B) :: i
Expand All @@ -1846,7 +1900,7 @@ subroutine csv_convergence_summary(this, iu, totim, kper, kstp, isubtime, &
iouter = iouter + 1
end if
write(iu, '(*(G0,:,","))', advance='NO') &
this%nitercnt, totim, kper, kstp, isubtime, iouter, i
this%nitercnt, totim, kper, kstp, iouter, i
!
! -- solution summary
dv = DZERO
Expand Down
47 changes: 29 additions & 18 deletions src/Solution/SparseMatrixSolver/ims8linear.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1664,16 +1664,20 @@ SUBROUTINE IMSLINEARSUB_CG(ICNVG, ITMAX, INNERIT, &
END IF
CALL IMSLINEARSUB_TESTCNVG(ICNVGOPT, ICNVG, INNERIT, &
deltax, rcnvg, &
L2NORM0, EPFACT, HCLOSE, RCLOSE)
L2NORM0, EPFACT, HCLOSE, RCLOSE)
!
! CHECK FOR EXACT SOLUTION
IF (rcnvg == DZERO) ICNVG = 1
!-----------CHECK FOR EXACT SOLUTION
IF (rcnvg == DZERO) ICNVG = 1
!
!-----------CHECK FOR STANDARD CONVERGENCE
IF (ICNVG.NE.0) EXIT INNER
!
!-----------CHECK THAT CURRENT AND PREVIOUS rho ARE DIFFERENT
lsame = IS_SAME(rho, rho0)
IF (lsame) THEN
EXIT INNER
END IF
!
!-----------RECALCULATE THE RESIDUAL
IF (NORTH > 0) THEN
LORTH = mod(iiter+1,NORTH) == 0
Expand Down Expand Up @@ -1940,9 +1944,13 @@ SUBROUTINE IMSLINEARSUB_BCGS(ICNVG, ITMAX, INNERIT, &
CALL IMSLINEARSUB_TESTCNVG(ICNVGOPT, ICNVG, INNERIT, &
deltax, rcnvg, &
L2NORM0, EPFACT, HCLOSE, RCLOSE)
! CHECK FOR EXACT SOLUTION
IF (rcnvg == DZERO) ICNVG = 1
!
!-----------CHECK FOR EXACT SOLUTION
IF (rcnvg == DZERO) ICNVG = 1
!
!-----------CHECK FOR STANDARD CONVERGENCE
IF (ICNVG.NE.0) EXIT INNER
!
!-----------CHECK THAT CURRENT AND PREVIOUS rho, alpha, AND omega ARE
! DIFFERENT
lsame = IS_SAME(rho, rho0)
Expand Down Expand Up @@ -1999,28 +2007,31 @@ SUBROUTINE IMSLINEARSUB_TESTCNVG(Icnvgopt, Icnvg, Iiter, &
! + + + FUNCTIONS + + +
! + + + CODE + + +
IF (Icnvgopt == 0) THEN
IF (ABS(Hmax) <= Hclose .AND. ABS(Rmax) <= Rclose) THEN
IF (ABS(Hmax) <= Hclose .AND. ABS(Rmax) <= Rclose) THEN
Icnvg = 1
END IF
ELSE IF (Icnvgopt == 1) THEN
IF (ABS(Hmax) <= Hclose .AND. ABS(Rmax) <= Rclose .AND. &
iiter == 1) THEN
Icnvg = 1
ELSE IF (Icnvgopt == 1) THEN
IF (ABS(Hmax) <= Hclose .AND. ABS(Rmax) <= Rclose) THEN
IF (iiter == 1) THEN
Icnvg = 1
ELSE
Icnvg = -1
END IF
END IF
ELSE IF (Icnvgopt == 2) THEN
IF (ABS(Hmax) <= Hclose .OR. Rmax <= Rclose) THEN
ELSE IF (Icnvgopt == 2) THEN
IF (ABS(Hmax) <= Hclose .OR. Rmax <= Rclose) THEN
Icnvg = 1
ELSE IF (Rmax <= Rmax0*Epfact) THEN
ELSE IF (Rmax <= Rmax0*Epfact) THEN
Icnvg = -1
END IF
ELSE IF (Icnvgopt == 3) THEN
IF (ABS(Hmax) <= Hclose) THEN
ELSE IF (Icnvgopt == 3) THEN
IF (ABS(Hmax) <= Hclose) THEN
Icnvg = 1
ELSE IF (Rmax <= Rmax0*Rclose) THEN
ELSE IF (Rmax <= Rmax0*Rclose) THEN
Icnvg = -1
END IF
ELSE IF (Icnvgopt == 4) THEN
IF (ABS(Hmax) <= Hclose .AND. Rmax <= Rclose) THEN
ELSE IF (Icnvgopt == 4) THEN
IF (ABS(Hmax) <= Hclose .AND. Rmax <= Rclose) THEN
Icnvg = 1
ELSE IF (Rmax <= Rmax0*Epfact) THEN
Icnvg = -1
Expand Down
22 changes: 22 additions & 0 deletions src/Utilities/Table.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -59,6 +59,7 @@ module TableModule
procedure :: finalize_table
procedure :: set_maxbound
procedure :: set_title
procedure :: set_iout
procedure :: print_list_entry

procedure, private :: allocate_strings
Expand Down Expand Up @@ -881,6 +882,27 @@ subroutine set_title(this, title)
return
end subroutine set_title

subroutine set_iout(this, iout)
! ******************************************************************************
! set_iout -- reset iout
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(TableType) :: this
integer(I4B), intent(in) :: iout
! -- local
! ------------------------------------------------------------------------------
!
! -- set iout
this%iout = iout
!
! -- return
return
end subroutine set_iout

subroutine print_list_entry(this, i, nodestr, q, bname)
! ******************************************************************************
! print_list_entry -- write flow term table values
Expand Down

0 comments on commit c173833

Please sign in to comment.