Related
I am making a physics calculator in Fortran and I have run into a problem. Recently I had some assistance with my code that makes it possible to do, say, a speed calculation, and then go back to the menu to do a time calculation. However, I just added 2 other settings (E= mc2 and current/charge/time), with another menu to choose which one you want to use. My current code (which I will input below) only takes you back to the calculation menu. How would I go about making it so that after you click a button you go back to the main menu?
module kinematics
implicit none
real :: t, d, s
contains
subroutine time_from_distance_and_speed()
print *, 'Input distance in metres'
read *, d
print *, 'Input speed in metres per second'
read *, s
t = d / s
print*, 'Time is ', s
end subroutine
subroutine distance_from_speed_and_time()
print *, 'Input speed in metres per second'
read *, s
print *, 'Input time in seconds'
read *, t
d = s * t
print*, 'Distance is ', d
end subroutine
subroutine speed_from_time_and_distance()
print *, 'Input distance in metres'
read *, d
print *, 'Input time in seconds'
read *, t
s = d / t
print *, 'Speed is ', s
end subroutine
end module
module electronics
implicit none
real :: Q, I, T
contains
subroutine charge_from_current_and_time()
print *, 'Input current in amps'
read *, I
print *, 'Input time in seconds'
read *, T
Q = I * T
print*, 'Charge is ', Q
end subroutine
subroutine current_from_charge_and_time()
print *, 'Input charge in coulombs'
read *, Q
print *, 'Input time in seconds'
read *, T
I = Q/T
print*, 'Current is ', I
end subroutine
subroutine time_from_current_and_charge()
print *, 'Input current in coulombs'
read *, Q
print *, 'Input charge in amps'
read *, I
T = Q/I
print*,'time is ', T
end subroutine
end module
module energy
implicit none
real :: e, m, c
contains
subroutine energy_from_mass_and_lspeed()
print *, 'Warning- speed of light rounded to 300000000'
read *,
print *, 'Input mass in kilograms'
read *, m
c = 300000000
e = m * c * c
print*, 'Energy is ', e
end subroutine
end module
program bike
use kinematics
use electronics
use energy
implicit none
integer :: gg, pp
print *, 'Press 0 for speed, distance, and time. Press 1 for current, charge and time. Press 2 for E= mc^2'
read *, pp
if ( pp == 0 ) then
do while(.true.)
print *, 'Press 1 for speed, 2 for distance, and 3 for time'
read *, gg
if(gg == 1) then
call speed_from_time_and_distance
else if(gg == 2) then
call distance_from_speed_and_time
else if(gg == 3) then
call time_from_distance_and_speed
end if
print *, 'Press 5 to exit the console, or press 4 to do another calculation'
read *, gg
if(gg== 5) then
exit
end if
end do
end if
if ( pp == 1 ) then
do while(.true.)
print *, 'Press 1 for charge, 2 for current, and 3 for time'
read *, gg
if(gg == 1) then
call charge_from_current_and_time
else if(gg == 2) then
call current_from_charge_and_time
else if(gg == 3) then
call time_from_current_and_charge
end if
print *, 'Press 5 to exit the console, or press 4 to do another calculation'
read *, gg
if(gg== 5) then
exit
end if
end do
end if
if ( pp == 2 ) then
do while(.true.)
call energy_from_mass_and_lspeed
print *, 'Press 5 to exit the console, or press 4 to do another calculation'
read *, gg
if(gg== 5) then
exit
end if
end do
end if
end program
I built a speed, distance, and time calculator. I thought that it would be cool if you could go back to the main menu and calculate time after your original calculation (as an example). How would I do this by using modules? Here are the modules I have created:
module menu
real :: s ! speed
real :: d ! distance
real :: t ! time
real :: gg ! this is how I am going to switch between distance, time, and speed
print *, 'Press 1 for speed, 2 for distance, and 3 for time'
read*, gg
end menu
module speed
print *, 'Input distance in metres'
read *, d
print *, 'Input time in seconds'
read *, t
s = d / t
print *, 'Speed is ', s
end speed
module stay or leave
print *, 'Press 4 to go back to menu, or press 5 to exit the console'
read *, gg
end stay or leave
module distance
print *, 'Input speed in metres per second'
read *, s
print *, 'Input time in seconds'
read *, t
d = s * t
print*, 'Distance is ', d
end distance
module time
print *, 'Input distance in metres'
read *, d
print *, 'Input speed in metres per second'
read *, s
t = d / s
print*, 'Time is ', s
end time
You are using module as a subroutine. A module is a collection of related subroutines, user types and other related data. There is no need to use modules in this example (at least not in the way it is shown above).
But if you had to use modules I have included an example below. The module definition contains the following subroutines
time_from_distance_and_speed()
distance_from_speed_and_time()
speed_from_time_and_distance()
and three common variables t, d, s used in the calculations. Although in general it not recommended re-using the same variables in different routines, this is done here for illustrative purposes to show how "global" variables can be defined in the module level.
Module
Here the module contains the variable definitions which are common to the procedures it contains. It also defines the three calculation processes.
module kinematics
implicit none
real :: t, d, s
contains
subroutine time_from_distance_and_speed()
print *, 'Input distance in metres'
read *, d
print *, 'Input speed in metres per second'
read *, s
t = d / s
print*, 'Time is ', s
end subroutine
subroutine distance_from_speed_and_time()
print *, 'Input speed in metres per second'
read *, s
print *, 'Input time in seconds'
read *, t
d = s * t
print*, 'Distance is ', d
end subroutine
subroutine speed_from_time_and_distance()
print *, 'Input distance in metres'
read *, d
print *, 'Input time in seconds'
read *, t
s = d / t
print *, 'Speed is ', s
end subroutine
end module
Program
Here the main program uses the module defined above and calls the appropriate method depending on the user input.
program bike
use kinematics
integer :: gg
do while(.true.)
print *, 'Press 1 for speed, 2 for distance, and 3 for time'
read*, gg
if(gg == 1) then
call speed_from_time_and_distance
else if(gg == 2) then
call distance_from_speed_and_time
else if(gg == 3) then
call time_from_distance_and_speed
end if
print *, 'Press 5 to exit the console, anything else will repeat'
read *, gg
if(gg== 5) then
exit
end if
end do
end program
I want to call a subroutine in the main program and also want to get the output of that subroutine in the main program but when I write the output in the subroutine its different than when I write it in the main program someone can tell me where I am wrong? while writing yy in subroutine and in main program gives different values.
subroutine zlamda(lamdaroot)
INTEGER N,NBMAX
REAL X1,X2
PARAMETER(N=100,NBMAX=20,X1=0.0,X2=3.141592/2.)
INTEGER i,nb
REAL zbrent,root,tol,xb1(NBMAX),xb2(NBMAX)
EXTERNAL zbrak,bess
REAL bess,lamdaroot,lamda
COMMON /flamda/ eL,z
nb=NBMAX
call zbrak(bess,X1,X2,N,xb1,xb2,nb)
do 200 i=1,nb
tol=(1.0e-6)*(xb1(i)+xb2(i))/2.0
lamdaroot=zbrent(bess,xb1(i),xb2(i),tol)
yy=lamdaroot
write(*,*)yy,'=lamdaroot=yy'
200 continue
return
END
FUNCTION bess(lamda)
REAL bss,lamda,zz,x
bess=0.5*sin(lamda)*sqrt(1.+3.*sin(lamda)**2)+(0.5/sqrt(3.))
+ *log(abs(sqrt(3.)*sin(lamda)+sqrt(1.+3.*sin(lamda)**2)))
+ -abs(zz)/4685.0
return
END
SUBROUTINE zbrak(fx,x1,x2,n,xb1,xb2,nb)
INTEGER n,nb
REAL x1,x2,xb1(nb),xb2(nb),fx
EXTERNAL fx
INTEGER i,nbb
REAL dx,fc,fp,x
nbb=0
x=x1
dx=(x2-x1)/n
fp=fx(x)
do 11 i=1,n
x=x+dx
fc=fx(x)
if(fc*fp.le.0.) then
nbb=nbb+1
xb1(nbb)=x-dx
xb2(nbb)=x
if(nbb.eq.nb)goto 1
endif
fp=fc
11 continue
1 continue
nb=nbb
return
END
FUNCTION zbrent(func,x1,x2,tol)
INTEGER ITMAX
REAL zbrent,tol,x1,x2,func,EPS
EXTERNAL func
PARAMETER (ITMAX=100,EPS=3.e-8)
INTEGER iter
REAL a,b,c,d,e,fa,fb,fc,p,q,r,s,tol1,xm
a=x1
b=x2
fa=func(a)
fb=func(b)
if((fa.gt.0..and.fb.gt.0.).or.(fa.lt.0..and.fb.lt.0.))pause
*'root must be bracketed for zbrent'
c=b
fc=fb
do 11 iter=1,ITMAX
if((fb.gt.0..and.fc.gt.0.).or.(fb.lt.0..and.fc.lt.0.))then
c=a
fc=fa
d=b-a
e=d
endif
if(abs(fc).lt.abs(fb)) then
a=b
b=c
c=a
fa=fb
fb=fc
fc=fa
endif
tol1=2.*EPS*abs(b)+0.5*tol
xm=.5*(c-b)
if(abs(xm).le.tol1 .or. fb.eq.0.)then
zbrent=b
return
endif
if(abs(e).ge.tol1 .and. abs(fa).gt.abs(fb)) then
s=fb/fa
if(a.eq.c) then
p=2.*xm*s
q=1.-s
else
q=fa/fc
r=fb/fc
p=s*(2.*xm*q*(q-r)-(b-a)*(r-1.))
q=(q-1.)*(r-1.)*(s-1.)
endif
if(p.gt.0.) q=-q
p=abs(p)
if(2.*p .lt. min(3.*xm*q-abs(tol1*q),abs(e*q))) then
e=d
d=p/q
else
d=xm
e=d
endif
else
d=xm
e=d
endif
a=b
fa=fb
if(abs(d) .gt. tol1) then
b=b+d
else
b=b+sign(tol1,xm)
endif
fb=func(b)
11 continue
pause 'zbrent exceeding maximum iterations'
zbrent=b
return
END
and main program is
program main
implicit none
real yy,lamdaroot
call zlamda(lamdaroot)
write(*,*)yy
stop
endprogram main
I have code that works fine to compute eigenvalues in my test case for ARPACK Shamelessly taken from here and adapted to a quick 4x4 matrix. (Comments at the top removed in my sample code for brevity).
Okay, my problem. I have very large matrices, or at least, I will for my actual problems. But, when I make the integers kind 16, ARPACK gives an error. Is there a simple way to convert the ARPACK functions to allow my 16 byte indexing of things? Or, is it possible to alter how it makes the library to allow for this? I made the library with gfortran.
Any insight would be greatly appreciated.
PLEASE NOTE: The code below has been edited (to actually run properly). I've also added 2 subroutines that may be useful for the folks getting started with ARPACK. Please forgive the change in format of the error print statements.
program main
implicit none
integer, parameter :: maxn = 256
integer, parameter :: maxnev = 10
integer, parameter :: maxncv = 25
integer, parameter :: ldv = maxn
intrinsic abs
real :: ax(maxn)
character :: bmat
real :: d(maxncv,2)
integer :: ido, ierr, info
integer :: iparam(11), ipntr(11)
integer ishfts, j, lworkl, maxitr, mode1, n, nconv, ncv, nev, nx, resid(maxn)
logical rvec
logical select(maxncv)
real sigma, tol, v(ldv,maxncv)
real, external :: snrm2
character ( len = 2 ) which
real workl(maxncv*(maxncv+8))
real workd(3*maxn)
real, parameter :: zero = 0.0E+00
!
! Set dimensions for this problem.
!
nx = 4
n = nx
!
! Specifications for ARPACK usage are set below:
!
!
! 2) NCV = 20 sets the length of the Arnoldi factorization.
! 3) This is a standard problem (indicated by bmat = 'I')
! 4) Ask for the NEV eigenvalues of largest magnitude
! (indicated by which = 'LM')
!
! See documentation in SSAUPD for the other options SM, LA, SA, LI, SI.
!
! NEV and NCV must satisfy the following conditions:
!
! NEV <= MAXNEV
! NEV + 1 <= NCV <= MAXNCV
!
nev = 3 ! Asks for 4 eigenvalues to be computed.
ncv = min(25,n)
bmat = 'I'
which = 'LM'
if ( maxn < n ) then
PRINT *, ' '
PRINT *, 'SSSIMP - Fatal error!'
PRINT *, ' N is greater than MAXN '
stop
else if ( maxnev < nev ) then
PRINT *, ' '
PRINT *, 'SSSIMP - Fatal error!'
PRINT *, ' NEV is greater than MAXNEV '
stop
else if ( maxncv < ncv ) then
PRINT *, ' '
PRINT *, 'SSSIMP - Fatal error!'
PRINT *, ' NCV is greater than MAXNCV '
stop
end if
!
! Specification of stopping rules and initial
! conditions before calling SSAUPD
!
! TOL determines the stopping criterion. Expect
! abs(lambdaC - lambdaT) < TOL*abs(lambdaC)
! computed true
! If TOL <= 0, then TOL <- macheps (machine precision) is used.
!
! IDO is the REVERSE COMMUNICATION parameter. Initially be set to 0 before the first call to SSAUPD.
!
! INFO on entry specifies starting vector information and on return indicates error codes
! Initially, setting INFO=0 indicates that a random starting vector is requested to
! start the ARNOLDI iteration.
!
! The work array WORKL is used in SSAUPD as workspace. Its dimension
! LWORKL is set as illustrated below.
!
lworkl = ncv * ( ncv + 8 )
tol = zero
info = 0
ido = 0
!
! Specification of Algorithm Mode:
!
! This program uses the exact shift strategy
! (indicated by setting PARAM(1) = 1).
!
! IPARAM(3) specifies the maximum number of Arnoldi iterations allowed.
!
! Mode 1 of SSAUPD is used (IPARAM(7) = 1).
!
! All these options can be changed by the user. For details see the
! documentation in SSAUPD.
!
ishfts = 0
maxitr = 300
mode1 = 1
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode1
!
! MAIN LOOP (Reverse communication loop)
!
! Repeatedly call SSAUPD and take actions indicated by parameter
! IDO until convergence is indicated or MAXITR is exceeded.
!
do
call ssaupd ( ido, bmat, n, which, nev, tol, resid, &
ncv, v, ldv, iparam, ipntr, workd, workl, &
lworkl, info )
if ( ido /= -1 .and. ido /= 1 ) then
exit
end if
call av ( nx, workd(ipntr(1)), workd(ipntr(2)) )
end do
!
! Either we have convergence or there is an error.
!
CALL dsaupderrormessage(info)
if ( info < 0 ) then
! Error message. Check the documentation in SSAUPD.
PRINT *, 'SSSIMP - Fatal error!'
PRINT *, ' Error with SSAUPD, INFO = ', info
PRINT *, ' Check documentation in SSAUPD.'
else
!
! No fatal errors occurred.
! Post-Process using SSEUPD.
!
! Computed eigenvalues may be extracted.
!
! Eigenvectors may be also computed now if
! desired. (indicated by rvec = .true.)
!
! The routine SSEUPD now called to do this
! post processing (Other modes may require
! more complicated post processing than mode1.)
!
rvec = .true.
call sseupd ( rvec, 'All', select, d, v, ldv, sigma, &
bmat, n, which, nev, tol, resid, ncv, v, ldv, &
iparam, ipntr, workd, workl, lworkl, ierr )
!
! Eigenvalues are returned in the first column of the two dimensional
! array D and the corresponding eigenvectors are returned in the first
! NCONV (=IPARAM(5)) columns of the two dimensional array V if requested.
!
! Otherwise, an orthogonal basis for the invariant subspace corresponding
! to the eigenvalues in D is returned in V.
!
CALL dseupderrormessage(ierr)
if ( ierr /= 0 ) then
PRINT *, 'SSSIMP - Fatal error!'
PRINT *, ' Error with SSEUPD, IERR = ', ierr
PRINT *, ' Check the documentation of SSEUPD.'
! Compute the residual norm|| A*x - lambda*x ||
! for the NCONV accurately computed eigenvalues and eigenvectors.
! (iparam(5) indicates how many are accurate to the requested tolerance)
!
else
nconv = iparam(5)
do j = 1, nconv
call av ( nx, v(1,j), ax )
call saxpy ( n, -d(j,1), v(1,j), 1, ax, 1 )
d(j,2) = snrm2 ( n, ax, 1)
d(j,2) = d(j,2) / abs ( d(j,1) )
end do
!
! Display computed residuals.
!
call smout ( 6, nconv, 2, d, maxncv, -6, &
'Ritz values and relative residuals' )
! 6: Output to screen Write(6, #internalnumber)
! nconv: number of rows in the matrix d
! 2: Number of columns in matrix d
! maxncv: Leading dimension of the matrix data
! -6: print the matrix d with iabs(-6) decimal digits per number
! Use formatting indexed by -6 to print A
end if
!
! Print additional convergence information.
!
if ( info == 1) then
PRINT *, ' '
PRINT *, ' Maximum number of iterations reached.'
else if ( info == 3) then
PRINT *, ' '
PRINT *, ' No shifts could be applied during implicit' &
// ' Arnoldi update, try increasing NCV.'
end if
PRINT *, ' '
PRINT *, 'SSSIMP:'
PRINT *, '====== '
PRINT *, ' '
PRINT *, ' Size of the matrix is ', n
PRINT *, ' The number of Ritz values requested is ', nev
PRINT *, &
' The number of Arnoldi vectors generated (NCV) is ', ncv
PRINT *, ' What portion of the spectrum: ' // which
PRINT *, &
' The number of converged Ritz values is ', nconv
PRINT *, &
' The number of Implicit Arnoldi update iterations taken is ', iparam(3)
PRINT *, ' The number of OP*x is ', iparam(9)
PRINT *, ' The convergence criterion is ', tol
end if
PRINT *, ' '
PRINT *, 'SSSIMP:'
PRINT *, ' Normal end of execution.'
! write ( *, '(a)' ) ' '
! call timestamp ( )
stop
end
!*******************************************************************************
!
!! Av computes w <- A * V where A is the matri used is
! | 1 1 1 1 |
! | 1 0 1 1 |
! | 1 1 0 1 |
! | 1 1 1 0 |
!
! Parameters:
! Input, integer NX, the length of the vectors.
! Input, real V(NX), the vector to be operated on by A.
! Output, real W(NX), the result of A*V.
!
!*******************************************************************************
subroutine av ( nx, v, w )
implicit none
integer nx
integer :: j, i, lo, n2
real, parameter :: one = 1.0E+00
real :: A(4,4)
real :: h2, temp, v(nx), w(nx)
A(:,:) = one
A(2,2) = 0.0E+00
A(3,3) = 0.0E+00
A(4,4) = 0.0E+00
do j= 1,4
temp = 0.0E+00
do i= 1,4
temp = temp + v(i)* A(i,j)
end do
w(j) = temp
end do
return
end subroutine
SUBROUTINE dsaupderrormessage(dsaupdinfo)
implicit none
integer :: dsaupdinfo
if (dsaupdinfo .EQ. 0) THEN
PRINT *, 'Normal Exit in dsaupd: info = 0.'
elseif (dsaupdinfo .EQ. -1) THEN
PRINT *, 'Error in dsaupd: info = -1.'
PRINT *, 'N must be positive.'
elseif (dsaupdinfo .EQ. -2) THEN
PRINT *, 'Error in dsaupd: info = -2.'
PRINT *, 'NEV must be positive.'
elseif (dsaupdinfo .EQ. -3) THEN
PRINT *, 'Error in dsaupd: info = -3.'
PRINT *, 'NCV must be between NEV and N. '
elseif (dsaupdinfo .EQ. -4) THEN
PRINT *, 'Error in dsaupd: info = -4'
PRINT *, 'The maximum number of Arnoldi update iterations allowed must be greater than zero.'
elseif (dsaupdinfo .EQ. -5) THEN
PRINT *, 'Error in dsaupd: info = -5'
PRINT *, 'WHICH must be LM, SM, LA, SA, or BE. info = -5.'
elseif (dsaupdinfo .EQ. -6) THEN
PRINT *, 'Error in dsauupd: info = -6. '
PRINT *, 'BMAT must be I or G. '
elseif (dsaupdinfo .EQ. -7) THEN
PRINT *, 'Error in dsaupd: info = -7.'
PRINT *, 'Length of private work work WORKL array isnt sufficient.'
elseif (dsaupdinfo .EQ. -8) THEN
PRINT *, 'Error in dsaupd: info = -8.'
PRINT *, 'Error in return from trid. eval calc. Error info from LAPACK dsteqr. info =-8'
elseif (dsaupdinfo .EQ. -9) THEN
PRINT *, 'Error in dsaupd: info = -9.'
PRINT *, 'Starting vector is 0.'
elseif (dsaupdinfo .EQ. -10) THEN
PRINT *, 'Error in dsaupd: info = -10. '
PRINT *, 'IPARAM(7) must be 1,2,3,4, or 5.'
elseif (dsaupdinfo .EQ. -11) THEN
PRINT *, 'Error in dsaupd: info = -11.'
PRINT *, 'IPARAM(7)=1 and BMAT=G are incompatible.'
elseif (dsaupdinfo .EQ. -12) THEN
PRINT *, 'Error in dsaupd: info = -12'
PRINT *, 'NEV and WHICH=BE are incompatible.'
elseif (dsaupdinfo .EQ. -13) THEN
PRINT *, 'Error in dsaupd: info = -13.'
PRINT *, 'DSAUPD did find any eigenvalues to sufficient accuracy.'
elseif (dsaupdinfo .EQ. -9999) THEN
PRINT *, 'Error in dsaupd: info = -9999'
PRINT *, 'Could not build an Arnoldi factorization. IPARAM(5) returns the size of the current Arnoldi factorization. &
The user is advised to check that enough workspace and array storage has been allocated. '
elseif (dsaupdinfo .EQ. 1) THEN
PRINT *, 'Error in dsaupd: info = 1'
PRINT *, 'Maximum number of iterations taken. All possible eigenvalues of OP has been found. '
PRINT *, 'IPARAM(5) returns the number of wanted converged Ritz values.'
elseif (dsaupdinfo .EQ. 3) THEN
PRINT *, 'Error in dsaupd: info =3'
PRINT *, 'No shifts could be applied during a cycle of the Implicitly restarted Arnoldi iteration.'
PRINT *, 'One possibility is to increase the size of NCV relative to NEV.'
else
PRINT *, 'Unknown error. info =', dsaupdinfo
END IF
end subroutine
SUBROUTINE dseupderrormessage(dseupdinfo)
implicit none
integer :: dseupdinfo
if (dseupdinfo .EQ. 0) THEN
PRINT *, 'Normal Exit in dseupd: info = 0.'
elseif (dseupdinfo .EQ. -1) THEN
PRINT *, 'Error in deseupd: N must be positive. info =-1.'
elseif (dseupdinfo .EQ. -2) THEN
PRINT *, 'Error in deseupd: NEV must be positive. info = -2.'
elseif (dseupdinfo .EQ. -3) THEN
PRINT *, 'Error in deseupd: NCV must be between NEV and N. info = -3.'
elseif (dseupdinfo .EQ. -5) THEN
PRINT *, 'Error in deseupd: WHICH must be LM, SM, LA, SA, or BE info = -5.'
elseif (dseupdinfo .EQ. -6) THEN
PRINT *, 'Error in deseupd: BMAT must be I or G. info = -6.'
elseif (dseupdinfo .EQ. -7) THEN
PRINT *, 'Error in deseupd: N Length of private work work WORKL array isnt sufficient. info = -7.'
elseif (dseupdinfo .EQ. -8) THEN
PRINT *, 'Error in deseupd: Error in return from trid. eval calc. Error info from LAPACK dsteqr. info = -8.'
elseif (dseupdinfo .EQ. -9) THEN
PRINT *, 'Error in deseupd: Starting vector is 0. info = -9.'
elseif (dseupdinfo .EQ. -10) THEN
PRINT *, 'Error in deseupd: IPARAM(7) must be 1,2,3,4, or 5. info = -10.'
elseif (dseupdinfo .EQ. -11) THEN
PRINT *, 'Error in deseupd: IPARAM(7)=1 and BMAT=G are incompatible. info = -11.'
elseif (dseupdinfo .EQ. -12) THEN
PRINT *, 'Error in deseupd: NEV and WHICH=BE are incompatible. info = -12.'
elseif (dseupdinfo .EQ. -14) THEN
PRINT *, 'Error in deseupd: DSAUPD did find any eigenvalues to sufficient accuracy. info = -14.'
elseif (dseupdinfo .EQ. -15) THEN
PRINT *, 'Error in deseupd: HOWMANY must one A or S if RVEC=1. info = -15.'
elseif (dseupdinfo .EQ. -16) THEN
PRINT *, 'Error in deseupd: HOWMANY =S not yet implemented. info = -16.'
elseif (dseupdinfo .EQ. -17) THEN
PRINT *, 'Error in deseupd: info =-17.'
PRINT *, 'DSEUPD got a different count of the number of converged Ritz values than DSAUPD.'
PRINT *, 'User likely made an error in passing data DSAUPD -> DSEUPD. info = -17.'
else
PRINT *, 'Unknown error. info =', dseupdinfo
END IF
end subroutine
I'm try to compile a Fortran application to write HDF5 files. My compiler is gfortran 4.7.2. Specifically, I'm trying to create a dataspace with a certain set of current dimensions and maximum dimensions. I want the last dimension to have an unlimited maximum dimension. There isn't much documentation for Fortran HDF5, but I was able to figure out that this can be specified by setting that dimension in question to H5S_UNLIMITED_F. This value is supposed to evaluate to -1, but in my application it instead evaluates to 0, which causes a runtime error because 0 is less than the corresponding current dimension (in my case, 20). This is the error:
HDF5-DIAG: Error detected in HDF5 (1.8.11) thread 0:
#000: H5S.c line 1388 in H5Screate_simple(): maxdims is smaller than dims
major: Invalid arguments to routine
minor: Bad value
I compiled one of the Fortran examples that came with HDF5 that uses the same H5S_UNLIMITED_F parameter (h5_extend.f90), but for that application, the parameter evaluates to -1 and there is no problem.
What might I be doing wrong?
Below is a test program I wrote to replicate the problem seen in my project:
program simple_test
use hdf5
implicit none
integer :: irank, hdferr
integer(hsize_t) :: ny, nx, nz
real, dimension(:,:,:), allocatable :: dset
character (len = 256) :: hdf_file, dlab
integer(hid_t) :: file_handle, mem_space, file_space, dset_handle
integer(hsize_t), dimension(:), allocatable :: dim_array, max_array
irank = 3
ny = 10
nx = 15
nz = 20
allocate (dset(ny, nx, nz))
hdf_file = 'simple_test.hdf5'
dlab = 'simple_data'
allocate (dim_array(irank))
allocate (max_array(irank))
dim_array = (/ ny, nx, nz /)
max_array = (/ ny, nx, H5S_UNLIMITED_F /)
print *, 'h5s_unlimited_f: ', h5s_unlimited_f
print *, 'dim_array: ', dim_array
print *, 'max_array: ', max_array
call h5open_f(hdferr)
if (hdferr .eq. -1) then
print *, 'Error opening HDF5 Fortran interface.'
end if
! Create a new file.
call h5fcreate_f(hdf_file, H5F_ACC_TRUNC_F, file_handle, hdferr)
if (hdferr .eq. -1) then
print *, 'Error creating HDF5 file.'
end if
! Create memory dataspace.
call h5screate_simple_f(irank, dim_array, mem_space, hdferr, max_array)
if (hdferr .eq. -1) then
print *, 'Error creating HDF5 memory dataspace.'
end if
! Create the dataset.
call h5dcreate_f(file_handle, trim(dlab), H5T_IEEE_F32LE, mem_space, &
dset_handle, hdferr)
if (hdferr .eq. -1) then
print *, 'Error creating HDF5 dataset.'
end if
! Create file dataspace.
call h5screate_simple_f(irank, dim_array, file_space, hdferr, max_array)
if (hdferr .eq. -1) then
print *, 'Error creating HDF5 file dataspace.'
end if
call h5dwrite_f(dset_handle, H5T_IEEE_F32LE, dset, dim_array, hdferr, &
mem_space, file_space)
if (hdferr .eq. -1) then
print *, 'Error writing HDF5 dataset.'
end if
call h5close_f(hdferr)
if (hdferr .eq. -1) then
print *, 'Error closing HDF5 Fortran interface.'
end if
deallocate (dset)
deallocate (dim_array)
deallocate (max_array)
end program simple_test
The first call to h5s_create_simple_f is what fails. If I change the memory dataspace to not use the max_array parameter (since it is optional and in my case perhaps unnecessary), then I still get the same error on the second call to h5s_create_simple_f.
I'm compiling as follows:
gfortran -c simple_test.f90 -o simple_test.o -I<hdf5_include_path>
gfortran -o simple_test simple_test.o -L<hdf5_lib_path> -lhdf5_fortran -lhdf5hl_fortran
I've also tried setting max_array(irank) to -1, but that yields an entirely different error.
(The original issue was that H5S_UNLIMITED_F is a variable that is initialised by a call to H5open_f, referencing it before that initialization is not permitted.)
Are you sure that the call to H5S_create_simple_f is what fails? Your traceback indicates an error from the dataset portion of the library.
I would expect a failure from dataset creation, because for variable sized datasets you need to specify the chunk size. Create a property list using H5Pcreate_f, then set the chunk size using H5Pset_chunk_f, then provide that property list after the error argument in the call to H5Dcreate_f. Comment if that doesn't make sense and I'll dig out an example.