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.
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'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
I have I simple problem but I cannot find a solution anywhere.
I have to integrate a function (for example using a Simpson's rule subroutine) but I am obliged to pass to my function more than one argument: one is the variable that I want to integrate later and another one is just a value coming from a different calculation which I cannot perform inside the function.
The problem is that the Simpson subroutine only accept f(x) to perform the integral and not f(x,y).
After Vladimir suggestions I modified the code.
Below the example:
Program main2
!------------------------------------------------------------------
! Integration of a function using Simpson rule
! with doubling number of intervals
!------------------------------------------------------------------
! to compile:
! gfortran main2.f90 -o simp2
implicit none
double precision r, rb, rmin, rmax, rstep, integral, eps
double precision F_int
integer nint, i, rbins
double precision t
rbins = 4
rmin = 0.0
rmax = 4.0
rstep = (rmax-rmin)/rbins
rb = rmin
eps = 1.0e-8
func = 0.0
t=2.0
do i=1,rbins
call func(rb,t,res)
write(*,*)'r, f(rb) (in main) = ', rb, res
!test = F_int(rb)
!write(*,*)'test F_int (in loop) = ', test
call simpson2(F_int(rb),rmin,rb,eps,integral,nint)
write(*,*)'r, integral = ', rb, integral
rb = rb+rstep
end do
end program main2
subroutine func(x,y,res)
!----------------------------------------
! Real Function
!----------------------------------------
implicit none
double precision res
double precision, intent(in) :: x
double precision y
res = 2.0*x + y
write(*,*)'f(x,y) (in func) = ',res
return
end subroutine func
function F_int(x)
!Function to integrate
implicit none
double precision F_int, res
double precision, intent(in) :: x
double precision y
call func(x,y,res)
F_int = res
end function F_int
Subroutine simpson2(f,a,b,eps,integral,nint)
!==========================================================
! Integration of f(x) on [a,b]
! Method: Simpson rule with doubling number of intervals
! till error = coeff*|I_n - I_2n| < eps
! written by: Alex Godunov (October 2009)
!----------------------------------------------------------
! IN:
! f - Function to integrate (supplied by a user)
! a - Lower limit of integration
! b - Upper limit of integration
! eps - tolerance
! OUT:
! integral - Result of integration
! nint - number of intervals to achieve accuracy
!==========================================================
implicit none
double precision f, a, b, eps, integral
double precision sn, s2n, h, x
integer nint
double precision, parameter :: coeff = 1.0/15.0 ! error estimate coeff
integer, parameter :: nmax=1048576 ! max number of intervals
integer n, i
! evaluate integral for 2 intervals (three points)
h = (b-a)/2.0
sn = (1.0/3.0)*h*(f(a)+4.0*f(a+h)+f(b))
write(*,*)'a, b, h, sn (in simp) = ', a, b, h, sn
! loop over number of intervals (starting from 4 intervals)
n=4
do while (n <= nmax)
s2n = 0.0
h = (b-a)/dfloat(n)
do i=2, n-2, 2
x = a+dfloat(i)*h
s2n = s2n + 2.0*f(x) + 4.0*f(x+h)
end do
s2n = (s2n + f(a) + f(b) + 4.0*f(a+h))*h/3.0
if(coeff*abs(s2n-sn) <= eps) then
integral = s2n + coeff*(s2n-sn)
nint = n
exit
end if
sn = s2n
n = n*2
end do
return
end subroutine simpson2
I think I'm pretty close to the solution but I cannot figure it out...
If I call simpson2(F_int, ..) without putting the argument in F_int I receive this message:
call simpson2(F_int,rmin,rb,eps,integral,nint)
1
Warning: Expected a procedure for argument 'f' at (1)
Any help?
Thanks in advance!
Now you have a code we can work with, good job!
You need to tell the compiler, that F_int is a function. That can be done by
external F_int
but it is much better to learn Fortran 90 and use modules or at least interface blocks.
module my_functions
implicit none
contains
subroutine func(x,y,res)
!----------------------------------------
! Real Function
!----------------------------------------
implicit none
double precision res
double precision, intent(in) :: x
double precision y
res = 2.0*x + y
write(*,*)'f(x,y) (in func) = ',res
return
end subroutine func
function F_int(x)
!Function to integrate
implicit none
double precision F_int, res
double precision, intent(in) :: x
double precision y
call func(x,y,res)
F_int = res
end function F_int
end module
Now you can easily use the module and integrate the function
use my_functions
call simpson2(F_int,rmin,rb,eps,integral,nint)
But you will find that F_int still does not know what y is! It has it's own y with undefined value! You should put y into the module instead so that everyone can see it.
module my_functions
implicit none
double precision :: y
contains
Don't forget to remove all other declarations of y! Both in function F_int and in the main program. Probably it is also better to call it differently.
Don't forget to set the value of y somewhere inside your main loop!
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...
I guess I could easily use some help here, since I'm messing around with some fortran 2003 but can't seem to understand how to do things really.
The fact is that I need to write a fortran code that declares, inside a module, a new data type
that has as one of its members a pointer to a real function. Something like
module new_mod
type my_type
real*8 :: a, b
(here something that declares a real*8 function), pointer :: ptr
end type my_type
end module_new
module funcs
real*8 function function1(x)
real*8 :: x
function1 = x*x
end function function1
real*8 function function2(x)
real*8 :: x
function2 = x*x
end function function2
end module funcs
then in the main program I would like to have something like
program my_prog
use module_new
use module_funcs
implicit none
real*8 :: y, z
type(my_type) :: atom
...
atom%ptr => function1
y = atom%ptr(x)
...
atom%ptr => function2
z = atom%ptr(x)
end program my_prog
while
so the main idea is that module_new contains a type that has a pointer to a real
function. This pointer in th eobjects of the new type I must be able to point to different functions in the main program.
I have seen one can do similar things with abstract interfaces and such, but honestly, I'm in a mess here. If someone could help, I'll appreciate that.
Cheers...
Well, that is not really the type of question you would send to stackoverflow, but actually your code needs only a "slight improvement" (by appropriate definition of slight) to work:
module accuracy
implicit none
integer, parameter :: dp = kind(1.0d0)
end module accuracy
module typedef
use accuracy
implicit none
type :: mytype
real(dp) :: aa, bb
procedure(myinterface), pointer, nopass :: myfunc
end type mytype
abstract interface
function myinterface(xx)
import :: dp
real(dp), intent(in) :: xx
real(dp) :: myinterface
end function myinterface
end interface
end module typedef
module funcs
use accuracy
implicit none
contains
function func1(xx)
real(dp), intent(in) :: xx
real(dp) :: func1
func1 = xx
end function func1
function func2(xx)
real(dp), intent(in) :: xx
real(dp) :: func2
func2 = 2.0_dp * xx
end function func2
end module funcs
program test
use accuracy
use typedef
use funcs
implicit none
real(dp) :: xx
type(mytype) :: atom
xx = 12.0_dp
atom%myfunc => func1
print *, atom%myfunc(xx)
atom%myfunc => func2
print *, atom%myfunc(xx)
end program test
There are several things to be worth to mentioned:
You should use one global parameter for your accuracy (see module accuracy) and forget about real*8.
Your procedure pointer in your derived type needs an interface, which is provided within the following abstract interface block (see 'abstract interfaces' in a good F2003 book).
You need the nopass option for the procedure pointer in the derived type as otherwise Fortran will assume that the first parameter passed to the function/subroutine is the derived type itself (see 'type bound procedures' in a good F2003 book).
Finally, although rather obvious: You should definitely read a book about the Fortran 2003 features if you are serious about using them in a production code.