I'm trying to read in multiple files in a loop but it appears my code reads the files each time which makes it slow. I have included a flag to read the files the first time only but it doesn't seem to work. How do I make the code faster?
program readfiles
use variables
use trilinear
implicit none
real:: coord(1448,27), inner_coord(1448,3), interpolated_array(1448) !
integer :: i, j, N, zeta, lam, k, l, m, row, inner_row, max_rows
Logical :: first_time = .True.
CHARACTER(len=100) :: FN
type(string) :: array(3)
N=3 !--arbitrary number of files
array(1)%str = '2e8'
array(2)%str = '2e9'
array(3)%str = '3e9'
if(first_time) then
max_rows=1448
do row=1, max_rows
lam = 80
DO I=1,N
lam = lam + 60
zeta=20
do j=1,N
zeta = zeta + 20
do k=1,N
WRITE(FN,10)lam, zeta, (array(k)%str)!,k=1,N)
OPEN(99,FILE=FN, action='read', status='old', position='rewind')!open the file to read
do inner_row=1,max_rows
read (99,*) (inner_coord(inner_row,l),l=1,3)!coorda, coordb, coordc
enddo
coord(:,9*I+3*j+k-12)=inner_coord(:,3)
CLOSE(99) !this ensures it closes d file it is reading from so a new one can b opened for reading
enddo
enddo
END DO
ENDDO
10 FORMAT('4e3_2048_',(I3.0),'_',(I2.2),'_',(A3),'.ksz_cl.txt') !length of this is decided by FN
first_time = .False.
endif
print *, first_time
interpolated_array = trilinear_mod(150.0,70.0,2000000000.0,coord)
open (unit=96, file='interpolated_array.txt') !This bit flattens the array
do m = 1,max_rows
write(96,'(30f16.13)') interpolated_array(m) !'(27f13.10)'
enddo
end program readfiles
I could be wrong but seems to me that you are doing your loop in inefficient way. You open file and move to the end of the file reading line by line and only use last read (1448 times, too much). Instead I would rid off outer loop (with row index) and move coord(:,9*I+3*j+k-12)=inner_coord(:,3) inside of the loop above and put under read.
My fortran is rusty but i think it should look like:
if(first_time) then
OPEN(99,FILE=FN, action='read', status='old', position='rewind')
do inner_row=1,max_rows
read (99,*) (inner_coord(inner_row,l),l=1,3)!coorda, coordb, coordc
coord(:,9*I+3*j+k-12)=inner_coord(:,3)
CLOSE(99)
enddo
first_time=.false.
enddo
Related
I am currently accelerating a Fortran code where I have a main accelerated loop in subroutine sub. In the loop, I want to call subroutine subsub on the device with acc routine. The subroutine has an intent(out) argument val, which is private in the loop. As subsub has a loop itself, I want to use the vector clause:
module calc
implicit none
public :: sub
private
contains
subroutine sub()
integer :: i
integer :: array(10)
integer :: val
!$acc kernels loop independent private(val)
do i = 1, 10
call subsub(val)
array(i) = val
enddo
print "(10(i0, x))", array
endsubroutine
subroutine subsub(val)
!$acc routine vector
integer, intent(out) :: val
integer :: i
val = 0
!$acc loop independent reduction(+:val)
do i = 1, 10
val = val + 1
enddo
endsubroutine
endmodule
program test
use calc, only: sub
implicit none
call sub()
endprogram
When compiling with the PGI compiler version 20.9-0 and running the program, I get gibberish values in variable array. When I simply use acc routine for subsub, I get the correct behavior (10 in all values of array). What is wrong in my approach to parallelize this subroutine?
It does look like a compiler code generation issue on how val is getting handled in the main loop. Luckily the workaround is easy, just add the installation of val in the main loop.
% cat test.f90
module calc
implicit none
public :: sub
private
contains
subroutine sub()
integer :: i
integer :: array(10)
integer :: val
!$acc kernels loop independent private(val)
do i = 1, 10
val = 0
call subsub(val)
array(i) = val
enddo
print "(10(i0, x))", array
endsubroutine
subroutine subsub(val)
!$acc routine vector
integer, intent(out) :: val
integer :: i
val = 0
!$acc loop independent reduction(+:val)
do i = 1, 10
val = val + 1
enddo
endsubroutine
endmodule
program test
use calc, only: sub
implicit none
call sub()
endprogram
% nvfortran -acc -Minfo=accel test.f90 -V20.9 ; a.out
sub:
10, Generating implicit copyout(array(:)) [if not already present]
11, Loop is parallelizable
Generating Tesla code
11, !$acc loop gang ! blockidx%x
subsub:
18, Generating Tesla code
24, !$acc loop vector ! threadidx%x
Generating reduction(+:val)
Vector barrier inserted for vector loop reduction
24, Loop is parallelizable
10 10 10 10 10 10 10 10 10 10
I'm trying to learn Fortran (unfortunately a necessity for my research group) - one of the tasks I set myself was to package one of the necessary functions (Associated Legendre polynomials) from the Numerical Recipes book into a fortran 03 compliant module. The original program (f77) has some error handling in the form of the following:
if(m.lt.0.or.m.gt.1.or.abs(x).gt.1)pause 'bad arguments in plgndr'
Pause seems to have been deprecated since f77 as using this line gives me a compiling error, so I tried the following:
module sha_helper
implicit none
public :: plgndr, factorial!, ylm
contains
! numerical recipes Associated Legendre Polynomials rewritten for f03
function plgndr(l,m,x) result(res_plgndr)
integer, intent(in) :: l, m
real, intent(in) :: x
real :: res_plgndr, fact, pll, pmm, pmmp1, somx2
integer :: i,ll
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
res_plgndr=-10e6 !return a ridiculous value
else
pmm = 1.
if (m.gt.0) then
somx2 = sqrt((1.-x)*(1.+x))
fact = 1.
do i = 1, m
pmm = -pmm*fact*somx2
fact = fact+2
end do
end if
if (l.eq.m) then
res_plgndr = pmm
else
pmmp1 = x*(2*m+1)*pmm
if(l.eq.m+1) then
res_plgndr = pmmp1
else
do ll = m+2, l
pll = (x*(2*ll-1)*pmmp1-(ll+m-1)*pmm)/(ll-m)
pmm = pmmp1
pmmp1 = pll
end do
res_plgndr = pll
end if
end if
end if
end function plgndr
recursive function factorial(n) result(factorial_result)
integer, intent(in) :: n
integer, parameter :: RegInt_K = selected_int_kind(20) !should be enough for the factorials I am using
integer (kind = RegInt_K) :: factorial_result
if (n <= 0) then
factorial_result = 1
else
factorial_result = n * factorial(n-1)
end if
end function factorial
! function ylm(l,m,theta,phi) result(res_ylm)
! integer, intent(in) :: l, m
! real, intent(in) :: theta, phi
! real :: res_ylm, front_block
! real, parameter :: pi = 3.1415926536
! front_block = sqrt((2*l+1)*factorial(l-abs(m))/(4*pi*))
! end function ylm
end module sha_helper
The main code after the else works, but if I execute my main program and call the function with bad values, the program freezes before executing the print statement. I know that the print statement is the problem, as commenting it out allows the function to execute normally, returning -10e6 as the value. Ideally, I would like the program to crash after giving a user readable error message, as giving bad values to the plgndr function is a fatal error for the program. The function plgndr is being used by the program sha_lmc. Currently all this does is read some arrays and then print a value of plgndr for testing (early days). The function ylm in the module sha_helper is also not finished, hence it is commented out. The code compiles using gfortran sha_helper.f03 sha_lmc.f03 -o sha_lmc, and
gfortran --version
GNU Fortran (GCC) 4.8.2
!Spherical Harmonic Bayesian Analysis testbed for Lagrangian Dynamical Monte Carlo
program sha_analysis
use sha_helper
implicit none
!Analysis Parameters
integer, parameter :: harm_order = 6
integer, parameter :: harm_array_length = (harm_order+1)**2
real, parameter :: coeff_lo = -0.1, coeff_hi = 0.1, data_err = 0.01 !for now, data_err fixed rather than heirarchical
!Monte Carlo Parameters
integer, parameter :: run = 100000, burn = 50000, thin = 100
real, parameter :: L = 1.0, e = 1.0
!Variables needed by the program
integer :: points, r, h, p, counter = 1
real, dimension(:), allocatable :: x, y, z
real, dimension(harm_array_length) :: l_index_list, m_index_list
real, dimension(:,:), allocatable :: g_matrix
!Open the file, allocate the x,y,z arrays and read the file
open(1, file = 'Average_H_M_C_PcP_boschi_1200.xyz', status = 'old')
read(1,*) points
allocate(x(points))
allocate(y(points))
allocate(z(points))
print *, "Number of Points: ", points
readloop: do r = 1, points
read(1,*) x(r), y(r), z(r)
end do readloop
!Set up the forwards model
allocate(g_matrix(harm_array_length,points))
!Generate the l and m values of spherical harmonics
hloop: do h = 0, harm_order
ploop: do p = -h,h
l_index_list(counter) = h
m_index_list(counter) = p
counter = counter + 1
end do ploop
end do hloop
print *, plgndr(1,2,0.1)
!print *, ylm(1,1,0.1,0.1)
end program sha_analysis
Your program does what is known as recursive IO - the initial call to plgndr is in the output item list of an IO statement (a print statement) [directing output to the console] - inside that function you then also attempt to execute another IO statement [that outputs to the console]. This is not permitted - see 9.11p2 and p3 of F2003 or 9.12p2 of F2008.
A solution is to separate the function invocation from the io statement in the main program, i.e.
REAL :: a_temporary
...
a_temporary = plgndr(1,2,0.1)
PRINT *, a_temporary
Other alternatives in F2008 (but not F2003 - hence the [ ] parts in the first paragraph) include directing the output from the function to a different logical unit (note that WRITE (*, ... and PRINT ... reference the same unit).
In F2008 you could also replace the WRITE statement with a STOP statement with a message (the message must be a constant - which wouldn't let you report the problematic values).
The potential for inadvertently invoking recursive IO is part of the reason that some programming styles discourage conducting IO in functions.
Try:
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
stop
else
...
end if
I have several input data files with the name angleFile1.dat, angleFile2.dat, angleFile3.dat and so on. (I have more than 100 files)
Each file contain 45000 data of angles. I want to group these angles to get a distribution within 0 to 360 degrees.
I have written a Fortran code to do the job for one file at a time.
This code will read in the input file "angleFile1.dat" and write the distribution (in bins) in the "angleOut.dat" file.
program binangle
implicit none
integer :: i, j, k
integer,parameter :: arr=45000
real,dimension(1:arr) :: aangle
integer,dimension(0:360) :: binaangle
do i = 0,360
binaangle(i) = 0.0
end do
!OPEN OUTPUT FILE
open(unit=49,status="unknown",file="angleOut.dat")
!OPEN INPUT FILE
open(unit=50,status="unknown",file="angleFile1.dat")
read(50,'(F8.3)') (aangle(i), i = 1,arr)
! DO THE BINNING
do j = 1, arr
binaangle(int(aangle(j))) = binaangle(int(aangle(j))) + 1
end do
! WRITE INTO OUTPUT FILE
do k = 0,360
write(49,*) k, " ", binaangle(k)
end do
How to make this code to recursively take in the input files (angleFile1.dat, angleFile2.dat, angleFile3.dat and say until angleFile100.dat) and write the distribution in the same output file?
Help is much appreciated.
Well, one way would be to split the reading into a separate subroutine. Something like (untested):
program binangle
implicit none
integer :: i, k
integer,parameter :: nfiles = 100 ! Use get_command_argument to read the
! value at runtime rather than hardcoded,
! left as an exercise to the reader
integer,dimension(361) :: binaangle
binaangle = 0 ! Use array op rather than manual loop
do i = 1, nfiles
call add_angles_to_bins(binaangle, i)
end do
!OPEN OUTPUT FILE
open(unit=49,status="replace",file="angleOut.dat")
! WRITE INTO OUTPUT FILE
do k = 1, ubound(binaangle, 1)
write(49,*) k - 1, " ", binaangle(k)
end do
contains
subroutine add_angles_to_bins(bins, fnum)
integer, intent(inout) :: bins(:)
integer, intent(in) :: fnum
character(len=200) :: fname
integer, parameter :: arr = 45000
real :: aangle(arr)
write(fname, '(A,I0,A)') 'angleFile', fnum, '.dat'
!OPEN INPUT FILE
open(unit=50,status="old",file=fname)
read(50,'(F8.3)') aangle
close(50)
! DO THE BINNING
do j = 1, arr
binaangle(int(aangle(j)) + 1) = binaangle(int(aangle(j)) + 1) + 1
end do
end program binangle
(One might add that the above suggested solution does not use recursion.)
I'm trying to learn Fortran (unfortunately a necessity for my research group) - one of the tasks I set myself was to package one of the necessary functions (Associated Legendre polynomials) from the Numerical Recipes book into a fortran 03 compliant module. The original program (f77) has some error handling in the form of the following:
if(m.lt.0.or.m.gt.1.or.abs(x).gt.1)pause 'bad arguments in plgndr'
Pause seems to have been deprecated since f77 as using this line gives me a compiling error, so I tried the following:
module sha_helper
implicit none
public :: plgndr, factorial!, ylm
contains
! numerical recipes Associated Legendre Polynomials rewritten for f03
function plgndr(l,m,x) result(res_plgndr)
integer, intent(in) :: l, m
real, intent(in) :: x
real :: res_plgndr, fact, pll, pmm, pmmp1, somx2
integer :: i,ll
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
res_plgndr=-10e6 !return a ridiculous value
else
pmm = 1.
if (m.gt.0) then
somx2 = sqrt((1.-x)*(1.+x))
fact = 1.
do i = 1, m
pmm = -pmm*fact*somx2
fact = fact+2
end do
end if
if (l.eq.m) then
res_plgndr = pmm
else
pmmp1 = x*(2*m+1)*pmm
if(l.eq.m+1) then
res_plgndr = pmmp1
else
do ll = m+2, l
pll = (x*(2*ll-1)*pmmp1-(ll+m-1)*pmm)/(ll-m)
pmm = pmmp1
pmmp1 = pll
end do
res_plgndr = pll
end if
end if
end if
end function plgndr
recursive function factorial(n) result(factorial_result)
integer, intent(in) :: n
integer, parameter :: RegInt_K = selected_int_kind(20) !should be enough for the factorials I am using
integer (kind = RegInt_K) :: factorial_result
if (n <= 0) then
factorial_result = 1
else
factorial_result = n * factorial(n-1)
end if
end function factorial
! function ylm(l,m,theta,phi) result(res_ylm)
! integer, intent(in) :: l, m
! real, intent(in) :: theta, phi
! real :: res_ylm, front_block
! real, parameter :: pi = 3.1415926536
! front_block = sqrt((2*l+1)*factorial(l-abs(m))/(4*pi*))
! end function ylm
end module sha_helper
The main code after the else works, but if I execute my main program and call the function with bad values, the program freezes before executing the print statement. I know that the print statement is the problem, as commenting it out allows the function to execute normally, returning -10e6 as the value. Ideally, I would like the program to crash after giving a user readable error message, as giving bad values to the plgndr function is a fatal error for the program. The function plgndr is being used by the program sha_lmc. Currently all this does is read some arrays and then print a value of plgndr for testing (early days). The function ylm in the module sha_helper is also not finished, hence it is commented out. The code compiles using gfortran sha_helper.f03 sha_lmc.f03 -o sha_lmc, and
gfortran --version
GNU Fortran (GCC) 4.8.2
!Spherical Harmonic Bayesian Analysis testbed for Lagrangian Dynamical Monte Carlo
program sha_analysis
use sha_helper
implicit none
!Analysis Parameters
integer, parameter :: harm_order = 6
integer, parameter :: harm_array_length = (harm_order+1)**2
real, parameter :: coeff_lo = -0.1, coeff_hi = 0.1, data_err = 0.01 !for now, data_err fixed rather than heirarchical
!Monte Carlo Parameters
integer, parameter :: run = 100000, burn = 50000, thin = 100
real, parameter :: L = 1.0, e = 1.0
!Variables needed by the program
integer :: points, r, h, p, counter = 1
real, dimension(:), allocatable :: x, y, z
real, dimension(harm_array_length) :: l_index_list, m_index_list
real, dimension(:,:), allocatable :: g_matrix
!Open the file, allocate the x,y,z arrays and read the file
open(1, file = 'Average_H_M_C_PcP_boschi_1200.xyz', status = 'old')
read(1,*) points
allocate(x(points))
allocate(y(points))
allocate(z(points))
print *, "Number of Points: ", points
readloop: do r = 1, points
read(1,*) x(r), y(r), z(r)
end do readloop
!Set up the forwards model
allocate(g_matrix(harm_array_length,points))
!Generate the l and m values of spherical harmonics
hloop: do h = 0, harm_order
ploop: do p = -h,h
l_index_list(counter) = h
m_index_list(counter) = p
counter = counter + 1
end do ploop
end do hloop
print *, plgndr(1,2,0.1)
!print *, ylm(1,1,0.1,0.1)
end program sha_analysis
Your program does what is known as recursive IO - the initial call to plgndr is in the output item list of an IO statement (a print statement) [directing output to the console] - inside that function you then also attempt to execute another IO statement [that outputs to the console]. This is not permitted - see 9.11p2 and p3 of F2003 or 9.12p2 of F2008.
A solution is to separate the function invocation from the io statement in the main program, i.e.
REAL :: a_temporary
...
a_temporary = plgndr(1,2,0.1)
PRINT *, a_temporary
Other alternatives in F2008 (but not F2003 - hence the [ ] parts in the first paragraph) include directing the output from the function to a different logical unit (note that WRITE (*, ... and PRINT ... reference the same unit).
In F2008 you could also replace the WRITE statement with a STOP statement with a message (the message must be a constant - which wouldn't let you report the problematic values).
The potential for inadvertently invoking recursive IO is part of the reason that some programming styles discourage conducting IO in functions.
Try:
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
stop
else
...
end if
I'm trying to write a code in Fortran that generates that given the following input 1,2,3 generates the permutations with repetition:
111
112
113
121
122
123
.
.
.
Obviously there will be 3^3 = 27 (n^k) combinations. Does anyone know the algorithm that generates something like this?
Here is one solution:
module perm_mod
contains
subroutine print_permutations(A)
implicit none
integer,intent(in) :: A(:)
integer :: i, j, l, remainder
integer :: idx(size(A,1)), stride(size(A,1))
l = size(A,1)
stride(1) = 1
do i=2,l
stride(i) = stride(i-1)*l
enddo ! i
do i=0,l**l-1
remainder = i
do j=l,1,-1
idx(j) = remainder / stride(j)
remainder = remainder - idx(j)*stride(j)
enddo ! j
print *,A(idx+1)
enddo ! i
end subroutine
end module
program perm
use perm_mod
implicit none
integer,parameter :: A(3) = [ 1, 2, 3 ]
call print_permutations(A)
end program