Related
Let's say I want to perform an operation in my main program (in Fortran). And lets say that operation is finding minimum number in a 1D array. I wish to do so by passing the array into the call subroutine and the subroutine will print the minimum value on the screen. There are different ways or algorithms to find minimum value in an array. Lets say I have 100 different methods: Method1, Method2..... Method100. Now I want to try using each one of these methods separately (I don't want to try all of them at once, but one method in each run). I don't want to create 100 different subroutines and change the code every time to decide which one to call, rather I want to mention in the input file which one I want to choose. So basically, the computer has to read the input file (to know which method to use) and perform the task using the specified method amongst different methods available.
I can write a Subroutine dump all the methods into that subroutine and put an IF condition to choose among various methods. But IF conditions are in efficient particularly on GPUs, I want to know the most efficient way of doing this.
MAIN PROGRAM
INTEGER Method !will be read from input file
Array = [12,5,3,4,1,7,4,3]
call print_Minimum(Array)
END PROGRAM
SUBROUTINE print_Minimum(Array)
IF (METHOD == 1)
<method 1 code>
ELSE IF (METHOD == 2)
<method 2 code>
:
:
:
:
ELSE IF (METHOD == 100)
<method100 code>
END IF
END SUBROUTINE
Thanks in advance.
This is probably best done using a function pointer and/or functions as arguments.
You can set a function pointer to a certain function and do this in your nested ifs and you can pass functions as arguments.
Both methods are implemented in the following example.
module minimum_mod
implicit none
private
public :: get_min_t, naive_min, time_min_function
abstract interface
integer pure function get_min_t(X)
integer, intent(in) :: X(:)
end function
end interface
contains
subroutine time_min_function(f, X)
procedure(get_min_t) :: f
integer, intent(in) :: X(:)
integer :: res
res = f(X)
write(*, *) res
end subroutine
integer pure function naive_min(X)
integer, intent(in) :: X(:)
integer :: i
naive_min = huge(naive_min)
do i = 1, size(X)
naive_min = min(naive_min, X(i))
end do
end function
end module
program time_min_finders
use minimum_mod, only: get_min_t, naive_min, time_min_function
implicit none
integer, parameter :: test_set(5) = [1, 10, 3, 5, 7]
procedure(get_min_t), pointer :: f
f => naive_min
call time_min_function(f, test_set)
end program
PS: Note that you can now do all the timinig logic inside time_min_function.
You can create an array of a derived type that contains a function pointer, effectively an array of function pointers. Then in principle you could initialize the function pointers to point at all of your test functions so that you could refer to each function by its index without having to test with a SELECT CASE of IF block: this is the typical Fortran way. However, either I've got the syntax for initialization wrong or my old version of gfortran just isn't capable, so I had to initialize one at a time. Sigh.
module minfuncs
implicit none
abstract interface
function func(array)
integer, intent(in) :: array(:)
integer func
end function func
end interface
type func_node
procedure(func), NOPASS, pointer :: f
end type func_node
! type(func_node) :: method(5) = [func_node(min_1),func_node(min_2), &
! func_node(min_3),func_node(min_4),func_node(min_5)]
contains
function min_1(array)
integer, intent(in) :: array(:)
integer min_1
integer i
min_1 = array(1)
do i = 2, size(array)
min_1 = min(min_1,array(i))
end do
end function min_1
function min_2(array)
integer, intent(in) :: array(:)
integer min_2
integer i
min_2 = array(1)
do i = 8, size(array), 7
min_2 = min(min_2,array(i-6),array(i-5),array(i-4), &
array(i-3),array(i-2),array(i-1),array(i))
end do
do i = i-6, size(array)
min_2 = min(min_2, array(i))
end do
end function min_2
function min_3(array)
integer, intent(in) :: array(:)
integer min_3
integer i
min_3 = array(1)
do i = 2, size(array)
min_3 = min_3-dim(min_3,array(i))
end do
end function min_3
function min_4(array)
integer, intent(in) :: array(:)
integer min_4
integer ymm(8)
integer i
if(size(array) >= 8) then
ymm = array(1:8)
do i = 16, size(array), 8
ymm = min(ymm,array(i-7:i))
end do
min_4 = minval([ymm,array(i-7:size(array))])
else
min_4 = minval(array)
end if
end function min_4
function min_5(array)
integer, intent(in) :: array(:)
integer min_5
min_5 = minval(array)
end function min_5
end module minfuncs
program test
use minfuncs
implicit none
integer, parameter :: N = 75
integer i
integer :: A(N) = modulo(5*[(i,i=1,N)]**2,163)
! type(func_node) :: method(5) = [func_node(min_1),func_node(min_2), &
! func_node(min_3),func_node(min_4),func_node(min_5)]
type(func_node) method(5)
method(1)%f => min_1
method(2)%f => min_2
method(3)%f => min_3
method(4)%f => min_4
method(5)%f => min_5
do i = 1, size(method)
write(*,*) method(i)%f(A)
end do
end program test
Output:
2
2
2
2
2
The solution for this double integration is -0.083 but in the final compliation it appears -Infinity. It seems that the error is very simple, but I really can't find it.
I have been searching specially in the module section but I don't see why it appears like -Infinity. For example, if you change the two functions between them (x in f2 and x^2 in f1) the solution for the integration is 0.083 and the code gives it correct. Can annyone find the error? Thanks a lot.
module funciones
contains
function f(x,y)
implicit none
real*8:: x,y,f
f=2d0*x*y
end function
function f1(x)
real*8::x,f1
f1=x
end function
function f2(x)
real*8::x,f2
f2=x**2d0
end function
function g(x,c,d,h)
implicit none
integer::m,j
real*8::x,y,c,d,k,s,h,g
m=nint(((d-c)/h)+1d0)
k=(d-c)/dble(m)
s=0.
do j=1d0,m-1d0
y=c+dble(j)*k
s=s+f(x,y)
end do
g=k*(0.5d0*(f(x,c)+f(x,d))+s)
return
end function
subroutine trapecio(a,b,n,integral)
implicit none
integer::n,i
real*8::a,b,c,d,x,h,s,a1,a2,b1,b2,integral
h=(b-a)/dble(n)
s=0d0
do i=1d0,n-1d0
x=a+dble(i)*h
c=f1(x)
d=f2(x)
s=s+g(x,c,d,h)
end do
a1=f1(a)
a2=f2(a)
b1=f1(b)
b2=f2(b)
integral=h*(0.5d0*g(a,a1,a2,h)+0.5d0*g(b,b1,b2,h)+s)
end subroutine
end module
program main
use funciones
implicit none
integer::n,i
real*8::a,b,c,d,x,s,h,integral
print*, "introduzca los valores de a, b y n"
read(*,*) a, b, n
call trapecio (a,b,n,integral)
print*,integral
end program
The main program is simple, just calling the subroutine and using the module. It also prints the final result.
First of all, like mentioned in the comments: your problem is not clear. Which input parameters a, b and n do you use and which result do you expect?
Other than that: the code you posted used deprecated features and non-standard types and bad code style.
Some general hints:
real*8 is non-standard Fortran. Use real(real64) instead. real64 has to be imported by use :: iso_fotran_env, only: real64.
non-integer expressions (do i=1d0,n-1d0) in do-loops are a deleted feature in modern Fortran. Use integers instead.
code should be formatted with white spaces and indentations
print*, should be replaced with write(*,*)
code should always use English names
write implicit none in the beginning of the module, not for every function.
make the module/program interface clear by using the statements private, public, and only
if You want to convert to type real, use the function REAL instead of DBLE
I prefer the cleaner function definition using result
use intent keywords: intent(in) passes the variable as a const reference.
the variables c,d,x,s,h in the main program are unused. Compile with warnings to detect unused variables.
This is the code changed with the suggestions I made:
module funciones
use :: iso_fortran_env, only: real64
implicit none
private
public :: trapecio, r8
integer, parameter :: r8 = real64
contains
function f(x,y) result(value)
real(r8), intent(in) :: x,y
real(r8) :: value
value = 2._r8*x*y
end function
function f1(x) result(value)
real(r8), intent(in) :: x
real(r8) :: value
value = x
end function
function f2(x) result(value)
real(r8), intent(in) :: x
real(r8) :: value
value = x**2._r8
end function
function g(x,c,d,h) result(value)
real(r8), intent(in) :: x, c, d, h
real(r8) :: value
real(r8) :: y, k, s
integer :: m, j
m = NINT(((d-c)/h)+1._r8)
k = (d-c)/REAL(m, r8)
s = 0._r8
do j = 1, m-1
y = c + REAL(j,r8)*k
s = s + f(x,y)
end do
value = k*(0.5_r8*(f(x,c)+f(x,d))+s)
end function
subroutine trapecio(a, b, n, integral)
real(r8), intent(in) :: a, b
integer, intent(in) :: n
real(r8), intent(out) :: integral
integer :: i
real(r8) :: c, d, x, h, s, a1, a2, b1, b2
h = (b-a)/REAL(n,r8)
s = 0._r8
do i = 1, n-1
x = a + REAL(i,r8)*h
c = f1(x)
d = f2(x)
s = s + g(x,c,d,h)
end do
a1 = f1(a)
a2 = f2(a)
b1 = f1(b)
b2 = f2(b)
integral = h*(0.5_r8*g(a,a1,a2,h) + 0.5_r8*g(b,b1,b2,h) + s)
end subroutine
end module
program main
use funciones, only: trapecio, r8
implicit none
integer :: n,i
real(r8) :: a,b,integral
write(*,*) "introduzca los valores de a, b y n"
read(*,*) a, b, n
call trapecio (a,b,n,integral)
write(*,*) integral
end program
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
As we know, more recent versions of Fortran support array operations, which can eliminate many loops. So I was wondering if it would be possible to eliminate even the last remaining loop in following code snippet (as to make it a one-liner):
subroutine test(n,x,lambda)
integer, intent(in) :: n
real, dimension(:), intent(in) :: x
real, dimension(:), intent(out) :: lambda
real :: eps
integer :: i
do i=1,n
lambda(i) = product(x(i)-x, mask=(abs(x(i)-x) > epsilon(eps)))
enddo
end subroutine
Its intention is to calculate n lambda(i) values in which
lambda(i) = (x(i)-x(1))*(x(i)-x(2))*...*(x(i)-x(i-1)*(x(i)-x(i+1))*...*(x(i)-x(n))
OK, try this
lambda = product(max(spread(x, dim=1, ncopies=size(x)) - &
spread(x, dim=2, ncopies=size(x)), eps), dim=2)
That's a one-liner. It's also rather wasteful of memory and much less comprehensible than the original.
Have you tried it with an implied do-loop in the array creation? something like real, dimension(:), intent(out):: lambda =(/product(x(i)-x, mask=(abs(x(i)-x)>epsilon(eps))), i=1, n/) ... I am not sure about the syntax here, but something like that might work.
You might even be able to create the array without calling the subroutine and do it in your main program, if your x-array is available.
Hope it helps.
Yes, you can shorten this, product can use 2D arrays:
You would first need to set up a matrix of the differences:
do i=1,n
mat(:,i) = x(i) - x
enddo
or, as a one-liner:
forall ( i=1:n ) mat(:,i) = x(i) - x
Now you can do the product along the second dimension:
lambda = product(mat, dim=2, mask=(abs(mat) > epsilon(eps)))
Whole program:
program test
integer, parameter :: n = 3
real, dimension(n) :: x
real, dimension(n) :: lambda
real, dimension(n,n) :: mat
real :: eps = 1.
integer :: i
call random_number( x )
do i=1,n
lambda(i) = product(x(i)-x, mask=(abs(x(i)-x) > epsilon(eps)))
enddo
print *,lambda
forall ( i=1:n ) mat(:,i) = x(i) - x
lambda = product(mat, dim=2, mask=(abs(mat) > epsilon(eps)))
print *,lambda
end program
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