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&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&