Double precision function wp(S,wmav,ip) - fortran

At this time I using Plato for compiling free IDE for Fortran.
My problem is about how to properly compile this code. It always gives an error code but whenever I search on google I find nothing.
This code is from Understanding luminance spectra and efficiency using wp and related function from Charles W Struck.
If there is somebody want to discuss about luminance spectra or theoretical things about this book I am open.
options/g_float
double precision function wp(S,wmav,ip)
C
C
C finds one particular wp function, knowing its fundamental
C arguments S,wmav, ip.
C
C
C largest allowed ip is 70
C
C eq. (4.45)
C
C
IMPLICIT REAL*8(A-H, O-P, R-Z), LOGICAL*4(Q)
dimension pfact1(47),pfact2(24),pfact(71)
equivalence (pfact(1),pfact1(1)),(pfact(48),pfact2(1))
data pfactl/l.d000,1.d000,2.d000,6.d000,24.d000,l20.d000,720.d000,
15040.d000,40320.d000,362880.d000,3.6288d006,3.99168d007,
24.790016d008,6.2270208d009,8.71782912d010,1.307674368d012,
32.0922789888d013,3.55687428096d014,6.402373705728000d+015,
41.216451004088320d+017,2.432902008176640d+018,
55.109094217170944d+019,1.124000727777608d+021,
62.585201673888498d+022,6.204484017332395d+023,
71.551121004333099d+025,4.032914611266057d+026,
81.088886945041835d+028,3.048883446117139d+029,
98.841761993739703d+030,2.652528598121911d+032,
a8.222838654177925d+033,2.631308369336936d+035,
b8.683317618811888d+036,2.952327990396042d+038,
c1.033314796638615d+040,3.719933267899013d+041,
d1.376375309122635d+043,5.230226174666011d+044,
e2.039788208119744d+046,8.159152832478978d+047,
f3.345252661316381d+049,1.405006117752880d+051,
g6.041526306337384d+052,2.658271574788449d+054,
h1.196222208654802d+056,5.502622159812090d+057/
data pfact2/
12.586232415111682d+059,1.241391559253608d+061,
26.082818640342677d+062,3.041409320171339d+064,
31.551118753287383d+066,8.065817517094390d+067,
44.274883284060027d+069,2.308436973392415d+071,
51.269640335365828d+073,7.109985878048638d+074,
64.052691950487723d+076,
72.350561331282880d+078,1.386831185456899d+080,
88.320987112741393d+081,5.075802138772249d+083,
93.146997326038795d+085,1.982608315404441d+087,
a1.268869321858842d+089,8.247650592082473d+090,
b5.443449390774432d+092,3.647111091818869d+094,
c2.480035542436831d+096,1.711224524281413d+098,
d1.197857166996989d+100/
pr=dfloat(ip)
ipr=ip
if(ip.lt.0)then
pr=-pr
ipr=-ip
end if
boltz=wmav/(1.d000+wmav)
boltzl=dlog(boltz)
smav=S*wmav
smplav=smav+S
s2mp1=smav+smp1av
if(s2mp1.le.235.d000)then
bp=dexp(-s2mp1)*smplav**pr/pfact(ipr+1)
else
bp=dexp(dlog(s2mp1)+pr*dlog(smplav)-dlog(pfact(ipr+1)))
end if
bsum=1.d000
blsum=0.d000
blterm=1.d000
wnum=smav*smp1av
wdnom1=0.d000
wdnom2=pr
do 1 j=1,150
wdnom1=wdnom1+1.d000
wdnom2=wdnom2+1.d000
bterm=wnum*blterm/(wdnom1*wdnom2)
bsum=bsum+bterm
if(bsum.eq.blsum)then
wp=bsum*bp
if(ip.lt.0)then
if(pr*boltzl.le.200.d000)then
wp=wp*(boltz**pr)
else
wp=0.d000
end if
end if
return
else
blsum=bsum
blterm=bterm
end if
1 continue
END
Error note :
F95(1) : error 201 - '(' expected after OPTIONS
F95(7) : error 609 - Expected '/' at end of DATA list
F95(8) : error 699 - Invalid character '.' at start of line
F95(8) : error 32 - Statement not recognised
F95(33) : warning 21 - Label 88 is declared, but not used
F95(7) : error 52 - Compilation abandoned

Related

How to use quadpack with Microsoft Visual Studio (Intel Fortran) ? Errors in xerrmv.f

I am trying to use quadpack in Microsoft Visual using Intel Fortran.
From netlib I downloaded: dqag.f, dqage.f, dqk15.f, dqk21.f, dqk31.f, dqk41.f, dqk51.f, dqk61.f, dqpsrt.f, dquad.f, fdump.f, j4save.f, s88fmt.f, testf4.f, xerabt.f, xerctl.f, xerprt.f, xerror.f, xerrwv.f, xersav.f, xgetua.f.
to try to recreate the result from makefile.2.
And I get the errors:
Severity Code Description Project File Line Suppression State
Error Compilation Aborted (code 1) C:\Users\...\test_quadpack\xerrwv.f 1
Error error #6633: The type of the actual argument differs from the type of the dummy argument. [LFIRST] C:\Users\...\test_quadpack\xerrwv.f 65
Error error #6633: The type of the actual argument differs from the type of the dummy argument. [MESSG] C:\Users\...\test_quadpack\xerrwv.f 127
Error error #6634: The shape matching rules of actual arguments and dummy arguments have been violated. [MESSG] C:\Users\C:\Users\...\test_quadpack\xerrwv.f 127
These errors I get from xerrmv.f which can be downloaded from xerrmv.f line 65, 127 and 127
subroutine xerrwv(messg,nmessg,nerr,level,ni,i1,i2,nr,r1,r2)
c
c abstract
c xerrwv processes a diagnostic message, in a manner
c determined by the value of level and the current value
c of the library error control flag, kontrl.
c (see subroutine xsetf for details.)
c in addition, up to two integer values and two real
c values may be printed along with the message.
c
c description of parameters
c --input--
c messg - the hollerith message to be processed.
c nmessg- the actual number of characters in messg.
c nerr - the error number associated with this message.
c nerr must not be zero.
c level - error category.
c =2 means this is an unconditionally fatal error.
c =1 means this is a recoverable error. (i.e., it is
c non-fatal if xsetf has been appropriately called.)
c =0 means this is a warning message only.
c =-1 means this is a warning message which is to be
c printed at most once, regardless of how many
c times this call is executed.
c ni - number of integer values to be printed. (o to 2)
c i1 - first integer value.
c i2 - second integer value.
c nr - number of real values to be printed. (0 to 2)
c r1 - first real value.
c r2 - second real value.
c
c examples
c call xerror(29hsmooth -- num (=i1) was zero.,29,1,2,
c 1 1,num,0,0,0.,0.)
c call xerrwv(54hquadxy -- requested error (r1) less than minimum
c 1 (r2).,54,77,1,0,0,0,2,errreq,errmin)
c
c written by ron jones, with slatec common math library subcommittee
c latest revision --- 19 mar 1980
c
dimension messg(nmessg),lun(5)
c get flags
lkntrl = j4save(2,0,.false.)
maxmes = j4save(4,0,.false.)
c check for valid input
if ((nmessg.gt.0).and.(nerr.ne.0).and.
1 (level.ge.(-1)).and.(level.le.2)) go to 10
if (lkntrl.gt.0) call xerprt(17hfatal error in...,17)
call xerprt(23hxerror -- invalid input,23)
if (lkntrl.gt.0) call fdump
if (lkntrl.gt.0) call xerprt(29hjob abort due to fatal error.,
1 29)
if (lkntrl.gt.0) call xersav(1h ,0,0,0,kdummy)
call xerabt(23hxerror -- invalid input,23)
return
10 continue
c record message
junk = j4save(1,nerr,.true.)
call xersav(messg,nmessg,nerr,level,kount)
c let user override
lfirst = messg(1)
lmessg = nmessg
lerr = nerr
llevel = level
call xerctl(lfirst,lmessg,lerr,llevel,lkntrl)
c reset to original values
lmessg = nmessg
lerr = nerr
llevel = level
lkntrl = max0(-2,min0(2,lkntrl))
mkntrl = iabs(lkntrl)
c decide whether to print message
if ((llevel.lt.2).and.(lkntrl.eq.0)) go to 100
if (((llevel.eq.(-1)).and.(kount.gt.min0(1,maxmes)))
1.or.((llevel.eq.0) .and.(kount.gt.maxmes))
2.or.((llevel.eq.1) .and.(kount.gt.maxmes).and.(mkntrl.eq.1))
3.or.((llevel.eq.2) .and.(kount.gt.max0(1,maxmes)))) go to 100
if (lkntrl.le.0) go to 20
call xerprt(1h ,1)
c introduction
if (llevel.eq.(-1)) call xerprt
1(57hwarning message...this message will only be printed once.,57)
if (llevel.eq.0) call xerprt(13hwarning in...,13)
if (llevel.eq.1) call xerprt
1 (23hrecoverable error in...,23)
if (llevel.eq.2) call xerprt(17hfatal error in...,17)
20 continue
c message
call xerprt(messg,lmessg)
call xgetua(lun,nunit)
do 50 kunit=1,nunit
iunit = lun(kunit)
if (iunit.eq.0) iunit = i1mach(4)
if (ni.ge.1) write (iunit,22) i1
if (ni.ge.2) write (iunit,23) i2
if (nr.ge.1) write (iunit,24) r1
if (nr.ge.2) write (iunit,25) r2
22 format (11x,21hin above message, i1=,i10)
23 format (11x,21hin above message, i2=,i10)
24 format (11x,21hin above message, r1=,e20.10)
25 format (11x,21hin above message, r2=,e20.10)
if (lkntrl.le.0) go to 40
c error number
write (iunit,30) lerr
30 format (15h error number =,i10)
40 continue
50 continue
c trace-back
if (lkntrl.gt.0) call fdump
100 continue
ifatal = 0
if ((llevel.eq.2).or.((llevel.eq.1).and.(mkntrl.eq.2)))
1ifatal = 1
c quit here if message is not fatal
if (ifatal.le.0) return
if ((lkntrl.le.0).or.(kount.gt.max0(1,maxmes))) go to 120
c print reason for abort
if (llevel.eq.1) call xerprt
1 (35hjob abort due to unrecovered error.,35)
if (llevel.eq.2) call xerprt
1 (29hjob abort due to fatal error.,29)
c print error summary
call xersav(1h ,-1,0,0,kdummy)
120 continue
c abort
if ((llevel.eq.2).and.(kount.gt.max0(1,maxmes))) lmessg = 0
call xerabt(messg,lmessg)
return
end
This is the main program:
program dquad
c driver for quadpack
implicit double precision (a-h, o-z)
external f
parameter (limit=50, lenw=4*limit)
dimension iwork(limit), work(lenw)
open (unit=8, file='outquad', iostat=ios, err=100)
c lower limit of itegration
a=-1.0d+00
c upper limit of integration
b=2.0d+00
c absolute accuracy requested
epsabs=1.0d-15
c relative accuracy requested
epsrel=1.0d-09
do 20 l=1, 3000
c key for choice of local integration rule:
c a Gauss-Kronrod pair is used with
c 7 - 15 points if key .lt. 2,
c 10 - 21 points if key = 2,
c 15 - 31 points if key = 3,
c 20 - 41 points if key = 4,
c 25 - 51 points if key = 5,
c 30 - 61 points if key .gt. 5
do 10 key=1, 6
call dqag (f, a, b, epsabs, epsrel, key, result, abserr, neval,
* ier, limit, lenw, last, iwork, work)
if (l .eq. 1) then
write (8, *) 'integral =', result
write (8, *) 'absolute error =', abserr
write (8, *) 'number of integrand evaluations=', neval
end if
10 continue
20 continue
stop
100 write (8, *) 'ios=', ios
stop
end
Also from netlib quad.f.
And this is the function that should be integrated, it's just an example, it not the function that I am gonna integrate in my research,
I just want to learn to integrate quadpack in my code.
double precision function f(x)
implicit double precision (a-h, o-z)
f = 1.0d+00 + x * x + 1.0d+00 / (1.0d+00 + 1.0d+02 * x * x)
return
end
This is from netlib [testf4.f] (http://netlib.org/alliant/quad/testf4.f).
This is xerctl.f
SUBROUTINE XERCTL(MESSG1,NMESSG,NERR,LEVEL,KONTRL)
C***BEGIN PROLOGUE XERCTL
C***DATE WRITTEN 790801 (YYMMDD)
C***REVISION DATE 820801 (YYMMDD)
C***CATEGORY NO. R3C
C***KEYWORDS ERROR,XERROR PACKAGE
C***AUTHOR JONES, R. E., (SNLA)
C***PURPOSE Allows user control over handling of individual errors.
C***DESCRIPTION
C Abstract
C Allows user control over handling of individual errors.
C Just after each message is recorded, but before it is
C processed any further (i.e., before it is printed or
C a decision to abort is made), a call is made to XERCTL.
C If the user has provided his own version of XERCTL, he
C can then override the value of KONTROL used in processing
C this message by redefining its value.
C KONTRL may be set to any value from -2 to 2.
C The meanings for KONTRL are the same as in XSETF, except
C that the value of KONTRL changes only for this message.
C If KONTRL is set to a value outside the range from -2 to 2,
C it will be moved back into that range.
C
C Description of Parameters
C
C --Input--
C MESSG1 - the first word (only) of the error message.
C NMESSG - same as in the call to XERROR or XERRWV.
C NERR - same as in the call to XERROR or XERRWV.
C LEVEL - same as in the call to XERROR or XERRWV.
C KONTRL - the current value of the control flag as set
C by a call to XSETF.
C
C --Output--
C KONTRL - the new value of KONTRL. If KONTRL is not
C defined, it will remain at its original value.
C This changed value of control affects only
C the current occurrence of the current message.
C***REFERENCES JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-
C HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES,
C 1982.
C***ROUTINES CALLED (NONE)
C***END PROLOGUE XERCTL
CHARACTER*20 MESSG1
C***FIRST EXECUTABLE STATEMENT XERCTL
RETURN
END
This is xerror.f
subroutine xerror(messg,nmessg,nerr,level)
c
c abstract
c xerror processes a diagnostic message, in a manner
c determined by the value of level and the current value
c of the library error control flag, kontrl.
c (see subroutine xsetf for details.)
c
c description of parameters
c --input--
c messg - the hollerith message to be processed, containing
c no more than 72 characters.
c nmessg- the actual number of characters in messg.
c nerr - the error number associated with this message.
c nerr must not be zero.
c level - error category.
c =2 means this is an unconditionally fatal error.
c =1 means this is a recoverable error. (i.e., it is
c non-fatal if xsetf has been appropriately called.)
c =0 means this is a warning message only.
c =-1 means this is a warning message which is to be
c printed at most once, regardless of how many
c times this call is executed.
c
c examples
c call xerror(23hsmooth -- num was zero.,23,1,2)
c call xerror(43hinteg -- less than full accuracy achieved.,
c 43,2,1)
c call xerror(65hrooter -- actual zero of f found before interval
c 1 fully collapsed.,65,3,0)
c call xerror(39hexp -- underflows being set to zero.,39,1,-1)
c
c written by ron jones, with slatec common math library subcommittee
c latest revision --- 7 feb 1979
c
dimension messg(nmessg)
call xerrwv(messg,nmessg,nerr,level,0,0,0,0,0.,0.)
return
end
I think the problem is with the messages like this from here:
if(ier.ne.0) call xerror(26habnormal return from dqag ,26,ier,lvl)
but I don't know to fix it.
Can I use in main Fortran 90, where I call the subroutine to integrate? How it is supposed to look? I'm not familiar with fortran 77.
Any suggestion for dealing with this is greatly appreciated.

`Unexpected attribute declaration statement` in data statement

I tried to write some data in Fortran:
program Problem
DIMENSION X(8), W(8)
DATA X /0.0950125098D0, 0.2816035507D0, 0.4580167776D0, 0.6178762444D0
+ , 0.7554044083D0, 0.8656312023D0, 0.9445750230D0, 0.9894009349D0/
DATA W /0.1894506104D0, 0.1826034150D0, 0.1691565193D0, 0.1495959888D0
+ , 0.1246289712D0, 0.0951585116D0, 0.0622535239D0, 0.0271524594D0/
D = 0.D0
DO NJ=1,8
D = D + X(NJ) + W(NJ)
ENDDO
write(*,*) D
end
But I always get the following error message: Unexpected attribute declaration statement at (1).
Does anybody know why?
As already stated by others you should use the new fortran standard. If you do that you can just remove the "+" you used to indicate a continuation line (should have been in column 6) and instead add an ampersand "&" at the end of the line that should be continued.
Then the program compiles and runs. But as X and W are single precision you use too many digits in your data statement. Use implicit none and declare all variables. And get a textbook.
Below you find a minor update to your code which allows it to compile:
program Problemless
dimension X(8), W(8)
data X /0.0950125098D0, 0.2816035507D0, 0.4580167776D0,
+ 0.6178762444D0, 0.7554044083D0, 0.8656312023D0,
+ 0.9445750230D0, 0.9894009349D0/
data W /0.1894506104D0, 0.1826034150D0, 0.1691565193D0,
+ 0.1495959888D0, 0.1246289712D0, 0.0951585116D0,
+ 0.0622535239D0, 0.0271524594D0/
D = 0.D0
do NJ=1,8
D = D + X(NJ) + W(NJ)
enddo
write(*,*) D
end
Your code is written in Fixed-source form (See Section 6.3.3 of the Fortran standard). This implies that you cannot have anything beyond column 72. All I've done is to correct this in the above.
If you are learning fortran, I would suggest to stop using the fixed format and start using the free format.
no upvotes required for this post

End of record error in file opening

I am currently writing a code to simulate particle collisions. I am trying to open as much files as there are particles (N) and then put the data for positions and velocities in each of these files for each step of the time integration (using Euler's method, but that is not relevant). For that, I tried using a do loop so it will open all the files I need - then I put all the data in them with a different do loop later - and then close them all.
I first tried just doing a do loop to open the files - but it gave errors of the type "file already open in another unit", so I did the following:
module parameters
implicit none
character :: posvel
integer :: i, j, N
real :: tmax
real, parameter :: tmin=0.0, pi=3.14159265, k=500.0*10E3, dt=10.0E-5, dx=10.0E-3, g=9.806, ro=1.5*10E3
real, dimension(:), allocatable :: xold, xnew, vold, vnew, m, F, r
end module parameters
PROGRAM Collision
use parameters
implicit none
write(*,*) 'Enter total number of particles (integer number):'
read(*,*) N
allocate(xold(N))
allocate(vold(N))
allocate(xnew(N))
allocate(vnew(N))
allocate(m(N))
allocate(F(N))
allocate(r(N))
xold(1) = 0.0
vold(1) = 0.0
m(1) = 6.283*10E-9
r(1) = 10E-4
xold(2) = 5.0
vold(2) = 0.0
m(2) = 6.283*10E-9
r(2) = 10E-4
write(*,*) 'Type total time elapsed for the simulation(real number):'
read(*,*) tmax
do i = 1, N
write(posvel,"(a,i3.3,a)") "posveldata",i,".txt"
open(unit=i,file=posvel, status="unknown")
end do
do i = 1, N
close(unit=i)
end do
END PROGRAM Collision
The last ten lines are the ones that regard to my problem.
That worked in codeblocks - it opened just the number of files I needed, but I'm actually using gfortran and it gives me and "end of record" error in the write statement.
How can I make it to execute properly and give me the N different files that I need?
P.S.: It is not a problem of compilation, but after I execute the program.
Your character string in the parameter module has only 1 character length, so it cannot contain the full file name. So please use a longer string, for example
character(100) :: posvel
Then you can open each file as
do i = 1, N
write(posvel,"(a,i0,a)") "posveldata",i,".txt"
open(unit=i,file=trim(posvel), status="unknown")
end do
Here, I have used the format i0 to automatically determine a proper width for integer, and trim() for removing unnecessary blanks in the file name (though they may not be necessary). The write statement can also be written more compactly as
write(posvel,"('posveldata',i0,'.txt')") i
by embedding character literals into the format specification.
The error message "End of record" comes from the above issue. This can be confirmed by the following code
character c
write(c,"(a)") "1"
print *, "c = ", c
write(c,"(a)") "23" !! line 8 in test.f90
print *, "c = ", c
for which gfortran gives
c = 1
At line 8 of file test.f90
Fortran runtime error: End of record
This means that while c is used as an internal file, this "file" does not have enough space to accommodate two characters (here "23"). For comparison, ifort14 gives
c = 1
forrtl: severe (66): output statement overflows record, unit -5, file Internal Formatted Write
while Oracle Fortran12 gives
c = 1
****** FORTRAN RUN-TIME SYSTEM ******
Error 1010: record too long
Location: the WRITE statement at line 8 of "test.f90"
Aborted
(It is interesting that Oracle Fortran reports the record to be "too long", which may refer to the input string.)

Reading formatted data - Fortran runtime error: Bad real number

I am trying to use the code below to read a formatted file and write it into another. However, on running it shows the following error
$ ./conv.sac.farm < i_conv.farm
# stn comp Delta Tr-time Start in record
At line 54 of file Main/conv.sac.farm.f (unit = 5, file = 'stdin')
Fortran runtime error: Bad real number in item 1 of list input
The source code is as follows
PARAMETER (nd0=100000,pi=3.1415926)
IMPLICIT COMPLEX*8 (Z)
CHARACTER name*6,comp*6,fname*60,event*20
- ,cmp(0:3)*5,fname0*60,charac*15,scode*60
REAL*8 GFACT(500),PP0(500),depth0
integer hr0,mnu0,yr,month,day,hr,mnu
REAL x(nd0),y(nd0)
DIMENSION Z(nd0),zpole(50),zero(50)
data np,cmp/8,'disp.','vel. ','acc. ','orig.'/
common /tbl/ip(110,14),is(110,14),secp(110,14),secs(110,14)
read(5,'(a)') event
read(5,*) alats,alons,depth,hr0,mnu0,sec0,id,delmin,delmax
depth0=depth
write(22,'(a,a5,3f7.2,2i3,f6.2)')
# event,cmp(id),alats,alons,depth,hr0,mnu0,sec0
* << J-B travel time table >>
OPEN(11,FILE='jb.ptime')
OPEN(12,FILE='jb.stime')
1000 read(11,*,end=1001) n,(ip(n,i),secp(n,i),i=1,14)
goto 1000
1001 read(12,*,end=1002) n,(is(n,i),secs(n,i),i=1,14)
goto 1001
1002 continue
close(11)
close(12)
* << Geometrical factor >>
OPEN(15,FILE='jb.table')
CALL GEOM(GFACT,PP0,depth0)
close(15)
nstn=0
print *,' # stn comp Delta Tr-time Start in record'
5 read(5,'(a)') fname
read(5,'(a)') scode
* ta=advance of start-time relative the standard P/S arrival
* du=duration
c
if(fname.eq.'dummy') goto 90
read(5,*) ta,du,dt,f1,f2,iph,nr,iuni
open(1,file=fname)
READ(1,'(g15.7)') dt0
read(1,'(/////5g15.7)') dum, alat, alon, elev
read(1,'(///////5i10)') yr, nday, hr,mnu, nsec
read(1,'(5i10)') nmsec,ndum,ndum,ndum,nd
read(1,'(/////)')
read(1,'(a6,2x,a13)') name,charac
read(1,'(////)')
And so on..
Line 54 is
read(5,*) ta,du,dt,f1,f2,iph,nr,iuni
I found a similar question following this link
Fortran runtime error: Bad real number
However, if I understand correctly, the corrections mentioned were pertaining to reading unformatted data. Despite this, I tried and failed as expected, given that the file I am trying to read is formatted.
here is a little trick if you can't readily find the offending line in the data file:
replace your read that throws the error with this:
read(5,'(a)')line
read(line,*,iostat=ios) ta,du,dt,f1,f2,iph,nr,iuni
if(ios>0)then
write(*,*)'error reading line:',line
stop
endif
with the declarations
integer ios
character*(200) line
Probably just do that for debugging then revert to the original once you fix the problem.

Invalid character in name at (1) with fixed-form source

I am getting an eror "Invalid character in name at (1)" in my Fortran 77 program. Why is this?
It is in my read statement
100 READ(S,*,END=200) LINE
but I am not sure why
Code:
PROGRAM Exercise
C
C PARAMETERS
C
INTEGER UNUM
PARAMETER (UNUM=15)
C
C LOCAL VARIABLES
C
REAL LINES
C
C FUNCTION DECLARATIONS
C
REAL NUMLIN
C
C COMMON VARIABLES
C
C
C DATA STATEMENTS
C
C MAIN PROGRAM MODULE
C
OPEN(UNIT=UNUM, FILE = 'line.txt', STATUS='OLD')
LINES=NUNMLIN(UNUM)
C
C Rewinding to the top of the file because the pointer is at the end
C of the file
C
REWIND(UNUM)
CLOSE(UNUM)
CALL PROCES(UNUM,LINES)
STOP
END PROGRAM
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C SUBROUTINE PROCES
C
C dynamically allocates space
C
SUBROUTINE PROCES(U,L)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C FUNCTIONS
C
C NUMLIN - counts the number of lines, uses the fact that the file
C is already open and passes this information to the next subroutine
C
REAL FUNCTION NUMLIN(S)
REAL NUMLIN
REAL S
CHARACTER*256 LINE
100 READ(S,*,END=200) LINE
NUMLIN=NUMLIN+1
GOTO 100
200 CONTINUE
RETURN
END
Error:
NumberCountingExercise.for:90.7:
100 READ(S,*,END=200) LINE
1
Error: Invalid character in name at (1)
NumberCountingExercise.for:93.7:
200 CONTINUE
1
Error: Invalid character in name at (1)
NumberCountingExercise.for:85.27:
In fixed source form, a statement label should appear in columns 1 to 5.
100 and 200 are (starting in column 7) in the statement field and are taken as being part of entities' names. A name must begin with a letter.