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