I have a program that creates values for the matrix u, and this changes for every iteration f, I want to write out the value of u(2,2) for every iteration f. So for example u(2,2)=5 f=1, u(2,2)=9 f=2, and so on.
Now test(u,n,f) only writes the last value.When it have met my criteria to stop the do loop. I don't want my subroutine to overwrite the file plot.txt every time, I want it to keep u(2,2) for every iterations. I want it to look like this
5 1
9 2
10 3
but not it only writes
15 25
How can this be fixed?
subroutine test(u,n,f)
!input
integer :: n,f,write_unit
real(8) :: u(n+2,n+2)
!lokale
integer :: i,j
real(8) :: vek_x,vek_y
!Skriver vektor verdier til fil som gnuplot skal bruke
open(newunit=write_unit,access='sequential',file='plot.txt',status='unknown')
write(write_unit,*)'# x y vx vy'
vek_x=u(2,2)
!write(write_unit,*) vek_x,f
write(write_unit,*) vek_x,f
write(write_unit,*)''
close(write_unit,status='keep')
"Program" that creates different values for u
do f=1,1000
do j=2,n+1
do i=2,n+1
u(i,j)=(u(i+1,j)+u(i-1,j)+u(i,j+1)+u(i,j-1))/4
!u(i,j)=(1-omega)*u(i,j)+omega*1/4*(u(i+1,j)+u(i-1,j)+u(i,j+1)+u(i,j-1))
end do
end do
if (u(2,2) .eq. 15) then
exit
end if
call test(u,n,f)
end do
Just open the file for appending
open(newunit=write_unit,access='sequential',file='plot.txt',position='append',status='old',action='write')
if that is what you wanted.
For the first time to may want to just create it empty
open(newunit=write_unit,access='sequential',file='plot.txt',status='replace')
close(write_unit)
Related
I know how to change numbers in text in a one file, but I need to use table like this (lets say file=word):
1 # K
2 # L
3 # M
and in another file text.dat:
1 1
1 2
1 3
in the second column change the numbers 1, 2, 3 in text K, L, M using Fortran program. I know I can use arrays or I can read it like a line with index. Does anyone has an idea how to do it taking the text from different file? I have problem how to combine changing numbers in one file to text employing two files.
My starting code:
program prevod
implicit none
integer :: i, k, maxgrps, a, p
character(LEN=40):: afile, line, lmpline
parameter (maxgrps=10)
character*10 :: atom, blank, atpname(maxgrps)
logical :: elements, first
afile="t2.dat"
open(20, file = "text.dat",status='old')
open(11,file="res",status='unknown')
do i=1,3
read(20,fmt='(a)') line
read(unit=line,fmt='(i2)') p
if(index(line,'element')==0) then
open(12,file=afile,status='old')
do a=1,3
read(unit=12,fmt='(a)') lmpline
k=index(lmpline,'#');if(k==0) goto 90
atom=lmpline(k:k+6)
k=len_trim(atom)
90 write(11,'(i2,a)') k, atom
enddo
write(11,'(i2,a)') atom
endif
close(12)
enddo
end program prevod
The result I want should look like:
1 K
1 L
1 M
I need to from second file this change of three numbers to K, L, M.
Before we do anything else, let's get rid of that goto. Nothing good can come of it. The lines
read(unit=12,fmt='(a)') lmpline
k=index(lmpline,'#');if(k==0) goto 90
atom=lmpline(k:k+6)
k=len_trim(atom)
90 write(11,'(i2,a)') k, atom
are equivalent to
read(unit=12,fmt='(a)') lmpline
k=index(lmpline,'#')
if (k/=0) then
atom=lmpline(k:k+6)
k=len_trim(atom)
endif
write(11,'(i2,a)') k, atom
but it looks like you're trying to to error handling, which should probably instead be
read(unit=12,fmt='(a)') lmpline
k=index(lmpline,'#')
if (k==0) then
write(11,'(i2,a)') k, atom
stop
endif
atom=lmpline(k:k+6)
k=len_trim(atom)
The next thing to note is that it's not generally a good idea to read through the same file lots of times in the same code. Instead, let's pull your code for reading word (which I believe you call t2.dat in your code?) out of the loop for reading text.dat, and store each atom in an array, as per Ian Bush's comments:
program prevod
implicit none
integer :: i, k, maxgrps, a, p
character(LEN=40):: afile, line, lmpline
parameter (maxgrps=10)
character*10 :: atoms(3), blank, atpname(maxgrps)
logical :: elements, first
afile="t2.dat"
open(12,file=afile,status='old')
do a=1,3
read(unit=12,fmt='(a)') lmpline
k=index(lmpline,'#')
if (k==0) then
write(*, *) k, atom
stop
endif
atoms(a)=lmpline(k:k+6)
enddo
close(12)
open(20, file = "text.dat",status='old')
open(11,file="res",status='unknown')
do i=1,3
read(20,fmt='(a)') line
read(unit=line,fmt='(i2)') p
if(index(line,'element')==0) then
do a=1,3
k=len_trim(atoms(a))
write(11,'(i2,a)') k, atoms(a)
enddo
write(11,'(i2,a)') atoms(3)
endif
enddo
end program prevod
Note that I've replaced the last atom with atoms(3) as you're writing it outside the loop, so it will take the final value. This is probably not what you want.
Now we can look at your loop for reading text.dat and writing res. First off, you're only reading one integer from each line of text.dat. You probably want to read both integers from each line. Also, it's generally better to use list-directed reads rather than formatted reads for this kind of task, as they are more flexible to file format. So your line
read(unit=line,fmt='(i2)') p
would become
read(unit=line, *) a, p
Now you can look for the atom which matches p. Rather than scrolling through a file and finding the match, you can simply access this as atoms(p). And so your code would become
program prevod
implicit none
integer :: i, k, maxgrps, a, p
character(LEN=40):: afile, line, lmpline
parameter (maxgrps=10)
character*10 :: atoms(3), blank, atpname(maxgrps)
logical :: elements, first
afile="t2.dat"
open(12,file=afile,status='old')
do a=1,3
read(unit=12,fmt='(a)') lmpline
k=index(lmpline,'#')
if (k==0) then
write(*, *) k, atom
stop
endif
atoms(a)=lmpline(k:k+6)
enddo
close(12)
open(20, file = "text.dat",status='old')
open(11,file="res",status='unknown')
do i=1,3
read(20,fmt='(a)') line
read(unit=line, *) a, p
write(11,'(i2,a)') a, atoms(p)
enddo
end program prevod
I am trying to read a text file using a Fortran code. I have a file with 1999 rows and the number of columns vary with each row. Can someone please tell me how one can code such a problem. This is my code for reading a 4*2 text file but I am using do loops which I can't use in my current case.
PROGRAM myread2
IMPLICIT NONE
INTEGER, DIMENSION(100) :: a, b
INTEGER :: row,col,max_rows,max_cols
OPEN(UNIT=11, file='text.txt')
DO row = 1,4
READ(11,*) a(row), b(row)
END DO
PRINT *, a(1)
PRINT *, a(4)
PRINT*, b(4)
END PROGRAM myread2
The best way of reading a file like this depends on how you want to store the data. I'm going to use a ragged array as it's probably simplest, although other container types may be better suited depending on your requirements.
Fortran doesn't have ragged arrays natively, so first you need to define a type to hold each row. This can be done as
type :: RowData
integer, allocatable :: cols(:)
end type
type(RowData), allocatable :: rows(:)
When this container is filled out, the value in the i'th column of the j'th row will be accessed as
value = rows(j)%cols(i)
We can then write a program to read the file, e.g.
type :: RowData
integer, allocatable :: cols(:)
end type
type(RowData), allocatable :: rows(:)
integer :: no_rows
integer :: i
open(unit=11, file='text.txt')
no_rows = count_lines(11)
allocate(rows(no_rows))
do i=1,no_rows
rows(i)%cols = read_row(11)
enddo
Now we just need to write the functions count_lines, which counts the number of lines in the file, and read_row, which reads a line from the file and returns the contents of that line as an array of integers.
Following this question, count_lines can be written as
! Takes a file unit, and returns the number of lines in the file.
! N.B. the file must be at the start of the file.
function count_lines(file_unit) result(output)
integer, intent(in) :: file_unit
integer :: output
integer :: iostat
output = 0
iostat = 0
do while (iostat==0)
read(file_unit, *, iostat=iostat)
if (iostat==0) then
output = output+1
endif
enddo
rewind(file_unit)
end function
Writing read_row, to parse a line of unknown length from a file, can be done by following this question.
I have written a function that reads an array and returns it:
function read_array(f) result (arr)
implicit none
integer, intent(in) :: f
integer, dimension(:), pointer :: arr
integer :: n, i
read(f, *) n
allocate(arr(n))
do i = 1, n
read(f, *) arr(i)
end do
end function read_array
This function is supposed to read an array of integers from a file in unit f and return it as a pointer. The problem is that in the do loop, every read statement reads an entire line, rather than just 1 integer.
Here is how I want my file to look:
5
9 7 4 3 10
And here is how I have to lay it out currently:
5
9
7
4
3
10
So how can I make the read statement not consume an entire line and only read one number?
I think that something like
read(f,*)yourarray
should work for you
Can anyone help me to find where I am going wrong about writing this code
program time_period
! This program calculates time period of an SHM given length of the chord
implicit none
integer, parameter:: length=10
real, parameter :: g=9.81, pi=3.1415926535897932384
integer, dimension(1:length)::chordlength
integer :: l
real :: time
do l= 1,length
time = 2*pi*(chordlength(l)/(g))**.5
print *, l, time
enddo
end program
Result:
1 0.00000000E+00
2 0.00000000E+00
3 0.00000000E+00
4 0.00000000E+00
5 0.00000000E+00
6 0.00000000E+00
7 0.00000000E+00
8 0.00000000E+00
9 0.00000000E+00
10 0.00000000E+00
If the chord lengths you're interested are the integer values 1,2,...,10 you hardly need an array to store them. Further, if what you are interested in are the SHM period lengths for each of those 10 chord lengths, it strikes me that you should have an array like this:
real, dimension(length) :: shm_periods
which you would then populate, perhaps like this:
do l= 1,length
shm_periods(l) = 2*pi*(l/g)**.5
print *, l, shm_periods(l)
enddo
Next, you could learn about Fortran's array syntax and write only one statement to assign values to shm_periods.
#High Performance Mark
i worked it the following way
program time_period
! This program calculates time period of an SHM given length of the chord
implicit none
integer, parameter:: length=10
real, parameter :: g=9.81, pi=3.1415926535897932384
integer, dimension(1:length)::chordlength
integer :: l
real, dimension(1:length) :: timeperiod
do l= 1,length
print *, 'Enter ChordLength', l
read *, chordlength(l)
timeperiod(l) = 2*pi*(chordlength(l)/g)**.5
enddo
do l=1,length
print *, l, timeperiod(l)
enddo
end program
its giving me results but asking to type the chord lengths...appreciate your help
The code below does not answer your question (since you already did that). But it does address some issues with the design of the code.
As a next step, lets say you want to use a) a function for the calculation, b) have some standard length values to display the period and c) input a custom length for calculation.
Fortran allows for the declaration of elemental functions which can operate on single values or arrays just the same (with no need for a loop). See the example below:
elemental function CalcTimePeriod(chord_length) result(period)
! Calculate the SHM time period from the chord length
real, parameter :: g=9.80665, pi=3.1415926535897932384
real, intent(in) :: chord_length
real :: period
period = 2*pi*sqrt(chord_length/g)
end function
So I am posting the code below in hopes that you can learn something new with modern Fortran.
program SHM_CalcTime
implicit none
! Variables
integer, parameter :: n = 10
real, dimension(n) :: gen_lengths, periods
real :: input_length
integer :: i
! Example calculation from generated array of chord lengths
! fill an array of lengths using the formula len = 1.0 + (i-1)/2
gen_lengths = [ (1.0+real(i-1)/2, i=1, n) ]
! calculate the time periods for ALL the lengths in the array
periods = CalcTimePeriod(gen_lengths)
write (*, '(1x,a14,1x,a18)') 'length', 'period'
do i=1,n
write (*, '(1x,g18.4,1x,g18.6)') gen_lengths(i), periods(i)
end do
input_length = 1.0
do while( input_length>0 )
write (*,*) 'Enter chord length (0 to exit):'
read (*,*) input_length
if(input_length<=0.0) then
exit
end if
write (*, '(1x,g18.4,1x,g18.6)') input_length, CalcTimePeriod(input_length)
end do
contains
elemental function CalcTimePeriod(chord_length) result(period)
! Calculate the SHM time period from the chord length
real, parameter :: g=9.80665, pi=3.1415926535897932384
real, intent(in) :: chord_length
real :: period
period = 2*pi*sqrt(chord_length/g)
end function
end program SHM_CalcTime
On a final note, see that programs can have internal functions declared after a contains statement, with no need for an explicit interface declaration as you would with older Fortran variants.
I have found many questions that turn around this issue, but none that directly answer the question:
-in fortran, what are (a) the fastest (wall clock) and (b) the most elegant (concise and clear) way to eliminate duplicates from a list of integers
There has to be a better way than my feeble attempt:
Program unique
implicit none
! find "indices", the list of unique numbers in "list"
integer( kind = 4 ) :: kx, list(10)
integer( kind = 4 ),allocatable :: indices(:)
logical :: mask(10)
!!$ list=(/3,2,5,7,3,1,4,7,3,3/)
list=(/1,(kx,kx=1,9)/)
mask(1)=.true.
do kx=10,2,-1
mask(kx)= .not.(any(list(:kx-1)==list(kx)))
end do
indices=pack([(kx,kx=1,10)],mask)
print *,indices
End Program unique
My attempt expects the list to be ordered, but it would be better if that requirement were lifted
I just couldn't help myself, so I wrote up an answer you may enjoy. The following code will return an array of unique values in ascending order for an input array of unsorted integers. Note that the output results are the actual values, not just the indices.
program unique_sort
implicit none
integer :: i = 0, min_val, max_val
integer, dimension(10) :: val, unique
integer, dimension(:), allocatable :: final
val = [ 3,2,5,7,3,1,4,7,3,3 ]
min_val = minval(val)-1
max_val = maxval(val)
do while (min_val<max_val)
i = i+1
min_val = minval(val, mask=val>min_val)
unique(i) = min_val
enddo
allocate(final(i), source=unique(1:i)) !<-- Or, just use unique(1:i)
print "(10i5:)", final
end program unique_sort
! output: 1 2 3 4 5 7
See this gist for timing comparisons between (unique_sort) above, your example (unique_indices), and the example at Rosetta Code (remove_dups) as well as a couple of variations. I'd like to test #High Performance Mark's code but haven't yet.
Run program 1,000,000 times, 100 integers 0<=N<=50
- unique_sort t~2.1 sec input: unsorted, w/duplicates output: sorted unique values
- remove_dup t~1.4 input: unsorted, w/duplicates output: unsorted unique values
- unique_indices t~1.0 input: sorted, w/duplicates output: unsorted indices for unique values
- BONUS!(Python) t~4.1 input: unsorted, w/duplicates output: sorted unique values
Bottom line: on my machine (i7 8GB laptop) unique_indices is slightly faster than remove_dups. However, remove_dups does not require the input array to be pre-sorted, and actually returns the values rather than the indices (see the gist for a modified version of unique_indices that returns the values instead, which doesn't seem to slow it down much at all).
On the other hand, unique_sort takes around twice as long, but is designed to handle unsorted input, and also returns the values in sorted order, in 8 LOC (minus the var declarations). So that seems a fair trade-off. Anywho, I'm sure unique_sort can be optimized for greater speed using some sort of masking statement, but that's for another day.
Update
The timings shown above were obtained from a test program where each subroutine was placed in a module and executed via a procedure call. However, I found a surprisingly large improvement in performance when unique_sort was placed directly in the main program, completing in only ~0.08 sec for 1 million runs. A speedup of ~25x simply by not using a procedure seems strange to me - ordinarily, I assume that the compiler optimizes the cost of procedure calls away. For example, I found no difference in performance for remove_dup or unique_indices whether they were executed via a procedure or placed directly in the main program.
After #VladimirF pointed out that I was overcomparing, I found I could vectorize my original code (remove the do loop do kx....). I have coupled the "unique" function with a mergesort algorithm loosely based on wikipedia. The guts are contained in module SortUnique
Module SortUnique
contains
Recursive Subroutine MergeSort(temp, Begin, Finish, list)
! 1st 3 arguments are input, 4th is output sorted list
implicit none
integer(kind=4),intent(inout) :: Begin,list(:),temp(:)
integer(kind=4),intent(in) :: Finish
integer(kind=4) :: Middle
if (Finish-Begin<2) then !if run size =1
return !it is sorted
else
! split longer runs into halves
Middle = (Finish+Begin)/2
! recursively sort both halves from list into temp
call MergeSort(list, Begin, Middle, temp)
call MergeSort(list, Middle, Finish, temp)
! merge sorted runs from temp into list
call Merge(temp, Begin, Middle, Finish, list)
endif
End Subroutine MergeSort
Subroutine Merge(list, Begin, Middle, Finish, temp)
implicit none
integer(kind=4),intent(inout) :: list(:),temp(:)
integer(kind=4),intent(in) ::Begin,Middle,Finish
integer(kind=4) :: kx,ky,kz
ky=Begin
kz=Middle
!! While there are elements in the left or right runs...
do kx=Begin,Finish-1
!! If left run head exists and is <= existing right run head.
if (ky.lt.Middle.and.(kz.ge.Finish.or.list(ky).le.list(kz))) then
temp(kx)=list(ky)
ky=ky+1
else
temp(kx)=list(kz)
kz = kz + 1
end if
end do
End Subroutine Merge
Function Unique(list)
!! usage sortedlist=Unique(list)
implicit none
integer(kind=4) :: strt,fin,N
integer(kind=4), intent(inout) :: list(:)
integer(kind=4), allocatable :: unique(:),work(:)
logical,allocatable :: mask(:)
! sort
work=list;strt=1;N=size(list);fin=N+1
call MergeSort(work,strt,fin,list)
! cull duplicate indices
allocate(mask(N));
mask=.false.
mask(1:N-1)=list(1:N-1)==list(2:N)
unique=pack(list,.not.mask)
End Function Unique
End Module SortUnique
Program TestUnique
use SortUnique
implicit none
! find "indices", the list of unique numbers in "list"
integer (kind=4),allocatable :: list(:),newlist(:)
integer (kind=4) :: kx,N=100000 !N even
real (kind=4) :: start,finish,myrandom
allocate(list(N))
do kx=1,N
call random_number(myrandom)
list(kx)=ifix(float(N)/2.*myrandom)
end do
call cpu_time(start)
newlist=unique(list)
call cpu_time(finish)
print *,"cull duplicates: ",finish-start
print *,"size(newlist) ",size(newlist)
End Program TestUnique
At #HighPerformanceMark 's suggestion, the function is simply invoked as newlist=unique(list). The above is certainly not concise, but it seems clear, and it is about 200 times faster than either my original or the other solutions proposed.