program random
   implicit none
   real(kind=8),allocatable:: x(:),AIN(:,:),CL(:,:,:),f(:,:),maxf(:)
   real(kind=8) upperbound,lowerbound,seed,NRAB,a,upper,lower,afa,sum,replace
   integer number,j,N1,i,k,N3,L,M,count,ii,G
   number=2
   upperbound=6
   lowerbound=-6
   N1=5
   N3=10
   upper=1
   lower=-1
   afa=2
   G=5
   allocate(x(number))
   allocate(AIN(N1,number))
   allocate(maxf(N1))
   call random_seed ()         
   call random_number (seed)  
 
   do i=1,N1
     do L=1,number
       call randomnumber(seed,upperbound,lowerbound,NRAB)
       AIN(i,L)=NRAB
       end do
   end do
   
   allocate(CL(N1,N3,number))
   allocate(f(N1,N3))
   do i=1,N1
      do L=1,number  
        x(L)=AIN(i,L)
      end do
     call equation(x,f(i,1)) 
     do L=1,number
       CL(i,1,L)=AIN(i,L)
     end do
   end do
   call random_seed ()         ! 根据日期和时间随机地提供种
   call random_number (seed)   ! 每次随机数都不一样，不必再提供种子
   do i=1,N1
     do K=2,N3 
        do L=1,number
    x(L)=AIN(i,L)
        end do
10      call randomnumber(seed,upper,lower,NRAB)
        call equation(x,f(i,k))
        a=-f(i,k)/2000
        do L=1,number
    CL(i,k,L)=AIN(i,L)+NRAB**3*afa*exp(a)
           if((CL(i,k,L)>6.0).or.(CL(i,k,L)<-6.0)) then
       go to 10
           end if
         end do
       end do
   end do


   do i=1,N1
     maxf(i)=0
   end do


   do i=1,N1
     do k=1,N3
        do L=1,number
           x(L)=CL(i,k,L)
        end do
        call equation(x,f(i,k))
      end do
   end do

call create(N1,N3,number,CL,f)
       
end


subroutine randomnumber(R,upperbound,lowerbound,NRAB)
    implicit none
    INTEGER K,i,M,L
    real(kind=8) lowerbound,upperbound,S,J,R,NRAB
    S=upperbound-lowerbound+1.0
    K=LOG(S-0.5)/LOG(2.0)+1
    L=1
    DO I=1,K
        L=2*L
    end do
    K=1
    S=4.0*L
10    IF (K.LE.1) THEN
      R=5*R
      M=R/S
      R=R-M*S
      J=lowerbound+R/4.0
      IF (J.LE.upperbound) THEN
        NRAB=J
        K=K+1
      END IF
      GOTO 10
    END IF
    RETURN
END



subroutine equation(x,f)
  implicit none
  real(kind=8) x(2),f
  f=2200-(x(1)*x(1)+x(2)-11)*(x(1)*x(1)+x(2)-11)-(x(1)+x(2)*x(2)-7)*(x(1)+x(2)*x(2)-7)
  return
end

subroutine create(N1,N3,number,CL,f)
   implicit none
   integer number,j,N1,i,k,N3,L,M,count,ii,G
   real(kind=8),allocatable:: adCL(:,:),adf(:),replaceCL(:,:),replacef(:)
   integer,allocatable::pi(:)
   real(kind=8) upperbound,lowerbound,seed,NRAB,a,upper,lower,afa,sum,replace,CL(N1,N3,number),f(N1,N3), x(number),maxf(N1)

   afa=2
 
 do i=1,N1
    M=0
    count=0
    sum=0
    do k=1,N3
      if(f(i,k)>maxf(i)) then
         M=M+1
      end if
     end do


     allocate(adCL(M,number))
     allocate(adf(M))
     allocate(pi(M))     
     allocate(replacef(M*N3)) 
     allocate(replaceCL(M*N3,L))

     do k=1,M
        if(f(i,k)>maxf(i)) then
          do L=1,number
      adCL(k,L)=CL(i,k,L)
          end do
          adf(k)=f(i,k)
        end if
     end do


     do ii=1,M
       do k=1,N3
10       call randomnumber(seed,upper,lower,NRAB)
         a=-adf(ii)/2000
         do L=1,number
     replaceCL((ii-1)*N3+k,L)=adCL(ii,L)+NRAB**3*afa*exp(a)
     if((replaceCL((ii-1)*N3+k,L)>6.0).or.(replaceCL((ii-1)*N3+k,L)<-6.0)) then
              go to 10
           end if 
           x(L)=replaceCL((ii-1)*N3+k,L)
         end do
         call equation(x,replacef((ii-1)*N3+k))
       end do
     end do


     do k=1,N3*M-1
       do ii=k+1,N3*M
          if(replacef(ii)>replacef(k)) then
             replace=replacef(k)
             replacef(k)=replacef(ii)
             replacef(ii)=replace
             do L=1,number
               replace=replaceCL(k,L)
        replaceCL(k,L)=replaceCL(ii,L)
        replaceCL(ii,L)=replace    
      end do
     end if
         end do
       end do 
     
       do k=1,N3
         f(i,k)=replacef(k)
         write(*,*)f(i,k)
         do L=1,number
     CL(i,k,L)=replaceCL(k,L)
            write(*,*)CL(i,k,L)
          end do
       end do

        
      deallocate(adCL)
      deallocate(adf)
      deallocate(pi)
      deallocate(replaceCL)
      deallocate(replacef) 
   end do
   return


end 



运行出现数组越界,请高手指教！谢谢