I am running a model and writing the model output to a binary file (a GrADS *gra file) such that, for example:
integer,parameter :: nvar =3 ,& !number of variables to be written to file
nx=10,ny=10,& !number of girdboxes in lat & long
nt = 5
integer :: it, & ! loop counter
irec ! Record number
real :: var1(nx,ny), var2(nx,ny),var3(nx,ny)
OPEN(30,file='Outfile.gra',action='write',form='unformatted',access='direct',&
recl=4*nVar*nx*ny,status='replace')
!loop over timesteps
it = 1, nt
irec = irec + 1
WRITE(1,rec=irec) Var1(:,:),Var2(:,:),Var3(:,:)
enddo
The file can be read in GrADS and the *ctl file looks like this
dset /mypath/Outfile.gra
title MyTitle
options little_endian
xdef 10 linear 1 1
ydef 10 linear 1 1
zdef 1 linear 1.0 1.0
tdef 5 linear 00:00Z01jan2012 1hr
vars 3
var1
var2
var3
endvars
What I would like to do, from a separate program, is write all the x&y of 1 variable at 1 timestep to a text file. I tried a number of ways but nothing has worked. My latest attempt is this one:
integer,parameter :: &
t = 3, & !Timestep I want to write to file
field = 2, & !Variable I want to write to file
nvar =3 , & !number of variables to be written to file
nx=10,ny=10, & !number of girdboxes in lat & long
nt = 5 !number of timesteps
inteǵer :: it,ix,iy,& ! loop counters
irec ! Record number
real :: val(nx,ny) ! Data to be written to file
open(1,file='NewFile.txt',status='replace')
open(2,file='Outfile.gra',action='read',form='unformatted',access='direct',&
recl=4*nVar*nx*ny,status='old')
irec = 0
do it = 1,nt
irec=irec + nvar*nx*ny
if(it == t) then
irec = irec + (field-1)*nx*ny
do ix = 1,nx
do iy = 1,ny
irec=irec+1
read(2,rec=irec) val(ix,iy)
enddo
enddo
write(1,*) val(:,:)
This particular example gives me the following error
Fortran runtime error: Non-existing record number
but I tried other variations that did not give me any errors but simply didn't write what I was trying to write to file. Could somebody tell me what I am doing wrong and how to solve this? Thank you.
OK, let me try again. When you write outfile.gra you appear to write nt records to it in the block
!loop over timesteps
it = 1, nt
irec = irec + 1
WRITE(1,rec=irec) Var1(:,:),Var2(:,:),Var3(:,:)
enddo
I guess that irec is initialised to 0 somewhere in the code. nt is set to 5 so, if my guess is correct, your code writes 5 records to outfile.gra.
Later, you read the same file in this block
irec = 0
do it = 1,nt
irec=irec + nvar*nx*ny
if(it == t) then
irec = irec + (field-1)*nx*ny
do ix = 1,nx
do iy = 1,ny
irec=irec+1
read(2,rec=irec) val(ix,iy)
enddo
enddo
It's unclear where the if statement closes but from your question I guess that it closes after the loops over nx and ny, like this:
irec = 0
do it = 1,nt
irec=irec + nvar*nx*ny
if(it == t) then
irec = irec + (field-1)*nx*ny
do ix = 1,nx
do iy = 1,ny
irec=irec+1
read(2,rec=irec) val(ix,iy)
enddo
enddo
end if
Again, if my guess is correct, then irec has the value 401 when the read statement is first executed.
It seems that you have written 5 records to outfile.gra and are trying to read the 401st record from it. It's entirely reasonable for the run-time to report that you are trying to read a record that doesn't exist.
High Performance Mark and hristo-iliev identified the problem with the record number. In order to be able to do what I want, i.e. write a single variable at a single timestep the right code is
irec = 0
do it = 1, t
irec = irec + 1
read(2,rec=irec) val(:,:,:)
enddo
write(1,*) val(:,:,field)
where val(nx,ny,nVar)
Related
A small example serial code, which has the same structure as my code, is shown below.
PROGRAM MAIN
IMPLICIT NONE
INTEGER :: i, j
DOUBLE PRECISION :: en,ei,es
DOUBLE PRECISION :: ki(1000,2000), et(200),kn(2000)
OPEN(UNIT=3, FILE='output.dat', STATUS='UNKNOWN')
DO i = 1, 1000, 1
DO j = 1, 2000, 1
ki(i,j) = DBLE(i) + DBLE(j)
END DO
END DO
DO i = 1, 200, 1
en = 2.0d0/DBLE(200)*(i-1)-1.0d0
et(i) = en
es = 0.0d0
DO j = 1, 1000, 1
kn=ki(j,:)
CALL CAL(en,kn,ei)
es = es + ei
END DO
WRITE (UNIT=3, FMT=*) et(i), es
END DO
CLOSE(UNIT=3)
STOP
END PROGRAM MAIN
SUBROUTINE CAL (en,kn,ei)
IMPLICIT NONE
INTEGER :: i
DOUBLE PRECISION :: en, ei, gf,p
DOUBLE PRECISION :: kn(2000)
p = 3.14d0
ei = 0.0d0
DO i = 1, 2000, 1
gf = 1.0d0 / (en - kn(i) * p)
ei = ei + gf
END DO
RETURN
END SUBROUTINE CAL
I am running my code on the cluster, which has 32 CPUs on one node, and there are totally 250 GB memory shared by 32 CPUs on one node. I can use 32 nodes maximumly.
Every time when the inner Loop is done, there is one data to be collected. After all outer Loops are done, there are totally 200 data to be collected. If only the inner Loop is executed by one CPU, it would take more than 3 days (more than 72 hours).
I want to do the parallelization for both inner Loop and outer Loop respectively? Would anyone please suggest how to parallelize this code?
Can I use MPI technique for both inner Loop and outer Loop respectively? If so, how to differentiate different CPUs that execute different Loops (inner Loop and outer Loop)?
On the other hand, I saw someone mention the parallelization with hybrid MPI and OpenMP method. Can I use MPI technique for the outer Loop and OpenMP technique for the inner Loop? If so, how to collect one data to the CPU after every inner Loop is done each time and collect 200 data in total to CPU after all outer Loops are done. How to differentiate different CPUs that execute inner Loop and outer Loop respectively?
Alternatively, would anyone provide any other suggestion on parallelizing the code and enhance the efficiency? Thank you very much in advance.
As mentioned in the comments, a good answer will require more detailed question. However, at a first sight it seems that parallelizing the internal loop
DO j = 1, 1000, 1
kn=ki(j,:)
CALL CAL(en,kn,ei)
es = es + ei
END DO
should be enough to solve your problem, or at least it will be a good starter. First of all I guess that there is an error on the loop
DO i = 1, 1000, 1
DO j = 1, 2000, 1
ki(j,k) = DBLE(j) + DBLE(k)
END DO
END Do
since the k is set to 0 and and there is no cell with address corresponding to 0 (see your variable declaration). Also ki is declared ki(1000,2000) array while ki(j,i) is (2000,1000) array. Beside these error, I guess that ki should be calculated as
ki(i,j) = DBLE(j) + DBLE(i)
if true, I suggest you the following solution
PROGRAM MAIN
IMPLICIT NONE
INTEGER :: i, j, k,icr,icr0,icr1
DOUBLE PRECISION :: en,ei,es,timerRate
DOUBLE PRECISION :: ki(1000,2000), et(200),kn(2000)
INTEGER,PARAMETER:: nthreads=1
call system_clock(count_rate=icr)
timerRate=real(icr)
call system_clock(icr0)
call omp_set_num_threads(nthreads)
OPEN(UNIT=3, FILE='output.dat', STATUS='UNKNOWN')
DO i = 1, 1000, 1
DO j = 1, 2000, 1
ki(i,j) = DBLE(j) + DBLE(i)
END DO
END DO
DO i = 1, 200, 1
en = 2.0d0/DBLE(200)*(i-1)-1.0d0
et(i) = en
es = 0.0d0
!$OMP PARALLEL DO private(j,kn,ei) firstpribate(en) shared(ki) reduction(+:es)
DO j = 1, 1000, 1
kn=ki(j,:)
CALL CAL(en,kn,ei)
es = es + ei
END DO
!$OMP END PARALLEL DO
WRITE (UNIT=3, FMT=*) et(i), es
END DO
CLOSE(UNIT=3)
call system_clock(icr1)
write (*,*) (icr1-icr0)/timerRate ! return computing time
STOP
END PROGRAM MAIN
SUBROUTINE CAL (en,kn,ei)
IMPLICIT NONE
INTEGER :: i
DOUBLE PRECISION :: en, ei, gf,p
DOUBLE PRECISION :: kn(2000)
p = 3.14d0
ei = 0.0d0
DO i = 1, 2000, 1
gf = 1.0d0 / (en - kn(i) * p)
ei = ei + gf
END DO
RETURN
END SUBROUTINE CAL
I add some variables to check the computing time ;-).
This solution is computed in 5.14 s, for nthreads=1, and in 2.75 s, for nthreads=2. It does not divide the computing time by 2, but it seems to be a good deal for a first shot. Unfortunately, on this machine I have a core i3 proc. So I can't do better than nthreads=2. However, I wonder, how the code will behave with nthreads=16 ???
Please let me know
I hope that this helps you.
Finally, I warn about the choice of variables status (private, firstprivate and shared) that might be consider carefully in the real code.
Question
Consider the following code:
program example
implicit none
integer, parameter :: n_coeffs = 1000
integer, parameter :: n_indices = 5
integer :: i
real(8), dimension(n_coeffs) :: coeff
integer, dimension(n_coeffs,n_indices) :: index
do i = 1, n_coeffs
coeff(i) = real(i*3,8)
index(i,:) = [2,4,8,16,32]*i
end do
end
For any 5 dimensional index I need to obtain the associated coefficient, without knowing or calculating i. For instance, given [2,4,8,16,32] I need to obtain 3.0 without computing i.
Is there a reasonable solution, perhaps using sparse matrices, that would work for n_indices in the order of 100 (though n_coeffs still in the order of 1000)?
A Bad Solution
One solution would be to define a 5 dimensional array as in
real(8), dimension(2000,4000,8000,16000,32000) :: coeff2
do i = 1, ncoeffs
coeff2(index(i,1),index(i,2),index(i,3),index(i,4),index(i,5)) = coeff(i)
end do
then, to get the coefficient associated with [2,4,8,16,32], call
coeff2(2,4,8,16,32)
However, besides being very wasteful of memory, this solution would not allow n_indices to be set to a number higher than 7 given the limit of 7 dimensions to an array.
OBS: This question is a spin-off of this one. I have tried to ask the question more precisely having failed in the first attempt, an effort that greatly benefited from the answer of #Rodrigo_Rodrigues.
Actual Code
In case it helps here is the code for the actual problem I am trying to solve. It is an adaptive sparse grid method for approximating a function. The main goal is to make the interpolation at the and as fast as possible:
MODULE MOD_PARAMETERS
IMPLICIT NONE
SAVE
INTEGER, PARAMETER :: d = 2 ! number of dimensions
INTEGER, PARAMETER :: L_0 = 4 ! after this adaptive grid kicks in, for L <= L_0 usual sparse grid
INTEGER, PARAMETER :: L_max = 9 ! maximum level
INTEGER, PARAMETER :: bound = 0 ! 0 -> for f = 0 at boundary
! 1 -> adding grid points at boundary
! 2 -> extrapolating close to boundary
INTEGER, PARAMETER :: max_error = 1
INTEGER, PARAMETER :: L2_error = 1
INTEGER, PARAMETER :: testing_sample = 1000000
REAL(8), PARAMETER :: eps = 0.01D0 ! epsilon for adaptive grid
END MODULE MOD_PARAMETERS
PROGRAM MAIN
USE MOD_PARAMETERS
IMPLICIT NONE
INTEGER, DIMENSION(d,d) :: ident
REAL(8), DIMENSION(d) :: xd
INTEGER, DIMENSION(2*d) :: temp
INTEGER, DIMENSION(:,:), ALLOCATABLE :: grid_index, temp_grid_index, grid_index_new, J_index
REAL(8), DIMENSION(:), ALLOCATABLE :: coeff, temp_coeff, J_coeff
REAL(8) :: temp_min, temp_max, V, T, B, F, x1
INTEGER :: k, k_1, k_2, h, i, j, L, n, dd, L1, L2, dsize, count, first, repeated, add, ind
INTEGER :: time1, time2, clock_rate, clock_max
REAL(8), DIMENSION(L_max,L_max,2**(L_max),2**(L_max)) :: coeff_grid
INTEGER, DIMENSION(d) :: level, LL, ii
REAL(8), DIMENSION(testing_sample,d) :: x_rand
REAL(8), DIMENSION(testing_sample) :: interp1, interp2
! ============================================================================
! EXECUTABLE
! ============================================================================
ident = 0
DO i = 1,d
ident(i,i) = 1
ENDDO
! Initial grid point
dsize = 1
ALLOCATE(grid_index(dsize,2*d),grid_index_new(dsize,2*d))
grid_index(1,:) = 1
grid_index_new = grid_index
ALLOCATE(coeff(dsize))
xd = (/ 0.5D0, 0.5D0 /)
CALL FF(xd,coeff(1))
CALL FF(xd,coeff_grid(1,1,1,1))
L = 1
n = SIZE(grid_index_new,1)
ALLOCATE(J_index(n*2*d,2*d))
ALLOCATE(J_coeff(n*2*d))
CALL SYSTEM_CLOCK (time1,clock_rate,clock_max)
DO WHILE (L .LT. L_max)
L = L+1
n = SIZE(grid_index_new,1)
count = 0
first = 1
DEALLOCATE(J_index,J_coeff)
ALLOCATE(J_index(n*2*d,2*d))
ALLOCATE(J_coeff(n*2*d))
J_index = 0
J_coeff = 0.0D0
DO k = 1,n
DO i = 1,d
DO j = 1,2
IF ((bound .EQ. 0) .OR. (bound .EQ. 2)) THEN
temp = grid_index_new(k,:)+(/ident(i,:),ident(i,:)*(grid_index_new(k,d+i)-(-1)**j)/)
ELSEIF (bound .EQ. 1) THEN
IF (grid_index_new(k,i) .EQ. 1) THEN
temp = grid_index_new(k,:)+(/ident(i,:),ident(i,:)*(-(-1)**j)/)
ELSE
temp = grid_index_new(k,:)+(/ident(i,:),ident(i,:)*(grid_index_new(k,d+i)-(-1)**j)/)
ENDIF
ENDIF
CALL XX(d,temp(1:d),temp(d+1:2*d),xd)
temp_min = MINVAL(xd)
temp_max = MAXVAL(xd)
IF ((temp_min .GE. 0.0D0) .AND. (temp_max .LE. 1.0D0)) THEN
IF (first .EQ. 1) THEN
first = 0
count = count+1
J_index(count,:) = temp
V = 0.0D0
DO k_1 = 1,SIZE(grid_index,1)
T = 1.0D0
DO k_2 = 1,d
CALL XX(1,temp(k_2),temp(d+k_2),x1)
CALL BASE(x1,grid_index(k_1,k_2),grid_index(k_1,k_2+d),B)
T = T*B
ENDDO
V = V+coeff(k_1)*T
ENDDO
CALL FF(xd,F)
J_coeff(count) = F-V
ELSE
repeated = 0
DO h = 1,count
IF (SUM(ABS(J_index(h,:)-temp)) .EQ. 0) THEN
repeated = 1
ENDIF
ENDDO
IF (repeated .EQ. 0) THEN
count = count+1
J_index(count,:) = temp
V = 0.0D0
DO k_1 = 1,SIZE(grid_index,1)
T = 1.0D0
DO k_2 = 1,d
CALL XX(1,temp(k_2),temp(d+k_2),x1)
CALL BASE(x1,grid_index(k_1,k_2),grid_index(k_1,k_2+d),B)
T = T*B
ENDDO
V = V+coeff(k_1)*T
ENDDO
CALL FF(xd,F)
J_coeff(count) = F-V
ENDIF
ENDIF
ENDIF
ENDDO
ENDDO
ENDDO
ALLOCATE(temp_grid_index(dsize,2*d))
ALLOCATE(temp_coeff(dsize))
temp_grid_index = grid_index
temp_coeff = coeff
DEALLOCATE(grid_index,coeff)
ALLOCATE(grid_index(dsize+count,2*d))
ALLOCATE(coeff(dsize+count))
grid_index(1:dsize,:) = temp_grid_index
coeff(1:dsize) = temp_coeff
DEALLOCATE(temp_grid_index,temp_coeff)
grid_index(dsize+1:dsize+count,:) = J_index(1:count,:)
coeff(dsize+1:dsize+count) = J_coeff(1:count)
dsize = dsize + count
DO i = 1,count
coeff_grid(J_index(i,1),J_index(i,2),J_index(i,3),J_index(i,4)) = J_coeff(i)
ENDDO
IF (L .LE. L_0) THEN
DEALLOCATE(grid_index_new)
ALLOCATE(grid_index_new(count,2*d))
grid_index_new = J_index(1:count,:)
ELSE
add = 0
DO h = 1,count
IF (ABS(J_coeff(h)) .GT. eps) THEN
add = add + 1
J_index(add,:) = J_index(h,:)
ENDIF
ENDDO
DEALLOCATE(grid_index_new)
ALLOCATE(grid_index_new(add,2*d))
grid_index_new = J_index(1:add,:)
ENDIF
ENDDO
CALL SYSTEM_CLOCK (time2,clock_rate,clock_max)
PRINT *, 'Elapsed real time1 = ', DBLE(time2-time1)/DBLE(clock_rate)
PRINT *, 'Grid Points = ', SIZE(grid_index,1)
! ============================================================================
! Compute interpolated values:
! ============================================================================
CALL RANDOM_NUMBER(x_rand)
CALL SYSTEM_CLOCK (time1,clock_rate,clock_max)
DO i = 1,testing_sample
V = 0.0D0
DO L1=1,L_max
DO L2=1,L_max
IF (L1+L2 .LE. L_max+1) THEN
level = (/L1,L2/)
T = 1.0D0
DO dd = 1,d
T = T*(1.0D0-ABS(x_rand(i,dd)/2.0D0**(-DBLE(level(dd)))-DBLE(2*FLOOR(x_rand(i,dd)*2.0D0**DBLE(level(dd)-1))+1)))
ENDDO
V = V + coeff_grid(L1,L2,2*FLOOR(x_rand(i,1)*2.0D0**DBLE(L1-1))+1,2*FLOOR(x_rand(i,2)*2.0D0**DBLE(L2-1))+1)*T
ENDIF
ENDDO
ENDDO
interp2(i) = V
ENDDO
CALL SYSTEM_CLOCK (time2,clock_rate,clock_max)
PRINT *, 'Elapsed real time2 = ', DBLE(time2-time1)/DBLE(clock_rate)
END PROGRAM
For any 5 dimensional index I need to obtain the associated
coefficient, without knowing or calculating i. For instance, given
[2,4,8,16,32] I need to obtain 3.0 without computing i.
function findloc_vector(matrix, vector) result(out)
integer, intent(in) :: matrix(:, :)
integer, intent(in) :: vector(size(matrix, dim=2))
integer :: out, i
do i = 1, size(matrix, dim=1)
if (all(matrix(i, :) == vector)) then
out = i
return
end if
end do
stop "No match for this vector"
end
And that's how you use it:
print*, coeff(findloc_vector(index, [2,4,8,16,32])) ! outputs 3.0
I must confess I was reluctant to post this code because, even though this answers your question, I honestly think this is not what you really want/need, but you dind't provide enough information for me to know what you really do want/need.
Edit (After actual code from OP):
If I decrypted your code correctly (and considering what you said in your previous question), you are declaring:
REAL(8), DIMENSION(L_max,L_max,2**(L_max),2**(L_max)) :: coeff_grid
(where L_max = 9, so size(coeff_grid) = 21233664 =~160MB) and then populating it with:
DO i = 1,count
coeff_grid(J_index(i,1),J_index(i,2),J_index(i,3),J_index(i,4)) = J_coeff(i)
ENDDO
(where count is of the order of 1000, i.e. 0.005% of its elements), so this way you can fetch the values by its 4 indices with the array notation.
Please, don't do that. You don't need a sparse matrix in this case either. The new approach you proposed is much better: storing the indices in each row of an smaller array, and fetching on the array of coefficients by the corresponding location of those indices in its own array. This is way faster (avoiding the large allocation) and much more memory-efficient.
PS: Is it mandatory for you to stick to Fortran 90? Its a very old version of the standard and chances are that the compiler you're using implements a more recent version. You could improve the quality of your code a lot with the intrinsic move_alloc (for less array copies), the kind constants from the intrinsic module iso_fortran_env (for portability), the [], >, <, <=,... notation (for readability)...
I want to do a fixed calculation step for multiple .dat files.
Here is my code for what I want to do with one .dat file i.e. the calculation:
dimension t(128716),x(128716)
open (unit=88,file='ALFA-gua-100m-2.dat',status='unknown')
do i=1,128716
read(88,*)t(i),x(i)
enddo
sum=0
do j=1,128716
sum=sum+x(j)
enddo
write(*,*)sum/128716
close(88)
stop
end
How do I go about this? Please suggest!
Here is my code for multiple file :
dimension t(128716),x(128716)
open (unit=11,file='ALFA-gua-100m-2.dat',status='unknown')
open (unit=12,file='ALFA-gua-100m-5.dat',status='unknown')
do i=1,2
ii = i + 10
do j=1,128716
read(ii,*)t(j),x(j)
enddo
sum=0
do k=1,128716
sum=sum+x(k)
enddo
enddo
do l=1,2
ll = l + 10
write(ll,*)sum/128716.0
close(ll)
enddo
stop
end
But its not working.
An addendum to #VladimirF's answer.
To sum all the elements in an array called x we can simply write
sumx = sum(x)
there is no need for the programmer to write a loop at all. If using an array of sums, then something like
sums(1) = sum(x)
would be appropriate.
Then to calculate the mean of an array I'd write
meanx = sum(x)/size(x)
While I'm writing: it's not a good idea to call a variable sum. There's an existing intrinsic function of that name and it will only confuse readers (though not the compiler) to have a variable of that name too.
You cannot use the same sum for two iterations of the i loop when you have two separate loops. It will get overwritten when processing the second file.
You can join the loops into one.
do i=1,2
ii = i + 10
do j=1,128716
read(ii,*)t(j),x(j)
enddo
sum=0
do k=1,128716
sum=sum+x(k)
enddo
write(ii,*)sum/128716.0
close(ii)
enddo
You can use an array for the sums sums(i).
do i=1,2
ii = i + 10
do j=1,128716
read(ii,*)t(j),x(j)
enddo
sum=0
do k=1,128716
sums(i)=sums(i)+x(k)
enddo
enddo
do l=1,2
ll = l + 10
write(ll,*)sums(l)/128716.0
close(ll)
enddo
My goal is to create 10,000 randomly generated numbers between 0 and 1, organize them into ten bins evenly spaced between 0 and 1, and compute a frequency for each bin. This is my code so far.
program listrand
implicit none
integer :: n,p
integer :: a,b,c,d,e,f,g,h,i,j = 0
real :: xran
!real, dimension(10,2) :: bin_and_freq -- list of bins and frequency
do n = 1,10000
call random_number(xran)
if (xran < 0.1) then
a = a + 1
elseif (xran>0.1 .and. xran<0.2) then
b = b + 1
elseif (xran>0.2 .and. xran<0.3) then
c = c+1
elseif (xran>0.3 .and. xran<0.4) then
d = d+1
elseif (xran>0.4 .and. xran<0.5) then
e = e + 1
elseif (xran>0.5 .and. xran<0.6) then
f = f+1
elseif (xran>0.6 .and. xran<0.7) then
g = g+1
elseif (xran>0.7 .and. xran<0.8) then
h=h+1
elseif (xran>0.8 .and. xran<0.9) then
i=i+1
else
j = j+1
endif
enddo
print *, a,b,c,d,e,f,g,h,i,j
end program listrand
I am getting an unexpected output:
988 1036 133225987 1004 934 986 1040 33770 1406729616 1052.
Why are c,h, and i so large? Also, is there a more efficient way of going about this than using the unwieldy IF/ELSEIF block I have?
In your long
integer :: a,b,c,d,e,f,g,h,i,j = 0
You are only initialising j to be 0, all others have random numbers in them. If you add
a = 0
b = 0
c = 0
d = 0
e = 0
f = 0
g = 0
h = 0
i = 0
j = 0
before your loop, everything works well.
As for how to simplify it:
Here is my version of the program:
program listrand
implicit none
integer, parameter :: nbins = 10
integer :: n, bin
integer :: bin_hits(nbins) ! Number of bin hits
real :: xran
real :: bin_lower(nbins) ! Lower edge of bins
! bin_lower(1) == 0.0
bin_hits = 0
! Set up equidistant bins
bin_lower = [ (real(n-1) / nbins, n = 1, size(bin_lower)) ]
do n = 1,10000
call random_number(xran)
bin = count(bin_lower <= xran)
bin_hits(bin) = bin_hits(bin)+1
enddo
do n = 1, nbins-1
print '(2(F6.2), I6)' bin_lower(n), bin_lower(n+1), bin_hits(n)
end do
print '(2(F6.2), I6)' bin_lower(nbins), 1.0, bin_hits(nbins)
end program listrand
For the index of which bin_hits element to increment, I'm counting the number of values in bin_lower that are actually lower than xran.
EDIT
I'd like to also point to the answer from High Performance Mark a bit further down, who instead of calling RANDOM_NUMBER for each value individually uses it to generate a whole array of random numbers.
Additionally, he's using the fact that the bins are fixed and equidistant to calculate the bin number directly from the random value instead of comparing it to each bin as in my version.
Both of these make the program faster.
If speed of execution is one's main concern, and if one is willing to trade space for time, this might appeal:
PROGRAM listrand
IMPLICIT NONE
INTEGER, PARAMETER :: nbins = 10
INTEGER, PARAMETER :: nsamples = 10**4
INTEGER :: bin_hits(0:nbins-1)
REAL :: xran(nsamples)
INTEGER :: binned_rn(nsamples), n
bin_hits = 0
CALL RANDOM_NUMBER(xran)
binned_rn = INT(nbins*xran)
DO n = 1, nsamples
bin_hits(binned_rn(n)) = bin_hits(binned_rn(n)) +1
END DO
WRITE(*,*) bin_hits
END PROGRAM listrand
In a limited number of tests this version is 3 - 4 times as fast as #chw21's version.
I need some technical help in modifying my FORTRAN coding. I have searched the Internet but I can't fine one which can solve my need.
Basically I am analyzing simulation data using FORTRAN program. Firstly, I shall explain the format of my data to make easy the understanding of what I want. I have 10 files. Each file contains x, y z, data for 1000 frames and each frame contains 20736 (x,y,z) data. Since the total size of all data is about 10 GB for all 10,000 frames, I have to break them into small chunks (10 files) to avoid any crash during calculation. At the beginning of each file (first line) there is a text which can be neglected and each frame ending with information of the box size (bx,by,bz). This is the format of my data files.
I have attached the coding which I have been using for analysis.
The current codding will do calculation file after file and frame after frame in the sequential order. But now I want to do the calculation on selected frames only by jumping frame after frame with certain pattern. For example, I choose frame 1, 4, 8, 12, 16.... and so on until the last frame (10,000).
I have no idea how to choose the frames which are more then 1000 which fall in the second or third files.
I have shown my code below:
module all_parameter
integer,parameter :: MAXATOM=20736
integer,parameter :: nat = 20736
integer, parameter :: startFiles=31
integer, parameter :: endFiles=40
integer,parameter :: NO_OF_FILES=10
integer,parameter :: FRAMES_IN=1000
integer, parameter :: totalFrames = ( NO_OF_FILES * FRAMES_IN )
integer :: i, j, k, IFram, nhb, nlipid, jjj
integer :: BIN, iat, jat
!real :: DELR, fnid, GNRM, RCUT, rlower, rupper
real :: junk, dR, bx, by, bz, bbx
real :: only_head, only_tail, only_water
real :: mass_head, mass_tail, mass_water
character*4 at(MAXATOM)
real,dimension(MAXATOM) :: x, y, z
real,dimension(3) :: rcm
real,dimension(MAXATOM) :: rx, ry, rz
real,dimension(MAXATOM) :: mass
integer, parameter :: startlipid=1
integer, parameter :: endlipid=64
integer, parameter :: lipidNo=64
real, parameter :: PI = (22.0/7.0)
real, dimension(startlipid:endlipid) :: array_UniVekLx, array_UniVekLy, array_UniVekLz
integer :: no, no2, c71, c72, c80, c81
real :: p1x, p1y, p1z, p2x, p2y, p2z, vekx, veky, vekz
real :: mag_vekp1p2, unit_vekx, unit_veky, unit_vekz
real :: sum_UniVekLx, sum_UniVekLy, sum_UniVekLz
real :: avg_frame_vekx, avg_frame_veky, avg_frame_vekz
real :: xx, yy, zz, frame_MagLipVek, theta,theta2, uni_frame_Vekx, uni_frame_Veky, uni_frame_Vekz
real :: xxx, yyy, zzz,UniVekLx, UniVekLy, UniVekLz, FrameAvgUniVekMag
real :: avg_UniVekLx, avg_UniVekLy,avg_UniVekLz, MagLipVek
end module all_parameter
PROGRAM order_parameter
use all_parameter
implicit none
!=========================================================================
! Open files to be read and to write on
!=========================================================================
!
! Topology file !CHANGE
open(unit=31,status="old",file="../malto_thermoNEW_Ori_50ns-set1.traj ")
open(unit=32,status="old",file="../malto_thermoNEW_Ori_50ns-set2.traj ")
open(unit=33,status="old",file="../malto_thermoNEW_Ori_50ns-set3.traj ")
open(unit=34,status="old",file="../malto_thermoNEW_Ori_50ns-set4.traj ")
open(unit=35,status="old",file="../malto_thermoNEW_Ori_50ns-set5.traj ")
open(unit=36,status="old",file="../malto_thermoNEW_Ori_50ns-set6.traj ")
open(unit=37,status="old",file="../malto_thermoNEW_Ori_50ns-set7.traj ")
open(unit=38,status="old",file="../malto_thermoNEW_Ori_50ns-set8.traj ")
open(unit=39,status="old",file="../malto_thermoNEW_Ori_50ns-set9.traj ")
open(unit=40,status="old",file="../malto_thermoNEW_Ori_50ns-set10.traj ")
! Open New Files
open(unit=51,status="unknown",file="BOXinfo.dat ")
open(unit=75,status="unknown",file="magnitude_theta_lipid-thermo-malto.dat")
do k = startlipid, endlipid
array_UniVekLx(k) =0.0
array_UniVekLy(k) =0.0
array_UniVekLz(k) =0.0
end do
! READ COORDINATES IN FRAMES FROM TRAJ file
INPUTFILES: do jjj = startFiles, endFiles
! LOOP OVER FRAMES
IFram = 1
read(jjj,'(a)') junk
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!IFram = 1
WHOLE: do while ( IFram <= FRAMES_IN)
read(jjj,'(10F8.3)') (x(i),y(i),z(i),i = 1,nat) ! reading TRAJ file
read(jjj,'(3F8.3)') bx,by,bz
write(51,'(a,3F8.3)') 'BOXINFO', bx,by,bz
! LOOP OVER ATOMS
loop1: do j = startlipid, endlipid !nat in lipids
loop2: do i = 45, 45 !,3 !atoms in a lipid
no= i + (j-1)*81
!no2= (no + 18)
c71=no
c72=(no+3)
p1x=((x(c71) + x(c72))/2.0 )
p1y=((y(c71) + y(c72))/2.0 )
p1z=((z(c71) + z(c72))/2.0 )
.
.
.
.
enddo loop2 ! going to next lipid
!CLOSE LOOP OVER ATOMS
enddo loop1 ! going to next frame , before that
!CLOSE LOOP OVER A FRAME
IFram = IFram + 1
enddo WHOLE
!CLOSE LOOP OVER ALL FILES
enddo INPUTFILES
end program order_parameter
I really appreciate your help in advance.
Thanks.
Well, in the loop, unless mod(framenumber, 4) == 0 skip to the next iteration (the CYCLE statement does that in Fortran). That way, you'll process only every fourth frame.
Also, you way want to use a somewhat more precise value for PI. 22/7, WTF?
Obviously the program needs to know which file it is reading, 1, 2... 10. Call that ifile. Then the frame with the file, say frame_in_file. Then you have frame = (ifile-1) * frame_in_file. Do you have a rule to decide whether you want to process "frame"? If the rule is to process every fourth, use mod and cycle as suggested #janneb. Otherwise, I'm not sure what you are asking.
With ten files, it would be easier to write the filename to a string and process them with a loop, opening each file in turn with the same unit number and closing at the end of the loop. This would be a little easier if you used the convention that the number in the file name was always two digits, with a leading zero if less than 10:
do ifile=1, 10
write (filename, '( "myfile_number", I2.2, ".data" )' ) ifile
open (unit=30, file=filename, ...)
loop: read from the file...
calculate overall frame number ...
cycle out of read loop if unsuitable frame...
process the frame...
end read loop
close (unit=30)
end do