First of all, Happy New Year 2022.
I am new in learning OMP Parallel programming in Fortran.
Need HELP with my codes below, which produces a correct result if run in serial,
but produces a random (incorrect) result if run in parallel (multi-threads).
Purpose is to swap the values of some array elements in global shared array A(N:N).
Cannot figure out or identify what is wrong in my code below
(i.e. any race conditions in updating elements of Array A ?)
SUBROUTINE SWAP_COLUMNS (IS)
INTEGER :: IS, L, LH, KK
INTEGER :: I, J
L = (IS - 1) / 2
LH = L + 1
!$OMP PARALLEL DEFAULT(PRIVATE) SHARED(A,IS,L,LH)
!$OMP DO
DO J = 1, L
DO I = 1, IS
KK = I + IS
IF (I == LH) THEN
CALL SWAP_VALUES (I, J+1, KK, J+1)
ELSE
CALL SWAP_VALUES (I, J, KK, J)
END IF
END DO
END DO
!$OMP END DO
!$OMP END PARALEL
SUBROUTINE SWAP_VALUES (I3, K1, I4, K2)
INTEGER :: IT, I3,K1, I4,K2
IT = A(I3, K1)
A(I3, K1) = A(I4,K2)
A(I4, K2) = IT
END SUBROUTINE
Example :
Array A (6,6) :
8 1 6 ….
3 5 7 ….
4 9 2 …
35 28 33 …
30 32 34 …
31 36 29 …
I would expect that the result would always be correct (as run with single thread)
with IS = 3 , the correct expected result :
35 1 6 ….
3 32 7 ….
31 9 2 …..
8 28 33 ….
30 5 34 ….
4 36 29 ...
I tried a manual calculation :
IS = 3
Iteration 1 : J = 1, I = 1, KK = 4
CALL SWAP_VALUES (1, 1, 4, 1) ----> Swap A(1,1) & A(4,1)
Iteration 2 : J = 1, I = 2, KK = 5
CALL SWAP_VALUES (2, 2, 5, 2) -----> Swap A(2,2) & A(5,2)
Last Iteration 3 : J =1, I = 3, KK = 6
CALL SWAP_VALUES( 3,1, 6,1) -----> A(3,1) & A(6,1)
I would expect that even run in parallel (multi threads), as each element of array A
is accessed or updated independently (not dependent on the loop iteration
(before or after), there should be no issue of race condition, and the local variable IT
is a private variable in subroutine SWAP_VALUES.
But instead, I get a random result, sometimes correct and sometimes incorrect,
and sometimes the element value does not swap, or sometimes it is copied but
not swapped so the value becomes duplicated ( e.g. A(1,1) = 35 and A(4,1) = 35
instead of 8)
Related
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.
For a given 3x3 matrix, for example:
A = [3 1 -4 ; 2 5 6 ; 1 4 8]
If I need the minor matrix for entry (1,2)
Minor = [2 6 ; 1 8]
I already wrote a program to read in the matrix from a text file, and I am supposed to write a subroutine to extract the minor matrix from the main matrix A based on the user inputs for i,j. I am very new to Fortran and have no clue how to do that. I made some very desperate attempts but I am sure there is a cleaner way to do that.
I got so desperate I wrote 9 if functions for each possible combination of i and j but that clearly is not a smart way for doing this. Any help is appreciated!
One way to do this is, as #HighPerformanceMark said in the comment, with vector subscripts. You can declare an array with the rows you want to keep, and the same for columns, and pass them as indices to your matrix. Like this:
function minor(matrix, i, j)
integer, intent(in) :: matrix(:,:), i, j
integer :: minor(size(matrix, 1) - 1, size(matrix, 2) - 1)
integer :: rows(size(matrix, 1) - 1), cols(size(matrix, 2) - 1), k
rows = [(k, k = 1, i - 1), (k, k = i + 1, size(rows))]
cols = [(k, k = 1, j - 1), (k, k = j + 1, size(cols))]
minor = matrix(rows, cols)
end
(I didn't test it yet, so tell me if there is any error)
Another option would be constructing a new matrix from 4 assignments, one for each quadrant of the result (limited by the excluded row/column).
I like the first option more because it is more scalable. You could easily extend the function to remove multiple rows/columns by passing arrays as arguments, or adapt it to work on higher dimensions.
You can use an ac-implied-do and RESHAPE to construct a mask of the parts of the matrix you want to preserve and then zap the rest with pack and reassemble with RESHAPE.
program minor
implicit none
integer A(3,3)
integer, allocatable :: B(:,:)
character(20) fmt
integer i, j
A = reshape([ &
3, 1, -4, &
2, 5, 6, &
1, 4, 8], &
shape(A), order = [2,1])
write(fmt,'(*(g0))') '(a/',size(A,2),'(i3))'
write(*,fmt) 'A =',transpose(A)
B = reshape(pack(A,reshape([((all([i,j]/=[1,2]),i=1,size(A,1)), &
j=1,size(A,2))],shape(A))),shape(A)-1)
write(fmt,'(*(g0))') '(a/',size(B,2),'(i3))'
write(*,fmt) 'B =',transpose(B)
end program minor
Output:
A =
3 1 -4
2 5 6
1 4 8
B =
2 6
1 8
I have a word corpus of say 3000 words such as [hello, who, this ..].
I want to find the nth 3 word combination from this corpus.I am fine with any order as long as the algorithm gives consistent output.
What would be the time complexity of the algorithm.
I have seen this answer but was looking for something simple.
(Note that I will be using 1-based indexes and ranks throughout this answer.)
To generate all combinations of 3 elements from a list of n elements, we'd take all elements from 1 to n-2 as the first element, then for each of these we'd take all elements after the first element up to n-1 as the second element, then for each of these we'd take all elements after the second element up to n as the third element. This gives us a fixed order, and a direct relation between the rank and a specific combination.
If we take element i as the first element, there are (n-i choose 2) possibilities for the second and third element, and thus (n-i choose 2) combinations with i as the first element. If we then take element j as the second element, there are (n-j choose 1) = n-j possibilities for the third element, and thus n-j combinations with i and j as the first two elements.
Linear search in tables of binomial coefficients
With tables of these binomial coefficients, we can quickly find a specific combination, given its rank. Let's look at a simplified example with a list of 10 elements; these are the number of combinations with element i as the first element:
i
1 C(9,2) = 36
2 C(8,2) = 28
3 C(7,2) = 21
4 C(6,2) = 15
5 C(5,2) = 10
6 C(4,2) = 6
7 C(3,2) = 3
8 C(2,2) = 1
---
120 = C(10,3)
And these are the number of combinations with element j as the second element:
j
2 C(8,1) = 8
3 C(7,1) = 7
4 C(6,1) = 6
5 C(5,1) = 5
6 C(4,1) = 4
7 C(3,1) = 3
8 C(2,1) = 2
9 C(1,1) = 1
So if we're looking for the combination with e.g. rank 96, we look at the number of combinations for each choice of first element i, until we find which group of combinations the combination ranked 96 is in:
i
1 36 96 > 36 96 - 36 = 60
2 28 60 > 28 60 - 28 = 32
3 21 32 > 21 32 - 21 = 11
4 15 11 <= 15
So we know that the first element i is 4, and that within the 15 combinations with i=4, we're looking for the eleventh combination. Now we look at the number of combinations for each choice of second element j, starting after 4:
j
5 5 11 > 5 11 - 5 = 6
6 4 6 > 4 6 - 4 = 2
7 3 2 <= 3
So we know that the second element j is 7, and that the third element is the second combination with j=7, which is k=9. So the combination with rank 96 contains the elements 4, 7 and 9.
Binary search in tables of running total of binomial coefficients
Instead of creating a table of the binomial coefficients and then performing a linear search, it is of course more efficient to create a table of the running total of the binomial coefficient, and then perform a binary search on it. This will improve the time complexity from O(N) to O(logN); in the case of N=3000, the two look-ups can be done in log2(3000) = 12 steps.
So we'd store:
i
1 36
2 64
3 85
4 100
5 110
6 116
7 119
8 120
and:
j
2 8
3 15
4 21
5 26
6 30
7 33
8 35
9 36
Note that when finding j in the second table, you have to subtract the sum corresponding with i from the sums. Let's walk through the example of rank 96 and combination [4,7,9] again; we find the first value that is greater than or equal to the rank:
3 85 96 > 85
4 100 96 <= 100
So we know that i=4; we then subtract the previous sum next to i-1, to get:
96 - 85 = 11
Now we look at the table for j, but we start after j=4, and subtract the sum corresponding to 4, which is 21, from the sums. then again, we find the first value that is greater than or equal to the rank we're looking for (which is now 11):
6 30 - 21 = 9 11 > 9
7 33 - 21 = 12 11 <= 12
So we know that j=7; we subtract the previous sum corresponding to j-1, to get:
11 - 9 = 2
So we know that the second element j is 7, and that the third element is the second combination with j=7, which is k=9. So the combination with rank 96 contains the elements 4, 7 and 9.
Hard-coding the look-up tables
It is of course unnecessary to generate these look-up tables again every time we want to perform a look-up. We only need to generate them once, and then hard-code them into the rank-to-combination algorithm; this should take only 2998 * 64-bit + 2998 * 32-bit = 35kB of space, and make the algorithm incredibly fast.
Inverse algorithm
The inverse algorithm, to find the rank given a combination of elements [i,j,k] then means:
Finding the index of the elements in the list; if the list is sorted (e.g. words sorted alphabetically) this can be done with a binary search in O(logN).
Find the sum in the table for i that corresponds with i-1.
Add to that the sum in the table for j that corresponds with j-1, minus the sum that corresponds with i.
Add to that k-j.
Let's look again at the same example with the combination of elements [4,7,9]:
i=4 -> table_i[3] = 85
j=7 -> table_j[6] - table_j[4] = 30 - 21 = 9
k=9 -> k-j = 2
rank = 85 + 9 + 2 = 96
Look-up tables for N=3000
This snippet generates the look-up table with the running total of the binomial coefficients for i = 1 to 2998:
function C(n, k) { // binomial coefficient (Pascal's triangle)
if (k < 0 || k > n) return 0;
if (k > n - k) k = n - k;
if (! C.t) C.t = [[1]];
while (C.t.length <= n) {
C.t.push([1]);
var l = C.t.length - 1;
for (var i = 1; i < l / 2; i++)
C.t[l].push(C.t[l - 1][i - 1] + C.t[l - 1][i]);
if (l % 2 == 0)
C.t[l].push(2 * C.t[l - 1][(l - 2) / 2]);
}
return C.t[n][k];
}
for (var total = 0, x = 2999; x > 1; x--) {
total += C(x, 2);
document.write(total + ", ");
}
This snippet generates the look-up table with the running total of the binomial coefficients for j = 2 to 2999:
for (var total = 0, x = 2998; x > 0; x--) {
total += x;
document.write(total + ", ");
}
Code example
Here's a quick code example, unfortunately without the full hardcoded look-up tables, because of the size restriction on answers on SO. Run the snippets above and paste the results into the arrays iTable and jTable (after the leading zeros) to get the faster version with hard-coded look-up tables.
function combinationToRank(i, j, k) {
return iTable[i - 1] + jTable[j - 1] - jTable[i] + k - j;
}
function rankToCombination(rank) {
var i = binarySearch(iTable, rank, 1);
rank -= iTable[i - 1];
rank += jTable[i];
var j = binarySearch(jTable, rank, i + 1);
rank -= jTable[j - 1];
var k = j + rank;
return [i, j, k];
function binarySearch(array, value, first) {
var last = array.length - 1;
while (first < last - 1) {
var middle = Math.floor((last + first) / 2);
if (value > array[middle]) first = middle;
else last = middle;
}
return (value <= array[first]) ? first : last;
}
}
var iTable = [0]; // append look-up table values here
var jTable = [0, 0]; // and here
// remove this part when using hard-coded look-up tables
function C(n,k){if(k<0||k>n)return 0;if(k>n-k)k=n-k;if(!C.t)C.t=[[1]];while(C.t.length<=n){C.t.push([1]);var l=C.t.length-1;for(var i=1;i<l/2;i++)C.t[l].push(C.t[l-1][i-1]+C.t[l-1][i]);if(l%2==0)C.t[l].push(2*C.t[l-1][(l-2)/2])}return C.t[n][k]}
for (var iTotal = 0, jTotal = 0, x = 2999; x > 1; x--) {
iTable.push(iTotal += C(x, 2));
jTable.push(jTotal += x - 1);
}
document.write(combinationToRank(500, 1500, 2500) + "<br>");
document.write(rankToCombination(1893333750) + "<br>");
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.
I have a column matrix with 40 values. Say,
1
4
5
2
4
1
9
.
.
.
2
How can I call every four values and average them until it reaches 40th? I managed to do in the following way but is there a better way? Beste!
i = 1, 4
avg1 = avg + avg(i)
i = 5,8
avg2 = avg + avg(i)
i = 9,12
avg3 = avg + avg(i)
.......
i = 37,40
avg10 = avg + avg(i)
It took me a couple of iterations to get the syntax right, but how about this?
integer, parameter, dimension(*) :: a = [ 1, 4, 5, ..., 2 ]
integer :: i
real, dimension(10) :: avg
avg = [ (sum(a(i * 4 + 1 : (i + 1) * 4)) / 4., i = 0, 9) ]
print *, avg
end
How about that?
program testing
implicit none
integer, dimension(40) :: array
real, dimension(10) :: averages
integer :: i, j, k, aux
array(:) = (/(i, i=1,40)/) ! just values 1 to 40
averages(:) = 0.0
k = 1 ! to keep track of where to store the next average
do i=1,40,4 ! iterate over the entire array in steps of 4
aux = 0 ! just a little helper variable, not really required, but neater I think
do j=i,i+3 ! iterating over 4 consecutive values
aux = aux + array(j)
end do
averages(k) = aux / 4.0
k = k + 1
end do
print *, averages
end program testing
This is the output:
2.500000 6.500000 10.50000 14.50000 18.50000
22.50000 26.50000 30.50000 34.50000 38.50000
Is this what you were looking for?