30 lines
688 B
Fortran
30 lines
688 B
Fortran
SUBROUTINE covsrt(covar,npc,ma,ia,mfit)
|
|
INTEGER ma,mfit,npc,ia(ma)
|
|
REAL covar(npc,npc)
|
|
INTEGER i,j,k
|
|
REAL swap
|
|
do 12 i=mfit+1,ma
|
|
do 11 j=1,i
|
|
covar(i,j)=0.
|
|
covar(j,i)=0.
|
|
11 continue
|
|
12 continue
|
|
k=mfit
|
|
do 15 j=ma,1,-1
|
|
if(ia(j).ne.0)then
|
|
do 13 i=1,ma
|
|
swap=covar(i,k)
|
|
covar(i,k)=covar(i,j)
|
|
covar(i,j)=swap
|
|
13 continue
|
|
do 14 i=1,ma
|
|
swap=covar(k,i)
|
|
covar(k,i)=covar(j,i)
|
|
covar(j,i)=swap
|
|
14 continue
|
|
k=k-1
|
|
endif
|
|
15 continue
|
|
return
|
|
END
|