How to print in a single row in a loop? - fortran

Suppose I have a Fortran program which includes the following loop:
do i=1, 10
print *, i
enddo
The output of this will be like
1
2
...
10
How can I write these values to a single line, like in the following?
1 2 ... 10

There are a number of ways, two that come to mind immediately are shown in the following little program
$ cat loop.f90
Program loop
Implicit None
Integer :: i
Write( *, * ) 'First way - non-advancing I/O'
Do i = 1, 10
Write( *, '( i0, 1x )', Advance = 'No' ) i
End Do
Write( *, * ) ! Finish record
Write( *, * ) 'Second way - implied do loop'
Write( *, * ) ( i, i = 1, 10 )
End Program loop
$ gfortran -std=f2003 -Wall -Wextra -fcheck=all loop.f90
$ ./a.out
First way - non-advancing I/O
1 2 3 4 5 6 7 8 9 10
Second way - implied do loop
1 2 3 4 5 6 7 8 9 10
$
The first method. non-advancing I/O, suppresses the end of record marker being written, which is normally a new line, but does require an explicit format. The second, implied do loop, doesn't require a format, but is less flexible.
BTW in English they are normally called "loops"

Related

How to extract substring of Fortran string array using index of position?

I have two files, one with two columns where I want to extract a substring from the second column; and the other file has a single column with the position used to subset the string. The first and second files look like these:
File 1: file.txt
1 123456789
2 123456789
3 123456789
4 123456789
5 123456789
6 123456789
7 123456789
8 123456789
9 123456789
10 123456789
File 2: index.txt
1
3
5
7
In this example, the second column of the file.txt has 9 values without space. I would like to do a subset based on the position from the index.txt file.
I wrote the following program in Fortran that where I can subset them, but I don't know how to collapse them together so when I write them to a file they would be together without space.
Fortran file: subsetFile.f90
program subsetfile
implicit none
integer :: io,tmp,n,m,s,i,ind
integer, dimension (:), allocatable :: vec, idx
character(len=1000) :: arr
character(len=1000) :: fn, fnpos
print*, "File name:"
read*, fn
print*, "Position file name:"
read*, fnpos
open(unit=100, file=fnpos, status='old', action='read')
n = 0
do
read(100,*,iostat=io)
if (io/=0) exit
n = n + 1
end do
close(unit=100)
allocate (idx(n))
open(unit=101, file=fnpos, status='old', action='read')
do i=1,n
read(101,*) idx(i)
end do
close(unit=101)
s = n + 1
open(unit=102, file=fn, status='old', action='read')
n = 0
do
read(102,*,iostat=io)
if (io/=0) exit
n = n + 1
end do
close(unit=102)
open(unit=103, file=fn, status='old', action='read')
do
read(103,*) tmp, arr
m = len_trim(arr)
exit
end do
close(unit=103)
allocate (vec(m))
open(unit=104, file = fn, status = 'old', action = 'read')
open(unit=105, file = 'output.txt', status = 'replace')
do i=1,n
read(104,*) ind, arr
read(arr,'(*(i1))') vec
write(105, *) ind, vec(idx)
end do
close(unit=104)
close(unit=105)
deallocate (idx, vec)
end program subsetfile
The following is the output I get when I run the code:
1 1 3 5 7
2 1 3 5 7
3 1 3 5 7
4 1 3 5 7
5 1 3 5 7
6 1 3 5 7
7 1 3 5 7
8 1 3 5 7
9 1 3 5 7
10 1 3 5 7
The following is the desired output:
1 1357
2 1357
3 1357
4 1357
5 1357
6 1357
7 1357
8 1357
9 1357
10 1357
Does anyone know how can I write a file in that format, with only two columns?
Thank you
You should use explicit format for the output, not the list-directed format (*). You are already using the i1 descriptor for the read. You can also use it for the write.
write(105, '(i0,5x,*(i1))') ind, vec(idx)
If those vec members may be larger than 9 and occupy more digits, use i0 instead. Adjust other parameters as needed (e.g. fixed number of characters for the first number or the number of the spaces between the columns.
write(105, '(i10,1x,*(i1))') ind, vec(idx)
In Fortran, each format for formatted I/O is a string: so you have complete freedom as far as how you can specify it.
In most cases, your format never changes, see it as a PARAMETER in your program. In fact, you can specify such parameter string in three ways:
Inside the read/write statement:
write(unit,'(xxxxx)')
as a format label
write(unit,100)
100 format(xxxxx)
as a parameter string
character(len=*), parameter :: myFmt = "(xxxxx)"
write(unit,myFmt)
as a non-parameter string. Note in both ways 1) and 2) you are just using a character(len=*), parameter string variable. Similarly, if your format may vary at runtime, just create an appropriate format string every time you need to use it, for example:
program test_formatString
implicit none
! Copy user data
integer, parameter :: vec(*) = [1,2,3,4,5,6,7,8,9,0]
integer, parameter :: idx(*) = [1,3,5,7]
integer :: n
n = 12
! Test variable sizes of the first column vs the index columns
write(*,myWidthFmt(2,1)) n, vec(idx)
write(*,myWidthFmt(4,2)) n, vec(idx)
write(*,myWidthFmt(3,3)) n, vec(idx)
contains
! Function to create a format string
character(len=15) function myWidthFmt(indWidth,vecWidth) result(fmt)
integer, intent(in) :: indWidth,vecWidth
write(fmt,1) min(indWidth,99),min(vecWidth,99)
1 format('(i',i2,',1x,*(i',i2,'))')
end function myWidthFmt
end program test_formatString

Need Help: Fortran Infinite Loop

I'm very new to using Fortran, and I can't seem to figure out why this subroutine is getting stuck in an infinite loop. Here's the code for said DO loop:
SUBROUTINE FILLARRAY(K, N)
REAL X, Y
INTEGER XPOS, YPOS
INTEGER K(N,N)
DO 10 I = 1, 100
15 CALL RANDOM_NUMBER(X)
CALL RANDOM_NUMBER(Y)
XPOS = 20 * X + 1.0
YPOS = 20 * Y + 1.0
PRINT *, XPOS
PRINT *, YPOS
IF(K(XPOS, YPOS).NE.1) THEN
K(XPOS,YPOS) = 1
END IF
IF (K(XPOS, YPOS).EQ.1) THEN
GOTO 15
END IF
10 CONTINUE
RETURN
END
I am basically trying to fill a 20 x 20 array randomly with the value 1.
I was also wondering if there is a way to forego using END IF that anyone knows about! Thank you!
The array will eventually all be set to 1 leading to an infinte loop with GOTO 15.
Try this code instead:
IF(K(XPOS, YPOS).NE.1) THEN
K(XPOS,YPOS) = 1
ELSE
GOTO 15
END IF
This method is horribly inefficient. I'd do it something like the below. Note i've filled with i rather than 1, partially to show the random order of filling, partially to act as a check I haven't screwed up, as each number should appear exactly once.
ian#eris:~/work/stack$ cat random_fill.f90
Program random_fill
Implicit None
Integer, Parameter :: n = 5
Integer, Dimension( 1:n, 1:n ) :: K
Call fillarray( k, n )
Write( *, '( 5( 5( i2, 1x ) / ) )' ) K
Contains
Subroutine fillarray( k, n )
Implicit None
Integer , Intent( In ) :: n
Integer, Dimension( 1:n, 1:n ), Intent( Out ) :: K
Integer, Dimension( : ), Allocatable :: index_list
Real :: rand
Integer :: val, x, y
Integer :: i
index_list = [ ( i, i = 0, n * n - 1 ) ]
Do i = 1, n * n
Call Random_number( rand )
val = 1 + Int( rand * Size( index_list ) )
x = 1 + index_list( val ) / n
y = 1 + Mod( index_list( val ), n )
K( x, y ) = i
index_list = [ index_list( :val - 1 ), index_list( val + 1: ) ]
End Do
End Subroutine fillarray
End Program random_fill
ian#eris:~/work/stack$ gfortran -O -Wall -Wextra -pedantic -fcheck=all -std=f2008 random_fill.f90
ian#eris:~/work/stack$ ./a.out
11 8 14 24 16
19 23 25 15 3
21 20 5 7 18
6 17 22 12 9
2 4 1 10 13
ian#eris:~/work/stack$ ./a.out
24 15 7 22 25
8 17 10 1 14
9 5 4 12 2
11 21 20 3 18
6 19 23 13 16
ian#eris:~/work/stack$ ./a.out
22 11 6 21 24
7 3 8 10 25
17 19 16 2 9
13 4 15 5 23
12 1 14 20 18
You are stuck in an infinite loop because the statement goto 15 is always executed.
If k(xpos, ypos) is 1 then the first if statement is false, but the second is true so the goto 15 is executed.
If instead k(xpos, ypos) is not 1 then the first if statement is true, and so k(xpos, ypos) is set to 1. The second if statement is only evaluated after this, and so is true, and so the goto 15 is executed.
As other answers have mentioned, the method you are using is horribly inefficient. However, if you still want to use it, here is the fixed code, with a number of modernisations:
subroutine fillarray(k, n)
implicit none
integer, intent(in) :: n
integer, intent(inout) :: k(n,n)
real(dp) :: x, y
integer :: xpos, ypos
integer :: i
i=1
do while (i<=100)
call random_number(x)
call random_number(y)
xpos = 20*x + 1.0_dp
ypos = 20*y + 1.0_dp
if (k(xpos, ypos)/=1) then
k(xpos, ypos) = 1
i = i+1
endif
enddo
end subroutine
Note that this assumes that the array k has already been initialised, otherwise checking the contents of the array will lead to undefined behaviour.
As to whether end if is optional or not. No, it is not optional. It is always required. All languages need to know where the end of a loop is. C uses }, Python uses un-indentation, Fortran uses endif.

Do loop is stuck at the first subarray in MPI SCATTER and GATHER

I have two arrays, array global has 8 values and it will be scatter among array local with 2 values. What I was trying to do is, take the big array, split into small arrays, do some work, then put it back together.
Problem:
Even though I successfully scattered the data, the do loop as written is only working for the first sub array local. What I want is all of the integers in the scattered local array should be multiplied by 2, then gathered into the global array.
Code for the do loop (some work has been done here):
do j = 1,2
local(j) = j*2
print *, j
end do
Here's the full code. If you go down below you'll notice the part which I need your help.
MODULE MPI
IMPLICIT NONE
INCLUDE 'mpif.h'
INTEGER :: MYID,TOTPS, IERR, MPISTTS
CONTAINS
SUBROUTINE MPIINIT
IMPLICIT NONE
CALL MPI_INIT( IERR )
CALL MPI_COMM_RANK(MPI_COMM_WORLD,MYID,IERR)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD,TOTPS,IERR)
RETURN
END SUBROUTINE MPIINIT
END MODULE MPI
PROGRAM SCATTER
USE MPI
IMPLICIT NONE
CALL MPIINIT
CALL TEST
CALL MPI_FINALIZE(IERR)
CONTAINS
SUBROUTINE TEST
USE MPI
IMPLICIT NONE
INTEGER :: I,J
INTEGER,DIMENSION(8) :: GLOBAL
INTEGER,DIMENSION(2) :: LOCAL
if (myid .eq. 0) then
do i = 1,8
global(i) = i
end do
end if
call mpi_scatter(global,2,mpi_integer,local,2,mpi_integer,0, &
mpi_comm_world,ierr)
print*,"task",myid,":",local
call mpi_barrier(mpi_comm_world,ierr)
!!!!!!! do some work here
do j = 1,2
local(j) = j*2
print*,j
end do
!!!!!! end work
call mpi_gather(local,2,mpi_integer,global,2,mpi_integer,0, &
mpi_comm_world,ierr)
if(myid .eq. 0) then
print*,"task",myid,":",global
end if
END SUBROUTINE TEST
END PROGRAM SCATTER
Notes:
(1) I've been reading & learning from this thread but it looks challenging for now.
(2) Run code mpif90 SCATTER.f90 .. mpirun -np 4 ./a.out
Output:
task 0 : 1 2
task 1 : 3 4
task 2 : 5 6
task 3 : 7 8
1
2
1
2
1
2
1
2
task 0 : 2 4 2 4 2 4 2 4
What I want to get is: task 0 : 2 4 6 8 10 12 14 16
You wrote
local(j) = j * 2
print*, j
I don't think that does what you think it does.
You probably meant to write
local(j) = local(j) * 2
print*, local(j)

-fortran : reading numbers from a text file

I have a text file of numbers containing several columns and several lines. I have tried several ways including arrays but in the best result I could get only 3 columns of the whole. Any ideas how I can read all the data in Fortran 77?
open(unit=1, file='f', status='old')
do i = 1, 100
read(1, *) x(i), y(i), z(i)
write(6, * ) x(i), y(i), z(i)
enddo
or even 2 dimensional arrays:
do i = 1, 100
do j = 1, 50
read(1, *) x(i, j)
write(6, *) x(i, j)
enddo
enddo
or changing the open(..., access='direct')
none of them worked out since i have a file like this:
1 2 4.5 77 89 4 3 2...
2 4 4 5 6 73 5 3.4 ...
1 2 4 5 67 8 99...
...
The data does not seem to have any particular structure.
You can use list-directed input for this:
program main
real a(100)
read (*,*) a
print *,a
end
I would advise you against using any unit number smaller than 10 in your code for your own purposes.

Random sampling in fortran

I have the following data
X Y INFTIME
1 1 0
1 2 4
1 3 4
1 4 3
2 1 3
2 2 1
2 3 3
2 4 4
3 1 2
3 2 2
3 3 0
3 4 2
4 1 4
4 2 3
4 3 3
4 4 0
X and Y represent he X and Y components in the square grid of 4 by 4.
Here I want to sample randomly 10% from the population which are infected i.e, whose INFTIME is non zero. I did not get any idea of coding so could not start it.
Any suggestions and idea will be great for me.
Thanks
EDIT:
DO T = 1,10
DO i = 1, 625
IF(INFTIME(i)/=0 .AND. INFTIME(i) .LE. T)THEN
CALL RANDOM_NUMBER(u(i))
u(i) = 1+aint(u(i)*25)
CALL RANDOM_NUMBER(v(i))
v(i) = 1+aint(v(i)*25)
CALL RANDOM_NUMBER(w(i))
w(i) = 1+aint(w(i)*10)
ENDIF
ENDDO
ENDDO
do p = 1,625
WRITE(*,*) u(p),v(p),w(p)
enddo
This is my code what I tried but it only gives the random numbers, not the connection to the data. I used the data of 25 by 25 grids i.e, 625 individuals and time of infection 1 to 10
Follow what ja72 said. You have three 1D arrays of the same size (16). All you need to do is pick a number between 1 and 16, check to see if INFTIME is zero and accept the value as needed, then repeat until you've taken 10% of the samples (which would be 1.6 values, so I presume you'd just take 2? Or do you have more data than this 4x4 you presented?)
Edit You need to call the random number generator before the if statement:
do t=1,10
do i=1,625
ind = 1+int(624*rand(seed))
if(inftime(ind).neq.0 .and. inftime(ind).le.t) then
stuff
endif
enddo
enddo
The call ind=1+int(625*rand(seed)) will pick a random integer between 1 (when rand(seed)=0) and 625 (when rand(seed)=1). Then you can do what you need if the if statement is satisfied.
EDIT: program epimatrix
IMPLICIT NONE
INTEGER ::l, i,T,K
REAL, DIMENSION(1:625):: X,y,inftime
INTEGER::seed,my_cnt
INTEGER,DIMENSION(8) :: time1
CALL DATE_AND_TIME(values=time1)
seed = 1000*time1(7)+time1(8)
call srand(seed)
OPEN(10, FILE = 'epidemicSIR.txt', FORM = 'FORMATTED')
DO l = 1,625
READ(10,*,END = 200) X(l), Y(l), INFTIME(l)
! WRITE(*,*) X(l),Y(l), INFTIME(l)
! if you know how it was formatted, you should use
! read(10,20) X(l), Y(l), INFTIME(l)
! where 20 is the format
ENDDO
200 CONTINUE
CLOSE(10)
DO T = 1,10
my_cnt=0
write(*,*) "T=",T
DO while (my_cnt.le.63)
K = 1+int(624*rand())
IF(INFTIME(K)/=0 .AND. INFTIME(K) .LE. T)THEN
write(*,*) X(k),Y(k),INFTIME(k)
my_cnt=my_cnt+1
ENDIF
enddo
write(*,*) " "
ENDDO
end program
EDIT 2
I've adjusted the program to fix some of the issues. I've tried keeping my edits in lowercase so that you can see the difference. The do-while loop allows the code to continue running until the condition my_cnt.le.63 has been met (which means you have 63 lines of X, Y, inftime per T). I've added a line to output T and another line to add a space so that the data might be more clear when looking at the output.
This should take care of all the issues you've been running into. If not, I'll keep checking this page.