I have a code as enclosed below. It is supposed to read a binary file and produce a special format. (This code is a part of siesta code.) However, I receive the following error when I execute the code:
At line 127 of file grid2cube.f (unit = 5, file = 'stdin')
Fortran runtime error: Bad real number in item 0 of list input
The fortran compiler and flags that I have compiled the main code are:
FC= /usr/local/bin/mpif90
FFLAGS=-g -O2 FPPFLAGS= -DMPI
-DFC_HAVE_FLUSH -DFC_HAVE_ABORT LDFLAGS=
This code is also compiled with the same flag:
/usr/local/bin/mpif90 -c -g -O2 grid2cube.f
/usr/local/bin/mpif90 -o grid2cube grid2cube.o
I also change "-O2" to "-O1" and "O0" and recompiled everything. But the same error was produced.Besides I am using mpich-3.0.4 and gfortran as the base.
Please kindly help me correct this error.
program grid2cube
implicit none
integer maxp, natmax, nskip
parameter (maxp = 12000000)
parameter (natmax = 1000)
integer ipt, isp, ix, iy, iz, i, ip, natoms, np,
. mesh(3), nspin, Ind, id(3), iix, iiy,
. iiz, ii, length, lb
integer is(natmax), izat(natmax)
character sysname*70, fnamein*75, fnameout(2)*75,
. fnamexv*75, paste*74, task*5, fform*12
double precision rho(maxp,2), rhot(maxp,2)
double precision cell(3,3), xat(natmax,3), cm(3), rt(3),
. delta(3), dr(3), residual
external paste, lb
c ---------------------------------------------------------------------------
read(*,*)
read(5,*) sysname
read(5,*) task
read(5,*) rt(1),rt(2),rt(3)
read(5,*) nskip
read(5,*) fform
fnamexv = paste(sysname,'.XV')
if (task .eq. 'rho') then
fnamein = paste(sysname,'.RHO')
else if (task .eq. 'drho') then
fnamein = paste(sysname,'.DRHO')
else if (task .eq. 'ldos') then
fnamein = paste(sysname,'.LDOS')
else if (task .eq. 'vt') then
fnamein = paste(sysname,'.VT')
else if (task .eq. 'vh') then
fnamein = paste(sysname,'.VH')
else if (task .eq. 'bader') then
fnamein = paste(sysname,'.BADER')
else
write(6,*) 'Wrong task'
write(6,*) 'Accepted values: rho, drho, ldos, vh, vt, bader'
write(6,*) '(in lower case!!!!)'
stop
endif
length = lb(fnamein)
write(6,*)
write(6,*) 'Reading grid data from file ',fnamein(1:length)
c read function from the 3D grid --------------------------------------------
open( unit=1, file=fnamein, form=fform, status='old' )
if (fform .eq. 'unformatted') then
read(1) cell
else if (fform .eq. 'formatted') then
do ix=1,3
read(1,*) (cell(iy,ix),iy=1,3)
enddo
else
stop 'ERROR: last input line must be formatted or unformatted'
endif
write(6,*)
write(6,*) 'Cell vectors'
write(6,*)
write(6,*) cell(1,1),cell(2,1),cell(3,1)
write(6,*) cell(1,2),cell(2,2),cell(3,2)
write(6,*) cell(1,3),cell(2,3),cell(3,3)
residual = 0.0d0
do ix=1,3
do iy=ix+1,3
residual = residual + cell(ix,iy)**2
enddo
enddo
if (residual .gt. 1.0d-6) then
write(6,*)
write(6,*) 'ERROR: this progam can only handle orthogonal cells'
write(6,*) ' with vectors pointing in the X, Y and Z directions'
stop
endif
if (fform .eq. 'unformatted') then
read(1) mesh, nspin
else
read(1,*) mesh, nspin
endif
write(6,*)
write(6,*) 'Grid mesh: ',mesh(1),'x',mesh(2),'x',mesh(3)
write(6,*)
write(6,*) 'nspin = ',nspin
write(6,*)
do ix=1,3
dr(ix)=cell(ix,ix)/mesh(ix)
enddo
np = mesh(1) * mesh(2) * mesh(3)
if (np .gt. maxp) stop 'grid2d: Parameter MAXP too small'
C read(1) ( (rho(ip,isp), ip = 1, np), isp = 1,nspin)
do isp=1,nspin
Ind=0
if (fform .eq. 'unformatted') then
do iz=1,mesh(3)
do iy=1,mesh(2)
read(1) (rho(Ind+ix,isp),ix=1,mesh(1))
Ind=Ind+mesh(1)
enddo
enddo
else
do iz=1,mesh(3)
do iy=1,mesh(2)
read(1,'(e15.6)') (rho(Ind+ix,isp),ix=1,mesh(1))
Ind=Ind+mesh(1)
enddo
enddo
endif
enddo
C translate cell
do ix=1,3
delta(ix) = rt(ix)/dr(ix)
id(ix) = delta(ix)
delta(ix) = rt(ix) - id(ix) * dr(ix)
enddo
do iz=1,mesh(3)
do iy=1,mesh(2)
do ix=1,mesh(1)
iix=ix+id(1)
iiy=iy+id(2)
iiz=iz+id(3)
if (iix .lt. 1) iix=iix+mesh(1)
if (iiy .lt. 1) iiy=iiy+mesh(2)
if (iiz .lt. 1) iiz=iiz+mesh(3)
if (iix .gt. mesh(1)) iix=iix-mesh(1)
if (iiy .gt. mesh(2)) iiy=iiy-mesh(2)
if (iiz .gt. mesh(3)) iiz=iiz-mesh(3)
if (iix .lt. 1) stop 'ix < 0'
if (iiy .lt. 1) stop 'iy < 0'
if (iiz .lt. 1) stop 'iz < 0'
if (iix .gt. mesh(1)) stop 'ix > cell'
if (iiy .gt. mesh(2)) stop 'iy > cell'
if (iiz .gt. mesh(3)) stop 'iz > cell'
i=ix+(iy-1)*mesh(1)+(iz-1)*mesh(1)*mesh(2)
ii=iix+(iiy-1)*mesh(1)+(iiz-1)*mesh(1)*mesh(2)
do isp=1,nspin
rhot(ii,isp)=rho(i,isp)
enddo
enddo
enddo
enddo
close(1)
open( unit=3, file=fnamexv, status='old', form='formatted')
read(3,*)
read(3,*)
read(3,*)
read(3,*) natoms
do i=1,natoms
read(3,*) is(i),izat(i),(xat(i,ix),ix=1,3)
enddo
do i=1,natoms
do ix=1,3
xat(i,ix)=xat(i,ix)+rt(ix)-delta(ix)
if (xat(i,ix) .lt. 0.0) xat(i,ix)=xat(i,ix)+cell(ix,ix)
if (xat(i,ix) .gt. cell(ix,ix))
. xat(i,ix)=xat(i,ix)-cell(ix,ix)
enddo
enddo
close(3)
if (nspin .eq. 1) then
fnameout(1) = paste(fnamein,'.cube')
else if (nspin .eq. 2) then
fnameout(1) = paste(fnamein,'.UP.cube')
fnameout(2) = paste(fnamein,'.DN.cube')
else
stop 'nspin must be either 1 or 2'
endif
do isp=1,nspin
length = lb(fnameout(isp))
write(6,*) 'Writing CUBE file ',fnameout(isp)(1:length)
C open( unit=2, file=fnameout(isp), status='new', form='formatted')
open( unit=2, file=fnameout(isp), form='formatted')
length = lb(fnameout(isp))
write(2,*) fnameout(isp)(1:length)
write(2,*) fnameout(isp)(1:length)
write(2,'(i5,4f12.6)') natoms, 0.0,0.0,0.0
do ix=1,3
ii = mesh(ix)/nskip
if (ii*nskip .ne. mesh(ix)) ii = ii+1
write(2,'(i5,4f12.6)')
. ii,(cell(ix,iy)/ii,iy=1,3)
enddo
do i=1,natoms
write(2,'(i5,4f12.6)') izat(i),0.0,(xat(i,ix),ix=1,3)
enddo
do ix=1,mesh(1),nskip
do iy=1,mesh(2),nskip
write(2,'(6e13.5)')
. (rhot(ix+(iy-1)*mesh(1)+(iz-1)*mesh(1)*mesh(2),isp),
. iz=1,mesh(3),nskip)
enddo
enddo
close(2)
enddo
write(6,*)
end
CHARACTER*(*) FUNCTION PASTE( STR1, STR2 )
C CONCATENATES THE STRINGS STR1 AND STR2 REMOVING BLANKS IN BETWEEN
C Writen by Jose M. Soler
CHARACTER*(*) STR1, STR2
DO 10 L = LEN( STR1 ), 1, -1
IF (STR1(L:L) .NE. ' ') GOTO 20
10 CONTINUE
20 PASTE = STR1(1:L)//STR2
END
INTEGER FUNCTION LB ( STR1 )
C RETURNS THE SIZE IF STRING STR1 WITH BLANKS REMOVED
C Writen by P. Ordejon from Soler's paste.f
CHARACTER*(*) STR1
DO 10 L = LEN( STR1 ), 1, -1
IF (STR1(L:L) .NE. ' ') GOTO 20
10 CONTINUE
20 LB = L
END
The statement at the error line is:
read(5,*) rt(1),rt(2),rt(3)
This is is a list-directed formatted read. As you indicated in the comment, you are trying to read binary (unformatted) data. That cannot work. The statement above expects formatted, data, that means text with human readable numbers.
Also the pre-connected unit 5 is standard input. It shouldn't work for unformatted data if you first read formatted from it (with read(5,*) sysname).
Side note: the number 5 for standard input is not standardized, but is quite a safe assumption in practice. But I would use * instead of 5 anyway.
Response to a comment:
The (*,*) also cannot work. Generally, whenever you provide a format, which is the second argument in the parenthesis to read or write, you do formatted i/o. It doesn't matter if the format is * or something different. You cannot read unformatted data this way. You have to open a file for the unformatted read with form=unformatted with any possible access and read it with:
read(file_unit_number) rt(1),rt(2),rt(3)
If you cannot read the numbers in the data file as a text you cannot use formatted read.
Related
This program:
C This program calculates cos(x**2)
PROGRAM COSX_SQUARE
IMPLICIT NONE
INTEGER a
REAL y, r
PRINT*, 'INPUT THE DEGREE'
PRINT*, 'BETWEEN 0 AND 360'
READ*, a
a*(3.141592/180) = y
C This part determines minus sign and calculates the function
IF (a .GT. 90) THEN
r = -(1-(y**4)/2+(y**8)/24-(y**12)/720+(y**16)/40320)
ELSEIF (a .GE. 270) THEN
r = 1-(y**4)/2+(y**8)/24-(y**12)/720+(y**16)/40320
ELSEIF (a .GT. 360) THEN
PRINT*, 'INVALID DEGREE'
PRINT*, 'DEGREE MUST BE BETWEEN 0 AND 360'
ELSEIF (a .LT. 0) THEN
PRINT*, 'INVALID DEGREE'
PRINT*, 'DEGREE MUST BE BETWEEN 0 AND 360'
END IF
PRINT*, 'THE RESULT OF COS', a, 'SQUARE IS = ', r
STOP
END
Gives this error:
a*(3.141592/180)=y
1
Error: Unclassifiable statement at (1)
I already defined a as INTEGER. Why this error keeps coming?
Yep. It is an expression which begins a statement. Maybe change it to
y = a*(3.141592/180)
if that is what you really meant.
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 trying to compile some Fortran code but I keep getting errors with the FORMAT statement. It says I'm missing brackets and characters but it looks fine to me. I am compiling it with silverfrost. The code is shown below:
! PROGRAM TO SOLVE DEEP-BED DRYING MODEL
!
! BASIC STATEMENTS
!
CHARACTER*20 FiIe1, File2
COMMON AMo
COMMON /DENS/ Pmo, Pme
COMMON /THICK/ dxo, Dxe
DIMENSION AM1(50), AM2(50), T(50), Gs(51), Vs(51), Ts(51), Dx(50), X(50)
!
!To define a number of statement functions
AMe(Ts)=0.62*EXP(-1.116*(Ts-100)**0.3339)
A(Ts, Vs)=(1.2925-0.00058*Ts) * (0.9991-0.0963*Vs)
AK(Ts, Vs)=(0.00273*Ts-0.2609)*(2.0984*Vs+0.2174)
AN(Ts)=0.00222*Ts+0.9599
Ps(Ts)=0.7401-0.001505*Ts
!
!INPUT SECTION OF THE PROGR.A,M
!
PRINT*, 'Input the mass of the sample (g) :'
READ*, Wo
PRINT*, 'Input the initial moisture content (db):'
READ*, AMo
PRINT*, 'lnput the depth of the sample bed (mm):'
READ*, Xo
PRINT*, 'Input the number of layers in the bed:'
READ*, Nx
PRINT*, 'Input the steam temperature at inlet (oC):'
READ*, Tso
PRINT*, 'input the steam flow rate at inlet (kg/(m2.s)):'
READ*, Gso
PRINT*, 'lnput the expected drying time (min):'
READ*, Timeo
PRINT*, 'lnput the time interval- (min) :'
READ*, Dt
!
! TO DEFINE AND OPEN DATA FILES
!
PRINT*, 'Name for the file recording the simulation +process:'
READ*, File1
OPEN (1, FILE=File1)
PRINT*, 'Name for the file recording major data:'
READ*, File2
OPEN (2, FILE=File2)
!
! TO WRITE INPUTTED PARAMETERS IN THE DATA FILES
!
WRITE (1, *) 'Mass of sample:', Wo, ' g'
WRITE (1, *) 'Initial moisture content:', AMo, ' kg/kg'
WRITE (1, *) 'Depth of sample bed:', Xo, 'mm'
WRITE (1, *) 'Number of layers in sample bed:', Nx
WRITE (1, *) 'Steam temperature at inlet', Tso, 'deg C'
WRITE (1, *) 'Steam flow rate at inlet', Gso, 'kg/m2s'
WRITE (1, *) 'Expected drying time', Timeo, ' min'
WRITE (1, *) 'Time interval:', Dt, ' min'
!
WRITE (2, *) 'Mass of sample', Wo, 'g'
WRITE (2, *) 'Initial moisture content', AMo, 'kg/kg'
WRITE (2, *) 'Depth of sample bed', Xo, 'mm'
WRITE (2, *) 'Number of layers in sample bed', Nx
WRITE (2, *) 'Steam temperature at inlet', Tso, ' deg C'
WRITE (2, *) 'Steam flow rate at inlet', Gso, ' kg/m2*s'
WRITE (2, *) 'Expected drying time', Timeo, ' min'
WRITE (2, *) 'Time interval:', Dt, ' min'
!
!BASIC CALCULATION BASED ON THE INPUT DATA
!
Dxo=Xo/1000/Nx
Dxe=0.867*Dxo
D1=0.066
Pmo=4*(Wo/l000)/(3.14159*D1**2*(Xo/1000)*(1+AMo))
Pme=Pmo/0.867
AMeo=AMe(Tso)
NT=NINT(Timeo/Dt)
Pso=Ps(Tso)
Vso=Gso/Pso
!
!TO SET VALUES FOR SOME PHYSTCAL AND THERMODYNAMTC PROPERTIES
!
Cs=2000
Cw1=4193
Cw=4313
C=1245
!
!TO CALCULATE THE INTTIAL MOISTURE CONTENT CONSIDERING STEAM CONDENSATION
!
AMo1=AMo+(C+Cw1*AMo)/(2257000+Cs*(Tso-100))*(100-10)
!
!TO SET JUDGE CRITERION FOR TERMINATING THE DRYING OF A LAYER
!(A small difference between moisture content and equilibrium moisture content)
DM=0.0001
!
!MAJOR DERIVATION FOR DRYING SIMULATION
!
J=0
Time=0
m=1
!
WRITE(2, 100)
100 FORMAT(4H J, 9H T(min), 8H M(db),7H Gs , 10H Ts(C) ,9H Front1, 5H L1, 9H Front2, 5h L2, 9H Depth)
!
200 m5=m-1
IF (J .GT. Nt) GO to 800
!
PRINT*, ' '
PRINT*, ' '
PRINT*, 'Time inverval:', J, ' Drying time:', Time, ' min'
WRITE(1, x) ' '
WRITE(1, *) 'Time interval:', J, ' Drying time:', Time, ' min'
WRITE(*, 300)
WRITE(1, 300)
300 FORMAT(1x, 3H, I, 7H, X(i), 8H M(i), 10H T(i), 10H Gs(i), 8H Ts(i))
!
AveM=0
!
! For dried region
!
IF(m .GT. 1) THEN
DO 500 i=1, m-1
Dx(i)=Dxe
X(i)=(i-0.5)*Dxe
AM1(i)=AM2(i)
T(i)=Tso
Gs(i)=Gso
Vs(i)=Vso
Ts(i)=Tso
AveM=AveM+AM1(i)
WRITE(*, 400) i, X(i), AM1(i), T(i), Gs(i), Ts(i)
WRITE(1, 400) i, X(i), AM1(i), T(i), Gs(i), Ts(i)
400 FORMAT(1X, I3, 2X, F6.4, 2X, F6.4, 2X, F8.3, 2X, F7.3, 2X, F7.3)
500 CONTINUE
ENDIF
! Calculation of the drying front position
IF (m .EQ. l) THEN
X1=-1
No1=-1
ELSE
Xl=X(m-1)+Dx(m-1)/2
No1=m-1
ENDIF
!
IF (m .GT. Nx) GO TO 900
!
Ts(m)=Tso
Vs(m)=Vso
L=0
DO 600 i=m, Nx
IF(L .NE.0) GO TO 510
!
! For drying region
!
If (J .EQ. O) THEN
Am1(i)=AMo1
Else
AM1(i)=AM2(i)
ENDIF
Dx(i)=Dxx(AM1(i))
IF (i .EQ. 1) THEN
X(i)=Dx(i)/2
ELSE
X(i)=X(i-1)+Dx(i-1)/2+Dx(i)/2
ENDIF
!
! To define transition variables
!
AMe5=AMe(Ts(i))
A5=A(Ts(i),Vs(i))
AK5=AK(Ts(i),Vs(i))
AN5=AN(Ts(i))
Ps5=Ps(Ts(i))
P5=P(AMl(i))
Dt5=Dt* 60
!
! Derivation
!
AMmax=A5*(AMo-AMe5)/EXP((AN5-1)/AN5)+AMe5
IF (AM1(i) .GE. AMmax) THEN
AM2(i)=AM1(i)-Dt5*AK5*AN5*(AMmax-AMe5)*(ALOG(A5*(AMo-AMe5)/(AMmax-AMe5))/AK5)**((AN5-1)/AN5)/60
ELSE
AM2(i)=AM1(i)-Dt5*AK5*AN5*(AM1(i)-AMe5)*(ALOG(A5*(AMo-AMe5)/(AM1(i)-AMe5))/AK5)**((AN5-1)/AN5)/60
ENDIF
DR=(AM2(i)-AM1(i))/Dt5
!
IF (AM1(i) .GE. AMo) THEN
T(i)=100
DerT=0
ELSE
T(i)=Tso-(Tso-100)*(AM1(i)-AMeo)/(AMo-AMeo)
DerT=-(Tso-l00)/(AMo-AMeo)*DR
ENDIF
!
Gs(i)=Vs(i)*Ps5
Gs(i+l)=Gs(i)-Dx(i)*P5*DR
Vs(i+1)=Gs(i+1)/Ps5
Hv5=Hv(AMl(i), T(i))
Ts(i+1)=Ts(i)+Dx(i)*P5*(Hv5+Cs*(Ts(i)-T(i)))/(Gs(i)*Cs)*DR-Dx(i)*P5*(C+Cw*AMl(i))/(Gs(i)*Cs)*DerT
!
! To find the first layer in wet region
!
IF (Ts(i+l) .LE. l00) THEN
Ts(i+1)=100
L=i
ENDIF
!
! To check if the layer has been dried to equilibrium
!
IF ((AM2(i)-AMeo) .LE. DM) THEN
m5=i
AM2(i)=AMeo
ENDIF
GO TO 520
!
! For wet region
!
510 AM1(i)=AMo1
AM2(i)=AMo1
T(i)=100
Gs(i+l)=Gs(i)
Vs(i+1)=Vs(i)
Ts(i+1)=100
!
Dx(i)=Dxx(AM1(i))
IF (i .EQ. 1) THEN
X(i)=Dx(i)/2
ELSE
X(i)=X(i-1)+Dx(i-1)/2+Dx(i)/2
ENDIF
!
520 AveM=AveM+AM1(i)
WRITE(*, 400) i, X(i), AM1(i), T(i), Gs(i), Ts(i)
WRITE(1, 400) i, X(i), AM1(i), T(i), Gs(i), Ts(i)
600 CONTINUE
!
! Calculation of wet front position
IF (L .EQ. O) THEN
X2=-1
No2=-1
ELSE
X2=X(L)+Dx(L)/2
No2=L+1
ENDIF
!
AveM=AveM/Nx
Depth=X(Nx)+Dx(Nx)/2
!
WRITE(*, 100)
WRITE(*, 700) J, Time, AveM, Gs(Nx*1), Ts(Nx*1), XI, No1, X2, No2, Depth
WRITE (2, 700) J, Time, AveM, Gs(Nx+1), Ts(Nx*1), X1, No1, X2, No2, Depth
700 FORMAT(I4, 2X, F7.3, 2X, F6.4, 2X, F6.4, 2X, F7.3, 2X, F7.4, 2x, I3, 2X, F7.4, 2X, I3, 2x, F7.4)
!
J=J+1
Time=Time+Dt
m=m5+1
GO TO 200
!
800 PRINT*, ' '
PRINT*, 'The drying time was up to the specified time.'
PRINT*, 'The drying simulation was stopped.'
PRINT*, 'The sample was not dried to equilibrium'
WRITE(1,*) ' '
WRITE(1,*) 'The drying time was up to the specified time.'
WRITE(1,*) 'The drying simulation was stopped'
WRITE(1,*) 'The sample was not dried to equilibrium'
WRITE(1,*) ' '
WRITE(2,*) 'The drying time was up to the specified time'
WRITE(2,*) 'The drying simulation was stopped'
WRITE(2,*) 'The drying simulation was stopped'
WRITE(2,*) 'The sample was not dried to equilirbium'
GO TO 910
!
900 No2=-1
X2=-1
AveM=AveM/Nx
WRITE(*, 100)
WRITE(*, 700) J, Time, AveM, Gs(Nx+1), Ts(Nx+1), X1, No1, X2, No2, Depth
WRITE(2, 700) J, Time, AveM, Gs(Nx+1), Ts(Nx+1), X1, No1, X2, No2, Depth
!
PRINT*, ' '
PRINT*, 'The sample was dried to equilibrium'
PRINT*, 'The drying simulation was stopped.'
WRITE(1,*) ' '
WRITE(1,*) 'The sample was dried to equilibrium'
WRITE(1,*) 'The drying simulation was stopped'
WRITE(2,*) ' '
WRITE(2,*) 'The sample was not dried to equilirbium'
WRITE(2,*) 'The drying simulation was stopped'
!
910 CLOSE(1)
CLOSE(2)
END
!
!**********************************************************************************
!
! EXTERNAL FUNCTION FOR LATENT HEAT OF EVAPORATION
!
FUNCTION Hv(AM, T)
Hfg=2257000-2916.7*(T-100)
IF (AM .GE. 0.2) THEN
Hv=Hfg
ELSE
Hv=Hfg*(1+EXP(-19.9*AM))
ENDIF
RETURN
END
!
! EXTERNAL FUNCTION FOR BULK DENSITY
!
FUNCTION P(AM)
COMMON AMo/DENS/ Pmo, Pme
IF (AM .GE. AMo) THEN
P=Pmo
ELSE IF (AM .LT. 0.11) THEN
P=Pme
ELSE
P=Pmo-(Pmo-Pme)*(AMo-AM)/(AMo-0.11)
ENDIF
RETURN
END
!
! EXTERNAL FUNCTION FOR LAYER THICKNESS
!
FUNCTION Dxx(AM)
COMMON AMo/THICK/ Dxo, Dxe
IF (AM .GE. AMO) THEN
Dxx=Dxo
ELSE IF (AM .LT. 0.11) THEN
Dxx=Dxe
ELSE
Dxx=Dxo-(Dxo-Dxe)*(AMo-AM)/(AMo-0.11)
ENDIF
RETURN
END
!
!****************************************************************************************
And the errors are shown below:
Compiling and linking file: SHSDRYING.F95
C:\Users\steva\Desktop\SHSDRYING.F95(104) : error 58 - Unpaired right bracket(s)
C:\Users\steva\Desktop\SHSDRYING.F95(45) : error 259 - Scalar, default-kind, CHARACTER expression expected for the FILE keyword
C:\Users\steva\Desktop\SHSDRYING.F95(45) : warning 868 - Opening unit 1 may affect the operation of input from the default unit '*' - are you sure you want to do this?
C:\Users\steva\Desktop\SHSDRYING.F95(48) : warning 868 - Opening unit 2 may affect the operation of output to the default unit '*' - are you sure you want to do this?
C:\Users\steva\Desktop\SHSDRYING.F95(116) : warning 792 - Comma missing in format
C:\Users\steva\Desktop\SHSDRYING.F95(116) : warning 792 - Comma missing in format
C:\Users\steva\Desktop\SHSDRYING.F95(116) : error 270 - Missing width count for 'G' descriptor
C:\Users\steva\Desktop\SHSDRYING.F95(116) : warning 792 - Comma missing in format
C:\Users\steva\Desktop\SHSDRYING.F95(116) : error 274 - Unknown edit descriptor '(', or missing comma
C:\Users\steva\Desktop\SHSDRYING.F95(292) : warning 868 - Closing unit 1 may affect the operation of input from the default unit '*' - are you sure you want to do this?
C:\Users\steva\Desktop\SHSDRYING.F95(293) : warning 868 - Closing unit 2 may affect the operation of output to the default unit '*' - are you sure you want to do this?
C:\Users\steva\Desktop\SHSDRYING.F95(103) : error 90 - FORMAT label 100 does not exist
Compilation failed.
Unit 5,6 and 1,2 (and others) are reserved... If you make UNIT=1 become UNIT=21 and UNIT=2 become UNIT=22 it will work.
Better is probably to use NEWUNIT
! PROGRAM TO SOLVE DEEP-BED DRYING MODEL
!
! BASIC STATEMENTS
!
PROGRAM DEEP_BED_DRYING !New
IMPLICIT NONE !New
CHARACTER*20 FiIe1, File2
COMMON AMo
COMMON /DENS/ Pmo, Pme
COMMON /THICK/ dxo, Dxe
...
OPEN (NEWUNIT=MyUnit1, FILE=File1) !New
WRITE(*,*)' Unit1=',MyUnit1 !New
...
OPEN (NEWUNIT=MyUnit2, FILE=File2) !New
WRITE(*,*)' Unit2=',MyUnit2 !New
enter code here
!WRITE(1,*) ...
WRITE(MyUnit1,*) ...
IMPLICIT NONE is not a bad habit to get into using.
I would line up things for ease of reading...
WRITE (1, *) 'Mass of sample:' , Wo , ' g'
WRITE (1, *) 'Initial moisture content:' , AMo , ' kg/kg'
WRITE (1, *) 'Depth of sample bed:' , Xo , 'mm'
WRITE (1, *) 'Number of layers in sample bed:' , Nx
WRITE (1, *) 'Steam temperature at inlet' , Tso , 'deg C'
WRITE (1, *) 'Steam flow rate at inlet' , Gso , 'kg/m2s'
WRITE (1, *) 'Expected drying time' , Timeo , ' min'
WRITE (1, *) 'Time interval:' , Dt , ' min'
You either need to compile with -132 or use line continuation...
.F77 or -fixed compiler switch (Anything n Column #6):
WRITE(2, 100)
100 FORMAT(4H J, 9H T(min), 8H M(db),7H Gs , 10H Ts(C) ,
!234567
& 9H Front1, 5H L1, 9H Front2, 5h L2, 9H Depth)
.F90 or -free compiler switch (& at the end):
WRITE(2, 100) !Here
100 FORMAT(4H J, 9H T(min), 8H M(db),7H Gs , 10H Ts(C) , &
!234567
9H Front1, 5H L1, 9H Front2, 5h L2, 9H Depth)
The FORMAT statements in the program use Hollerith edit descriptors, which was a feature deleted from the language as of Fortran 95. These are notoriously error prone - character string edit descriptors should be used instead.
Hollerith edit descriptors are of the form nHxxx - where n characters following the H are equivalent to a character literal. The problem with the identified statement (at least) is that the parenthesis that is meant to close the format statement is being considered part of the literal - probably because a space or similar has been deleted from the source.
100 FORMAT(...9H Depth)
123456789
The error messages also identify that the variable named File1 is not suitable as a FILE= specifier in an open statement. This is because there is no variable declaration for File1, so it is assumed to be of type REAL. There is a declaration for a variable FiIe1. IMPLICIT NONE helps find these sorts of spelling mistakes, but the code has clearly been written using implicit typing.
These sorts of errors suggest that the source has come from optical character recognition or similar. If so, you will need to be very mindful of OCR errors elsewhere in the source.
This program:
C This program calculates cos(x**2)
PROGRAM COSX_SQUARE
IMPLICIT NONE
INTEGER a
REAL y, r
PRINT*, 'INPUT THE DEGREE'
PRINT*, 'BETWEEN 0 AND 360'
READ*, a
a*(3.141592/180) = y
C This part determines minus sign and calculates the function
IF (a .GT. 90) THEN
r = -(1-(y**4)/2+(y**8)/24-(y**12)/720+(y**16)/40320)
ELSEIF (a .GE. 270) THEN
r = 1-(y**4)/2+(y**8)/24-(y**12)/720+(y**16)/40320
ELSEIF (a .GT. 360) THEN
PRINT*, 'INVALID DEGREE'
PRINT*, 'DEGREE MUST BE BETWEEN 0 AND 360'
ELSEIF (a .LT. 0) THEN
PRINT*, 'INVALID DEGREE'
PRINT*, 'DEGREE MUST BE BETWEEN 0 AND 360'
END IF
PRINT*, 'THE RESULT OF COS', a, 'SQUARE IS = ', r
STOP
END
Gives this error:
a*(3.141592/180)=y
1
Error: Unclassifiable statement at (1)
I already defined a as INTEGER. Why this error keeps coming?
Yep. It is an expression which begins a statement. Maybe change it to
y = a*(3.141592/180)
if that is what you really meant.
Apologies for inconvenience , I have resubmitted the code now.
Problem: I am trying to write a program that reads the precipitation from a binary (.DAT) file. It calculates the value of precipitation at each grid and for every grid the maximum value month is returned as output. For example if there was a value of 25 highest in the month of June then our output value should be "Jun".
implicit none
integer,parameter :: ix=44,iy=27,nyr=12
integer :: ntot
real :: v_obs(ix,iy,nyr),TestVal,b(ix,iy,nyr),wet(ix,iy)
real:: Mon(12),Y(12),missing_obs,missing_mod,missing
integer :: ii,jj,i,j,k,ik,jk,irec,m,n
character (130) dir,jan,feb,mar,apr,may,jun,jul,aug,sep,oct,nov,dec
data missing_obs/-999000000/
data missing/-999./
open(21,file='C:/Fortran/test-dat.dat',access='direct',recl=ix*iy*nyr,form='unformatted')
open(23,file='C:/wet-month.dat',access='direct',recl=ix*iy*nyr,form='unformatted')
irec=1
Do j=1,nyr
read(21,rec=irec) ((v_obs(ii,jj,j),ii=1,ix),jj=1,iy)
ntot=0
do ik=1,nyr
ntot=ntot+1
Y(ik)=v_obs(ii,jj,ik)
enddo
if (Y(ik) .eq. missing_obs)then
wet=-999
go to 199
endif
enddo
Mon(1)=v_obs(ii,jj,1)
Mon(2)=v_obs(ii,jj,2)
Mon(3)=v_obs(ii,jj,3)
Mon(4)=v_obs(ii,jj,4)
Mon(5)=v_obs(ii,jj,5)
Mon(6)=v_obs(ii,jj,6)
Mon(7)=v_obs(ii,jj,7)
Mon(8)=v_obs(ii,jj,8)
Mon(9)=v_obs(ii,jj,9)
Mon(10)=v_obs(ii,jj,10)
Mon(11)=v_obs(ii,jj,11)
Mon(12)=v_obs(ii,jj,12)
TestVal=MAXVAL(Mon)
If (TestVal .eq. Mon(1)) then
wet=jan
else if (TestVal .eq. Mon(2)) Then
wet=feb
else if (TestVal .eq. Mon(3)) Then
wet=mar
else if (TestVal .eq. Mon(4)) Then
wet=apr
else if (TestVal .eq. Mon(5)) Then
wet=may
else if (TestVal .eq. Mon(6)) Then
wet=jun
else if (TestVal .eq. Mon(7)) Then
wet=jul
else if (TestVal .eq. Mon(8)) Then
wet=aug
else if (TestVal .eq. Mon(9)) Then
wet=sep
else if (TestVal .eq. Mon(10)) Then
wet=oct
else if (TestVal .eq. Mon(11)) Then
wet=nov
else if (TestVal .eq. Mon(12)) Then
wet=dec
endif
199 continue
irec=1
do k=1,nyr
write(23,rec=irec)((wet(ii,jj),ii=1,ix),jj=1,iy)
irec=irec+1
enddo
close(21)
close(22)
end
The compliation error says
You cannot assign an expression of type CHARACTER(LEN=130) to a variable of type REAL(KIND=1)" i.e: "wet=jan".
But I want to save data as character for each grid point.Please help to resolve this error.
The problem is all those lines wet=jan, wet=feb, etc.
As I read from your code wet is real,dimension(44,27). jan and feb are of type character(130). Those are incompatible (as the compiler says).