I would like to have an associate that points to an array (or parts thereof) and is not one indexed.
The following program illustrates the problem:
program test_associate
implicit none(type, external)
integer, parameter :: N = 10
integer :: i, A(0 : N - 1)
A = [(i, i = lbound(A, 1), ubound(A, 1))]
write(*, *) A(0), A(9)
associate(B => A(0 : N - 1))
write(*, *) B(9) ! This writes 8 but should write 9
end associate
end program
I tried
associate(B(0 : N - 1) => A(0 : N - 1))
write(*, *) B(9)
end associate
but this is invalid syntax. (at least in my compiler which is gfortran 9.3)
The syntax
associate (B(0:N-1) => ...)
end associate
is not valid in Fortran: the left-hand side of the association item must be a name. With just a name (which here would be B) it isn't possible to specify properties such as bounds.
The bounds of the associating entity array (again, here B), are given by the results of using LBOUND on the right-hand side (the selector) (Fortran 2018, 11.1.3.3 p.1):
The lower bound of each dimension is the result of the intrinsic function LBOUND (16.9.109) applied to the corresponding dimension of selector
The referenced description of LBOUND explains how the bound is calculated in this case.
Because A(0:N-1) is not a whole array, LBOUND returns 1, and so the lower bound of B in this case is itself 1.
It is possible to have the lower bound of B be something other than 1: have the selector being a whole array. In
associate(B => A)
end associate
B will have lower bound that of A.
In conclusion: it's possible for an associate entity to have lower bound other than 1, but only when the thing it's associated with is a whole array. In particular, in associating with part of an array (and that can include all of the array, such as B => A(:), A(:) not being a whole array) the associating entity always has lower bounds 1.
As Vladimir F says in another answer, a pointer can have bounds controlled as part of pointer assignment.
I do not think that is possible. A(0 : N - 1) is a subarray, it is an expression, no longer the original array. The lower bound of A(0 : N - 1) is 1, not 0.
You can try
dimension A(0:9)
print *,lbound(A(0:8))
end
It will print 1.
Be aware, that your associate may case the array section to be copied and stored in a temporary array.
If you associate to => B, A will correctly write 9.
You can use pointers to point to such sections
program test_associate
implicit none(type, external)
integer, parameter :: N = 10
integer, target :: A(0 : N - 1)
integer, pointer :: B(:)
integer :: i
A = [(i, i = lbound(A, 1), ubound(A, 1))]
write(*, *) A(0), A(9)
B(0:N-1) => A(0:N-1)
write(*, *) B(9) ! This writes 9
end program
Related
Im trying to print prime numbers till 10000. (display the first five for testing)
This is my program
program primes
implicit none
integer :: array(1229)
integer :: i, ind
logical :: is_prime
ind = 1
do i = 2, 10000, 1
if (is_prime(i) .eqv. .true.) then
array(ind) = i
ind = ind + 1
end if
end do
print *, array(1)
print *, array(2)
print *, array(3)
print *, array(4)
print *, array(5)
end program primes
function is_prime(n) result(ispr)
implicit none
integer :: c, i
integer, intent(in) :: n
logical :: ispr
c = 0
do i = 2, n
if (mod(i,2) == 0) then
c = c + 1
end if
end do
ispr = (c == 0)
end function is_prime
I don't know why but this is the output
9175178
6417360
5374044
6750309
7536745
Why does this happen and how to correct?
is_prime should be(n is the only divider of n besides 1 <=> c == 1)
function is_prime(n) result(ispr)
implicit none
integer :: c, i
integer, intent(in) :: n
logical :: ispr
c = 0
do i = 2, n
if (mod(n,i) == 0) then
c = c + 1
end if
end do
ispr = (c == 1)
end function is_prime
Could be optimezed by leaving the loop when c == 1 and i < n(after adding 1 to c)...
See on online fortran compiler
version with exit loop
While I am not familiar with modern Fortran, it looks to me as if function is_prime(n) result(ispr) is not working.
In the do loop in that function, you want a loop that tests thus:
is n divisible by 2?
is n divisible by 3?
is n divisible by 4?
is n divisible by 5?
and so on.
But, what it is actually doing is asking these:
is 2 divisible by 2?
is 3 divisible by 2?
is 4 divisible by 2?
is 5 divisible by 2?
and so on.
As a result, your counter will always have a non-zero value, and your function will always return false.
But, that's not the only problem. From your results, it looks like your Fortran implementation does not automatically initialize variables. Suppose I have statements like the following:
integer :: b
print *,b
What will be the result?
Remember, the names of variables represent locations in the computer's memory. If a variable is not initialized, it's value will be what was in the memory location before your program started to run. This value will not be related to your program.
I have 2 suggestions to fix the 2nd problem:
Prior to do i = 2, 10000, 1, have another loop that sets each value in array.
Set a values of each array (i) inside your do i = 2, 10000, 1 loop. One way to do this is to set one value when (is_prime(i) .eqv. .true.) is true and a different value when it is false.
I have the following implementation of the MergeSort algorithm in Fortran.
My question is about call merge(work(1 : half), A(half + 1:), A).
Obviously I have overlapping memory, but from looking at the code in merge, this should be no problem, as long as the input arrays are sorted. (Which they are assumed to be anyway.)
On the other hand Fortran compilers may assume non aliased memory,
so I always think "don't do this".
I have two questions now:
When and how can I run into problems with my merge subroutine.
If I cannot implement MergeSort like this, how do I do it without creating a temporary array.
!> Merge sorted arrays A and B into C while preversing order.
subroutine merge(A, B, C)
implicit none
integer, intent(in) :: A(:), B(:)
integer, intent(inout) :: C(:)
integer :: i, j, k
if (size(A) + size(B) > size(C)) abort
i = 1; j = 1
do k = 1, size(C)
if (i <= size(A) .and. j <= size(B)) then
if (A(i) <= B(j)) then
C(k) = A(i)
i = i + 1
else
C(k) = B(j)
j = j + 1
end if
else if (i <= size(A)) then
C(k) = A(i)
i = i + 1
else if (j <= size(B)) then
C(k) = B(j)
j = j + 1
end if
end do
end subroutine merge
recursive subroutine MergeSort(A, work)
implicit none
integer, intent(inout) :: A(:)
integer, intent(inout) :: work(:)
integer :: half
half = (size(A) + 1) / 2
if (size(A) < 2) then
continue
else if (size(A) == 2) then
call naive_sort(A)
else
call MergeSort(A( : half), work)
call MergeSort(A(half + 1 :), work)
if (A(half) > A(half + 1)) then
work(1 : half) = A(1 : half)
! TODO: Non aliasing rule.
call merge(work(1 : half), A(half + 1:), A)
endif
end if
end subroutine MergeSort
PS: As you perhaps notice, the array C in the merge subroutine is declared as an inout parameter, because it is later used with overlapping memory.
This use of aliasing in calling merge is erroneous.
With
call merge(work(1 : half), A(half + 1:), A)
the dummy argument B is associated with A(half+1:) and the dummy argument C with A which is the understood overlap.
This aliasing means that the elements of B may not be defined (which is additionally required by the intent) and that the last few elements of C may not be defined.
However, if we look at the main loop in merge we see that in general every element of C appears in a statement looking like C(k)=...: we expect at least one of those conditions inside to be true. This is therefore invalid.
To be clear: a statement like C(k)=B(j) would be an illegal definition even if the value of C(k) doesn't change as a result.
Fortunately, perhaps, there is an easy way to create a temporary array to avoid aliasing: give the dummy argument B the value attribute. You could even do the same to A and remove the workspace array.
Here's my factorial function in Fortran.
module facmod
implicit none
contains
function factorial (n) result (fac)
use FMZM
integer, intent(in) :: n
integer :: i
type(IM) :: fac
fac = 1
if(n==0) then
fac = 1
elseif(n==1) then
fac = 1
elseif(n==2) then
fac = 2
elseif(n < 0) then
write(*,*) 'Error in factorial N=', n
stop 1
else
do i = 1, n
fac = fac * i
enddo
endif
end function factorial
end module facmod
program main
use FMZM
use facmod, only: factorial
implicit none
type(IM) :: res
integer :: n, lenr
character (len=:), allocatable :: str
character(len=1024) :: fmat
print*,'enter the value of n'
read*, n
res = factorial(n)
lenr = log10(TO_FM(res))+2
allocate(character(len=lenr) :: str)
write (fmat, "(A5,I0)") "i", lenr
call im_form(fmat, res, str)
print*, trim( adjustl(str))
end program main
I compile using FMZM:
gfortran -std=f2008 fac.F90 fmlib.a -o fac
echo -e "1000" | .fac computes easy. However, if I give this echo -e "3600" | .fac, I already get an error on my machine:
Error in FM. More than 200000 type (FM), (ZM), (IM) numbers
have been defined. Variable SIZE_OF_START in file
FMSAVE.f95 defines this value.
Possible causes of this error and remedies:
(1) Make sure all subroutines (also functions that do not
return type FM, ZM, or IM function values) have
CALL FM_ENTER_USER_ROUTINE
at the start and
CALL FM_EXIT_USER_ROUTINE
at the end and before any other return, and all
functions returning an FM, ZM, or IM function value have
CALL FM_ENTER_USER_FUNCTION(F)
at the start and
CALL FM_EXIT_USER_FUNCTION(F)
at the end and before any other return, where the actual
function name replaces F above.
Otherwise that routine could be leaking memory, and
worse, could get wrong results because of deleting some
FM, ZM, or IM temporary variables too soon.
(2) Make sure all subroutines and functions declare any
local type FM, ZM, or IM variables as saved. Otherwise
some compilers create new instances of those variables
with each call, leaking memory.
For example:
SUBROUTINE SUB(A,B,C,X,Y,RESULT)
TYPE (FM) :: A,B,C,X,Y,RESULT,ERR,TOL,H
Here A,B,C,X,Y,RESULT are the input variables and
ERR,TOL,H are local variables. The fix is:
SUBROUTINE SUB(A,B,C,X,Y,RESULT)
TYPE (FM) :: A,B,C,X,Y,RESULT
TYPE (FM), SAVE :: ERR,TOL,H
(3) Since = assignments for multiple precision variables are
the trigger for cleaning up temporary multiple precision
variables, a loop with subroutine calls that has no =
assignments can run out of space to store temporaries.
For example:
DO J = 1, N
CALL SUB(A,B,C,TO_FM(0),TO_FM(1),RESULT)
ENDDO
Most compilers will create two temporary variables with
each call, to hold the TO_FM values.
One fix is to put an assignment into the loop:
DO J = 1, N
ZERO = TO_FM(0)
CALL SUB(A,B,C,ZERO,TO_FM(1),RESULT)
ENDDO
(4) If a routine uses allocatable type FM, ZM, or IM arrays
and allocates and deallocates with each call, then after
many calls this limit on number of variables could be
exceeded, since new FM variable index numbers are
generated for each call to the routine.
A fix for this is to call FM_DEALLOCATE before actually
deallocating each array, so those index numbers can be
re-used. For example:
DEALLOCATE(T)
becomes:
CALL FM_DEALLOCATE(T)
DEALLOCATE(T)
(5) If none of this helps, try running this program again
after increasing the value of SIZE_OF_START and
re-compiling.
What optimizations or Fortran idioms am I missing that is hurting my performance so much?
For example, in python, I can factorial numbers much larger than 3500:
>>> import math
>>> math.factorial(100000)
Or in Haskell:
Prelude> product [1..100000]
Both these compute, not exactly quickly, but without error.
How can I improve my algorithm or better use existing libraries to improve performance of large integer factorials in Fortran? Is there a more appropriate big integer library than FMZM?
Try this. Apart from minor cosmetic changes, I just followed the recommendations of the error message in your question:
added calls to FM_ENTER_USER_FUNCTION and FM_EXIT_USER_FUNCTION,
added an assignment inside the loop (without this ii = to_im(i), it still fails, but I'm not sure why, as there is already an assignment with fac = fac * i, and accordind to the doc the assignment triggers cleaning up temporaries),
renamed factorial in main program as there is already a function with this name in FMZM.
Tested with ifort and n=100000.
module fac_mod
implicit none
contains
function factorial(n) result(fac)
use FMZM
integer, intent(in) :: n
integer :: i
type(IM) :: fac
type(IM), save :: ii
call FM_ENTER_USER_FUNCTION(fac)
fac = to_im(1)
if (n < 0) then
write (*, *) "Error in factorial N=", n
stop 1
else if (n > 1) then
do i = 1, n
ii = to_im(i)
fac = fac * ii
end do
end if
call FM_EXIT_USER_FUNCTION(fac)
end function factorial
end module fac_mod
program main
use FMZM
use fac_mod, only: f=>factorial
implicit none
type(IM) :: res
integer :: n, lenr
character(:), allocatable :: str
character(1024) :: fmat
print *, "enter the value of n"
read *, n
res = f(n)
lenr = 2 + log10(TO_FM(res))
allocate (character(lenr) :: str)
write (fmat, "(A5,I0)") "i", lenr
call im_form(fmat, res, str)
print *, trim(adjustl(str))
end program main
This is my code:
Program Dynamic_Array
Use Variables
Use Allocation_Module
Use Dealloaction_Module
Implicit none
Call Subroutine_0
Call Subroutine_1
End Program Dynamic_Array
Module Variables
Implicit none
Integer :: i , k
Integer , parameter :: Br_sn_cvo = 10
Integer , parameter :: Br_nn_mre = 7
Integer , parameter , dimension ( Br_nn_mre) :: Br_nn_cvo = [ 7 , 6 , 5 , 4 , 3 , 2 , 1 ]
Integer , dimension ( Br_nn_mre ) :: i_nn_dm_1 , i_nn_dm_2
type :: my_type
integer, allocatable :: my_size(:)
end type my_type
type(my_type), allocatable :: dS_sn(:)
End Module Variables
Module Allocation_Module
Use Variables
Implicit none
Contains
Subroutine Subroutine_0
Allocate(dS_sn(Br_nn_mre))
Loop_1: Do k = 1, Br_nn_mre
i_nn_dm_1(k) = Br_sn_cvo + Br_nn_mre + 1 + Br_nn_cvo(k) * ( k - 1 )
i_nn_dm_2(k) = Br_sn_cvo + Br_nn_mre + k * Br_nn_cvo(k)
Allocate( dS_sn(k)%my_size( i_nn_dm_1(k) : i_nn_dm_2(k)) )
Loop_2: Do i = i_nn_dm_1(k) , i_nn_dm_2(k)
dS_sn(k)%my_size(i) = i + k
End Do Loop_2
End do loop_1
End subroutine Subroutine_0
End Module Allocation_Module
Module Dealloaction_Module
Use Variables
Implicit none
Contains
Subroutine Subroutine_1
Do k = 1 , Br_nn_mre
Deallocate(dS_sn(k)%my_size)
End do
Deallocate(dS_sn)
Return
End Subroutine Subroutine_1
End Module Dealloaction_Module
I am not experienced programer in Fortran so I need to ask a few questions about process of memory allocation and deallocation for a dynamic arrays. Is there any problem with memory leak in this code?
Is this correct way for a memory allocation in separate module?
Is this correct way for a memory deallocation in separate module?
Here is an example...
...
IF(ALLOCATED(TheArray)) THEN
IF(SIZE(TheArray) /= The_Size_I_need) DEALLOCATE(TheArray)
ENDIF
IF(.NOT. ALLOCATED(TheArray)) ALLOCATE(TheArray(The_Size_I_need))
This is useful if the array gets used repeatedly for different processing sizes.
If it is "always" fixed in terms of the current execution, then there is no real need to do anything.
There is no memory leak in the code. It is impossible to make a memory leak with allocatable entities in Fortran. Only pointer can cause a memory leak.
With allocatable if something is going out of scope, it is deallocated automatically.
Your main array is a module variable so it is never going out of scope (it is save implicitly by Fortran 2008 rules). So if you don't deallocate it yourself, it will remain allocated and then deleted by the operating system on the program termination. But that is not normally considered to be a memory leak. It is not really harmful, because there is no way to make some forgotten copies of the array in memory.
The individual components my_size could go out of scope, when deallocating the large array dS_sn. In that case they are deallocated automatically by Fortran rules. You don't have to deallocate them one by one.
So you do not really have to do
Do k = 1 , Br_nn_mre
Deallocate(dS_sn(k)%my_size)
End do
Doing just
Deallocate(dS_sn)
is perfectly correct.
I am making a program that converts a decimal integer into its binary representation. Here is my code:
program test
implicit none
integer, dimension(:), allocatable :: binary
integer :: decimalnum, i, initvalue
print*, "Enter decimal number to convert: "
read*,initvalue
decimalnum = initvalue
i = 0
do while (decimalnum > 0)
if (MOD(decimalnum,2)==0) then
binary(i) = 0 ! this is as far as the program executes up to
decimalnum = decimalnum / 2
i = i + 1
else if (MOD(decimalnum,2)==1) then
binary(i) = 1
decimalnum = (decimalnum -1) / 2
i = i + 1
end if
end do
end program test
At the marked point, it returns the error Segmentation fault and exits with code 139.
Why does this happen?
Thanks in advance.
Here's a simple way to convert an integer i to its binary representation:
write(*,'(b16)') i
As written, this won't write any leading 0s. If you want the leading 0s, try
write(*,'(b16.16)') i
Of course, the preceding code writes the binary representation to the default output unit but using Fortran's internal write capabilities I could just as easily write the bits to a character variable. For example:
character(len=16) :: bits
...
write(bits,'(b16.16)') i
writes the binary digits of i into the character variable bits.
Now, if what you really want is to create an array of integers each representing one bit of the binary representation, then something like this
integer, dimension(16) :: bitarray
...
bitarray = 0
...
do ix = 1,len(bits)
if (bits(ix:ix)=='1') bitarray(ix) = 1
end do
would probably work.
1) Your crash occurs because you had allocated only 1 element for the array binary(:), and the While loop presumably had moved on to i = 2, at which point your array is index out of bounds (crash).
2) Fortran has a number of intrinsic functions that deal with bits directly. For example,
a) Bit_Size(var) returns the number of bits in "var", so if you must use an allocatable, now you know the array size required in advance.
b) BTest(iVar, pos) returns .True. if the bit at pos in iVar is 1
For example, using the other declarations above,:
Integer :: n
n = Bit_Size(decimalnum)
If( Allocated(Binary) ) DeAllocate(Binary) ! good practice
Allocate( Binary(1:n) ) ! in general, should get IOStat, just in case
Binary(:) = 0
ForAll(i=1:n, Mask = BTest( decimalnum, i-1 ) ) ! remember, bit intrinsics index from 0
Binary(i) = 1
End ForAll
... this is a little more efficient compared to Do and While, and may help (a little) towards smp. The Where/EndWhere construct can be used also, but I find ForAll's a little more efficient.
c) IBits(var, pos, len) extracts the bits from var starting at pos for len number of bits, for example if you wanted to create an "explicit" binary representation, that might be one way to go.
etc etc
3) If you "really mean" convert DecimalNum to Bin, then you have (substantial) additional problems, if Dec also includes floating point Dec (i.e. Reals), since the bit representation of Reals is in terms of exponents. I will assume that is not the case, as the code/explanation for that is much much more involved.
Finally, in Fortran, Nums are usually "signed" Nums and the leading bit is used to determine +ve (0) or -ve (1). So if you were going in the "other" direction (Bin2Dec), then would prefer an additional arg (perhaps optional) that controls whether the result is signed or unsigned. If unsigned, then the output var will need to be "bigger" compared to the input var (e.g. if converting unsigned 1-byt int to Fortran int, then must use at least 2-byte int (i.e. input Integer(1) must be output to an Integer(2)) etc.
As per the comments, you need to have executed an allocate statement (or something which does an allocation for you under the covers) before you can define the binary array. The simplest form of allocation statement would look something like ALLOCATE(binary(10)), which would given the binary array 10 elements, using the default (it can be changed for that array using the allocate statement) starting array index of 1.
Where the size of the allocation is not easily known before working with an array there are two basic approaches:
Do two passes, the first pass of which simply counts how many elements are required, then the array is allocated, then the second pass actually does the assignment to the relevant elements.
Allocate the array to an initial size (which may be zero), the progressively grow the array as required.
There are trade-offs associated with the decision around the approach to use associated with the relative overheads of things like allocation and the evaluation of each test when counting.
In Fortran 90 (time to move on to at least Fortran 95!), growing an allocatable array is somewhat convoluted (allocate a temporary, copy data from original to temporary, deallocate original, allocate original to new size, copy data from temporary back to resized original, deallocate temporary). In Fortran 2003 this operation becomes trivial.
so this is probably awful form, and certainly bad runtime (it copies the array for every single bit), but here's what I came up with. It seems to work.
program test
implicit none
integer, dimension(:), allocatable :: binary
integer :: decimalnum, i, initvalue, curSize, curBit
print*, "Enter decimal number to convert: "
read*,initvalue
decimalnum = initvalue
i = 1
ALLOCATE ( binary(1) )
curSize = 1
DO WHILE (decimalnum > 0)
IF (i > curSize ) THEN
curSize = curSize * 2
CALL expandArray( curSize, i-1 )
END IF
IF (MOD(decimalnum,2)==0) then
binary(i) = 0 ! this is as far as the program executes up to
decimalnum = decimalnum / 2
i = i + 1
ELSE IF (MOD(decimalnum,2)==1) then
binary(i) = 1
decimalnum = (decimalnum -1) / 2
i = i + 1
END IF
end do
PRINT*, binary
CONTAINS
SUBROUTINE expandArray( newSize, oldSize )
IMPLICIT NONE
INTEGER, DIMENSION(:), ALLOCATABLE :: temp
INTEGER :: j, newSize, oldSize
ALLOCATE( temp(newSize) )
DO j=1,oldSize
temp(j) = binary(j)
END DO
DEALLOCATE (binary)
ALLOCATE( binary(newSize) )
DO j=1,oldSize
binary(j) = temp(j)
END DO
DO j=oldSize+1,newSize
binary(j) = 0
END DO
DEALLOCATE (temp)
END SUBROUTINE
END PROGRAM test