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