Here is my problem: I have a fortran code with a certain amount of nested loops and first I wanted to know if it's possible to optimize (rearranging) them in order to get a time gain? Second I wonder if I could use OpenMP to optimize them?
I have seen a lot of posts about nested do loops in fortran and how to optimize them but I didn't find one example that is suited to mine. I have also searched about OpenMP for nested do loops in fortran but I'm level 0 in OpenMP and it's difficult for me to know how to use it in my case.
Here are two very similar examples of loops that I have, first:
do p=1,N
do q=1,N
do ab=1,nVV
cd = 0
do c=nO+1,N
do d=c+1,N
cd = cd + 1
A(p,q,ab) = A(p,q,ab) + (B(p,q,c,d) - B(p,q,d,c))*C(cd,ab)
end do
end do
kl = 0
do k=1,nO
do l=k+1,nO
kl = kl + 1
A(p,q,ab) = A(p,q,ab) + (B(p,q,k,l) - B(p,q,l,k))*D(kl,ab)
end do
end do
end do
do ij=1,nOO
cd = 0
do c=nO+1,N
do d=c+1,N
cd = cd + 1
E(p,q,ij) = E(p,q,ij) + (B(p,q,c,d) - B(p,q,d,c))*F(cd,ij)
end do
end do
kl = 0
do k=1,nO
do l=k+1,nO
kl = kl + 1
E(p,q,ij) = E(p,q,ij) + (B(p,q,k,l) - B(p,q,l,k))*G(kl,ij)
end do
end do
end do
end do
end do
and the other one is:
do p=1,N
do q=1,N
do ab=1,nVV
cd = 0
do c=nO+1,N
do d=nO+1,N
cd = cd + 1
A(p,q,ab) = A(p,q,ab) + B(p,q,c,d)*C(cd,ab)
end do
end do
kl = 0
do k=1,nO
do l=1,nO
kl = kl + 1
A(p,q,ab) = A(p,q,ab) + B(p,q,k,l)*D(kl,ab)
end do
end do
end do
do ij=1,nOO
cd = 0
do c=nO+1,N
do d=nO+1,N
cd = cd + 1
E(p,q,ij) = E(p,q,ij) + B(p,q,c,d)*F(cd,ij)
end do
end do
kl = 0
do k=1,nO
do l=1,nO
kl = kl + 1
E(p,q,ij) = E(p,q,ij) + B(p,q,k,l)*G(kl,ij)
end do
end do
end do
end do
end do
The very small difference between the two examples is mainly in the indices of the loops. I don't know if you need more info about the different integers in the loops but you have in general: nO < nOO < N < nVV. So I don't know if it's possible to optimize these loops and/or possibly put them in a way that will facilitate the use of OpenMP (I don't know yet if I will use OpenMP, it will depend on how much I can gain by optimizing the loops without it).
I already tried to rearrange the loops in different ways without any success (no time gain) and I also tried a little bit of OpenMP but I don't know much about it, so again no success.
From the initial comments it may appear that at least in some cases you may be using more memory than the available RAM, which means you may be using the swap file, with all the bad consequences on the performances. To fix this, you have to either install more RAM if possible, or deeply reorganize your code to not store the full B array (by far the largest one) at once (again, if possible).
Now, let's assume that you have enough RAM. As I wrote in the comments, the access pattern on the B array is far from optimal, as the inner loops correspond to the last indeces of B, which can result in many cache misses (all the more given the the size of B). Changing the loop order if possible is a way to go.
Just looking at your first example, I am focusing on the computation of the array A (the computation of the array E looks completely independent of A, so it can be processed separately):
!! test it at first without OpenMP
!!$OMP PARALLEL DO PRIVATE(cd,c,d,kl,k,l)
do ab=1,nVV
cd = 0
do c=nO+1,N
do d=c+1,N
cd = cd + 1
A(:,:,ab) = A(:,:,ab) + (B(:,:,c,d) - B(:,:,d,c))*C(cd,ab)
end do
end do
kl = 0
do k=1,nO
do l=k+1,nO
kl = kl + 1
A(:,:,ab) = A(:,:,ab) + (B(:,:,k,l) - B(:,:,l,k))*D(kl,ab)
end do
end do
end do
!!$OMP END PARALLEL DO
What I did:
moved the loops on p and q from outer to inner positions (it's not always as easy than it is here)
replaced them with array syntax (no performance gain to expect, just a code easier to read)
Now the inner loops (abstracted by the array syntax) tackle contiguous elements in memory, which is much better for the performances. The code is even ready for OpenMP multithreading on the (now) outer loop.
EDIT/Hint
Fortran stores the arrays in "column-major order", that is when incrementing the first index one accesses contiguous elements in memory. In C the arrays are stored in "row-major order", that is when incrementing the last index one accesses contiguous elements in memory. So a general rule is to have the inner loops on the first indeces (and the opposite in C).
It would be helpful if you could describe the operations you'd like to perform using tensor notation and the Einstein summation rule. I have the feeling the code could be written much more succinctly using something like np.einsum in NumPy.
For the second block of loop nests (the ones where you iterate across a square sub-section of B as opposed to a triangle) you could try to introduce some sub-programs or primitives from which the full solution is built.
Working from the bottom up, you start with a simple sum of two matrices.
!
! a_ij := a_ij + beta * b_ij
!
pure subroutine apb(A,B,beta)
real(dp), intent(inout) :: A(:,:)
real(dp), intent(in) :: B(:,:)
real(dp), intent(in) :: beta
A = A + beta*B
end subroutine
(for first code block in the original post, you would substitute this primitive with one that only updates the upper/lower triangle of the matrix)
One step higher is a tensor contraction
!
! a_ij := a_ij + b_ijkl c_kl
!
pure subroutine reduce_b(A,B,C)
real(dp), intent(inout) :: A(:,:)
real(dp), intent(in) :: B(:,:,:,:)
real(dp), intent(in) :: C(:,:)
integer :: k, l
do l = 1, size(B,4)
do k = 1, size(B,3)
call apb( A, B(:,:,k,l), C(k,l) )
end do
end do
end subroutine
Note the dimensions of C must match the last two dimensions of B. (In the original loop nest above, the storage order of C is swapped (i.e. c_lk instead of c_kl.)
Working our way upward, we have the contractions with two different sub-blocks of B, moreover A, C, and D have an additional outer dimension:
!
! A_n := A_n + B1_cd C_cdn + B2_kl D_kln
!
! The elements of A_n are a_ijn
! The elements of B1_cd are B1_ijcd
! The elements of B2_kl are B2_ijkl
!
subroutine abcd(A,B1,C,B2,D)
real(dp), intent(inout), contiguous :: A(:,:,:)
real(dp), intent(in) :: B1(:,:,:,:)
real(dp), intent(in) :: B2(:,:,:,:)
real(dp), intent(in), contiguous, target :: C(:,:), D(:,:)
real(dp), pointer :: p_C(:,:,:) => null()
real(dp), pointer :: p_D(:,:,:) => null()
integer :: k
integer :: nc, nd
nc = size(B1,3)*size(B1,4)
nd = size(B2,3)*size(B2,4)
if (nc /= size(C,1)) then
error stop "FATAL ERROR: Dimension mismatch between B1 and C"
end if
if (nd /= size(D,1)) then
error stop "FATAL ERROR: Dimension mismatch between B2 and D"
end if
! Pointer remapping of arrays C and D to rank-3
p_C(1:size(B1,3),1:size(B1,4),1:size(C,2)) => C
p_D(1:size(B2,3),1:size(B2,4),1:size(D,2)) => D
!$omp parallel do default(private) shared(A,B1,p_C,B2,p_D)
do k = 1, size(A,3)
call reduce_b( A(:,:,k), B1, p_C(:,:,k))
call reduce_b( A(:,:,k), B2, p_D(:,:,k))
end do
!$omp end parallel do
end subroutine
Finally, we reach the main level where we select the subblocks of B
program doit
use transform, only: abcd, dp
implicit none
! n0 [2,10]
!
integer, parameter :: n0 = 6
integer, parameter :: n00 = n0*n0
integer, parameter :: N, nVV
real(dp), allocatable :: A(:,:,:), B(:,:,:,:), C(:,:), D(:,:)
! N [100,200]
!
read(*,*) N
nVV = (N - n0)**2
allocate(A(N,N,nVV))
allocate(B(N,N,N,N))
allocate(C(nVV,nVV))
allocate(D(n00,nVV))
print *, "Memory occupied (MB): ", &
real(sizeof(A) + sizeof(B) + sizeof(C) + sizeof(D),dp) / 1024._dp**2
A = 0
call random_number(B)
call random_number(C)
call random_number(D)
call abcd(A=A, &
B1=B(:,:,n0+1:N,n0+1:N), &
B2=B(:,:,1:n0,1:n0), &
C=C, &
D=D)
deallocate(A,B,C,D)
end program
Similar to the answer by PierU, parallelization is on the outermost loop. On my PC, for N = 50, this re-engineered routine is about 8 times faster when executed serially. With OpenMP on 4 threads the factor is 20. For N = 100 and I got tired of waiting for the original code; the re-engineered version on 4 threads took about 3 minutes.
The full code I used for testing, configurable via environment variables (ORIG=<0|1> N=100 ./abcd), is available here: https://gist.github.com/ivan-pi/385b3ae241e517381eb5cf84f119423d
With more fine-tuning it should be possible to bring the numbers down even further. Even better performance could be sought with a specialized library like cuTENSOR (also used under the hood of Fortran intrinsics as explained in Bringing Tensor Cores to Standard Fortran or a tool like the Tensor Contraction Engine.
One last thing I found odd was that large parts of B are un-unused. The sub sections B(:,:,1:n0,n0+1:N) and B(:,:,n0+1:N,1:n0) appear to be wasted space.
I'm totally new to Fortran, and I'm trying to learn the language here:
http://www.fortrantutorial.com/files-precision/index.php. I have some basic experience with C and Python, but not much, like introduction class and such.
So in exercises 4.1, they ask me to input some numbers from a file, and check if these numbers are even or odd. Here is the code to input the numbers:
program readdata
implicit none
!reads data from a file called mydata.txt
real :: x,y,z
open(10,file='mydata.txt')
read(10,*) x,y,z
print *,x,y,z
end program readdata
The file mydata.txt contains some random numbers. And they can check if the number is even or odd by:
if (mod(num,2)>0) then……
My question is that: if this file have like 10, or 1000 numbers, do I have to manually assign every single one of them? Is there any other way for me to do quick calculation with mass numbers situation like that?
Every read also moves the read pointer forwards. So with every new read, a new line is read in from the file.
The easiest thing to do is to keep reading until the READ statement returns an error. Of course, you have to pass a variable for the READ to write its error into. Something like this:
program readdata
implicit none
real :: x, y, z
integer :: iounit, ios
open(newunit=iounit, file='mydata.txt', iostat=ios, action='READ')
if (ios /= 0) STOP 1
do
read(iounit, *, iostat=ios) x, y, z
if (ios /= 0) exit
print *, x, y, z
end do
close(iounit)
end program readdata
Update: If you're limited to Fortran 95, as OP suggested in his comments, here's what to change: Instead of
integer :: iounit, ios
open(newunit=iounit, ...)
you use
integer :: ios
integer, paramter :: iounit = 100
open(unit=iounit, ...)
All that's important is that iounit is a number, greater than 10, which is not used as a unit for any other read/write operation.
well a mass of numbers means that X, Y, and Z need to be more than a single number of each... so something like this should get you vectored towards a solution:
program readdata
implicit none
!reads data from a file called mydata.txt
INTEGER, PARAMETER :: max2process = 10000
INTEGER :: I
INTEGER :: K = 0
real , DIMENSION(max2process) :: x,y,z
LOGICAL, DIMENSION(max2process) :: ODD = .FALSE.
open(10,file='mydata.txt')
10 CONTINUE
X(:) = 0
Y(:) = 0
K(:) = 0
DO I = 1, max2process
K = K + I
read(10,*, EOF=99) x(I), y(I), z(I)
print *,x(I), y(I), z(I)
ENDDO
WRITE(*,22) I, MINVAL(X(1:I)), MAXVAL(X(1:I)
22 FORMAT(' MIN(X(1:',I5,')=',0PE12.5,' Max=',0PE12.5)
odd = .FALSE.
WHERE (MODULO(X, 2) /= 0)
ODD = .TRUE.
ENDWHERE
DO I = 1, 10
WRITE(*,88) I, X(I), odd(I)
88 FORMAT('x(', I2,')=',0PE12.5,' odd="',L1,'"')
EBDDO
WRITE(*,*) ' we did not hit the end of file... Go back and read some more'
GOTO 10
99 WRITE(*,*) 'END of file reached at ', (K-1)
end program readdata
Basically something like that, but I probably have a typo (LTR). If MODULO is ELEMENTAL then you can do it easily... And MODULO is ELEMENTAL, so you are in luck (which is common).
There is a https://rosettacode.org/wiki.Even_or_Odd#Fortran that looks nice. the functions could be further enhanced using ELEMENTAL FUNCTION.
that should give you enough to work it out.
or you could read the file to find the size, close and reopen it, and then allocate X, Y, Z and Odd... the example i gave was more of a streaming example. one should generally use a DO WHILE rather than a GOTO, but starting out a GOTO can be conceptually easier. (You need an EXIT or some DO WHILE (IOSTAT /= ) in order to break out)
I want to run m*n matrix to do QR decomposition in fortran
PROGRAM SUBDEM
INTEGER key, n, m, loopA
REAL resq
REAL A(3,2)
REAL B(3)
REAL X(2)
key = 0
n = 2
m = 3
resq = 0
CALL QR(m, n, A, B, X, resq)
END
The QR routine is:
subroutine QR(m, n, a, b, x, resq)
implicit double precision (a-h, o-z)
dimension a(m,n),b(m),x(n)
double precision sum, dot
resq=-2.0
if (m .lt. n) then
return
endif
resq=-1.0
! Loop ending on 1800 rotates a into upper triangular form.
do 1800 j=1, n
! Find constants for rotation and diagonal entry.
sq=0.0
do 1100 i=j, m
sq=a(i,j)**2 + sq
1100 continue
if (sq .eq. 0.0) then
return
endif
qv1=-sign(sqrt(sq), a(j,j))
u1=a(j,j) - qv1
a(j,j)=qv1
j1=j + 1
! Rotate remaining columns of sub-matrix.
do 1400 jj=j1, n
dot=u1*a(j,jj)
do 1200 i=j1, m
dot=a(i,jj)*a(i,j) + dot
1200 continue
const=dot/abs(qv1*u1)
do 1300 i=j1, m
a(i,jj)=a(i,jj) - const*a(i,j)
1300 continue
a(j,jj)=a(j,jj) - const*u1
1400 continue
! Rotate b vector.
dot=u1*b(j)
do 1600 i=j1, m
dot=b(i)*a(i,j) + dot
1600 continue
const=dot/abs(qv1*u1)
b(j)=b(j) - const*u1
do 1700 i=j1, m
b(i)=b(i) - const*a(i,j)
1700 continue
1800 continue
! Solve triangular system by back-substitution.
do 2200 ii=1, n
i=n-ii+1
sum=b(i)
do 2100 j=i+1, n
sum=sum - a(i,j)*x(j)
2100 continue
if (a(i,i).eq. 0.0) then
return
endif
x(i)=sum/a(i,i)
2200 continue
! Find residual in overdetermined case.
resq=0.0
do 2300 i=n+1, m
resq=b(i)**2 + resq
2300 continue
return
end subroutine
However I am getting:
Error 1 error #6633: The type of the actual argument differs from the
type of the dummy argument. [A] Error 2 error #6633: The type of
the actual argument differs from the type of the dummy argument.
[B] Error 3 error #6633: The type of the actual argument differs
from the type of the dummy argument. [X] Error 4 error #6633: The
type of the actual argument differs from the type of the dummy
argument. [RESQ]
What Am I doing wrong?
I will sum the comments of #george and #M.S.B.
The types and kinds of dummy arguments of procedures must match the actual arguments used by the calling code. The compiler can check this when having an explicit interface, when the procedure is in a module, for example, and some compilers can do that also for external procedures, which is your case.
Placing the subroutines in modules is the preferred way for making this check possible at all conditions and all compilers.
By using implicit double precision (a-h, o-z) you declare all variables with name beginning with a-h or o-z as being double precision. In your main program you are using real for calling the procedure. This is the error, the types have to match.
It is strongly discouraged to use any other form of the implicit other than implicit none, which is the form that should be present at the beginning of every compilation unit (program, module, external procedures).
As title says, I don't understand why f^:proposition^:_ y is a while loop. I have actually used it a couple times, but I don't understand how it works. I get that ^: repeats functions, but I'm confused by its double use in that statement.
I also can't understand why f^:proposition^:a: y works. This is the same as the previous one but returns the values from all the iterations, instead of only the last one as did the one above.
a: is an empty box and I get that has a special meaning used with ^: but even after having looked into the dictionary I couldn't understand it.
Thanks.
Excerpted and adapted from a longer writeup I posted to the J forums in 2009:
while =: ^:break_clause^:_
Here's an adverb you can apply to any code (which would equivalent of the
loop body) to create a while loop. In case you haven't seen it before, ^: is the power conjunction. More specifically, the phrase f^:n y applies the function f to the argument y exactly n times. The count n maybe be an integer or a function which applied to y produces an integer¹.
In the adverb above, we see the power conjunction twice, once in ^:break_clause and again in ^:_ . Let's first discuss the latter. That _ is J's notation for infinity. So, read literally, ^:_ is "apply the function an infinite number of times" or "keep reapplying forever". This is related to a while-loop's function, but it's not very useful if applied literally.
So, instead, ^:_ and its kin were defined to mean "apply a function to its limit", that is, "keep applying the function until its output matches its input". In that case, applying the function again would have no effect, because the next iteration would have the same input as the previous (remember that J is a functional language). So there's
no point in applying the function even once more: it has reached its limit.
For example:
cos=: 2&o. NB. Cosine function
pi =: 1p1 NB. J's notation for 1*pi^1 analogous to scientific notation 1e1
cos pi
_1
cos cos cos pi
0.857553
cos^:3 pi
0.857553
cos^:10 pi
0.731404
cos^:_ pi NB. Fixed point of cosine
0.739085
Here, we keep applying cosine until the answer stops changing: cosine has reached its fixed point, and more applications are superfluous. We can visualize this by showing the
intermediate steps:
cos^:a: pi
3.1415926535897 _1 0.54030230586813 ...73 more... 0.73908513321512 0.73908513321
So ^:_ applies a function to its limit. OK, what about ^:break_condition? Again, it's the same concept: apply the function on the left the number of times specified by the function on the right. In the case of _ (or its function-equivalent, _: ) the output is "infinity", in the case of break_condition the output will be 0 or 1 depending on the input (a break condition is boolean).
So if the input is "right" (i.e. processing is done), then the break_condition will be 0, whence loop_body^:break_condition^:_ will become loop_body^:0^:_ . Obviously, loop_body^:0 applies the loop_body zero times, which has no effect.
To "have no effect" is to leave the input untouched; put another way, it copies the input to the output ... but if the input matches the output, then the function has reached its limit! Obviously ^:_: detects this fact and terminates. Voila, a while loop!
¹ Yes, including zero and negative integers, and "an integer" should be more properly read as "an arbitrary array of integers" (so the function can be applied at more than one power simultaneously).
f^:proposition^:_ is not a while loop. It's (almost) a while loop when proposition returns 1 or 0. It's some strange kind of while loop when proposition returns other results.
Let's take a simple monadic case.
f =: +: NB. Double
v =: 20 > ] NB. y less than 20
(f^:v^:_) 0 NB. steady case
0
(f^:v^:_) 1 NB. (f^:1) y, until (v y) = 0
32
(f^:v^:_) 2
32
(f^:v^:_) 5
20
(f^:v^:_) 21 NB. (f^:0) y
21
This is what's happening: every time that v y is 1, (f^:1) y is executed. The result of (f^:1) y is the new y and so on.
If y stays the same for two times in a row → output y and stop.
If v y is 0→ output y and stop.
So f^:v^:_ here, works like double while less than 20 (or until the result doesn't change)
Let's see what happens when v returns 2/0 instead of 1/0.
v =: 2 * 20 > ]
(f^:v^:_) 0 NB. steady state
0
(f^:v^:_) 1 NB. (f^:2) 1 = 4 -> (f^:2) 4 = 16 -> (f^:2) 16 = 64 [ -> (f^:0) 64 ]
64
(f^:v^:_) 2 NB. (f^:2) 2 = 8 -> (f^:2) 8 = 32 [ -> (f^:0) 32 ]
32
(f^:v^:_) 5 NB. (f^:2) 5 = 20 [ -> (f^:0) 20 ]
20
(f^:v^:_) 21 NB. [ (f^:0) 21 ]
21
You can have many kinds of "strange" loops by playing with v. (It can even return negative integers, to use the inverse of f).