Declaration of 1D array with nonlinear functionality between boundaries - fortran

This is my code:
Program Arrays_0
Implicit none
Integer :: i , Read_number , Vig_Position , Vipg_Position , n_iter
Integer , parameter :: Br_gra = 12
Integer , parameter , dimension ( Br_gra ) :: Vig = [ ( i , i = 1 , Br_gra) ]
Integer , parameter , dimension ( Br_gra ) :: Vipg = [ 0 , 1 , 1 , 1 , 2 , 2 , 3 , 4 , 4 , 7 , 7 , 7 ]
Integer :: Result_of_calculation
Write(*,*)"Enter the number (From 1 to Br_gra):"
Read(*,*) Read_number
Vig_Position = Vig(Read_number)
Vipg_Position = Vipg(Vig_Position)
!K_str( Vig_Position_temp ) = Vig_Position_temp + 2.3
n_iter = 0
Result_of_calculation = Vig_Position
Do while( Vipg_Position .ne. Vipg(1) )
n_iter = n_iter + 1
Vig_Position = Vipg_Position
! K_str( Vig_Position_temp ) = Vig_Position_temp + 2.3
Result_of_calculation = Result_of_calculation + Vig_Position
Vipg_Position = Vipg(Vig_Position)
End Do
Write(*,'(a,1x,i0)')"The number of iteration is:",n_iter
Write(*,'(a,1x,i0)')"The result of calculation is:",Result_of_calculation
End Program Arrays_0
There is no problem with code if I want to make calculation for a n_iter and Result_of_calculation but I have a problem with declaration of K_str in way that can follow correctly specific use of this two variables (my intention for using this variables in calculation was showed in comments).
So question is how to declare, for example, in case that Read_number is 12?
In that case I have: K_str(12), K_str(7), K_str(3) and K_str(1).
What I can do is this:
Real, dimension (Br_gra):: K_str
But in this case a must import one more loop for all elements from Vig (12 calculation). I want to prevent that number of calculation and in this case, I want to that my code make just a 4 calculation.
How to do that?

So you want to get an array, which e.g. starts at index 1, ends at index 12, but does not contain all the indexes in between, just some of them?
That is not possible with Fortran arrays. Actually, it is not possible with arrays in any other language I know.
One can use the dictionary data structure for something like that, which is intrinsic in some languages, but not Fortran. There are external libraries for similar data-structures in Fortran. See http://fortranwiki.org/fortran/show/Hash+tables
You could also use a linked list with all usual drawbacks and advantages (no direct indexing etc.).
Unless your need is for some very large ranges of indexes, much much larger than your example, use a regular array that contains all indexes.
You can also use one array which will contain the data (indexed 1 to 4) and another array of the same size, which will contain the global position (1,3,7 and 12). Or a derived type with these two components. But it will not be the same usage as you propose.

Related

Find indices of non-zero elements in array fortran [duplicate]

This question already has answers here:
finding specific indices with pointer array
(3 answers)
Closed 2 years ago.
I have the following array
integer, dimension(4) :: my_array = (/160,0,230,0/)
I would like to find the indices of the elements that are non-zero and store them in another array or individual variables for future use.
I am not sure how to do this because I don't know a prior how many elements are non-zero. I was thinking of using a loop combined with count(my_array/=0) and maxloc.
Is some sort of loop the only way? I can't think of a good way to use WHERE or FINDLOC.
I have tried this
ii = COUNT(my_array.NE.0)
ALLOCATE(choices(ii))
choices = PACK(my_array,my_array.NE.0)
But only makes a new array without zero elements, so I lose the original indices.
I'm not 100% sure I understand what you want, but does this do it?
ian#eris:~/work/stack$ cat pack.f90
Program pack_index
Implicit None
Integer, Dimension( 1:4 ) :: my_array = [ 160, 0, 230, 0 ]
Integer, Dimension( : ), Allocatable :: choices
Integer, Dimension( : ), Allocatable :: indices
Integer :: i
indices = Merge( 0, [ ( i, i = 1, Size( my_array ) ) ], my_array == 0 )
choices = Pack( indices, indices /= 0 )
Write( *, * ) choices
End Program pack_index
ian#eris:~/work/stack$ gfortran-8 -std=f2008 -fcheck=all pack.f90
ian#eris:~/work/stack$ ./a.out
1 3

How to obtain the smallest figure out of five figures using OO Fortran

In what way can I get the smallest figure in a given five digit figure. E.g 23764. How do I get 2 being the smallest.
Taking the figure as a digit such as 456879, in order to obtain the smallest from the digit which is 4, I implemented the following
program findsmallestFigure
implicit none
integer:: figure
integer:: c,smallest,largest
smallest = 9
largest = 0
figure = 23456
do while(figure .GT. 0 )
c = MOD(figure,10)
largest = max(c,largest)
smallest = min(c,smallest)
figure = figure/10
end do
print *,'The smallest digit is',smallest
end
How do I achieve the same result using Object Oriented approach in Fortran ?
Create a module with a user-defined type that contains all the results, and the subroutines to fill in the values
module numstat
! Holds the statistics of a figure
type stat
integer :: smallest, largest, count
end type
! Constructor from a figure. Invoke by 'stat(1234)`
interface stat
module procedure :: calc_stat
end interface
contains
! Fill statistics type from a figure
function calc_stat(fig) result(s)
integer, intent(in) :: fig
type(stat) :: s
integer :: digit, f
! make a copy of the figure because intent(in) arguments
! are immutable (cannot change).
f = fig
s%smallest = 9
s%largest = 0
s%count = 0
do while(f > 0 )
s%count = s%count + 1
digit = mod(f, 10)
s%largest = max(s%largest, digit)
s%smallest = min(s%smallest, digit)
f = f/10
end do
end function
end module
Then use the module in the main program
program SONumstat
use numstat
implicit none
type(stat) :: s
integer :: figure
figure = 23456
s = stat(figure)
print *,'The number of digits is ', s%count
print *,'The smallest digit is ',s%smallest
print *,'The largest digit is ',s%largest
end program SONumstat

Fortran read from fie into arrays

I need to read from a txt file into three arrays in order to calculate distances between coordinates. I have looked through other answers and pieced together the script bellow. The columns of the input file need to be come my x, y and z arrays respectively. There are 64 rows and 16 decimal places for each entry. Pointers would be greatly appreciated.
the data format:
0.8607595188703266 0.9252035918116585 0.4094258340665792
0.5246038490998378 0.9804633529144733 0.5325820695466118
0.6955271184611949 0.3304908806613460 0.7154502550542654
and my script so far:
PROGRAM readtest
use, intrinsic :: iso_fortran_env
implicit none
integer, parameter :: ArrayLen = 64
real(real64), DIMENSION(ArrayLen) :: x
real(real64), DIMENSION(ArrayLen) :: y
real(real64), DIMENSION(ArrayLen) :: z
integer :: i, ReadCode, num
OPEN(1, FILE='contcar.txt', STATUS='old', ACTION='read')
OPEN(2, FILE='xyz.txt', STATUS='replace', ACTION='write')
num = 0
ReadLoop: do i=1, ArrayLen
read (1, '(A,F18.16)', iostat=ReadCode ) x(i), y(i), z(i)
if ( ReadCode /= 0 ) then
if ( ReadCode == iostat_end ) then
exit ReadLoop
else
write ( *, '( / "Error on read: ", I0 )' ) ReadCode
stop
end if
end if
num = num + 1
end do ReadLoop
WRITE(3, 100) x, y, z
100 format (A,F18.16)
END PROGRAM readtest
The xyz.txt is appearing blank and I am not getting any errors at this stage, what is wrong here that is stopping the array filling and writing to the file?
Sorry, if this is too much of mess to approach, any help would be appreciated.
Thanks
You have two problems with you approach:
Your format specifications are wrong
Your write won't do what you want
First off, the format A,F18.16 reads two items, a character and a floating point number. What you want is to read 3 floating point numbers. With the file provided, there are two spaces before each number so you could use
read (1, '(3(2X,F18.16))', iostat=ReadCode ) x(i), y(i), z(i)
but this is not very flexible if your input format changes and it is easier to just do list-directed input:
read (1, *, iostat=ReadCode ) x(i), y(i), z(i)
which will do what you want and is not sensitive to the exact positioning of the numbers within the file and how many intervening spaces exist.
This will load your data into the arrays. Now for output you want the same thing. You want to duplicate the output so we can use the first format about to stipulate that output (3(2X,F18.16)). This will output 3 numbers per line with 2 spaces before each number. The next problem is that you are attempting
WRITE(3, 100) x, y, z
which will transpose your array. It will write all of the x, then all of the y and lastly all of the z. If you want the same output, put it in a loop. Putting the above together, use:
do i=1, ArrayLen
WRITE(2, 100) x(i), y(i), z(i)
end do
100 format (3(2X,F18.16))
As a note, don't use single digit unit numbers, particularly the first few which conflict with system defined standard input/output/error units on most compilers.

mpi_gather doesn't return entire vector with fortran derived datatype

I'm running into an issue where mpi_gather only returns a small subset of the vector that I'm trying to pass. Note, I'm running this with np 1, but it also happens with np 2 and np 3. NAT = 3 (nat = number of atoms), and there are 194 unique pairs.
To make this happen, I have two derived data types in fortran:
type dtlrdh_lut
sequence
integer p
integer q
integer ind
real(dp), dimension(3, 3) :: TLR
real(dp), dimension(3, 3, 3, 3) :: dTLRdh
end type dtlrdh_lut
In my subroutine, I have defined my variables like so:
type(dtlrdh_lut), dimension(:), allocatable :: my_dtlrdh, collected_dtlrdh
integer :: dh_dtype, dr_dtype, dh_types(5), dr_types(6), dh_blocks(5), dr_blocks(6)
INTEGER(kind=MPI_ADDRESS_KIND) :: dh_offsets(5), dr_offsets(6)
integer :: numtasks, rank, ierr, dh_displs(nproc_image), dr_displs(nproc_image)
integer :: n, status(mpi_status_size)
I split up the work between processes in another method and then count the number of elements of the lookup table need to be computed and allocated the local lookup tables on this specific node like so:
my_num_pairs = 0
do i = 1, num_pairs, 1
if(unique_pairs(i)%cpu.eq.me_image) then
my_num_pairs = my_num_pairs + 1
end if
end do
if(.not.allocated(my_dtlrdh)) allocate(my_dtlrdh(my_num_pairs))
I also allocate and zero out the lookup table that everything will be combined back into with the following code:
if(me_image.eq.root_image) then
if(.not.allocated(collected_dtlrdh)) allocate(collected_dtlrdh(num_pairs))
do i=1,my_num_pairs,1
collected_dtlrdh(i)%p = 0
collected_dtlrdh(i)%q = 0
collected_dtlrdh(i)%ind = 0
collected_dtlrdh(i)%TLR = 0.0_DP
collected_dtlrdh(i)%dTLRdh = 0.0_DP
end do
end if
I then fill in the lookup table, but I'll skip that code. It's long and not relevant. With this done, it's time to start the MPI process to gather all back on the root process.
call mpi_get_address(my_dtlrdh(1)%p, dh_offsets(1), ierr)
call mpi_get_address(my_dtlrdh(1)%q, dh_offsets(2), ierr)
call mpi_get_address(my_dtlrdh(1)%ind, dh_offsets(3), ierr)
call mpi_get_address(my_dtlrdh(1)%TLR(1,1), dh_offsets(4), ierr)
call mpi_get_address(my_dtlrdh(1)%dTLRdh(1,1,1,1), dh_offsets(5), ierr)
do i = 2, size(dh_offsets)
dh_offsets(i) = dh_offsets(i) - dh_offsets(1)
end do
dh_offsets(1) = 0
dh_types = (/MPI_INTEGER, MPI_INTEGER, MPI_INTEGER, MPI_DOUBLE_PRECISION, MPI_DOUBLE_PRECISION/)
dh_blocks = (/1, 1, 1, 3*3, 3*3*3*3/)
call mpi_type_struct(5, dh_blocks, dh_offsets, dh_types, dh_dtype, ierr)
call mpi_type_commit(dh_dtype, ierr)
I then call gather via:
call mpi_gather(my_dtlrdh, my_num_pairs, dh_dtype, &
collected_dtlrdh, my_num_pairs, dh_dtype, &
root_image, intra_image_comm, ierr)
After I gather, I can then print out what everything should look like:
do i = 1, num_pairs, 1
write(stdout, *) my_dtlrdh(i)%p, collected_dtlrdh(i)%p, my_dtlrdh(i)%q, collected_dtlrdh(i)%q
end do
and this is where I see really strange information. The first few elements that are printed out look fine:
1 1 3 3
1 1 6 6
1 1 9 9
But the tail end of my vector looks like where I only send 174 elements instead of the full 194:
17 0 24 0
18 0 19 0
18 0 20 0
18 0 21 0
18 0 22 0
Given that there are 194 pairs, and both num_pairs and my_num_pairs equal 194, I'm confused. I went ahead and started to play around in desperation, and found that if I use this gather call instead of the one above, I get the full vector:
num_pairs = 2*num_pairs+40
call mpi_gather(my_dtlrdh, num_pairs, dh_dtype, &
collected_dtlrdh, num_pairs, dh_dtype, &
root_image, intra_image_comm, ierr)
which I found by just guess and check. While this may work for this small test system, it hardly seems like a scalable solution. I'm totally at a loss... Any ideas? And please, let me know if you guys need any more information from me.
MPI_TYPE_STRUCT is deprecated in favour of MPI_TYPE_CREATE_STRUCT. The latter takes conceptually the same arguments as the former but the array of offsets is of type INTEGER(KIND=MPI_ADDRESS_KIND), i.e. the type returned by MPI_GET_ADDRESS.
You should also consider alignment issues when using arrays of MPI datatypes, because, despite the SEQUENCE attribute, your derived type may be padded by the compiler with some bytes at the end. Thus it is a good idea to resize dh_dtype according to the difference between the output of MPI_GET_ADDRESS() applied to my_dtlrdh(1) and my_dtlrdh(2) by means of the MPI_TYPE_CREATE_RESIZED() subroutine.
This is explained in this lecture on datatypes at page 41
This is probably however not enough to explain your problem.

Count the numbers of equal rows in a file

Suppose you have a file.dat of the form:
1
1
1
2
2
3
3
3
3
...
I want to count how many equal numbers there are and save them iteratively in a string. For instance:
m = 3 (times 1),
m = 2 (times 2),
m = 4 (times 3).
I put here my code:
program sele
implicit none
integer::j,k,s,n,l,r,m
real*8,allocatable::ID(:)
real*8:: j_r8,i_r8
open(10,file='data.dat')
n=0
DO
READ(10,*,END=100)
n=n+1
END DO
100 continue
rewind(10)
allocate(ID(n))
s=0
do s=1, n
read(10,*) ID(s)
end do
do r=1,n-1
if (ID(r)-ID(r+1) .EQ. 0) then
m = m + 1
print*, m
end if
end do
end program
The last do is the condition I'd like to expand, with something like:
if (condition is true) then
save an index of the number of equal digits
use this to do some operations:
do i = 1, number of equal digits
if (condition is not true) then
restart with the other digits.
If the values you want to read are integer values in a given limited range (for instance from 1 to 100), then the simplest way is the following :
program sele
implicit none
integer, parameter :: vmin=1
integer, parameter :: vmax=100
integer :: list(vmin:vmax)
integer :: value,i
open(10,file='data.dat')
list=0
do
read(10,*,end=10) value
if(value < vmin .OR. value > vmax) then
write(*,*) 'invalid value ',value
stop
endif
list(value)=list(value)+1
enddo
10 continue
do i=vmin,vmax
if(list(i) > 0) then
write(*,*) list(i),' times ',i
endif
enddo
end program
Which gives on your example :
3 times 1
2 times 2
4 times 3
It is possible to improve easily that program to manage variable vmin and vmax (the array list must then be declared allocatable and allocated at the right size).
If the range is too large, then a simple array is not accurate anymore and the right algorithm becomes more complicated : it must avoid to store unused values.