596
16 Computer Programs in Vibration Analysis
Table 16.9 (continued)
zx(5)=1.0
zy(5)=-1.0
zx(6)=0.0
zy(6)=-1.0
zx(7)=-1.0
zy(7)=-1.0
zx(8)=-1.0
zy(8)=0.0
c*************************************************************************
c
element stiffness matrix generation starts
c**************************************************************************
do 16 i=1,nq
do 16 j=1,nq
call gacuv(i,j,zi,eta,hi,hj,nq)
c*************************************************************************
c
gacuv is a subroutine to fetch gauss point values based on the
c
number
c
of integration points required
c****************************************************************************
call shape (zi,eta,zx,zy,sfd,sfdr,sfdz,sfdzr,sfde,sfder,
*bb,zac,xg,yg,nn,nenp,nfree,elmas,rho)
do 24 m=1,nenp
do 24 n=1,nenp
if (n-m) 24,611,611
611
asat(m,n) = 0.0
do 24 l=1,5
do 24 k=1,5
asat(m,n) = asat(m,n)+bb(l,m)*rgd(l,k)*bb(k,n)*zac
24
continue
16
continue
do 620 i=1,nenp
do 620 j=1,nenp
620
stiff(j,i) = stiff(i,j)
c****************************************************************************
c
c
element stiffness matrix generation over
c
c****************************************************************************
c****************************************************************************
c
assembly of overall stiffness matrix in single array starts
c
c****************************************************************************
do 120 i = 1,ntot
120
gstif(i) = 0.0
do 200 iim = 1,nelm
call assem(iim,nbh,stiff,nod,gstif,nenp,nelm,nn,nfree)
200
continue
c****************************************************************************
c
c
assembly of overall stiffness matrix over
c
c****************************************************************************
do 30 ij=1,nt
kind(ij)=0
mind(ij)=ij
30
amaso(ij)=0
do 125 iim=1,nelm
call omas (iim,nn,nfree,nelm,nod,elmas,amaso)
125
continue
(continued)
16 Computer Programs in Vibration Analysis
Table 16.9 (continued)
zx(5)=1.0
zy(5)=-1.0
zx(6)=0.0
zy(6)=-1.0
zx(7)=-1.0
zy(7)=-1.0
zx(8)=-1.0
zy(8)=0.0
c*************************************************************************
c
element stiffness matrix generation starts
c**************************************************************************
do 16 i=1,nq
do 16 j=1,nq
call gacuv(i,j,zi,eta,hi,hj,nq)
c*************************************************************************
c
gacuv is a subroutine to fetch gauss point values based on the
c
number
c
of integration points required
c****************************************************************************
call shape (zi,eta,zx,zy,sfd,sfdr,sfdz,sfdzr,sfde,sfder,
*bb,zac,xg,yg,nn,nenp,nfree,elmas,rho)
do 24 m=1,nenp
do 24 n=1,nenp
if (n-m) 24,611,611
611
asat(m,n) = 0.0
do 24 l=1,5
do 24 k=1,5
asat(m,n) = asat(m,n)+bb(l,m)*rgd(l,k)*bb(k,n)*zac
24
continue
16
continue
do 620 i=1,nenp
do 620 j=1,nenp
620
stiff(j,i) = stiff(i,j)
c****************************************************************************
c
c
element stiffness matrix generation over
c
c****************************************************************************
c****************************************************************************
c
assembly of overall stiffness matrix in single array starts
c
c****************************************************************************
do 120 i = 1,ntot
120
gstif(i) = 0.0
do 200 iim = 1,nelm
call assem(iim,nbh,stiff,nod,gstif,nenp,nelm,nn,nfree)
200
continue
c****************************************************************************
c
c
assembly of overall stiffness matrix over
c
c****************************************************************************
do 30 ij=1,nt
kind(ij)=0
mind(ij)=ij
30
amaso(ij)=0
do 125 iim=1,nelm
call omas (iim,nn,nfree,nelm,nod,elmas,amaso)
125
continue
(continued)
