C*********************************************************************** subroutine mkpsi(p,psi) C Generates a symmetric matrix of integers indicating the linear C position in packed storage of the matrix elements integer p,psi(0:p,0:p),posn posn=0 do 10 j=0,p posn=posn+1 psi(j,j)=posn do 5 k=j+1,p posn=posn+1 psi(j,k)=posn psi(k,j)=posn 5 continue 10 continue return end C*********************************************************************** subroutine swp(d,theta,pivot,p,psi,submat,dir) C Performs sweep on a symmetric matrix in packed storage. C Sweeps on pivot position. Sweeps only the (0:submat,0:submat) C submatrix. C If dir=1, performs ordinary sweep. If dir=-1, performs reverse sweep. integer d,p,pivot,psi(0:p,0:p),submat,dir double precision theta(d),a,b,c a=theta(psi(pivot,pivot)) theta(psi(pivot,pivot))=-1./a do 10 j=0,submat if(j.ne.pivot) theta(psi(j,pivot))=theta(psi(j,pivot))/a*dir 10 continue do 30 i=0,submat do 20 j=i,submat if((i.ne.pivot).and.(j.ne.pivot))then b=theta(psi(i,pivot)) c=theta(psi(j,pivot)) theta(psi(i,j))=theta(psi(i,j))-a*b*c endif 20 continue 30 continue return end C*********************************************************************** subroutine mktheta(p,psi,G,theta) integer p, psi(0:p,0:p) double precision theta(1:(p+1)*(p+2)/2), G(0:p,0:p) do 10 j=0,p theta(psi(j,j))=G(j,j) do 20 k=j+1,p theta(psi(j,k))=G(j,k) 20 continue 10 continue return end subroutine mkG(p,psi,theta,G) integer p, psi(0:p,0:p) double precision theta(1:(p+1)*(p+2)/2), G(0:p,0:p) do 10 j=0,p G(j,j)=theta(psi(j,j)) do 20 k=j+1,p G(j,k)=theta(psi(j,k)) G(k,j)=G(j,k) 20 continue 10 continue return end