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