16.6 Computer Program for Finite Element Free Vibration Analysis of Plates
601
Table 16.9 (continued)
go to 170
160 eta = 0.774596669241483
hj = 0.555555555555556
170 return
end
c*********************************************************************
c
ASSEMBLY IN SKYLINE FORM
C*********************************************************************
subroutine assem1(ielm,nbh,estif,nod,gstif,nfree)
dimension estif(40,40),nod(1000,8),gstif(3300000)
nnpm=8
c
nnpm=no of nod per member/element
do 60 i=1,nnpm
ig=(nod(ielm,i)-1)*nfree
do 60 ii=1,nfree
mmi=ig+ii
mmm=mmi-1
imi=(i-1)*nfree+ii
do 60 j=1,nnpm
jg=(nod(ielm,j)-1)*nfree
do 60 jj=1,nfree
nnj=jg+jj
jnj=(j-1)*nfree+jj
if(nnj.gt.mmi)go to 55
if(mmi-nbh)35,35,40
35 kjj=mmm*(mmm+1)/2+nnj
kkj=kjj
go to 45
40 kkj=nbh*(nbh+1)/2
lrow=(mmm-nbh+1)*nbh+nnj-mmi
kkj=kkj+lrow
45 continue
gstif(kkj)=gstif(kkj)+estif(imi,jnj)
55 continue
60 continue
cwrite(*,*)'kkj=',kkj
return
end
c***********************************************************************
c*******************subroutine crunch***********************************
subroutine crunch(npt,nbh,ntot,gstif,kind)
dimension ak(3300000),gstif(3300000),kind(6000)
ist=1
iend=0
do 10 jj=1,nbh
i=(jj*(jj-1))/2
do 2 ii=1,jj
ak(ii)=gstif(i+ii)
2
continue
call search(ak,jj,ist,iend,gstif)
kind(jj)=iend
10 continue
do 20 jj=nbh+1,npt
i=i+nbh
do 4 ii=1,nbh
ak(ii)=gstif(i+ii)
4
continue
call search(ak,nbh,ist,iend,gstif)
kind(jj)=iend
20 continue
return
end
**************************subroutine search******************************
(continued)
601
Table 16.9 (continued)
go to 170
160 eta = 0.774596669241483
hj = 0.555555555555556
170 return
end
c*********************************************************************
c
ASSEMBLY IN SKYLINE FORM
C*********************************************************************
subroutine assem1(ielm,nbh,estif,nod,gstif,nfree)
dimension estif(40,40),nod(1000,8),gstif(3300000)
nnpm=8
c
nnpm=no of nod per member/element
do 60 i=1,nnpm
ig=(nod(ielm,i)-1)*nfree
do 60 ii=1,nfree
mmi=ig+ii
mmm=mmi-1
imi=(i-1)*nfree+ii
do 60 j=1,nnpm
jg=(nod(ielm,j)-1)*nfree
do 60 jj=1,nfree
nnj=jg+jj
jnj=(j-1)*nfree+jj
if(nnj.gt.mmi)go to 55
if(mmi-nbh)35,35,40
35 kjj=mmm*(mmm+1)/2+nnj
kkj=kjj
go to 45
40 kkj=nbh*(nbh+1)/2
lrow=(mmm-nbh+1)*nbh+nnj-mmi
kkj=kkj+lrow
45 continue
gstif(kkj)=gstif(kkj)+estif(imi,jnj)
55 continue
60 continue
cwrite(*,*)'kkj=',kkj
return
end
c***********************************************************************
c*******************subroutine crunch***********************************
subroutine crunch(npt,nbh,ntot,gstif,kind)
dimension ak(3300000),gstif(3300000),kind(6000)
ist=1
iend=0
do 10 jj=1,nbh
i=(jj*(jj-1))/2
do 2 ii=1,jj
ak(ii)=gstif(i+ii)
2
continue
call search(ak,jj,ist,iend,gstif)
kind(jj)=iend
10 continue
do 20 jj=nbh+1,npt
i=i+nbh
do 4 ii=1,nbh
ak(ii)=gstif(i+ii)
4
continue
call search(ak,nbh,ist,iend,gstif)
kind(jj)=iend
20 continue
return
end
**************************subroutine search******************************
(continued)
