58 character(len=LENMEMPATH) :: memory_path
59 character(len=LINELENGTH) :: fname
60 character(len=16) :: solver_mode
63 integer(I4B),
pointer :: id
64 integer(I4B),
pointer :: iu
65 real(dp),
pointer :: ttform
66 real(dp),
pointer :: ttsoln
67 integer(I4B),
pointer :: isymmetric => null()
68 integer(I4B),
pointer :: neq => null()
69 integer(I4B),
pointer :: matrix_offset => null()
74 real(dp),
dimension(:),
pointer,
contiguous :: rhs => null()
75 real(dp),
dimension(:),
pointer,
contiguous :: x => null()
76 integer(I4B),
dimension(:),
pointer,
contiguous :: active => null()
77 real(dp),
dimension(:),
pointer,
contiguous :: xtemp => null()
81 real(dp),
pointer :: theta => null()
82 real(dp),
pointer :: akappa => null()
83 real(dp),
pointer :: gamma => null()
84 real(dp),
pointer :: amomentum => null()
85 real(dp),
pointer :: breduc => null()
86 real(dp),
pointer :: btol => null()
87 real(dp),
pointer :: res_lim => null()
88 real(dp),
pointer :: dvclose => null()
89 real(dp),
pointer :: bigchold => null()
90 real(dp),
pointer :: bigch => null()
91 real(dp),
pointer :: relaxold => null()
92 real(dp),
pointer :: res_prev => null()
93 real(dp),
pointer :: res_new => null()
94 integer(I4B),
pointer :: icnvg => null()
95 integer(I4B),
pointer :: itertot_timestep => null()
96 integer(I4B),
pointer :: iouttot_timestep => null()
97 integer(I4B),
pointer :: itertot_sim => null()
98 integer(I4B),
pointer :: mxiter => null()
99 integer(I4B),
pointer :: linsolver => null()
100 integer(I4B),
pointer :: nonmeth => null()
101 integer(I4B),
pointer :: numtrack => null()
102 integer(I4B),
pointer :: iprims => null()
103 integer(I4B),
pointer :: ibflag => null()
104 integer(I4B),
dimension(:, :),
pointer,
contiguous :: lrch => null()
105 real(dp),
dimension(:),
pointer,
contiguous :: hncg => null()
106 real(dp),
dimension(:),
pointer,
contiguous :: dxold => null()
107 real(dp),
dimension(:),
pointer,
contiguous :: deold => null()
108 real(dp),
dimension(:),
pointer,
contiguous :: wsave => null()
109 real(dp),
dimension(:),
pointer,
contiguous :: hchold => null()
112 character(len=31),
dimension(:),
pointer,
contiguous :: caccel => null()
113 integer(I4B),
pointer :: icsvouterout => null()
114 integer(I4B),
pointer :: icsvinnerout => null()
115 integer(I4B),
pointer :: nitermax => null()
116 integer(I4B),
pointer :: convnmod => null()
117 integer(I4B),
dimension(:),
pointer,
contiguous :: convmodstart => null()
124 integer(I4B),
pointer :: iallowptc => null()
125 integer(I4B),
pointer :: iptcopt => null()
126 integer(I4B),
pointer :: iptcout => null()
127 real(dp),
pointer :: l2norm0 => null()
128 real(dp),
pointer :: ptcdel => null()
129 real(dp),
pointer :: ptcdel0 => null()
130 real(dp),
pointer :: ptcexp => null()
133 integer(I4B) :: tmr_prep_solve
134 integer(I4B) :: tmr_solve
135 integer(I4B) :: tmr_final_solve
136 integer(I4B) :: tmr_formulate
137 integer(I4B) :: tmr_linsolve
138 integer(I4B) :: tmr_flows
139 integer(I4B) :: tmr_budgets
140 character(len=24) :: id_postfix
143 real(dp),
pointer :: atsfrac => null()
156 class(*),
pointer :: synchronize_ctx => null()
218 integer(I4B) :: stage
219 class(*),
pointer :: ctx
238 character(len=*),
intent(in) :: filename
239 integer(I4B),
intent(in) :: id
241 integer(I4B) :: inunit
243 character(len=LENSOLUTIONNAME) :: solutionname
247 write (solutionname,
'(a, i0)')
'SLN_', id
249 num_sol%name = solutionname
251 allocate (num_sol%modellist)
252 allocate (num_sol%exchangelist)
254 call num_sol%allocate_scalars()
263 inquire (file=filename, number=inunit)
265 if (inunit < 0) inunit =
getunit()
267 write (
iout,
'(/a,a)')
' Creating solution: ', num_sol%name
271 call num_sol%parser%Initialize(num_sol%iu,
iout)
288 call mem_allocate(this%ttform,
'TTFORM', this%memory_path)
289 call mem_allocate(this%ttsoln,
'TTSOLN', this%memory_path)
290 call mem_allocate(this%isymmetric,
'ISYMMETRIC', this%memory_path)
292 call mem_allocate(this%matrix_offset,
'MATRIX_OFFSET', this%memory_path)
293 call mem_allocate(this%dvclose,
'DVCLOSE', this%memory_path)
294 call mem_allocate(this%bigchold,
'BIGCHOLD', this%memory_path)
295 call mem_allocate(this%bigch,
'BIGCH', this%memory_path)
296 call mem_allocate(this%relaxold,
'RELAXOLD', this%memory_path)
297 call mem_allocate(this%res_prev,
'RES_PREV', this%memory_path)
298 call mem_allocate(this%res_new,
'RES_NEW', this%memory_path)
299 call mem_allocate(this%icnvg,
'ICNVG', this%memory_path)
300 call mem_allocate(this%itertot_timestep,
'ITERTOT_TIMESTEP', this%memory_path)
301 call mem_allocate(this%iouttot_timestep,
'IOUTTOT_TIMESTEP', this%memory_path)
302 call mem_allocate(this%itertot_sim,
'INNERTOT_SIM', this%memory_path)
303 call mem_allocate(this%mxiter,
'MXITER', this%memory_path)
304 call mem_allocate(this%linsolver,
'LINSOLVER', this%memory_path)
305 call mem_allocate(this%nonmeth,
'NONMETH', this%memory_path)
306 call mem_allocate(this%iprims,
'IPRIMS', this%memory_path)
307 call mem_allocate(this%theta,
'THETA', this%memory_path)
308 call mem_allocate(this%akappa,
'AKAPPA', this%memory_path)
309 call mem_allocate(this%gamma,
'GAMMA', this%memory_path)
310 call mem_allocate(this%amomentum,
'AMOMENTUM', this%memory_path)
311 call mem_allocate(this%breduc,
'BREDUC', this%memory_path)
313 call mem_allocate(this%res_lim,
'RES_LIM', this%memory_path)
314 call mem_allocate(this%numtrack,
'NUMTRACK', this%memory_path)
315 call mem_allocate(this%ibflag,
'IBFLAG', this%memory_path)
316 call mem_allocate(this%icsvouterout,
'ICSVOUTEROUT', this%memory_path)
317 call mem_allocate(this%icsvinnerout,
'ICSVINNEROUT', this%memory_path)
318 call mem_allocate(this%nitermax,
'NITERMAX', this%memory_path)
319 call mem_allocate(this%convnmod,
'CONVNMOD', this%memory_path)
320 call mem_allocate(this%iallowptc,
'IALLOWPTC', this%memory_path)
321 call mem_allocate(this%iptcopt,
'IPTCOPT', this%memory_path)
322 call mem_allocate(this%iptcout,
'IPTCOUT', this%memory_path)
323 call mem_allocate(this%l2norm0,
'L2NORM0', this%memory_path)
324 call mem_allocate(this%ptcdel,
'PTCDEL', this%memory_path)
325 call mem_allocate(this%ptcdel0,
'PTCDEL0', this%memory_path)
326 call mem_allocate(this%ptcexp,
'PTCEXP', this%memory_path)
327 call mem_allocate(this%atsfrac,
'ATSFRAC', this%memory_path)
337 this%bigchold =
dzero
339 this%relaxold =
dzero
340 this%res_prev =
dzero
342 this%itertot_timestep = 0
343 this%iouttot_timestep = 0
352 this%amomentum =
dzero
358 this%icsvouterout = 0
359 this%icsvinnerout = 0
388 this%convnmod = this%modellist%Count()
391 call mem_allocate(this%active, this%neq,
'IACTIVE', this%memory_path)
392 call mem_allocate(this%xtemp, this%neq,
'XTEMP', this%memory_path)
393 call mem_allocate(this%dxold, this%neq,
'DXOLD', this%memory_path)
394 call mem_allocate(this%hncg, 0,
'HNCG', this%memory_path)
395 call mem_allocate(this%lrch, 3, 0,
'LRCH', this%memory_path)
396 call mem_allocate(this%wsave, 0,
'WSAVE', this%memory_path)
397 call mem_allocate(this%hchold, 0,
'HCHOLD', this%memory_path)
398 call mem_allocate(this%deold, 0,
'DEOLD', this%memory_path)
399 call mem_allocate(this%convmodstart, this%convnmod + 1,
'CONVMODSTART', &
404 this%xtemp(i) =
dzero
405 this%dxold(i) =
dzero
411 this%convmodstart(1) = ieq
412 do i = 1, this%modellist%Count()
415 this%convmodstart(i + 1) = ieq
437 integer(I4B),
allocatable,
dimension(:) :: rowmaxnnz
438 integer(I4B) :: ncol, irow_start, irow_end
439 integer(I4B) :: mod_offset
442 do i = 1, this%modellist%Count()
444 call mp%set_idsoln(this%id)
445 this%neq = this%neq + mp%neq
450 this%solver_mode =
'PETSC'
452 this%solver_mode =
'IMS'
456 allocate (this%linear_settings)
460 this%system_matrix => this%linear_solver%create_matrix()
461 this%vec_x => this%system_matrix%create_vec_mm(this%neq,
'X', &
463 this%x => this%vec_x%get_array()
464 this%vec_rhs => this%system_matrix%create_vec_mm(this%neq,
'RHS', &
466 this%rhs => this%vec_rhs%get_array()
468 call this%vec_rhs%get_ownership_range(irow_start, irow_end)
469 ncol = this%vec_rhs%get_size()
473 this%matrix_offset = irow_start - 1
474 do i = 1, this%modellist%Count()
481 call this%allocate_arrays()
484 allocate (this%cnvg_summary)
485 call this%cnvg_summary%init(this%modellist%Count(), this%convmodstart, &
489 do i = 1, this%modellist%Count()
491 call mp%set_xptr(this%x, this%matrix_offset,
'X', this%name)
492 call mp%set_rhsptr(this%rhs, this%matrix_offset,
'RHS', this%name)
493 call mp%set_iboundptr(this%active, this%matrix_offset,
'IBOUND', this%name)
497 allocate (rowmaxnnz(this%neq))
501 call this%sparse%init(this%neq, ncol, rowmaxnnz)
502 this%sparse%offset = this%matrix_offset
503 deallocate (rowmaxnnz)
506 call this%sln_connect()
509 write (this%id_postfix,
'(a,i0,a)')
" (", this%id,
")"
510 this%tmr_prep_solve = -1
512 this%tmr_final_solve = -1
513 this%tmr_formulate = -1
514 this%tmr_linsolve = -1
516 this%tmr_budgets = -1
536 character(len=linelength) :: warnmsg
537 character(len=linelength) :: keyword
538 character(len=linelength) :: fname
539 character(len=linelength) :: msg
541 integer(I4B) :: ifdparam, mxvl, npp
543 logical(LGP) :: isfound, endOfBlock
546 character(len=*),
parameter :: fmtcsvout = &
547 "(4x, 'CSV OUTPUT WILL BE SAVED TO FILE: ', a, &
548 &/4x, 'OPENED ON UNIT: ', I7)"
549 character(len=*),
parameter :: fmtptcout = &
550 "(4x, 'PTC OUTPUT WILL BE SAVED TO FILE: ', a, &
551 &/4x, 'OPENED ON UNIT: ', I7)"
552 character(len=*),
parameter :: fmterrasym = &
553 "(a,' **',a,'** PRODUCES AN ASYMMETRIC COEFFICIENT MATRIX, BUT THE &
554 &CONJUGATE GRADIENT METHOD WAS SELECTED. USE BICGSTAB INSTEAD. ')"
557 WRITE (
iout, 1) this%iu
558 00001
FORMAT(1x, /1x,
'IMS -- ITERATIVE MODEL SOLUTION PACKAGE, VERSION 6', &
559 ', 4/28/2017', /, 9x,
'INPUT READ FROM UNIT', i5)
568 call this%parser%GetBlock(
'OPTIONS', isfound, ierr, &
569 supportopenclose=.true., blockrequired=.false.)
573 write (
iout,
'(/1x,a)')
'PROCESSING IMS OPTIONS'
575 call this%parser%GetNextLine(endofblock)
577 call this%parser%GetStringCaps(keyword)
578 select case (keyword)
579 case (
'PRINT_OPTION')
580 call this%parser%GetStringCaps(keyword)
581 if (keyword .eq.
'NONE')
then
583 else if (keyword .eq.
'SUMMARY')
then
585 else if (keyword .eq.
'ALL')
then
588 write (errmsg,
'(3a)') &
589 'Unknown IMS print option (', trim(keyword),
').'
593 call this%parser%GetStringCaps(keyword)
594 if (keyword .eq.
'SIMPLE')
then
597 else if (keyword .eq.
'MODERATE')
then
600 else if (keyword .eq.
'COMPLEX')
then
604 write (errmsg,
'(3a)') &
605 'Unknown IMS COMPLEXITY option (', trim(keyword),
').'
608 case (
'CSV_OUTER_OUTPUT')
609 call this%parser%GetStringCaps(keyword)
610 if (keyword ==
'FILEOUT')
then
611 call this%parser%GetString(fname)
612 if (nr_procs > 1)
then
613 call append_processor_id(fname, proc_id)
616 call openfile(this%icsvouterout,
iout, fname,
'CSV_OUTER_OUTPUT', &
617 filstat_opt=
'REPLACE')
618 write (
iout, fmtcsvout) trim(fname), this%icsvouterout
620 write (errmsg,
'(a)')
'Optional CSV_OUTER_OUTPUT '// &
621 'keyword must be followed by FILEOUT'
624 case (
'CSV_INNER_OUTPUT')
625 call this%parser%GetStringCaps(keyword)
626 if (keyword ==
'FILEOUT')
then
627 call this%parser%GetString(fname)
628 if (nr_procs > 1)
then
629 call append_processor_id(fname, proc_id)
632 call openfile(this%icsvinnerout,
iout, fname,
'CSV_INNER_OUTPUT', &
633 filstat_opt=
'REPLACE')
634 write (
iout, fmtcsvout) trim(fname), this%icsvinnerout
636 write (errmsg,
'(a)')
'Optional CSV_INNER_OUTPUT '// &
637 'keyword must be followed by FILEOUT'
641 call this%parser%GetStringCaps(keyword)
642 select case (keyword)
653 this%iallowptc = ival
654 write (
iout,
'(1x,A)')
'PSEUDO-TRANSIENT CONTINUATION DISABLED FOR'// &
655 ' '//trim(adjustl(msg))//
' STRESS-PERIOD(S)'
656 case (
'ATS_OUTER_MAXIMUM_FRACTION')
657 rval = this%parser%GetDouble()
659 write (errmsg,
'(a,G0)')
'Value for ATS_OUTER_MAXIMUM_FRAC must be &
660 &between 0 and 0.5. Found ', rval
664 write (
iout,
'(1x,A,G0)')
'ADAPTIVE TIME STEP SETTING FOUND. FRACTION &
665 &OF OUTER MAXIMUM USED TO INCREASE OR DECREASE TIME STEP SIZE IS ',&
670 call this%parser%GetStringCaps(keyword)
671 if (keyword ==
'FILEOUT')
then
672 call this%parser%GetString(fname)
674 call openfile(this%icsvouterout,
iout, fname,
'CSV_OUTPUT', &
675 filstat_opt=
'REPLACE')
676 write (
iout, fmtcsvout) trim(fname), this%icsvouterout
679 write (warnmsg,
'(a)') &
680 'OUTER ITERATION INFORMATION WILL BE SAVED TO '//trim(fname)
684 warnmsg, this%parser%GetUnit())
686 write (errmsg,
'(a)')
'Optional CSV_OUTPUT '// &
687 'keyword must be followed by FILEOUT'
696 call this%parser%DevOpt()
698 write (
iout,
'(1x,A)')
'PSEUDO-TRANSIENT CONTINUATION ENABLED'
699 case (
'DEV_PTC_OUTPUT')
700 call this%parser%DevOpt()
702 call this%parser%GetStringCaps(keyword)
703 if (keyword ==
'FILEOUT')
then
704 call this%parser%GetString(fname)
705 if (nr_procs > 1)
then
706 call append_processor_id(fname, proc_id)
710 filstat_opt=
'REPLACE')
711 write (
iout, fmtptcout) trim(fname), this%iptcout
713 write (errmsg,
'(a)') &
714 'Optional PTC_OUTPUT keyword must be followed by FILEOUT'
717 case (
'DEV_PTC_OPTION')
718 call this%parser%DevOpt()
721 write (
iout,
'(1x,A)') &
722 'PSEUDO-TRANSIENT CONTINUATION USES BNORM AND L2NORM TO '// &
724 case (
'DEV_PTC_EXPONENT')
725 call this%parser%DevOpt()
726 rval = this%parser%GetDouble()
727 if (rval <
dzero)
then
728 write (errmsg,
'(a)')
'PTC_EXPONENT must be > 0.'
733 write (
iout,
'(1x,A,1x,g15.7)') &
734 'PSEUDO-TRANSIENT CONTINUATION EXPONENT', this%ptcexp
736 case (
'DEV_PTC_DEL0')
737 call this%parser%DevOpt()
738 rval = this%parser%GetDouble()
739 if (rval <
dzero)
then
740 write (errmsg,
'(a)')
'IMS sln_ar: PTC_DEL0 must be > 0.'
745 write (
iout,
'(1x,A,1x,g15.7)') &
746 'PSEUDO-TRANSIENT CONTINUATION INITIAL TIMESTEP', this%ptcdel0
749 write (errmsg,
'(a,2(1x,a))') &
750 'Unknown IMS option (', trim(keyword),
').'
754 write (
iout,
'(1x,a)')
'END OF IMS OPTIONS'
756 write (
iout,
'(1x,a)')
'NO IMS OPTION BLOCK DETECTED.'
759 00021
FORMAT(1x,
'SIMPLE OPTION:', /, &
760 1x,
'DEFAULT SOLVER INPUT VALUES FOR FAST SOLUTIONS')
761 00023
FORMAT(1x,
'MODERATE OPTION:', /, 1x,
'DEFAULT SOLVER', &
762 ' INPUT VALUES REFLECT MODERATELY NONLINEAR MODEL')
763 00025
FORMAT(1x,
'COMPLEX OPTION:', /, 1x,
'DEFAULT SOLVER', &
764 ' INPUT VALUES REFLECT STRONGLY NONLINEAR MODEL')
768 call this%sln_setouter(ifdparam)
771 call this%parser%GetBlock(
'NONLINEAR', isfound, ierr, &
772 supportopenclose=.true., blockrequired=.false.)
776 write (
iout,
'(/1x,a)')
'PROCESSING IMS NONLINEAR'
778 call this%parser%GetNextLine(endofblock)
780 call this%parser%GetStringCaps(keyword)
782 select case (keyword)
783 case (
'OUTER_DVCLOSE')
784 this%dvclose = this%parser%GetDouble()
785 case (
'OUTER_MAXIMUM')
786 this%mxiter = this%parser%GetInteger()
787 case (
'UNDER_RELAXATION')
788 call this%parser%GetStringCaps(keyword)
790 if (keyword ==
'NONE')
then
792 else if (keyword ==
'SIMPLE')
then
794 else if (keyword ==
'COOLEY')
then
796 else if (keyword ==
'DBD')
then
799 write (errmsg,
'(3a)') &
800 'Unknown UNDER_RELAXATION specified (', trim(keyword),
').'
804 case (
'LINEAR_SOLVER')
805 call this%parser%GetStringCaps(keyword)
807 if (keyword .eq.
'DEFAULT' .or. &
808 keyword .eq.
'LINEAR')
then
811 write (errmsg,
'(3a)') &
812 'Unknown LINEAR_SOLVER specified (', trim(keyword),
').'
815 this%linsolver = ival
816 case (
'UNDER_RELAXATION_THETA')
817 this%theta = this%parser%GetDouble()
818 case (
'UNDER_RELAXATION_KAPPA')
819 this%akappa = this%parser%GetDouble()
820 case (
'UNDER_RELAXATION_GAMMA')
821 this%gamma = this%parser%GetDouble()
822 case (
'UNDER_RELAXATION_MOMENTUM')
823 this%amomentum = this%parser%GetDouble()
824 case (
'BACKTRACKING_NUMBER')
825 this%numtrack = this%parser%GetInteger()
826 IF (this%numtrack > 0) this%ibflag = 1
827 case (
'BACKTRACKING_TOLERANCE')
828 this%btol = this%parser%GetDouble()
829 case (
'BACKTRACKING_REDUCTION_FACTOR')
830 this%breduc = this%parser%GetDouble()
831 case (
'BACKTRACKING_RESIDUAL_LIMIT')
832 this%res_lim = this%parser%GetDouble()
835 case (
'OUTER_HCLOSE')
836 this%dvclose = this%parser%GetDouble()
839 write (warnmsg,
'(a)') &
840 'SETTING OUTER_DVCLOSE TO OUTER_HCLOSE VALUE'
844 warnmsg, this%parser%GetUnit())
845 case (
'OUTER_RCLOSEBND')
848 write (warnmsg,
'(a)') &
849 'OUTER_DVCLOSE IS USED TO EVALUATE PACKAGE CONVERGENCE'
853 warnmsg, this%parser%GetUnit())
855 write (errmsg,
'(3a)') &
856 'Unknown IMS NONLINEAR keyword (', trim(keyword),
').'
860 write (
iout,
'(1x,a)')
'END OF IMS NONLINEAR DATA'
862 if (ifdparam .EQ. 0)
then
863 write (errmsg,
'(a)')
'NO IMS NONLINEAR block detected.'
868 if (this%theta <
dem3)
then
873 if (this%nonmeth < 1)
then
878 if (this%mxiter <= 0)
then
879 write (errmsg,
'(a)')
'Outer iteration number must be > 0.'
884 if (this%nonmeth > 0)
then
885 WRITE (
iout, *)
'**UNDER-RELAXATION WILL BE USED***'
887 elseif (this%nonmeth == 0)
then
888 WRITE (
iout, *)
'***UNDER-RELAXATION WILL NOT BE USED***'
891 WRITE (errmsg,
'(a)') &
892 'Incorrect value for variable NONMETH was specified.'
897 if (this%nonmeth == 1)
then
898 if (this%gamma == 0)
then
899 WRITE (errmsg,
'(a)') &
900 'GAMMA must be greater than zero if SIMPLE under-relaxation is used.'
905 if (this%solver_mode ==
'PETSC')
then
910 call this%linear_settings%init(this%memory_path)
911 call this%linear_settings%preset_config(ifdparam)
912 call this%linear_settings%read_from_file(this%parser,
iout)
914 if (this%linear_settings%ilinmeth ==
cg_method)
then
920 if (this%solver_mode ==
"IMS")
then
921 allocate (this%imslinear)
922 WRITE (
iout, *)
'***IMS LINEAR SOLVER WILL BE USED***'
923 call this%imslinear%imslinear_allocate(this%name,
iout, this%iprims, &
924 this%mxiter, this%neq, &
925 this%system_matrix, this%rhs, &
926 this%x, this%linear_settings)
929 else if (this%solver_mode ==
"PETSC")
then
930 call this%linear_solver%initialize(this%system_matrix, &
931 this%linear_settings, &
936 write (errmsg,
'(a)') &
937 'Incorrect value for linear solution method specified.'
942 if (this%isymmetric == 1)
then
943 write (
iout,
'(1x,a,/)')
'A symmetric matrix will be solved'
945 write (
iout,
'(1x,a,/)')
'An asymmetric matrix will be solved'
950 if (this%isymmetric == 1)
then
953 do i = 1, this%modellist%Count()
955 if (mp%get_iasym() /= 0)
then
956 write (errmsg, fmterrasym)
'MODEL', trim(adjustl(mp%name))
962 do i = 1, this%exchangelist%Count()
964 if (cp%get_iasym() /= 0)
then
965 write (errmsg, fmterrasym)
'EXCHANGE', trim(adjustl(cp%name))
975 WRITE (
iout, 9002) this%dvclose, this%mxiter, &
976 this%iprims, this%nonmeth, this%linsolver
979 9002
FORMAT(1x,
'OUTER ITERATION CONVERGENCE CRITERION (DVCLOSE) = ', e15.6, &
980 /1x,
'MAXIMUM NUMBER OF OUTER ITERATIONS (MXITER) = ', i0, &
981 /1x,
'SOLVER PRINTOUT INDEX (IPRIMS) = ', i0, &
982 /1x,
'NONLINEAR ITERATION METHOD (NONLINMETH) = ', i0, &
983 /1x,
'LINEAR SOLUTION METHOD (LINMETH) = ', i0)
985 if (this%nonmeth == 1)
then
986 write (
iout, 9003) this%gamma
987 else if (this%nonmeth == 2)
then
988 write (
iout, 9004) this%gamma
989 else if (this%nonmeth == 3)
then
990 write (
iout, 9005) this%theta, this%akappa, this%gamma, this%amomentum
994 if (this%numtrack /= 0)
write (
iout, 9006) this%numtrack, this%btol, &
995 this%breduc, this%res_lim
998 9003
FORMAT(1x,
'UNDER-RELAXATION FACTOR (GAMMA) = ', e15.6)
999 9004
FORMAT(1x,
'UNDER-RELAXATION PREVIOUS HISTORY FACTOR (GAMMA) = ', e15.6)
1000 9005
FORMAT(1x,
'UNDER-RELAXATION WEIGHT REDUCTION FACTOR (THETA) = ', e15.6, &
1001 /1x,
'UNDER-RELAXATION WEIGHT INCREASE INCREMENT (KAPPA) = ', e15.6, &
1002 /1x,
'UNDER-RELAXATION PREVIOUS HISTORY FACTOR (GAMMA) = ', e15.6, &
1003 /1x,
'UNDER-RELAXATION MOMENTUM TERM (AMOMENTUM) = ', e15.6)
1006 9006
FORMAT(1x,
'MAXIMUM NUMBER OF BACKTRACKS (NUMTRACK) = ', i0, &
1007 /1x,
'BACKTRACKING TOLERANCE FACTOR (BTOL) = ', e15.6, &
1008 /1x,
'BACKTRACKING REDUCTION FACTOR (BREDUC) = ', e15.6, &
1009 /1x,
'BACKTRACKING RESIDUAL LIMIT (RES_LIM) = ', e15.6)
1013 call this%imslinear%imslinear_summary(this%mxiter)
1015 call this%linear_solver%print_summary()
1021 call this%parser%StoreErrorUnit()
1026 call mem_reallocate(this%lrch, 3, this%mxiter,
'LRCH', this%name)
1029 if (this%nonmeth == 3)
then
1034 this%wsave(i) =
dzero
1035 this%hchold(i) =
dzero
1036 this%deold(i) =
dzero
1043 if (this%iprims == 2 .or. this%icsvinnerout > 0)
then
1044 this%nitermax = this%linear_settings%iter1 * this%mxiter
1049 allocate (this%caccel(this%nitermax))
1053 call this%cnvg_summary%reinit(this%nitermax)
1058 call this%parser%StoreErrorUnit()
1062 call this%parser%Clear()
1078 integer(I4B) :: idir
1079 real(DP) :: delt_temp
1080 real(DP) :: fact_lower
1081 real(DP) :: fact_upper
1087 if (this%atsfrac > dzero)
then
1089 fact_lower = this%mxiter * this%atsfrac
1090 fact_upper = this%mxiter - fact_lower
1091 if (this%iouttot_timestep < int(fact_lower))
then
1094 else if (this%iouttot_timestep > int(fact_upper))
then
1119 if (
kper == 1 .and.
kstp == 1)
then
1120 call this%writeCSVHeader()
1124 call this%writePTCInfoToFile(
kper)
1128 this%itertot_timestep = 0
1129 this%iouttot_timestep = 0
1156 write (
iout,
'(//1x,a,1x,a,1x,a)') &
1157 'Solution', trim(adjustl(this%name)),
'summary'
1158 write (
iout,
"(1x,70('-'))")
1159 write (
iout,
'(1x,a,1x,g0,1x,a)') &
1160 'Total formulate time: ', this%ttform,
'seconds'
1161 write (
iout,
'(1x,a,1x,g0,1x,a,/)') &
1162 'Total solution time: ', this%ttsoln,
'seconds'
1179 call this%imslinear%imslinear_da()
1180 deallocate (this%imslinear)
1184 call this%modellist%Clear()
1185 call this%exchangelist%Clear()
1186 deallocate (this%modellist)
1187 deallocate (this%exchangelist)
1189 call this%system_matrix%destroy()
1190 deallocate (this%system_matrix)
1191 call this%vec_x%destroy()
1192 deallocate (this%vec_x)
1193 call this%vec_rhs%destroy()
1194 deallocate (this%vec_rhs)
1198 deallocate (this%caccel)
1201 if (
associated(this%innertab))
then
1202 call this%innertab%table_da()
1203 deallocate (this%innertab)
1204 nullify (this%innertab)
1208 if (
associated(this%outertab))
then
1209 call this%outertab%table_da()
1210 deallocate (this%outertab)
1211 nullify (this%outertab)
1226 call this%cnvg_summary%destroy()
1227 deallocate (this%cnvg_summary)
1230 call this%linear_solver%destroy()
1231 deallocate (this%linear_solver)
1234 call this%linear_settings%destroy()
1235 deallocate (this%linear_settings)
1287 subroutine sln_ca(this, isgcnvg, isuppress_output)
1290 integer(I4B),
intent(inout) :: isgcnvg
1291 integer(I4B),
intent(in) :: isuppress_output
1294 character(len=LINELENGTH) :: line
1295 character(len=LINELENGTH) :: fmt
1297 integer(I4B) :: kiter
1300 call this%prepareSolve()
1304 line =
'mode="validation" -- Skipping matrix assembly and solution.'
1306 do im = 1, this%modellist%Count()
1308 call mp%model_message(line, fmt=fmt)
1312 outerloop:
do kiter = 1, this%mxiter
1315 call this%solve(kiter)
1318 if (this%icnvg == 1)
then
1325 call this%finalizeSolve(kiter, isgcnvg, isuppress_output)
1341 if (this%icsvouterout > 0)
then
1342 write (this%icsvouterout,
'(*(G0,:,","))') &
1343 'total_inner_iterations',
'totim',
'kper',
'kstp',
'nouter', &
1344 'inner_iterations',
'solution_outer_dvmax', &
1345 'solution_outer_dvmax_model',
'solution_outer_dvmax_package', &
1346 'solution_outer_dvmax_node'
1350 if (this%icsvinnerout > 0)
then
1351 write (this%icsvinnerout,
'(*(G0,:,","))', advance=
'NO') &
1352 'total_inner_iterations',
'totim',
'kper',
'kstp',
'nouter', &
1353 'ninner',
'solution_inner_dvmax',
'solution_inner_dvmax_model', &
1354 'solution_inner_dvmax_node'
1355 write (this%icsvinnerout,
'(*(G0,:,","))', advance=
'NO') &
1356 '',
'solution_inner_rmax',
'solution_inner_rmax_model', &
1357 'solution_inner_rmax_node'
1360 write (this%icsvinnerout,
'(*(G0,:,","))', advance=
'NO') &
1361 '',
'solution_inner_alpha'
1362 if (this%imslinear%ilinmeth == 2)
then
1363 write (this%icsvinnerout,
'(*(G0,:,","))', advance=
'NO') &
1364 '',
'solution_inner_omega'
1369 do im = 1, this%modellist%Count()
1371 write (this%icsvinnerout,
'(*(G0,:,","))', advance=
'NO') &
1372 '', trim(adjustl(mp%name))//
'_inner_dvmax', &
1373 trim(adjustl(mp%name))//
'_inner_dvmax_node', &
1374 trim(adjustl(mp%name))//
'_inner_rmax', &
1375 trim(adjustl(mp%name))//
'_inner_rmax_node'
1378 write (this%icsvinnerout,
'(a)')
''
1390 integer(I4B),
intent(in) :: kper
1392 integer(I4B) :: n, im, iallowptc, iptc
1397 do im = 1, this%modellist%Count()
1401 if (this%iallowptc < 0)
then
1409 iallowptc = this%iallowptc
1412 if (iallowptc > 0)
then
1414 call mp%model_ptcchk(iptc)
1421 write (
iout,
'(//)')
1424 write (
iout,
'(1x,a,1x,i0,1x,3a)') &
1425 'PSEUDO-TRANSIENT CONTINUATION WILL BE APPLIED TO MODEL', im,
'("', &
1426 trim(adjustl(mp%name)),
'") DURING THIS TIME STEP'
1447 call g_prof%start(
"Prepare solve"//this%id_postfix, this%tmr_prep_solve)
1453 do ic = 1, this%exchangelist%Count()
1459 do im = 1, this%modellist%Count()
1468 call g_prof%stop(this%tmr_prep_solve)
1487 integer(I4B),
intent(in) :: kiter
1491 character(len=LINELENGTH) :: title
1492 character(len=LINELENGTH) :: tag
1493 character(len=LENPAKLOC) :: cmod
1494 character(len=LENPAKLOC) :: cpak
1495 character(len=LENPAKLOC) :: cpakout
1496 character(len=LENPAKLOC) :: strh
1497 character(len=25) :: cval
1498 character(len=7) :: cmsg
1500 integer(I4B) :: im, m_idx, model_id
1501 integer(I4B) :: icsv0
1502 integer(I4B) :: kcsv0
1503 integer(I4B) :: ntabrows
1504 integer(I4B) :: ntabcols
1505 integer(I4B) :: i0, i1
1506 integer(I4B) :: itestmat, n
1507 integer(I4B) :: iter
1508 integer(I4B) :: inewtonur
1509 integer(I4B) :: locmax_nur
1510 integer(I4B) :: iend
1511 integer(I4B) :: icnvgmod
1512 integer(I4B) :: iptc
1513 integer(I4B) :: node_user
1514 integer(I4B) :: ipak
1515 integer(I4B) :: ipos0
1516 integer(I4B) :: ipos1
1517 real(DP) :: dxmax_nur
1518 real(DP) :: dxold_max
1523 real(DP) :: outer_hncg
1526 call g_prof%start(
"Solve"//this%id_postfix, this%tmr_solve)
1530 icsv0 = max(1, this%itertot_sim + 1)
1531 kcsv0 = max(1, this%itertot_timestep + 1)
1534 if (this%iprims > 0)
then
1535 if (.not.
associated(this%outertab))
then
1541 if (this%numtrack > 0)
then
1542 ntabcols = ntabcols + 4
1546 title = trim(this%memory_path)//
' OUTER ITERATION SUMMARY'
1547 call table_cr(this%outertab, this%name, title)
1548 call this%outertab%table_df(ntabrows, ntabcols,
iout, &
1550 tag =
'OUTER ITERATION STEP'
1551 call this%outertab%initialize_column(tag, 25, alignment=
tableft)
1552 tag =
'OUTER ITERATION'
1553 call this%outertab%initialize_column(tag, 10, alignment=
tabright)
1554 tag =
'INNER ITERATION'
1555 call this%outertab%initialize_column(tag, 10, alignment=
tabright)
1556 if (this%numtrack > 0)
then
1557 tag =
'BACKTRACK FLAG'
1558 call this%outertab%initialize_column(tag, 10, alignment=
tabright)
1559 tag =
'BACKTRACK ITERATIONS'
1560 call this%outertab%initialize_column(tag, 10, alignment=
tabright)
1561 tag =
'INCOMING RESIDUAL'
1562 call this%outertab%initialize_column(tag, 15, alignment=
tabright)
1563 tag =
'OUTGOING RESIDUAL'
1564 call this%outertab%initialize_column(tag, 15, alignment=
tabright)
1566 tag =
'MAXIMUM CHANGE'
1567 call this%outertab%initialize_column(tag, 15, alignment=
tabright)
1568 tag =
'STEP SUCCESS'
1569 call this%outertab%initialize_column(tag, 7, alignment=
tabright)
1570 tag =
'MAXIMUM CHANGE MODEL-(CELLID) OR MODEL-PACKAGE-(NUMBER)'
1571 call this%outertab%initialize_column(tag, 34, alignment=
tabright)
1576 if (this%numtrack > 0)
then
1577 call this%sln_backtracking(mp, cp, kiter)
1581 call g_prof%start(
"Formulate", this%tmr_formulate)
1584 call this%sln_buildsystem(kiter, inewton=1)
1587 call this%sln_calc_ptc(iptc, ptcf)
1590 do im = 1, this%modellist%Count()
1592 call mp%model_nr(kiter, this%system_matrix, 1)
1595 call g_prof%stop(this%tmr_formulate)
1599 call g_prof%start(
"Linear solve", this%tmr_linsolve)
1600 call this%sln_ls(kiter,
kstp,
kper, iter, iptc, ptcf)
1601 call g_prof%stop(this%tmr_linsolve)
1607 this%itertot_timestep = this%itertot_timestep + iter
1608 this%iouttot_timestep = this%iouttot_timestep + 1
1609 this%itertot_sim = this%itertot_sim + iter
1615 if (itestmat /= 0)
then
1616 open (99, file=
'sol_MF6.TXT')
1617 WRITE (99, *)
'MATRIX SOLUTION FOLLOWS'
1618 WRITE (99,
'(10(I8,G15.4))') (n, this%x(n), n=1, this%NEQ)
1625 call this%sln_get_dxmax(this%hncg(kiter), this%lrch(1, kiter))
1627 if (this%sln_has_converged(this%hncg(kiter)))
then
1632 if (this%icnvg == 0)
then
1640 if (kiter == this%mxiter)
then
1645 if (this%iprims > 0)
then
1647 call this%sln_get_loc(this%lrch(1, kiter), strh)
1650 call this%outertab%add_term(cval)
1651 call this%outertab%add_term(kiter)
1652 call this%outertab%add_term(iter)
1653 if (this%numtrack > 0)
then
1654 call this%outertab%add_term(
' ')
1655 call this%outertab%add_term(
' ')
1656 call this%outertab%add_term(
' ')
1657 call this%outertab%add_term(
' ')
1659 call this%outertab%add_term(this%hncg(kiter))
1660 call this%outertab%add_term(cmsg)
1661 call this%outertab%add_term(trim(strh))
1665 do ic = 1, this%exchangelist%Count()
1667 call cp%exg_cc(this%icnvg)
1671 icnvgmod = this%icnvg
1675 do im = 1, this%modellist%Count()
1677 call mp%get_mcellid(0, cmod)
1678 call mp%model_cc(this%itertot_sim, kiter, iend, icnvgmod, &
1681 ipos0 = index(cpak,
'-', back=.true.)
1682 ipos1 = len_trim(cpak)
1683 write (cpakout,
'(a,a,"-(",i0,")",a)') &
1684 trim(cmod), cpak(1:ipos0 - 1), ipak, cpak(ipos0:ipos1)
1691 if (this%icnvg == 1)
then
1692 this%icnvg = this%sln_package_convergence(dpak, cpakout, iend)
1695 if (this%iprims > 0)
then
1697 if (this%icnvg /= 1)
then
1702 if (len_trim(cpakout) > 0)
then
1705 call this%outertab%add_term(cval)
1706 call this%outertab%add_term(kiter)
1707 call this%outertab%add_term(
' ')
1708 if (this%numtrack > 0)
then
1709 call this%outertab%add_term(
' ')
1710 call this%outertab%add_term(
' ')
1711 call this%outertab%add_term(
' ')
1712 call this%outertab%add_term(
' ')
1714 call this%outertab%add_term(dpak)
1715 call this%outertab%add_term(cmsg)
1716 call this%outertab%add_term(cpakout)
1722 if (this%icnvg /= 1)
then
1723 if (this%nonmeth > 0)
then
1724 call this%sln_underrelax(kiter, this%hncg(kiter), this%neq, &
1725 this%active, this%x, this%xtemp)
1727 call this%sln_calcdx(this%neq, this%active, &
1728 this%x, this%xtemp, this%dxold)
1735 do im = 1, this%modellist%Count()
1737 i0 = mp%moffset + 1 - this%matrix_offset
1738 i1 = i0 + mp%neq - 1
1739 call mp%model_nur(mp%neq, this%x(i0:i1), this%xtemp(i0:i1), &
1740 this%dxold(i0:i1), inewtonur, dxmax_nur, locmax_nur)
1744 inewtonur = this%sln_sync_newtonur_flag(inewtonur)
1747 if (inewtonur /= 0)
then
1751 call this%sln_maxval(this%neq, this%dxold, dxold_max)
1754 if (this%sln_nur_has_converged(dxold_max, this%hncg(kiter)))
then
1760 call this%sln_get_dxmax(this%hncg(kiter), this%lrch(1, kiter))
1764 if (this%iprims > 0)
then
1765 cval =
'Newton under-relaxation'
1767 call this%sln_get_loc(this%lrch(1, kiter), strh)
1770 call this%outertab%add_term(cval)
1771 call this%outertab%add_term(kiter)
1772 call this%outertab%add_term(iter)
1773 if (this%numtrack > 0)
then
1774 call this%outertab%add_term(
' ')
1775 call this%outertab%add_term(
' ')
1776 call this%outertab%add_term(
' ')
1777 call this%outertab%add_term(
' ')
1779 call this%outertab%add_term(this%hncg(kiter))
1780 call this%outertab%add_term(cmsg)
1781 call this%outertab%add_term(trim(strh))
1788 if (this%icsvouterout > 0)
then
1791 outer_hncg = this%hncg(kiter)
1794 if (abs(outer_hncg) > abs(dpak))
then
1797 call this%sln_get_nodeu(this%lrch(1, kiter), m_idx, node_user)
1799 else if (outer_hncg ==
dzero .and. dpak ==
dzero)
then
1809 ipos0 = index(cmod,
'_')
1810 read (cmod(1:ipos0 - 1), *) m_idx
1812 ipos0 = index(cpak,
'-', back=.true.)
1813 cpakout = cpak(1:ipos0 - 1)
1823 write (this%icsvouterout,
'(*(G0,:,","))') &
1825 outer_hncg, model_id, trim(cpakout), node_user
1829 if (this%icsvinnerout > 0)
then
1830 call this%csv_convergence_summary(this%icsvinnerout,
totim,
kper,
kstp, &
1831 kiter, iter, icsv0, kcsv0)
1835 call g_prof%stop(this%tmr_solve)
1837 end subroutine solve
1849 integer(I4B),
intent(in) :: kiter
1850 integer(I4B),
intent(inout) :: isgcnvg
1851 integer(I4B),
intent(in) :: isuppress_output
1853 integer(I4B) :: ic, im
1857 character(len=*),
parameter :: fmtnocnvg = &
1858 "(1X,'Solution ', i0, ' did not converge for stress period ', i0, &
1859 &' and time step ', i0)"
1860 character(len=*),
parameter :: fmtcnvg = &
1861 "(1X, I0, ' CALLS TO NUMERICAL SOLUTION ', 'IN TIME STEP ', I0, &
1862 &' STRESS PERIOD ',I0,/1X,I0,' TOTAL ITERATIONS')"
1865 call g_prof%start(
"Finalize solve"//this%id_postfix, this%tmr_final_solve)
1869 if (this%iprims > 0)
then
1870 call this%outertab%finalize_table()
1876 if (this%icnvg /= 0)
then
1877 if (this%iprims > 0)
then
1878 write (
iout, fmtcnvg) kiter,
kstp,
kper, this%itertot_timestep
1887 if (this%iprims == 2)
then
1890 do im = 1, this%modellist%Count()
1892 call this%convergence_summary(mp%iout, im, this%itertot_timestep)
1896 call this%convergence_summary(
iout, this%convnmod + 1, &
1897 this%itertot_timestep)
1901 if (this%icnvg == 0) isgcnvg = 0
1903 call g_prof%start(
"Calculate flows", this%tmr_flows)
1907 do im = 1, this%modellist%Count()
1909 call mp%model_cq(this%icnvg, isuppress_output)
1913 do ic = 1, this%exchangelist%Count()
1915 call cp%exg_cq(isgcnvg, isuppress_output, this%id)
1918 call g_prof%stop(this%tmr_flows)
1919 call g_prof%start(
"Calculate budgets", this%tmr_budgets)
1923 do im = 1, this%modellist%Count()
1925 call mp%model_bd(this%icnvg, isuppress_output)
1929 do ic = 1, this%exchangelist%Count()
1931 call cp%exg_bd(isgcnvg, isuppress_output, this%id)
1935 call g_prof%stop(this%tmr_budgets)
1936 call g_prof%stop(this%tmr_final_solve)
1943 integer(I4B),
intent(in) :: kiter
1944 integer(I4B),
intent(in) :: inewton
1946 integer(I4B) :: im, ic
1951 call this%sln_reset()
1954 do im = 1, this%modellist%Count()
1956 call mp%model_reset()
1964 do ic = 1, this%exchangelist%Count()
1966 call cp%exg_cf(kiter)
1970 do im = 1, this%modellist%Count()
1972 call mp%model_cf(kiter)
1980 do ic = 1, this%exchangelist%Count()
1982 call cp%exg_fc(kiter, this%system_matrix, this%rhs, inewton)
1986 do im = 1, this%modellist%Count()
1988 call mp%model_fc(kiter, this%system_matrix, inewton)
2003 integer(I4B),
intent(in) :: iu
2004 integer(I4B),
intent(in) :: im
2005 integer(I4B),
intent(in) :: itertot_timestep
2007 character(len=LINELENGTH) :: title
2008 character(len=LINELENGTH) :: tag
2009 character(len=LENPAKLOC) :: loc_dvmax_str
2010 character(len=LENPAKLOC) :: loc_rmax_str
2011 integer(I4B) :: ntabrows
2012 integer(I4B) :: ntabcols
2013 integer(I4B) :: iinner
2015 integer(I4B) :: iouter
2018 integer(I4B) :: locdv
2019 integer(I4B) :: locdr
2031 if (.not.
associated(this%innertab))
then
2035 ntabrows = itertot_timestep
2039 title = trim(this%memory_path)//
' INNER ITERATION SUMMARY'
2040 call table_cr(this%innertab, this%name, title)
2041 call this%innertab%table_df(ntabrows, ntabcols, iu)
2042 tag =
'TOTAL ITERATION'
2043 call this%innertab%initialize_column(tag, 10, alignment=
tabright)
2044 tag =
'OUTER ITERATION'
2045 call this%innertab%initialize_column(tag, 10, alignment=
tabright)
2046 tag =
'INNER ITERATION'
2047 call this%innertab%initialize_column(tag, 10, alignment=
tabright)
2048 tag =
'MAXIMUM CHANGE'
2049 call this%innertab%initialize_column(tag, 15, alignment=
tabright)
2050 tag =
'MAXIMUM CHANGE MODEL-(CELLID)'
2052 tag =
'MAXIMUM RESIDUAL'
2053 call this%innertab%initialize_column(tag, 15, alignment=
tabright)
2054 tag =
'MAXIMUM RESIDUAL MODEL-(CELLID)'
2059 call this%innertab%set_maxbound(itertot_timestep)
2060 call this%innertab%set_iout(iu)
2065 do k = 1, itertot_timestep
2066 iinner = this%cnvg_summary%itinner(k)
2067 if (iinner <= i0)
then
2070 if (im > this%convnmod)
then
2073 do j = 1, this%convnmod
2074 if (abs(this%cnvg_summary%convdvmax(j, k)) > abs(dv))
then
2075 locdv = this%cnvg_summary%convlocdv(j, k)
2076 dv = this%cnvg_summary%convdvmax(j, k)
2078 if (abs(this%cnvg_summary%convrmax(j, k)) > abs(res))
then
2079 locdr = this%cnvg_summary%convlocr(j, k)
2080 res = this%cnvg_summary%convrmax(j, k)
2084 locdv = this%cnvg_summary%convlocdv(im, k)
2085 locdr = this%cnvg_summary%convlocr(im, k)
2086 dv = this%cnvg_summary%convdvmax(im, k)
2087 res = this%cnvg_summary%convrmax(im, k)
2089 call this%sln_get_loc(locdv, loc_dvmax_str)
2090 call this%sln_get_loc(locdr, loc_rmax_str)
2093 call this%innertab%add_term(k)
2094 call this%innertab%add_term(iouter)
2095 call this%innertab%add_term(iinner)
2096 call this%innertab%add_term(dv)
2097 call this%innertab%add_term(adjustr(trim(loc_dvmax_str)))
2098 call this%innertab%add_term(res)
2099 call this%innertab%add_term(adjustr(trim(loc_rmax_str)))
2112 niter, istart, kstart)
2117 integer(I4B),
intent(in) :: iu
2118 real(DP),
intent(in) :: totim
2119 integer(I4B),
intent(in) :: kper
2120 integer(I4B),
intent(in) :: kstp
2121 integer(I4B),
intent(in) :: kouter
2122 integer(I4B),
intent(in) :: niter
2123 integer(I4B),
intent(in) :: istart
2124 integer(I4B),
intent(in) :: kstart
2126 integer(I4B) :: itot
2127 integer(I4B) :: m_idx, j, k
2128 integer(I4B) :: kpos
2129 integer(I4B) :: loc_dvmax
2130 integer(I4B) :: loc_rmax
2131 integer(I4B) :: model_id, node_user
2141 kpos = kstart + k - 1
2142 write (iu,
'(*(G0,:,","))', advance=
'NO') &
2143 itot, totim, kper, kstp, kouter, k
2148 do j = 1, this%convnmod
2149 if (abs(this%cnvg_summary%convdvmax(j, kpos)) > abs(dvmax))
then
2150 loc_dvmax = this%cnvg_summary%convlocdv(j, kpos)
2151 dvmax = this%cnvg_summary%convdvmax(j, kpos)
2153 if (abs(this%cnvg_summary%convrmax(j, kpos)) > abs(rmax))
then
2154 loc_rmax = this%cnvg_summary%convlocr(j, kpos)
2155 rmax = this%cnvg_summary%convrmax(j, kpos)
2160 if (dvmax ==
dzero) loc_dvmax = 0
2161 if (rmax ==
dzero) loc_rmax = 0
2164 if (loc_dvmax > 0)
then
2165 call this%sln_get_nodeu(loc_dvmax, m_idx, node_user)
2167 model_id = num_mod%id
2172 write (iu,
'(*(G0,:,","))', advance=
'NO')
'', dvmax, model_id, node_user
2175 if (loc_rmax > 0)
then
2176 call this%sln_get_nodeu(loc_rmax, m_idx, node_user)
2178 model_id = num_mod%id
2183 write (iu,
'(*(G0,:,","))', advance=
'NO')
'', rmax, model_id, node_user
2187 write (iu,
'(*(G0,:,","))', advance=
'NO') &
2188 '', trim(adjustl(this%caccel(kpos)))
2193 do j = 1, this%cnvg_summary%convnmod
2194 loc_dvmax = this%cnvg_summary%convlocdv(j, kpos)
2195 dvmax = this%cnvg_summary%convdvmax(j, kpos)
2196 loc_rmax = this%cnvg_summary%convlocr(j, kpos)
2197 rmax = this%cnvg_summary%convrmax(j, kpos)
2200 if (loc_dvmax > 0)
then
2201 call this%sln_get_nodeu(loc_dvmax, m_idx, node_user)
2205 write (iu,
'(*(G0,:,","))', advance=
'NO')
'', dvmax, node_user
2208 if (loc_rmax > 0)
then
2209 call this%sln_get_nodeu(loc_rmax, m_idx, node_user)
2213 write (iu,
'(*(G0,:,","))', advance=
'NO')
'', rmax, node_user
2218 write (iu,
'(a)')
''
2240 character(len=*),
intent(in) :: filename
2242 integer(I4B) :: inunit
2244 select type (spm => this%system_matrix)
2247 open (unit=inunit, file=filename, status=
'unknown')
2248 write (inunit, *)
'ia'
2249 write (inunit, *) spm%ia
2250 write (inunit, *)
'ja'
2251 write (inunit, *) spm%ja
2252 write (inunit, *)
'amat'
2253 write (inunit, *) spm%amat
2254 write (inunit, *)
'rhs'
2255 write (inunit, *) this%rhs
2256 write (inunit, *)
'x'
2257 write (inunit, *) this%x
2293 models => this%modellist
2310 select type (exchange)
2321 type(
listtype),
pointer :: exchanges
2323 exchanges => this%exchangelist
2348 do im = 1, this%modellist%Count()
2350 call mp%model_ac(this%sparse)
2357 do ic = 1, this%exchangelist%Count()
2359 call cp%exg_ac(this%sparse)
2364 call this%sparse%sort()
2365 call this%system_matrix%init(this%sparse, this%name)
2366 call this%sparse%destroy()
2371 do im = 1, this%modellist%Count()
2373 call mp%model_mc(this%system_matrix)
2377 do ic = 1, this%exchangelist%Count()
2379 call cp%exg_mc(this%system_matrix)
2394 call this%system_matrix%zero_entries()
2395 call this%vec_rhs%zero_entries()
2404 subroutine sln_ls(this, kiter, kstp, kper, in_iter, iptc, ptcf)
2407 integer(I4B),
intent(in) :: kiter
2408 integer(I4B),
intent(in) :: kstp
2409 integer(I4B),
intent(in) :: kper
2410 integer(I4B),
intent(inout) :: in_iter
2411 integer(I4B),
intent(inout) :: iptc
2412 real(DP),
intent(in) :: ptcf
2414 logical(LGP) :: lsame
2416 integer(I4B) :: irow_glo
2417 integer(I4B) :: itestmat
2418 integer(I4B) :: ipos
2419 integer(I4B) :: icol_s
2420 integer(I4B) :: icol_e
2421 integer(I4B) :: jcol
2422 integer(I4B) :: iptct
2423 integer(I4B) :: iallowptc
2429 character(len=50) :: fname
2430 character(len=*),
parameter :: fmtfname =
"('mf6mat_', i0, '_', i0, &
2431 &'_', i0, '_', i0, '.txt')"
2434 do ieq = 1, this%neq
2437 irow_glo = ieq + this%matrix_offset
2440 this%xtemp(ieq) = this%x(ieq)
2444 if (this%active(ieq) > 0)
then
2446 adiag = abs(this%system_matrix%get_diag_value(irow_glo))
2447 if (adiag <
dem15)
then
2448 call this%system_matrix%set_diag_value(irow_glo, diagval)
2449 this%rhs(ieq) = this%rhs(ieq) + diagval * this%x(ieq)
2453 call this%system_matrix%set_diag_value(irow_glo,
done)
2454 call this%system_matrix%zero_row_offdiag(irow_glo)
2455 this%rhs(ieq) = this%x(ieq)
2461 do ieq = 1, this%neq
2462 if (this%active(ieq) > 0)
then
2463 icol_s = this%system_matrix%get_first_col_pos(ieq)
2464 icol_e = this%system_matrix%get_last_col_pos(ieq)
2465 do ipos = icol_s, icol_e
2466 jcol = this%system_matrix%get_column(ipos)
2467 if (jcol == ieq) cycle
2468 if (this%active(jcol) < 0)
then
2469 this%rhs(ieq) = this%rhs(ieq) - &
2470 (this%system_matrix%get_value_pos(ipos) * &
2472 call this%system_matrix%set_value_pos(ipos,
dzero)
2484 if (this%iallowptc < 0)
then
2493 iallowptc = this%iallowptc
2497 iptct = iptc * iallowptc
2501 if (iptct /= 0)
then
2502 call this%sln_l2norm(l2norm)
2505 if (kiter == 1)
then
2506 if (kper > 1 .or. kstp > 1)
then
2507 if (l2norm <= this%l2norm0)
then
2512 lsame =
is_close(l2norm, this%l2norm0)
2518 iptct = iptc * iallowptc
2519 if (iptct /= 0)
then
2520 if (kiter == 1)
then
2521 if (this%iptcout > 0)
then
2522 write (this%iptcout,
'(A10,6(1x,A15))')
'OUTER ITER', &
2523 ' PTCDEL',
' L2NORM0',
' L2NORM', &
2524 ' RHSNORM',
' 1/PTCDEL',
' RHSNORM/L2NORM'
2526 if (this%ptcdel0 >
dzero)
then
2527 this%ptcdel = this%ptcdel0
2529 if (this%iptcopt == 0)
then
2532 this%ptcdel =
done / ptcf
2535 do ieq = 1, this%neq
2536 if (this%active(ieq) .gt. 0)
then
2537 bnorm = bnorm + this%rhs(ieq) * this%rhs(ieq)
2541 this%ptcdel = bnorm / l2norm
2545 if (l2norm >
dzero)
then
2546 this%ptcdel = this%ptcdel * (this%l2norm0 / l2norm)**this%ptcexp
2551 if (this%ptcdel >
dzero)
then
2552 ptcval =
done / this%ptcdel
2557 do ieq = 1, this%neq
2558 irow_glo = ieq + this%matrix_offset
2559 if (this%active(ieq) > 0)
then
2560 diagval = abs(this%system_matrix%get_diag_value(irow_glo))
2561 bnorm = bnorm + this%rhs(ieq) * this%rhs(ieq)
2562 call this%system_matrix%add_diag_value(irow_glo, -ptcval)
2563 this%rhs(ieq) = this%rhs(ieq) - ptcval * this%x(ieq)
2567 if (this%iptcout > 0)
then
2568 write (this%iptcout,
'(i10,5(1x,e15.7),1(1x,f15.6))') &
2569 kiter, this%ptcdel, this%l2norm0, l2norm, bnorm, &
2570 ptcval, bnorm / l2norm
2572 this%l2norm0 = l2norm
2579 if (itestmat == 1)
then
2580 write (fname, fmtfname) this%id, kper, kstp, kiter
2581 print *,
'Saving amat to: ', trim(adjustl(fname))
2584 open (itestmat, file=trim(adjustl(fname)))
2585 write (itestmat, *)
'NODE, RHS, AMAT FOLLOW'
2586 do ieq = 1, this%neq
2587 irow_glo = ieq + this%matrix_offset
2588 icol_s = this%system_matrix%get_first_col_pos(irow_glo)
2589 icol_e = this%system_matrix%get_last_col_pos(irow_glo)
2590 write (itestmat,
'(*(G0,:,","))') &
2593 (this%system_matrix%get_column(ipos), ipos=icol_s, icol_e), &
2594 (this%system_matrix%get_value_pos(ipos), ipos=icol_s, icol_e)
2605 call this%imslinear%imslinear_apply(this%icnvg, kstp, kiter, in_iter, &
2606 this%nitermax, this%convnmod, &
2607 this%convmodstart, this%caccel, &
2610 call this%linear_solver%solve(kiter, this%vec_rhs, &
2611 this%vec_x, this%cnvg_summary)
2612 in_iter = this%linear_solver%iteration_number
2613 this%icnvg = this%linear_solver%is_converged
2626 integer(I4B),
intent(in) :: ifdparam
2629 select case (ifdparam)
2637 this%amomentum =
dzero
2641 this%res_lim =
dzero
2649 this%akappa = 0.0001d0
2651 this%amomentum =
dzero
2655 this%res_lim =
dzero
2663 this%akappa = 0.0001d0
2665 this%amomentum =
dzero
2669 this%res_lim = 0.002d0
2685 integer(I4B),
intent(in) :: kiter
2687 character(len=7) :: cmsg
2689 integer(I4B) :: btflag
2690 integer(I4B) :: ibflag
2691 integer(I4B) :: ibtcnt
2699 call this%sln_buildsystem(kiter, inewton=0)
2703 if (kiter == 1)
then
2704 call this%sln_l2norm(this%res_prev)
2705 resin = this%res_prev
2708 call this%sln_l2norm(this%res_new)
2709 resin = this%res_new
2713 if (this%res_new > this%res_prev * this%btol)
then
2716 btloop:
do nb = 1, this%numtrack
2719 call this%sln_backtracking_xupdate(btflag)
2722 if (btflag == 0)
then
2730 call this%sln_buildsystem(kiter, inewton=0)
2734 call this%sln_l2norm(this%res_new)
2737 if (nb == this%numtrack)
then
2741 if (this%res_new < this%res_prev * this%btol)
then
2745 if (this%res_new < this%res_lim)
then
2751 this%res_prev = this%res_new
2755 if (this%iprims > 0)
then
2756 if (ibtcnt > 0)
then
2763 call this%outertab%add_term(
'Backtracking')
2764 call this%outertab%add_term(kiter)
2765 call this%outertab%add_term(
' ')
2766 if (this%numtrack > 0)
then
2767 call this%outertab%add_term(ibflag)
2768 call this%outertab%add_term(ibtcnt)
2769 call this%outertab%add_term(resin)
2770 call this%outertab%add_term(this%res_prev)
2772 call this%outertab%add_term(
' ')
2773 call this%outertab%add_term(cmsg)
2774 call this%outertab%add_term(
' ')
2787 integer(I4B),
intent(inout) :: bt_flag
2789 bt_flag = this%get_backtracking_flag()
2792 if (bt_flag > 0)
then
2793 call this%apply_backtracking()
2802 integer(I4B) :: bt_flag
2807 real(dp) :: dx_abs_max
2815 if (this%active(n) < 1) cycle
2816 dx = this%x(n) - this%xtemp(n)
2818 if (dx_abs > dx_abs_max) dx_abs_max = dx_abs
2822 if (this%breduc * dx_abs_max >= this%dvclose)
then
2837 if (this%active(n) < 1) cycle
2838 delx = this%breduc * (this%x(n) - this%xtemp(n))
2839 this%x(n) = this%xtemp(n) + delx
2862 vec_resid => this%system_matrix%create_vec(this%neq)
2863 call this%sln_calc_residual(vec_resid)
2866 l2norm = vec_resid%norm2()
2869 call vec_resid%destroy()
2870 deallocate (vec_resid)
2881 integer(I4B),
intent(in) :: nsize
2882 real(DP),
dimension(nsize),
intent(in) :: v
2883 real(DP),
intent(inout) :: vmax
2895 if (denom ==
dzero)
then
2900 dnorm = abs(d) / denom
2901 if (dnorm >
done)
then
2915 integer(I4B),
intent(in) :: neq
2916 integer(I4B),
dimension(neq),
intent(in) :: active
2917 real(DP),
dimension(neq),
intent(in) :: x
2918 real(DP),
dimension(neq),
intent(in) :: xtemp
2919 real(DP),
dimension(neq),
intent(inout) :: dx
2926 if (active(n) < 1)
then
2929 dx(n) = x(n) - xtemp(n)
2938 integer(I4B) :: iptc
2949 vec_resid => this%system_matrix%create_vec(this%neq)
2950 call this%sln_calc_residual(vec_resid)
2953 do im = 1, this%modellist%Count()
2955 call mp%model_ptc(vec_resid, iptc, ptcf)
2959 call vec_resid%destroy()
2960 deallocate (vec_resid)
2972 call this%system_matrix%multiply(this%vec_x, vec_resid)
2974 call vec_resid%axpy(-1.0_dp, this%vec_rhs)
2977 if (this%active(n) < 1)
then
2978 call vec_resid%set_value_local(n, 0.0_dp)
2992 integer(I4B),
intent(in) :: kiter
2993 real(DP),
intent(in) :: bigch
2994 integer(I4B),
intent(in) :: neq
2995 integer(I4B),
dimension(neq),
intent(in) :: active
2996 real(DP),
dimension(neq),
intent(inout) :: x
2997 real(DP),
dimension(neq),
intent(in) :: xtemp
3008 if (this%nonmeth == 1)
then
3012 if (active(n) < 1) cycle
3015 delx = x(n) - xtemp(n)
3016 this%dxold(n) = delx
3019 x(n) = xtemp(n) + this%gamma * delx
3023 else if (this%nonmeth == 2)
then
3029 if (kiter == 1)
then
3031 this%relaxold =
done
3032 this%bigchold = bigch
3036 es = this%bigch / (this%bigchold * this%relaxold)
3038 if (es < -
done)
then
3044 this%relaxold = relax
3047 this%bigchold = (
done - this%gamma) * this%bigch + this%gamma * &
3051 if (relax <
done)
then
3055 if (active(n) < 1) cycle
3058 delx = x(n) - xtemp(n)
3059 this%dxold(n) = delx
3060 x(n) = xtemp(n) + relax * delx
3065 else if (this%nonmeth == 3)
then
3069 if (active(n) < 1) cycle
3072 delx = x(n) - xtemp(n)
3075 if (kiter == 1)
then
3076 this%wsave(n) =
done
3077 this%hchold(n) =
dem20
3078 this%deold(n) =
dzero
3085 if (this%deold(n) * delx <
dzero)
then
3086 ww = this%theta * this%wsave(n)
3089 ww = this%wsave(n) + this%akappa
3095 if (kiter == 1)
then
3096 this%hchold(n) = delx
3098 this%hchold(n) = (
done - this%gamma) * delx + &
3099 this%gamma * this%hchold(n)
3103 this%deold(n) = delx
3104 this%dxold(n) = delx
3108 if (kiter > 4) amom = this%amomentum
3109 delx = delx * ww + amom * this%hchold(n)
3110 x(n) = xtemp(n) + delx
3125 real(DP),
intent(inout) :: hncg
3126 integer(I4B),
intent(inout) :: lrch
3140 if (this%active(n) < 1) cycle
3141 hdif = this%x(n) - this%xtemp(n)
3143 if (ahdif > abigch)
then
3158 logical(LGP) :: has_converged
3160 has_converged = .false.
3161 if (abs(max_dvc) <= this%dvclose)
then
3162 has_converged = .true.
3172 real(dp),
intent(in) :: dpak
3173 character(len=LENPAKLOC),
intent(in) :: cpakout
3174 integer(I4B),
intent(in) :: iend
3176 integer(I4B) :: ivalue
3178 if (abs(dpak) > this%dvclose)
then
3183 'PACKAGE (', trim(cpakout),
') CAUSED CONVERGENCE FAILURE'
3195 integer(I4B),
intent(in) :: inewtonur
3197 integer(I4B) :: ivalue
3206 result(has_converged)
3208 real(dp),
intent(in) :: dxold_max
3209 real(dp),
intent(in) :: hncg
3210 logical(LGP) :: has_converged
3212 has_converged = .false.
3213 if (abs(dxold_max) <= this%dvclose .and. &
3214 abs(hncg) <= this%dvclose)
then
3215 has_converged = .true.
3227 integer(I4B),
intent(in) :: nodesln
3228 character(len=*),
intent(inout) :: str
3232 integer(I4B) :: istart
3233 integer(I4B) :: iend
3234 integer(I4B) :: noder
3235 integer(I4B) :: nglo
3244 nglo = nodesln + this%matrix_offset
3247 do i = 1, this%modellist%Count()
3251 call mp%get_mrange(istart, iend)
3252 if (nglo >= istart .and. nglo <= iend)
then
3253 noder = nglo - istart + 1
3254 call mp%get_mcellid(noder, str)
3268 integer(I4B),
intent(in) :: nodesln
3269 integer(I4B),
intent(inout) :: im
3270 integer(I4B),
intent(inout) :: nodeu
3274 integer(I4B) :: istart
3275 integer(I4B) :: iend
3276 integer(I4B) :: noder, nglo
3282 nglo = nodesln + this%matrix_offset
3285 do i = 1, this%modellist%Count()
3289 call mp%get_mrange(istart, iend)
3290 if (nglo >= istart .and. nglo <= iend)
then
3291 noder = nglo - istart + 1
3292 call mp%get_mnodeu(noder, nodeu)
3306 class(*),
pointer,
intent(inout) :: obj
3314 if (.not.
associated(obj))
return
3330 type(
listtype),
intent(inout) :: list
3331 integer(I4B),
intent(in) :: idx
3335 class(*),
pointer :: obj
3337 obj => list%GetItem(idx)
subroutine, public ats_submit_delt(kstp, kper, dt, sloc, idir)
@ brief Allow and external caller to submit preferred time step
subroutine, public addbasesolutiontolist(list, solution)
This module contains block parser methods.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
@ tabright
right justified table column
@ tableft
left justified table column
@ mvalidate
validation mode - do not run time steps
@ mnormal
normal output mode
real(dp), parameter dem20
real constant 1e-20
real(dp), parameter dep3
real constant 1000
integer(i4b), parameter lensolutionname
maximum length of the solution name
real(dp), parameter dep6
real constant 1000000
real(dp), parameter donethird
real constant 1/3
real(dp), parameter dnodata
real no data constant
integer(i4b), parameter lenpakloc
maximum length of a package location
real(dp), parameter dep20
real constant 1e20
real(dp), parameter dem1
real constant 1e-1
real(dp), parameter dhalf
real constant 1/2
real(dp), parameter dem3
real constant 1e-3
real(dp), parameter dem4
real constant 1e-4
real(dp), parameter dem6
real constant 1e-6
real(dp), parameter dzero
real constant zero
real(dp), parameter dprec
real constant machine precision
real(dp), parameter dem15
real constant 1e-15
real(dp), parameter dem2
real constant 1e-2
real(dp), parameter dtwo
real constant 2
integer(i4b), parameter lenmempath
maximum length of the memory path
real(dp), parameter dthree
real constant 3
real(dp), parameter done
real constant 1
subroutine pstop(status, message)
Stop the program, optionally specifying an error status code.
subroutine allocate_scalars(this)
@ brief Allocate and initialize scalars
integer(i4b), parameter, public cg_method
This module defines variable data types.
class(linearsolverbasetype) function, pointer, public create_linear_solver(solver_mode, sln_name)
Factory method to create the linear solver object.
type(listtype), public basesolutionlist
pure logical function, public is_close(a, b, rtol, atol, symmetric)
Check if a real value is approximately equal to another.
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
Store and issue logging messages to output units.
subroutine, public write_message(text, iunit, fmt, skipbefore, skipafter, advance)
Write a message to an output unit.
class(numericalexchangetype) function, pointer, public getnumericalexchangefromlist(list, idx)
Retrieve a specific numerical exchange from a list.
subroutine, public addnumericalexchangetolist(list, exchange)
Add numerical exchange to a list.
subroutine, public addnumericalmodeltolist(list, model)
class(numericalmodeltype) function, pointer, public getnumericalmodelfromlist(list, idx)
subroutine convergence_summary(this, iu, im, itertot_timestep)
@ brief Solution convergence summary
subroutine sln_get_nodeu(this, nodesln, im, nodeu)
@ brief Get user node number
integer(i4b) function sln_sync_newtonur_flag(this, inewtonur)
Synchronize Newton Under-relaxation flag.
subroutine save(this, filename)
@ brief Save solution data to a file
subroutine sln_backtracking_xupdate(this, bt_flag)
@ brief Backtracking update of the dependent variable
logical(lgp) function sln_nur_has_converged(this, dxold_max, hncg)
Custom convergence check for when Newton UR has been applied.
logical(lgp) function sln_has_converged(this, max_dvc)
integer(i4b), parameter petsc_solver
integer(i4b) function sln_package_convergence(this, dpak, cpakout, iend)
Check package convergence.
type(listtype) function, pointer get_exchanges(this)
Returns a pointer to the list of exchanges in this solution.
subroutine sln_l2norm(this, l2norm)
@ brief Calculate the solution L-2 norm for all active cells using
subroutine sln_connect(this)
@ brief Assign solution connections
subroutine sln_get_loc(this, nodesln, str)
@ brief Get cell location string
subroutine apply_backtracking(this)
Update x with backtracking.
subroutine writecsvheader(this)
@ brief CSV header
subroutine sln_buildsystem(this, kiter, inewton)
subroutine sln_maxval(this, nsize, v, vmax)
@ brief Get the maximum value from a vector
subroutine sln_calc_residual(this, vec_resid)
Calculate the current residual vector r = A*x - b,.
subroutine sln_backtracking(this, mp, cp, kiter)
@ brief Perform backtracking
subroutine sln_calc_ptc(this, iptc, ptcf)
Calculate pseudo-transient continuation factor.
subroutine sln_underrelax(this, kiter, bigch, neq, active, x, xtemp)
@ brief Under-relaxation
class(numericalsolutiontype) function, pointer, public castasnumericalsolutionclass(obj)
@ brief Cast a object as a Numerical Solution
type(listtype) function, pointer get_models(this)
Get a list of models.
subroutine finalizesolve(this, kiter, isgcnvg, isuppress_output)
@ brief finalize a solution
subroutine sln_setouter(this, ifdparam)
@ brief Set default Picard iteration variables
subroutine sln_ls(this, kiter, kstp, kper, in_iter, iptc, ptcf)
@ brief Solve the linear system of equations
subroutine sln_calcdx(this, neq, active, x, xtemp, dx)
@ brief Calculate dependent-variable change
integer(i4b), parameter ims_solver
subroutine csv_convergence_summary(this, iu, totim, kper, kstp, kouter, niter, istart, kstart)
@ brief Solution convergence CSV summary
subroutine sln_reset(this)
@ brief Reset the solution
class(numericalsolutiontype) function, pointer, public getnumericalsolutionfromlist(list, idx)
@ brief Get a numerical solution
subroutine allocate_arrays(this)
@ brief Allocate arrays
integer(i4b) function get_backtracking_flag(this)
Check if backtracking should be applied for this solution,.
subroutine preparesolve(this)
@ brief prepare to solve
subroutine writeptcinfotofile(this, kper)
@ brief PTC header
subroutine add_exchange(this, exchange)
Add exchange.
subroutine add_model(this, mp)
@ brief Add a model
subroutine, public create_numerical_solution(num_sol, filename, id)
@ brief Create a new solution
subroutine sln_get_dxmax(this, hncg, lrch)
@ brief Determine maximum dependent-variable change
type(profilertype), public g_prof
the global timer object (to reduce trivial lines of code)
subroutine print(this, output_unit)
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
integer(i4b) function, public count_errors()
Return number of errors.
subroutine, public deprecation_warning(cblock, cvar, cver, endmsg, iunit)
Store deprecation warning message.
integer(i4b), parameter, public stg_bfr_exg_ad
before exchange advance (per solution)
integer(i4b), parameter, public stg_bfr_exg_cf
before exchange calculate (per solution)
integer(i4b), parameter, public stg_bfr_exg_fc
before exchange formulate (per solution)
integer(i4b), parameter, public stg_bfr_exg_ac
before exchange add connections (per solution)
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
character(len=linelength) simulation_mode
integer(i4b) iout
file unit number for simulation output
integer(i4b) isim_mode
simulation mode
subroutine, public table_cr(this, name, title)
real(dp), pointer, public totim
time relative to start of simulation
integer(i4b), pointer, public kstp
current time step number
integer(i4b), pointer, public kper
current stress period number
real(dp), pointer, public delt
length of the current time step
subroutine, public code_timer(it, t1, ts)
Get end time and calculate elapsed time.
This module contains version information.
integer(i4b), parameter idevelopmode
Highest level model type. All models extend this parent type.
This structure stores the generic convergence info for a solution.
Abstract type for linear solver.
A generic heterogeneous doubly-linked list.