Is it possible to eliminate do loop - fortran

As we know, more recent versions of Fortran support array operations, which can eliminate many loops. So I was wondering if it would be possible to eliminate even the last remaining loop in following code snippet (as to make it a one-liner):
subroutine test(n,x,lambda)
integer, intent(in) :: n
real, dimension(:), intent(in) :: x
real, dimension(:), intent(out) :: lambda
real :: eps
integer :: i
do i=1,n
lambda(i) = product(x(i)-x, mask=(abs(x(i)-x) > epsilon(eps)))
enddo
end subroutine
Its intention is to calculate n lambda(i) values in which
lambda(i) = (x(i)-x(1))*(x(i)-x(2))*...*(x(i)-x(i-1)*(x(i)-x(i+1))*...*(x(i)-x(n))


OK, try this
lambda = product(max(spread(x, dim=1, ncopies=size(x)) - &
spread(x, dim=2, ncopies=size(x)), eps), dim=2)
That's a one-liner. It's also rather wasteful of memory and much less comprehensible than the original.


Have you tried it with an implied do-loop in the array creation? something like real, dimension(:), intent(out):: lambda =(/product(x(i)-x, mask=(abs(x(i)-x)>epsilon(eps))), i=1, n/) ... I am not sure about the syntax here, but something like that might work.
You might even be able to create the array without calling the subroutine and do it in your main program, if your x-array is available.
Hope it helps.


Yes, you can shorten this, product can use 2D arrays:
You would first need to set up a matrix of the differences:
do i=1,n
mat(:,i) = x(i) - x
enddo
or, as a one-liner:
forall ( i=1:n ) mat(:,i) = x(i) - x
Now you can do the product along the second dimension:
lambda = product(mat, dim=2, mask=(abs(mat) > epsilon(eps)))
Whole program:
program test
integer, parameter :: n = 3
real, dimension(n) :: x
real, dimension(n) :: lambda
real, dimension(n,n) :: mat
real :: eps = 1.
integer :: i
call random_number( x )
do i=1,n
lambda(i) = product(x(i)-x, mask=(abs(x(i)-x) > epsilon(eps)))
enddo
print *,lambda
forall ( i=1:n ) mat(:,i) = x(i) - x
lambda = product(mat, dim=2, mask=(abs(mat) > epsilon(eps)))
print *,lambda
end program

Related

How to compute a complex function in a cleverer way with Fortran?

I want to solve this equation by using Fortran:
Where ψ (psi) is a complex Fortran variable.
Now, I am solving this by defining two new complex variables:
ir=(1.0,0.0) and ii=(0.0,1.0).
I use these to select only the real or imaginary part of the equation. In this way I solve my equation separately for the real and imaginary part. The code is here:
do i = 1,nn
mod2 = (abs(psi(i)))**2
psi(i) = ir*(-beta*imag(der2(i)) + alpha*mod2*imag(psi(i))) + ii*(beta*real(der2(i)) - alpha*mod2*real(psi(i)))
end do
Where psi and der2 are complex arrays with nn elements.
I want to solve this equation in a better way without splitting it in two equations. I tried to solve it in this way:
mod2 = abs(psi)**2
psi = -ii*(-beta*der2+alpha*mod2*psi)
but it doesn't work because I obtain completely different values with respect to the first method I used. For me it makes sense that it doesn't work because in the second method I am not evaluating the real part. Is this right?
As an example, the 10° element of my psi array becomes:\
(-6.39094355774850412E-003,-6.04041029332164168E-003) (with 1° method)\
(-1.75266632213431602E-004,-6.21567692553507290E-003) (2° method)\
Any suggestion?
Thank you!

The problem is mod2 = abs(psi)**2 should have been mod2 = abs(dat)**2
But I think that the correct calculation for mod2 is sum( real( dat*conjg(dat) ) )
I get the same result with both methods with some arbitrary data:
eq1=
(-595.000000000000,-120.200000000000)
(-713.800000000000,-1.40000000000000)
(-832.600000000000,117.400000000000)
(-951.400000000000,236.200000000000)
(-1070.20000000000,355.000000000000)
(-1189.00000000000,473.800000000000)
(-1307.80000000000,592.600000000000)
(-1426.60000000000,711.400000000000)
(-1545.40000000000,830.200000000000)
(-1664.20000000000,949.000000000000)
eq2=
(-595.000000000000,-120.200000000000)
(-713.800000000000,-1.40000000000000)
(-832.600000000000,117.400000000000)
(-951.400000000000,236.200000000000)
(-1070.20000000000,355.000000000000)
(-1189.00000000000,473.800000000000)
(-1307.80000000000,592.600000000000)
(-1426.60000000000,711.400000000000)
(-1545.40000000000,830.200000000000)
(-1664.20000000000,949.000000000000)
Test code
program Console1
use,intrinsic :: iso_fortran_env
implicit none
! Variables
integer, parameter :: sp=real32, wp=real64
complex(wp), parameter :: ir = (1d0,0d0), ii = (0d0,1d0)
real(wp), parameter :: alpha = 0.1d0, beta = 0.2d0
integer, parameter :: n=10
complex(wp) :: dat(n), psi(n), der2(n)
integer :: i
! Body of Console1
dat = [ ( (2d0-i)*ir - (4d0+i)*ii, i=1,n ) ]
der2 = [ ( -(5d0+i)*ir + (1d0-i)*ii, i=1,n ) ]
psi = eq1(dat, der2)
print *, "eq1="
do i=1,n
print *, psi(i)
end do
psi = eq2(dat, der2)
print *, "eq2="
do i=1,n
print *, psi(i)
end do
contains
function eq1(dat, der2) result(psi)
complex(wp), intent(in) :: dat(:), der2(size(psi))
complex(wp) :: psi(size(dat))
real(wp) :: mod2
integer :: i
mod2 = sum( real( dat*conjg(dat) ) )
do i=1, size(psi)
psi(i) = ir*(-beta*imag(der2(i)) + alpha*mod2*imag(dat(i))) + ii*(beta*real(der2(i)) - alpha*mod2*real(dat(i)))
end do
end function
function eq2(dat, der2) result(psi)
complex(wp), intent(in) :: dat(:), der2(size(dat))
complex(wp) :: psi(size(dat))
real(wp) :: mod2
mod2 = sum( real( dat*conjg(dat) ) )
psi = -ii*(-beta*der2+alpha*mod2*dat)
end function
end program Console1
Also with your definition of |ψ| we have also consistent results.
eq1=
(-13.0000000000000,-3.80000000000000)
(-21.4000000000000,-1.40000000000000)
(-34.6000000000000,3.40000000000000)
(-53.8000000000000,11.8000000000000)
(-80.2000000000000,25.0000000000000)
(-115.000000000000,44.2000000000000)
(-159.400000000000,70.6000000000000)
(-214.600000000000,105.400000000000)
(-281.800000000000,149.800000000000)
(-362.200000000000,205.000000000000)
eq2=
(-13.0000000000000,-3.80000000000000)
(-21.4000000000000,-1.40000000000000)
(-34.6000000000000,3.40000000000000)
(-53.8000000000000,11.8000000000000)
(-80.2000000000000,25.0000000000000)
(-115.000000000000,44.2000000000000)
(-159.400000000000,70.6000000000000)
(-214.600000000000,105.400000000000)
(-281.800000000000,149.800000000000)
(-362.200000000000,205.000000000000)
with code
function eq1(dat, der2) result(psi)
complex(wp), intent(in) :: dat(:), der2(size(psi))
complex(wp) :: psi(size(dat))
real(wp) :: mod2(size(dat))
integer :: i
mod2 = abs(dat)**2
do i=1, size(psi)
psi(i) = ir*(-beta*imag(der2(i)) + alpha*mod2(i)*imag(dat(i))) + ii*(beta*real(der2(i)) - alpha*mod2(i)*real(dat(i)))
end do
end function
function eq2(dat, der2) result(psi)
complex(wp), intent(in) :: dat(:), der2(size(dat))
complex(wp) :: psi(size(dat))
real(wp) :: mod2(size(dat))
mod2 = abs(dat)**2
psi = -ii*(-beta*der2+alpha*mod2*dat)
end function
Going back to the original problem, I can replicate the issue
eq1=
(-13.0000000000000,-3.80000000000000)
(-21.4000000000000,-1.40000000000000)
(-34.6000000000000,3.40000000000000)
(-53.8000000000000,11.8000000000000)
(-80.2000000000000,25.0000000000000)
(-115.000000000000,44.2000000000000)
(-159.400000000000,70.6000000000000)
(-214.600000000000,105.400000000000)
(-281.800000000000,149.800000000000)
(-362.200000000000,205.000000000000)
eq2=
(0.000000000000000E+000,-1.20000000000000)
(0.200000000000000,-1.40000000000000)
(0.400000000000000,-1.60000000000000)
(0.600000000000000,-1.80000000000000)
(0.800000000000000,-2.00000000000000)
(-1952.64000000000,779.256000000000)
(NaN,NaN)
(1.40000000000000,-2.60000000000000)
(NaN,NaN)
(1.80000000000000,-3.00000000000000)
with mod2 = abs(psi)**2 instead of mod2 = abs(dat)**2

Fortran operator overloading for complex number matrix type

How can overload operator(+) and assigment(-) for my class?
the compiler shows me the following message
Error: Component to the right of a part reference with nonzero rank must not have the ALLOCATABLE
attribute at (1).
For the assigment(=), I have no idea how to do it.
For c ++ it was easier. Return pointner this
function zmat_zmat_add(zmatrix1,zmatrix2) result(res_zmat_zmat)
type(zmatrix_type), dimension(:,:), intent(in) :: zmatrix1
type(zmatrix_type), dimension(:,:), intent(in) :: zmatrix2
type(zmatrix_type) :: res_zmat_zmat
integer :: rows
integer :: i,j ! liczniki pętli
rows=3
do i=1, rows
do j=1, rows
res_zmat_zmat%zmatrix_data(i,j)%realis= &
zmatrix1%zmatrix_data(i,j)%realis + zmatrix2%zmatrix_data(i,j)%realis
res_zmat_zmat%zmatrix_data(i,j)%imaginalis = &
zmatrix1%zmatrix_data(i,j)%imaginalis + &
zmatrix2%zmatrix_data(i,j)%imaginalis
enddo
enddo
end function zmat_zmat_add
rest code
module zmatrix_module
implicit none
type, public :: zcomplex_type
real :: realis
real :: imaginalis
end type zcomplex_type
type, extends(zcomplex_type), public :: zmatrix_type
type(zcomplex_type), dimension(:,:), allocatable, public :: zmatrix_data
end type zmatrix_type
public :: zmatrix_allocate
public :: zmatrix_free
public :: zmatrix_set
public :: zmatrix_print
interface operator(+)
procedure zzadd
procedure zmat_zmat_add
end interface
contains
function zzadd(z1,z2) result(res)
type(zcomplex_type), intent(in) :: z1
type(zcomplex_type), intent(in) :: z2
type(zcomplex_type) :: res
res%realis=z1%realis+z2%realis
res%imaginalis= z1%imaginalis +z2%imaginalis
end function zzadd
function zmat_zmat_add(zmatrix1,zmatrix2) result(res_zmat_zmat)
type(zmatrix_type), dimension(:,:), intent(in) :: zmatrix1
type(zmatrix_type), dimension(:,:), intent(in) :: zmatrix2
type(zmatrix_type) :: res_zmat_zmat
integer :: rows
integer :: i,j
rows=3
do i=1, rows
do j=1, rows
res_zmat_zmat%zmatrix_data(i,j)%realis= &
zmatrix1%zmatrix_data(i,j)%realis + zmatrix2%zmatrix_data(i,j)%realis
res_zmat_zmat%zmatrix_data(i,j)%imaginalis = &
zmatrix1%zmatrix_data(i,j)%imaginalis + &
zmatrix2%zmatrix_data(i,j)%imaginalis
enddo
enddo
end function zmat_zmat_add
subroutine zmatrix_allocate(zarray,rows)
type(zmatrix_type), intent(out) :: zarray
integer, intent(in) :: rows
allocate(zarray%zmatrix_data(1:rows, 1:rows))
end subroutine zmatrix_allocate
subroutine zmatrix_free(zarray)
type(zmatrix_type), intent(inout) :: zarray
deallocate(zarray%zmatrix_data)
end subroutine zmatrix_free
subroutine zmatrix_set(zarray, rows, re_values, im_values)
type(zmatrix_type), intent(inout) :: zarray
integer, intent(in) :: rows
real, intent(in) :: re_values, im_values
integer :: i,j
do i=1, rows
do j=1, rows
zarray%zmatrix_data(i,j)%realis = re_values
zarray%zmatrix_data(i,j)%imaginalis = im_values
enddo
enddo
end subroutine zmatrix_set
subroutine zmatrix_print(array,rows)
type(zmatrix_type), intent(in) :: array
integer, intent(in) :: rows
integer i,j
do i=1, rows
write(*,*) (array%zmatrix_data(i,j), j=1, rows)
enddo
write(*,*)
end subroutine zmatrix_print
end module zmatrix_module
Program main
use zmatrix_module
implicit none
type(zmatrix_type) :: mat1
type(zmatrix_type) :: mat2
type(zmatrix_type) :: mat3
type(zcomplex_type) :: z1
type(zcomplex_type) :: z2
type(zcomplex_type) :: z3
integer :: rows
rows=2
print *, " AAAAAAA"
call zmatrix_allocate(mat1,rows)
call zmatrix_set(mat1,rows,10.0,8.0)
call zmatrix_print(mat1,rows)
print *, "BBBBBBBB"
call zmatrix_allocate(mat2,rows)
call zmatrix_set(mat2,rows,1.0,2.0)
call zmatrix_print(mat2,rows)
print *, "CCCCCC"
call zmatrix_allocate(mat3,rows)
mat3=zmat_zmat_add(mat1,mat2)
mat3=mat1+mat2
call zmatrix_print(mat3,rows)
call zmatrix_free(mat1)
call zmatrix_free(mat2)
call zmatrix_free(mat3)
End Program main

The comments point out the immediate problem - you don't need the dimension attribute in the zmat_zmat_add routine - you are adding a single matrix to another matrix, not an array of matrix to another array of matrices. Thus you have a scalar of the appropriate type for each dummy argument.
However as the actual question indicates there is a second problem, how to allocate the result array for zmat_zmat_add. Well, you make the result allocatable and allocate it! I've shown in the first code below the most direct way to solve the problems you are showing. However the code you have written reads a bit like writing C++ as Fortran. This is not the best way to solve this problem, and so I have provided a second solution which is a much more Fortran way of doing things. This is below the first code. Anyway here the quick and dirty fix to your code:
ijb#ijb-Latitude-5410:~/work/stack$ cat zm1.f90
module zmatrix_module
implicit none
type, public :: zcomplex_type
real :: realis
real :: imaginalis
end type zcomplex_type
type, extends(zcomplex_type), public :: zmatrix_type
type(zcomplex_type), dimension(:,:), allocatable, public :: zmatrix_data
end type zmatrix_type
public :: zmatrix_allocate
public :: zmatrix_free
public :: zmatrix_set
public :: zmatrix_print
interface operator(+)
procedure zzadd
procedure zmat_zmat_add
end interface
contains
function zzadd(z1,z2) result(res)
type(zcomplex_type), intent(in) :: z1
type(zcomplex_type), intent(in) :: z2
type(zcomplex_type) :: res
res%realis=z1%realis+z2%realis
res%imaginalis= z1%imaginalis +z2%imaginalis
end function zzadd
function zmat_zmat_add(zmatrix1,zmatrix2) result(res_zmat_zmat)
type(zmatrix_type), intent(in) :: zmatrix1
type(zmatrix_type), intent(in) :: zmatrix2
type(zmatrix_type) :: res_zmat_zmat
integer :: cols, rows
integer :: i,j
rows = Size( zmatrix1%zmatrix_data, Dim = 1 )
cols = Size( zmatrix1%zmatrix_data, Dim = 2 )
Allocate( res_zmat_zmat%zmatrix_data( 1:rows, 1:cols ) )
do i=1, rows
do j=1, cols
res_zmat_zmat%zmatrix_data(i,j)%realis= &
zmatrix1%zmatrix_data(i,j)%realis + zmatrix2%zmatrix_data(i,j)%realis
res_zmat_zmat%zmatrix_data(i,j)%imaginalis = &
zmatrix1%zmatrix_data(i,j)%imaginalis + &
zmatrix2%zmatrix_data(i,j)%imaginalis
enddo
enddo
end function zmat_zmat_add
subroutine zmatrix_allocate(zarray,rows)
type(zmatrix_type), intent(out) :: zarray
integer, intent(in) :: rows
allocate(zarray%zmatrix_data(1:rows, 1:rows))
end subroutine zmatrix_allocate
subroutine zmatrix_free(zarray)
type(zmatrix_type), intent(inout) :: zarray
deallocate(zarray%zmatrix_data)
end subroutine zmatrix_free
subroutine zmatrix_set(zarray, rows, re_values, im_values)
type(zmatrix_type), intent(inout) :: zarray
integer, intent(in) :: rows
real, intent(in) :: re_values, im_values
integer :: i,j
do i=1, rows
do j=1, rows
zarray%zmatrix_data(i,j)%realis = re_values
zarray%zmatrix_data(i,j)%imaginalis = im_values
enddo
enddo
end subroutine zmatrix_set
subroutine zmatrix_print(array,rows)
type(zmatrix_type), intent(in) :: array
integer, intent(in) :: rows
integer i,j
do i=1, rows
write(*,*) (array%zmatrix_data(i,j), j=1, rows)
enddo
write(*,*)
end subroutine zmatrix_print
end module zmatrix_module
Program main
use zmatrix_module
implicit none
type(zmatrix_type) :: mat1
type(zmatrix_type) :: mat2
type(zmatrix_type) :: mat3
integer :: rows
rows=2
print *, " AAAAAAA"
call zmatrix_allocate(mat1,rows)
call zmatrix_set(mat1,rows,10.0,8.0)
call zmatrix_print(mat1,rows)
print *, "BBBBBBBB"
call zmatrix_allocate(mat2,rows)
call zmatrix_set(mat2,rows,1.0,2.0)
call zmatrix_print(mat2,rows)
print *, "CCCCCC"
call zmatrix_allocate(mat3,rows)
mat3=zmat_zmat_add(mat1,mat2)
mat3=mat1+mat2
call zmatrix_print(mat3,rows)
call zmatrix_free(mat1)
call zmatrix_free(mat2)
call zmatrix_free(mat3)
End Program main
ijb#ijb-Latitude-5410:~/work/stack$ gfortran --version
GNU Fortran (Ubuntu 9.3.0-17ubuntu1~20.04) 9.3.0
Copyright (C) 2019 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
ijb#ijb-Latitude-5410:~/work/stack$ gfortran -std=f2018 -Wall -Wextra -fcheck=all -O -Wuse-without-only zm1.f90 -o zm1
zm1.f90:99:4:
99 | use zmatrix_module
| 1
Warning: USE statement at (1) has no ONLY qualifier [-Wuse-without-only]
ijb#ijb-Latitude-5410:~/work/stack$ ./zm1
AAAAAAA
10.0000000 8.00000000 10.0000000 8.00000000
10.0000000 8.00000000 10.0000000 8.00000000
BBBBBBBB
1.00000000 2.00000000 1.00000000 2.00000000
1.00000000 2.00000000 1.00000000 2.00000000
CCCCCC
11.0000000 10.0000000 11.0000000 10.0000000
11.0000000 10.0000000 11.0000000 10.0000000
ijb#ijb-Latitude-5410:~/work/stack$
As I say this is not a very "Fortran" way of solving this. Here is what I would do. Note
The intrinsic Complex data type
Array syntax to simplify the code
Allocation of allocatable arrays when they are the result of a calculation, again simplifying the code
Use of intrinsics to find properties of arrays rather than carrying around extra variables which contain duplicate information
Type bound procedures
(Not really only Fortran but use of private for encapsulation and to minimise name space pollution)
Quite probably others
Anyway here goes
Module zmatrix_module
Implicit None
Type, Public :: zmatrix_type
Private
Complex, Dimension(:,:), Allocatable, Private :: zmatrix_data
Contains
Procedure, Public :: allocate => zmatrix_allocate
Procedure, Public :: free => zmatrix_free
Procedure, Public :: set => zmatrix_set
Procedure, Public :: print => zmatrix_print
Generic , Public :: Operator( + ) => add
Procedure, Private :: add => zmat_zmat_add
End Type zmatrix_type
Private
Contains
Function zmat_zmat_add(zmatrix1,zmatrix2) Result(res_zmat_zmat)
Class(zmatrix_type), Intent(in) :: zmatrix1
Type (zmatrix_type), Intent(in) :: zmatrix2
Type (zmatrix_type) :: res_zmat_zmat
! Uses allocation on assignment
! Also use array syntax to simplify code
res_zmat_zmat%zmatrix_data = zmatrix1%zmatrix_data + zmatrix2%zmatrix_data
End Function zmat_zmat_add
Subroutine zmatrix_allocate(zarray,rows)
! Note Intent(out) ensures the array is deallocate on entry to the routine
Class(zmatrix_type), Intent(out) :: zarray
Integer, Intent(in) :: rows
Allocate(zarray%zmatrix_data(1:rows, 1:rows))
End Subroutine zmatrix_allocate
Subroutine zmatrix_free(zarray)
Class(zmatrix_type), Intent(inout) :: zarray
Deallocate(zarray%zmatrix_data)
End Subroutine zmatrix_free
Subroutine zmatrix_set(zarray, values )
Class(zmatrix_type), Intent(inout) :: zarray
Complex, Intent(in) :: values
zarray%zmatrix_data = values
End Subroutine zmatrix_set
Subroutine zmatrix_print(array)
Class(zmatrix_type), Intent(in) :: array
Integer :: i
! Don't need to carry around extra data, just ask the array its size
Do i=1, Size( array%zmatrix_data, Dim = 1 )
Write(*,*) array%zmatrix_data(i,:)
Enddo
Write(*,*)
End Subroutine zmatrix_print
End Module zmatrix_module
Program main
Use zmatrix_module, Only : zmatrix_type
Implicit None
Type( zmatrix_type ) :: mat1
Type( zmatrix_type ) :: mat2
Type( zmatrix_type ) :: mat3
Integer :: rows
rows=2
Print *, " AAAAAAA"
Call mat1%allocate( rows )
Call mat1%set( ( 10.0, 8.0 ) )
Call mat1%print()
Print *, "BBBBBBBB"
Call mat2%allocate( rows )
Call mat2%set( ( 1.0, 2.0 ) )
Call mat2%print()
Print *, "CCCCCC"
! Note mat3 gets auto-allocated as a result of the operation
mat3 = mat1 + mat2
Call mat3%print()
Call mat3%free()
Call mat2%free()
Call mat1%free()
End Program main
ijb#ijb-Latitude-5410:~/work/stack$ gfortran --version
GNU Fortran (Ubuntu 9.3.0-17ubuntu1~20.04) 9.3.0
Copyright (C) 2019 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
ijb#ijb-Latitude-5410:~/work/stack$ gfortran -std=f2018 -Wall -Wextra -fcheck=all -O -Wuse-without-only zm2.f90 -o zm2
ijb#ijb-Latitude-5410:~/work/stack$ ./zm2
AAAAAAA
(10.0000000,8.00000000) (10.0000000,8.00000000)
(10.0000000,8.00000000) (10.0000000,8.00000000)
BBBBBBBB
(1.00000000,2.00000000) (1.00000000,2.00000000)
(1.00000000,2.00000000) (1.00000000,2.00000000)
CCCCCC
(11.0000000,10.0000000) (11.0000000,10.0000000)
(11.0000000,10.0000000) (11.0000000,10.0000000)
ijb#ijb-Latitude-5410:~/work/stack$
There is another way which would fit this nicely, namely parametrised derived types. But I have no experience here so I won't go into something I don't know.

#Ian Bush mentioned in his answer that another option is to use the feature called parameterized derived types.
I will show a sample implementation here using those type parameters. Here are some callouts, first:
With this you might reduce the need for allocatable variables, because you can specify the shape of your type-members at compile-time or runtime.
If you want to learn more about parameterized types, this article is a good starting point.
This was introduced in Fortran 2003. The availability of this feature depends on the compiler. Even some compilers that claim to be fully compliant with Fortran 2003 might fail to compile (for example, gfortran fails in several points of the following code).
Sample implementation:
module zmatrix_module
implicit none
private
! A parameterized-type is declared like this.
type, public :: zmatrix(rows)
! Delcare each parameter inside the type. In this case it is a len-type.
integer, len :: rows
private
! You can use a len-type parameter in initialization expressions.
complex :: data(rows, rows)
contains
! No need for `allocate` and `free` procedures anymore.
procedure, public :: set => zmat_set
procedure, public :: print => zmat_print
procedure :: add => zmat_add_zmat
generic, public :: operator(+) => add
end type
contains
function zmat_add_zmat(z1, z2) result(out)
class(zmatrix(*)), intent(in) :: z1
type(zmatrix(*)), intent(in) :: z2
! Match the len parameter of the output with the input.
type(zmatrix(z1%rows)) :: out
out%data = z1%data + z2%data
end
subroutine zmat_set(z, values)
class(zmatrix(*)), intent(inout) :: z
complex, intent(in) :: values
z%data = values
end
subroutine zmat_print(z)
class(zmatrix(*)), intent(in) :: z
integer :: i
! You can inquiry the type parameter with a syntax similar to structure field.
do i=1, z%rows
write(*,*) z%data(i,:)
end do
write(*,*)
end
end
Sample program using:
program main
use zmatrix_module, only : zmatrix
implicit None
integer, parameter :: rows = 2
! A constant or initialization expression are allowed as the len parameter.
type(zmatrix(rows)) :: mat1
type(zmatrix(rows)) :: mat2
! If you declare an allocatable, you might declare the len parameter as deferred.
type(zmatrix(:)), allocatable :: mat3(:)
call mat1%set((10.0, 8.0))
call mat2%set((1.0, 2.0))
! Note mat3 gets auto-allocated as a result of the operation.
mat3 = mat1 + mat2
! You can also allocate the object explicitly, or using a source/mold.
! allocate(zmatrix(2) :: mat3)
! allocate(mat3, source=mat1)
call mat3%print()
end

How to READ data starting from a pattern-matched line with Fortran?

I have a file pos.xyz with the following format, where i = 6,etc represent the frame indices. (Here, the first frame has i = 6. In general, the first frame's index can be i = 0,i = 1, or i = 2,...)
I want to implement a function: For any two given integers a and b,( a<b, e.g., 7 and 9), read
the data from the frame index 7 to 9 into an array. Could you give me a suggestion on how to implement this idea?
4
i = 6, time = 3.000, E = -205.1846561900
O 2.6028572470 4.1666579520 12.7865910725
O 6.5415232423 8.8963227363 17.7533721708
O 15.6020396800 11.9022808314 15.2930838049
O 11.2843786793 13.2653367176 13.8186352548
4
i = 7, time = 3.500, E = -205.1845561905
O 5.1072569275 11.9945026418 4.1254340934
O 2.5299942732 11.4124710424 9.5495912455
O 14.8837181647 12.6571252157 7.8905997802
O 15.1684493877 10.7315923081 2.6631494700
4
i = 8, time = 4.000, E = -205.1846261900
O 2.6028572470 4.1666579520 12.7865910725
O 6.5415232423 8.8963227363 17.7533721708
O 15.6020396800 11.9922808314 15.2930838049
O 11.2843786793 13.2653367176 13.8186352548
4
i = 9, time = 4.500, E = -205.1846561805
O 5.1072569375 11.9945026418 4.1258340934
O 2.5299942732 11.4124710424 9.5495912455
O 14.8837181647 12.6570252157 7.8905997802
O 15.1684493877 10.7310923081 2.6630494700
4
i = 10, time = 5.000, E = -205.1846551805
O 5.1072569275 11.9945026418 4.1254340934
O 2.5299932732 11.4129710424 9.5495912455
O 14.8837181647 12.6571252157 7.8905997802
O 15.1684473877 10.7313923081 2.6631494700
what I did: for the special case with i = 0 as the first frame. For example, If I want to read from the 3rd frame, I can first skip (m+2)*(3-1) lines and then READ the data,m=4. The function is as follows.
SUBROUTINE skip_lines(indx, i_input)
! Purpose:
! To skip lines when read data from the input
IMPLICIT NONE
INTEGER :: i
INTEGER,INTENT(IN) :: i_input,indx
do i=1,i_input
read(indx,*) !Neglect (nat+2)*(ns-1) lines
enddo
END SUBROUTINE skip_lines
But for general case, if the first frame has a frame non-zero number,this idea is not efficient. I hope to find a better way to implement it.

Thanks to #francescalus 's and #High Performance Mark 's suggestions. I use a DO WHILE loop and I have implemented my idea. I put one simplified version of my subroutine here. It include some types defined in modules, which are not the important thing here. Now, it can
(1) Read a trajectory file from any step a to any step b, where a and b are given by user;
(2) Read data every ns steps.
SUBROUTINE read_traj(indx,nmo_start,nmo_end,ns,nat,n_samples)
! goal:
! read info from the trajectory file (format: ***.xyz)
! read data from frame a to frame b
USE atom_module
USE parameter_shared
INTEGER :: iatom, i_sample
INTEGER, PARAMETER:: nat = 4
INTEGER :: n_samples !n_samples = INT((a-b)/ns)
INTEGER, PARAMETER :: indx = 10
INTEGER, PARAMETER :: ns = 2 ! read one sample from the trajectory every ns step.
INTEGER, PARAMETER :: a =7
INTEGER, PARAMETER :: b=10
CHARACTER(LEN=4) :: x
INTEGER :: y
allocate(atom_info(nat,n_samples))
i_sample = 1
DO WHILE (i_sample < n_samples)
read(indx, '(A3,I5)') x, y
CHECK: IF (head_char=="i = " .AND. (y>a-1 .and. y<b+1) .AND. MOD(y-(a-1),ns) == 1) THEN
WRITE(*,*)"head_char and y:", x, y
BACKSPACE(UNIT=indx) ! we have to read the whole line with ' i = ' line.
read(indx,120) sampled_movie(i_sample), sampled_time(i_sample), sampled_energy(i_sample)
120 FORMAT (3X,I5,8X,F9.3,5X,F20.10)
inner: do iatom= 1,nat
read (indx,*) atom_info(iatom, i_sample)%atom_name, atom_info(iatom,i_sample)%coord(1), &
atom_info(iatom,i_sample)%coord(2), atom_info(iatom,i_sample)%coord(3)
enddo inner
i_sample = i_sample + 1
ENDIF CHECK
END DO
END SUBROUTINE read_traj

gfortran -Wall -fcheck=all parameter_shared.f95 atom_module.f95 traj.f95 sample.f95 test.f95 -o test.x
! test.f95
PROGRAM test
! Purpose: To read data starting from any block.
USE atom_module
IMPLICIT NONE
!==========
!parameters
!==========
INTEGER :: ns ! Get one sample from the trajectory every ns step.
INTEGER :: nmo_start
INTEGER :: nmo_end
INTEGER :: nat ! number of atoms
REAL(kind=4) :: delta_t0 ! For reading data
character(LEN=200) :: pos_filename
!===============
! Initialization
delta_t0 = 0.0005; ns = 2
nmo_start = 7; nmo_end = 10
nat = 4; pos_filename="pos.xyz"
!========================
! Sampling the trajectory
CALL sample(pos_filename,nmo_start,nmo_end,nat,ns)
END PROGRAM test
! sample.f95
SUBROUTINE sample(pos_filename,nmo_start,nmo_end,nat,ns)
USE parameter_shared
USE atom_module, ONLY: atom_info
USE traj
IMPLICIT NONE
!==========
!Parameters
!==========
character(LEN=*), INTENT(IN) :: pos_filename
INTEGER, INTENT(IN) :: nmo_start
INTEGER, INTENT(IN) :: nmo_end
INTEGER, INTENT(IN) :: nat ! number of atoms
INTEGER, INTENT(IN) :: ns ! Get one sample from the trajectory every ns step.
!Local varables
INTEGER :: n_samples !n_samples = INT(nmo/ns)
INTEGER :: iatom,imovie,i
!Initialization
iatom = 0; imovie =0; i =0
! Obatin n_samples
n_samples = sampling_number(nmo_start,nmo_end,ns)
allocate(sampled_movie(n_samples))
allocate(sampled_time(n_samples))
allocate(sampled_energy(n_samples))
!=======================
!read in trajectory file
!=======================
open(10,file=trim(pos_filename))
CALL read_traj(10,nmo_start,nmo_end,ns,nat,n_samples)
close(10)
write(6,*) 'End of trajectory reading.'
!=============
!write in file
!=============
sampled_pos_filename = 'pos_sampled.xyz'
open(10,file=sampled_pos_filename)
do i =1,n_samples
write (10,'(I8)') nat
WRITE(10,100) 'i =',i-1,', time =',sampled_time(i),', E =',sampled_energy(i)
100 FORMAT (1X,A3,I10,A8,F10.3,A5,F20.10)
DO iatom = 1, nat
WRITE(10,*) TRIM(atom_info(iatom, i)%atom_name), &
atom_info(iatom,i)%coord(1), &
atom_info(iatom,i)%coord(2), &
atom_info(iatom,i)%coord(3)
ENDDO
enddo
write(6,*)'Sampled trajectory is written in: ', sampled_pos_filename
close(10)
deallocate(sampled_movie, sampled_time,sampled_energy)
END SUBROUTINE sample
MODULE traj
IMPLICIT NONE
CONTAINS
INTEGER FUNCTION sampling_number(nmo_start,nmo_end,ns)
!To calculate the total numbers of samples one want to include
INTEGER,INTENT(IN) :: ns ! Get one sample from the trajectory every ns step.
INTEGER,INTENT(IN) :: nmo_start, nmo_end
write(*,*) 'In function sampling_number: nmo_end = ', nmo_end
positive: IF (nmo_end <0 .OR. nmo_start < 0 .OR. ns <0) THEN
write(*,*) 'Please enter non-negative values for the ns, starting step and ending step.'
ELSE IF (nmo_end < nmo_start) THEN
write(*,*) 'Please note that starting step shoud not larger than ending step.'
ELSE IF (ns ==0) THEN
sampling_number = nmo_end-(nmo_start-1)
ELSE IF (nmo_end-(nmo_start-1) <= ns) THEN
sampling_number = INT((nmo_end-(nmo_start-1))/ns + 1)
ELSE IF (nmo_end-(nmo_start-1) > ns) THEN
sampling_number = INT((nmo_end-(nmo_start-1))/ns)
END IF positive
END FUNCTION sampling_number
SUBROUTINE read_traj(indx,nmo_start,nmo_end,ns,nat,n_samples)
! Purpose: to READ data starting from a pattern-matched line.
USE atom_module, ONLY: atom_info
USE parameter_shared, ONLY: sampled_movie, sampled_time, sampled_energy
INTEGER :: iatom,i_sample
INTEGER, INTENT(IN) :: nat
INTEGER, INTENT(IN) :: n_samples !n_samples = INT(nmo/ns)
INTEGER, INTENT(IN) :: indx
INTEGER, INTENT(IN) :: ns ! Get one sample from the trajectory every ns step.
INTEGER, INTENT(IN) :: nmo_start, nmo_end ! To get the total number of moves
CHARACTER(LEN=4) :: head_char
INTEGER :: y
allocate(atom_info(nat,n_samples))
i_sample = 1
write(*,*) "read_traj(): New total time steps (n_samples):", n_samples
DO WHILE (i_sample < n_samples+1) ! +1 means i_sample can take the value of n_samples
read(indx, '(A4)') head_char
PRE_CHECK:IF (head_char=="i = ") THEN
BACKSPACE(UNIT=indx) ! Because I am not able to read other lines with the format '(A4,I8)', and have not find any good way, so I try to read it in '(A4)' first
read(indx, '(A4,I8)') head_char, y
CHECK_HEAD:IF (head_char=="i = " .AND. (y>nmo_start-1 .and. y<nmo_end+1) .AND. MOD(y-(nmo_start-1),ns) == 1) THEN
WRITE(*,*)"read_traj():", head_char, y
BACKSPACE(UNIT=indx) ! Because we have to read the whole line with ' i = ' line.
read(indx,130) sampled_movie(i_sample), sampled_time(i_sample), sampled_energy(i_sample)
130 FORMAT (4X,I8,9X,F12.3,6X,F20.10)
131 FORMAT (A4,3F20.10)
inner: do iatom= 1,nat
read (indx,131) atom_info(iatom, i_sample)%atom_name, atom_info(iatom,i_sample)%coord(1), &
atom_info(iatom,i_sample)%coord(2), atom_info(iatom,i_sample)%coord(3)
enddo inner
i_sample = i_sample + 1
ENDIF CHECK_HEAD
ENDIF PRE_CHECK
END DO
END SUBROUTINE read_traj
END MODULE traj
MODULE atom_module
! To define the derived data type for atom
IMPLICIT NONE
TYPE :: atom
CHARACTER(LEN=2) :: atom_name
INTEGER :: atom_id
INTEGER :: host_id ! For O atom in water, host_id = atom_id
REAL :: mass
REAL, DIMENSION(3) :: coord
END TYPE atom
! The array atom_info can be shared by subroutines
TYPE(atom), ALLOCATABLE, DIMENSION(:,:) :: atom_info
END MODULE atom_module
MODULE parameter_shared
!
! Purpose:
! To declare data to share between routines.
IMPLICIT NONE
!SAVE
character(LEN=200) :: sampled_pos_filename
INTEGER, ALLOCATABLE, DIMENSION(:) :: sampled_movie
REAL, ALLOCATABLE, DIMENSION(:) :: sampled_time, sampled_energy
END MODULE parameter_shared

How to fix solution with double integration

The solution for this double integration is -0.083 but in the final compliation it appears -Infinity. It seems that the error is very simple, but I really can't find it.
I have been searching specially in the module section but I don't see why it appears like -Infinity. For example, if you change the two functions between them (x in f2 and x^2 in f1) the solution for the integration is 0.083 and the code gives it correct. Can annyone find the error? Thanks a lot.
module funciones
contains
function f(x,y)
implicit none
real*8:: x,y,f
f=2d0*x*y
end function
function f1(x)
real*8::x,f1
f1=x
end function
function f2(x)
real*8::x,f2
f2=x**2d0
end function
function g(x,c,d,h)
implicit none
integer::m,j
real*8::x,y,c,d,k,s,h,g
m=nint(((d-c)/h)+1d0)
k=(d-c)/dble(m)
s=0.
do j=1d0,m-1d0
y=c+dble(j)*k
s=s+f(x,y)
end do
g=k*(0.5d0*(f(x,c)+f(x,d))+s)
return
end function
subroutine trapecio(a,b,n,integral)
implicit none
integer::n,i
real*8::a,b,c,d,x,h,s,a1,a2,b1,b2,integral
h=(b-a)/dble(n)
s=0d0
do i=1d0,n-1d0
x=a+dble(i)*h
c=f1(x)
d=f2(x)
s=s+g(x,c,d,h)
end do
a1=f1(a)
a2=f2(a)
b1=f1(b)
b2=f2(b)
integral=h*(0.5d0*g(a,a1,a2,h)+0.5d0*g(b,b1,b2,h)+s)
end subroutine
end module
program main
use funciones
implicit none
integer::n,i
real*8::a,b,c,d,x,s,h,integral
print*, "introduzca los valores de a, b y n"
read(*,*) a, b, n
call trapecio (a,b,n,integral)
print*,integral
end program
The main program is simple, just calling the subroutine and using the module. It also prints the final result.

First of all, like mentioned in the comments: your problem is not clear. Which input parameters a, b and n do you use and which result do you expect?
Other than that: the code you posted used deprecated features and non-standard types and bad code style.
Some general hints:
real*8 is non-standard Fortran. Use real(real64) instead. real64 has to be imported by use :: iso_fotran_env, only: real64.
non-integer expressions (do i=1d0,n-1d0) in do-loops are a deleted feature in modern Fortran. Use integers instead.
code should be formatted with white spaces and indentations
print*, should be replaced with write(*,*)
code should always use English names
write implicit none in the beginning of the module, not for every function.
make the module/program interface clear by using the statements private, public, and only
if You want to convert to type real, use the function REAL instead of DBLE
I prefer the cleaner function definition using result
use intent keywords: intent(in) passes the variable as a const reference.
the variables c,d,x,s,h in the main program are unused. Compile with warnings to detect unused variables.
This is the code changed with the suggestions I made:
module funciones
use :: iso_fortran_env, only: real64
implicit none
private
public :: trapecio, r8
integer, parameter :: r8 = real64
contains
function f(x,y) result(value)
real(r8), intent(in) :: x,y
real(r8) :: value
value = 2._r8*x*y
end function
function f1(x) result(value)
real(r8), intent(in) :: x
real(r8) :: value
value = x
end function
function f2(x) result(value)
real(r8), intent(in) :: x
real(r8) :: value
value = x**2._r8
end function
function g(x,c,d,h) result(value)
real(r8), intent(in) :: x, c, d, h
real(r8) :: value
real(r8) :: y, k, s
integer :: m, j
m = NINT(((d-c)/h)+1._r8)
k = (d-c)/REAL(m, r8)
s = 0._r8
do j = 1, m-1
y = c + REAL(j,r8)*k
s = s + f(x,y)
end do
value = k*(0.5_r8*(f(x,c)+f(x,d))+s)
end function
subroutine trapecio(a, b, n, integral)
real(r8), intent(in) :: a, b
integer, intent(in) :: n
real(r8), intent(out) :: integral
integer :: i
real(r8) :: c, d, x, h, s, a1, a2, b1, b2
h = (b-a)/REAL(n,r8)
s = 0._r8
do i = 1, n-1
x = a + REAL(i,r8)*h
c = f1(x)
d = f2(x)
s = s + g(x,c,d,h)
end do
a1 = f1(a)
a2 = f2(a)
b1 = f1(b)
b2 = f2(b)
integral = h*(0.5_r8*g(a,a1,a2,h) + 0.5_r8*g(b,b1,b2,h) + s)
end subroutine
end module
program main
use funciones, only: trapecio, r8
implicit none
integer :: n,i
real(r8) :: a,b,integral
write(*,*) "introduzca los valores de a, b y n"
read(*,*) a, b, n
call trapecio (a,b,n,integral)
write(*,*) integral
end program

Passing different set of variables in a FORTRAN subroutine

I want to apply three different methods, selected with the value of an integer switch. The first method uses two integers, the second a real array and an integer and the third a real 2D array. In my current implementation, I allocate and pass as parameters all the above data (2 int + real_array + int + real_2array). I could also use a module, but it would be similar. I'm searching for a method to define only the data that my method will use (i.e. only the matrix for method 3) and nothing else. Any suggestions?
Edit:
I have made a simplified version of what I described above.
A part of the main program:
INTEGER :: m, imeth
REAL*8 :: x, y
REAL*8, DIMENSION(:), ALLOCATABLE :: uu, wc
REAL*8, DIMENSION(:,:), ALLOCATABLE :: BCH
imeth = 0
m = 64
ALLOCATE(uu(m), uu_(m), wc(m))
ALLOCATE(BCH(m,m))
if (imeth .EQ. 0) then
x = 1.0d0
y = 2.0d0
elseif (imeth .EQ. 1) then
!Assign values to wc
else
!Assign values to BCH
endif
call subr(m,x,y,uu,uu_,imeth,BCH,wc)
STOP
END
and a subroutine
SUBROUTINE subr(n,a,b,u,u_,imeth,DCH,ws)
IMPLICIT NONE
INTEGER, INTENT(IN) :: n, imeth
REAL*8, INTENT(IN) :: u(n), DCH(n,n), ws(n)
REAL*8, INTENT(OUT) :: u_(n)
INTEGER :: i
if (imeth .EQ. 0) then
u_ = -u_ * 0.5d0 / (a+b)
elseif (imeth .EQ. 1) then
u_ = -u / ws
else
u_ = matmul(DCH,u)
endif
RETURN
END SUBROUTINE subr
I want the main program to have a form like
imeth = 0
m = 64
ALLOCATE(uu(m), uu_(m))
if (imeth .EQ. 0) then
a = 1.0d0
b = 2.0d0
elseif (imeth .EQ. 1) then
ALLOCATE(wc(m))
!Assign values to wc
else
ALLOCATE(BCH(m,m))
!Assign values to BCH
endif
if (imeth .EQ. 0) then
call subrA(m,x,y,uu,uu_)
elseif (imeth .EQ. 1) then
call subrB(m,wc,uu,uu_)
else
call subrC(m,BCH,uu,uu_)
endif

EDIT: After OP added the code I think that using optional arguments in conjunction with the present intrinsic might be better suited for this task. The subroutine could then read
SUBROUTINE subr(n,u_,a,b,u,DCH,ws)
IMPLICIT NONE
INTEGER, INTENT(IN) :: n
REAL*8, INTENT(OUT) :: u_(n)
REAL*8, INTENT(IN),OPTIONAL :: a(n)
REAL*8, INTENT(IN),OPTIONAL :: b(n)
REAL*8, INTENT(IN),OPTIONAL :: u(n)
REAL*8, INTENT(IN),OPTIONAL :: DCH(n,n)
REAL*8, INTENT(IN),OPTIONAL :: ws(n)
INTEGER :: i
if ( present(a) .and. present(b) ) then
u_ = -u_ * 0.5d0 / (a+b)
elseif ( present(u) .and. present(ws) ) then
u_ = -u / ws
elseif ( present(wch) .and. present(u) ) then
u_ = matmul(DCH,u)
else
stop 'invalid combination'
endif
END SUBROUTINE subr
Here is the old answer as it still might be helpful:
Maybe you could try interfaces:
module interface_test
implicit none
interface method
module procedure method1
module procedure method2
module procedure method3
end interface
contains
subroutine method1(int1, int2)
implicit none
integer,intent(in) :: int1
integer,intent(out) :: int2
int2 = 2*int1
end subroutine
subroutine method2(int, realArray)
implicit none
integer,intent(in) :: int
real,intent(out) :: realArray(:)
realArray = real(2*int)
end subroutine
subroutine method3(realArray)
implicit none
real,intent(inout) :: realArray(:,:)
realArray = 2*realArray
end subroutine
end module
program test
use interface_test, only: method
implicit none
integer :: int1, int2
real :: arr1D(10)
real :: arr2D(10,10)
int1 = 1
call method(int1, int2)
print *, int2
call method(int1,arr1D)
print *, arr1D(1)
arr2D = 1.
call method(arr2D)
print *, arr2D(1,1)
end program