1 subroutine bc3per (iBC, res, iper, ilwork,nQs) 2c 3c---------------------------------------------------------------------- 4c 5c This routine satisfies the BC of the periodic nodes after Ap product 6c 7c input: 8c iBC (nshg) : Boundary Condition Code 9c iper (nshg) : partners of periodic nodes 10c res (nshg,nQs) : residual before BC is applied 11c 12c output: 13c res (nshg,nQs) : residual after satisfaction of BC 14c 15c 16c Kenneth Jansen, Winter 1998. 17c---------------------------------------------------------------------- 18c 19 use periodicity ! this gives you rcount(1:nshg) (real*8) 20 include "common.h" 21c 22 dimension iBC(nshg), 23 & res(nshg,nQs), ilwork(nlwork), 24 & iper(nshg) 25c 26c.... local periodic (and axisymmetric) boundary conditions (no communications) 27c 28 do j = 1,nshg 29 if ((btest(iBC(j),10)) .or. (btest(iBC(j),12))) then 30 i = iper(j) 31 res(i,:) = res(i,:) + res(j,:) 32 res(j,:) = zero 33 endif 34 enddo 35 36 37 if(numpe.gt.1) then 38c 39c.... nodes treated on another processor are eliminated 40c 41 numtask = ilwork(1) 42 itkbeg = 1 43 44 do itask = 1, numtask 45 46 iacc = ilwork (itkbeg + 2) 47 numseg = ilwork (itkbeg + 4) 48 49 if (iacc .eq. 0) then 50 do is = 1,numseg 51 isgbeg = ilwork (itkbeg + 3 + 2*is) 52 lenseg = ilwork (itkbeg + 4 + 2*is) 53 isgend = isgbeg + lenseg - 1 54 res(isgbeg:isgend,:) = zero 55 enddo 56 endif 57 58 itkbeg = itkbeg + 4 + 2*numseg 59 60 enddo 61 endif 62c 63c.... return 64c 65 return 66 end 67 68 69 70 71 72