I am using Microsoft Visual Studio with Intel Fortran and totally new to this coding platform. If my question is not worthy enough to put here, I ask for the apology in advance but I really need the solution to this problem.
I am needed to integrate a large number of trigonometric expressions (approx. 4860). I am using the QUADPACK library and following code:
program integral
real ( kind = 4 ), parameter :: a = 0.0E+00
real ( kind = 4 ) abserr
real ( kind = 4 ) b,x
real ( kind = 4 ), parameter :: epsabs = 0.0E+00
real ( kind = 4 ), parameter :: epsrel = 0.001E+00
real ( kind = 4 ), external :: f2
integer ( kind = 4 ) ier
integer ( kind = 4 ), parameter :: key = 6
integer ( kind = 4 ) neval
real ( kind = 4 ), parameter :: r4_pi = 3.141592653589793E+00
real ( kind = 4 ) result1
real ( kind = 4 ), parameter :: true = 0.06278740E+00
b = r4_pi
call qag ( f2, a, b, epsabs, epsrel, key, result1, abserr, neval, ier )
write ( *, '(a)' ) ' '
write ( *, '(a)' ) 'QAG_TEST'
write ( *, '(a)' ) ' Test QAG'
write ( *, '(a)' ) ' '
write ( *, '(a)' ) ' Integrand is COS(100*SIN(X))'
write ( *, '(a,g14.6)' ) ' Integral left endpoint A = ', a
write ( *, '(a,g14.6)' ) ' Integral right endpoint B = ', b
write ( *, '(a,g14.6)' ) ' Exact integral is ', true
write ( *, '(a,g14.6)' ) ' Estimated integral is ', result1
write ( *, '(a,g14.6)' ) ' Estimated integral error = ', abserr
write ( *, '(a,g14.6)' ) ' Exact integral error = ', true - result
write ( *, '(a,i8)' ) ' Number of function evaluations, NEVAL = ', neval
write ( *, '(a,i8)' ) ' Error return code IER = ', ier
end program integral
function f2(x)
implicit none
real ( kind = 4 ) f2
real ( kind = 4 ) x
f2=COS(100*SIN(X))
end function
From the above code, I can easily find the integral of a single expression. But in my case, I have an array (18*270) containing all the elements as a mathematical expression. I want to call them one by one and integrate them. Please suggest me how to deal with it. Thank you.
Related
Related question Fortran: Which method is faster to change the rank of arrays? (Reshape vs. Pointer)
If I have a tensor contraction
A[a,b] * B[b,c,d] = C[a,c,d]
If I use BLAS, I think I need DGEMM (assume real values), then I can
first reshape tensor B[b,c,d] as D[b,e] where e = c*d,
DGEMM, A[a,b] * D[b,e] = E[a,e]
reshape E[a,e] into C[a,c,d]
The problem is, reshape is not that fast :( I saw discussions in Fortran: Which method is faster to change the rank of arrays? (Reshape vs. Pointer)
, in the above link, the author met some error messages, except reshape itself.
Thus, I am asking if there is a convenient solution.
[I have prefaced the size of dimensions with the letter n to avoid confusion in the below between the tensor and the size of the tensor]
As discussed in the comments there is no need to reshape. Dgemm has no concept of tensors, it only knows about arrays. All it cares about is that those arrays are laid out in the correct order in memory. As Fortran is column major if you use a 3 dimensional array to represent the 3 dimensional tensor B in the question it will be laid out exactly the same in memory as a 2 dimensional array used to represent the 2 dimensional tensor D. As far as the matrix mult is concerned all you need to do now is get the dot products which form the result to be the right length. This leads you to the conclusion that if you tell dgemm that B has a leading dim of nb, and a second dim of nc*nd you will get the right result. This leads us to
ian#eris:~/work/stack$ gfortran --version
GNU Fortran (Ubuntu 7.4.0-1ubuntu1~18.04.1) 7.4.0
Copyright (C) 2017 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
ian#eris:~/work/stack$ cat reshape.f90
Program reshape_for_blas
Use, Intrinsic :: iso_fortran_env, Only : wp => real64, li => int64
Implicit None
Real( wp ), Dimension( :, : ), Allocatable :: a
Real( wp ), Dimension( :, :, : ), Allocatable :: b
Real( wp ), Dimension( :, :, : ), Allocatable :: c1, c2
Real( wp ), Dimension( :, : ), Allocatable :: d
Real( wp ), Dimension( :, : ), Allocatable :: e
Integer :: na, nb, nc, nd, ne
Integer( li ) :: start, finish, rate
Write( *, * ) 'na, nb, nc, nd ?'
Read( *, * ) na, nb, nc, nd
ne = nc * nd
Allocate( a ( 1:na, 1:nb ) )
Allocate( b ( 1:nb, 1:nc, 1:nd ) )
Allocate( c1( 1:na, 1:nc, 1:nd ) )
Allocate( c2( 1:na, 1:nc, 1:nd ) )
Allocate( d ( 1:nb, 1:ne ) )
Allocate( e ( 1:na, 1:ne ) )
! Set up some data
Call Random_number( a )
Call Random_number( b )
! With reshapes
Call System_clock( start, rate )
d = Reshape( b, Shape( d ) )
Call dgemm( 'N', 'N', na, ne, nb, 1.0_wp, a, Size( a, Dim = 1 ), &
d, Size( d, Dim = 1 ), &
0.0_wp, e, Size( e, Dim = 1 ) )
c1 = Reshape( e, Shape( c1 ) )
Call System_clock( finish, rate )
Write( *, * ) 'Time for reshaping method ', Real( finish - start, wp ) / rate
! Direct
Call System_clock( start, rate )
Call dgemm( 'N', 'N', na, ne, nb, 1.0_wp, a , Size( a , Dim = 1 ), &
b , Size( b , Dim = 1 ), &
0.0_wp, c2, Size( c2, Dim = 1 ) )
Call System_clock( finish, rate )
Write( *, * ) 'Time for straight method ', Real( finish - start, wp ) / rate
Write( *, * ) 'Difference between result matrices ', Maxval( Abs( c1 - c2 ) )
End Program reshape_for_blas
ian#eris:~/work/stack$ cat in
40 50 60 70
ian#eris:~/work/stack$ gfortran -std=f2008 -Wall -Wextra -fcheck=all reshape.f90 -lblas
ian#eris:~/work/stack$ ./a.out < in
na, nb, nc, nd ?
Time for reshaping method 1.0515256000000001E-002
Time for straight method 5.8608790000000003E-003
Difference between result matrices 0.0000000000000000
ian#eris:~/work/stack$ gfortran -std=f2008 -Wall -Wextra reshape.f90 -lblas
ian#eris:~/work/stack$ ./a.out < in
na, nb, nc, nd ?
Time for reshaping method 1.3585931000000001E-002
Time for straight method 1.6730429999999999E-003
Difference between result matrices 0.0000000000000000
That said I think it worth noting though that the overhead for reshaping is O(N^2) while the time for the matrix multiply is O(N^3). Thus for large matrices the percentage overhead due to the reshape will tend to zero. Now code performance is not the only consideration, code readability and maintainability is also very important. So, if you find the reshape method much more readable and the matrices you use are sufficiently large that the overhead is not of import, you may well use the reshapes as in this case code readability might be more important than the performance. Your call.
I want to calculate D[a,d] = A[a,b,c] * B[b,c,d].
Method I: reshape A[a,b,c] => C1[a,e], B[b,c,d] => C2[e,d], e = b*c
Method II: directly call dgemm. This is a run-time error.
" na, nb, nc, nd ?
2 3 5 7
Time for reshaping method 2.447600000000000E-002
Intel MKL ERROR: Parameter 10 was incorrect on entry to DGEMM .
Time for straight method 1.838800000000000E-002
Difference between result matrices 5.46978468774136 "
Question: Can we contract two indexes together by BLAS?
The following only works for one index.
How to speed up reshape in higher rank tensor contraction by BLAS in Fortran?
Program reshape_for_blas
Use, Intrinsic :: iso_fortran_env, Only : wp => real64, li => int64
Implicit None
Real( wp ), Dimension( :, :, : ), Allocatable :: a
Real( wp ), Dimension( :, :, : ), Allocatable :: b
Real( wp ), Dimension( :, : ), Allocatable :: c1, c2
Real( wp ), Dimension( :, : ), Allocatable :: d
Real( wp ), Dimension( :, : ), Allocatable :: e
Integer :: na, nb, nc, nd, ne
Integer( li ) :: start, finish, rate
Write( *, * ) 'na, nb, nc, nd ?'
Read( *, * ) na, nb, nc, nd
ne = nb * nc
Allocate( a ( 1:na, 1:nb, 1:nc ) )
Allocate( b ( 1:nb, 1:nc, 1:nd ) )
Allocate( c1( 1:na, 1:ne ) )
Allocate( c2( 1:ne, 1:nd ) )
Allocate( d ( 1:na, 1:nd ) )
Allocate( e ( 1:na, 1:nd ) )
! Set up some data
Call Random_number( a )
Call Random_number( b )
! With reshapes
Call System_clock( start, rate )
c1 = Reshape( a, Shape( c1 ) )
c2 = Reshape( b, Shape( c2 ) )
Call dgemm( 'N', 'N', na, nd, ne, 1.0_wp, c1, Size( c1, Dim = 1 ), &
c2, Size( c2, Dim = 1 ), &
0.0_wp, e, Size( e, Dim = 1 ) )
Call System_clock( finish, rate )
Write( *, * ) 'Time for reshaping method ', Real( finish - start, wp ) / rate
! Direct
Call System_clock( start, rate )
Call dgemm( 'N', 'N', na, nd, ne, 1.0_wp, a , Size( a , Dim = 1 ), &
b , Size( b , Dim = 1 ), &
0.0_wp, d, Size( d, Dim = 1 ) )
Call System_clock( finish, rate )
Write( *, * ) 'Time for straight method ', Real( finish - start, wp ) / rate
Write( *, * ) 'Difference between result matrices ', Maxval( Abs( d - e ) )
End Program reshape_for_blas
In the following code I was under the impression that a repeat count in a formatted write simply expanded the bracket to be repeated.
program main
implicit none
integer, parameter :: N = 5
real a(N), ct(N)
integer i
a = [ ( 0.1 * i, i = 1, N ) ]
ct = 10 * a
write( *, "( 1x, i4, 2( 1x, e11.4 ) )" ) ( i, a(i), ct(i), i = 1, N ) ! METHOD 1
write( *, * )
write( *, "( 1x, i4, 1x, e11.4, 1x, e11.4 )" ) ( i, a(i), ct(i), i = 1, N ) ! METHOD 2
end program
However, putting the repeat count in fails (throws an error on some compilers, writes garbage on others). Writing the whole lot out explicitly without a repeat count is fine. The implied do-loop may or may not contribute to the problem.
The formats
( 1x, i4, 2( 1x, e11.4 ) )
and
( 1x, i4, 1x, e11.4, 1x, e11.4 )
are not equivalent. Expansion of the repeat count does not work in exactly this way.
Yes, the group in the first is expanded to give something that looks like the second, but there is a big difference in how the format behaves when there are more items to be written than there are data edit descriptors. This is "format reversion".
In the first format, format reversion (reached after writing the first three data items) moves the processing back to the ( 1x, e11.4 ) group. In the second, because there is no internal (...) group, reversion goes back to the start of the whole format.
For format reversion to work as you expect in the first, you can add another (...) group:
(( 1x, i4, 2( 1x, e11.4 ) ))
I am working on a code that needs to get the two variables of a binomial expression. I want to know if there's a way to separate a string with a sign in the middle into two substrings.
e.g. (x+y)^3 to var1=x and var2=y or (qwerty-asdf)^12 to var1=qwerty and var2=asdf
I have tried doing this:
character(100) :: str, var
var=' '
do i=1,len(str)
if (((str(i:i) == "+") .or. (str(i:i) == "-")) .or. &
((str(i:i) >= "a") .and. (str(i:i) <= "z"))) &
var=trim(var)//trim(str(i:i))
end do
But the only characters that get removed are the parenthesis and the power.
Another way that I'm looking at my problem is that if I know what the string length where the signs are then I can do this:
character(100) :: str, var
var=' '
do i=1,len(the_unknown_string_length)
if ((str(i:i) >= "a") .and. (str(i:i) <= "z")) &
var=trim(var)//trim(str(i:i))
end do
Although, I also don't know how I could get the specific string length where the signs appear.
I wouldn't mess about with loops - I'd use the available intrinsic functions. Something like
ijb#ijb-Latitude-5410:~/work/stack$ cat binom.f90
Program binom
Implicit None
Character( Len = 100 ) :: expression
Character( Len = : ), Allocatable :: var1, var2
Write( *, '( a )' ) 'Expression?'
Read ( *, '( a )' ) expression
Call split_it( expression, var1, var2 )
If( Len( var1 ) /= 0 .And. Len( var2 ) /= 0 ) Then
Write( *, '( a, a, t20, i0 )' ) 'Var1 = ', var1, Len( var1 )
Write( *, '( a, a, t20, i0 )' ) 'Var2 = ', var2, Len( var2 )
Else
Write( *, * ) 'No + or - in the string'
End If
Contains
Subroutine split_it( expression, var1, var2 )
Implicit None
Character( Len = * ), Intent( In ) :: expression
Character( Len = : ), Allocatable, Intent( Out ) :: var1
Character( Len = : ), Allocatable, Intent( Out ) :: var2
Integer :: split_pos
Integer :: paren_pos
split_pos = Scan( expression, '+-' )
If( split_pos /= 0 ) Then
var1 = Trim( Adjustl( expression( :split_pos - 1 ) ) )
paren_pos = Scan( var1, '(' )
var1 = Trim( Adjustl( var1( paren_pos + 1: ) ) )
var2 = Trim( Adjustl( expression( split_pos + 1: ) ) )
paren_pos = Scan( var2, ')' )
var2 = Trim( Adjustl( var2( :paren_pos - 1 ) ) )
Else
Allocate( Character( Len = 0 ) :: var1 )
Allocate( Character( Len = 0 ) :: var2 )
End If
End Subroutine split_it
End Program binom
ijb#ijb-Latitude-5410:~/work/stack$ gfortran --version
GNU Fortran (Ubuntu 9.3.0-17ubuntu1~20.04) 9.3.0
Copyright (C) 2019 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
ijb#ijb-Latitude-5410:~/work/stack$ gfortran -Wall -Wextra -fcheck=all -std=f2008 -g binom.f90
ijb#ijb-Latitude-5410:~/work/stack$ ./a.out
Expression?
(x+y)^3
Var1 = x 1
Var2 = y 1
ijb#ijb-Latitude-5410:~/work/stack$ ./a.out
Expression?
(qwerty-asdf)^12
Var1 = qwerty 6
Var2 = asdf 4
ijb#ijb-Latitude-5410:~/work/stack$ ./a.out
Expression?
( aag + fg ) ^98
Var1 = aag 3
Var2 = fg 2
ijb#ijb-Latitude-5410:~/work/stack$ ./a.out
Expression?
wibble
No + or - in the string
I am new to MPI programming with Fortran. I want to plot a 2D graph. I am trying to let each processor calculate one point of graph and send it to root to write it on file. Can somebody tell me how to send two variables viz: x and f(x) with mpi_gather. Thanks for any help.
Just as an example of both what Hristo said and " Is there anything wrong with passing an unallocated array to a routine without an explicit interface? " here's how you might do it
Program gather
Use mpi
Implicit None
Integer, Dimension( :, : ), Allocatable :: result
Integer, Dimension( 1:2 ) :: buffer
Integer :: me, nprocs, error
Integer :: x, fx
Call mpi_init( error )
Call mpi_comm_rank( mpi_comm_world, me , error )
Call mpi_comm_size( mpi_comm_world, nprocs, error )
If( me == 0 ) Then
Allocate( result( 1:2, 1:nprocs ) ) !Naughty - should check stat
Else
Allocate( result( 1:0, 1:0 ) ) !Naughty - should check stat
End If
x = me
fx = x * x
buffer( 1 ) = x
buffer( 2 ) = fx
Call mpi_gather( buffer, 2, mpi_integer, &
result, 2, mpi_integer, &
0, mpi_comm_world, error )
If( me == 0 ) Then
Write( *, '( 99999( i3, 1x ) )' ) result( 1, : )
Write( *, '( 99999( i3, 1x ) )' ) result( 2, : )
End If
Call mpi_finalize( error )
End Program gather
Wot now? mpif90 gather.f90
Wot now? mpirun -np 7 ./a.out
0 1 2 3 4 5 6
0 1 4 9 16 25 36