1 subroutine Au1GMR (EGmass, uBrg, ilwork,iBC,iper ) 2c 3c---------------------------------------------------------------------- 4c 5c This routine performs a matrix-vector product for the EBE - 6c preconditioned GMRES solver. 7c 8c input: 9c EGmass (numel, nedof, nedof) : element mass matrices 10c ilwork (nlwork) : local MPI communication array 11c 12c output: 13c uBrg (nshg,nflow) : next Krylov vector 14c 15c---------------------------------------------------------------------- 16c 17 use pointer_data 18 19 include "common.h" 20 include "mpif.h" 21c 22 dimension EGmass(numel,nedof,nedof), uBrg(nshg,nflow), 23 & uBtmp(nshg,nflow), ilwork(nlwork), 24 & iBC(nshg), 25 & iper(nshg) 26c 27c.... communicate:: copy the master's portion of uBrg to each slave 28c 29 if (numpe > 1) then 30 call commu (uBrg, ilwork, nflow , 'out') 31 endif 32c 33c.... local periodic boundary conditions (no communications) 34c 35 do j=1,nflow 36 uBrg(:,j)=uBrg(iper(:),j) 37 enddo 38c 39c slave has masters value, for abc we need to rotate it 40c (if this is a vector only no SCALARS) 41 if((iabc==1)) !are there any axisym bc's 42 & call rotabc(uBrg(1,2), iBC, 'out') 43 44c 45c.... initialize 46c 47 uBtmp = zero 48c 49c.... loop over element blocks 50c 51 do iblk = 1, nelblk 52 iel = lcblk(1,iblk) 53 nenl = lcblk(5,iblk) 54 npro = lcblk(1,iblk+1) - iel 55 inum = iel + npro - 1 56 nshl = lcblk(10,iblk) 57c 58c.... compute and assemble the Au product 59c 60 call asAuGMR (mien(iblk)%p, EGmass(iel:inum,:,:), uBrg, 61 & uBtmp ) 62c 63 enddo 64 65 uBrg = uBtmp 66c 67c.... --------------------> communications <------------------------- 68c 69c 70 if((iabc==1)) !are there any axisym bc's 71 & call rotabc(uBrg(1,2), iBC, 'in ') 72c 73 if (numpe > 1) then 74c 75c.... send slave's copy of uBrg to the master 76c 77 call commu (uBrg , ilwork, nflow , 'in ') 78c 79c.... nodes treated on another processor are eliminated 80c 81 numtask = ilwork(1) 82 itkbeg = 1 83 84 do itask = 1, numtask 85 86 iacc = ilwork (itkbeg + 2) 87 numseg = ilwork (itkbeg + 4) 88 89 if (iacc .eq. 0) then 90 do is = 1,numseg 91 isgbeg = ilwork (itkbeg + 3 + 2*is) 92 lenseg = ilwork (itkbeg + 4 + 2*is) 93 isgend = isgbeg + lenseg - 1 94 uBrg(isgbeg:isgend,:) = zero 95 enddo 96 endif 97 98 itkbeg = itkbeg + 4 + 2*numseg 99 100 enddo 101 endif 102c 103c.... end 104c 105 return 106 end 107c 108c 109c 110 subroutine Au1GMRSclr (EGmasst, uBrg, ilwork, iper ) 111c 112c---------------------------------------------------------------------- 113c 114c This routine performs a matrix-vector product for the EBE - 115c preconditioned GMRES solver. 116c 117c input: 118c EGmasst (numel, nshape, nshape) : element mass matrices 119c ilwork (nlwork) : local MPI communication array 120c 121c output: 122c uBrg (nshg) : next Krylov vector 123c 124c---------------------------------------------------------------------- 125c 126 use pointer_data 127 128 include "common.h" 129 include "mpif.h" 130c 131 dimension EGmasst(numel,nshape,nshape),uBrg(nshg), 132 & uBtmp(nshg), ilwork(nlwork), iper(nshg) 133c 134c.... communicate:: copy the master's portion of uBrg to each slave 135c 136 if (numpe > 1) then 137 call commu (uBrg, ilwork, 1, 'out') 138 endif 139c ... changed 140c.... local periodic boundary conditions (no communications) 141c 142 uBrg(:)=uBrg(iper(:)) 143c 144c 145c.... initialize 146c 147 uBtmp = zero 148c 149c.... loop over element blocks 150c 151 do iblk = 1, nelblk 152 iel = lcblk(1,iblk) 153 nenl = lcblk(5,iblk) 154 npro = lcblk(1,iblk+1) - iel 155 inum = iel + npro - 1 156 nshl = lcblk(10,iblk) 157c 158c.... compute and assemble the Au product 159c 160 call asAuGMRSclr (mien(iblk)%p, EGmassT(iel:inum,:,:), uBrg, 161 & uBtmp ) 162c 163 enddo 164 165 uBrg = uBtmp 166c 167c.... --------------------> communications <------------------------- 168c 169 if (numpe > 1) then 170c 171c.... send slave's copy of uBrg to the master 172c 173 call commu (uBrg , ilwork, 1, 'in ') 174c 175c.... nodes treated on another processor are eliminated 176c 177 numtask = ilwork(1) 178 itkbeg = 1 179 180 do itask = 1, numtask 181 182 iacc = ilwork (itkbeg + 2) 183 numseg = ilwork (itkbeg + 4) 184 185 if (iacc .eq. 0) then 186 do is = 1,numseg 187 isgbeg = ilwork (itkbeg + 3 + 2*is) 188 lenseg = ilwork (itkbeg + 4 + 2*is) 189 isgend = isgbeg + lenseg - 1 190 uBrg(isgbeg:isgend) = zero 191 enddo 192 endif 193 194 itkbeg = itkbeg + 4 + 2*numseg 195 196 enddo 197 endif 198c 199c.... end 200c 201 return 202 end 203 204 205