xref: /phasta/phSolver/compressible/itrpr1.f (revision 595995161822a203c8467e0e4a253d7bd7d6df32)
1*59599516SKenneth E. Jansen        subroutine itrPr1 (ien,  Binv,   uBrg,    uBtmp,  code)
2*59599516SKenneth E. Jansenc
3*59599516SKenneth E. Jansenc----------------------------------------------------------------------
4*59599516SKenneth E. Jansenc
5*59599516SKenneth E. Jansenc This routine preconditions a given vector, element-by-element.
6*59599516SKenneth E. Jansenc The preconditioner used is Gauss-Siedel.
7*59599516SKenneth E. Jansenc
8*59599516SKenneth E. Jansenc input:
9*59599516SKenneth E. Jansenc  ien    (npro,nshape)         : element nodal connectivity
10*59599516SKenneth E. Jansenc  Binv   (npro,nedof,nedof)	: LHS element preconditioner matrices
11*59599516SKenneth E. Jansenc  code				: preconditioning code
12*59599516SKenneth E. Jansenc				    .eq. 'R_Pcond ', Right precond.
13*59599516SKenneth E. Jansenc				    .eq. 'L_Pcond ', Left  precond.
14*59599516SKenneth E. Jansenc
15*59599516SKenneth E. Jansenc output:
16*59599516SKenneth E. Jansenc  uBrg    (nshg,nflow)	        : preconditioned vector (uBrg)
17*59599516SKenneth E. Jansenc
18*59599516SKenneth E. Jansenc Farzin Shakib, Winter 1987.
19*59599516SKenneth E. Jansenc----------------------------------------------------------------------
20*59599516SKenneth E. Jansenc
21*59599516SKenneth E. Jansen        include "common.h"
22*59599516SKenneth E. Jansenc
23*59599516SKenneth E. Jansen	dimension Binv(npro,nedof,nedof),  uBrg(nshg,nflow),
24*59599516SKenneth E. Jansen     &		  uBrgl(npro,nshape*nflow), ien(npro,nshape),
25*59599516SKenneth E. Jansen     &            uBtmp(nshg,nflow)
26*59599516SKenneth E. Jansenc
27*59599516SKenneth E. Jansen	character*8 code
28*59599516SKenneth E. Jansenc
29*59599516SKenneth E. Jansenc.... -------------------->  Right Pre-condition  <--------------------
30*59599516SKenneth E. Jansenc
31*59599516SKenneth E. Jansen	if (code .eq. 'R_Pcond ') then
32*59599516SKenneth E. Jansenc
33*59599516SKenneth E. Jansenc.... perform the upper triangular solve
34*59599516SKenneth E. Jansenc
35*59599516SKenneth E. Jansen	   call localt (uBrg,   uBrgl,   abs(ien),  nflow,   'gather  ' )
36*59599516SKenneth E. Jansenc
37*59599516SKenneth E. Jansen           do i = nedof-1, 1, -1
38*59599516SKenneth E. Jansen              do j = i+1, nedof
39*59599516SKenneth E. Jansen                 uBrgl(:,i) = uBrgl(:,i) - Binv(:,i,j) * uBrgl(:,j)
40*59599516SKenneth E. Jansen              enddo
41*59599516SKenneth E. Jansen           enddo
42*59599516SKenneth E. Jansenc
43*59599516SKenneth E. Jansen	   call localt (uBrg,   uBrgl,   abs(ien),  nflow,   'globaliz')
44*59599516SKenneth E. Jansenc
45*59599516SKenneth E. Jansen	return
46*59599516SKenneth E. Jansenc
47*59599516SKenneth E. Jansen	endif
48*59599516SKenneth E. Jansenc
49*59599516SKenneth E. Jansenc.... -------------------->  Left Pre-condition  <---------------------
50*59599516SKenneth E. Jansenc
51*59599516SKenneth E. Jansen	if (code .eq. 'L_Pcond ') then
52*59599516SKenneth E. Jansenc
53*59599516SKenneth E. Jansenc.... perform the lower triangular solve (in reverse order)
54*59599516SKenneth E. Jansenc
55*59599516SKenneth E. Jansen           call localt (uBrg,   uBrgl,   abs(ien),  nflow, 'gather  ')
56*59599516SKenneth E. Jansenc
57*59599516SKenneth E. Jansen           do  i = 2, nedof
58*59599516SKenneth E. Jansen              do  j = 1, i-1
59*59599516SKenneth E. Jansen                 uBrgl(:,i) = uBrgl(:,i) - Binv(:,i,j) * uBrgl(:,j)
60*59599516SKenneth E. Jansen              enddo
61*59599516SKenneth E. Jansen           enddo
62*59599516SKenneth E. Jansen
63*59599516SKenneth E. Jansen           call localt (uBrg,   uBrgl,   abs(ien),  nflow, 'globaliz')
64*59599516SKenneth E. Jansenc
65*59599516SKenneth E. Jansen	return
66*59599516SKenneth E. Jansenc
67*59599516SKenneth E. Jansen      endif
68*59599516SKenneth E. Jansenc
69*59599516SKenneth E. Jansenc.... error handling
70*59599516SKenneth E. Jansenc
71*59599516SKenneth E. Jansen      call error ('itrPr1  ', code, iGMRES)
72*59599516SKenneth E. Jansenc
73*59599516SKenneth E. Jansenc.... end
74*59599516SKenneth E. Jansenc
75*59599516SKenneth E. Jansen      end
76