xref: /phasta/phSolver/common/genshpb.f (revision 595995161822a203c8467e0e4a253d7bd7d6df32)
1      subroutine genshpb (shpb,    shglb, nshpb, nblk)
2c
3c----------------------------------------------------------------------
4c
5c This subroutine generates shape functions for triangular,
6c quadrilateral, tetrahedron, wedge and brick elements.
7c
8c Christian Whiting, Winter 1999
9c----------------------------------------------------------------------
10c
11      include "common.h"
12c
13      dimension shpb(MAXTOP,maxsh,MAXQPT),
14     &          shglb(MAXTOP,nsd,maxsh,MAXQPT)
15c
16c.... loop through element blocks
17c
18      do iblk = 1, nblk
19c
20c.... get coord. system and element type
21c
22
23         lcsyst = lcblkb(3,iblk)
24
25c.... generate the shape-functions in local coordinates
26c
27         select case ( lcsyst )
28         case ( 1 )             ! tets
29            nshl=lcblkb(9,iblk)
30            do i=1,nintb(lcsyst)
31               call shpTet(ipord,Qptb(1,1:3,i),shpb(1,:,i),
32     &              shglb(1,:,:,i))
33            enddo
34            shglb(1,:,1:nshl,1:nintb(lcsyst)) =
35     &           shglb(1,:,1:nshl,1:nintb(lcsyst))/two
36c
37         case ( 2 )             ! hexes
38c
39            do i=1,nintb(lcsyst)
40               call shpHex  (ipord, Qptb(2,1:3,i),shpb(2,:,i),
41     &              shglb(2,:,:,i))
42            enddo
43c
44         case ( 3 )             ! wedges with tri bd face
45
46            do i=1,nintb(lcsyst)
47               call shp6w (ipord,Qptb(3,1:3,i),
48     &              shpb(3,:,i),shglb(3,:,:,i))
49            enddo
50c
51         case ( 4 )             ! wedges with quad bd face
52c
53            do i=1,nintb(lcsyst)
54               call shp6w (ipord,Qptb(4,1:3,i),
55     &              shpb(4,:,i),shglb(4,:,:,i))
56            enddo
57         case ( 5 )             ! pyramids with quad bd face
58c
59            do i=1,nintb(lcsyst)
60               call shppyr (ipord,Qptb(5,1:3,i),
61     &              shpb(5,:,i),shglb(5,:,:,i))
62            enddo
63c
64         case ( 6 )             ! pyramids with quad bd face
65c
66            do i=1,nintb(lcsyst)
67               call shppyr (ipord,Qptb(6,1:3,i),
68     &              shpb(6,:,i),shglb(6,:,:,i))
69            enddo
70c
71c.... nonexistent element
72c
73         case default
74c
75            call error ('genshp  ', 'elem Cat', lelCat)
76c
77         end select
78c
79c.... end of generation
80c
81      enddo
82c
83c.... return
84c
85      return
86      end
87