I have a program as follows:
Integer N,tmax
parameter (N=10,tmax=10)
real :: L,dt,noise,positions(tmax,N),positions0(N),s,force
integer :: param
force=0
L=100.0
dt=0.1
param=0
r=0
!initialization
do 1 i1=1,N
param=param+100
positions(1,i1)=(ran2(param)-0.5)*L
1 continue
positions0=positions(1,:)
!time dependent process
do 2 i2=1,tmax
do 3 i3=1,N
param=param+100
force=0
noise=0
call routine_interaction(i3,N,positions0,force)
noise=(ran2(param)-0.5)*L/10
positions(i2,i3)=positions0(i3)+dt*(noise+force)
3 continue
positions0=positions(i2,:)
2 continue
print*, positions(1,:)
print*, positions(tmax,:)
end
with the subroutine and function:
FUNCTION ran2(idum)
INTEGER idum
!The ran2() subroutine from Numerical Recipes
! (C) Copr. 1986-92 Numerical Recipes Software #$!5,5.){2p491&&k"15. page 272
END
subroutine routine_interaction(ii,N,positions0,force)
integer N,ii
real :: r,s,force
real positions0(N)
do 4 i4=1,N
if (ii.ne.i4) then
r=abs(positions0(ii)-positions0(i4))
s=sign(1.0,positions0(i4)-positions0(ii))
force=force-(1/r**4-1/r**2)*s
end if
4 continue
return
end
as you can see, the subroutine routine_interaction is called at each time step, so that at each time step, there are 2 iterations and NxN=N² calculations.
Is there a way in fortran to define a function at each time step, that would be defined as: new_function(ii)=routine_interaction(ii,N,positions0,force) and that would be called in the do loop 3. It would lead to N+N calculations at each time steps?
If you want to use this algorithm, there is no way to reduce the force calculation (routine_interaction) to O(N) time. You have N elements in positions0, and you are calculating the distance r between each element and each other element (r=abs(positions(ii)-positions0(i4))). This requires at least N*(N-1)/2 calculations.
You can somewhat reduce the number of calculations using a triangular loop, e.g. as
program p
implicit none
integer, parameter :: N=10, tmax=10
real :: L,dt,noise,positions(tmax,N),positions0(N),force(N)
integer :: param
L=100.0
dt=0.1
param=0
!initialization
do i1=1,N
param=param+100
positions(1,i1)=(ran2(param)-0.5)*L
enddo
positions0=positions(1,:)
!time dependent process
do i2=1,tmax
force = routine_interaction(N,positions0)
do i3=1,N
param=param+100
noise=(ran2(param)-0.5)*L/10
positions(i2,i3)=positions0(i3)+dt*(noise+force(i3))
enddo
positions0=positions(i2,:)
enddo
print*, positions(1,:)
print*, positions(tmax,:)
end program
function routine_interaction(N,positions0) result (force)
integer, intent(in) :: N
real, intent(in) :: positions0(N)
real :: r,s,force(N)
integer :: i3,i4
force = 0
do i3=1,N
do i4=1,i3-1
r=abs(positions0(i3)-positions0(i4))
s=sign(1.0,positions0(i4)-positions0(i3))
force(i3)=force(i3)-(1/r**4-1/r**2)*s
force(i4)=force(i4)+(1/r**4-1/r**2)*s
enddo
enddo
end function
Related
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 actually want to solve an n variable hamilton's sets of equations. In fortran,to define a function, we, generally do the following.
function H(x,p) result(s)
real::x,p,s
s=x**2+p**2
end function H
Now, if I wish to solve an n variable hamilton's equation, I need to define an n variable H(x(i),p(i)) where i runs from 1 to n. Suppose p(i) are the variables and H is p(i)^2, summed over i from 1 to n.
What are the possible ways of defining a function with an array as input? It is not possible to write H(x1,x2....x100...) manuaaly each time.
module aa
implicit none
public :: H
contains
function H(x,p) result(s)
real, dimension(:), intent(in) :: x,p
real, dimension(:), allocatable :: s
integer :: i, n
n = size(x, 1)
allocate(s(n))
do i=1, n
s(i) = x(i)**2 + p(i)**2
enddo
end function H
end module aa
program test
use aa
real, dimension(10) :: x, p
real, dimension(:), allocatable :: s
integer :: n
x(:) = 1.
p(:) = 1.
n = size(x, 1)
allocate(s(n))
s(:) = 0.
s = H(x,p)
print*, s
end program test
Compiled and tested with GNU Fortran (Ubuntu 7.4.0-1ubuntu1~18.04.1) 7.4.0
This is not really a real case program example because if you know the dimensions of x and p, you also know the dimensions of s, so you could have just defined it instead of allocating. But it can be used to generalize modules once there is no reference to any dimension in the module.
For this to work, you will notice that s must be allocatable and must have been allocated before calling the function.
I'm trying to understand why one of the below is allowed by the standard while the other is not. They don't seem different except for boilerplate code to me. I feel like I'm misunderstanding something, or that there is a better way of doing it. Any help would be appreciated.
Not allowed:
real :: x
class(*) :: temp
x = 4
temp = genericAssignment(x)
select type(temp)
type is(real)
write(*,*) temp
end select
contains
function genericAssignment(a) result(b)
class(*) :: a
class(*) :: b
allocate(b, source=a)
end function genericAssignment
Allowed:
Type GenericContainer
class(*), pointer :: gen
End Type
real :: x
class(*) :: ptr
type(GenericContainer) :: temp
x = 4
temp = genericAssignment(x)
select type(ptr => temp%gen)
type is(real)
write(*,*) ptr
end select
contains
function genericAssignment(a) result(b)
class(*) :: a
type(GenericContainer) :: b
allocate(b%gen, source=a)
end function genericAssignment
The current standard allows both.
The "allowed" code block has a function with a non-polymorphic result, with the result of evaluating the function being assigned to a non-polymorphic variable. This is valid Fortran 2003.
The "not allowed" block has a function with a polymorphic result, with the result of evaluating the function being assigned to a polymorphic variable. This is valid Fortran 2008.
Note that the number of complete Fortran 2008 compiler implementations out there is small.
~~~
The function in the "not allowed" block is somewhat pointless - the code block is equivalent to:
real :: x
class(*) :: temp
x = 4
temp = x
select type(temp)
type is(real)
write(*,*) temp
end select
The purpose of the example below is to parallelize a do loop over a subroutine named "sub1" that invokes a function in which a simple addition operation is executed.
The problem that troubles me is that, in my mathematical model, the invoked function has two input arguments, (a,e), but for some reason in my code, I am restricted to pass a single-argument function to the subroutine "sub1." The solution I figured out is to set the second variable "e" to be inherited by the invoked function from the module it resides. The outcome looks good to me.
I am wondering whether using heritage to pass more than one arguments---identically defined in the module where the invoked function resides---to the invoked function in the parallel region will lead to any racing problem.
Thanks.
Lee
---- There are two files in this example: main.f90 and model.f90.
MAIN.f90
program main
! The definition of sub1 is:
! taking function_1,input_2,input_3 as inputs and
! returning output_4 as output
use omp_lib
use model
implicit none
integer :: j
real :: m(1000),k(1000)
m=[(real(j),j=1,1000)]
!$omp parallel do private(j) shared(m,k)
do j=1,1000
call sub1(fun1,m(j),2.,k(j))
enddo
!$omp end parallel do
end program main
MODEL.F90
module model
implicit none
real :: e
contains
subroutine sub1(func,a,c,d)
implicit none
real, intent(in) :: a,c
real, intent(out) :: d
interface
real function func(a)
implicit none
real :: a
end function func
end interface
e=c
d=func(a)
end subroutine sub1
real function fun1(a)
implicit none
real :: a
fun1=a**e
end function fun1
end module model
Yes, more threads will try to write to the variable e in this line
e=c
and that is a race condition. You can make it threadprivate. That way every thread will have its private copy that will persist during the calls.
In Fortran 2008 you could also do something along the lines of the program below, but the principle is the same.
module model
implicit none
real :: e
contains
subroutine sub2(func,a,d)
implicit none
real, intent(in) :: a
real, intent(out) :: d
interface
real function func(a)
implicit none
real :: a
end function func
end interface
d=func(a)
end subroutine
end module model
program main
! The definition of sub1 is:
! taking function_1,input_2,input_3 as inputs and
! returning output_4 as output
use omp_lib
use model
implicit none
integer :: j
real :: c
real :: m(1000),k(1000)
m=[(real(j),j=1,1000)]
!$omp parallel do private(j,c) shared(m,k)
do j=1,1000
c = i
call sub2(fun1,m(j),k(j))
enddo
!$omp end parallel do
contains
real function fun1(a)
implicit none
real :: a
fun1=a**c
end function fun1
end program main
I'm working on a Fortran 90 assignment, and I'm having a lot of issues learning how to use subroutines and functions, and I'm hoping someone can help me. if it isn't obvious, I'm extremely new to FORTRAN and much more comfortable with language like C and Java.
Anyway, here's what I have to do: The user selects what they would like to do: add, subtract, multiply, or transpose two matrices. I'm using a select case for this, which works great. However, I obviously don't want to duplicate the same code to fill two matrices four different times, so I'm trying to make it a separate function. Ideally, I'd like to do something like this:
integer matrix1(11,11), matrix2(11,11)
integer rows1,cols1,rows2,cols2,i,j
case (1)
matrix1 = fillmatrix(rows1,cols1)
matrix2 = fillmatrix(rows2,cols2)
.
.
.
function fillmatrix(rows,columns)
integer input
read *,rows,columns
do i = 1, rows
do j = 1, columns
fillmatrix(i,j) = read *,input
end do
end do
end
Is there any way to do something like this? And am i making myself clear, because sometimes I have trouble saying what I mean.
Or is this possible?
matrix1 = fillmatrix(rows1)cols1)
function fillmatrix(rows,columns)
integer input,matrix(11,11)
//fill matrix
return matrix
end
In C or Java, you just have functions, but Fortran has both functions and subroutines. In a case like this, it might be easier to write it as a subroutine instead of as a function, so your call would look something like
integer matrix1(11,11), matrix2(11,11)
integer rows1,cols1,rows2,cols2,i,j
...
case (1)
call fillmatrix(matrix1)
call fillmatrix(matrix2)
...
where the subroutine would look something like
subroutine fillmatrix(m)
implicit none
integer, intent(out) :: m(:,:)
integer :: i, j
do j = 1,size(m,2)
do i = 1,size(m,1)
read *, m(i,j)
end do
end do
end subroutine fillmatrix
Note that I'm not directly specifying the array bounds - instead I'm figuring them out inside the subroutine. This means that this subroutine needs an explicit interface - the easiest way to get this is to put it in either a contains block or a module.
If you want to use a function, you need to know the size of the matrix before calling it. Here is a small example:
module readMatrix
implicit none
contains
function fillmatrix(cols,rows)
implicit none
! Argument/return value
integer,intent(in) :: rows,cols
integer :: fillmatrix(rows,cols)
! Loop counters
integer :: i,j
do j = 1, rows
do i = 1, cols
write(*,*) 'Enter matrix element ',i,j
read *,fillmatrix(i,j)
enddo ! j
enddo ! i
end function
end module
program test
use readMatrix
implicit none
integer,allocatable :: matrix(:,:)
integer :: row,col, stat
write(*,*) 'Enter number of rows'
read *,row
write(*,*) 'Enter number of cols'
read *,col
allocate( matrix(col,row), stat=stat )
if (stat/=0) stop 'Cannot allocate memory'
matrix = fillmatrix(col,row)
write(*,*) matrix
deallocate(matrix)
end program
This is similar, using a subroutine and a static array (like in the question):
module readMatrix
implicit none
contains
subroutine fillmatrix(cols,rows,matrix)
implicit none
! Argument/return value
integer,intent(out) :: rows,cols
integer,intent(out) :: matrix(:,:)
! Loop counters
integer :: i,j
write(*,*) 'Enter number of rows, up to a maximum of ',size(matrix,2)
read *,rows
write(*,*) 'Enter number of cols, up to a maximum of ',size(matrix,1)
read *,cols
if ( rows > size(matrix,2) .or. cols > size(matrix,1) ) &
stop 'Invalid dimension specified'
do j = 1, rows
do i = 1, cols
write(*,*) 'Enter matrix element ',i,j
read *,matrix(i,j)
enddo ! j
enddo ! i
end subroutine
end module
program test
use readMatrix
implicit none
integer,parameter :: maxCol=10,maxRow=10
integer :: matrix(maxCol,maxRow)
integer :: row,col
call fillmatrix(col,row,matrix)
write(*,*) matrix(1:col,1:row)
end program
You could even pass an allocatable array to the subroutine and allocate it there, but that's a different story...