xref: /phasta/phSolver/common/shp4t.f (revision 595995161822a203c8467e0e4a253d7bd7d6df32)
1*59599516SKenneth E. Jansen        subroutine shp4T (QuadPt, nQpt,   shp,    shgl,   wght)
2*59599516SKenneth E. Jansenc
3*59599516SKenneth E. Jansenc----------------------------------------------------------------------
4*59599516SKenneth E. Jansenc
5*59599516SKenneth E. Jansenc  This subroutine generates shape functions for the 4-node
6*59599516SKenneth E. Jansenc   tetrahedra.
7*59599516SKenneth E. Jansenc
8*59599516SKenneth E. Jansenc input:
9*59599516SKenneth E. Jansenc  QuadPt (4,nQpt)              : quadrature points' local coord's
10*59599516SKenneth E. Jansenc                                   QuadPt(1,*) : r
11*59599516SKenneth E. Jansenc                                   QuadPt(2,*) : s
12*59599516SKenneth E. Jansenc                                   QuadPt(3,*) : t
13*59599516SKenneth E. Jansenc                                   QuadPt(4,*) : wght
14*59599516SKenneth E. Jansenc  nQpt                         : number of quadrature points
15*59599516SKenneth E. Jansenc
16*59599516SKenneth E. Jansenc output:
17*59599516SKenneth E. Jansenc  shp    (nen,nQpt)            : shape functions
18*59599516SKenneth E. Jansenc  shgl   (nsd,nen,nQpt)        : local-gradient of shape function
19*59599516SKenneth E. Jansenc  wght   (nQpt)                : quadrature weights
20*59599516SKenneth E. Jansenc
21*59599516SKenneth E. Jansenc
22*59599516SKenneth E. Jansenc shape-functions:
23*59599516SKenneth E. Jansenc  N1 = 1 - r - s - t
24*59599516SKenneth E. Jansenc  N2 = r
25*59599516SKenneth E. Jansenc  N3 = s
26*59599516SKenneth E. Jansenc  N4 = t
27*59599516SKenneth E. Jansenc
28*59599516SKenneth E. Jansenc Note: To be compatible with design of Tau and DC, the local
29*59599516SKenneth E. Jansenc       gradients are divided by 2.  This is equivalent to having
30*59599516SKenneth E. Jansenc       r=[-1,1], s=[-1,1] and t=[-1,1], without really changing
31*59599516SKenneth E. Jansenc       r, s and t points (i.e., Qpt is for r=[0,1], s=[0,1] and
32*59599516SKenneth E. Jansenc       t=[0,1] range)
33*59599516SKenneth E. Jansenc
34*59599516SKenneth E. Jansenc Zdenek Johan, Summer 1990.
35*59599516SKenneth E. Jansenc----------------------------------------------------------------------
36*59599516SKenneth E. Jansenc
37*59599516SKenneth E. Jansen        include "common.h"
38*59599516SKenneth E. Jansenc
39*59599516SKenneth E. Jansen        dimension QuadPt(4,*),                   shp(nen,*),
40*59599516SKenneth E. Jansen     &            shgl(nsd,nen,*),               wght(*)
41*59599516SKenneth E. Jansenc
42*59599516SKenneth E. Jansenc.... loop through quadrature points
43*59599516SKenneth E. Jansenc
44*59599516SKenneth E. Jansen        do m = 1, nQpt
45*59599516SKenneth E. Jansenc
46*59599516SKenneth E. Jansenc.... generate the local-shape-functions
47*59599516SKenneth E. Jansenc
48*59599516SKenneth E. Jansen          shp(1,m) = one - QuadPt(1,m) - QuadPt(2,m) - QuadPt(3,m)
49*59599516SKenneth E. Jansen          shp(2,m) = QuadPt(1,m)
50*59599516SKenneth E. Jansen          shp(3,m) = QuadPt(2,m)
51*59599516SKenneth E. Jansen          shp(4,m) = QuadPt(3,m)
52*59599516SKenneth E. Jansenc
53*59599516SKenneth E. Jansenc.... generate the grad-local-shape-functions
54*59599516SKenneth E. Jansenc
55*59599516SKenneth E. Jansen          shgl(1,1,m) = -pt5
56*59599516SKenneth E. Jansen          shgl(2,1,m) = -pt5
57*59599516SKenneth E. Jansen          shgl(3,1,m) = -pt5
58*59599516SKenneth E. Jansen          shgl(1,2,m) =  pt5
59*59599516SKenneth E. Jansen          shgl(2,2,m) =  zero
60*59599516SKenneth E. Jansen          shgl(3,2,m) =  zero
61*59599516SKenneth E. Jansen          shgl(1,3,m) =  zero
62*59599516SKenneth E. Jansen          shgl(2,3,m) =  pt5
63*59599516SKenneth E. Jansen          shgl(3,3,m) =  zero
64*59599516SKenneth E. Jansen          shgl(1,4,m) =  zero
65*59599516SKenneth E. Jansen          shgl(2,4,m) =  zero
66*59599516SKenneth E. Jansen          shgl(3,4,m) =  pt5
67*59599516SKenneth E. Jansenc
68*59599516SKenneth E. Jansenc.... copy the weight
69*59599516SKenneth E. Jansenc
70*59599516SKenneth E. Jansen          wght(m) = QuadPt(4,m)
71*59599516SKenneth E. Jansenc
72*59599516SKenneth E. Jansenc.... end of shape-function loop
73*59599516SKenneth E. Jansenc
74*59599516SKenneth E. Jansen        enddo
75*59599516SKenneth E. Jansenc
76*59599516SKenneth E. Jansenc.... return
77*59599516SKenneth E. Jansenc
78*59599516SKenneth E. Jansen        return
79*59599516SKenneth E. Jansen        end
80