I have been stuck for a while on this. I ran a simulation in Fortran90.
program epidemic
implicit none
!!!variable declaration
integer, parameter::n=625
real, dimension(1:n)::x,y
real :: alpha, beta, epsilon, dist, prob, u
integer, dimension(1:n) :: infections
integer:: T, I1, I2, I3, i, j, K2, infperiod, k, tmax
!!!!!!!!!! paramater value
tmax=11
alpha=0.4
gamma=9
!!Generate population!!
I3=1
Do I1=1, 25, 1
Do I2=1,25,1
x(I3)=REAL(I1)
y(I3)=REAL(I2)
Infections(I3)=0
I3=I3+1
ENDDO
ENDDO
!!!INITIAL INFECTION!!!
call random_number(u)
k2=1+aint(u)*n
infections(k2)=1
!!!! initial infection !!!!!!
call random_number(u)
IF (prob >= u) THEN
END IF
END IF
ENDDO
enddo
!!! output data
!!! writing and saving
Do i= 1, n
write(*,*) i, x(i), y(i)
ENDDO
end program epidemic
The result of my simulation is a data frame that looks like this
1 1.00000000 1.00000000 1
2 1.00000000 2.00000000 4
3 1.00000000 3.00000000 3
4 1.00000000 4.00000000 4
5 1.00000000 5.00000000 4
6 1.00000000 6.00000000 4
7 1.00000000 7.00000000 4
8 1.00000000 8.00000000 2
9 1.00000000 9.00000000 4
10 1.00000000 10.0000000 4
11 1.00000000 11.0000000 5
12 1.00000000 12.0000000 5
13 1.00000000 13.0000000 4
14 1.00000000 14.0000000 5
15 1.00000000 15.0000000 6
The first column represents the individuals such that i=1, 625, The second and third column represents the matrix indices [i,j]. The forth column represents the (time) (1:15 days) the person get the infections. I would like to be able to table the output into just two columns.
Just to illustrate, I would like to create a new variable that show the many people got infected in this day.
So, the output of the 625 rows becomes something like this
AT Day=1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
Total of infected individual =3 5 6 7 11 8 0 1 ...........
Thank you very very much
Now that it's clear what you have, try this:
Add a new declaration
integer, dimension(15) :: infection_day
and, after your existing loop do T ..., insert something like
do i = 1, 15
infection_day(i) = count(infections==i)
end do
to summarise your data.
I don't have Fortran on this machine so haven't tested this code fragment, but it should put you on the right track.
This should get you started...
...
INTEGER, DIMENSION(31) :: Sums
!day is the 4th column from 1:625...
...
Sums(:) = 0
...
DO Entry = 1, 625
Sums(Thedayindex) = Sums(Thedayindex) + Day(Entry)
ENDDO
...
Related
I am trying to parallelize a distributed hydrological model using MPI (in Fortran). The model takes its input data from a file and most of the inputs are 2D arrays. My goal is to decompose the 2D global data into a small chunk 2D data and send each chunk to different cores. Then do some computation on the small chunk and finally gather the results back to the root.
I just followed the wonderful answer by Jonathan Dursi at Sending 2D arrays in Fortran with MPI_Gather, and I wanted to add more flexibility to include the cases when the 2D array data domain in both dimensions is not equally divisible by the number of processor cores.
I have also seen the solution for the same problem based on MPI_Alltoallw at Scatter Matrix Blocks of Different Sizes using MPI again by Jonathan Dursi. That method needs the creation of 4 types of blocks. For me it is a bit difficult to implement that because I don't know the exact size of the global domain. The model is intended to be applied in different domain sizes, i.e. in different river basins to be specific. Also the model has many input data (some subroutines have up to 15 different types of 2D data) to communicate between cores.
So, I was trying to solve the problem this way.
Create optimal division of processors in each dimension of the Cartesian grid
Define a new Cartesian communicator (with periods=.true., this is very important)
Create new datatype with MPI_Type_create_subarray (with equally sized type. Actually, it is not equally sized, but I forced it with periods=.true. on both dimensions. And here is where the problem occurred)
Scatter the data with MPI_Scatterv
Do the computation
Gather the results with MPI_Gatherv (I know the gatherv truncates some data, but that is not a problem as that part of the data is not needed)
The problem is that the periods=.true. doesn't have an effect, or I misunderstand what periods means in MPI_Cart_create. My understanding was that if periods are true in a dimension, then after the end of the data in that dimension it will pick the data in the beginning of the dimension (i.e. the data at the beginning will be taken twice, first by let's say process 0, and then by the last process in that dimension). But this is not happening for me at the moment. The last process in that dimension picks the data at the beginning of the next row. After that everything goes crazy. Had the periods been functioning as I expected, I guess the approach was correct.
System and Environment (Ubuntu 21.10, GFortran 11.2.0, Open MPI 4.1.1)
I would be very happy if you have any idea why periods=.true. is not responding as expected.
I am playing with it by creating a 10 by 10 random number, and I paste everything here. Please pardon me if 10x10 is a big matrix for your eyes. For me it works fine when the number of processes is 4 and gives incorrect answer with 6 processes.
program topo
USE mpi_f08
implicit none
!VARIABLE DECLARATION ==> related to the application
integer, parameter :: rows = 10, cols = 10
integer, dimension(rows*cols) :: file
integer, dimension(rows, cols) :: array_a
integer, allocatable, dimension(:,:) :: array_b
integer :: i, j, p
!VARIABLE DECLARATION ==> related to MPI
TYPE(MPI_Comm) :: comcart, comm=MPI_COMM_WORLD
integer :: comrank, comsize, ierror
!VARIABLE DECLARATION ==> related to Topology
integer, parameter :: ndims = rank(array_a)
integer :: dims(ndims)
logical :: periodic(ndims), reorder
!VARIABLE DECLARATION ==> related to SUBARRAY
TYPE(MPI_Datatype) :: newtype, resizedtype
integer(kind=MPI_ADDRESS_KIND) :: extent, lb
integer, dimension(ndims) :: starts, subsizes, gsizes
integer :: intsize
!VARIABLE DECLARATION ==> related to MPI_Scatterv
integer, allocatable, dimension(:) :: displs, counts
!Initialize MPI environment
call MPI_Init(ierror)
call MPI_Comm_rank(comm, comrank, ierror)
call MPI_Comm_size(comm, comsize, ierror)
!Read input data from file (please consider as it is read from file)
if (comrank==0) then
file=(/7,4,5,5,6,1,7,6,8,9,&
8,7,4,1,8,0,0,5,0,8,&
1,7,8,3,2,7,5,5,6,6,&
7,1,8,8,2,4,5,1,3,0,&
3,3,0,4,0,3,4,5,9,2,&
1,9,7,5,8,2,0,7,9,7,&
0,1,0,2,1,7,3,7,2,1,&
9,3,0,1,3,0,5,2,0,2,&
6,7,8,0,6,6,0,2,6,8,&
0,2,3,4,2,8,3,6,2,3/)
!open(unit=20, file="random_num.txt")
! read(20, 100) array_a
!close(20)
array_a=reshape(file,[10, 10])
write(*,*) "The original array from file"
write(*,100) array_a
write(*,*) "=============================================="
100 format(10i10)
end if
!Specifying the number of cores in each dimension. Put (0, 0) to let MPI decide
dims = 0
!Create optimal division of processors in each dimension of the Cartesian grid
Call MPI_Dims_create(comsize, ndims, dims, ierror)
!!Check the allocated cores in each dimension
!if (comrank==0) then
! write(*,*) "The number of cores in Y and X directions are: ", dims
!end if
!Initialize some of the inputs for MPI_Cart_create
periodic = .true.
reorder = .false.
!Define a new communicator
Call MPI_Cart_create(comm, ndims, dims, periodic, reorder, comcart, ierror)
!Update ranks and size based on the new communicator (just in case)
call MPI_Comm_rank(comcart, comrank, ierror)
call MPI_Comm_size(comcart, comsize, ierror)
!Initialize some of the inputs for MPI_Type_create_subarray
gsizes=shape(array_a)
!Here is the trick to make equal-sized chunks (of course the periodic must be true)
subsizes=ceiling(real(gsizes)/real(dims)) ! Or you can activate the alternatives below if you don't like this expression
!subsizes(1)=ceiling(real(gsizes(1))/real(dims(1)))
!subsizes(2)=ceiling(real(gsizes(2))/real(dims(2)))
starts = 0
!!Check the global and local sizes in each dimension
!if (comrank==0) then
! write(*,*) "The number of global grids in Y and X directions are: ", gsizes
! write(*,*) "The number of subgrids in Y and X directions are: ", subsizes
!end if
!Create new datatype with MPI_Type_create_subarray
call MPI_Type_create_subarray(ndims, gsizes, subsizes, starts, MPI_ORDER_FORTRAN, MPI_INTEGER, newtype, ierror)
!Set the extent of the newtype
call MPI_Type_size(MPI_INTEGER, intsize, ierror)
extent = subsizes(1)*intsize
lb = 0
!Resize the newtype based on the new lower bound(lb), and its upper bound is set to be lb + extent.
call MPI_Type_create_resized(newtype, lb, extent, resizedtype, ierror)
!Prepare the new datatype (resizedtype) for use
call MPI_Type_commit(resizedtype, ierror)
!Initialize some of the inputs for MPI_Scatterv
allocate(array_b(subsizes(1), subsizes(2)))
allocate (displs(comsize))
allocate (counts(comsize))
counts = 1 ! we will send one of these new types to everyone
do j = 1, dims(2)
do i = 1, dims(1)
displs(1+(i-1)+dims(1)*(j-1))=(i-1)+subsizes(2)*dims(1)*(j-1)
end do
end do
!write(*,*) "Displs are: ", displs
!Everything is ready. Let's scatter the the data
call MPI_Scatterv(array_a, counts, displs, resizedtype, array_b, subsizes(1)*subsizes(2), MPI_INTEGER, 0, comcart, ierror)
!Check the received chunk of data at each core
do p=1, comsize
if (comrank == p-1) then
write (*, *) 'Rank ', comrank, ' received: '
do i=1, subsizes(2)
write(*, *) array_b(:, i)
end do
end if
call MPI_Barrier(comcart, ierror)
end do
!Do some computation in each core
where (array_b==0)
array_b=999
end where
!Check the chunk of data at each core after computation, i.e. the data soon to be send
do p=1, comsize
if (comrank == p-1) then
write(*, *) 'Rank ', comrank, ' sending: '
do i=1, subsizes(2)
write(*, *) array_b(:,i)
end do
end if
call MPI_Barrier(comcart, ierror)
end do
!Gather the computation results back into the root
call MPI_Gatherv(array_b, subsizes(1)*subsizes(2), MPI_INTEGER, array_a, counts, displs, resizedtype, 0, comcart, ierror)
!Check the final result collected at the root
if (comrank == 0) then
write(*, *) ' Root received: '
do i=1,gsizes(2)
write(*, *) array_a(:, i)
end do
end if
!Deallocate resources associated with the committed type
call MPI_Type_free(resizedtype,ierror)
!Deallocate allocated arrays
deallocate(array_b)
deallocate(displs)
deallocate(counts)
!Terminate MPI environment
call MPI_Finalize(ierror)
end program topo
THE RESULT FROM 6 PROCESSORS LOOKS LIKE
The original array from file
7 4 5 5 6 1 7 6 8 9
8 7 4 1 8 0 0 5 0 8
1 7 8 3 2 7 5 5 6 6
7 1 8 8 2 4 5 1 3 0
3 3 0 4 0 3 4 5 9 2
1 9 7 5 8 2 0 7 9 7
0 1 0 2 1 7 3 7 2 1
9 3 0 1 3 0 5 2 0 2
6 7 8 0 6 6 0 2 6 8
0 2 3 4 2 8 3 6 2 3
==================================================================
Rank 0 received:
7 4 5 5
8 7 4 1
1 7 8 3
7 1 8 8
3 3 0 4
Rank 1 received:
6 1 7 6
8 0 0 5
2 7 5 5
2 4 5 1
0 3 4 5
Rank 2 received:
8 9 8 7
0 8 1 7
6 6 7 1
3 0 3 3
9 2 1 9
Rank 3 received:
0 1 0 2
9 3 0 1
6 7 8 0
0 2 3 4
0 0 3 4
Rank 4 received:
1 7 3 7
3 0 5 2
6 6 0 2
2 8 3 6
0 0 640473088 22028
Rank 5 received:
2 1 9 3
0 2 6 7
6 8 0 2
2 3 0 0
640467440 22028 -487235792 32764
Rank 0 sending:
7 4 5 5
8 7 4 1
1 7 8 3
7 1 8 8
3 3 999 4
Rank 1 sending:
6 1 7 6
8 999 999 5
2 7 5 5
2 4 5 1
999 3 4 5
Rank 2 sending:
8 9 8 7
999 8 1 7
6 6 7 1
3 999 3 3
9 2 1 9
Rank 3 sending:
999 1 999 2
9 3 999 1
6 7 8 999
999 2 3 4
999 999 3 4
Rank 5 sending:
2 1 9 3
999 2 6 7
6 8 999 2
2 3 999 999
640467440 22028 -487235792 32764
Rank 4 sending:
1 7 3 7
3 999 5 2
6 6 999 2
2 8 3 6
999 999 640473088 22028
Root received:
7 4 5 5 6 1 7 6 8 9
8 7 4 1 8 999 999 5 999 8
1 7 8 3 2 7 5 5 6 6
7 1 8 8 2 4 5 1 3 999
3 3 999 4 999 3 4 5 9 2
1 9 7 5 8 2 0 7 9 7
999 1 999 2 1 7 3 7 2 1
9 3 999 1 3 999 5 2 999 2
6 7 8 999 6 6 999 2 6 8
999 2 3 4 2 8 3 6 2 3
RUN FINISHED; exit value 0; real time: 200ms; user: 210ms; system: 210ms
I just reformatted the code and the results for better visualization. Thanks
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
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.
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.
How should I call a Fortran function?
I am trying to call DLANSY but it erroneously returns 0. See the code and the program output below.
SUBROUTINE COND(TYP,N,A,LDA,IPIV,WORK,LWORK,IWORK,INFO,RCOND)
INTEGER TYP, N, LDA, IPIV(*), IWORK(*), INFO, LWORK
DOUBLE PRECISION A(LDA,*), ANORM, RCOND, WORK(*)
CHARACTER*1 UPLO
EXTERNAL DLANSY, DSYTRF, DSYCON
IF (TYP .EQ. 0) THEN
UPLO = 'L'
ELSE
UPLO = 'U'
ENDIF
DO I = 1, N
DO J = 1,N
WRITE(*,*) I,J,A(I,J)
END DO
END DO
WRITE(*,*) 'TYPE ',UPLO
WRITE(*,*) 'N ',N
WRITE(*,*) 'LDA ',LDA
ANORM = DLANSY('1', UPLO, N, A, LDA, WORK)
C ANORM = 10;
WRITE(*,*) 'ANORM ',ANORM
END
And what it prints:
1 1 1.0000000000000000
1 2 2.0000000000000000
1 3 3.0000000000000000
1 4 4.0000000000000000
2 1 1.0000000000000000
2 2 2.0000000000000000
2 3 3.0000000000000000
2 4 4.0000000000000000
3 1 1.0000000000000000
3 2 2.0000000000000000
3 3 3.0000000000000000
3 4 4.0000000000000000
4 1 1.0000000000000000
4 2 2.0000000000000000
4 3 3.0000000000000000
4 4 4.0000000000000000
TYPE L
N 4
LDA 4
ANORM 0.0000000000000000
In the input arrays are of proper size.
What is going on?
You need to tell the compiler that DLANSY returns a double precision value, rather than real, which is what you get currently via the implicit typing rules. E.g. with a line like
double precision, external :: dlansy
Or, if for some strange reason one is limited to some ancient compiler that does not support F90:
DOUBLE PRECISION DLANSY
EXTERNAL DLANSY