103 lines
2.7 KiB
FortranFixed
103 lines
2.7 KiB
FortranFixed
|
|
subroutine randpermut_dim_samp(npoints,ndim,x)
|
|
implicit none
|
|
!
|
|
! conduct random permutation
|
|
integer npoints,ndim,i,j,k,iextreme,index,ibad,ngood,
|
|
& istore(npoints)
|
|
double precision x(ndim,npoints),xtemp(npoints),
|
|
& ran2_reset,temp,bmin(ndim),bmax(ndim)
|
|
|
|
do i=1,ndim
|
|
do j=1,npoints
|
|
xtemp(j)=x(i,j)
|
|
enddo
|
|
do j=1,npoints
|
|
index=int(dble(npoints-j+1)*ran2_reset()+1.0d0)
|
|
x(i,j)=xtemp(index)
|
|
xtemp(index)=xtemp(npoints-j+1)
|
|
enddo
|
|
enddo
|
|
|
|
if(ndim.eq.1)return
|
|
if(npoints.le.3)return
|
|
|
|
! now check to see if all extreme values are togather
|
|
do i=1,ndim
|
|
bmax(i)=x(i,1)
|
|
bmin(i)=x(i,1)
|
|
enddo
|
|
do i=2,npoints
|
|
do j=1,ndim
|
|
if(bmax(j).lt.x(j,i))then
|
|
bmax(j)=x(j,i)
|
|
endif
|
|
if(bmin(j).gt.x(j,i))then
|
|
bmin(j)=x(j,i)
|
|
endif
|
|
enddo
|
|
enddo
|
|
do i=1,npoints
|
|
iextreme=0
|
|
do j=1,ndim
|
|
if(dabs(x(j,i)-bmax(j)).lt.1.0d-9.or.
|
|
& dabs(x(j,i)-bmin(j)).lt.1.0d-9)then
|
|
iextreme=iextreme+1
|
|
endif
|
|
enddo
|
|
|
|
if(iextreme.ge.(ndim/2+1))then
|
|
! more than half take extreme values, need to change
|
|
! find ones without any extremes
|
|
ngood=0
|
|
do j=1,i
|
|
ibad=0
|
|
do k=1,ndim
|
|
if(dabs(x(k,j)-bmax(k)).lt.1.0d-9.or.
|
|
& dabs(x(k,j)-bmin(k)).lt.1.0d-9)then
|
|
ibad=1
|
|
endif
|
|
enddo
|
|
if(ibad.eq.0)then
|
|
ngood=ngood+1
|
|
istore(ngood)=j
|
|
endif
|
|
enddo
|
|
do j=1+i,npoints
|
|
ibad=0
|
|
do k=1,ndim
|
|
if(dabs(x(k,j)-bmax(k)).lt.1.0d-9.or.
|
|
& dabs(x(k,j)-bmin(k)).lt.1.0d-9)then
|
|
ibad=1
|
|
endif
|
|
enddo
|
|
if(ibad.eq.0)then
|
|
ngood=ngood+1
|
|
istore(ngood)=j
|
|
endif
|
|
enddo
|
|
if(ngood.ge.1)then
|
|
index=int(dble(ngood)*ran2_reset()+1.0d0)
|
|
index=istore(index)
|
|
else
|
|
! there is no single point that does not take any extremes
|
|
index=int(dble(npoints)*ran2_reset()+1.0d0)
|
|
if(index.eq.i)then
|
|
if(i.eq.1)then
|
|
index=npoints
|
|
else
|
|
index=1
|
|
endif
|
|
endif
|
|
endif
|
|
do j=1,ndim,2
|
|
temp=x(j,i)
|
|
x(j,i)=x(j,index)
|
|
x(j,index)=temp
|
|
enddo
|
|
endif
|
|
enddo
|
|
return
|
|
end
|
|
c&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
|