I decided to use lapack subroutine dtrmm instead of matmul to multiply lower triangular (d,d) matrix and general (d,n) matrix. However, it doesn't seem to work correctly. The following code compares results of matlum (top) and dtrmm
Program test
implicit none
integer, parameter :: n = 3, d = 3 ! arbitrary numbers, no luck with other values
integer :: i
real(8) :: a(d,d), b(d,n), c(d,n)
call random_number(a)
call random_number(b)
do i=2,d
a(1:i-1,i) = 0
end do
c = matmul(a,b)
call dtrmm('L','L','N','N',d,n,1,a,d,b,d) ! documentation linked in the question
print*, 'correct result : '
do i=1,d
print*, c(i,:)
end do
print*, 'dtrmm yields : '
do i=1,d
print*, b(i,:)
end do
End Program test
returns this
correct result :
0.75678922130735249 0.51830058846965921 0.51177304237548271
1.1974740765385026 0.46115246753697681 0.98237114765741340
0.98027798241945430 0.53718796235743815 1.0328498570683342
dtrmm yields :
6.7262070844500211E+252 4.6065628207770121E+252 4.5485471599475983E+252
1.0642935166471391E+253 4.0986405551607272E+252 8.7311388520015068E+252
8.7125351741793473E+252 4.7744304178222945E+252 9.1797845822711462E+252
Other lapack suboutines I used work fine. What could be causing this to misbehave? Is this a bug, or have I just badly misunderstood something?
It is a simple data type error. The factor alpha must be of type double precision whereas you supplied an integer of default kind.
Thus
...
! call dtrmm('L','L','N','N',d,n,1,a,d,b,d) WRONG
call dtrmm('L','L','N','N',d,n,1d0,a,d,b,d) ! note 1d0 instead of 1
...
gives the correct result.
Related
I've written a piece of FORTRAN code that solves first order differential equations, for example the one that is in the function at the momement. However, I want to use it for second order ODES (and eventually 2nd order coupled ODEs), but I'm struggling to adapt it. Here's the code:
program rungekutta
implicit none
integer :: istat
real(8)::a,b,h,y_0,t
write(*,*)"Enter interval a,b, step-size h and y_0"
read(*,*)a,b,h,y_0
open(unit=1, file="rungekutta.dat",status='replace', iostat=istat)
if (istat .ne. 0) stop 'error opening rungekutta.dat'
call RungeKuttaSub(y_0,a,b,h)
close(1)
contains
subroutine RungeKuttaSub(y_0,a,b,h)
implicit none
real(8), intent(inout)::a,h,b, y_0
real(8):: y,t, F_1, F_2, F_3, F_4
t=a
y=y_0
do while(t<=b)
F_1=h*f(y,t)
F_2=h*f(y+(1d0/2d0)*F_1, t+h*(1d0/2d0))
F_3=h*f(y+(1d0/2d0)*F_2, t+h*(1d0/2d0))
F_4=h*f(y+F_3,t+h)
y=y+(F_1+2d0*F_2+2d0*F_3+F_4)/6d0
write(1,*)t, y
t=t+h
end do
end subroutine
function f(y,t)
implicit none
real(8)::f,y,t,pi
pi=acos(-1d0)
f=-y+sin(pi*2d0*t)
end function
end program
So as you can see the differential in the function at the moment is y'(t) = -y(t) + sin(2*pi*t). How can I update this for 2nd order ODEs?
Thanks.
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
Hermite Interpolation woes
I am trying to find the Newton Dividing Differences for the function and derivative values of a given set of x's. I'm running into serious problems with my code working for tiny examples, but failing on bigger one's. As is clearly visible, my answers are very much larger than they original function values.
Does anybody have any idea what I'm doing wrong?
program inter
implicit none
integer ::n,m
integer ::i
real(kind=8),allocatable ::xVals(:),fxVals(:),newtonDivDiff(:),dxVals(:),zxVals(:),zdxVals(:),zfxVals(:)
real(kind=8) ::Px
real(kind=8) ::x
Open(Unit=8,File="data/xVals")
Open(Unit=9,File="data/fxVals")
Open(Unit=10,File="data/dxVals")
n = 4 ! literal number of data pts
m = n*2+1
!after we get the data points allocate the space
allocate(xVals(0:n))
allocate(fxVals(0:n))
allocate(dxVals(0:n))
allocate(newtonDivDiff(0:n))
!allocate the zvalue arrays
allocate(zxVals(0:m))
allocate(zdxVals(0:m))
allocate(zfxVals(0:m))
!since the size is the same we can read in one loop
do i=0,n
Read(8,*) xVals(i)
Read(9,*) fxVals(i)
Read(10,*) dxVals(i)
end do
! contstruct the z illusion
do i=0,m,2
zxVals(i) = xVals(i/2)
zxVals(i+1) = xVals(i/2)
zdxVals(i) = dxVals(i/2)
zdxVals(i+1) = dxVals(i/2)
zfxVals(i) = fxVals(i/2)
zfxVals(i+1) = fxVals(i/2)
end do
!slightly modified business as usual
call getNewtonDivDiff(zxVals,zdxVals,zfxVals,newtonDivDiff,m)
do i=0,n
call evaluatePolynomial(m,newtonDivDiff,xVals(i),Px,zxVals)
print*, xVals(i) ,Px
end do
close(8)
close(9)
close(10)
stop
deallocate(xVals,fxVals,dxVals,newtonDivDiff,zxVals,zdxVals,zfxVals)
end program inter
subroutine getNewtonDivDiff(xVals,dxVals,fxVals,newtonDivDiff,n)
implicit none
integer ::i,k
integer, intent(in) ::n
real(kind=8), allocatable,dimension(:,:) ::table
real(kind=8),intent(in) ::xVals(0:n),dxVals(0:n),fxVals(0:n)
real(kind=8), intent(inout) ::newtonDivDiff(0:n)
allocate(table(0:n,0:n))
table = 0.0d0
do i=0,n
table(i,0) = fxVals(i)
end do
do k=1,n
do i = k,n
if( k .eq. 1 .and. mod(i,2) .eq. 1) then
table(i,k) = dxVals(i)
else
table(i,k) = (table(i,k-1) - table(i-1,k-1))/(xVals(i) - xVals(i-k))
end if
end do
end do
do i=0,n
newtonDivDiff(i) = table(i,i)
!print*, newtonDivDiff(i)
end do
deallocate(table)
end subroutine getNewtonDivDiff
subroutine evaluatePolynomial(n,newtonDivDiff,x,Px,xVals)
implicit none
integer,intent(in) ::n
real(kind=8),intent(in) ::newtonDivDiff(0:n),xVals(0:n)
real(kind=8),intent(in) ::x
real(kind=8), intent(out) ::Px
integer ::i
Px = newtonDivDiff(n)
do i=n,1,-1
Px = Px * (x- xVals(i-1)) + newtonDivDiff(i-1)
end do
end subroutine evaluatePolynomial
Values
x f(x) f'(x)
1.16, 1.2337, 2.6643
1.32, 1.6879, 2.9989
1.48, 2.1814, 3.1464
1.64, 2.6832, 3.0862
1.8, 3.1553, 2.7697
Output
1.1599999999999999 62.040113431002474
1.3200000000000001 180.40121445431600
1.4800000000000000 212.36319446149312
1.6399999999999999 228.61845650513027
1.8000000000000000 245.11610836104515
You are accessing array newtonDivDiff out of bounds.
You are first allocating it as 0:n (main program's n) then you are passing to subroutine getNewtonDivDiff as 0:n (the subroutine's n) but you pass m (m=n*2+1) to the argument n. That means you tell the subroutine that the array has bounds 0:m which is 0:9, but it has only bounds 0:4.
It is quite difficult to debug the program as it stands, I had to use valgrind. If you move your subroutines to a module and change the dummy arguments to assumed shape arrays (:,:) then the bound checking in gfortran (-fcheck=all) will catch the error.
Other notes:
kind=8 is ugly, 8 can mean different things for different compilers. If you want 64bit variables, you can use kind=real64 (real64 comes from module iso_fortran_env in Fortran 2008) or use selected_real_kind() (Fortran 90 kind parameter)
You do not have to deallocate your local arrays in the subroutines, they are deallocated automatically.
Your deallocate statement in the main program is after the stop statement, it will never be executed. I would just delete the stop, there is no reason to have it.
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.
I've been trying to find a standards-compliant way to check for Infinite and NaN values in Fortran 90/95 but it proved harder than I thought.
I tried to manually create Inf and NaN variables using the binary representation described in IEEE 754, but I found no such functionality.
I am aware of the intrinsic ieee_arithmetic module in Fortran 2003 with the ieee_is_nan() and ieee_is_finite() intrinsic functions. However it's not supported by all the compilers (notably gfortran as of version 4.9).
Defining infinity and NaN at the beginning like pinf = 1. / 0 and nan = 0. / 0 seems hackish to me and IMHO can raise some building problems - for example if some compilers check this in compile time one would have to provide a special flag.
Is there a way I can implement in standard Fortran 90/95?
function isinf(x)
! Returns .true. if x is infinity, .false. otherwise
...
end function isinf
and isnan()?
The simple way without using the ieee_arithmatic is to do the following.
Infinity: Define your variable infinity = HUGE(dbl_prec_var) (or, if you have it, a quad precision variable). Then you can simply check to see if your variable is infinity by if(my_var > infinity).
NAN: This is even easier. By definition, NAN is not equal to anything, even itself. Simply compare the variable to itself: if(my_var /= my_var).
I don't have enough rep to comment so I'll "answer" regarding Rick Thompson's suggestion for testing infinity.
if (A-1 .eq. A)
This will also be true if A is a very large floating point number, and 1 is below the precision of A.
A simple test:
subroutine test_inf_1(A)
real, intent(in) :: A
print*, "Test (A-1 == A)"
if (A-1 .eq. A) then
print*, " INFINITY!!!"
else
print*, " NOT infinite"
endif
end subroutine
subroutine test_inf_2(A)
real, intent(in) :: A
print*, "Test (A > HUGE(A))"
if (A > HUGE(A)) then
print*, " INFINITY!!!"
else
print*, " NOT infinite"
endif
end subroutine
program test
real :: A,B
A=10
print*, "A = ",A
call test_inf_1(A)
call test_inf_2(A)
print*, ""
A=1e20
print*, "A = ",A
call test_inf_1(A)
call test_inf_2(A)
print*, ""
B=0.0 ! B is necessary to trick gfortran into compiling this
A=1/B
print*, "A = ",A
call test_inf_1(A)
call test_inf_2(A)
print*, ""
end program test
outputs:
A = 10.0000000
Test (A-1 == A)
NOT infinite
Test (A > HUGE(A))
NOT infinite
A = 1.00000002E+20
Test (A-1 == A)
INFINITY!!!
Test (A > HUGE(A))
NOT infinite
A = Infinity
Test (A-1 == A)
INFINITY!!!
Test (A > HUGE(A))
INFINITY!!!
No.
The salient parts of IEEE_ARITHMETIC for generating/checking for NaN's are easy enough to write for gfortran for a particular architecture.
I have used:
PROGRAM MYTEST
USE, INTRINSIC :: IEEE_ARITHMETIC, ONLY: IEEE_IS_FINITE
DOUBLE PRECISION :: number, test
number = 'the expression to test'
test = number/number
IF (IEEE_IS_FINITE(test)) THEN
WRITE(*,*) 'We are OK'
ELSE
WRITE(*,*) 'Got a problem'
END IF
WRITE(*,*) number, test
END PROGRAM MYTEST
This will print 'Got a problem' for number = 0.0D0, 1.0D0/0.0D0, 0.0D0/0.0D0, SQRT(-2.0D0), and also for overflows and underflows such as number = EXP(1.0D800) or number = EXP(-1.0D800). Notice that generally, things like number = EXP(1.0D-800) will just set number = 1.0 and produce a warning at compilation time, but the program will print 'We are OK', which I find acceptable.
OL.
for testing NaN none of the things worked eg.if testing real s2p to see if it is NaN then
if(isnan(s2p))
did not work in gfortran nor did
if(s2p.ne.s2p).
The only thing that worked was
if(.not.s2p<1.and..not.s2p>1)
though to make real sure u may want to add
if(.not.s2p<1.and..not.s2p>1.and..not.s2p==1)
No.
Neither is there a standards-compliant way of checking for infinities or NaNs in Fortran 90/95, nor can there be a standards-compliant way. There is no standards-compliant way of defining either of these quasi-numbers in Fortran 90/95.
For Fortran, 1/infinity=0
thus, divide your variable by zero
i.e
program test
implicit none
real :: res
integer :: i
do i=1,1000000
res=-log((1.+(10**(-real(i))))-1.)
print*,i,res
if ((1./res)==0.) then
exit
end if
end do
end program
there's your infinity check. No complication necessary.
For Inf it seems to work that if (A-1 .eq. A) is true, then A is Inf