17 integer(4),
parameter :: krealp = 8
19 integer(kind=kint) :: NPFIU, NPFIL
20 integer(kind=kint) :: N
21 integer(kind=kint) :: NDOF, NDOF2
22 integer(kind=kint),
pointer :: inumFI1L(:) => null()
23 integer(kind=kint),
pointer :: inumFI1U(:) => null()
24 integer(kind=kint),
pointer :: FI1L(:) => null()
25 integer(kind=kint),
pointer :: FI1U(:) => null()
27 integer(kind=kint),
pointer :: indexL(:) => null()
28 integer(kind=kint),
pointer :: indexU(:) => null()
29 integer(kind=kint),
pointer :: itemL(:) => null()
30 integer(kind=kint),
pointer :: itemU(:) => null()
31 real(kind=
kreal),
pointer :: d(:) => null()
32 real(kind=
kreal),
pointer :: al(:) => null()
33 real(kind=
kreal),
pointer :: au(:) => null()
35 real(kind=krealp),
pointer :: sainvu(:) => null()
36 real(kind=krealp),
pointer :: sainvl(:) => null()
37 real(kind=krealp),
pointer :: sainvd(:) => null()
38 real(kind=
kreal),
pointer :: t(:) => null()
49 integer(kind=kint ) :: precond
50 real(kind=krealp) :: filter
60 indexl => hecmat%indexL
61 indexu => hecmat%indexU
65 if (precond.eq.20)
call form_ilu1_sainv_nn(hecmat)
67 allocate (sainvd(ndof2*hecmat%NP))
68 allocate (sainvl(ndof2*npfiu))
69 allocate (t(ndof*hecmat%NP))
74 filter= hecmat%Rarray(5)
76 write(*,
"(a,F15.8)")
"### SAINV FILTER :",filter
78 call hecmw_sainv_nn(hecmat)
80 allocate (sainvu(ndof2*npfiu))
83 call hecmw_sainv_make_u_nn(hecmat)
89 real(kind=
kreal),
intent(inout) :: zp(:)
90 real(kind=
kreal),
intent(in) :: r(:)
91 integer(kind=kint) :: in, i, j, isl, iel, isu, ieu,idof,jdof
92 real(kind=
kreal) :: sw(ndof),x(ndof)
116 x(idof) = r(ndof*(in-1)+idof)
120 sw(idof) = sw(idof) + sainvl(ndof2*(j-1)+ndof*(idof-1)+jdof)*x(jdof)
125 x(idof) = r(ndof*(i-1)+idof)
126 t(ndof*(i-1)+idof)=x(idof)+sw(idof)
130 t(ndof*(i-1)+idof)=t(ndof*(i-1)+idof)+sainvd(ndof2*(i-1)+ndof*(jdof-1)+idof)*x(jdof)
132 t(ndof*(i-1)+idof)=t(ndof*(i-1)+idof)*sainvd(ndof2*(i-1)+ndof*(idof-1)+idof)
153 isu= inumfi1u(i-1) + 1
158 x(idof) = t(ndof*(in-1)+idof)
162 sw(idof) = sw(idof) + sainvu(ndof2*(j-1)+ndof*(idof-1)+jdof)*x(jdof)
168 x(idof) = t(ndof*(i-1)+idof)
171 zp(ndof*(i-1)+idof) = x(idof) + sw(idof)
172 do jdof = ndof, idof+1, -1
173 zp(ndof*(i-1)+idof) = zp(ndof*(i-1)+idof)+sainvd(ndof2*(i-1)+ndof*(idof-1)+jdof)*x(jdof)
193 subroutine hecmw_sainv_nn(hecMAT)
197 integer(kind=kint) :: i, j, k, js, je, in, itr, idof, jdof, iitr
198 real(kind=krealp) :: dd, dtmp(hecmat%NDOF), x(hecmat%NDOF)
200 real(kind=krealp) :: filter
201 real(kind=krealp),
allocatable :: zz(:), vv(:)
203 filter= hecmat%Rarray(5)
205 allocate (vv(ndof*hecmat%NP))
206 allocate (zz(ndof*hecmat%NP))
213 zz(ndof*(itr-1)+idof)= sainvd(ndof2*(itr-1)+ndof*(idof-1)+iitr)
215 zz(ndof*(itr-1)+iitr)= 1.0d0
217 js= inumfi1l(itr-1) + 1
222 zz(ndof*(in-1)+idof)=sainvl(ndof2*(j-1)+ndof*(iitr-1)+idof)
228 x(idof)=zz(ndof*(i-1)+idof)
232 vv(ndof*(i-1)+idof) = vv(ndof*(i-1)+idof) + d(ndof2*(i-1)+ndof*(idof-1)+jdof)*x(jdof)
242 vv(ndof*(in-1)+idof) = vv(ndof*(in-1)+idof) + al(ndof2*(j-1)+ndof*(jdof-1)+idof)*x(jdof)
252 vv(ndof*(in-1)+idof) = vv(ndof*(in-1)+idof) + au(ndof2*(j-1)+ndof*(jdof-1)+idof)*x(jdof)
260 dtmp(idof)= sainvd(ndof2*(itr-1)+ndof*(idof-1)+idof)
265 sainvd(ndof2*(i-1)+ndof*(idof-1)+idof) = vv(ndof*(i-1)+idof)
267 sainvd(ndof2*(i-1)+ndof*(idof-1)+idof) = sainvd(ndof2*(i-1)+ndof*(idof-1)+idof) + &
268 & sainvd(ndof2*(i-1)+ndof*(jdof-1)+idof)*vv(ndof*(i-1)+jdof)
271 js= inumfi1l(i-1) + 1
276 x(idof)=vv(ndof*(in-1)+idof)
280 sainvd(ndof2*(i-1)+ndof*(idof-1)+idof) = sainvd(ndof2*(i-1)+ndof*(idof-1)+idof) + &
281 & sainvl(ndof2*(j-1)+ndof*(idof-1)+jdof)*x(jdof)
288 dd = 1.0d0/sainvd(ndof2*(itr-1)+ndof*(iitr-1)+iitr)
290 sainvd(ndof2*(itr-1)+ndof*(idof-1)+idof) = dtmp(idof)
293 do idof = iitr+1, ndof
294 sainvd(ndof2*(itr-1)+ndof*(idof-1)+idof) = sainvd(ndof2*(itr-1)+ndof*(idof-1)+idof)*dd
299 sainvd(ndof2*(i-1)+ndof*(idof-1)+idof) = sainvd(ndof2*(i-1)+ndof*(idof-1)+idof)*dd
305 dd = sainvd(ndof2*(itr-1)+ndof*(k-1)+k)
306 if(abs(dd) > filter)
then
308 sainvd(ndof2*(itr-1)+ndof*(jdof-1)+k)= sainvd(ndof2*(itr-1)+ndof*(jdof-1)+k) - dd*zz(ndof*(itr-1)+jdof)
310 js= inumfi1l(itr-1) + 1
315 sainvl(ndof2*(j-1)+ndof*(k-1)+idof) = sainvl(ndof2*(j-1)+ndof*(k-1)+idof)-dd*zz(ndof*(in-1)+idof)
322 js= inumfi1l(i-1) + 1
325 dd = sainvd(ndof2*(i-1)+ndof*(idof-1)+idof)
326 if(abs(dd) > filter)
then
331 sainvl(ndof2*(j-1)+ndof*(idof-1)+jdof)=sainvl(ndof2*(j-1)+ndof*(idof-1)+jdof)-dd*zz(ndof*(in-1)+jdof)
344 sainvd(ndof2*(i-1)+ndof*(idof-1)+idof)=1/sainvd(ndof2*(i-1)+ndof*(idof-1)+idof)
345 do jdof = idof+1, ndof
346 sainvd(ndof2*(i-1)+ndof*(jdof-1)+idof)=sainvd(ndof2*(i-1)+ndof*(idof-1)+jdof)
350 end subroutine hecmw_sainv_nn
352 subroutine hecmw_sainv_make_u_nn(hecMAT)
355 integer(kind=kint) i,j,k,n,m,o,idof,jdof
356 integer(kind=kint) is,ie,js,je
371 sainvu(ndof2*(n-1)+ndof*(jdof-1)+idof)=sainvl(ndof2*(j-1)+ndof*(idof-1)+jdof)
380 end subroutine hecmw_sainv_make_u_nn
385 subroutine form_ilu0_sainv_nn(hecMAT)
389 allocate (inumfi1l(0:hecmat%NP), inumfi1u(0:hecmat%NP))
390 allocate (fi1l(hecmat%NPL), fi1u(hecmat%NPU))
397 inumfi1l = hecmat%indexL
398 inumfi1u = hecmat%indexU
405 end subroutine form_ilu0_sainv_nn
410 subroutine form_ilu1_sainv_nn(hecMAT)
414 integer(kind=kint),
allocatable :: iwsl(:), iwsu(:), iw1(:), iw2(:)
415 integer(kind=kint) :: nplf1,npuf1
416 integer(kind=kint) :: i,jj,kk,l,isk,iek,isj,iej
417 integer(kind=kint) :: icou,icou0,icouu,icouu1,icouu2,icouu3,icoul,icoul1,icoul2,icoul3
418 integer(kind=kint) :: j,k,isl,isu
427 allocate (iw1(hecmat%NP) , iw2(hecmat%NP))
428 allocate (inumfi1l(0:hecmat%NP), inumfi1u(0:hecmat%NP))
439 do l= indexl(i-1)+1, indexl(i)
442 do l= indexu(i-1)+1, indexu(i)
450 isj= indexu(kk-1) + 1
454 if (iw1(jj).eq.0 .and. jj.lt.i)
then
455 inumfi1l(i)= inumfi1l(i)+1
458 if (iw1(jj).eq.0 .and. jj.gt.i)
then
459 inumfi1u(i)= inumfi1u(i)+1
464 nplf1= nplf1 + inumfi1l(i)
465 npuf1= npuf1 + inumfi1u(i)
470 allocate (iwsl(0:hecmat%NP), iwsu(0:hecmat%NP))
471 allocate (fi1l(hecmat%NPL+nplf1), fi1u(hecmat%NPU+npuf1))
473 npfiu = hecmat%NPU+npuf1
474 npfil = hecmat%NPL+nplf1
482 iwsl(i)= indexl(i)-indexl(i-1) + inumfi1l(i) + iwsl(i-1)
483 iwsu(i)= indexu(i)-indexu(i-1) + inumfi1u(i) + iwsu(i-1)
489 inumfi1l(i)= inumfi1l(i-1) + inumfi1l(i)
490 inumfi1u(i)= inumfi1u(i-1) + inumfi1u(i)
494 do l= indexl(i-1)+1, indexl(i)
497 do l= indexu(i-1)+1, indexu(i)
505 isj= indexu(kk-1) + 1
509 if (iw1(jj).eq.0 .and. jj.lt.i)
then
511 fi1l(icoul+iwsl(i-1)+indexl(i)-indexl(i-1))= jj
514 if (iw1(jj).eq.0 .and. jj.gt.i)
then
516 fi1u(icouu+iwsu(i-1)+indexu(i)-indexu(i-1))= jj
526 icoul1= indexl(i) - indexl(i-1)
527 icoul2= inumfi1l(i) - inumfi1l(i-1)
528 icoul3= icoul1 + icoul2
529 icouu1= indexu(i) - indexu(i-1)
530 icouu2= inumfi1u(i) - inumfi1u(i-1)
531 icouu3= icouu1 + icouu2
535 do k= indexl(i-1)+1, indexl(i)
540 do k= inumfi1l(i-1)+1, inumfi1l(i)
542 iw1(icou0)= fi1l(icou0+iwsl(i-1))
548 call sainv_sort_nn (iw1, iw2, icoul3, hecmat%NP)
556 do k= indexu(i-1)+1, indexu(i)
561 do k= inumfi1u(i-1)+1, inumfi1u(i)
563 iw1(icou0)= fi1u(icou0+iwsu(i-1))
569 call sainv_sort_nn (iw1, iw2, icouu3, hecmat%NP)
585 deallocate (iw1, iw2)
586 deallocate (iwsl, iwsu)
588 end subroutine form_ilu1_sainv_nn
595 subroutine sainv_sort_nn(STEM, INUM, N, NP)
598 integer(kind=kint) :: n, np
599 integer(kind=kint),
dimension(NP) :: stem
600 integer(kind=kint),
dimension(NP) :: inum
601 integer(kind=kint),
dimension(:),
allocatable :: istack
602 integer(kind=kint) :: m,nstack,jstack,l,ir,ip,i,j,k,ss,ii,temp,it
604 allocate (istack(-np:+np))
623 if (stem(i).le.ss)
goto 2
634 if (jstack.eq.0)
then
653 if (stem(l+1).gt.stem(ir))
then
662 if (stem(l).gt.stem(ir))
then
671 if (stem(l+1).gt.stem(l))
then
688 if (stem(i).lt.ss)
goto 3
692 if (stem(j).gt.ss)
goto 4
715 if (jstack.gt.nstack)
then
716 write (*,*)
'NSTACK overflow'
720 if (ir-i+1.ge.j-1)
then
734 end subroutine sainv_sort_nn
739 if (
associated(sainvd))
deallocate(sainvd)
740 if (
associated(sainvl))
deallocate(sainvl)
741 if (
associated(sainvu))
deallocate(sainvu)
742 if (
associated(inumfi1l))
deallocate(inumfi1l)
743 if (
associated(inumfi1u))
deallocate(inumfi1u)
744 if (
associated(fi1l))
deallocate(fi1l)
745 if (
associated(fi1u))
deallocate(fi1u)
integer(kind=kint) function, public hecmw_mat_get_precond(hecMAT)
subroutine, public hecmw_precond_sainv_nn_clear()
subroutine, public hecmw_precond_sainv_nn_apply(R, ZP)
subroutine, public hecmw_precond_sainv_nn_setup(hecMAT)
integer(kind=4), parameter kreal