Ask Question

Name:
Title:
Your Question:

Answer Question

Name:
Your Answer:
User Submitted Source Code!


Description:
  base
Language: FORTRAN
Code:
program pro 
parameter(im=100,ii=100000000,nx=1000000) 
dimension y(10),jh(0:im*im),jpntr(10)
y(1) = 0
y(2) = 12
y(3) = 15
y(4) = 16
y(5) = 19
y(6) = 20
y(7) = 12
y(8) = 14
y(9) = 12
y(10) = 1

eps = 0.1

call base(10, y, 1, 1, jh, jpntr, eps)
  write(*,100) '1', jpntr(1)
  write(*,100) '2', jpntr(2)
  write(*,100) '3', jpntr(3)
  write(*,100) '4', jpntr(4)
  write(*,100) '5', jpntr(5)
  write(*,100) '6', jpntr(6)
  write(*,100) '7', jpntr(7)
  write(*,100) '8', jpntr(8)
  write(*,100) '9', jpntr(9)
  write(*,100) '10', jpntr(10)
  100 format (A,F)

end program pro

subroutine base(nmax,y,id,m,jh,jpntr,eps)
      parameter(im=100,ii=100000000) 
      dimension y(nmax),jh(0:im*im),jpntr(nmax)

      do 10 i=0,im*im
 10      jh(i)=0
      do 20 n=(m-1)*id+1,nmax                                  ! make histogram
         i=mod(int(y(n)/eps)+ii,im)
         if(m.gt.1) i=im*i+mod(int()+ii,im)
 20      jh(i)=jh(i)+1
      do 30 i=1,im*im                                           ! accumulate it
 30      jh(i)=jh(i)+jh(i-1)
      do 40 n=(m-1)*id+1,nmax                           ! fill list of pointers

         i=mod(int(y(n)/eps)+ii,im)
         if(m.gt.1) i=im*i+mod(int(y/eps)+ii,im)
         jpntr(jh(i))=n
 40      jh(i)=jh(i)-1
      end
Comments: