574
16 Computer Programs in Vibration Analysis
Table 16.3 (continued)
common /a/ ntv,nbh,gstif(itdf),gmass(itdf),gload(ntdf),kind(ntdf),
>mind(ntdf)
common /b/ nod(ielt,2),xg(inod),yg(inod),zg(inod)
dimension ak(200)
ist=1
iend=0
do 10 jj=1,nbh
i=(jj*(jj-1))/2
do 2 ii=1,jj
if(ind.eq.1) ak(ii)=gstif(i+ii)
if(ind.eq.2) ak(ii)=gmass(i+ii)
2
continue
call search(ak,jj,ist,iend,ind)
if(ind.eq.1) kind(jj)=iend
if(ind.eq.2) mind(jj)=iend
10
continue
do 20 jj=nbh+1,ntv
i=i+nbh
do 4 ii=1,nbh
if (ind.eq.1) ak(ii)=gstif(i+ii)
if (ind.eq.2) ak(ii)=gmass(i+ii)
4
continue
call search(ak,nbh,ist,iend,ind)
if (ind.eq.1) kind(jj)=iend
if (ind.eq.2) mind(jj)=iend
20
continue
return
end
*
Subroutine search
subroutine search(ak,nb,ist,iend,ind)
parameter (ielt=50,inod=50,ntdf=inod*6,inb=50)
parameter (ibh=25,itdf=ntdf*ibh)
common /a/ ntv,nbh,gstif(itdf),gmass(itdf),gload(ntdf),kind(ntdf),
>mind(ntdf)
dimension ak(200)
do 20 ii=1,nb
if(ak(ii))10,20,10
10
ibl=ii
go to 30
20
continue
ibl=nb
30
continue
icount=nb-ibl+1
iend=iend+icount
do 40 ii=ist,iend
jj=ii-ist+ibl
if (ind.eq.1) gstif(ii)=ak(jj)
if (ind.eq.2) gmass(ii)=ak(jj)
40
continue
ist=ist+icount
return
end
*
Subroutine Bac
(continued)
16 Computer Programs in Vibration Analysis
Table 16.3 (continued)
common /a/ ntv,nbh,gstif(itdf),gmass(itdf),gload(ntdf),kind(ntdf),
>mind(ntdf)
common /b/ nod(ielt,2),xg(inod),yg(inod),zg(inod)
dimension ak(200)
ist=1
iend=0
do 10 jj=1,nbh
i=(jj*(jj-1))/2
do 2 ii=1,jj
if(ind.eq.1) ak(ii)=gstif(i+ii)
if(ind.eq.2) ak(ii)=gmass(i+ii)
2
continue
call search(ak,jj,ist,iend,ind)
if(ind.eq.1) kind(jj)=iend
if(ind.eq.2) mind(jj)=iend
10
continue
do 20 jj=nbh+1,ntv
i=i+nbh
do 4 ii=1,nbh
if (ind.eq.1) ak(ii)=gstif(i+ii)
if (ind.eq.2) ak(ii)=gmass(i+ii)
4
continue
call search(ak,nbh,ist,iend,ind)
if (ind.eq.1) kind(jj)=iend
if (ind.eq.2) mind(jj)=iend
20
continue
return
end
*
Subroutine search
subroutine search(ak,nb,ist,iend,ind)
parameter (ielt=50,inod=50,ntdf=inod*6,inb=50)
parameter (ibh=25,itdf=ntdf*ibh)
common /a/ ntv,nbh,gstif(itdf),gmass(itdf),gload(ntdf),kind(ntdf),
>mind(ntdf)
dimension ak(200)
do 20 ii=1,nb
if(ak(ii))10,20,10
10
ibl=ii
go to 30
20
continue
ibl=nb
30
continue
icount=nb-ibl+1
iend=iend+icount
do 40 ii=ist,iend
jj=ii-ist+ibl
if (ind.eq.1) gstif(ii)=ak(jj)
if (ind.eq.2) gmass(ii)=ak(jj)
40
continue
ist=ist+icount
return
end
*
Subroutine Bac
(continued)
