Initial commit

2016-02-03 18:52:05 +00:00
commit d40505e161
507 changed files with 91383 additions and 0 deletions
@@ -0,0 +1,102 @@
+     
+      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&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&