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,nflow) : residual before BC is applied 11c 12c output: 13c res (nshg) : residual after satisfaction of BC 14c 15c 16c Kenneth Jansen, Winter 1998. 17c---------------------------------------------------------------------- 18c 19 include "common.h" 20c 21 dimension iBC(nshg), 22 & res(nshg,nQs), ilwork(nlwork), 23 & iper(nshg) 24c 25c 26c.... local periodic boundary conditions (no communications) 27c 28 do j = 1,nshg 29 if (btest(iBC(j),10)) then 30 i = iper(j) 31 res(i,:) = res(i,:) + res(j,:) 32 res(j,:) = zero 33 endif 34 enddo 35c 36c.... periodic slaves get the residual values of the masters 37c 38c do i = 1,nshg 39c if (btest(iBC(i),10)) then 40c res(i,:) = res(iper(i),:) 41c endif 42c enddo 43c 44c 45c.... return 46c 47 return 48 end 49c 50c 51c 52 subroutine bc3perSclr (iBC, res, iper) 53c 54c---------------------------------------------------------------------- 55c 56c This routine satisfies the BC of the periodic nodes after Ap product 57c 58c input: 59c iBC (nshg) : Boundary Condition Code 60c iper (nshg) : partners of periodic nodes 61c res (nshg) : residual before BC is applied 62c 63c output: 64c res (nshg) : residual after satisfaction of BC 65c 66c 67c Kenneth Jansen, Winter 1998. 68c---------------------------------------------------------------------- 69c 70 include "common.h" 71c 72 dimension iBC(nshg), 73 & res(nshg), 74 & iper(nshg) 75c 76c 77c.... local periodic boundary conditions (no communications) 78c 79 do j = 1,nshg 80 if (btest(iBC(j),10)) then 81 i = iper(j) 82 res(i) = res(i) + res(j) 83 res(j) = zero !changed 84 endif 85 enddo 86c 87c.... periodic slaves get the residual values of the masters 88c 89c$$$ do i = 1,nshg 90c$$$ if (btest(iBC(i),10)) then 91c$$$ res(i) = res(iper(i)) 92c$$$ endif 93c$$$ enddo 94c 95c 96c.... return 97c 98 return 99 end 100 101