Read array of unknown size from keyboard - memory-management

I want to insert an unknown number of values in an array (no matter the order).
I could first read how many values are to be inserted, then allocate the allocatable array, and finally read its values, as in the following code
PROGRAM try
IMPLICIT NONE
INTEGER :: N
REAL, DIMENSION(:), ALLOCATABLE :: x
WRITE (*,*) "how many values?"
READ (*,*) N
ALLOCATE(x(N))
WRITE (*,*) "insert the values"
READ (*,*) x
END PROGRAM
What if I want to insert the values without declaring how many before allocating the array?
I think I should use a DO WHILE cycle to insert the values in ascending order, till a descending value is insert, thus indicating the sequence is ended. I think a part of the code would be the following,
index = 1
WRITE(*,*) x
READ(*,*) x(index)
exit = .FALSE.
DO WHILE (exit.EQV..FALSE.)
index = index + 1
READ(*,*) x(index)
IF (x(index)>x(index-1)) THEN
exit = .TRUE.
index = index - 1
END IF
END DO
How to declare the array x?

I tried with the following solution, building on the concept "a lot of memory allocation and reallocation" expressed by #High Performance Mark.
PROGRAM COEFFS
USE COMPACT
IMPLICIT NONE
REAL, DIMENSION(:), ALLOCATABLE :: x,x2
INTEGER :: nL,nR,nT,index,oL,oR
LOGICAL :: exit
WRITE(*,*) "Input an increasing sequence of reals (end the sequence &
& with the first decreasing element, which will be discarded):"
index = 1
ALLOCATE(x(index))
READ(*,*) x(index)
ALLOCATE(x2(index))
x2 = x
DEALLOCATE(x)
exit = .FALSE.
DO WHILE (exit.EQV..FALSE.)
index = index + 1
ALLOCATE(x(index))
x(1:index-1) = x2
READ(*,*) x(index)
DEALLOCATE(x2)
ALLOCATE(x2(index))
x2 = x
DEALLOCATE(x)
IF (x2(index)<x2(index-1)) THEN
exit = .TRUE.
index = index - 1
ALLOCATE(x(index))
x = x2(1:index)
END IF
END DO
DEALLOCATE(x2)
WRITE(*,*) "x = ", x
END PROGRAM
With the array being input by keyboard, I don't think allocation/reallocation is a problem, since it happens at a much higher speed than that of my fingers typing the values, doesn't it?
Still I think the code could be made better. For instance, using two arrays is the only way to take advantage of allocation/reallocation?

Related

How to remove several columns from a matrix

Integer :: NBE,ierr,RN,i,j
Real(kind=8), allocatable :: AA1(:,:),AA2(:,:)
NBE=40
RN=3*NBE-2
Allocate(AA1(3*NBE,3*NBE),AA2(3*NBE,RN),stat=ierr)
If (ierr .ne. 0) Then
print *, 'allocate steps failed 1'
pause
End If
Do i=1,3*NBE
Do j=1,3*NBE
AA1(i,j)=1
End Do
End Do
I want to remove columns 97 and 113 from the matrix AA1 and then this matrix becomes AA2. I just want to know if any command of Fortran can realize this operation?
Alexander Vogt's answer gives the concept of using a vector subscript to select the elements of the array for inclusion. That answer constructs the vector subscript array using
[(i,i=1,96),(i=98,112),(i=114,3*NBE)]
Some may consider
AA2 = AA1(:,[(i,i=1,96),(i=98,112),(i=114,3*NBE)])
to be less than clear in reading. One could use a "temporary" index vector
integer selected_columns(RN)
selected_columns = [(i,i=1,96),(i=98,112),(i=114,3*NBE)]
AA2 = AA1(:,selected_columns)
but that doesn't address the array constructor being not nice, especially in more complicated cases. Instead, we can create a mask and use our common techniques:
logical column_wanted(3*NBE)
integer, allocatable :: selected_columns(:)
! Create a mask of whether a column is wanted
column_wanted = .TRUE.
column_wanted([97,113]) = .FALSE.
! Create a list of indexes of wanted columns
selected_columns = PACK([(i,i=1,3*NBE)],column_wanted)
AA2 = AA1(:,selected_columns)
Here's a simple one liner:
AA2 = AA1(:,[(i,i=1,96),(i=98,112),(i=114,3*NBE)])
Explanation:
(Inner part) Construct a temporary array for the indices [1,...,96,98,...,112,114,...,3*NBE]
(Outer part) Copy the matrix and only consider the columns in the index array
OK, I yield to #IanBush... Even simpler would be to do three dedicated assignments:
AA2(:,1:96) = AA1(:,1:96)
AA2(:,97:111) = AA1(:,98:112)
AA2(:,112:) = AA1(:,114:)
I don't have a fortran compiler here at home, so I cant test it. But I'd do something line this:
i = 0
DO j = 1, 3*NBE
IF (j == 97 .OR. j == 113) CYCLE
i = i + 1
AA2(:, i) = AA1(:, j)
END DO
The CYCLE command means that the rest of the loop should not be executed any more and the next iteration should start. Thereby, i will not get incremented, so when j=96, then i=96, when j=98 then i=97, and when j=114 then i=112.
A few more words: Due to Fortran's memory layout, you want to cycle over the first index the fastest, and so forth. So your code would run faster if you changed it to:
Do j=1,3*NBE ! Outer loop over second index
Do i=1,3*NBE ! Inner loop over first index
AA1(i,j)=1
End Do
End Do
(Of course, such an easy initialisation can be done even easier with just AA1(:,:) = 1 of just AA1 = 1.

Calculating the convolution of a matrix with a recursive subroutine in Fortran 2003

I've never asked a question here, so please let me know if I am describing my problem enough.
I'm pretty new at Fortran and I wanted to create a recursive subroutine that would compute each square of a 3 x 3 matrix. If you are not familiar with convolution, this is a good resource: http://songho.ca/dsp/convolution/convolution2d_example.html.
I used the same values in this example to make sure I was doing it right.
The purpose of the program is to have the recursive subroutine called in the middle of two do loops (indexes both go from [0,2]). When the recusive function is called, it will find the sum of all the products of one square of the output matrix. The loops will call it 9 times to ensure that every square's value has been calculated to produce the desired output. Well, after much editing on paper, I thought that I had a pretty good idea that the subroutine would work and it seems that only the first square (0,0) was able to get its answer, -13.
I believe my problem has to do with the assignments in the subroutine. I want to continue calling the next 'temp' value to add it to the total, which will be returned to the program calling it.
Depending on the current i and j values, there might not be any multiplication needed for every turn through the recursive method, so I wanted the subroutine to find a way to continue adding temp if that was the case.
program conprac
implicit none
integer, dimension(0:2,0:2) :: mat1(0:2,0:2) = reshape((/1,4,7,2,5,8,3,6,9/),(/3,3/))
integer, dimension(0:2,0:2) :: totals(0:2,0:2) = 0
integer, dimension(2,2) :: kernal(0:2,0:2) = reshape((/1,0,-1,2,0,-2,1,0,-1/),(/3,3/))
integer :: i=0, j=0, this_total=0, total=0, m=0, n=0, k=0
!do m = 0,0
!do n = 0,1
total = 0
call calc(kernal, mat1, i, j, m, n, this_total, total)
totals(m,n) = total
!end do
!end do
write(*,*) "totals(0,0): ", totals(0,0) !-13
!write(*,*) "totals(0,1): ", totals(0,1) !-20
end program conprac
recursive subroutine calc(kernal, mat, i, j, addToi, addToj, this_total, total)
implicit none
!declare calling parameter types and definitions
!to calculate with
integer, intent(in), dimension(0:2,0:2) :: kernal, mat
integer, intent(in) :: addToi, addToj
integer, intent(out) :: i, j, this_total
!to calculate
integer, intent(out) :: total
!temp variable
integer :: temp
if (i <= 2) then
if (j > 2) then
i = i + 1
j = 0
end if
if ((i + addToi) - 1 < 0 .or. (j + addToj) - 1 < 0 .or. (i + addToi) - 1 > 2 .or. (j + addToj) - 1 > 2) then
j = j+1
call calc(kernal, mat, i, j, addToi, addToj, this_total, temp)
total = total + temp
write(*,*) "total1: ", total
else
this_total = kernal(i,j) * mat((i + addToi) - 1, (j + addToj) - 1)
j = j+1
call calc(kernal, mat, i, j, addToi, addToj, this_total, temp)
total = this_total + temp
write(*,*) "total2: ", total
end if
end if
end subroutine calc
As of right now, the do loops are commented out so I can test one value at a time up where m, n are initialized.
The parameters for the subroutine are: kernal and mat being the 2 matricies, i and j both starting at 0 when the subroutine is called, m and n values being what is added to i and j respectively to make sure that the kernal is shifted and not calculating in the same spot for all 9 squares. this_total is a holder for the product of an overlapping square to be added to the returning value total, and total is the value returned and will be sent to the totals array in the program. For the first one, it would be at index (m,n), or (0,0).
These are the outputs for the first square in totals:
m=0,n=0

How to find the dimension of a matrix?

I have a matrix that contains both character and reals and I want a program that reads this matrix (finds the dimensions by itself). Here is my code:
! A fortran95 program for G95
Program Project2nd
implicit none
character(len=40), allocatable :: a(:,:)
integer i,j,k,n,m,l,st
character(len=40) d
n=0; m=1; j=1;
open(10,file=&
'/Users/dariakowsari/Documents/Physics/Programming/Fortran95-Projects/Project2nd/input.txt', &
IOstat=st)
do while (st == 0)
read(10,*,IOstat=st) d
n=n+1
end do
st=0
do j=1,m
do while (st == 0)
allocate(a(1,m))
read(10,*,IOstat=st) (a(1,j),j=1,m)
m=m+1
deallocate(a)
end do
print*, n,m
end
Here is my Matrix:
a b 13 15.5 13.2
c d 16 16.75 19
e f 19.2 12.2 18.2
With this code I got (3,2) for the dimensions of my matrix.
There are a few errors in your example code which means it doesn't compile for me but after a few changes I managed to get a similar result to you.
*Update: As noted by #francescalus in the comments to my other (now deleted) answer, that approach involved undefined behaviour and as such is not an appropriate solution. This arose from trying to read more elements from the file than were present.)
Here's an alternative approach, which should avoid this undefined behaviour, but is probably pretty inefficient.
Program Project2nd
implicit none
character(len=40), allocatable :: a(:)
integer, allocatable :: ind(:)
integer, parameter :: maxElements = 100
integer i,j,n,m,st
character(len=40) d
n=0;
open(10,file='mat.txt',IOstat=st)
!Find number of lines
do while (st == 0)
read(10,*,IOstat=st) d
if(st ==0) n=n+1
end do
!Move back to the start of the file
rewind(10)
!Read all of the data
do m=n,maxElements,n
allocate(a(m))
read(10,*,IOstat=st) a
deallocate(a)
rewind(10)
if(st.ne.0) exit
enddo
m = m -n !Need to roll back m by one iteration to get the last which worked.
if(mod(m,n).ne.0) then
print*,"Error: Number of elements not divisible by number of rows."
stop
endif
!Number of columns = n_elements/nrow
m=m/n
print*, n,m
end Program Project2nd
Essentially this uses the same code as you had for counting the number of lines, however note that you only want to increment n when the read was successful (i.e. st==0). Note we do not exit the whilst block as soon as st becomes non-zero, it is only once we reach the end of the whilst block. After that we need to rewind the file so that the next read starts at the start of the file.
In a previous comment you mentioned that you'd rather not have to specify maxElement if you really want to avoid this then replace the second do loop with something like
st = 0 ; m = n
do while (st==0)
allocate(a(m))
read(10,*,IOstat=st) a
deallocate(a)
rewind(10)
if(st.ne.0) then
m = m - n !Go back to value of m that worked
exit
endif
m=m+n
enddo
here is how to do w/o rewinding.
implicit none
character(len=100) wholeline
character(len=20), allocatable :: c(:)
integer iline,io,ni,nums
open(20,file='testin.dat')
iline=0
do while(.true.)
read(20,'(a)',iostat=io)wholeline
if(io.ne.0)exit
iline=iline+1
ni=lineitems(wholeline)
allocate(c(ni))
read(wholeline,*)c
nums=ctnums(c)
write(*,*)'line',iline,' contains ',ni,'items',nums,
$ 'are numbers'
deallocate(c)
enddo
write(*,*)'total lines is ',iline
contains
integer function ctnums(c)
! count the number of items in a character array that are numbers
! this is a template,
! obviously you could assign the numbers to a real array here
character(len=*), allocatable :: c(:)
real f
integer i,io
ctnums=0
do i = 1,size(c)
read(c(i),*,iostat=io)f
if(io.eq.0)ctnums=ctnums+1
enddo
end function
integer function lineitems(line)
! count the number of items in a space delimited string
integer,parameter ::maxitems=100
character(len=*) line
character(len=80) :: c(maxitems)
integer iline,io
lineitems=0
do iline=1,maxitems
read(line,*,iostat=io)c(:iline)
if(io.ne.0)return
lineitems=iline
enddo
if(lineitems.eq.maxitems)write(*,*)'warning maxitems reached'
end function
end
output
line 1 contains 5 items 3 are numbers
line 2 contains 5 items 3 are numbers
total lines is 2

Random number concentrated within a certain range

I wrote Fortran code to generate a series of random numbers. In this code, I could set up random number window (minimum and maximum random number) and percentage of random numbers within this window (number of random numbers). I want that the generated random numbers are always different from each other.
I could use gfortran compiler to compile it successfully; however, I found a problem. For instance, when I input 1 and 81 as minimum and maximum values respectively and 0.07 as the percentage, the code always gave me seven different random numbers, which were always smaller than 10, no matter how many times I ran it. What I expect is that the code should give me seven different random numbers which are distributed within 1~81 range, rather than only concentrated within 1~10 range. I do not know why the code gave me the random numbers only concentrating within a certain range. I paste my code below.
Would you anyone give me some suggestions on my problem? Thank you very much in advance.
PROGRAM RANDOM_POSITION
IMPLICIT NONE
REAL percent, val
INTEGER maxi, mini, num, i, l
INTEGER, DIMENSION(1), ALLOCATABLE :: position(:)
PRINT *,'Range for the impurity position(maximum and minimum value):'
PRINT *,'Minimum value:'
READ (UNIT=*, FMT=*) mini
PRINT *,'Maximum value:'
READ (UNIT=*, FMT=*) maxi
PRINT 11,'Percentage of impurity='
11 FORMAT(A23,$)
READ (UNIT=*, FMT=*) percent
num = (maxi-mini) * percent
IF ((maxi-mini) * percent-num .NE. 0.0) THEN
num = num + 1
END IF
PRINT *, num
ALLOCATE (position(num))
CALL RANDOM_SEED()
DO i=1, num ,1
CALL RANDOM_NUMBER(val)
position(i) = NINT(mini + val * num)
CALL JUDGEMENT(position, i, l)
l = 0
DO WHILE (l .EQ. 0)
CALL RANDOM_NUMBER(val)
position(i) = NINT(mini + val * num)
CALL JUDGEMENT(position, i, l)
END DO
PRINT *, position(i)
END DO
DEALLOCATE(position)
STOP
END PROGRAM RANDOM_POSITION
SUBROUTINE JUDGEMENT(arr, j, l)
IMPLICIT NONE
INTEGER j, k, l
INTEGER, DIMENSION(1) :: arr(j)
l = 1
DO k=1, j-1, 1
IF (arr(k) .EQ. arr(j)) THEN
l = 0
EXIT
ELSE
l = 1
END IF
END DO
RETURN
END SUBROUTINE JUDGEMENT

How can I count occurrence of numbers in matrix in fortran?

I'm using fortran 90, and I hope to count the number of occurence, when two numbers appears in an array.
flag=0
q=0
do k=1,ncolumns
if (conn(m,k)==i .and. conn(m,k)==l) flag=1
enddo
if (flag==1) q=q+1
write (*,*) q
Here, conn(m,k) is the matrix, made up of m lines and k columns. I want to read the conn(m,k), and count the number of occurrence when both number i and l are included in conn(m,k). I know above code will not work because it prints out only 0, since that if loop have a problem. But I cannot use '.or.' because I want the count when i and l both are included in the conn(m,k). How can I check both number i and l are included in conn?
I modified the code above like
ncolumns=2
flag=0
q=0
do k=1,ncolumns
!!!if (conn(m,k)==i .and. conn(m,k)==l) flag=1
if (((conn(m,1)==i).and.(conn(m,2)==l)).or.((conn(m,1)==l).and.(conn(m,2)==i))) flag=1
enddo
if (flag==1) q=q+1
write (*,*) q
This works fine, but as you can see, this code is ridiculous since I need to manually define k, specially when 'ncolumns' is huge number. How can I do this with index?
Likewise, how can I check 2 or more specific numbers are included in the matrix like conn(m,k) in fortran? Thanks.
Something like this ought to do what you want:
nums = [2,12,-4,99] ! an array of the numbers you're looking for
q = 0 ! the count of rows containing all the numbers in nums
DO ix = 1, SIZE(conn,1) ! the number of rows in conn
nmatches = 0 ! the number of elements of nums found in conn(ix,:)
DO jx = 1, SIZE(nums)
IF(ANY(conn(ix,:)==nums(jx))) nmatches = nmatches+1 ! figure this out yourself
END DO
! if there are as many matches in this row as there are elements in nums, add 1 to q
IF(nmatches==SIZE(nums)) q = q+1
END DO
You can also use a dummy matrix (dummy_mat) to populate with ones where the values are located in the matrix you are searching (value_mat) and then sum the dummy matrix to get the count (num_entries):
nums = [2,12,-4,99]
do i=1,size(nums) ! loop over the values you are looking for
dummy_mat = 0 ! zero out dummy matrix that is the same size as your value matrix
where (value_mat(:,:) == nums(i))
dummy_mat(:,:) = 1
end where
num_entries(i) = SUM(dummy_mat)
end do
From the comment "if there are 3 lines in conn which have two elements (such as 3 and 12) together, the printed q should be 3".
You can do this with a single loop if you have Fortran95 (I forget if it is in the 90 spec) or later.
Here is an example:
Program Test_Count
Implicit None
Real(Kind=8), Dimension(3) :: nums = (/-2.0_8 , -3.0_8 , -4.0_8/)
Real(Kind=8), Dimension(4,4) :: test
Logical, Dimension(4) :: Mask
Integer :: i,j,NumberOfLines
! Fill test
Do i = 1,4
Do j = 1,4
test(i,j) = -4.0_8 + (j -1)
End Do
End Do
! Count the row that have all the nums in them
Mask = any(test == nums(1),2)
Do i = 2,3
Mask = Mask .and. any(test == num2(i),2)
End Do
NumberOfLines = count(Mask)
Write(*,*) NumberOfLines ! Prints out 4.
End Program Test_Count

Resources