MODFLOW 6  version 6.5.0.dev2
MODFLOW 6 Code Documentation
Data Types | Functions/Subroutines
imslinearmodule Module Reference

Data Types

type  imslineardatatype
 

Functions/Subroutines

subroutine imslinear_ar (this, NAME, IOUT, IPRIMS, MXITER, NEQ, matrix, RHS, X, linear_settings)
 @ brief Allocate storage and read data More...
 
subroutine imslinear_summary (this, mxiter)
 @ brief Write summary of settings More...
 
subroutine allocate_scalars (this)
 @ brief Allocate and initialize scalars More...
 
subroutine imslinear_da (this)
 @ brief Deallocate memory More...
 
subroutine imslinear_set_input (this, IFDPARAM)
 @ brief Set default settings More...
 
subroutine imslinear_ap (this, ICNVG, KSTP, KITER, IN_ITER, NCONV, CONVNMOD, CONVMODSTART, CACCEL, summary)
 @ brief Base linear accelerator subroutine More...
 

Function/Subroutine Documentation

◆ allocate_scalars()

subroutine imslinearmodule::allocate_scalars ( class(imslineardatatype), intent(inout)  this)
private

Allocate and initialize linear accelerator scalars

Parameters
[in,out]thisImsLinearDataType instance

Definition at line 461 of file ImsLinear.f90.

462  ! -- modules
463  use memorymanagermodule, only: mem_allocate
464  ! -- dummy variables
465  class(ImsLinearDataType), intent(inout) :: this !< ImsLinearDataType instance
466  !
467  ! -- allocate scalars
468  call mem_allocate(this%iout, 'IOUT', this%memoryPath)
469  call mem_allocate(this%ipc, 'IPC', this%memoryPath)
470  call mem_allocate(this%iacpc, 'IACPC', this%memoryPath)
471  call mem_allocate(this%niterc, 'NITERC', this%memoryPath)
472  call mem_allocate(this%niabcgs, 'NIABCGS', this%memoryPath)
473  call mem_allocate(this%niapc, 'NIAPC', this%memoryPath)
474  call mem_allocate(this%njapc, 'NJAPC', this%memoryPath)
475  call mem_allocate(this%epfact, 'EPFACT', this%memoryPath)
476  call mem_allocate(this%l2norm0, 'L2NORM0', this%memoryPath)
477  call mem_allocate(this%njlu, 'NJLU', this%memoryPath)
478  call mem_allocate(this%njw, 'NJW', this%memoryPath)
479  call mem_allocate(this%nwlu, 'NWLU', this%memoryPath)
480  !
481  ! -- initialize scalars
482  this%iout = 0
483  this%ipc = 0
484  this%iacpc = 0
485  this%niterc = 0
486  this%niabcgs = 0
487  this%niapc = 0
488  this%njapc = 0
489  this%epfact = dzero
490  this%l2norm0 = 0
491  this%njlu = 0
492  this%njw = 0
493  this%nwlu = 0
494  !
495  ! -- return
496  return
memorymanagermodule::mem_allocate
Definition: MemoryManager.f90:53

◆ imslinear_ap()

subroutine imslinearmodule::imslinear_ap ( class(imslineardatatype), intent(inout)  this,
integer(i4b), intent(inout)  ICNVG,
integer(i4b), intent(in)  KSTP,
integer(i4b), intent(in)  KITER,
integer(i4b), intent(inout)  IN_ITER,
integer(i4b), intent(in)  NCONV,
integer(i4b), intent(in)  CONVNMOD,
integer(i4b), dimension(convnmod + 1), intent(inout)  CONVMODSTART,
character(len=31), dimension(nconv), intent(inout)  CACCEL,
type(convergencesummarytype), intent(in), pointer  summary 
)
private

Base linear accelerator subroutine that scales and reorders the system of equations, if necessary, updates the preconditioner, and calls the appropriate linear accelerator.

Parameters
[in,out]thisImsLinearDataType instance
[in,out]icnvgconvergence flag (1) non-convergence (0)
[in]kstptime step number
[in]kiterouter iteration number
[in,out]in_iterinner iteration number
[in]summaryConvergence summary report

Definition at line 632 of file ImsLinear.f90.

635  ! -- modules
636  USE simmodule
637  ! -- dummy variables
638  CLASS(ImsLinearDataType), INTENT(INOUT) :: this !< ImsLinearDataType instance
639  integer(I4B), INTENT(INOUT) :: ICNVG !< convergence flag (1) non-convergence (0)
640  integer(I4B), INTENT(IN) :: KSTP !< time step number
641  integer(I4B), INTENT(IN) :: KITER !< outer iteration number
642  integer(I4B), INTENT(INOUT) :: IN_ITER !< inner iteration number
643  ! -- convergence information dummy variables
644  integer(I4B), INTENT(IN) :: NCONV !<
645  integer(I4B), INTENT(IN) :: CONVNMOD !<
646  integer(I4B), DIMENSION(CONVNMOD + 1), INTENT(INOUT) :: CONVMODSTART !<
647  character(len=31), DIMENSION(NCONV), INTENT(INOUT) :: CACCEL !<
648  type(ConvergenceSummaryType), pointer, intent(in) :: summary !< Convergence summary report
649  ! -- local variables
650  integer(I4B) :: n
651  integer(I4B) :: innerit
652  integer(I4B) :: irc
653  integer(I4B) :: itmax
654  real(DP) :: dnrm2
655  !
656  ! -- set epfact based on timestep
657  this%EPFACT = ims_base_epfact(this%ICNVGOPT, kstp)
658  !
659  ! -- SCALE PROBLEM
660  IF (this%ISCL .NE. 0) THEN
661  CALL ims_base_scale(0, this%ISCL, &
662  this%NEQ, this%NJA, this%IA, this%JA, &
663  this%AMAT, this%X, this%RHS, &
664  this%DSCALE, this%DSCALE2)
665  END IF
666  !
667  ! -- PERMUTE ROWS, COLUMNS, AND RHS
668  IF (this%IORD /= 0) THEN
669  CALL dperm(this%NEQ, this%AMAT, this%JA, this%IA, &
670  this%ARO, this%JARO, this%IARO, &
671  this%LORDER, this%ID, 1)
672  CALL dvperm(this%NEQ, this%X, this%LORDER)
673  CALL dvperm(this%NEQ, this%RHS, this%LORDER)
674  this%IA0 => this%IARO
675  this%JA0 => this%JARO
676  this%A0 => this%ARO
677  ELSE
678  this%IA0 => this%IA
679  this%JA0 => this%JA
680  this%A0 => this%AMAT
681  END IF
682  !
683  ! -- UPDATE PRECONDITIONER
684  CALL ims_base_pcu(this%iout, this%NJA, this%NEQ, this%NIAPC, this%NJAPC, &
685  this%IPC, this%RELAX, this%A0, this%IA0, this%JA0, &
686  this%APC, this%IAPC, this%JAPC, this%IW, this%W, &
687  this%LEVEL, this%DROPTOL, this%NJLU, this%NJW, &
688  this%NWLU, this%JLU, this%JW, this%WLU)
689  !
690  ! -- INITIALIZE SOLUTION VARIABLE AND ARRAYS
691  IF (kiter == 1) then
692  this%NITERC = 0
693  summary%iter_cnt = 0
694  end if
695  irc = 1
696  icnvg = 0
697  DO n = 1, this%NEQ
698  this%D(n) = dzero
699  this%P(n) = dzero
700  this%Q(n) = dzero
701  this%Z(n) = dzero
702  END DO
703  !
704  ! -- CALCULATE INITIAL RESIDUAL
705  call ims_base_residual(this%NEQ, this%NJA, this%X, this%RHS, this%D, &
706  this%A0, this%IA0, this%JA0)
707  this%L2NORM0 = dnrm2(this%NEQ, this%D, 1)
708  !
709  ! -- CHECK FOR EXACT SOLUTION
710  itmax = this%ITER1
711  IF (this%L2NORM0 == dzero) THEN
712  itmax = 0
713  icnvg = 1
714  END IF
715  !
716  ! -- SOLUTION BY THE CONJUGATE GRADIENT METHOD
717  IF (this%ILINMETH == 1) THEN
718  CALL ims_base_cg(icnvg, itmax, innerit, &
719  this%NEQ, this%NJA, this%NIAPC, this%NJAPC, &
720  this%IPC, this%ICNVGOPT, this%NORTH, &
721  this%DVCLOSE, this%RCLOSE, this%L2NORM0, &
722  this%EPFACT, this%IA0, this%JA0, this%A0, &
723  this%IAPC, this%JAPC, this%APC, &
724  this%X, this%RHS, this%D, this%P, this%Q, this%Z, &
725  this%NJLU, this%IW, this%JLU, &
726  nconv, convnmod, convmodstart, &
727  caccel, summary)
728  !
729  ! -- SOLUTION BY THE BICONJUGATE GRADIENT STABILIZED METHOD
730  ELSE IF (this%ILINMETH == 2) THEN
731  CALL ims_base_bcgs(icnvg, itmax, innerit, &
732  this%NEQ, this%NJA, this%NIAPC, this%NJAPC, &
733  this%IPC, this%ICNVGOPT, this%NORTH, &
734  this%ISCL, this%DSCALE, &
735  this%DVCLOSE, this%RCLOSE, this%L2NORM0, &
736  this%EPFACT, this%IA0, this%JA0, this%A0, &
737  this%IAPC, this%JAPC, this%APC, &
738  this%X, this%RHS, this%D, this%P, this%Q, &
739  this%T, this%V, this%DHAT, this%PHAT, this%QHAT, &
740  this%NJLU, this%IW, this%JLU, &
741  nconv, convnmod, convmodstart, &
742  caccel, summary)
743  END IF
744  !
745  ! -- BACK PERMUTE AMAT, SOLUTION, AND RHS
746  IF (this%IORD /= 0) THEN
747  CALL dperm(this%NEQ, this%A0, this%JA0, this%IA0, &
748  this%AMAT, this%JA, this%IA, &
749  this%IORDER, this%ID, 1)
750  CALL dvperm(this%NEQ, this%X, this%IORDER)
751  CALL dvperm(this%NEQ, this%RHS, this%IORDER)
752  END IF
753  !
754  ! -- UNSCALE PROBLEM
755  IF (this%ISCL .NE. 0) THEN
756  CALL ims_base_scale(1, this%ISCL, &
757  this%NEQ, this%NJA, this%IA, this%JA, &
758  this%AMAT, this%X, this%RHS, &
759  this%DSCALE, this%DSCALE2)
760  END IF
761  !
762  ! -- SET IMS INNER ITERATION NUMBER (IN_ITER) TO NUMBER OF
763  ! IMSLINEAR INNER ITERATIONS (innerit)
764  in_iter = innerit
765  !
766  ! -- RETURN
767  RETURN
dnrm2
real(kind=8) function dnrm2(n, x, incx)
Definition: blas1_d.f90:388
simmodule
This module contains simulation methods.
Definition: Sim.f90:10
dvperm
subroutine dvperm(n, x, perm)
Definition: sparsekit.f90:62
dperm
subroutine dperm(nrow, a, ja, ia, ao, jao, iao, perm, qperm, job)
Definition: sparsekit.f90:354
Here is the call graph for this function:

◆ imslinear_ar()

subroutine imslinearmodule::imslinear_ar ( class(imslineardatatype), intent(inout)  this,
character(len=lensolutionname), intent(in)  NAME,
integer(i4b), intent(in)  IOUT,
integer(i4b), intent(in), target  IPRIMS,
integer(i4b), intent(in)  MXITER,
integer(i4b), intent(in), target  NEQ,
class(matrixbasetype), pointer  matrix,
real(dp), dimension(neq), intent(inout), target  RHS,
real(dp), dimension(neq), intent(inout), target  X,
type(imslinearsettingstype), pointer  linear_settings 
)

Allocate storage for linear accelerators and read data

Parameters
[in,out]thisImsLinearDataType instance
[in]namesolution name
[in]ioutsimulation listing file unit
[in]iprimsprint option
[in]mxitermaximum outer iterations
[in]neqnumber of equations
[in,out]rhsright-hand side
[in,out]xdependent variables
linear_settingsthe settings form the IMS file

Definition at line 111 of file ImsLinear.f90.

113  ! -- modules
114  use memorymanagermodule, only: mem_allocate
115  use memoryhelpermodule, only: create_mem_path
116  use simmodule, only: store_error, count_errors, &
117  deprecation_warning
118  ! -- dummy variables
119  CLASS(ImsLinearDataType), INTENT(INOUT) :: this !< ImsLinearDataType instance
120  CHARACTER(LEN=LENSOLUTIONNAME), INTENT(IN) :: NAME !< solution name
121  integer(I4B), INTENT(IN) :: IOUT !< simulation listing file unit
122  integer(I4B), TARGET, INTENT(IN) :: IPRIMS !< print option
123  integer(I4B), INTENT(IN) :: MXITER !< maximum outer iterations
124  integer(I4B), TARGET, INTENT(IN) :: NEQ !< number of equations
125  class(MatrixBaseType), pointer :: matrix
126  real(DP), DIMENSION(NEQ), TARGET, INTENT(INOUT) :: RHS !< right-hand side
127  real(DP), DIMENSION(NEQ), TARGET, INTENT(INOUT) :: X !< dependent variables
128  type(ImsLinearSettingsType), pointer :: linear_settings !< the settings form the IMS file
129  ! -- local variables
130  character(len=LINELENGTH) :: errmsg
131  integer(I4B) :: n
132  integer(I4B) :: i0
133  integer(I4B) :: iscllen, iolen
134 
135  !
136  ! -- DEFINE NAME
137  this%memoryPath = create_mem_path(name, 'IMSLINEAR')
138  !
139  ! -- SET pointers to IMS settings
140  this%DVCLOSE => linear_settings%dvclose
141  this%RCLOSE => linear_settings%rclose
142  this%ICNVGOPT => linear_settings%icnvgopt
143  this%ITER1 => linear_settings%iter1
144  this%ILINMETH => linear_settings%ilinmeth
145  this%iSCL => linear_settings%iscl
146  this%IORD => linear_settings%iord
147  this%NORTH => linear_settings%north
148  this%RELAX => linear_settings%relax
149  this%LEVEL => linear_settings%level
150  this%DROPTOL => linear_settings%droptol
151  !
152  ! -- SET POINTERS TO SOLUTION STORAGE
153  this%IPRIMS => iprims
154  this%NEQ => neq
155  call matrix%get_aij(this%IA, this%JA, this%AMAT)
156  call mem_allocate(this%NJA, 'NJA', this%memoryPath)
157  this%NJA = size(this%AMAT)
158  this%RHS => rhs
159  this%X => x
160  !
161  ! -- ALLOCATE SCALAR VARIABLES
162  call this%allocate_scalars()
163  !
164  ! -- initialize iout
165  this%iout = iout
166  !
167  ! -- DEFAULT VALUES
168  this%IPC = 0
169  !
170  this%IACPC = 0
171  !
172  ! -- PRINT A MESSAGE IDENTIFYING IMSLINEAR SOLVER PACKAGE
173  write (iout, 2000)
174 02000 FORMAT(1x, /1x, 'IMSLINEAR -- UNSTRUCTURED LINEAR SOLUTION', &
175  ' PACKAGE, VERSION 8, 04/28/2017')
176  !
177  ! -- DETERMINE PRECONDITIONER
178  IF (this%LEVEL > 0 .OR. this%DROPTOL > dzero) THEN
179  this%IPC = 3
180  ELSE
181  this%IPC = 1
182  END IF
183  IF (this%RELAX > dzero) THEN
184  this%IPC = this%IPC + 1
185  END IF
186  !
187  ! -- ERROR CHECKING FOR OPTIONS
188  IF (this%ISCL < 0) this%ISCL = 0
189  IF (this%ISCL > 2) THEN
190  WRITE (errmsg, '(A)') 'IMSLINEAR7AR ISCL MUST BE <= 2'
191  call store_error(errmsg)
192  END IF
193  IF (this%IORD < 0) this%IORD = 0
194  IF (this%IORD > 2) THEN
195  WRITE (errmsg, '(A)') 'IMSLINEAR7AR IORD MUST BE <= 2'
196  call store_error(errmsg)
197  END IF
198  IF (this%NORTH < 0) THEN
199  WRITE (errmsg, '(A)') 'IMSLINEAR7AR NORTH MUST >= 0'
200  call store_error(errmsg)
201  END IF
202  IF (this%RCLOSE == dzero) THEN
203  IF (this%ICNVGOPT /= 3) THEN
204  WRITE (errmsg, '(A)') 'IMSLINEAR7AR RCLOSE MUST > 0.0'
205  call store_error(errmsg)
206  END IF
207  END IF
208  IF (this%RELAX < dzero) THEN
209  WRITE (errmsg, '(A)') 'IMSLINEAR7AR RELAX MUST BE >= 0.0'
210  call store_error(errmsg)
211  END IF
212  IF (this%RELAX > done) THEN
213  WRITE (errmsg, '(A)') 'IMSLINEAR7AR RELAX MUST BE <= 1.0'
214  call store_error(errmsg)
215  END IF
216  !
217  ! -- INITIALIZE IMSLINEAR VARIABLES
218  this%NITERC = 0
219  !
220  ! -- ALLOCATE AND INITIALIZE MEMORY FOR IMSLINEAR
221  iscllen = 1
222  IF (this%ISCL .NE. 0) iscllen = neq
223  CALL mem_allocate(this%DSCALE, iscllen, 'DSCALE', trim(this%memoryPath))
224  CALL mem_allocate(this%DSCALE2, iscllen, 'DSCALE2', trim(this%memoryPath))
225  !
226  ! -- determine dimensions for preconditing arrays
227  call ims_calc_pcdims(this%NEQ, this%NJA, this%IA, this%LEVEL, this%IPC, &
228  this%NIAPC, this%NJAPC, this%NJLU, this%NJW, this%NWLU)
229  !
230  ! -- ALLOCATE BASE PRECONDITIONER VECTORS
231  CALL mem_allocate(this%IAPC, this%NIAPC + 1, 'IAPC', trim(this%memoryPath))
232  CALL mem_allocate(this%JAPC, this%NJAPC, 'JAPC', trim(this%memoryPath))
233  CALL mem_allocate(this%APC, this%NJAPC, 'APC', trim(this%memoryPath))
234  !
235  ! -- ALLOCATE MEMORY FOR ILU0 AND MILU0 NON-ZERO ROW ENTRY VECTOR
236  CALL mem_allocate(this%IW, this%NIAPC, 'IW', trim(this%memoryPath))
237  CALL mem_allocate(this%W, this%NIAPC, 'W', trim(this%memoryPath))
238  !
239  ! -- ALLOCATE MEMORY FOR ILUT VECTORS
240  CALL mem_allocate(this%JLU, this%NJLU, 'JLU', trim(this%memoryPath))
241  CALL mem_allocate(this%JW, this%NJW, 'JW', trim(this%memoryPath))
242  CALL mem_allocate(this%WLU, this%NWLU, 'WLU', trim(this%memoryPath))
243  !
244  ! -- GENERATE IAPC AND JAPC FOR ILU0 AND MILU0
245  IF (this%IPC == 1 .OR. this%IPC == 2) THEN
246  CALL ims_base_pccrs(this%NEQ, this%NJA, this%IA, this%JA, &
247  this%IAPC, this%JAPC)
248  END IF
249  !
250  ! -- ALLOCATE SPACE FOR PERMUTATION VECTOR
251  i0 = 1
252  iolen = 1
253  IF (this%IORD .NE. 0) THEN
254  i0 = this%NEQ
255  iolen = this%NJA
256  END IF
257  CALL mem_allocate(this%LORDER, i0, 'LORDER', trim(this%memoryPath))
258  CALL mem_allocate(this%IORDER, i0, 'IORDER', trim(this%memoryPath))
259  CALL mem_allocate(this%IARO, i0 + 1, 'IARO', trim(this%memoryPath))
260  CALL mem_allocate(this%JARO, iolen, 'JARO', trim(this%memoryPath))
261  CALL mem_allocate(this%ARO, iolen, 'ARO', trim(this%memoryPath))
262  !
263  ! -- ALLOCATE WORKING VECTORS FOR IMSLINEAR SOLVER
264  CALL mem_allocate(this%ID, this%NEQ, 'ID', trim(this%memoryPath))
265  CALL mem_allocate(this%D, this%NEQ, 'D', trim(this%memoryPath))
266  CALL mem_allocate(this%P, this%NEQ, 'P', trim(this%memoryPath))
267  CALL mem_allocate(this%Q, this%NEQ, 'Q', trim(this%memoryPath))
268  CALL mem_allocate(this%Z, this%NEQ, 'Z', trim(this%memoryPath))
269  !
270  ! -- ALLOCATE MEMORY FOR BCGS WORKING ARRAYS
271  this%NIABCGS = 1
272  IF (this%ILINMETH == 2) THEN
273  this%NIABCGS = this%NEQ
274  END IF
275  CALL mem_allocate(this%T, this%NIABCGS, 'T', trim(this%memoryPath))
276  CALL mem_allocate(this%V, this%NIABCGS, 'V', trim(this%memoryPath))
277  CALL mem_allocate(this%DHAT, this%NIABCGS, 'DHAT', trim(this%memoryPath))
278  CALL mem_allocate(this%PHAT, this%NIABCGS, 'PHAT', trim(this%memoryPath))
279  CALL mem_allocate(this%QHAT, this%NIABCGS, 'QHAT', trim(this%memoryPath))
280  !
281  ! -- INITIALIZE IMSLINEAR VECTORS
282  DO n = 1, iscllen
283  this%DSCALE(n) = done
284  this%DSCALE2(n) = done
285  END DO
286  DO n = 1, this%NJAPC
287  this%APC(n) = dzero
288  END DO
289  !
290  ! -- WORKING VECTORS
291  DO n = 1, this%NEQ
292  this%ID(n) = izero
293  this%D(n) = dzero
294  this%P(n) = dzero
295  this%Q(n) = dzero
296  this%Z(n) = dzero
297  END DO
298  DO n = 1, this%NIAPC
299  this%IW(n) = izero
300  this%W(n) = dzero
301  END DO
302  !
303  ! -- BCGS WORKING VECTORS
304  DO n = 1, this%NIABCGS
305  this%T(n) = dzero
306  this%V(n) = dzero
307  this%DHAT(n) = dzero
308  this%PHAT(n) = dzero
309  this%QHAT(n) = dzero
310  END DO
311  !
312  ! -- ILUT AND MILUT WORKING VECTORS
313  DO n = 1, this%NJLU
314  this%JLU(n) = izero
315  END DO
316  DO n = 1, this%NJW
317  this%JW(n) = izero
318  END DO
319  DO n = 1, this%NWLU
320  this%WLU(n) = dzero
321  END DO
322  !
323  ! -- REORDERING VECTORS
324  DO n = 1, i0 + 1
325  this%IARO(n) = izero
326  END DO
327  DO n = 1, iolen
328  this%JARO(n) = izero
329  this%ARO(n) = dzero
330  END DO
331  !
332  ! -- REVERSE CUTHILL MCKEE AND MINIMUM DEGREE ORDERING
333  IF (this%IORD .NE. 0) THEN
334  CALL ims_base_calc_order(this%IORD, this%NEQ, this%NJA, this%IA, &
335  this%JA, this%LORDER, this%IORDER)
336  END IF
337  !
338  ! -- ALLOCATE MEMORY FOR STORING ITERATION CONVERGENCE DATA
339  !
340  ! -- RETURN
341  RETURN
memoryhelpermodule::create_mem_path
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
Definition: MemoryHelper.f90:22
simmodule::store_error
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
simmodule::count_errors
integer(i4b) function, public count_errors()
Return number of errors.
Definition: Sim.f90:59
simmodule::deprecation_warning
subroutine, public deprecation_warning(cblock, cvar, cver, endmsg, iunit)
Store deprecation warning message.
Definition: Sim.f90:259
Here is the call graph for this function:

◆ imslinear_da()

subroutine imslinearmodule::imslinear_da ( class(imslineardatatype), intent(inout)  this)

Deallocate linear accelerator memory.

Parameters
[in,out]thislinear datatype instance

Definition at line 504 of file ImsLinear.f90.

505  ! -- modules
506  use memorymanagermodule, only: mem_deallocate
507  ! -- dummy variables
508  class(ImsLinearDataType), intent(inout) :: this !< linear datatype instance
509  !
510  ! -- arrays
511  call mem_deallocate(this%dscale)
512  call mem_deallocate(this%dscale2)
513  call mem_deallocate(this%iapc)
514  call mem_deallocate(this%japc)
515  call mem_deallocate(this%apc)
516  call mem_deallocate(this%iw)
517  call mem_deallocate(this%w)
518  call mem_deallocate(this%jlu)
519  call mem_deallocate(this%jw)
520  call mem_deallocate(this%wlu)
521  call mem_deallocate(this%lorder)
522  call mem_deallocate(this%iorder)
523  call mem_deallocate(this%iaro)
524  call mem_deallocate(this%jaro)
525  call mem_deallocate(this%aro)
526  call mem_deallocate(this%id)
527  call mem_deallocate(this%d)
528  call mem_deallocate(this%p)
529  call mem_deallocate(this%q)
530  call mem_deallocate(this%z)
531  call mem_deallocate(this%t)
532  call mem_deallocate(this%v)
533  call mem_deallocate(this%dhat)
534  call mem_deallocate(this%phat)
535  call mem_deallocate(this%qhat)
536  !
537  ! -- scalars
538  call mem_deallocate(this%iout)
539  call mem_deallocate(this%ipc)
540  call mem_deallocate(this%iacpc)
541  call mem_deallocate(this%niterc)
542  call mem_deallocate(this%niabcgs)
543  call mem_deallocate(this%niapc)
544  call mem_deallocate(this%njapc)
545  call mem_deallocate(this%epfact)
546  call mem_deallocate(this%l2norm0)
547  call mem_deallocate(this%njlu)
548  call mem_deallocate(this%njw)
549  call mem_deallocate(this%nwlu)
550  call mem_deallocate(this%NJA)
551  !
552  ! -- nullify pointers
553  nullify (this%iprims)
554  nullify (this%neq)
555  nullify (this%nja)
556  nullify (this%ia)
557  nullify (this%ja)
558  nullify (this%amat)
559  nullify (this%rhs)
560  nullify (this%x)
561  !
562  ! -- return
563  return
memorymanagermodule::mem_deallocate
Definition: MemoryManager.f90:121

◆ imslinear_set_input()

subroutine imslinearmodule::imslinear_set_input ( class(imslineardatatype), intent(inout)  this,
integer(i4b), intent(in)  IFDPARAM 
)

Set default linear accelerator settings.

Parameters
[in,out]thisImsLinearDataType instance
[in]ifdparamcomplexity option

Definition at line 571 of file ImsLinear.f90.

572  ! -- dummy variables
573  CLASS(ImsLinearDataType), INTENT(INOUT) :: this !< ImsLinearDataType instance
574  integer(I4B), INTENT(IN) :: IFDPARAM !< complexity option
575  ! -- code
576  SELECT CASE (ifdparam)
577  !
578  ! -- Simple option
579  CASE (1)
580  this%ITER1 = 50
581  this%ILINMETH = 1
582  this%IPC = 1
583  this%ISCL = 0
584  this%IORD = 0
585  this%DVCLOSE = dem3
586  this%RCLOSE = dem1
587  this%RELAX = dzero
588  this%LEVEL = 0
589  this%DROPTOL = dzero
590  this%NORTH = 0
591  !
592  ! -- Moderate
593  CASE (2)
594  this%ITER1 = 100
595  this%ILINMETH = 2
596  this%IPC = 2
597  this%ISCL = 0
598  this%IORD = 0
599  this%DVCLOSE = dem2
600  this%RCLOSE = dem1
601  this%RELAX = 0.97d0
602  this%LEVEL = 0
603  this%DROPTOL = dzero
604  this%NORTH = 0
605  !
606  ! -- Complex
607  CASE (3)
608  this%ITER1 = 500
609  this%ILINMETH = 2
610  this%IPC = 3
611  this%ISCL = 0
612  this%IORD = 0
613  this%DVCLOSE = dem1
614  this%RCLOSE = dem1
615  this%RELAX = dzero
616  this%LEVEL = 5
617  this%DROPTOL = dem4
618  this%NORTH = 2
619  END SELECT
620  !
621  ! -- return
622  RETURN

◆ imslinear_summary()

subroutine imslinearmodule::imslinear_summary ( class(imslineardatatype), intent(inout)  this,
integer(i4b), intent(in)  mxiter 
)

Write summary of linear accelerator settings.

Parameters
[in,out]thisImsLinearDataType instance
[in]mxitermaximum number of outer iterations

Definition at line 349 of file ImsLinear.f90.

350  ! -- dummy variables
351  class(ImsLinearDataType), intent(inout) :: this !< ImsLinearDataType instance
352  integer(I4B), intent(in) :: mxiter !< maximum number of outer iterations
353  ! -- local variables
354  CHARACTER(LEN=10) :: clin(0:2)
355  CHARACTER(LEN=31) :: clintit(0:2)
356  CHARACTER(LEN=20) :: cipc(0:4)
357  CHARACTER(LEN=20) :: cscale(0:2)
358  CHARACTER(LEN=25) :: corder(0:2)
359  CHARACTER(LEN=16), DIMENSION(0:4) :: ccnvgopt
360  CHARACTER(LEN=15) :: clevel
361  CHARACTER(LEN=15) :: cdroptol
362  integer(I4B) :: i
363  integer(I4B) :: j
364  ! -- data
365  DATA clin/'UNKNOWN ', &
366  &'CG ', &
367  &'BCGS '/
368  DATA clintit/' UNKNOWN ', &
369  &' CONJUGATE-GRADIENT ', &
370  &'BICONJUGATE-GRADIENT STABILIZED'/
371  DATA cipc/'UNKNOWN ', &
372  &'INCOMPLETE LU ', &
373  &'MOD. INCOMPLETE LU ', &
374  &'INCOMPLETE LUT ', &
375  &'MOD. INCOMPLETE LUT '/
376  DATA cscale/'NO SCALING ', &
377  &'SYMMETRIC SCALING ', &
378  &'L2 NORM SCALING '/
379  DATA corder/'ORIGINAL ORDERING ', &
380  &'RCM ORDERING ', &
381  &'MINIMUM DEGREE ORDERING '/
382  DATA ccnvgopt/'INFINITY NORM ', &
383  &'INFINITY NORM S ', &
384  &'L2 NORM ', &
385  &'RELATIVE L2NORM ', &
386  &'L2 NORM W. REL. '/
387  ! -- formats
388 02010 FORMAT(1x, /, 7x, 'SOLUTION BY THE', 1x, a31, 1x, 'METHOD', &
389  /, 1x, 66('-'), /, &
390  ' MAXIMUM OF ', i0, ' CALLS OF SOLUTION ROUTINE', /, &
391  ' MAXIMUM OF ', i0, &
392  ' INTERNAL ITERATIONS PER CALL TO SOLUTION ROUTINE', /, &
393  ' LINEAR ACCELERATION METHOD =', 1x, a, /, &
394  ' MATRIX PRECONDITIONING TYPE =', 1x, a, /, &
395  ' MATRIX SCALING APPROACH =', 1x, a, /, &
396  ' MATRIX REORDERING APPROACH =', 1x, a, /, &
397  ' NUMBER OF ORTHOGONALIZATIONS =', 1x, i0, /, &
398  ' HEAD CHANGE CRITERION FOR CLOSURE =', e15.5, /, &
399  ' RESIDUAL CHANGE CRITERION FOR CLOSURE =', e15.5, /, &
400  ' RESIDUAL CONVERGENCE OPTION =', 1x, i0, /, &
401  ' RESIDUAL CONVERGENCE NORM =', 1x, a, /, &
402  ' RELAXATION FACTOR =', e15.5)
403 02015 FORMAT(' NUMBER OF LEVELS =', a15, /, &
404  ' DROP TOLERANCE =', a15, //)
405 2030 FORMAT(1x, a20, 1x, 6(i6, 1x))
406 2040 FORMAT(1x, 20('-'), 1x, 6(6('-'), 1x))
407 2050 FORMAT(1x, 62('-'),/) !
408 ! -- -----------------------------------------------------------
409  !
410  ! -- initialize clevel and cdroptol
411  clevel = ''
412  cdroptol = ''
413  !
414  ! -- write common variables to all linear accelerators
415  write (this%iout, 2010) &
416  clintit(this%ILINMETH), mxiter, this%ITER1, &
417  clin(this%ILINMETH), cipc(this%IPC), &
418  cscale(this%ISCL), corder(this%IORD), &
419  this%NORTH, this%DVCLOSE, this%RCLOSE, &
420  this%ICNVGOPT, ccnvgopt(this%ICNVGOPT), &
421  this%RELAX
422  if (this%level > 0) then
423  write (clevel, '(i15)') this%level
424  end if
425  if (this%droptol > dzero) then
426  write (cdroptol, '(e15.5)') this%droptol
427  end if
428  IF (this%level > 0 .or. this%droptol > dzero) THEN
429  write (this%iout, 2015) trim(adjustl(clevel)), &
430  trim(adjustl(cdroptol))
431  ELSE
432  write (this%iout, '(//)')
433  END IF
434 
435  if (this%iord /= 0) then
436  !
437  ! -- WRITE SUMMARY OF REORDERING INFORMATION TO LIST FILE
438  if (this%iprims == 2) then
439  DO i = 1, this%neq, 6
440  write (this%iout, 2030) 'ORIGINAL NODE :', &
441  (j, j=i, min(i + 5, this%neq))
442  write (this%iout, 2040)
443  write (this%iout, 2030) 'REORDERED INDEX :', &
444  (this%lorder(j), j=i, min(i + 5, this%neq))
445  write (this%iout, 2030) 'REORDERED NODE :', &
446  (this%iorder(j), j=i, min(i + 5, this%neq))
447  write (this%iout, 2050)
448  END DO
449  END IF
450  end if
451  !
452  ! -- return
453  return