Populate a constant array in order specified by other constants? - fortran

Is there a way to populate a constant array in an order specified by other constant variables?
So, in effect this:
integer, parameter :: ired = 1
integer, parameter :: iblue = 2
real, parameter :: myarr(2,3)
myarr(ired, :) = [1,0,0]
myarr(iblue,:) = [0,0,1]
Except the above of course will not compile. Is there a way to get to this in some way?

To generalize #HPM's answer to the case where ired and iblue etc may be discontiguous (e.g, 1 and 3), combined use of implied do-loop + array constructor might be useful. Because arrays in Fortran are column-major, I have aligned the vectors in a matrix such that [ vec1, vec2, ..., vecN ] where vecX is a 3-vector.
integer :: k
integer, parameter :: ired = 1, iblue = 3, mxvec = 4, ndim = 3, zero(3) = [0,0,0]
integer, dimension( ndim * mxvec ), parameter :: &
red = [ (zero, k=1,ired-1 ), [1,1,1], (zero, k=ired+1, mxvec) ], &
blue = [ (zero, k=1,iblue-1), [7,7,7], (zero, k=iblue+1,mxvec) ]
integer, parameter :: myarr( ndim, mxvec ) = reshape( red + blue, [ ndim, mxvec ] )
print "(a,/100(3i2/))", "red = ", red
print "(a,/100(3i2/))", "blue = ", blue
print "(a,/100(3i2/))", "myarr = ", myarr
print *, "myarr( :, ired ) = ", myarr( :, ired )
print *, "myarr( :, iblue ) = ", myarr( :, iblue )
Result:
red =
1 1 1
0 0 0
0 0 0
0 0 0
blue =
0 0 0
0 0 0
7 7 7
0 0 0
myarr =
1 1 1
0 0 0
7 7 7
0 0 0
myarr( :, ired ) = 1 1 1
myarr( :, iblue ) = 7 7 7

No, there is no way to assign values to a parameter after program start-up; that's exactly what the attribute parameter is intended to prevent.
You could write
real, parameter :: myarr(2,3) = reshape([1.0,0,0,0,0,1],[2,3])
to initialise myarr. Note that the elements are provided to reshape in the array element order specified by Fortran (ie column major); here it happens to be the same as if you had specified them in row major order. And note that in Fortran initialization means, precisely, setting a value in the declaration statement, which is how parameters acquire values.
I don't immediately see any way to use ired and iblue in the intialisation but I'm struggling to see that as a problem.
EDIT, after OP's comment:
I guess you could write something like
INTEGER, PARAMETER :: ired = 1
INTEGER, PARAMETER :: iblue = 2
REAL, PARAMETER, DIMENSION(2,3) :: rows = reshape([1,0,0,0,0,1],[2,3])
REAL, PARAMETER :: myarr(2,3) = RESHAPE([rows(ired,:), rows(iblue,:)], [2,3])
and now you only have to swap the values of ired and blue to change myarr. And the only thing you might forget is why you wrote such convoluted code !

Related

How to write to file elements of arrays in a particular pattern

I want to write to file elements of the three arrays: k= (/1, 2 /), kp = (/1, 2 /), w(k,kp) = (/1,2 ,3,4/)
in the following pattern, using Fortran:
k kp w(k,kp)
1 1 1
1 2 2
2 1 3
2 2 4
I know how to write for column "kp" and "w", but how can I write column "k" ?
I have my code as:
write(20,*) "k" , "kp", "W"
do i = 1,2
do j = 1, 2
write (20,*) k( ) kp(j) , W(i,j)
end do
end do
Is this homework problem?
program foo
implicit none
integer :: i, j, k(2) = [1,2], kp(2) = [1,2]
integer :: w(2,2) = reshape([1,3,2,4], [2,2])
do j = 1, 2
do i = 1, 2
write(*,'(*(1X,I0))') k(j), kp(i), w(k(j),kp(i))
end do
end do
end program foo

Find the sum of each rows and each columns

need to use SUM() and dim
the problem in the sum() algorithm does not calculate correctly, I can’t fix it, I need someone’s help
program main
use environment
implicit none
character(*), parameter :: input_file = "../data/input.txt", output_file = "output.txt"
integer :: In = 0, Out = 0, rows = 0, columns = 0!, i = 0
integer, allocatable :: A(:,:)
integer :: res_rows = 0, res_columns = 0
open (file=input_file, newunit=In)
read(In, *) rows, columns
allocate(A(rows, columns))
read (In, *) A
close (In)
res_rows = sum(A(1:columns+1,1), dim=1)
res_columns = sum(A(1:rows+1,1), dim=1)
!outout data
open (file=output_file, encoding=E_, newunit=Out, position='append')
write(*,*)"rows:",res_rows
write(*,*)"columns:",res_columns
close (Out)
end program main
input data from txt file
4 3
1 1 2
4 3 4
1 1 2
4 3 2
output data to txt file
rows: 4 11 4 9
columns: 10 8 10
Fortran is a column-major language. Your read(in,*) a is populating the matrix in the wrong order. Try writing out the first row of your matrix a. Your use of the sum intrinsic is also wrong. See below.
program main
implicit none
character(*), parameter :: input_file = "a.dat"
integer i, in, out, rows, columns
integer, allocatable :: a(:,:)
integer :: res_rows = 0, res_columns = 0
open(file=input_file, newunit=in, status='old')
read(in, *) rows, columns
allocate(a(rows, columns))
do i = 1, rows
read(in,*) a(i,:)
end do
close(in)
print '(A,4(1X,I0))', 'Sum of each row:', sum(a,dim=2)
do i = 1, rows
print '(3I3,A,I0)', a(i,:),' = ', sum(a(i,:))
end do
print *
print '(A,4(1X,I0))', 'Sum of each column:', sum(a,dim=1)
do i = 1, columns
print '(4I3,A,I0)', a(:,i),' = ',sum(a(:,i))
end do
end program main

mkl: invalid value error exporing sparse matrix

The following program uses Intel MKL and creates a sparse matrix from the coordinate represenation, then the matrix is exported to the CSR format.
include 'mkl_spblas.f90'
program test
use iso_c_binding
use mkl_spblas
implicit none
complex(kind=kind(0.d0)) :: values(4)
integer :: columns(4)
integer :: rows(4)
TYPE(C_PTR) :: rows_start_csr, rows_end_csr, col_index_csr, values_csr
integer(C_INT) :: indexing_csr, nrows_csr, ncol_csr
type(SPARSE_MATRIX_T) :: handle
integer :: stat
! Matrix
!
! | 0 1 0 0 |
! | 1 0 0 0 |
! | 0 0 1 0 |
! | 0 0 0 1 |
values(1) = 1
rows(1) = 1
columns(1) = 2
values(2) = 1
rows(2) = 2
columns(2) = 1
values(3) = 1
rows(3) = 3
columns(3) = 3
values(4) = 1
rows(4) = 4
columns(4) = 4
stat = mkl_sparse_z_create_coo(handle, SPARSE_INDEX_BASE_ONE, 4, 4, 4, rows, columns, values)
write (*,*) 'stat after create = ', stat
stat = mkl_sparse_z_export_csr(handle, indexing_csr, nrows_csr, ncol_csr, rows_start_csr, rows_end_csr, col_index_csr, values_csr)
write (*,*) 'stat after export = ', stat, ' SPARSE_STATUS_INVALID_VALUE = ', SPARSE_STATUS_INVALID_VALUE
end program test
The output of the program is:
stat after create = 0
stat after export = 3 SPARSE_STATUS_INVALID_VALUE = 3
While after the matrix creation the status is OK, surprisingly, the status after exporting it corresponds to SPARSE_STATUS_INVALID_VALUE.
How can this possibly happens, and how to fix it?
You need to convert your COO format to CSR beforehand.
include 'mkl_spblas.f90'
program test
use iso_c_binding
use mkl_spblas
implicit none
complex(kind=kind(0.d0)) :: values(4)
integer :: columns(4)
integer :: rows(4)
TYPE(C_PTR) :: rows_start_csr, rows_end_csr, col_index_csr, values_csr
integer(C_INT) :: indexing_csr, nrows_csr, ncol_csr
type(SPARSE_MATRIX_T) :: coo, csr ! ===== NEW
integer :: stat
! Matrix
!
! | 0 1 0 0 |
! | 1 0 0 0 |
! | 0 0 1 0 |
! | 0 0 0 1 |
values(1) = 1
rows(1) = 1
columns(1) = 2
values(2) = 1
rows(2) = 2
columns(2) = 1
values(3) = 1
rows(3) = 3
columns(3) = 3
values(4) = 1
rows(4) = 4
columns(4) = 4
stat = mkl_sparse_z_create_coo(coo, SPARSE_INDEX_BASE_ONE, 4, 4, 4, rows, columns, values)
write (*,*) 'stat after create = ', stat
! ===== NEW ===== ->
stat = mkl_sparse_convert_csr(coo, SPARSE_OPERATION_NON_TRANSPOSE, csr)
write (*,*) 'stat after convert = ', stat
! ===== NEW ===== <-
stat = mkl_sparse_z_export_csr(csr, indexing_csr, nrows_csr, ncol_csr, rows_start_csr, rows_end_csr, col_index_csr, values_csr)
write (*,*) 'stat after export = ', stat, ' SPARSE_STATUS_INVALID_VALUE = ', SPARSE_STATUS_INVALID_VALUE
end program

Set negative values in a array to zero by using the if conditional

I have a function of some variables, which will yield an array consisted of both negative and positive values (Real). But since only positive values are physically meaningful to me, I want to set all negative values inside the array to be zero.
I have provided my code related to this function below:
The reason I declare a temporary variable 'res' is that I try to build in an IF-ELSE in the position I marked in code as follows:
If (res >= 0) Then
result = res
Else
result = 0
End If
But the error says a scalar-valued expression for S_A if required here.
If instead of res we use res(il,ir) is used,
If (res(il,ir) >= 0) Then
result(il,ir) = res(il,ir)
Else
result = 0
End If
the error says error #6351: The number of subscripts is incorrect.
Is there any way to implement this idea?
Function somefunction(x,y,il,ir) Result(result)
!! ---- begin of declaration ---------------------------
Implicit None
!! boundary indices
Integer, Intent ( in ) :: il,ir
!! the vars
Real ( kind = rk ), Intent ( in ), Dimension ( il:ir ) :: x,y
!! the result
Real ( kind = rk ), Dimension ( il:ir ) :: result
!! temp vars
Real ( kind = rk ), Dimension ( il:ir ) :: res
!! loop index
Integer :: i
!! ---- end of declaration -----------------------------
res = x+y
SA = S_A
!!IF-ELSE!!
End Function somefunction
If you want to have an if statement element wise on an array, you should use the where statement, for example:
program min0
implicit none
real :: res(5, 5), result(5, 5)
call random_number(res)
res=res-0.5
print '(5(F5.2,X))', res
where (res>=0)
result = res
elsewhere
result = 0
end where
print *, '---------------------------------------'
print '(5(F5.2,X))', result
end program min0
I don't know why you get a subscript error, it might help if you tell us which line of the code the error occurs. But of course in the second code, you update a single element of result if res is larger than 0, but set the whole array result to 0 if it isn't. This is almost certainly not what you want.
Cheers
The function appears to take in X and Y dimensioned from (il:if)... say from (3:6), so a vector. However the index later says (il,ir) which means it is a 2 dimensional array.
WHERE seems like a good choice. Another would be a logical MASK to associate the where-positions. It makes sense is PACK and unpack are usd,
Why even say what size the vectors are?
ELEMENTAL Function somefunction(x,y) Result(Res)
!! ---- begin of declaration ---------------------------
Implicit None
Real ( kind = rk ), Intent (IN), Dimension (:) :: x,y
!! the result
Real ( kind = rk ), Dimension ( il:ir ) :: res
!! loop index
Integer :: i
!! ---- end of declaration -----------------------------
res = x+y
WHERE res <= 0
Res = 0
ENDWHERE
!!IF-ELSE!!
End Function somefunction
Then on the calling side... call the function over the range of undecided you want.
Z(1:5) = somefunction(X(1:5),Y(1:5))

Writing a blank instead of an integer in Fortran

I have a few 110-element vectors. They sometimes have a value from 0 to 9, but their default value is -1. I'd like to print a blank if a cell's value is -1; print their value otherwise.
I'm printing several things in an output line so I can't use an if with two writes. Passing the values to a character vector worked but I can't help but think there must be a better way.
My attempt:
program integer_print_blank_test
implicit none
integer, dimension(9) :: longint
character(len=3), dimension(9) :: longchar
integer :: i, j
do i = 0, 2
write(*,*) (longint(3*i+j), j = 1, 3)
end do
longint = -1
longint(1) = 1
longint(4) = 3
longint(9) = 7
write(*,*) "longint"
do i = 0, 2
write(*,*) (longint(3*i+j), j = 1, 3)
end do
do i = 1, 9
write(longchar(i),"(I3)") longint(i)
end do
write(*,*) "longchar"
do i = 0, 2
write(*,*) (longchar(3*i+j), j = 1, 3)
end do
write(*,*) "only positives in longchar"
longchar = " "
do i = 1, 9
if (longint(i) > -1) then
write(longchar(i),"(I3)") longint(i)
end if
end do
do i = 0, 2
write(*,*) (longchar(3*i+j), j = 1, 3)
end do
end program integer_print_blank_test
You might think this is a better way. Define a function such as
ELEMENTAL FUNCTION borf(int) RESULT(str)
INTEGER, INTENT(in) :: int
CHARACTER(len=2) :: str
str = ' '
IF (int>-1) WRITE(str,'(i2)') int
END FUNCTION borf
and use it like this
WRITE(*,*) borf(longint)