576
16 Computer Programs in Vibration Analysis
Table 16.3 (continued)
integer q
n=npt
xcm=1.0
l(1)=sqrt(l(1))
do 1 i=2,n
q=ld(i)-i
m1=1+ld(i-1)-q
do 2 j=m1,i
nn=0
el=l(j+q)
if(j-1)10,2,10
10
continue
kk=ld(j)-j
nn=1+ld(j-1)-kk
nn=max0(nn,m1)
if(nn-j)15,2,15
15
continue
j1=j-1
do 3 k=nn,j1
3
el=el-l(q+k)*l(kk+k)
2
l(j+q)=el/l(ld(j))
if(el .le. 0)go to 5
xc=1./l(i+q)
if(xc-xcm)1,20,20
20
continue
xcm=xc
jcm=i
1
l(ld(i))=sqrt(el)
icm=int(alog10(xcm))+1
ier=2
write(*,*) '
n = ',n
go to 6
5
ier=3
n=-n
write(*,*) '
n = ',n
write(*,*)'error***
Stiffness Matrix Not Positive Definite'
6
return
end
C
SUBROUTINE TO CALCULATE EIGEN VECTORS
SUBROUTINE R8USIV(NRQD,BD,ALPHA)
DIMENSION U(300,20),V(300,20),W(300,20),BD(20),HZ(20),ERR(20)
COMMON/A/NNF,NBH,L(7500),G(7500),GL(300),LD(300),GD(300)
INTEGER GD
REAL L,HZ
DATA NOI,TOLVEC,GES,IRENT,LET,LOCK,INT/80,1.E-06,0.,0,0,1,1/
N=NNF
ND=N
NA=GD(N)
RQD=NRQD
M=NRQD*2.
CALL R8URED(NK,N,IER)
IF(N .LT. 0)RETURN
C
IF(IRENT .EQ. 2)CALL R8UPRE(ND,W,U,NK,M,N,1,IRENT)
CALL R8URAN(ND,U,N,M,IRENT,GES)
CALL R8UORT(ND,U,N,M,1)
50
CALL R8UBAC(ND,U,V,NK,N,M,LOCK)
CALL R8UPRE1(ND,V,W,NA,N,M,LOCK,0)
CALL R8UFOR(ND,W,V,NK,N,M,LOCK)
CALL R8UDEC(ND,U,V,W,BD,N,M,LOCK,TOLVEC)
CALL R8URAN(ND,W,N,M,IRENT,GES)
CALL R8UORT(ND,W,N,M,LOCK)
CALL R8UERR(ND,U,W,BD,ERR,N,M,NRQD,LOCK,TOLVEC,LET)
(continued)