AnotherFoxGuy/autocmake
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fortran code cosmetics

Browse Source
This commit is contained in:
Radovan Bast 2015-08-04 11:44:57 +02:00
parent 792b66f037
commit c89a15ef58
1 changed files with 27 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
test/fc_lapack/src/example.F90
View File

@ -1,24 +1,40 @@
program example program example
implicit none implicit none
integer, parameter :: n = 3 integer, parameter :: n = 3
integer :: info real(8), parameter :: small = 1.0d-12
integer :: ierr
real(8) :: a(n, n) real(8) :: a(n, n)
real(8) :: b(n) real(8) :: b(n)
integer :: ipiv(n) integer :: ipiv(n)
logical :: roots_ok=.false. logical :: roots_ok
data a /2,1,3,2,6,8,6,8,18/ a(1, 1) = 2.0d0
data b /1,3,5/ a(2, 1) = 1.0d0
a(3, 1) = 3.0d0
a(1, 2) = 2.0d0
a(2, 2) = 6.0d0
a(3, 2) = 8.0d0
a(1, 3) = 6.0d0
a(2, 3) = 8.0d0
a(3, 3) = 18.0d0
call dgesv( n, 1, a, n, ipiv, b, n , info ) b(1) = 1.0d0
if (info.gt.0) stop "error in dgesv routine !" b(2) = 3.0d0
b(3) = 5.0d0
! roots are -0.5, 0.25, 0.25 call dgesv(n, 1, a, n, ipiv, b, n, ierr)
roots_ok=dabs(b(1)+0.5).le.1d-12.and.dabs(b(2)-0.25).le.1d-12.and.dabs(b(3)-0.25).le.1d-12 if (ierr /= 0) stop "error in dgesv routine!"
roots_ok = dabs(b(1) + 0.50d0) <= small .and. &
dabs(b(2) - 0.25d0) <= small .and. &
dabs(b(3) - 0.25d0) <= small
if (roots_ok) then if (roots_ok) then
print *, 'dgesv test ok' print *, 'dgesv test ok'
else else
stop 'dgesv test failed!' stop 'ERROR: dgesv test failed!'
endif endif
end program end program