I have an optimization solver in Fortran 90. So, if I want to change the objective function
I have to modified the main file and write the objective function in this way:
subroutine fobj(n,x,f)
implicit none
integer :: n
real(8) :: f
real(8) :: x(n)
intent(in ) :: n,x
intent(out) :: f
!OBJECTIVE FUNCTION
f = x(1)**2-x(2)+2*x(3)
end subroutine fobj
I have a big objective function, so I want to call this line "f = x(1)**2-x(2)+2*x(3)" from an external file or at least the subrutine.
Is that possible? (I'm new in Fortran.)
I know that I can modified the file with Python, but I want to do it in other file.
Thanks a lot!
Sure. Use:
include 'file.inc'
to include source code from an external file.
I'm not sure if this is what you're looking for, but:
Fortran also allows you to pass subroutine/function names around as actual arguments to subroutine/function calls. The corresponding dummy arguments must have the "external" attribute.
subroutine fobj(n,x,f,func)
implicit none
integer :: n
real(8),external :: func
real(8) :: f
real(8) :: x(n)
intent(in ) :: n,x
intent(out) :: f
!OBJECTIVE FUNCTION
f=func(x,n)
end subroutine fobj
function func1(x,n)
implicit none
real(8) func1
integer n
real(8) :: f,x(n)
f = x(1)**2-x(2)+2*x(3)
end function func1
function func2(x,n)
implicit none
real(8) func2
integer n
real(8) :: f,x(n)
f = x(1)**2+x(2)+2*x(3)
end function func2
program main
real(8),external :: func1,func2
real(8),allocatable :: x(:)
real(8) :: f
integer n
n=50
allocate(x(n))
x=10. !Set X to a known value
call fobj(n,x,f,func1) !Call func1
print*,f !10**2-10+2*10 = 110
x=10. !Reset X ... just to make sure there is no funny business in func1,func2
call fobj(n,x,f,func2) !Call func2
print*,f !10**2+10+2*10 = 130
deallocate(x)
end program main
Of course, this program does nothing useful other than call func1 and func2 in obscure ways, but hopefully it illustrates the point. If you're looking to switch out the function at compile-time, then I think a include "myfile" is probably cleaner (just switching which file you're including at the time as suggested by #AlejandroLL)
You might also try to use Modules in your program. Sometimes when you pass special variables to your subroutines/functions you need to write interfaces for them. Using modules will improve your program structure and you'll be more effective and all interfaces would be generated automatically.
Related
I have function that returns an array, say
function f(A)
implicit none
real, intent(in) :: A(5)
real, intent(out) :: f(5)
f = A+1
end
My question is, how can I define f in the main program unit? E.g.
program main
implicit none
real :: A(5)
real, dimension(5), external :: f ! does not work
...
end
You need an explicit interface. You can do this in a few ways.
Explicitly in the scoping unit that calls f:
interface
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
end function
end interface
Place the function in your program host scope as an internal function:
program main
...
contains
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
f = A+1
end
end program
Place the function in a module:
module A
contains
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
f = A+1
end
end module
program main
use A
...
end program
Use the explicit interface from a different procedure with the same arguments and return type, kind and rank.
program main
interface
function r5i_r5o(r5)
implicit none
real, intent(in) :: r5(5)
real :: r5i_r5o(5)
end function
end interface
procedure(r5i_r5o) :: f
...
end program
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
f = A+1
end
The cleanest way of doing this is option #3 using modules. This gives you the benefit of an automatic explicit interface (not needing to do option #1 everywhere you call f) and makes your function available everywhere the module is used rather than limited to a specific scoping unit as in option #2. Option #4 can be handy if you have many procedures with the same argument and return types since one explicit interface can be re-used for all of them.
This shows three different ways to specify function results, and how to use modules to organize your functions:
module so_func
INTEGER, PARAMETER :: MAX_SIZE = 5
TYPE MY_DATA
INTEGER :: SIZE
REAL, DIMENSION(MAX_SIZE) :: DATA
ENDTYPE
contains
FUNCTION f1(A,N) RESULT(X)
implicit none
INTEGER, INTENT(IN) :: N
REAL, INTENT(IN) :: A(N)
REAL :: X(N)
! ....
X = 1.0+A
END FUNCTION f1
TYPE(MY_DATA) FUNCTION f2(A,N)
implicit none
INTEGER, INTENT(IN) :: N
REAL, INTENT(IN) :: A(N)
! ....
f2%SIZE = N
f2%DATA(1:N) = 1.0+A
END FUNCTION f2
FUNCTION f3(A,N)
implicit none
INTEGER, INTENT(IN) :: N
REAL, INTENT(IN) :: A(N)
REAL :: f3(N)
! ....
f3 = 1.0+A
END FUNCTION f3
end module
program SO_RESULT
use so_func
implicit none
integer, parameter :: n=5
REAL :: A(n), y1(n), y3(n)
TYPE(MY_DATA) :: y2
INTEGER :: i
! Variables
A =(/ (i, i=1,n) /)
y1 = f1(A,n)
y2 = f2(A,n)
y3 = f3(A,n)
end program SO_RESULT
I am writing a code with a lot of 2D arrays and manipulation of them. I would like the code to be as concise as possible, for that I would like to use as many 'implicit' operation on array as possible but I don't really know how to write them for 2D arrays.
For axample:
DO J=1,N
DO I=1,M
A(I,J)=B(J)*A(I,J)
ENDDO
ENDDO
become easily:
DO J=1,N
A(:,J)=B(J)*A(:,J)
ENDDO
Is there a way to reduce also the loop J?
Thanks
For brevity and clarity, you could wrap these operations in a derived type. I wrote a minimal example which is not so concise because I need to initialise the objects, but once this initialisation is done, manipulating your arrays becomes very concise and elegant.
I stored in arrays_module.f90 a derived type arrays2d_T which can hold the array coefficients, plus useful information (number of rows and columns). This type contains procedures for initialisation, and the operation you are trying to perform.
module arrays_module
implicit none
integer, parameter :: dp = kind(0.d0) !double precision definition
type :: arrays2d_T
real(kind=dp), allocatable :: dat(:,:)
integer :: nRow, nCol
contains
procedure :: kindOfMultiply => array_kindOfMuliply_vec
procedure :: init => initialize_with_an_allocatable
end type
contains
subroutine initialize_with_an_allocatable(self, source_dat, nRow, nCol)
class(arrays2d_t), intent(inOut) :: self
real(kind=dp), allocatable, intent(in) :: source_dat(:,:)
integer, intent(in) :: nRow, nCol
allocate (self%dat(nRow, nCol), source=source_dat)
self%nRow = nRow
self%nCol = nCol
end subroutine
subroutine array_kindOfMuliply_vec(self, vec)
class(arrays2d_t), intent(inOut) :: self
real(kind=dp), allocatable, intent(in) :: vec(:)
integer :: iRow, jCol
do jCol = 1, self%nCol
do iRow = 1, self%nRow
self%dat(iRow, jCol) = vec(jCol)*self%dat(iRow, jCol)
end do
end do
end subroutine
end module arrays_module
Then, in main.f90, I check the behaviour of this multiplication on a simple example:
program main
use arrays_module
implicit none
type(arrays2d_T) :: A
real(kind=dp), allocatable :: B(:)
! auxilliary variables that are only useful for initialization
real(kind=dp), allocatable :: Aux_array(:,:)
integer :: M = 3
integer :: N = 2
! initialise the 2d array
allocate(Aux_array(M,N))
Aux_array(:,1) = [2._dp, -1.4_dp, 0.3_dp]
Aux_array(:,2) = [4._dp, -3.4_dp, 2.3_dp]
call A%init(aux_array, M, N)
! initialise vector
allocate (B(N))
B = [0.3_dp, -2._dp]
! compute the product
call A%kindOfMultiply(B)
print *, A%dat(:,1)
print *, A%dat(:,2)
end program main
Compilation can be as simple as gfortran -c arrays_module.f90 && gfortran -c main.f90 && gfortran -o main.out main.o arrays_module.o
Once this object-oriented machinery exists, call A%kindOfMultiply(B) is much clearer than a FORALL approach (and much less error prone).
No one has mentioned do concurrent construct here, which has the potential to automatically parallelize and speed up your code,
do concurrent(j=1:n); A(:,j)=B(j)*A(:,j); end do
A one-line solution can be achieved by using FORALL:
FORALL(J=1:N) A(:,J) = B(J)*A(:,J)
Note that FORALL is deprecated in the most recent versions of the standard, but as far as I know, that is the only way you can perform that operation as a single line of code.
I have a Fortran program that compiles without problems, but then gets an error:
Attempt to call a routine with argument number one as a procedure when
a real(kind=2) was required
ROOTS!X_ROOT - in file exercise2base.f90 at line 20 [+0074]
main - in file exercise2base.f90 at line 65 [+00c8]
I don't really know what this means, I thought maybe it means that I pass an argument to some function which is not the right type, but the references that are given don't make sense:
line 20 is end function x_rtsmpl
line 66 is answer=x_root(bb_integral,l1,l2,epsx,epsf,root_type)
so I don't understand what's going on...
I'm using Silverfrost with Plato IDE.
module roots
implicit none
character(20) :: root_type
contains
function x_rtsmpl(f,x1,x2,epsx,epsf) result(x_root)
implicit none
real(2) :: x_root
real(2), intent(IN) :: x1,x2,epsx,epsf
interface
function f(x)
implicit none
real(2), intent(IN) :: x
real(2) :: f
end function f
end interface
real(2) :: xx,fx
x_root=x1
end function x_rtsmpl
function x_root(f,x1,x2,epsx,epsf) result(x_r)
implicit none
real(2) :: x_r
real(2), intent(IN) :: x1,x2,epsx,epsf
interface
function f(x)
implicit none
real(2), intent(IN) :: x
real(2) :: f
end function f
end interface
x_r=x_rtsmpl(f,x1,x2,epsx,epsf)
return
end function x_root
end module roots
module blackbody
implicit none
private
public :: Ibb
contains
function Ibb(lambda)
real(2) , intent (in) :: lambda
real(2) :: Ibb
Ibb=lambda+1._2
return
end function Ibb
end module blackbody
program master
use roots
use blackbody
implicit none
real(2) :: l2,epsx,epsf,answer,l1,epsi,requested
l1=4.d-7
l2=1.d-4
epsx=1.d-2*l1
epsf=1.d-1
epsi=1.d-4
answer=x_root(Ibb,l1,l2,epsx,epsf)
end program master
EDIT: The code is now trimmed all the way down to its basic functions with only declarations and simple "dummy" calculations.
I want to pass a type bound procedures (as an external function) to another function as follows:
module mod1
implicit none
type type1
real :: a
contains
procedure,pass :: f
end type
contains
real function f(y,e)
class(type1), intent(in) :: y
real,intent(in) :: e
f=y%a+e
end function
end module
program test
use mod1
type(type1) :: t
t%a=3e0
write(*,*) s(t%f)
contains
real function s(g)
real,external :: g
s=g(5e0)+2e0
end function
end program
gfortran produces gives this error :
write(*,*) s(t%f)
1
Error: Expected argument list at (1)
But what I can do is:
program test
t%a=3e0
write(*,*) s(k)
contains
real function s(g)
real,external :: g
s=g(5e0)+2e0
end function
real function k(e)
real,intent(in) :: e
k=3e0+e
end function
end program
I think the problem is related to Passing type bound procedures as arguments, but I don't see at the moment how the answers there can help me.
EDIT:
A better example which (hopefully) shows the difficulty:
module mod2
implicit none
contains
real function s(g)
interface
real function g(x)
real, intent(in) :: x
end function
end interface
s=g(5e0)+2e0
end function
end module
module mod1
use mod2
type type1
real :: a
contains
procedure,pass :: f
procedure,pass :: h
end type
contains
real function f(y,e)
class(type1), intent(in) :: y
real,intent(in) :: e
f=y%a+e
end function
real function h(y)
class(type1), intent(inout) :: y
h=s(y%f)
end function
end module
program test
use mod1
type(type1) :: t
t%a=3e0
write(*,*) t%h
end program
EDIT II:
Ok, the wrappers still work in combination with a pointer:
module mod2
implicit none
contains
real function s(g)
interface
real function g(x)
real, intent(in) :: x
end function
end interface
s=g(5e0)+2e0
end function
end module
module mod1
use mod2
type type1
real :: a
contains
procedure,pass :: f
procedure,pass :: h
end type
class(type1),pointer :: help_w
contains
real function f(y,e)
class(type1), intent(in) :: y
real,intent(in) :: e
f=y%a+e
end function
real function h(y)
class(type1), intent(inout),target :: y
help_w => y
h=s(wrap)
end function
function wrap(x)
real,intent(in) :: x
wrap=help_w%f(x)
end function
end module
program test
use mod1
type(type1) :: t
t%a=3e0
write(*,*) t%h()
end program
This is certainly not a beautiful solution but at least it works.
You can write a wrapper. This is the most straightforward version. Requires passing internal function as a dummy argument (F2008), but you could declare the wrapper in a module too, if the t can bee there.
Note I changed the declaration of the procedure argument in s to something more modern - the interface block.
program test
use mod1
type(type1) :: t
t%a=3e0
write(*,*) s(wrap)
contains
real function s(g)
interface
real function g(x)
real, intent(in) :: x
end function
end interface
s=g(5e0)+2e0
end function
function wrap(x)
real, intent(in) :: x
wrap = t%f(x)
end function
end program
The reason for your error is well described in the answers to the linked question, you cannot pass type bound procedures the way you tried.
I have the following FORTRAN code:
FUNCTION inverse_deterministic_cdf(dist, p) RESULT(value)
!=========== result ============
REAL(C_DOUBLE) :: value
!====== input parameters =======
TYPE(deterministic), INTENT(IN) :: dist
REAL(C_DOUBLE), INTENT(IN) :: p
!======= subroutine body =======
value = p ! This is only here to suppress unused dummy argument warning
value = dist%value
END FUNCTION inverse_deterministic_cdf
In this case, inverse_deterministic_cdf is an implementation of an inverse_cdf interface, which is why there's the unused p here. As you can see, I have a method of suppressing the unused dummy argument, but it feels inelegant to me. Does anyone have any best practices for how they handle this? (I also want this to be compiler agnostic.) I know how to suppress the warnings universally, but I want to be warned when I have an unused dummy argument and I'm not anticipating it.
Edit to add (upon request):
The inverse_cdf interface is defined thusly:
INTERFACE inverse_cdf
MODULE PROCEDURE inverse_distribution_cdf, inverse_normal_cdf, inverse_lognormal_cdf, inverse_deterministic_cdf
END INTERFACE
My guess would be that you need to define a generic interface.
stuff.f90
MODULE stuff
IMPLICIT NONE
INTERFACE stuff_foo
MODULE PROCEDURE foo1
MODULE PROCEDURE foo2
END INTERFACE stuff_foo
CONTAINS
FUNCTION foo1(a) RESULT(f)
REAL :: a
REAL :: f
f = a
END FUNCTION foo1
FUNCTION foo2(a, b) RESULT(f)
REAL :: a
REAL :: b
REAL :: f
f = a + b
END FUNCTION foo2
END MODULE stuff
main.f90
PROGRAM main
USE stuff
IMPLICIT NONE
PRINT *, stuff_foo(1.0)
PRINT *, stuff_foo(1.0, 2.0)
END PROGRAM main
Since you have your procedure in a module (and thus, the procedure has an explicit interface), why not use an optional argument? E.g. something like
FUNCTION inverse_cdf(dist, p) RESULT(value)
!=========== result ============
REAL(C_DOUBLE) :: value
!====== input parameters =======
TYPE(deterministic), INTENT(IN) :: dist
REAL(C_DOUBLE), INTENT(IN), OPTIONAL :: p
!======= subroutine body =======
IF (PRESENT(p)) THEN
value = dist%value * p ! Some expression using p
ELSE
value = dist%value
END IF
END FUNCTION inverse_cdf