1 subroutine i3Pcond ( Binv, uBrg, ilwork, code ) 2c 3c--------------------------------------------------------------------- 4c This routine is the preconditioner driver which calls 5c local routines to perform the right or left EBE preconditioning 6c of a vector. 7c 8c input: 9c Binv (numel,nedof,nedof) : element preconditioners 10c uBrg (nshg, nflow) : vector to be preconditioned 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 17c 18c--------------------------------------------------------------------- 19c 20 use pointer_data 21 22 include "common.h" 23c 24 dimension Binv(numel,nedof,nedof), uBrg(nshg,nflow) 25c 26 dimension uBtmp(nshg,nflow), ilwork(nlwork) 27c 28 character*8 code 29c 30c.... initialize 31c 32 uBtmp = zero 33c 34c.... loop over element blocks 35c 36 do iblk = 1, nelblk 37 iel = lcblk(1,iblk) 38 nenl = lcblk(5,iblk) 39 npro = lcblk(1,iblk+1) - iel 40 inum = iel + npro - 1 41c 42c.... right precondition the vector 43c 44 if (code .eq. 'R_Pcond ') then 45c 46 if (iPcond .eq. 1) then 47 call itrPr1 (mien(iblk)%p, Binv(iel:inum,:,:), uBrg, 48 & uBtmp, 'R_Pcond ') 49 endif 50c 51c if (iPcond .eq. 2) then 52c call itrPr2 (mien(iblk)%p, Binv(iel:inum,:,:), uBrg, 53c & 'R_Pcond ') 54c endif 55 endif 56c 57c.... left precondition the vector 58c 59 if (code .eq. 'L_Pcond ') then 60c 61 if (iPcond .eq. 1) then 62 call itrPr1 (mien(iblk)%p, Binv(iel:inum,:,:), uBrg, 63 & uBtmp, 'L_Pcond ') 64 endif 65c 66c if (iPcond .eq. 2) then 67c call itrPr2 (mien(iblk)%p, Binv(iel:inum,:,:), uBrg, 68c & 'L_Pcond ') 69c endif 70 endif 71c 72 enddo 73c 74c.... update the vector 75c 76c if (iPcond .ne. 0) uBrg = uBtmp 77c 78c.... return 79c 80 return 81 end 82