FrontISTR  5.9.0
Large-scale structural analysis program with finit element method
hecmw_precond_SAINV_nn.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
2 ! Copyright (c) 2019 FrontISTR Commons
3 ! This software is released under the MIT License, see LICENSE.txt
4 !-------------------------------------------------------------------------------
5 
7  use hecmw_util
10 
11  private
12 
16 
17  integer(4),parameter :: krealp = 8
18 
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()
26 
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()
34 
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()
39 
40 contains
41 
42  !C***
43  !C*** hecmw_precond_nn_sainv_setup
44  !C***
45  subroutine hecmw_precond_sainv_nn_setup(hecMAT)
46  implicit none
47  type(hecmwst_matrix) :: hecmat
48 
49  integer(kind=kint ) :: precond
50  real(kind=krealp) :: filter
51 
52  n = hecmat%N
53  ndof = hecmat%NDOF
54  ndof2 = ndof*ndof
55  precond = hecmw_mat_get_precond(hecmat)
56 
57  d => hecmat%D
58  au=> hecmat%AU
59  al=> hecmat%AL
60  indexl => hecmat%indexL
61  indexu => hecmat%indexU
62  iteml => hecmat%itemL
63  itemu => hecmat%itemU
64 
65  if (precond.eq.20) call form_ilu1_sainv_nn(hecmat)
66 
67  allocate (sainvd(ndof2*hecmat%NP))
68  allocate (sainvl(ndof2*npfiu))
69  allocate (t(ndof*hecmat%NP))
70  sainvd = 0.0d0
71  sainvl = 0.0d0
72  t = 0.0d0
73 
74  filter= hecmat%Rarray(5)
75 
76  write(*,"(a,F15.8)")"### SAINV FILTER :",filter
77 
78  call hecmw_sainv_nn(hecmat)
79 
80  allocate (sainvu(ndof2*npfiu))
81  sainvu = 0.0d0
82 
83  call hecmw_sainv_make_u_nn(hecmat)
84 
85  end subroutine hecmw_precond_sainv_nn_setup
86 
87  subroutine hecmw_precond_sainv_nn_apply(R, ZP)
88  implicit none
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)
93 
94 #ifndef _OPENACC
95  !$OMP PARALLEL DEFAULT(NONE) &
96  !$OMP&PRIVATE(i,X,SW,j,in,isL,ieL,isU,ieU,idof,jdof) &
97  !$OMP&SHARED(N,SAINVD,SAINVL,SAINVU,inumFI1U,FI1U,inumFI1L,FI1L,R,T,ZP,NDOF,NDOF2)
98 #endif
99 
100 #ifdef _OPENACC
101  !$acc kernels
102  !$acc loop independent
103 #else
104  !$OMP DO
105 #endif
106  !C-- FORWARD
107  do i= 1, n
108  do idof = 1, ndof
109  sw(idof) = 0.0d0
110  end do
111  isl= inumfi1l(i-1)+1
112  iel= inumfi1l(i)
113  do j= isl, iel
114  in= fi1l(j)
115  do idof = 1, ndof
116  x(idof) = r(ndof*(in-1)+idof)
117  end do
118  do idof = 1, ndof
119  do jdof = 1, ndof
120  sw(idof) = sw(idof) + sainvl(ndof2*(j-1)+ndof*(idof-1)+jdof)*x(jdof)
121  end do
122  end do
123  enddo
124  do idof = 1, ndof
125  x(idof) = r(ndof*(i-1)+idof)
126  t(ndof*(i-1)+idof)=x(idof)+sw(idof)
127  end do
128  do idof = 1, ndof
129  do jdof = 1, idof-1
130  t(ndof*(i-1)+idof)=t(ndof*(i-1)+idof)+sainvd(ndof2*(i-1)+ndof*(jdof-1)+idof)*x(jdof)
131  end do
132  t(ndof*(i-1)+idof)=t(ndof*(i-1)+idof)*sainvd(ndof2*(i-1)+ndof*(idof-1)+idof)
133  end do
134  enddo
135 #ifdef _OPENACC
136  !$acc end kernels
137 #else
138  !$OMP END DO
139 #endif
140 
141 #ifdef _OPENACC
142  !$acc kernels
143  !$acc loop independent
144 #else
145  !$OMP DO
146 #endif
147  !C-- BACKWARD
148  do i= 1, n
149  do idof = 1, ndof
150  sw(idof) = 0.0d0
151  end do
152 
153  isu= inumfi1u(i-1) + 1
154  ieu= inumfi1u(i)
155  do j= isu, ieu
156  in= fi1u(j)
157  do idof = 1, ndof
158  x(idof) = t(ndof*(in-1)+idof)
159  end do
160  do idof = 1, ndof
161  do jdof = 1, ndof
162  sw(idof) = sw(idof) + sainvu(ndof2*(j-1)+ndof*(idof-1)+jdof)*x(jdof)
163  end do
164  end do
165  enddo
166 
167  do idof = 1, ndof
168  x(idof) = t(ndof*(i-1)+idof)
169  end do
170  do idof = 1, ndof
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)
174  end do
175  end do
176  enddo
177 #ifdef _OPENACC
178  !$acc end kernels
179 #else
180  !$OMP END DO
181 #endif
182 
183 #ifndef _OPENACC
184  !$OMP END PARALLEL
185 #endif
186 
187  end subroutine hecmw_precond_sainv_nn_apply
188 
189 
190  !C***
191  !C*** hecmw_rif_nn
192  !C***
193  subroutine hecmw_sainv_nn(hecMAT)
194  implicit none
195  type (hecmwst_matrix) :: hecmat
196 
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)
199 
200  real(kind=krealp) :: filter
201  real(kind=krealp), allocatable :: zz(:), vv(:)
202 
203  filter= hecmat%Rarray(5)
204 
205  allocate (vv(ndof*hecmat%NP))
206  allocate (zz(ndof*hecmat%NP))
207  do itr=1,n
208  do iitr=1,ndof
209  zz(:) = 0.0d0
210  vv(:) = 0.0d0
211  !{v}=[A]{zi}
212  do idof = 1,ndof
213  zz(ndof*(itr-1)+idof)= sainvd(ndof2*(itr-1)+ndof*(idof-1)+iitr)
214  end do
215  zz(ndof*(itr-1)+iitr)= 1.0d0
216 
217  js= inumfi1l(itr-1) + 1
218  je= inumfi1l(itr )
219  do j= js, je
220  in = fi1l(j)
221  do idof = 1, ndof
222  zz(ndof*(in-1)+idof)=sainvl(ndof2*(j-1)+ndof*(iitr-1)+idof)
223  end do
224  enddo
225 
226  do i= 1, itr
227  do idof = 1,ndof
228  x(idof)=zz(ndof*(i-1)+idof)
229  end do
230  do idof = 1, ndof
231  do jdof = 1, ndof
232  vv(ndof*(i-1)+idof) = vv(ndof*(i-1)+idof) + d(ndof2*(i-1)+ndof*(idof-1)+jdof)*x(jdof)
233  end do
234  end do
235 
236  js= indexl(i-1) + 1
237  je= indexl(i )
238  do j=js,je
239  in = iteml(j)
240  do idof = 1, ndof
241  do jdof = 1, ndof
242  vv(ndof*(in-1)+idof) = vv(ndof*(in-1)+idof) + al(ndof2*(j-1)+ndof*(jdof-1)+idof)*x(jdof)
243  end do
244  end do
245  enddo
246  js= indexu(i-1) + 1
247  je= indexu(i )
248  do j= js, je
249  in = itemu(j)
250  do idof = 1, ndof
251  do jdof = 1, ndof
252  vv(ndof*(in-1)+idof) = vv(ndof*(in-1)+idof) + au(ndof2*(j-1)+ndof*(jdof-1)+idof)*x(jdof)
253  end do
254  end do
255  enddo
256  enddo
257 
258  !{d}={v^t}{z_j}
259  do idof = 1, ndof
260  dtmp(idof)= sainvd(ndof2*(itr-1)+ndof*(idof-1)+idof)
261  end do
262 
263  do i= itr,n
264  do idof = 1,ndof
265  sainvd(ndof2*(i-1)+ndof*(idof-1)+idof) = vv(ndof*(i-1)+idof)
266  do jdof = 1, idof-1
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)
269  end do
270  end do
271  js= inumfi1l(i-1) + 1
272  je= inumfi1l(i )
273  do j= js, je
274  in = fi1l(j)
275  do idof = 1,ndof
276  x(idof)=vv(ndof*(in-1)+idof)
277  end do
278  do idof = 1, ndof
279  do jdof = 1, ndof
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)
282  end do
283  end do
284  enddo
285  enddo
286 
287  !Update D
288  dd = 1.0d0/sainvd(ndof2*(itr-1)+ndof*(iitr-1)+iitr)
289  do idof=1,iitr-1
290  sainvd(ndof2*(itr-1)+ndof*(idof-1)+idof) = dtmp(idof)
291  end do
292  ! SAINVD(NDOF2*(itr-1)+NDOF*(iitr-1)+iitr)=dd
293  do idof = iitr+1, ndof
294  sainvd(ndof2*(itr-1)+ndof*(idof-1)+idof) = sainvd(ndof2*(itr-1)+ndof*(idof-1)+idof)*dd
295  end do
296 
297  do i =itr+1,n
298  do idof = 1, ndof
299  sainvd(ndof2*(i-1)+ndof*(idof-1)+idof) = sainvd(ndof2*(i-1)+ndof*(idof-1)+idof)*dd
300  end do
301  enddo
302 
303  !Update Z
304  do k=iitr+1,ndof
305  dd = sainvd(ndof2*(itr-1)+ndof*(k-1)+k)
306  if(abs(dd) > filter)then
307  do jdof = 1, iitr
308  sainvd(ndof2*(itr-1)+ndof*(jdof-1)+k)= sainvd(ndof2*(itr-1)+ndof*(jdof-1)+k) - dd*zz(ndof*(itr-1)+jdof)
309  end do
310  js= inumfi1l(itr-1) + 1
311  je= inumfi1l(itr )
312  do j= js, je
313  in = fi1l(j)
314  do idof = 1, ndof
315  sainvl(ndof2*(j-1)+ndof*(k-1)+idof) = sainvl(ndof2*(j-1)+ndof*(k-1)+idof)-dd*zz(ndof*(in-1)+idof)
316  end do
317  enddo
318  endif
319  end do
320 
321  do i= itr +1,n
322  js= inumfi1l(i-1) + 1
323  je= inumfi1l(i )
324  do idof = 1, ndof
325  dd = sainvd(ndof2*(i-1)+ndof*(idof-1)+idof)
326  if(abs(dd) > filter)then
327  do j= js, je
328  in = fi1l(j)
329  if (in > itr) exit
330  do jdof=1,ndof
331  sainvl(ndof2*(j-1)+ndof*(idof-1)+jdof)=sainvl(ndof2*(j-1)+ndof*(idof-1)+jdof)-dd*zz(ndof*(in-1)+jdof)
332  end do
333  enddo
334  endif
335  end do
336  enddo
337  end do
338  enddo
339  deallocate(vv)
340  deallocate(zz)
341 
342  do i =1,n
343  do idof = 1, ndof
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)
347  end do
348  end do
349  enddo
350  end subroutine hecmw_sainv_nn
351 
352  subroutine hecmw_sainv_make_u_nn(hecMAT)
353  implicit none
354  type (hecmwst_matrix) :: hecmat
355  integer(kind=kint) i,j,k,n,m,o,idof,jdof
356  integer(kind=kint) is,ie,js,je
357 
358  n = 1
359  do i= 1, hecmat%NP
360  is=inumfi1u(i-1) + 1
361  ie=inumfi1u(i )
362  flag1:do k= is, ie
363  m = fi1u(k)
364  js=inumfi1l(m-1) + 1
365  je=inumfi1l(m )
366  do j= js,je
367  o = fi1l(j)
368  if (o == i)then
369  do idof = 1, ndof
370  do jdof = 1, ndof
371  sainvu(ndof2*(n-1)+ndof*(jdof-1)+idof)=sainvl(ndof2*(j-1)+ndof*(idof-1)+jdof)
372  end do
373  end do
374  n = n + 1
375  cycle flag1
376  endif
377  enddo
378  enddo flag1
379  enddo
380  end subroutine hecmw_sainv_make_u_nn
381 
382  !C***
383  !C*** FORM_ILU1_nn
384  !C*** form ILU(1) matrix
385  subroutine form_ilu0_sainv_nn(hecMAT)
386  implicit none
387  type(hecmwst_matrix) :: hecmat
388 
389  allocate (inumfi1l(0:hecmat%NP), inumfi1u(0:hecmat%NP))
390  allocate (fi1l(hecmat%NPL), fi1u(hecmat%NPU))
391 
392  inumfi1l = 0
393  inumfi1u = 0
394  fi1l = 0
395  fi1u = 0
396 
397  inumfi1l = hecmat%indexL
398  inumfi1u = hecmat%indexU
399  fi1l = hecmat%itemL
400  fi1u = hecmat%itemU
401 
402  npfiu = hecmat%NPU
403  npfil = hecmat%NPL
404 
405  end subroutine form_ilu0_sainv_nn
406 
407  !C***
408  !C*** FORM_ILU1_nn
409  !C*** form ILU(1) matrix
410  subroutine form_ilu1_sainv_nn(hecMAT)
411  implicit none
412  type(hecmwst_matrix) :: hecmat
413 
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
419  !C
420  !C +--------------+
421  !C | find fill-in |
422  !C +--------------+
423  !C===
424 
425  !C
426  !C-- count fill-in
427  allocate (iw1(hecmat%NP) , iw2(hecmat%NP))
428  allocate (inumfi1l(0:hecmat%NP), inumfi1u(0:hecmat%NP))
429 
430  inumfi1l= 0
431  inumfi1u= 0
432 
433  nplf1= 0
434  npuf1= 0
435  do i= 2, hecmat%NP
436  icou= 0
437  iw1= 0
438  iw1(i)= 1
439  do l= indexl(i-1)+1, indexl(i)
440  iw1(iteml(l))= 1
441  enddo
442  do l= indexu(i-1)+1, indexu(i)
443  iw1(itemu(l))= 1
444  enddo
445 
446  isk= indexl(i-1) + 1
447  iek= indexl(i)
448  do k= isk, iek
449  kk= iteml(k)
450  isj= indexu(kk-1) + 1
451  iej= indexu(kk )
452  do j= isj, iej
453  jj= itemu(j)
454  if (iw1(jj).eq.0 .and. jj.lt.i) then
455  inumfi1l(i)= inumfi1l(i)+1
456  iw1(jj)= 1
457  endif
458  if (iw1(jj).eq.0 .and. jj.gt.i) then
459  inumfi1u(i)= inumfi1u(i)+1
460  iw1(jj)= 1
461  endif
462  enddo
463  enddo
464  nplf1= nplf1 + inumfi1l(i)
465  npuf1= npuf1 + inumfi1u(i)
466  enddo
467 
468  !C
469  !C-- specify fill-in
470  allocate (iwsl(0:hecmat%NP), iwsu(0:hecmat%NP))
471  allocate (fi1l(hecmat%NPL+nplf1), fi1u(hecmat%NPU+npuf1))
472 
473  npfiu = hecmat%NPU+npuf1
474  npfil = hecmat%NPL+nplf1
475 
476  fi1l= 0
477  fi1u= 0
478 
479  iwsl= 0
480  iwsu= 0
481  do i= 1, hecmat%NP
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)
484  enddo
485 
486  do i= 2, hecmat%NP
487  icoul= 0
488  icouu= 0
489  inumfi1l(i)= inumfi1l(i-1) + inumfi1l(i)
490  inumfi1u(i)= inumfi1u(i-1) + inumfi1u(i)
491  icou= 0
492  iw1= 0
493  iw1(i)= 1
494  do l= indexl(i-1)+1, indexl(i)
495  iw1(iteml(l))= 1
496  enddo
497  do l= indexu(i-1)+1, indexu(i)
498  iw1(itemu(l))= 1
499  enddo
500 
501  isk= indexl(i-1) + 1
502  iek= indexl(i)
503  do k= isk, iek
504  kk= iteml(k)
505  isj= indexu(kk-1) + 1
506  iej= indexu(kk )
507  do j= isj, iej
508  jj= itemu(j)
509  if (iw1(jj).eq.0 .and. jj.lt.i) then
510  icoul = icoul + 1
511  fi1l(icoul+iwsl(i-1)+indexl(i)-indexl(i-1))= jj
512  iw1(jj) = 1
513  endif
514  if (iw1(jj).eq.0 .and. jj.gt.i) then
515  icouu = icouu + 1
516  fi1u(icouu+iwsu(i-1)+indexu(i)-indexu(i-1))= jj
517  iw1(jj) = 1
518  endif
519  enddo
520  enddo
521  enddo
522 
523  isl = 0
524  isu = 0
525  do i= 1, hecmat%NP
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
532  !C
533  !C-- LOWER part
534  icou0= 0
535  do k= indexl(i-1)+1, indexl(i)
536  icou0 = icou0 + 1
537  iw1(icou0)= iteml(k)
538  enddo
539 
540  do k= inumfi1l(i-1)+1, inumfi1l(i)
541  icou0 = icou0 + 1
542  iw1(icou0)= fi1l(icou0+iwsl(i-1))
543  enddo
544 
545  do k= 1, icoul3
546  iw2(k)= k
547  enddo
548  call sainv_sort_nn (iw1, iw2, icoul3, hecmat%NP)
549 
550  do k= 1, icoul3
551  fi1l(k+isl)= iw1(k)
552  enddo
553  !C
554  !C-- UPPER part
555  icou0= 0
556  do k= indexu(i-1)+1, indexu(i)
557  icou0 = icou0 + 1
558  iw1(icou0)= itemu(k)
559  enddo
560 
561  do k= inumfi1u(i-1)+1, inumfi1u(i)
562  icou0 = icou0 + 1
563  iw1(icou0)= fi1u(icou0+iwsu(i-1))
564  enddo
565 
566  do k= 1, icouu3
567  iw2(k)= k
568  enddo
569  call sainv_sort_nn (iw1, iw2, icouu3, hecmat%NP)
570 
571  do k= 1, icouu3
572  fi1u(k+isu)= iw1(k)
573  enddo
574 
575  isl= isl + icoul3
576  isu= isu + icouu3
577  enddo
578 
579  !C===
580  do i= 1, hecmat%NP
581  inumfi1l(i)= iwsl(i)
582  inumfi1u(i)= iwsu(i)
583  enddo
584 
585  deallocate (iw1, iw2)
586  deallocate (iwsl, iwsu)
587  !C===
588  end subroutine form_ilu1_sainv_nn
589 
590  !C
591  !C***
592  !C*** fill_in_S33_SORT
593  !C***
594  !C
595  subroutine sainv_sort_nn(STEM, INUM, N, NP)
596  use hecmw_util
597  implicit none
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
603 
604  allocate (istack(-np:+np))
605 
606  m = 100
607  nstack= np
608 
609  jstack= 0
610  l = 1
611  ir = n
612 
613  ip= 0
614  1 continue
615  ip= ip + 1
616 
617  if (ir-l.lt.m) then
618  do j= l+1, ir
619  ss= stem(j)
620  ii= inum(j)
621 
622  do i= j-1,1,-1
623  if (stem(i).le.ss) goto 2
624  stem(i+1)= stem(i)
625  inum(i+1)= inum(i)
626  end do
627  i= 0
628 
629  2 continue
630  stem(i+1)= ss
631  inum(i+1)= ii
632  end do
633 
634  if (jstack.eq.0) then
635  deallocate (istack)
636  return
637  endif
638 
639  ir = istack(jstack)
640  l = istack(jstack-1)
641  jstack= jstack - 2
642  else
643 
644  k= (l+ir) / 2
645  temp = stem(k)
646  stem(k) = stem(l+1)
647  stem(l+1)= temp
648 
649  it = inum(k)
650  inum(k) = inum(l+1)
651  inum(l+1)= it
652 
653  if (stem(l+1).gt.stem(ir)) then
654  temp = stem(l+1)
655  stem(l+1)= stem(ir)
656  stem(ir )= temp
657  it = inum(l+1)
658  inum(l+1)= inum(ir)
659  inum(ir )= it
660  endif
661 
662  if (stem(l).gt.stem(ir)) then
663  temp = stem(l)
664  stem(l )= stem(ir)
665  stem(ir)= temp
666  it = inum(l)
667  inum(l )= inum(ir)
668  inum(ir)= it
669  endif
670 
671  if (stem(l+1).gt.stem(l)) then
672  temp = stem(l+1)
673  stem(l+1)= stem(l)
674  stem(l )= temp
675  it = inum(l+1)
676  inum(l+1)= inum(l)
677  inum(l )= it
678  endif
679 
680  i= l + 1
681  j= ir
682 
683  ss= stem(l)
684  ii= inum(l)
685 
686  3 continue
687  i= i + 1
688  if (stem(i).lt.ss) goto 3
689 
690  4 continue
691  j= j - 1
692  if (stem(j).gt.ss) goto 4
693 
694  if (j.lt.i) goto 5
695 
696  temp = stem(i)
697  stem(i)= stem(j)
698  stem(j)= temp
699 
700  it = inum(i)
701  inum(i)= inum(j)
702  inum(j)= it
703 
704  goto 3
705 
706  5 continue
707 
708  stem(l)= stem(j)
709  stem(j)= ss
710  inum(l)= inum(j)
711  inum(j)= ii
712 
713  jstack= jstack + 2
714 
715  if (jstack.gt.nstack) then
716  write (*,*) 'NSTACK overflow'
717  stop
718  endif
719 
720  if (ir-i+1.ge.j-1) then
721  istack(jstack )= ir
722  istack(jstack-1)= i
723  ir= j-1
724  else
725  istack(jstack )= j-1
726  istack(jstack-1)= l
727  l= i
728  endif
729 
730  endif
731 
732  goto 1
733 
734  end subroutine sainv_sort_nn
735 
737  implicit none
738 
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)
746  nullify(inumfi1l)
747  nullify(inumfi1u)
748  nullify(fi1l)
749  nullify(fi1u)
750  nullify(d)
751  nullify(al)
752  nullify(au)
753  nullify(indexl)
754  nullify(indexu)
755  nullify(iteml)
756  nullify(itemu)
757 
758  end subroutine hecmw_precond_sainv_nn_clear
759 end module hecmw_precond_sainv_nn
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)
I/O and Utility.
Definition: hecmw_util_f.F90:7
integer(kind=4), parameter kreal