I have a code in Fortran IV that I need to run. I was told to try to compile it in Fortran 77 and fix the error. So I named the file with a .f extension and tried to compile it with gfortran. I got the next error referring to the Fortran IV function copied below:
abel.f:432.24:
REAL FUNCTION DGDT*8(IX,NV,XNG,FNG,GNG,X)
1
Error: Expected formal argument list in function definition at (1)
Since I'm not too familiar with Fortran I'd appreciate if someone can tell me how to fix this problem .
REAL FUNCTION DGDT*8(IX,NV,XNG,FNG,GNG,X) AAOK0429
C AAOK0430
C THIS SUBROUTINE COMPUTES THE VALUE OF THE DERIVATIVE OF THE AAOK0431
C G-FUNCTION FOR A SLIT TRANSMISSION FUNCTION GIVEN BY A AAOK0432
C PIECE-WISE CUBIC SPLINE , WHOSE PARAMETERS ARE AAOK0433
C CONTAINED IN XNG,FNG AND GNG. AAOK0434
C AAOK0435
IMPLICIT REAL*8(A-H,O-Z) AAOK0436
C AAOK0437
C ALLOWABLE ROUNDING ERROR ON POINTS AT EXTREAMS OF KNOT RANGE AAOK0438
C IS 2**IEPS*MAX(!XNG(1)!,!XNG(NV)!). AAOK0439
INTEGER*4 IFLG/0/,IEPS/-50/ AAOK0440
DIMENSION XNG(1),FNG(1),GNG(1) AAOK0441
C AAOK0442
C TEST WETHER POINT IN RANGE. AAOK0443
IF(X.LT.XNG(1)) GO TO 990 AAOK0444
IF(X.GT.XNG(NV)) GO TO 991 AAOK0445
C AAOK0446
C ESTIMATE KNOT INTERVAL BY ASSUMING EQUALLY SPACED KNOTS. AAOK0447
12 J=DABS(X-XNG(1))/(XNG(NV)-XNG(1))*(NV-1)+1 AAOK0448
C ENSURE CASE X=XNG(NV) GIVES J=NV-1 AAOK0449
J=MIN0(J,NV-1) AAOK0450
C INDICATE THAT KNOT INTERVAL INSIDE RANGE HAS BEEN USED. AAOK0451
IFLG=1 AAOK0452
C SEARCH FOR KNOT INTERVAL CONTAINING X. AAOK0453
IF(X.LT.XNG(J)) GO TO 2 AAOK0454
C LOOP TILL INTERVAL FOUND. AAOK0455
1 J=J+1 AAOK0456
11 IF(X.GT.XNG(J+1)) GO TO 1 AAOK0457
GO TO 7 AAOK0458
2 J=J-1 AAOK0459
IF(X.LT.XNG(J)) GO TO 2 AAOK0460
C AAOK0461
C CALCULATE SPLINE PARAMETERS FOR JTH INTERVAL. AAOK0462
7 H=XNG(J+1)-XNG(J) AAOK0463
Q1=H*GNG(J) AAOK0464
Q2=H*GNG(J+1) AAOK0465
SS=FNG(J+1)-FNG(J) AAOK0466
B=3D0*SS-2D0*Q1-Q2 AAOK0467
A=Q1+Q2-2D0*SS AAOK0468
C AAOK0469
C CALCULATE SPLINE VALUE. AAOK0470
8 Z=(X-XNG(J))/H AAOK0471
C TF=((A*Z+B)*Z+Q1)*Z+FNG(J) AAOK0472
C TG=((3.*A*Z+2.*B)*Z+Q1)/H AAOK0473
C DGDT=(TG-TF/X)/X AAOK0474
DGDT=(3.*A*Z*Z+2.*B*Z+Q1)/H AAOK0475
RETURN AAOK0476
C TEST IF X WITHIN ROUNDING ERROR OF XNG(1). AAOK0477
990 IF(X.LE.XNG(1)-2D0**IEPS*DMAX1(DABS(XNG(1)),DABS(XNG(NV)))) GO AAOK0478
1 TO 99 AAOK0479
J=1 AAOK0480
GO TO 7 AAOK0481
C TEST IF X WITHIN ROUNDING ERROR OF XNG(NV). AAOK0482
991 IF(X.GE.XNG(NV)+2D0**IEPS*DMAX1(DABS(XNG(1)),DABS(XNG(NV)))) GO AAOK0483
1 TO 99 AAOK0484
J=NV-1 AAOK0485
GO TO 7 AAOK0486
99 IFLG=0 AAOK0487
C FUNCTION VALUE SET TO ZERO FOR POINTS OUTSIDE THE RANGE. AAOK0488
DGDT=0D0 AAOK0489
RETURN AAOK0490
END AAOK0491
This doesn't look so bad. Modern compilers still accept the real*8 syntax although it isn't standard. So you should (as mentioned) replace the line
REAL FUNCTION DGDT*8(IX,NV,XNG,FNG,GNG,X) AAOK0429
with
REAL*8 FUNCTION DGDT(IX,NV,XNG,FNG,GNG,X) AAOK0429
which compiled successfully for me using gfortran 4.6.2 using gfortran -c DGDT.f.
Good luck, and be on the lookout for other problems. Just because the code compiles does not mean it is running the same way it was designed!
Not really an answer, see the one from Ross. But I just can't stand the requirement for fixed form. Here is how this code probably would look like in F90 with free form:
function DGDT(IX, NV, XNG, FNG, GNG, X)
! THIS FUNCTION COMPUTES THE VALUE OF THE DERIVATIVE OF THE
! G-FUNCTION FOR A SLIT TRANSMISSION FUNCTION GIVEN BY A
! PIECE-WISE CUBIC SPLINE, WHOSE PARAMETERS ARE
! CONTAINED IN XNG,FNG AND GNG.
implicit none
integer, parameter :: rk = selected_real_kind(15)
integer :: ix, nv
real(kind=rk) :: dgdt
real(kind=rk) :: xng(nv)
real(kind=rk) :: fng(nv)
real(kind=rk) :: gng(nv)
real(kind=rk) :: x
! ALLOWABLE ROUNDING ERROR ON POINTS AT EXTREAMS OF KNOT RANGE
! IS 2**IEPS*MAX(!XNG(1)!,!XNG(NV)!).
integer, parameter :: ieps = -50
integer, save :: iflg = 0
integer :: j
real(kind=rk) :: tolerance
real(kind=rk) :: H
real(kind=rk) :: A, B
real(kind=rk) :: Q1, Q2
real(kind=rk) :: SS
real(kind=rk) :: Z
tolerance = 2.0_rk**IEPS * MAXVAL(ABS(XNG([1,NV])))
! TEST WETHER POINT IN RANGE.
if ((X < XNG(1) - tolerance) .or. (X > XNG(NV) + tolerance)) then
! FUNCTION VALUE SET TO ZERO FOR POINTS OUTSIDE THE RANGE.
iflg = 0
DGDT = 0.0_rk
return
end if
! ESTIMATE KNOT INTERVAL BY ASSUMING EQUALLY SPACED KNOTS.
J = abs(x-xng(1)) / (xng(nv)-xng(1)) * (nv-1) + 1
! ENSURE CASE X=XNG(NV) GIVES J=NV-1
J = MIN(J,NV-1)
! INDICATE THAT KNOT INTERVAL INSIDE RANGE HAS BEEN USED.
IFLG = 1
! SEARCH FOR KNOT INTERVAL CONTAINING X.
do
if ( (x >= xng(j)) .or. (j==1) ) EXIT
j = j-1
! LOOP TILL INTERVAL FOUND.
end do
do
if ( (x <= xng(j+1)) .or. (j==nv-1) ) EXIT
j = j+1
! LOOP TILL INTERVAL FOUND.
end do
! CALCULATE SPLINE PARAMETERS FOR JTH INTERVAL.
H = XNG(J+1) - XNG(J)
Q1 = H*GNG(J)
Q2 = H*GNG(J+1)
SS = FNG(J+1) - FNG(J)
B = 3.0_rk*SS - 2.0_rk*Q1 - Q2
A = Q1 + Q2 - 2.0_rk*SS
! CALCULATE SPLINE VALUE.
Z = (X-XNG(J))/H
DGDT = ( (3.0_rk*A*Z + 2.0_rk*B)*Z + Q1 ) / H
end function DGDT
Note, I did not test this in any way, also there might be some wrong guesses in there, like that ieps should be a constant. Also, I am not so sure about iflg, and the ix argument does not appear to be used at all. So I might got something wrong. For the tolerance it is better to use a factor instead of a difference and a 2.**-50 will not change the value for a the maxval in a double precision number here. Also note, I am using some other F90 features besides the free form now.
DISCLAIMER: Just mentioning a possible solution here, not recommending it...
As much as all other answers are valid and that supporting some Fortran IV code as is is a nightmare, you still might want / need to avoid touching it as much as possible. And since Fortran IV had some strange behaviours when it comes to loops for example (with loops always cycled at least once IINM), using a "proper" Fortran IV compiler might be a "good" idea.
Anyway, all this to say that the Intel compiler for example, supports Fortran IV natively with the -f66 compiler switch, and I'm sure other compilers do as well. This may be worth checking.
Related
I am converting f77 code to f90 code, and part of the code needs to sum over elements of a 3d matrix. In f77 this was accomplished by using 3 loops (over outer,middle,inner indices). I decided to use the f90 intrinsic sum (3 times) to accomplish this, and much to my surprise the answers differ. I am using the ifort compiler, have debugging, check-bounds, no optimization all turned on
Here is the f77-style code
r1 = 0.0
do k=1,nz
do j=1,ny
do i=1,nx
r1 = r1 + foo(i,j,k)
end do
end do
end do
and here is the f90 code
r = SUM(SUM(SUM(foo, DIM=3), DIM=2), DIM=1)
I have tried all sorts of variations, such as swapping the order of the loops for the f77 code, or creating temporary 2D matrices and 1D arrays to "reduce" the dimensions while using SUM, but the explicit f77 style loops always give different answers from the f90+ SUM function.
I'd appreciate any suggestions that help understand the discrepancy.
By the way this is using one serial processor.
Edited 12:13 pm to show complete example
! ifort -check bounds -extend-source 132 -g -traceback -debug inline-debug-info -mkl -o verify verify.f90
! ./verify
program verify
implicit none
integer :: nx,ny,nz
parameter(nx=131,ny=131,nz=131)
integer :: i,j,k
real :: foo(nx,ny,nz)
real :: r0,r1,r2
real :: s0,s1,s2
real :: r2Dfooxy(nx,ny),r1Dfoox(nx)
call random_seed
call random_number(foo)
r0 = 0.0
do k=1,nz
do j=1,ny
do i=1,nx
r0 = r0 + foo(i,j,k)
end do
end do
end do
r1 = 0.0
do i=1,nx
do j=1,ny
do k=1,nz
r1 = r1 + foo(i,j,k)
end do
end do
end do
r2 = 0.0
do j=1,ny
do i=1,nx
do k=1,nz
r2 = r2 + foo(i,j,k)
end do
end do
end do
!*************************
s0 = 0.0
s0 = SUM(SUM(SUM(foo, DIM=3), DIM=2), DIM=1)
s1 = 0.0
r2Dfooxy = SUM(foo, DIM = 3)
r1Dfoox = SUM(r2Dfooxy, DIM = 2)
s1 = SUM(r1Dfoox)
s2 = SUM(foo)
!*************************
print *,'nx,ny,nz = ',nx,ny,nz
print *,'size(foo) = ',size(foo)
write(*,'(A,4(ES15.8))') 'r0,r1,r2 = ',r0,r1,r2
write(*,'(A,3(ES15.8))') 'r0-r1,r0-r2,r1-r2 = ',r0-r1,r0-r2,r1-r2
write(*,'(A,4(ES15.8))') 's0,s1,s2 = ',s0,s1,s2
write(*,'(A,3(ES15.8))') 's0-s1,s0-s2,s1-s2 = ',s0-s1,s0-s2,s1-s2
write(*,'(A,3(ES15.8))') 'r0-s1,r1-s1,r2-s1 = ',r0-s1,r1-s1,r2-s1
stop
end
!**********************************************
sample output
nx,ny,nz = 131 131 131
size(foo) = 2248091
r0,r1,r2 = 1.12398225E+06 1.12399525E+06 1.12397238E+06
r0-r1,r0-r2,r1-r2 = -1.30000000E+01 9.87500000E+00 2.28750000E+01
s0,s1,s2 = 1.12397975E+06 1.12397975E+06 1.12398225E+06
s0-s1,s0-s2,s1-s2 = 0.00000000E+00-2.50000000E+00-2.50000000E+00
r0-s1,r1-s1,r2-s1 = 2.50000000E+00 1.55000000E+01-7.37500000E+00
First, welcome to StackOverflow. Please take the tour! There is a reason we expect a Minimal, Complete, and Verifiable example because we look at your code and can only guess at what might be the case and that is not too helpful for the community.
I hope the following suggestions helps you figure out what is going on.
Use the size() function and print what Fortran thinks are the sizes of the dimensions as well as printing nx, ny, and nz. As far as we know, the array is declared bigger than nx, ny, and nz and these variables are set according to the data set. Fortran does not necessarily initialize arrays to zero depending on whether it is a static or allocatable array.
You can also try specifying array extents in the sum function:
r = Sum(foo(1:nx,1:ny,1:nz))
If done like this, at least we know that the sum function is working on the exact same slice of foo that the loops loop over.
If this is the case, you will get the wrong answer even though there is nothing 'wrong' with the code. This is why it is particularly important to give that Minimal, Complete, and Verifiable example.
I can see the differences now. These are typical rounding errors from adding small numbers to a large sum. The processor is allowed to use any order of the summation it wants. There is no "right" order. You cannot really say that the original loops make the "correct" answer and the others do not.
What you can do is to use double precision. In extreme circumstances there are tricks like the Kahan summation but one rarely needs that.
Addition of a small number to a large sum is imprecise and especially so in single precision. You still have four significant digits in your result.
One typically does not use the DIM= argument, that is used in certain special circumstances.
If you want to sum all elements of foo, use just
s0 = SUM(foo)
That is enough.
What
s0 = SUM(SUM(SUM(foo, DIM=3), DIM=2), DIM=1)
does is that it will make a temporary 2D arrays with each element be the sum of the respective row in the z dimension, then a 1D array with each element the sum over the last dimension of the 2D array and then finally the sum of that 1D array. If it is done well, the final result will be the same, but it well eat a lot of CPU cycles.
The sum intrinsic function returns a processor-dependant approximation to the sum of the elements of the array argument. This is not the same thing as adding sequentially all elements.
It is simple to find an array x where
summation = x(1) + x(2) + x(3)
(performed strictly left to right) is not the best approximation for the sum treating the values as "mathematical reals" rather than floating point numbers.
As a concrete example to look at the nature of the approximation with ifort, we can look at the following program. We need to enable optimizations here to see effects; the importance of order of summation is apparent even with optimizations disabled (with -O0 or -debug).
implicit none
integer i
real x(50)
real total
x = [1.,(EPSILON(0.)/2, i=1, SIZE(x)-1)]
total = 0
do i=1, SIZE(x)
total = total+x(i)
print '(4F17.14)', total, SUM(x(:i)), SUM(DBLE(x(:i))), REAL(SUM(DBLE(x(:i))))
end do
end program
If adding up in strict order we get 1., seeing that anything smaller in magnitude than epsilon(0.) doesn't affect the sum.
You can experiment with the size of the array and order of its elements, the scaling of the small numbers and the ifort floating point compilation options (such as -fp-model strict, -mieee-fp, -pc32). You can also try to find an example like the above using double precision instead of default real.
So I am using the taylor series to calculate sin(0.75) in fortran 90 up until a certain point, so I need to run it in a do while loop (until my condition is met). This means I will need to use a factorial, here's my code:
program taylor
implicit none
real :: x = 0.75
real :: y
integer :: i = 3
do while (abs(y - sin(0.75)) > 10.00**(-7))
i = i + 2
y = x - ((x**i)/fact(i))
print *, y
end do
end program taylor
Where i've written fact(i) is where i'll need the factorial. Unfortunately, Fortran doesn't have an intrinsic ! function. How would I implement the function in this program?
Thanks.
The following simple function answers your question. Note how it returns a real, not an integer. If performance is not an issue, then this is fine for the Taylor series.
real function fact(n)
integer, intent(in) :: n
integer :: i
if (n < 0) error stop 'factorial is singular for negative integers'
fact = 1.0
do i = 2, n
fact = fact * i
enddo
end function fact
But the real answer is that Fortran 2008 does have an intrinsic function for the factorial: the Gamma function. For a positive integer n, it is defined such that Gamma(n+1) == fact(n).
(I can imagine the Gamma function is unfamiliar. It's a generalization of the factorial function: Gamma(x) is defined for all complex x, except non-positive integers. The offset in the definition is for historical reasons and unnecessarily confusing it you ask me.)
In some cases you may want to convert the output of the Gamma function to an integer. If so, make sure you use "long integers" via INT(Gamma(n+1), kind=INT64) with the USE, INTRINSIC :: ISO_Fortran_env declaration. This is a precaution against factorials becoming quite large. And, as always, watch out for mixed-mode arithmetic!
Here's another method to compute n! in one line using only inline functions:
product((/(i,i=1,n)/))
Of course i must be declared as an integer beforehand. It creates an array that goes from 1 to n and takes the product of all components. Bonus: It even works gives the correct thing for n = 0.
You do NOT want to use a factorial function for your Taylor series. That would meant computing the same terms over and over. You should just multiply the factorial variable in each loop iteration. Don't forget to use real because the integer will overflow quickly.
See the answer under the question of your schoolmate Program For Calculating Sin Using Taylor Expansion Not Working?
Can you write the equation which gives factorial?
It may look something like this
PURE FUNCTION Bang(N)
IMPLICIT NONE
INTEGER, INTENT(IN) :: N
INTEGER :: I
INTEGER :: Bang
Bang = N
IF(N == 2) THEN
Bang = 2
ELSEIF(N == 1) THEN
Bang = 1
ELSEIF(N < 1) THEN
WRITE(*,*)'Error in Bang function N=',N
STOP
ELSE
DO I = (N-1), 2, -1
Bang = Bang * I
ENDDO
ENDIF
RETURN
END FUNCTION Bang
I am using a computational fluid dynamics software that is compiled with gfortran version 4.8.5 on Ubuntu 16.04 LTS. The software can be compiled with either single precision or double precision and the -O3 optimization option. As I do not have the necessary computational resources to run the CFD software on double precision I am compiling it with single precision and the following options
ffpe-trap=invalid,zero,overflow
I am getting a SIGFPE error on a line of code that contains the asin function-
INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND( 6, 37) !< single precision
INTEGER, PARAMETER :: wp = sp
REAL(KIND=wp) zsm(:,:)
ela(i,j) = ASIN(zsm(ip,jp))
In other words the inverse sin function and this code is part of a doubly nested FOR loop with jp and ip as the indices. Currently the software staff is unable to help me for various other reasons and so I am trying to debug this on my own. The SIGFPE error is only being observed in the single precision compilation not double precision compilation.
I have inserted the following print statements in my code prior to the line of code that is failing i.e. the asin function call. Would this help me with unraveling the problem that I am facing ? This piece of code is executed for every time step and it is occurring after a series of time steps. Alternatively what other steps can I do to help me fix this problem ? Would adding "precision" to the compiler flag help ?
if (zsm(ip,jp) >= 1.0 .or. zsm(ip,jp) <= -1.0) then
print *,zsm(ip,jp),ip,jp
end if
EDIT
I took a look at this answer Unexpected behavior of asin in R and I am wondering whether I could do something similar in fortran i.e. by using the max function. If it goes below -1 or greater than 1 then round it off in the proper manner. How can I do it with gfortran using the max function ?
On my desktop the following program executes with no problems(i.e. it has the ability to handle signed zeros properly) and so I am guessing the SIGFPE error occurs with either the argument greater than 1 or less than -1.
program testa
real a,x
x = -0.0000
a = asin(x)
print *,a
end program testa
We have min and max functions in Fortran, so I think we can use the same method as in the linked page, i.e., asin( max(-1.0,min(1.0,x) ). I have tried the following test with gfortran-4.8 & 7.1:
program main
implicit none
integer, parameter :: sp = selected_real_kind( 6, 37 )
integer, parameter :: wp = sp
! integer, parameter :: wp = kind( 0.0 )
! integer, parameter :: wp = kind( 0.0d0 )
real(wp) :: x, a
print *, "Input x"
read(*,*) x
print *, "x =", x
print *, "equal to 1 ? :", x == 1.0_wp
print *, asin( x )
print *, asin( max( -1.0_wp, min( 1.0_wp, x ) ) )
end
which gives with wp = sp (or wp = kind(0.0) on my computer)
$ ./a.out
Input x
1.00000001
x = 1.00000000
equal to 1 ? : T
1.57079625 (<- 1.5707964 for gfortran-4.8)
1.57079625
$ ./a.out
Input x
1.0000001
x = 1.00000012
equal to 1 ? : F
NaN
1.57079625
and with wp = kind(0.0d0)
$ ./a.out
Input x
1.0000000000000001
x = 1.0000000000000000
equal to 1 ? : T
1.5707963267948966
1.5707963267948966
$ ./a.out
Input x
1.000000000000001
x = 1.0000000000000011
equal to 1 ? : F
NaN
1.5707963267948966
If it is necessary to modify a lot of asin(x) and the program relies on a C or Fortran preprocessor, it may be convenient to define some macro like
#define clamp(x) max(-1.0_wp,min(1.0_wp,x))
and use it as asin( clamp(x) ). If we want to remove such a modification, we can simply change the definition of clamp() as #define clamp(x) (x). Another approach may be to define some asin2(x) function that limits x to [-1,1] and replace the built-in asin by asin2 (either as a macro or a Fortran function).
I am now running a program for a certain iterations. The time step is 0.01. I want to write some information when a specific time is reached. For example:
program abc
implicit none
double precision :: time,step,target
integer :: x
time = 0.d0
step = 0.01
target = 5.d0
do x = 1,6000
time = time + step
"some equations here to calculate the model parameters"
if(time.eq.target)then
write(*,*) "model parameters"
endif
enddo
However, "time" never equals to 1.0 or 2.0 or etc. It shows like "0.999999866" instead of "1.0" and "1.99999845" instead of "2.0".
Although I can use integer "x" to define when to write the information, I prefer to use the time step. Also, I may want to change the time step (0.01/0.02/0.05/etc) or target (5.0/6.0/8.0/etc).
Does anyone knows how to fix this? Thanks ahead.
You have now discovered floating point arithmetic! Just ensure that the time is sufficiently close to the target.
if(abs(time-target) < 0.5d0*step ) then
...
should do the trick.
Floating point arithmetic is not perfect and your variables are always exact up to a certain machine error, depending on your variables' number format (32, 64, 128 bit). The following example illustrates well this characteristic:
PROGRAM main
USE, INTRINSIC :: ISO_FORTRAN_ENV, qp => real128
IMPLICIT NONE
REAL(qp) :: a, b, c
a = 128._qp
b = a/120._qp + 1
c = 120._qp*(b-1)
PRINT*, "a = ", a
PRINT*, "c = ", c
END PROGRAM main
Here is the output to this program with gfortran v.4.6.3:
a = 128.00000000000000000
c = 127.99999999999999999
Hey I am trying to get my LAPACK libraries to work and I have searched and searched but I can't seem to figure out what I am doing wrong.
I try running my code, and I get the following error
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
Backtrace for this error:
#0 0x7FFB23D405F7
#1 0x7FFB23D40C3E
#2 0x7FFB23692EAF
#3 0x401ED1 in sgesv_
#4 0x401D0B in MAIN__ at CFDtest.f03:? Segmentation fault (core dumped)
I will paste my main code here, hopefully someone can help me with this problem.
****************************************************
PROGRAM CFD_TEST
USE MY_LIB
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
DIMENSION ET(0:10), VN(0:10), WT(0:10)
DIMENSION SO(0:10), FU(0:10), DMA(0:10,0:10)
DIMENSION DMA2(0:10,0:10), QN(0:10), WKSPCE(0:10)
INTEGER*8 :: pivot(10), inf
INTEGER*8 :: N
EXTERNAL SGESV
!SET THE PARAMETERS
SIGMA1 = 0.D0
SIGMA2 = 0.D0
TAU = 1.D0
EF = 1.D0
EXP = 2.71828182845904509D0
COST = EXP/(1.D0+EXP*EXP)
DO 1 N=2, 10
!COMPUATION OF THE NODES, WEIGHTS AND DERIVATIVE MATRIX
CALL ZELEGL(N,ET,VN)
CALL WELEGL(N,ET,VN,WT)
CALL DMLEGL(N,10,ET,VN,DMA)
!CONSTRUCTION OF THE MATRIX CORRESPONDING TO THE
!DIFFERENTIAL OPERATOR
DO 2 I=0, N
DO 2 J=0, N
SUM = 0.D0
DO 3 K=0, N
SUM = SUM + DMA(I,K)*DMA(K,J)
3 CONTINUE
OPER = -SUM
IF(I .EQ. J) OPER = -SUM + TAU
DMA2(I,J) = OPER
2 CONTINUE
!CHANGE OF THE ENTRIES OF THE MATRIX ACCORDING TO THE
!BOUNDARY CONDITIONS
DO 4 J=0, N
DMA2(0,J) = 0.D0
DMA2(N,J) = 0.D0
4 CONTINUE
DMA2(0,0) = 1.D0
DMA2(N,N) = 1.D0
!CONSTRUCTION OF THE RIGHT-HAND SIDE VECTOR
DO 5 I=1, N-1
FU(I) = EF
5 CONTINUE
FU(0) = SIGMA1
FU(N) = SIGMA2
!SOLUTION OF THE LINEAR SYSTEM
N1 = N + 1
CALL SGESV(N,N,DMA2,pivot,FU,N,inf)
DO 6 I = 0, N
FU(I) = SO(I)
6 CONTINUE
PRINT *, pivot
1 CONTINUE
RETURN
END PROGRAM CFD_TEST
*****************************************************
The commands I run to compile are
gfortran -c MY_LIB.f03
gfortran -c CFDtest.f03
gfortran MY_LIB.o CFDtest.o -o CFDtest -L/usr/local/lib -llapack -lblas
I ran the command
-fbacktrace -g -Wall -Wextra CFDtest
CFDtest: In function _fini':
(.fini+0x0): multiple definition of_fini'
/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../x86_64-linux-gnu/crti.o:/build/buildd/glibc-2.19/csu/../sysdeps/x86_64/crti.S:80: first defined here
CFDtest: In function data_start':
(.data+0x0): multiple definition ofdata_start'
/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../x86_64-linux-gnu/crt1.o:(.data+0x0): first defined here
CFDtest: In function data_start':
(.data+0x8): multiple definition of__dso_handle'
/usr/lib/gcc/x86_64-linux-gnu/4.9/crtbegin.o:(.data+0x0): first defined here
CFDtest:(.rodata+0x0): multiple definition of _IO_stdin_used'
/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../x86_64-linux-gnu/crt1.o:(.rodata.cst4+0x0): first defined here
CFDtest: In function_start':
(.text+0x0): multiple definition of _start'
/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../x86_64-linux-gnu/crt1.o:(.text+0x0): first defined here
CFDtest: In function_init':
(.init+0x0): multiple definition of _init'
/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../x86_64-linux-gnu/crti.o:/build/buildd/glibc-2.19/csu/../sysdeps/x86_64/crti.S:64: first defined here
/usr/lib/gcc/x86_64-linux-gnu/4.9/crtend.o:(.tm_clone_table+0x0): multiple definition of__TMC_END'
CFDtest:(.data+0x10): first defined here
/usr/bin/ld: error in CFDtest(.eh_frame); no .eh_frame_hdr table will be created.
collect2: error: ld returned 1 exit status
You haven't posted your code for MY_LIB.f03 so we cannot compile CFDtest.f03 exactly as you have supplied it.
(As an aside, the usual naming convention is that f90 in a .f90 file is not supposed to imply the language version being targeted. Rather, .f90 denotes free format while .f is used for fixed format. By extension, your .f03 files would be better (i.e., more portable if) named as .f90.)
I commented out the USE MY_LIB line and ran your code through nagfor -u -c cfd_test.f90. The output, broken down, is
Extension: cfd_test.f90, line 13: Byte count on numeric data type
detected at *#8
Extension: cfd_test.f90, line 15: Byte count on numeric data type
detected at *#8
Byte counts are not portable. The kind value for an 8-byte integer is selected_int_kind(18). (Similarly you might like to use a kind(0.0d0) kind value for your double precision data.)
Error: cfd_test.f90, line 48: Implicit type for I
detected at 2#I
Error: cfd_test.f90, line 50: Implicit type for J
detected at 2#J
Error: cfd_test.f90, line 54: Implicit type for K
detected at 3#K
Error: cfd_test.f90, line 100: Implicit type for N1
detected at N1#=
You have these implicitly typed, which implies they are 4-byte (default) integers. You should probably declare these explicitly as 8-byte integers (using the 8-byte integer kind value above) if that's what you intend.
Questionable: cfd_test.f90, line 116: Variable COST set but never referenced
Questionable: cfd_test.f90, line 116: Variable N1 set but never referenced
Warning: cfd_test.f90, line 116: Unused local variable QN
Warning: cfd_test.f90, line 116: Unused local variable WKSPCE
You need to decide what you intend to do with these, or whether they are just deletable cruft.
With the implicit integers declared explicitly, there is further output
Warning: cfd_test.f90, line 116: Variable SO referenced but never set
This looks bad.
Obsolescent: cfd_test.f90, line 66: 2 is a shared DO termination label
Your DO loops would probably be better using the modern END DO terminators (not shared!)
Error: cfd_test.f90, line 114: RETURN is only allowed in SUBROUTINEs and FUNCTIONs
This is obviously easy to fix.
For the LAPACK call, one source of explicit interfaces for these routines is the NAG Fortran Library (through the nag_library module). Since your real data is not single precision, you should be using dgesv instead of sgesv. Adding USE nag_library, ONLY: dgesv and switching to call dgesv instead of sgesv, then recompiling as above, reveals
Incorrect data type INTEGER(KIND=4) (expected INTEGER) for argument N (no. 1) of DGESV
so you should indeed be using default (4-byte integers) - at least for the LAPACK build on your system, which will almost certainly be using 4-byte integers. Thus you might want to forget all about kinding your integers and just use the default integer type for all. Correcting this gives
Array supplied for scalar argument LDA (no. 4) of DGESV
so you do need to add this argument. Maybe pass size(DMA2,1)?
With this argument added to the call the code compiles successfully, but without the definitions for your *LEGL functions I couldn't go through any run-time testing.
Here is my modified (and pretty-printed) version of your program
Program cfd_test
! Use my_lib
! Use nag_library, Only: dgesv
Implicit None
Integer, Parameter :: wp = kind(0.0D0)
Real (Kind=wp) :: ef, oper, sigma1, sigma2, tau
Integer :: i, inf, j, k, n, sum
Real (Kind=wp) :: dma(0:10, 0:10), dma2(0:10, 0:10), et(0:10), fu(0:10), &
so(0:10), vn(0:10), wt(0:10)
Integer :: pivot(10)
External :: dgesv, dmlegl, welegl, zelegl
Intrinsic :: kind, size
! SET THE PARAMETERS
sigma1 = 0._wp
sigma2 = 0._wp
tau = 1._wp
ef = 1._wp
Do n = 2, 10
! COMPUATION OF THE NODES, WEIGHTS AND DERIVATIVE MATRIX
Call zelegl(n, et, vn)
Call welegl(n, et, vn, wt)
Call dmlegl(n, 10, et, vn, dma)
! CONSTRUCTION OF THE MATRIX CORRESPONDING TO THE
! DIFFERENTIAL OPERATOR
Do i = 0, n
Do j = 0, n
sum = 0._wp
Do k = 0, n
sum = sum + dma(i, k)*dma(k, j)
End Do
oper = -sum
If (i==j) oper = -sum + tau
dma2(i, j) = oper
End Do
End Do
! CHANGE OF THE ENTRIES OF THE MATRIX ACCORDING TO THE
! BOUNDARY CONDITIONS
Do j = 0, n
dma2(0, j) = 0._wp
dma2(n, j) = 0._wp
End Do
dma2(0, 0) = 1._wp
dma2(n, n) = 1._wp
! CONSTRUCTION OF THE RIGHT-HAND SIDE VECTOR
Do i = 1, n - 1
fu(i) = ef
End Do
fu(0) = sigma1
fu(n) = sigma2
! SOLUTION OF THE LINEAR SYSTEM
Call dgesv(n, n, dma2, size(dma2,1), pivot, fu, n, inf)
Do i = 0, n
fu(i) = so(i)
End Do
Print *, pivot
End Do
End Program
In general your development experience will be the most pleasant if you use as good a checking compiler as you can get your hands on and if you make sure you ask it to diagnose as much as it can for you.
As far as I can tell, there could be a number of problems:
Your integers with INTEGER*8 might be too long, maybe INTEGER*4 or simply INTEGER would be better
You call SGESV on double arguments instead of DGESV
Your LDA argument is missing, so your code should perhaps look like CALL DGESV(N,N,DMA2,N,pivot,FU,N,inf) but you need to check whether this is what you want.