How to count instances of data being within specific ranges using arrays and count function

Hello all,

My goal is to make a program that reads a data file with 5 columns of data, reads each column and counts how many data points fit within different ranges (these counts are placed into different bins, which represent different ranges.) So, for column b I want 20 bins with the complete bin range going from (-3 to 3). For example, bin1 for column b will count how many numbers in that column are in the range (-3 to -2.7), bin2 would count for the range (-2.7, -2.4), etc… I want the bin width and each bin range to be the same for each column so that each column is counted for the same ranges. Originally, I had a horribly inefficient program (which worked) but in the end I had 80 if statements (20 for each column.) I wanted to see if I could use arrays and the count function to reduce it to just 4 lines. I have seen suggestions to have an array that looks like:

        binb(i)=binb(i)+count(b>=lower(i) .and. b<upper(i))
        binc(i)=binc(i)+count(c>=lower(i) .and. c<upper(i))
        bind(i)=bind(i)+count(d>=lower(i) .and. d<upper(i))
        bine(i)=bine(i)+count(e>=lower(i) .and. e<upper(I))

but lower and upper must be arrays instead of scalars… Here is my program thus far:

    program mean_analysis
    implicit none
    
    integer i, j, k, N, l
    double precision a, b, c, d, e
    integer binb(1:20),binc(1:20),bind(1:20),bine(1:20)
    real lower(1:20),upper(1:20)

    

    character(100) event
    
    upper(1)=-2.7
    lower(1)=-3
    

    




    
        
    open(unit = 7, file="zpc_initial_momenta.dat")
        do l=2,20
            lower(l)=lower(l-1)+.3
            upper(l)=upper(l-1)+.3  
        end do
        
        do k=1, 10
            read(7,'(A)') event
            do j=1,4000
            read(7,*) a, b, c, d, e
            do i=1,20
        binb(i)=binb(i)+count(b>=lower(i:) .and. b<upper(:i))
        binc(i)=binc(i)+count(c>=lower(i:) .and. c<upper(:i))
        bind(i)=bind(i)+count(d>=lower(i:) .and. d<upper(:i))
        bine(i)=bine(i)+count(e>=lower(i:) .and. e<upper(:i))   
        
        end do
        end do
        end do
                
    close(7)
            
    open(unit = 8, file="outputanalysis.dat")
        Write(8,*) 'The bins in each column are as follows:'
        Write(8,*) 'FIRST COLUMN (MOMENTUM IN X DIRECTION)'
        write(8,*) binb
        
    close(8)
    
    end program

I have tried to remedy the lower - upper scalar issue by implementing an idea someone had on another post of mine, to make lower-> lower(I:) and upper → upper(:I) , but it does not use the correct i-th values for the upper and lower arrays that I defined earlier with a do loop. Any suggestions or help is greatly appreciated. Thank you!

Since the width the interval of values that each bin holds is the same (0.3), you can compute the bin i.d. ib = int(b/0.3)+11, and increment the count of that bin, i.e., binb(ib) = binb(ib)+1. You will have to cover edge cases, i.e., b = 3, with more lines of code.

It is not clear if there is any relation between the different columns. If not, you could treat the other columns in the same way that I outlined.

For equally-spaced bins you can use division and then truncation to calculate the bin that a number belongs to, as shown in the program below:

program main
implicit none
integer, parameter :: dp = kind(1.0d0), nobs = 10**8, nbins = 20
real(kind=dp), parameter :: xmin=-3.0_dp, xmax=3.0_dp, xrange = xmax-xmin, &
   width=xrange/nbins
real(kind=dp) :: x(nobs), xlo, xhi
integer :: i, ibin(nobs), icount(2)
call random_seed()
call random_number(x)
x = xmin + x*xrange
ibin = int((x-xmin)/width + 1) ! compute bin for each x
print*,"min, max ibin =",minval(ibin),maxval(ibin)
print "(*(a10))","bin","xlo","xhi","#","#chk","diff"
do i=1,nbins
   xlo = xmin + (i-1)*width
   xhi = xlo + width   
   icount(1) = count(ibin==i)
   icount(2) = count(x >= xlo .and. x < xhi)
   print "(i10,2f10.3,*(i10))",i,xlo,xhi,icount(1),icount(2),icount(2)-icount(1) 
end do
end program main

with sample output

 min, max ibin =           1          20
       bin       xlo       xhi         #      #chk      diff
         1    -3.000    -2.700   5000414   5000414         0
         2    -2.700    -2.400   5002200   5002200         0
         3    -2.400    -2.100   5000047   5000047         0
         4    -2.100    -1.800   4996252   4996252         0
         5    -1.800    -1.500   5000232   5000232         0
         6    -1.500    -1.200   5000081   5000081         0
         7    -1.200    -0.900   5000498   5000498         0
         8    -0.900    -0.600   4999122   4999122         0
         9    -0.600    -0.300   5002345   5002345         0
        10    -0.300    -0.000   4997068   4997068         0
        11     0.000     0.300   4999849   4999849         0
        12     0.300     0.600   5002097   5002097         0
        13     0.600     0.900   4999572   4999572         0
        14     0.900     1.200   5001520   5001520         0
        15     1.200     1.500   5002181   5002181         0
        16     1.500     1.800   4996387   4996387         0
        17     1.800     2.100   5003861   5003861         0
        18     2.100     2.400   4999951   4999951         0
        19     2.400     2.700   4994710   4994710         0
        20     2.700     3.000   5001613   5001613         0