Initial Commit

2018-02-08 21:28:33 -05:00
commit 678c1d3966
14352 changed files with 3176737 additions and 0 deletions
@@ -0,0 +1,96 @@
+subroutine sort(n,arr)
+
+  integer n,m,nstack
+  real arr(n)
+  parameter (m=7,nstack=50)
+  integer i,ir,j,jstack,k,l,istack(nstack)
+  real a,temp
+
+  jstack=0
+  l=1
+  ir=n
+  n0=n
+
+1 if(ir-l.lt.m) then
+     do j=l+1,ir
+        a=arr(j)
+        do i=j-1,1,-1
+           if(arr(i).le.a) goto 2
+           arr(i+1)=arr(i)
+        enddo
+        i=0
+2       arr(i+1)=a
+     enddo
+
+     if(jstack.eq.0) return
+
+     ir=istack(jstack)
+     l=istack(jstack-1)
+     jstack=jstack-2
+
+  else
+     k=(l+ir)/2
+     temp=arr(k)
+     arr(k)=arr(l+1)
+     arr(l+1)=temp
+
+     if(arr(l+1).gt.arr(ir)) then
+        temp=arr(l+1)
+        arr(l+1)=arr(ir)
+        arr(ir)=temp
+     endif
+
+     if(arr(l).gt.arr(ir)) then
+        temp=arr(l)
+        arr(l)=arr(ir)
+        arr(ir)=temp
+     endif
+
+     if(arr(l+1).gt.arr(l)) then
+        temp=arr(l+1)
+        arr(l+1)=arr(l)
+        arr(l)=temp
+     endif
+
+     i=l+1
+     j=ir
+     a=arr(l)
+3    i=i+1
+     if(i.gt.n0) then
+        do jj=1,n0
+           write(99,3001) jj,arr(jj),i,n,ir
+3001       format(i10,e12.3,3i10)
+        enddo
+        close(99)
+        stop 'Bounds error in sort.f90'
+     endif
+     if(arr(i).lt.a) goto 3
+
+4    j=j-1
+     if(arr(j).gt.a) goto 4
+
+     if(j.lt.i) goto 5
+     temp=arr(i)
+     arr(i)=arr(j)
+     arr(j)=temp
+     goto 3
+
+5    arr(l)=arr(j)
+     arr(j)=a
+     jstack=jstack+2
+     if(jstack.gt.nstack) stop 'nstack too small in sort'
+
+     if(ir-i+1.ge.j-l) then
+        istack(jstack)=ir
+        istack(jstack-1)=i
+        ir=j-1
+     else
+        istack(jstack)=j-1
+        istack(jstack-1)=l
+        l=i
+     endif
+
+  endif
+  goto 1
+
+end subroutine sort