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