xref: /phasta/phSolver/common/genshp.f (revision 595995161822a203c8467e0e4a253d7bd7d6df32)

        subroutine genshp (shp,    shgl, nshp, nblk)
c
c----------------------------------------------------------------------
c
c This subroutine generates shape functions for triangular,
c quadrilateral, tetrahedron, wedge and brick elements and pyramids.
c
c Christian Whiting, Winter 1999
c----------------------------------------------------------------------
c
        include "common.h"
c
        dimension shp(MAXTOP,maxsh,MAXQPT),
     &            shgl(MAXTOP,nsd,maxsh,MAXQPT)
c
c.... loop through element blocks
c
        maxnint=1
          do iblk = 1, nblk
c
c.... get coord. system and element type
c
            lcsyst = lcblk(3,iblk)
            nshl   = lcblk(10,iblk)
c
c.... generate the shape-functions in local coordinates
c
            select case ( lcsyst )
            case ( 1 )          ! tets
               maxnint=max(maxnint,nint(lcsyst))
            do i=1,nint(lcsyst)
               call shpTet(ipord,Qpt(1,1:3,i),shp(1,:,i),shgl(1,:,:,i))
            enddo
            shgl(1,:,1:nshl,1:nint(lcsyst)) =
     &      shgl(1,:,1:nshl,1:nint(lcsyst))/two
c
            case ( 2 )          ! hexes
c
               maxnint=max(maxnint,nint(lcsyst))
            do i=1,nint(lcsyst)
               call shphex  (ipord, Qpt(2,1:3,i),shp(2,:,i),
     &                       shgl(2,:,:,i))
            enddo
c
            case ( 3 )          ! wedges
c
               maxnint=max(maxnint,nint(lcsyst))
            do i=1,nint(lcsyst)
               call shp6w  (ipord,Qpt(3,1:3,i),shp(3,:,i),
     &                       shgl(3,:,:,i))
            enddo

         case ( 5)              ! pyramids

               maxnint=max(maxnint,nint(lcsyst))
            do i=1,nint(lcsyst)
               call shppyr (ipord,Qpt(5,1:3,i),shp(5,:,i),shgl(5,:,:,i))

            enddo
c
c.... nonexistent element
c
            case default
c
            call error ('genshp  ', 'elem Cat', lelCat)
c
            end select
c
c.... end of generation
c
          enddo
c
c.... return
c
        return
        end