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