I want to find the maximum of an array T without using maxval in the last 2 parts of my code (marked with **). Unfortunately, it isn't working. It diplays me all the numbers verified only with the if condition without finding the maximum of it. The if condition just takes the first number and compared to other and if verified, display it all I can't my find my error.
Program exo2
Implicit None
Real, Dimension (:,:), Allocatable :: D
integer :: i,Z,A,B,ok
Real :: no_esc_max=1 , no_esc_min=1
Real, Dimension(:) , Allocatable :: T
print*, "entrez le nombre etudies"
read*, A
print*, "entrez le nombre de mesures pour chaque escargot"
read*, B
Allocate(D(A,B), STAT=ok)
Allocate(T(A), STAT=ok)
if (ok/=0) then
print* , "allocation a echoue"
Stop
end if
Do i=1,A
Do z=1,B
Print*, "Escargot",i
Print*,"entrez la vitesse lors de la mesure",z
Read*, D(i,z)
end do
end do
Do i=1,A
print*, D(i,:)
end do
Do i=1,A
Do z=1,B
T(i)=Sum(D(i,:))/z
end do
print*, "moyenne escargot", i , T(i)
end do
! (**) This block seems to have the problem
no_esc_max=T(1)
do i=2,A
if (no_esc_max<T(i)) then
T(i)=no_esc_max
end if
print* , "escargot",i, "est le plus rapide"
end do
no_esc_min=T(1)
do i=2,A
if (no_esc_min>T(i)) then
T(i)=no_esc_min
end if
print*, "escargot", i, "est le moins rapide"
end do
! (**) End of the block
Deallocate (D)
Deallocate (T)
End Program exo2
To print the correct i, you should keep track of the index refering to your max/min value. Additionally, put your print*,'..' commands outside the do-loop. Otherwise, it seems that you are just printing all of them.
Related
I use Fortran 90 via Force 2.0, with a 64bits pc under windows 10.
Everytime I compile and execute my code one of my column (the 't' one at the left) that I write in a .dat file changes even though I didn't change my code.
! module
module force_param
implicit none
integer,parameter :: dim=3
integer,parameter :: dim_l=dim-1
real*8,parameter :: rapmas=0.5, omega2=100, fsm2=1.E-4, x0_=0.1E0, x2_ =0.01E0
real*8,parameter :: omeg=10.d0, Aex=0.01E0
contains
subroutine force(x,v,f)
implicit none
real*8 :: x(dim), v(dim), f(dim_l)
f(1)=-omega2*(x(1)-x(3)) - omega2*rapmas*(x(1)-x(2))
f(2)=-omega2*(x(2)-x(1)) - fsm2*(v(1)-v(3))
end subroutine force
end module force_param
! algorithme de heun
subroutine heun(x,v,xn,vn,dt)
use force_param
IMPLICIT NONE
real*8::x( dim),v( dim),xn(dim),vn( dim),dt
real*8::f( dim_l), fn( dim_l)
call force(x,v,f)
xn(1: dim_l)=x( 1 : dim_l)+v( 1 : dim_l )*dt
vn(1:dim_l)=v(1: dim_l)+f( 1 : dim_l )*dt
call force(xn,vn,fn )
xn( 1 : dim_l)=x(1:dim_l)+((v(1:dim_l)+vn(1:dim_l))*.5d0*dt)
vn( 1 : dim_l)=v(1:dim_l)+((f(1:dim_l)+fn(1:dim_l))*.5d0*dt)
end subroutine heun
Thank you, I don't know how to access the debugging options though, I tried the button that says 'debugging' but it doesn't seem to do anything. I initialized all my variables too and nothing changed :
! PROGRAM PRINCIPAL
program vibrations
use force_param
implicit none
integer,parameter :: n=50
integer :: i
real*8 :: dt,pi
real*8:: x(dim),v(dim),xn(dim),vn(dim)
real*8 :: t,tn
pi=3.141592
dt=2*pi/(omeg*n)
x(1)=x0_
x(2)=x2_
x(3)=0
v(:)=0
xn(:)=0
vn(:)=0
t=0
tn=0
do i=0,n*1000
t=i*dt
x(3)=0
v(3)=0
tn=(i+n)*dt
xn(3)=0
vn(3)=0
call heun(x,v,xn,vn,dt)
open(11,file='oscill_libI.dat')
write(11,*)t,xn(1), xn(2)
x(:)=xn(:)
v(:)=vn(:)
enddo
end program vibrations
Here is the beginning of my dat file, sometimes the 't' column goes from 0 to 62, sometimes from 0 to 79 it's like randomized, but the 2 right columns stay the same :
0.0000000000000000 9.88551278186548116E-002 1.07106110228664085E-002
1.25663681030273432E-002 9.54368715187558225E-002 1.28277973235651557E-002
2.51327362060546865E-002 8.98431692414301264E-002 1.62639044499528901E-002
3.76991043090820280E-002 8.22344006522621740E-002 2.08756113538187266E-002
5.02654724121093729E-002 7.28284342737571672E-002 2.64687493992564297E-002
6.28318405151367110E-002 6.18938950672803800E-002 3.28048473194145346E-002
7.53982086181640559E-002 4.97418661274231927E-002 3.96091910096331989E-002
8.79645767211914009E-002 3.67162863528836467E-002 4.65801381808427575E-002
0.10053094482421875 2.31833471408859799E-002 5.33993871027770503E-002
0.11309731292724609 9.52022271687244688E-003 5.97428674724096373E-002
0.12566368103027342 -3.89651034653112948E-003 6.52919008503467374E-002
0.13823004913330078 -1.67023992139428389E-002 6.97442687804509659E-002
0.15079641723632811 -2.85562232108175044E-002 7.28248289506616686E-002
0.16336278533935547 -3.91503348001675106E-002 7.42953335021119959E-002
0.17592915344238280 -4.82199079113247164E-002 7.39631284187664967E-002
0.18849552154541016 -5.55508033296286119E-002 7.16884480472895630E-002
Here is two example of the end of my .dat file, generated from the same code :
62.643344993591306 -2.22234174408908088E-002 -6.79345709753481353E-002
62.655911361694336 7.81763163624332930E-004 -8.43500285728980836E-002
62.668477729797360 2.31009413326696972E-002 -9.94182790176534326E-002
62.681044097900390 4.40812444698733333E-002 -0.11254380214307025
62.693610466003413 6.31170757113199837E-002 -0.12318313084617104
62.706176834106444 7.96689081015940076E-002 -0.13086315388478151
62.718743202209467 9.32799461005491132E-002 -0.13519725211303918
62.731309570312497 0.10359012770409017 -0.13589874559045442
62.743875938415528 0.11034702522217735 -0.13279121399446445
62.756442306518551 0.11341330157177297 -0.12581535178107928
62.769008674621581 0.11277048866797904 -0.11503212942774470
62.781575042724604 0.10851897164177816 -0.10062214936426861
62.794141410827635 0.10087418344945331 -8.28812061224447061E-002
62.806707778930658 9.01591351206557229E-002 -6.22121809658964242E-002
76.566880851745609 -2.17677700529351897E-002 -1.05802168534466483E-002
76.579447219848632 -4.88389979588944381E-002 6.79397900452341150E-003
76.592013587951655 -7.46968241174833236E-002 2.32872848719374026E-002
76.604579956054678 -9.85925322542900023E-002 3.82250728574096491E-002
76.617146324157716 -0.11983644140594378 5.09885339005944488E-002
76.629712692260739 -0.13781930927178770 6.10355204755949760E-002
76.642279060363762 -0.15203121044591339 6.79188940734381658E-002
76.654845428466800 -0.16207729220063621 7.13017843304816629E-002
76.667411796569823 -0.16768990946606288 7.09692653728316025E-002
76.679978164672846 -0.16873675548102926 6.68360694761913066E-002
76.692544532775869 -0.16522473162941959 5.89500848494855997E-002
76.705110900878907 -0.15729943518448128 4.74915192035008926E-002
76.717677268981930 -0.14524028276312445 3.27677494663660557E-002
76.730243637084953 -0.12945142581913546 1.52040161357704148E-002
76.742810005187991 -0.11044874807218197 -4.66974609003714767E-003
76.755376373291014 -8.88433591287705327E-002 -2.62355258305883438E-002
! algorithme de heun
subroutine heun(x,v,xn,vn,dt)
use force_param
IMPLICIT NONE
real*8::x( dim),v( dim),xn(dim),vn( dim),dt
real*8::f( dim_l), fn( dim_l)
call force(x,v,f)
xn(1: dim_l)=x( 1 : dim_l)+v( 1 : dim_l )*dt
vn(1:dim_l)=v(1: dim_l)+f( 1 : dim_l )*dt
call force(xn,vn,fn )
xn( 1 : dim_l)=x(1:dim_l)+((v(1:dim_l)+vn(1:dim_l))*.5d0*dt)
vn( 1 : dim_l)=v(1:dim_l)+((f(1:dim_l)+fn(1:dim_l))*.5d0*dt)
end subroutine heun
! PROGRAM PRINCIPAL
program vibrations
use force_param
implicit none
integer,parameter :: n=50
integer :: i
real*8 :: dt,pi
real*8:: x(dim),v(dim),xn(dim),vn(dim),f( dim_l),fn( dim_l)
real*8 :: t,tn
pi=3.141592
dt=2*pi/(omeg*n)
x(1)=x0_
x(2)=x2_
x(3)=0
v(:)=0
xn(:)=0
vn(:)=0
t=0
tn=0
f(:) = 0
fn(:) = 0
do i=0,n*1000
t=i*dt
x(3)=0
v(3)=0
tn=(i+n)*dt
xn(3)=0
vn(3)=0
call heun(x,v,xn,vn,dt)
open(11,file='oscill_lib.dat')
write(11,'(f15.8,1x,f15.8,1x,f15.8)')t,xn(1), xn(2)
x(:)=xn(:)
v(:)=vn(:)
enddo
close(11)
end program vibrations
I misunderstood your issue: You have to close your file. Use close(11) before terminating your program. That way you make sure your output is saved fully.
And, as mentioned in the comments. You should open the file only once. Or close it and the open again for appending if necessary.
I have a program in Fortran that saves the results to a file. At the moment I open the file using
OPEN (1, FILE = 'Output.TXT')
However, I now want to run a loop, and save the results of each iteration to the files 'Output1.TXT', 'Output2.TXT', 'Output3.TXT', and so on.
Is there an easy way in Fortran to constuct filenames from the loop counter i?
you can write to a unit, but you can also write to a string
program foo
character(len=1024) :: filename
write (filename, "(A5,I2)") "hello", 10
print *, trim(filename)
end program
Please note (this is the second trick I was talking about) that you can also build a format string programmatically.
program foo
character(len=1024) :: filename
character(len=1024) :: format_string
integer :: i
do i=1, 10
if (i < 10) then
format_string = "(A5,I1)"
else
format_string = "(A5,I2)"
endif
write (filename,format_string) "hello", i
print *, trim(filename)
enddo
end program
A much easier solution IMHO ...................
character(len=8) :: fmt ! format descriptor
fmt = '(I5.5)' ! an integer of width 5 with zeros at the left
i1= 59
write (x1,fmt) i1 ! converting integer to string using a 'internal file'
filename='output'//trim(x1)//'.dat'
! ====> filename: output00059.dat
Well here is a simple function which will return the left justified string version of an integer:
character(len=20) function str(k)
! "Convert an integer to string."
integer, intent(in) :: k
write (str, *) k
str = adjustl(str)
end function str
And here is a test code:
program x
integer :: i
do i=1, 100
open(11, file='Output'//trim(str(i))//'.txt')
write (11, *) i
close (11)
end do
end program x
I already showed this elsewhere on SO (How to use a variable in the format specifier statement? , not an exact duplicate IMHO), but I think it is worthwhile to place it here. It is possible to use the techniques from other answers for this question to make a simple function
function itoa(i) result(res)
character(:),allocatable :: res
integer,intent(in) :: i
character(range(i)+2) :: tmp
write(tmp,'(i0)') i
res = trim(tmp)
end function
which you can use after without worrying about trimming and left-adjusting and without writing to a temporary variable:
OPEN(1, FILE = 'Output'//itoa(i)//'.TXT')
It requires Fortran 2003 because of the allocatable string.
For a shorten version.
If all the indices are smaller than 10, then use the following:
do i=0,9
fid=100+i
fname='OUTPUT'//NCHAR(i+48) //'.txt'
open(fid, file=fname)
!....
end do
For a general version:
character(len=5) :: charI
do i = 0,100
fid = 100 + i
write(charI,"(A)"), i
fname ='OUTPUT' // trim(charI) // '.txt'
open(fid, file=fname)
end do
That's all.
I've tried #Alejandro and #user2361779 already but it gives me an unsatisfied result such as file 1.txt or file1 .txt instead of file1.txt. However i find the better solution:
...
integer :: i
character(len=5) :: char_i ! use your maximum expected len
character(len=32) :: filename
write(char_i, '(I5)') i ! convert integer to char
write(filename, '("path/to/file/", A, ".dat")') trim(adjustl(char_i))
...
Explanation:
e.g. set i = 10 and write(char_i, '(I5)') i
char_i gives " 10" ! this is original value of char_i
adjustl(char_i) gives "10 " ! adjust char_i to the left
trim(adjustl(char_i)) gives "10" ! adjust char_i to the left then remove blank space on the right
I think this is a simplest solution that give you a dynamical length filename without any legacy blank spaces from integer to string conversion process.
Try the following:
....
character(len=30) :: filename ! length depends on expected names
integer :: inuit
....
do i=1,n
write(filename,'("output",i0,".txt")') i
open(newunit=iunit,file=filename,...)
....
close(iunit)
enddo
....
Where "..." means other appropriate code for your purpose.
To convert an integer to a string:
integer :: i
character* :: s
if (i.LE.9) then
s=char(48+i)
else if (i.GE.10) then
s=char(48+(i/10))// char(48-10*(i/10)+i)
endif
Here is my subroutine approach to this problem. it transforms an integer in the range 0 : 9999 as a character. For example, the INTEGER 123 is transformed into the character 0123. hope it helps.
P.S. - sorry for the comments; they make sense in Romanian :P
subroutine nume_fisier (i,filename_tot)
implicit none
integer :: i
integer :: integer_zeci,rest_zeci,integer_sute,rest_sute,integer_mii,rest_mii
character(1) :: filename1,filename2,filename3,filename4
character(4) :: filename_tot
! Subrutina ce transforma un INTEGER de la 0 la 9999 in o serie de CARACTERE cu acelasi numar
! pentru a fi folosite in numerotarea si denumirea fisierelor de rezultate.
if(i<=9) then
filename1=char(48+0)
filename2=char(48+0)
filename3=char(48+0)
filename4=char(48+i)
elseif(i>=10.and.i<=99) then
integer_zeci=int(i/10)
rest_zeci=mod(i,10)
filename1=char(48+0)
filename2=char(48+0)
filename3=char(48+integer_zeci)
filename4=char(48+rest_zeci)
elseif(i>=100.and.i<=999) then
integer_sute=int(i/100)
rest_sute=mod(i,100)
integer_zeci=int(rest_sute/10)
rest_zeci=mod(rest_sute,10)
filename1=char(48+0)
filename2=char(48+integer_sute)
filename3=char(48+integer_zeci)
filename4=char(48+rest_zeci)
elseif(i>=1000.and.i<=9999) then
integer_mii=int(i/1000)
rest_mii=mod(i,1000)
integer_sute=int(rest_mii/100)
rest_sute=mod(rest_mii,100)
integer_zeci=int(rest_sute/10)
rest_zeci=mod(rest_sute,10)
filename1=char(48+integer_mii)
filename2=char(48+integer_sute)
filename3=char(48+integer_zeci)
filename4=char(48+rest_zeci)
endif
filename_tot=''//filename1//''//filename2//''//filename3//''//filename4//''
return
end subroutine nume_fisier
I have only limited experience with FORTRAN and I need to parse files with a structure similar to this:
H s 13.010000 0.019685
1.962000 0.137977
0.444600 0.478148
s 0.122000 1.000000
p 0.727000 1.000000
***
He s 38.360000 0.023809
5.770000 0.154891
1.240000 0.469987
s 0.297600 1.000000
p 1.275000 1.000000
***
I need to search for the label (e.g. He) and then read the corresponding blocks into an array.
I know I can parse file by specifying the format each line is supposed to have, but here there are different formats possible.
In Python I would just split each line by the white spaces and deal with it depending on the number of columns. But how to approach this in FORTRAN?
You can read each line as a character string and then process it. If, as it seems, the format is fixed (element symbol in first two characters, orbital letter in sixth character, etc.), the following program could serve you as inspiration:
program elms
implicit none
integer, parameter :: MAX_LEN = 40
character(len=MAX_LEN) :: line_el, line
integer :: u
integer :: is
integer :: nlin
character(len=2) :: element = 'He'
integer, parameter :: MAX_LINES = 20
real, dimension(MAX_LINES) :: e, f
open(newunit=u, file='elms.dat', status='old', action='read')
main_loop: do
! Read line
read(u, '(a)', iostat=is) line_el
if (eof_iostat(is)) exit main_loop
! Check first two characters of the line vs. chemical element.
if (line_el(1:2) .eq. element) then
! This is the beginning of an element block
nlin = 0
line = line_el
do
if (line .ne. '') then
! Line is not empty or only spaces.
nlin = nlin + 1
if (line(6:6) .ne. ' ') then
! Line contains an orbital letter - process it.
end if
! Read the real values in the rest of the line
read(line(7:),*) e(nlin), f(nlin)
end if
! Read next line
read(u, '(a)', iostat=is) line
if (eof_iostat(is)) exit main_loop
if (line(1:2) .ne. ' ') then
! Finished processing element block.
exit main_loop
end if
end do
end if
end do main_loop
! Close file
close(u)
contains
logical function eof_iostat(istat)
! Returns true if the end of file has been reached
use, intrinsic :: iso_fortran_env, only: IOSTAT_END
implicit none
integer, intent(in) :: istat
select case (istat)
case (0) ! No error
eof_iostat = .false.
case (IOSTAT_END) ! End of file reached
eof_iostat = .true.
case default ! Error
STOP
end select
end function eof_iostat
end program
You will probably need to make the program a subroutine, make element an intent(in) dummy argument, process the orbital symbols, etc.
Note that, if possible, it would be easier to just read all the data from the file in one go, and then search for the relevant data in the memory (e.g., having an array with the chemical symbols).
I have to develop a linear interpolation program, but keep getting these errors.
Here is the source code:
!Interpolation program for exercise 1 of portfolio
PROGRAM interpolation
IMPLICIT NONE
!Specify table 1 for test of function linter
REAL, DIMENSION (5):: x,f
!Specify results for table 1 at intervals of 1
REAL, DIMENSION (10):: xd, fd
!Specify table 2 to gain linter results
REAL, DIMENSION (9):: xx,ff
!Specify results for table 2 of at intervals of 0.25
REAL, DIMENSION (36):: xxd, ffd
INTEGER :: i, j
!Write values for table dimensions
!Enter x values for Table 1
x(1)=-4.0
x(2)=-2.0
x(3)=0.0
x(4)=2.0
x(5)=4.0
f(1)=28.0
f(2)=11.0
f(3)=2.0
f(4)=1.0
f(5)=8.0
xd(1)=-4.0
xd(2)=-3.0
xd(3)=-1.0
xd(4)=0.0
xd(5)=1.0
xd(6)=2.0
xd(7)=3.0
xd(9)=4.0
!Print Table 1 Array
PRINT *,"Entered Table Values are", x,f
PRINT *,"Interpolation Results for Table 1", xd, fd
END PROGRAM
SUBROUTINE interpol(x,f, xd,fd)
DO i=1, 5
DO j=1, 5
IF (x(j) < xd(i) .AND. xd(i) <= x(j+1)) THEN
fd=linterp (x(j),x(j+1),f(j))
END IF
END DO
END DO
END SUBROUTINE interpol
!Linear Interpolation function
FUNCTION linterp(x(i),x(i+1),f(i),f(i+1),x)
linterp=f(i)+((x-x(i))/(x(i+1)-x(i)))*(f(i+1)-f(i))
END FUNCTION
With it giving these errors;
lin.f90:55:18: Error: Expected formal argument list in function definition at (1)
lin.f90:56:19:
linterp=f(i)+((x-x(i))/(x(i+1)-x(i)))*(f(i+1)-f(i))
1
Error: Expected a right parenthesis in expression at (1)
lin.f90:57:3:
END FUNCTION
1
Error: Expecting END PROGRAM statement at (1)
Could anyone please point me in the right direction?
It is exactly what the compiler complains about: you are missing a right parenthesis.
Either remove the superfluous left (:
linterp=f(i)+ ( x-x(i) ) / ( x(i+1)-x(i) )* ( f(i+1)-f(i) )
or add another )
linterp=f(i)+ ( (x-x(i)) ) / ( x(i+1)-x(i) )* ( f(i+1)-f(i) )
Note that I removed another miss-placed ) in the middle part.
Apart from that, your function declaration is broken! You cannot have x(i) in the declaration!
Try:
real FUNCTION linterp(xI,xIp1,fI,fIp1,x)
implicit none
real, intent(in) :: xI,xIp1,fI,fIp1,x
linterp = fI + (x-xI)/(xIp1-xI)*(fIp1-fI)
END FUNCTION
Alternatively, you can provide the whole arrays (including its length N) and the current index:
real FUNCTION linterp(x,f,N,i,xx)
implicit none
integer, intent(in) :: N
real, intent(in) :: x(N), f(N), xx
integer, intent(in) :: i
linterp = f(i) + (xx-x(i))/( x(i+1)-x(i) )*( f(i+1)-f(i) )
END FUNCTION
In addition to everything Alexander said. You also need to make sure that you have the same amount of inputs in your function declaration as you do when you call it:
fd=linterp (x(j),x(j+1),f(j))
has two less inputs than in your function declaration:
FUNCTION linterp(x(i),x(i+1),f(i),f(i+1),x)
Also, don't forget to add an index to fd, either i or j:
fd(i)=linterp (x(j),x(j+1),f(j))
otherwise you're replacing the entire array with the linterp result every time.
I'm new to fortran and I'm trying to write and compile an easy example that I found in this address to read a simple 2 column text file:
Date Water-flow
717976 7.140
717977 6.570
717978 6.040
717979 5.780
717980 5.530
The program is pasted below, but when trying to compile and run I don't really understand the resulting error, could you please advice me?
PROGRAM READHPOP
IMPLICIT NONE
INTEGER, PARAMETER :: lun = 10
INTEGER :: res,i
CHARACTER(len=80) :: cbuffer
INTEGER :: flength
INTEGER,ALLOCATABLE,DIMENSION(:) :: dates
REAL,ALLOCATABLE,DIMENSION(:) :: water_flow
INTEGER :: c_position,string_length
OPEN(UNIT=lun,FILE="st.dat",FORM="FORMATTED",IOSTAT=res)
IF(res/=0) THEN
PRINT*,'error in opening file, status: ',res
STOP
END IF
READ(UNIT=lun,FMT='(A)',IOSTAT=res) cbuffer
IF(res /=0) THEN
PRINT *,'ERROR IN READING file, status: ',res
CLOSE(UNIT=lun)
STOP
END IF
string_length=LEN_TRIM(cbuffer)
c_position=INDEX(cbuffer,':')
READ(cbuffer(c_position+1:string_length),FMT='(A10)') flength
ALLOCATE(dates(flength),STAT=res)
IF (res/=0) THEN
PRINT*,'ERROR IN ALLOCATING MEMORY, status:',res
CLOSE(UNIT=lun)
STOP
END IF
READ(UNIT=lun,FMT='(A)',IOSTAT=res) cbuffer
DO i=1,cbuffer
READ(UNIT=lun,FMT='(I6,1X,F6.3)') dates(i),water_flow(i)
PRINT*,'DIAS ',dates(i)
END DO
end PROGRAM readhpop
EDIT: thanks to all for the inputs, just to close the issue, I paste below the working code, regards!
PROGRAM READHPOP
IMPLICIT NONE
INTEGER, PARAMETER :: lun = 10
INTEGER :: res,i
CHARACTER(len=80) :: cbuffer
INTEGER :: flength
INTEGER,ALLOCATABLE,DIMENSION(:) :: dates
REAL,ALLOCATABLE,DIMENSION(:) :: water_flow
INTEGER :: c_position,string_length
OPEN(UNIT=lun,FILE="st.dat",FORM="FORMATTED",IOSTAT=res)
IF(res/=0) THEN
PRINT*,'error in opening file, status: ',res
STOP
END IF
READ(UNIT=lun,FMT='(A)',IOSTAT=res) cbuffer
IF(res /=0) THEN
PRINT *,'ERROR IN READING file, status: ',res
CLOSE(UNIT=lun)
STOP
END IF
string_length=LEN_TRIM(cbuffer)
c_position=INDEX(cbuffer,':')
READ(cbuffer(c_position+1:string_length),FMT='(I10)') flength
ALLOCATE(dates(flength),water_flow(flength),STAT=res)
IF (res/=0) THEN
PRINT*,'ERROR IN ALLOCATING MEMORY, status:',res
CLOSE(UNIT=lun)
STOP
END IF
DO i=1,flength
READ(UNIT=lun,FMT='(I6,F6.3)') dates(i),water_flow(i)
PRINT*,'LINE OF FILE',i,' DAYS ',dates(i),' WATERFLOW ',water_flow(i)
END DO
PAUSE
END PROGRAM READHPOP
Okay, here is a working version:
PROGRAM READHPOP
IMPLICIT NONE
INTEGER, PARAMETER :: lun = 10
INTEGER :: res,i
CHARACTER(len=80) :: cbuffer
INTEGER :: flength
INTEGER,ALLOCATABLE,DIMENSION(:) :: dates
REAL,ALLOCATABLE,DIMENSION(:) :: water_flow
INTEGER :: c_position,string_length
OPEN(UNIT=lun,FILE="st.dat",FORM="FORMATTED",IOSTAT=res)
IF(res/=0) THEN
PRINT*,'error in opening file, status: ',res
STOP
END IF
READ(UNIT=lun,FMT='(A)',IOSTAT=res) cbuffer
IF(res /=0) THEN
PRINT *,'ERROR IN READING file, status: ',res
CLOSE(UNIT=lun)
STOP
END IF
string_length=LEN_TRIM(cbuffer)
c_position=INDEX(cbuffer,':')
READ(cbuffer(c_position+1:string_length),FMT='(I10)') flength
ALLOCATE(dates(flength),water_flow(flength),STAT=res)
IF (res/=0) THEN
PRINT*,'ERROR IN ALLOCATING MEMORY, status:',res
CLOSE(UNIT=lun)
STOP
END IF
DO i=1,flength
READ(UNIT=lun,FMT='(I6,F6.3)') dates(i),water_flow(i)
PRINT*,'DIAS ',dates(i)
END DO
end PROGRAM readhpop
Issues:
water_flow needs to be allocated
When determining flength: flength is an integer, so read it as an integer (here: '(I10)'). The number of dates is expected after a colon, so change st.dat to:
Date Water-flow: 5
717976 7.140
717977 6.570
717978 6.040
717979 5.780
717980 5.530
Loop over flength instead of cbuffer
One read statement too much - you are trying to read beyond the end of the file...
In this line
READ(cbuffer(c_position+1:string_length),FMT='(A10)') flength
you read an integer value under a character edit descriptor. This may well return a value in flength which exceeds any reasonable value for your allocatable array. For example, in a quick test I got a value of 538981169. Change that line to
READ(cbuffer(c_position+1:string_length),'(i)') flength