31 NEQ, NJA, NIAPC, NJAPC, &
32 IPC, ICNVGOPT, NORTH, &
33 DVCLOSE, RCLOSE, L2NORM0, EPFACT, &
34 IA0, JA0, A0, IAPC, JAPC, APC, &
37 NCONV, CONVNMOD, CONVMODSTART, &
40 integer(I4B),
INTENT(INOUT) :: ICNVG
41 integer(I4B),
INTENT(IN) :: ITMAX
42 integer(I4B),
INTENT(INOUT) :: INNERIT
43 integer(I4B),
INTENT(IN) :: NEQ
44 integer(I4B),
INTENT(IN) :: NJA
45 integer(I4B),
INTENT(IN) :: NIAPC
46 integer(I4B),
INTENT(IN) :: NJAPC
47 integer(I4B),
INTENT(IN) :: IPC
48 integer(I4B),
INTENT(IN) :: ICNVGOPT
49 integer(I4B),
INTENT(IN) :: NORTH
50 real(DP),
INTENT(IN) :: DVCLOSE
51 real(DP),
INTENT(IN) :: RCLOSE
52 real(DP),
INTENT(IN) :: L2NORM0
53 real(DP),
INTENT(IN) :: EPFACT
54 integer(I4B),
DIMENSION(NEQ + 1),
INTENT(IN) :: IA0
55 integer(I4B),
DIMENSION(NJA),
INTENT(IN) :: JA0
56 real(DP),
DIMENSION(NJA),
INTENT(IN) :: A0
57 integer(I4B),
DIMENSION(NIAPC + 1),
INTENT(IN) :: IAPC
58 integer(I4B),
DIMENSION(NJAPC),
INTENT(IN) :: JAPC
59 real(DP),
DIMENSION(NJAPC),
INTENT(IN) :: APC
60 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: X
61 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: B
62 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: D
63 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: P
64 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: Q
65 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: Z
67 integer(I4B),
INTENT(IN) :: NJLU
68 integer(I4B),
DIMENSION(NIAPC),
INTENT(IN) :: IW
69 integer(I4B),
DIMENSION(NJLU),
INTENT(IN) :: JLU
71 integer(I4B),
INTENT(IN) :: NCONV
72 integer(I4B),
INTENT(IN) :: CONVNMOD
73 integer(I4B),
DIMENSION(CONVNMOD + 1),
INTENT(INOUT) :: CONVMODSTART
74 character(len=31),
DIMENSION(NCONV),
INTENT(INOUT) :: CACCEL
79 character(len=31) :: cval
82 integer(I4B) :: xloc, rloc
83 integer(I4B) :: im, im0, im1
90 real(DP) :: denominator
91 real(DP) :: alpha, beta
100 inner:
DO iiter = 1, itmax
101 innerit = innerit + 1
102 summary%iter_cnt = summary%iter_cnt + 1
113 CALL lusol(neq, d, z, apc, jlu, iw)
115 rho = ddot(neq, d, 1, z, 1)
125 p(n) = z(n) + beta * p(n)
132 call amux(neq, p, q, a0, ja0, ia0)
133 denominator = ddot(neq, p, 1, q, 1)
134 denominator = denominator + sign(
dprec, denominator)
135 alpha = rho / denominator
142 summary%locdv(im) = 0
143 summary%dvmax(im) =
dzero
145 summary%rmax(im) =
dzero
148 im0 = convmodstart(1)
149 im1 = convmodstart(2)
155 im0 = convmodstart(im)
156 im1 = convmodstart(im + 1)
162 IF (abs(tv) > abs(deltax))
THEN
166 IF (abs(tv) > abs(summary%dvmax(im)))
THEN
167 summary%dvmax(im) = tv
168 summary%locdv(im) = n
171 tv = tv - alpha * q(n)
173 IF (abs(tv) > abs(rmax))
THEN
177 IF (abs(tv) > abs(summary%rmax(im)))
THEN
178 summary%rmax(im) = tv
181 l2norm = l2norm + tv * tv
183 l2norm = sqrt(l2norm)
188 WRITE (cval,
'(g15.7)') alpha
190 summary%itinner(n) = iiter
192 summary%convlocdv(im, n) = summary%locdv(im)
193 summary%convlocr(im, n) = summary%locr(im)
194 summary%convdvmax(im, n) = summary%dvmax(im)
195 summary%convrmax(im, n) = summary%rmax(im)
200 IF (icnvgopt == 2 .OR. icnvgopt == 3 .OR. icnvgopt == 4)
THEN
207 l2norm0, epfact, dvclose, rclose)
210 IF (rcnvg ==
dzero) icnvg = 1
213 IF (icnvg .NE. 0)
EXIT inner
223 lorth = mod(iiter + 1, north) == 0
230 if (rho ==
dzero)
then
239 IF (icnvg < 0) icnvg = 0
253 NEQ, NJA, NIAPC, NJAPC, &
254 IPC, ICNVGOPT, NORTH, ISCL, DSCALE, &
255 DVCLOSE, RCLOSE, L2NORM0, EPFACT, &
256 IA0, JA0, A0, IAPC, JAPC, APC, &
258 T, V, DHAT, PHAT, QHAT, &
260 NCONV, CONVNMOD, CONVMODSTART, &
263 integer(I4B),
INTENT(INOUT) :: ICNVG
264 integer(I4B),
INTENT(IN) :: ITMAX
265 integer(I4B),
INTENT(INOUT) :: INNERIT
266 integer(I4B),
INTENT(IN) :: NEQ
267 integer(I4B),
INTENT(IN) :: NJA
268 integer(I4B),
INTENT(IN) :: NIAPC
269 integer(I4B),
INTENT(IN) :: NJAPC
270 integer(I4B),
INTENT(IN) :: IPC
271 integer(I4B),
INTENT(IN) :: ICNVGOPT
272 integer(I4B),
INTENT(IN) :: NORTH
273 integer(I4B),
INTENT(IN) :: ISCL
274 real(DP),
DIMENSION(NEQ),
INTENT(IN) :: DSCALE
275 real(DP),
INTENT(IN) :: DVCLOSE
276 real(DP),
INTENT(IN) :: RCLOSE
277 real(DP),
INTENT(IN) :: L2NORM0
278 real(DP),
INTENT(IN) :: EPFACT
279 integer(I4B),
DIMENSION(NEQ + 1),
INTENT(IN) :: IA0
280 integer(I4B),
DIMENSION(NJA),
INTENT(IN) :: JA0
281 real(DP),
DIMENSION(NJA),
INTENT(IN) :: A0
282 integer(I4B),
DIMENSION(NIAPC + 1),
INTENT(IN) :: IAPC
283 integer(I4B),
DIMENSION(NJAPC),
INTENT(IN) :: JAPC
284 real(DP),
DIMENSION(NJAPC),
INTENT(IN) :: APC
285 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: X
286 real(DP),
DIMENSION(NEQ),
INTENT(IN) :: B
287 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: D
288 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: P
289 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: Q
290 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: T
291 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: V
292 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: DHAT
293 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: PHAT
294 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: QHAT
296 integer(I4B),
INTENT(IN) :: NJLU
297 integer(I4B),
DIMENSION(NIAPC),
INTENT(IN) :: IW
298 integer(I4B),
DIMENSION(NJLU),
INTENT(IN) :: JLU
300 integer(I4B),
INTENT(IN) :: NCONV
301 integer(I4B),
INTENT(IN) :: CONVNMOD
302 integer(I4B),
DIMENSION(CONVNMOD + 1),
INTENT(INOUT) :: CONVMODSTART
303 character(len=31),
DIMENSION(NCONV),
INTENT(INOUT) :: CACCEL
308 character(len=15) :: cval1, cval2
310 integer(I4B) :: iiter
311 integer(I4B) :: xloc, rloc
312 integer(I4B) :: im, im0, im1
319 real(DP) :: alpha, alpha0
321 real(DP) :: rho, rho0
322 real(DP) :: omega, omega0
323 real(DP) :: numerator, denominator
341 inner:
DO iiter = 1, itmax
342 innerit = innerit + 1
343 summary%iter_cnt = summary%iter_cnt + 1
346 rho = ddot(neq, dhat, 1, d, 1)
354 beta = (rho / rho0) * (alpha0 / omega0)
356 p(n) = d(n) + beta * (p(n) - omega0 * v(n))
369 CALL lusol(neq, p, phat, apc, jlu, iw)
375 call amux(neq, phat, v, a0, ja0, ia0)
378 denominator = ddot(neq, dhat, 1, v, 1)
379 denominator = denominator + sign(
dprec, denominator)
380 alpha = rho / denominator
384 q(n) = d(n) - alpha * v(n)
420 CALL lusol(neq, q, qhat, apc, jlu, iw)
424 call amux(neq, qhat, t, a0, ja0, ia0)
427 numerator = ddot(neq, t, 1, q, 1)
428 denominator = ddot(neq, t, 1, t, 1)
429 denominator = denominator + sign(
dprec, denominator)
430 omega = numerator / denominator
437 summary%dvmax(im) =
dzero
438 summary%rmax(im) =
dzero
441 im0 = convmodstart(1)
442 im1 = convmodstart(2)
448 im0 = convmodstart(im)
449 im1 = convmodstart(im + 1)
453 tv = alpha * phat(n) + omega * qhat(n)
455 IF (iscl .NE. 0)
THEN
458 IF (abs(tv) > abs(deltax))
THEN
462 IF (abs(tv) > abs(summary%dvmax(im)))
THEN
463 summary%dvmax(im) = tv
464 summary%locdv(im) = n
468 tv = q(n) - omega * t(n)
470 IF (iscl .NE. 0)
THEN
473 IF (abs(tv) > abs(rmax))
THEN
477 IF (abs(tv) > abs(summary%rmax(im)))
THEN
478 summary%rmax(im) = tv
481 l2norm = l2norm + tv * tv
483 l2norm = sqrt(l2norm)
488 WRITE (cval1,
'(g15.7)') alpha
489 WRITE (cval2,
'(g15.7)') omega
490 caccel(n) = trim(adjustl(cval1))//
','//trim(adjustl(cval2))
491 summary%itinner(n) = iiter
493 summary%convdvmax(im, n) = summary%dvmax(im)
494 summary%convlocdv(im, n) = summary%locdv(im)
495 summary%convrmax(im, n) = summary%rmax(im)
496 summary%convlocr(im, n) = summary%locr(im)
501 IF (icnvgopt == 2 .OR. icnvgopt == 3 .OR. icnvgopt == 4)
THEN
508 l2norm0, epfact, dvclose, rclose)
511 IF (rcnvg ==
dzero) icnvg = 1
514 IF (icnvg .NE. 0)
EXIT inner
533 lorth = mod(iiter + 1, north) == 0
540 if (rho * omega ==
dzero)
then
551 IF (icnvg < 0) icnvg = 0
566 integer(I4B),
INTENT(IN) :: IORD
567 integer(I4B),
INTENT(IN) :: NEQ
568 integer(I4B),
INTENT(IN) :: NJA
569 integer(I4B),
DIMENSION(NEQ + 1),
INTENT(IN) :: IA
570 integer(I4B),
DIMENSION(NJA),
INTENT(IN) :: JA
571 integer(I4B),
DIMENSION(NEQ),
INTENT(INOUT) :: LORDER
572 integer(I4B),
DIMENSION(NEQ),
INTENT(INOUT) :: IORDER
574 character(len=LINELENGTH) :: errmsg
577 integer(I4B),
DIMENSION(:),
ALLOCATABLE :: iwork0
578 integer(I4B),
DIMENSION(:),
ALLOCATABLE :: iwork1
579 integer(I4B) :: iflag
589 CALL genrcm(neq, nja, ia, ja, lorder)
591 nsp = 3 * neq + 4 * nja
592 allocate (iwork0(neq))
593 allocate (iwork1(nsp))
594 CALL ims_odrv(neq, nja, nsp, ia, ja, lorder, iwork0, &
596 IF (iflag .NE. 0)
THEN
597 write (errmsg,
'(A,1X,A)') &
598 'IMSLINEARSUB_CALC_ORDER error creating minimum degree ', &
604 deallocate (iwork0, iwork1)
609 iorder(lorder(n)) = n
614 call parser%StoreErrorUnit()
631 integer(I4B),
INTENT(IN) :: IOPT
632 integer(I4B),
INTENT(IN) :: ISCL
633 integer(I4B),
INTENT(IN) :: NEQ
634 integer(I4B),
INTENT(IN) :: NJA
635 integer(I4B),
DIMENSION(NEQ + 1),
INTENT(IN) :: IA
636 integer(I4B),
DIMENSION(NJA),
INTENT(IN) :: JA
637 real(DP),
DIMENSION(NJA),
INTENT(INOUT) :: AMAT
638 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: X
639 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: B
640 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: DSCALE
641 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: DSCALE2
644 integer(I4B) :: id, jc
645 integer(I4B) :: i0, i1
646 real(DP) :: v, c1, c2
657 c1 =
done / sqrt(abs(v))
670 amat(i) = c1 * amat(i) * c2
683 c1 = c1 + amat(i) * amat(i)
686 IF (c1 ==
dzero)
THEN
695 amat(i) = c1 * amat(i)
710 dscale2(jc) = dscale2(jc) + c2 * c2
715 IF (c2 ==
dzero)
THEN
730 amat(i) = c2 * amat(i)
754 amat(i) = (
done / c1) * amat(i) * (
done / c2)
774 AMAT, IA, JA, APC, IAPC, JAPC, IW, W, &
775 LEVEL, DROPTOL, NJLU, NJW, NWLU, JLU, JW, WLU)
779 integer(I4B),
INTENT(IN) :: IOUT
780 integer(I4B),
INTENT(IN) :: NJA
781 integer(I4B),
INTENT(IN) :: NEQ
782 integer(I4B),
INTENT(IN) :: NIAPC
783 integer(I4B),
INTENT(IN) :: NJAPC
784 integer(I4B),
INTENT(IN) :: IPC
785 real(DP),
INTENT(IN) :: RELAX
786 real(DP),
DIMENSION(NJA),
INTENT(IN) :: AMAT
787 integer(I4B),
DIMENSION(NEQ + 1),
INTENT(IN) :: IA
788 integer(I4B),
DIMENSION(NJA),
INTENT(IN) :: JA
789 real(DP),
DIMENSION(NJAPC),
INTENT(INOUT) :: APC
790 integer(I4B),
DIMENSION(NIAPC + 1),
INTENT(INOUT) :: IAPC
791 integer(I4B),
DIMENSION(NJAPC),
INTENT(INOUT) :: JAPC
792 integer(I4B),
DIMENSION(NIAPC),
INTENT(INOUT) :: IW
793 real(DP),
DIMENSION(NIAPC),
INTENT(INOUT) :: W
795 integer(I4B),
INTENT(IN) :: LEVEL
796 real(DP),
INTENT(IN) :: DROPTOL
797 integer(I4B),
INTENT(IN) :: NJLU
798 integer(I4B),
INTENT(IN) :: NJW
799 integer(I4B),
INTENT(IN) :: NWLU
800 integer(I4B),
DIMENSION(NJLU),
INTENT(INOUT) :: JLU
801 integer(I4B),
DIMENSION(NJW),
INTENT(INOUT) :: JW
802 real(DP),
DIMENSION(NWLU),
INTENT(INOUT) :: WLU
804 character(len=LINELENGTH) :: errmsg
805 character(len=100),
dimension(5),
parameter :: cerr = &
806 [
"Elimination process has generated a row in L or U whose length is > n.", &
807 &
"The matrix L overflows the array al. ", &
808 &
"The matrix U overflows the array alu. ", &
809 &
"Illegal value for lfil. ", &
810 &
"Zero row encountered. "]
811 integer(i4b) :: ipcflag
812 integer(I4B) :: icount
816 2000
FORMAT(/,
' MATRIX IS SEVERELY NON-DIAGONALLY DOMINANT.', &
817 /,
' ADDED SMALL VALUE TO PIVOT ', i0,
' TIMES IN', &
818 ' IMSLINEARSUB_PCU.')
830 apc, iapc, japc, iw, w, &
831 relax, ipcflag, delta)
836 CALL ilut(neq, amat, ja, ia, level, droptol, &
837 apc, jlu, iw, njapc, wlu, jw, ierr, &
838 relax, ipcflag, delta)
841 write (errmsg,
'(a,1x,i0,1x,a)') &
842 'ILUT: zero pivot encountered at step number', ierr,
'.'
844 write (errmsg,
'(a,1x,a)')
'ILUT:', cerr(-ierr)
847 call parser%StoreErrorUnit()
854 IF (ipcflag < 1)
THEN
857 delta = 1.5d0 * delta +
dem3
859 IF (delta >
dhalf)
THEN
866 if (icount > 10)
then
874 write (iout, 2000) icount
889 integer(I4B),
INTENT(IN) :: NJA
890 integer(I4B),
INTENT(IN) :: NEQ
891 real(DP),
DIMENSION(NJA),
INTENT(IN) :: AMAT
892 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: APC
893 integer(I4B),
DIMENSION(NEQ + 1),
INTENT(IN) :: IA
894 integer(I4B),
DIMENSION(NJA),
INTENT(IN) :: JA
897 integer(I4B) :: ic0, ic1
927 integer(I4B),
INTENT(IN) :: NEQ
928 real(DP),
DIMENSION(NEQ),
INTENT(IN) :: A
929 real(DP),
DIMENSION(NEQ),
INTENT(IN) :: D1
930 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: D2
950 APC, IAPC, JAPC, IW, W, &
951 RELAX, IPCFLAG, DELTA)
953 integer(I4B),
INTENT(IN) :: NJA
954 integer(I4B),
INTENT(IN) :: NEQ
955 real(DP),
DIMENSION(NJA),
INTENT(IN) :: AMAT
956 integer(I4B),
DIMENSION(NEQ + 1),
INTENT(IN) :: IA
957 integer(I4B),
DIMENSION(NJA),
INTENT(IN) :: JA
958 real(DP),
DIMENSION(NJA),
INTENT(INOUT) :: APC
959 integer(I4B),
DIMENSION(NEQ + 1),
INTENT(INOUT) :: IAPC
960 integer(I4B),
DIMENSION(NJA),
INTENT(INOUT) :: JAPC
961 integer(I4B),
DIMENSION(NEQ),
INTENT(INOUT) :: IW
962 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: W
963 real(DP),
INTENT(IN) :: RELAX
964 integer(I4B),
INTENT(INOUT) :: IPCFLAG
965 real(DP),
INTENT(IN) :: DELTA
967 integer(I4B) :: ic0, ic1
968 integer(I4B) :: iic0, iic1
969 integer(I4B) :: iu, iiu
972 integer(I4B) :: jcol, jw
973 integer(I4B) :: jjcol
992 w(jcol) = w(jcol) + amat(j)
995 ic1 = iapc(n + 1) - 1
998 lower:
DO j = ic0, iu - 1
1001 iic1 = iapc(jcol + 1) - 1
1003 tl = w(jcol) * apc(jcol)
1009 w(jjcol) = w(jjcol) - tl * apc(jj)
1011 rs = rs + tl * apc(jj)
1018 tl = (
done + delta) * d - (drelax * rs)
1022 IF (sd1 .NE. d)
THEN
1026 IF (ipcflag > 1)
THEN
1035 IF (abs(tl) ==
dzero)
THEN
1039 IF (ipcflag > 1)
THEN
1075 integer(I4B),
INTENT(IN) :: NJA
1076 integer(I4B),
INTENT(IN) :: NEQ
1077 real(DP),
DIMENSION(NJA),
INTENT(IN) :: APC
1078 integer(I4B),
DIMENSION(NEQ + 1),
INTENT(IN) :: IAPC
1079 integer(I4B),
DIMENSION(NJA),
INTENT(IN) :: JAPC
1080 real(DP),
DIMENSION(NEQ),
INTENT(IN) :: R
1081 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: D
1083 integer(I4B) :: ic0, ic1
1085 integer(I4B) :: jcol
1086 integer(I4B) :: j, n
1090 forward:
DO n = 1, neq
1093 ic1 = iapc(n + 1) - 1
1095 lower:
DO j = ic0, iu
1097 tv = tv - apc(j) * d(jcol)
1103 backward:
DO n = neq, 1, -1
1105 ic1 = iapc(n + 1) - 1
1108 upper:
DO j = iu, ic1
1110 tv = tv - apc(j) * d(jcol)
1130 Rmax0, Epfact, Dvclose, Rclose)
1132 integer(I4B),
INTENT(IN) :: Icnvgopt
1133 integer(I4B),
INTENT(INOUT) :: Icnvg
1134 integer(I4B),
INTENT(IN) :: Iiter
1135 real(DP),
INTENT(IN) :: Dvmax
1136 real(DP),
INTENT(IN) :: Rmax
1137 real(DP),
INTENT(IN) :: Rmax0
1138 real(DP),
INTENT(IN) :: Epfact
1139 real(DP),
INTENT(IN) :: Dvclose
1140 real(DP),
INTENT(IN) :: Rclose
1142 IF (icnvgopt == 0)
THEN
1143 IF (abs(dvmax) <= dvclose .AND. abs(rmax) <= rclose)
THEN
1146 ELSE IF (icnvgopt == 1)
THEN
1147 IF (abs(dvmax) <= dvclose .AND. abs(rmax) <= rclose)
THEN
1148 IF (iiter == 1)
THEN
1154 ELSE IF (icnvgopt == 2)
THEN
1155 IF (abs(dvmax) <= dvclose .OR. rmax <= rclose)
THEN
1157 ELSE IF (rmax <= rmax0 * epfact)
THEN
1160 ELSE IF (icnvgopt == 3)
THEN
1161 IF (abs(dvmax) <= dvclose)
THEN
1163 ELSE IF (rmax <= rmax0 * rclose)
THEN
1166 ELSE IF (icnvgopt == 4)
THEN
1167 IF (abs(dvmax) <= dvclose .AND. rmax <= rclose)
THEN
1169 ELSE IF (rmax <= rmax0 * epfact)
THEN
1179 niapc, njapc, njlu, njw, nwlu)
1180 integer(I4B),
intent(in) :: neq
1181 integer(I4B),
intent(in) :: nja
1182 integer(I4B),
dimension(:),
intent(in) :: ia
1183 integer(I4B),
intent(in) :: level
1184 integer(I4B),
intent(in) :: ipc
1185 integer(I4B),
intent(inout) :: niapc
1186 integer(I4B),
intent(inout) :: njapc
1187 integer(I4B),
intent(inout) :: njlu
1188 integer(I4B),
intent(inout) :: njw
1189 integer(I4B),
intent(inout) :: nwlu
1191 integer(I4B) :: n, i
1192 integer(I4B) :: ijlu, ijw, iwlu, iwk
1203 if (ipc == 3 .or. ipc == 4)
then
1206 iwk = neq * (level * 2 + 1)
1210 i = ia(n + 1) - ia(n)
1240 integer(I4B),
INTENT(IN) :: NEQ
1241 integer(I4B),
INTENT(IN) :: NJA
1242 integer(I4B),
DIMENSION(NEQ + 1),
INTENT(IN) :: IA
1243 integer(I4B),
DIMENSION(NJA),
INTENT(IN) :: JA
1244 integer(I4B),
DIMENSION(NEQ + 1),
INTENT(INOUT) :: IAPC
1245 integer(I4B),
DIMENSION(NJA),
INTENT(INOUT) :: JAPC
1247 integer(I4B) :: n, j
1248 integer(I4B) :: i0, i1
1249 integer(I4B) :: nlen
1250 integer(I4B) :: ic, ip
1251 integer(I4B) :: jcol
1252 integer(I4B),
DIMENSION(:),
ALLOCATABLE :: iarr
1259 ALLOCATE (iarr(nlen))
1263 IF (jcol == n) cycle
1276 iapc(neq + 1) = nja + 1
1281 i1 = iapc(n + 1) - 1
1282 japc(n) = iapc(n + 1)
1303 integer(I4B),
INTENT(IN) :: NVAL
1304 integer(I4B),
DIMENSION(NVAL),
INTENT(INOUT) :: IARRAY
1306 integer(I4B) :: i, j, itemp
1310 if (iarray(i) > iarray(j))
then
1312 iarray(j) = iarray(i)
1329 integer(I4B),
INTENT(IN) :: NEQ
1330 integer(I4B),
INTENT(IN) :: NJA
1331 real(DP),
DIMENSION(NEQ),
INTENT(IN) :: X
1332 real(DP),
DIMENSION(NEQ),
INTENT(IN) :: B
1333 real(DP),
DIMENSION(NEQ),
INTENT(INOUT) :: D
1334 real(DP),
DIMENSION(NJA),
INTENT(IN) :: A
1335 integer(I4B),
DIMENSION(NEQ + 1),
INTENT(IN) :: IA
1336 integer(I4B),
DIMENSION(NJA),
INTENT(IN) :: JA
1342 call amux(neq, x, d, a, ja, ia)
1356 integer(I4B) :: icnvgopt
1357 integer(I4B) :: kstp
1360 if (icnvgopt == 2)
then
1366 else if (icnvgopt == 4)
then
subroutine ilut(n, a, ja, ia, lfil, droptol, alu, jlu, ju, iwk, w, jw, ierr, relax, izero, delta)
subroutine lusol(n, y, x, alu, jlu, ju)
This module contains block parser methods.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
real(dp), parameter dhalf
real constant 1/2
real(dp), parameter dem3
real constant 1e-3
integer(i4b), parameter izero
integer constant zero
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 done
real constant 1
This module contains the IMS linear accelerator subroutines.
subroutine ims_base_pcu(IOUT, NJA, NEQ, NIAPC, NJAPC, IPC, RELAX, AMAT, IA, JA, APC, IAPC, JAPC, IW, W, LEVEL, DROPTOL, NJLU, NJW, NWLU, JLU, JW, WLU)
@ brief Update the preconditioner
subroutine ims_base_cg(ICNVG, ITMAX, INNERIT, NEQ, NJA, NIAPC, NJAPC, IPC, ICNVGOPT, NORTH, DVCLOSE, RCLOSE, L2NORM0, EPFACT, IA0, JA0, A0, IAPC, JAPC, APC, X, B, D, P, Q, Z, NJLU, IW, JLU, NCONV, CONVNMOD, CONVMODSTART, CACCEL, summary)
@ brief Preconditioned Conjugate Gradient linear accelerator
subroutine ims_base_pccrs(NEQ, NJA, IA, JA, IAPC, JAPC)
@ brief Generate CRS pointers for the preconditioner
subroutine ims_base_isort(NVAL, IARRAY)
In-place sorting for an integer array.
subroutine ims_base_bcgs(ICNVG, ITMAX, INNERIT, NEQ, NJA, NIAPC, NJAPC, IPC, ICNVGOPT, NORTH, ISCL, DSCALE, DVCLOSE, RCLOSE, L2NORM0, EPFACT, IA0, JA0, A0, IAPC, JAPC, APC, X, B, D, P, Q, T, V, DHAT, PHAT, QHAT, NJLU, IW, JLU, NCONV, CONVNMOD, CONVMODSTART, CACCEL, summary)
@ brief Preconditioned BiConjugate Gradient Stabilized linear accelerator
subroutine ims_calc_pcdims(neq, nja, ia, level, ipc, niapc, njapc, njlu, njw, nwlu)
subroutine ims_base_scale(IOPT, ISCL, NEQ, NJA, IA, JA, AMAT, X, B, DSCALE, DSCALE2)
@ brief Scale the coefficient matrix
subroutine ims_base_testcnvg(Icnvgopt, Icnvg, Iiter, Dvmax, Rmax, Rmax0, Epfact, Dvclose, Rclose)
@ brief Test for solver convergence
real(dp) function ims_base_epfact(icnvgopt, kstp)
Function returning EPFACT.
subroutine ims_base_ilu0a(NJA, NEQ, APC, IAPC, JAPC, R, D)
@ brief Apply the ILU0 and MILU0 preconditioners
subroutine ims_base_pcjac(NJA, NEQ, AMAT, APC, IA, JA)
@ brief Jacobi preconditioner
subroutine ims_base_calc_order(IORD, NEQ, NJA, IA, JA, LORDER, IORDER)
@ brief Calculate LORDER AND IORDER
subroutine ims_base_residual(NEQ, NJA, X, B, D, A, IA, JA)
Calculate residual.
subroutine ims_base_pcilu0(NJA, NEQ, AMAT, IA, JA, APC, IAPC, JAPC, IW, W, RELAX, IPCFLAG, DELTA)
@ brief Update the ILU0 preconditioner
type(blockparsertype), private parser
subroutine ims_base_jaca(NEQ, A, D1, D2)
@ brief Apply the Jacobi preconditioner
subroutine, public ims_odrv(n, nja, nsp, ia, ja, p, ip, isp, flag)
This module defines variable data types.
pure logical function, public is_close(a, b, rtol, atol, symmetric)
Check if a real value is approximately equal to another.
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 genrcm(node_num, adj_num, adj_row, adj, perm)
subroutine amux(n, x, y, a, ja, ia)
This structure stores the generic convergence info for a solution.