xref: /phasta/phSolver/incompressible/asbflx.f (revision 595995161822a203c8467e0e4a253d7bd7d6df32)
1      subroutine AsBFlx (u,           y,           ac,
2     &                   x,           shpb,
3     &                   shglb,       ienb,        iBCB,
4     &                   BCB,         invflx,      flxres,
5     &                   flxLHS,      flxnrm,      xKebe )
6c
7c----------------------------------------------------------------------
8c
9c This routine computes and assembles the data corresponding to the
10c  boundary elements.
11c
12c Zdenek Johan, Winter 1991.  (Fortran 90)
13c----------------------------------------------------------------------
14c
15      use turbSA ! access to d2wall
16        include "common.h"
17c
18        dimension y(nshg,ndofl),           x(numnp,nsd),
19     &            ac(nshg,ndofl),          u(nshg,nsd),
20     &            shpb(nshl,ngaussb),
21     &            shglb(nsd,nshl,ngaussb),
22     &            ienb(npro,nshl),
23     &            iBCB(npro,ndiBCB),       BCB(npro,nshlb,ndBCB),
24     &            invflx(nshg),            flxres(nshg,nflow),
25     &            flxLHS(nshg,1),          flxnrm(nshg,nsd)
26c
27        dimension yl(npro,nshl,ndofl),     xlb(npro,nenl,nsd),
28     &            rl(npro,nshl,nflow),     sgn(npro,nshl),
29     &            flhsl(npro,nshl,1),      fnrml(npro,nshl,nsd),
30     &            lnflx(npro),             lnode(27),
31     &            ul(npro,nshl,nsd),       acl(npro,nshl,ndofl)
32        real*8 dwl(npro,nshl)
33
34        dimension xKebe(npro,9,nshl,nshl)
35
36c
37c.... compute the nodes which lie on the boundary (hierarchic)
38c
39        call getbnodes(lnode)
40c
41c.... get the matrix of mode signs for the hierarchic basis functions
42c
43        if (ipord .gt. 1) then
44           call getsgn(ienb,sgn)
45        endif
46c
47c.... gather the variables
48c
49        call localy(y,      yl,     ienb,   ndofl,  'gather  ')
50        call localy(ac,     acl,    ienb,   ndofl,  'gather  ')
51        call localx(x,      xlb,    ienb,   nsd,    'gather  ')
52        call localx(u,      ul,     ienb,   nsd,    'gather  ')
53        if(iRANS.eq.-2) then
54           call local(d2wall, dwl, ienb, 1, 'gather  ')
55        endif
56
57        rl    = zero
58        flhsl = zero
59        fnrml = zero
60c
61        ires = 2
62        call e3b  (ul,      yl,      acl,     iBCB,    BCB,
63     &             shpb,    shglb,
64     &             xlb,     rl,      sgn,     dwl,     xKebe)
65        ires = 1
66c
67c.... assemble the residuals
68c
69        call local (flxres, rl,     ienb,   nflow,  'scatter ')
70c
71c.... compute the LHS for the flux computation (should only be done
72c     once)
73c
74        call f3lhs (shpb,       shglb,      xlb,
75     &              flhsl,      fnrml,      sgn )
76
77c
78c.... reset the non-contributing element values
79c
80        lnflx = 0
81        do n = 1, nshlb
82          lnflx = lnflx + min(1, invflx(ienb(:,lnode(n))))
83        enddo
84c
85        do n = 1, nshl
86          where (lnflx .ne. nshlb)   flhsl(:,n,1) = zero
87          do i = 1, nsd
88            where (lnflx .ne. nshlb) fnrml(:,n,i) = zero
89          enddo
90        enddo
91c
92c.... assemble the boundary LHS and normal
93c
94        call local (flxLHS, flhsl,  ienb,   1,      'scatter ')
95        call local (flxnrm, fnrml,  ienb,   nsd,    'scatter ')
96c
97c.... end
98c
99        return
100        end
101