Related
When I run the following code:
program foo
implicit none
logical :: a(2)
a = [.true., .true.]
print *, 'a = ', a
call evaluate(a)
a = [.true., .false.]
print *, 'a = ', a
call evaluate(a)
a = [.false., .false.]
print *, 'a = ', a
call evaluate(a)
contains
subroutine evaluate(a)
logical, intent(in) :: a(2)
if (a(1) .eqv. .true. .and. a(2) .eqv. .true.) then
print *, 'TT'
elseif (a(1) .eqv. .true. .and. a(2) .eqv. .false.) then
print *, 'TF'
elseif (a(1) .eqv. .false. .and. a(2) .eqv. .false.) then
print *, 'FF'
endif
end subroutine evaluate
end program
I get the following output:
a = T T
TT
a = T F
TF
a = F F
TT
Why the last call of the subroutine evaluate gives the wrong output (i.e. match the first if condition not the thrid)?
The code has been compiled with the command gfortran -Wall -fcheck=all foo.f90.
You have discovered that the order of precedence of logical operators in Fortran can be a bit confusing. Let's extend your program slightly and see more weirdness:
ijb#ijb-Latitude-5410:~/work/stack$ cat eqv_2.f90
program foo
implicit none
logical :: a(2)
a = [.true., .true.]
print *, 'a = ', a
call evaluate(a)
a = [.true., .false.]
print *, 'a = ', a
call evaluate(a)
a = [.false., .true.]
print *, 'a = ', a
call evaluate(a)
a = [.false., .false.]
print *, 'a = ', a
call evaluate(a)
contains
subroutine evaluate(a)
logical, intent(in) :: a(2)
if (a(1) .eqv. .true. .and. a(2) .eqv. .true.) then
print *, 'TT'
elseif (a(1) .eqv. .true. .and. a(2) .eqv. .false.) then
print *, 'TF'
elseif (a(1) .eqv. .false. .and. a(2) .eqv. .true.) then
print *, 'FT'
elseif (a(1) .eqv. .false. .and. a(2) .eqv. .false.) then
print *, 'FF'
endif
end subroutine evaluate
end program
ijb#ijb-Latitude-5410:~/work/stack$ gfortran -std=f2008 -Wall -Wextra -fcheck=all -g -O eqv_2.f90
ijb#ijb-Latitude-5410:~/work/stack$ ./a.out
a = T T
TT
a = T F
TF
a = F T
TF
a = F F
TT
Hmmm, so not only [false,false] is [true,true] but [false,true] is [true, false]! How can this happen outside politics?
Well the problem is the precedence of the .eqv. operator is lower than that of the .and. operator, and so .and. gets evaluated first. In fact the precedence of .eqv. and .neqv. are the lowest of any non-user defined operators in Fortran, so they will get evaluated last in any logical expression that only uses language defined operators. This is just the same as us evaluating 3 + 4 * 5 + 6 as 3 + (4*5) + 6 = 29 and not (3+4) * (5+6) = 77, because the precedence of * is higher than that of +.
So you evaluate .false. .eqv. .true. .and. .false. .eqv. .true. as
.false. .eqv. (.true. .and. .false.) .eqv. .true. =
( .false. .eqv. .false. ) .eqv. .true. =
.true. .eqv. .true. =
.true.
Hence the result you see. It is for this reason that I strongly recommend students to use brackets in long logical expressions - if we do this here we get what you expected:
ijb#ijb-Latitude-5410:~/work/stack$ cat eqv.f90
program foo
implicit none
logical :: a(2)
a = [.true., .true.]
print *, 'a = ', a
call evaluate(a)
a = [.true., .false.]
print *, 'a = ', a
call evaluate(a)
a = [.false., .false.]
print *, 'a = ', a
call evaluate(a)
contains
subroutine evaluate(a)
logical, intent(in) :: a(2)
if ( (a(1) .eqv. .true.) .and. (a(2) .eqv. .true.)) then
print *, 'TT'
elseif ((a(1) .eqv. .true.) .and. (a(2) .eqv. .false.)) then
print *, 'TF'
elseif ( (a(1) .eqv. .false.) .and. (a(2) .eqv. .false.)) then
print *, 'FF'
endif
end subroutine evaluate
end program
ijb#ijb-Latitude-5410:~/work/stack$ gfortran -std=f2008 -Wall -Wextra -fcheck=all -g -O eqv.f90
ijb#ijb-Latitude-5410:~/work/stack$ ./a.out
a = T T
TT
a = T F
TF
a = F F
FF
That said as Martin explains in the other answer a lot of this is redundant. In fact I would argue that expressions like a .eqv. .true. are not good style, and in fact I can't remember when I last use .eqv. or .neqv. in a code.
I'm not clear on why you are checking that a(1) and a(2) are true or false. Their values are, by definition, true or false and can therefore be used directly without comparing them to true or false:
if (a(1) .and. a(2)) then
print *, 'TT'
elseif (a(1) .neqv. a(2)) then
print *, 'TF'
elseif (a(1) .eqv. a(2)) then
print *, 'FF'
endif
The cases are:
Both values are true = a(1).and.a(2) = TT
The values are not equal = a(1).neqv.a(2) = TF
The values are equal = a(1).eqv.a(2) = FF
In the third case, they must be FF as actually all the other situations have been covered, so an else would be sufficient instead of elseif. However, I've left it as the original code had it for clarity.
Output:
a = T T
TT
a = T F
TF
a = F F
FF
Is there a Fortran library which has an implementation of an ordering function, i.e., a function ordering(list) (like Ordering[] in Mathematica) which gives the positions in list at which each successive element of the sorted list appears?
I can implement it but I don't want to reinvent the wheel (and my wheel could be far from perfect...). Since it is so basic I was searching for a lib containing such list operations but failed to find one.
Do you have any suggestions?
Since I had this already implemented a long time ago (which relies on and borrows heavily from the Numerical Recipes book of Bill Press et al), here is a self-contained implementation of it in Fortran:
module index_mod
use, intrinsic :: iso_fortran_env, only: IK=>int32, RK=>real64
implicit none
contains
subroutine indexArrayReal(n,Array,Index)
implicit none
integer(IK), intent(in) :: n
real(RK) , intent(in) :: Array(n)
integer(IK), intent(out) :: Index(n)
integer(IK), parameter :: nn=15, nstack=50
integer(IK) :: k,i,j,indext,jstack,l,r
integer(IK) :: istack(nstack)
real(RK) :: a
do j = 1,n
Index(j) = j
end do
jstack=0
l=1
r=n
do
if (r-l < nn) then
do j=l+1,r
indext=Index(j)
a=Array(indext)
do i=j-1,l,-1
if (Array(Index(i)) <= a) exit
Index(i+1)=Index(i)
end do
Index(i+1)=indext
end do
if (jstack == 0) return
r=istack(jstack)
l=istack(jstack-1)
jstack=jstack-2
else
k=(l+r)/2
call swap(Index(k),Index(l+1))
call exchangeIndex(Index(l),Index(r))
call exchangeIndex(Index(l+1),Index(r))
call exchangeIndex(Index(l),Index(l+1))
i=l+1
j=r
indext=Index(l+1)
a=Array(indext)
do
do
i=i+1
if (Array(Index(i)) >= a) exit
end do
do
j=j-1
if (Array(Index(j)) <= a) exit
end do
if (j < i) exit
call swap(Index(i),Index(j))
end do
Index(l+1)=Index(j)
Index(j)=indext
jstack=jstack+2
if (jstack > nstack) then
write(*,*) 'NSTACK too small in indexArrayReal()' ! xxx
error stop
end if
if (r-i+1 >= j-l) then
istack(jstack)=r
istack(jstack-1)=i
r=j-1
else
istack(jstack)=j-1
istack(jstack-1)=l
l=i
end if
end if
end do
contains
subroutine exchangeIndex(i,j)
integer(IK), intent(inout) :: i,j
integer(IK) :: swp
if (Array(j) < Array(i)) then
swp=i
i=j
j=swp
end if
end subroutine exchangeIndex
pure elemental subroutine swap(a,b)
implicit none
integer(IK), intent(inout) :: a,b
integer(IK) :: dum
dum=a
a=b
b=dum
end subroutine swap
end subroutine indexArrayReal
end module Index_mod
program Index_prog
use Index_mod, only: IK, RK, indexArrayReal
implicit none
integer(IK), parameter :: n = 5
integer(IK) :: Index(n)
real(RK) :: Array(n) = [ 1.,3.,4.,2.,-1. ]
call indexArrayReal(n,Array,Index)
write(*,*) "Index: ", Index
write(*,*) "Array(Index): ", Array(Index)
end program Index_prog
Compiled with GFortran 2008, here is the output:
$gfortran -std=f2008 *.f95 -o main
$main
Index: 5 1 4 2 3
Array(Index): -1.0000000000000000 1.0000000000000000 2.0000000000000000 3.0000000000000000 4.0000000000000000
The above routine was for sorting real-valued arrays. To sort integer arrays, simply change real(RK) :: Array(n) in the interface of subroutine indexArrayReal() to integer(IK) :: Array(n).
In fortran I have two arrays
u = (/ .true. , .false. , .true. , .false. /)
v = (/ .true. , .true. , .false. , .false. /)
and I want to add them like
w = u .or. v
to get
w == (/ .true. , .true. , .true. , .false. /)
but the .or. operator does not accept arrays as input.
What's the best way to do that? I feel like I should make use of the where intrinsic but I am not quite sure how.
An example to show that operator(.OR.) is in fact elemental:
program orme
implicit none
logical u(4), v(4), w(4)
integer i
u = [.TRUE., .FALSE., .TRUE., .FALSE.]
v = [.TRUE., .TRUE., .FALSE., .FALSE.]
w = u .OR. v
write(*,'(*(g0))') 'w =',(merge(' [',', ',i==1), &
trim(merge('.TRUE. ','.FALSE.',w(i))),i=1,size(w)),']'
end program orme
Output with ifort:
w = [.TRUE., .TRUE., .TRUE., .FALSE.]
EDIT: I see your reason for confusion: gfortran documents the intrinsic extension OR(I,J) which only works for scalars. ifort also documents OR(I,J) but it is elemental in that compiler. In both instances when it works the result is a bitwise logical OR of its inputs. Replace with IOR(I,J) to get the standard elemental version on any compiler. Also there is the logical array reduction function ANY and the integer array reduction function IANY which can come in handy sometimes.
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
I am having strange results when verifying the SVD decomposition from Lapack. Those routines are usually robust so I believe the bug is on my side. Any help will be highly appreciated. My matrix is pentadiagonal, size n*n and the code looks like :
! Compute real bi-diag from complex pentadiag
call ZGBBRD('B', n, n, 0, 2, 2, ab, 5, &
d, e, q, n, pt, n, dummy_argc, 1, work, rwork, info)
if (info.ne.0) then
print *,'Call to *GBBRD failed, info : ',info
call exit(0)
endif
! Compute diagonal matrix from bi-diagonal one
call dbdsdc('U', 'I', n, d, e, u, n, vt, n, &
dummy_argr, 1, work_big, iwork, info)
if (info.ne.0) then
print *,'Call to *BDSDC failed, info : ',info
call exit(0)
endif
print *,'singular values min/max : ',minval(d),maxval(d)
do ii=1,n
do jj=1,n
tmpqu(ii,jj)=0.
do kk=1,n
tmpqu(ii,jj)=tmpqu(ii,jj)+q(ii,kk)*u(kk,jj) ! Q*U
enddo
enddo
enddo
do ii=1,n
do jj=1,n
tmpqu(ii,jj)=tmpqu(ii,jj)*d(jj) ! Q*U*sigma
enddo
enddo
do ii=1,n
do jj=1,n
tmptot(ii,jj)=0.
do kk=1,n
tmptot(ii,jj) = tmptot(ii,jj) + & ! Q*U*sigma*VT
tmpqu(ii,kk)*vt(kk,jj)
enddo
enddo
enddo
tmpqu=tmptot
do ii=1,n
do jj=1,n
tmptot(ii,jj)=0.
do kk=1,n
tmptot(ii,jj) = tmptot(ii,jj) + & ! Q*U*sigma*VT*P
tmpqu(ii,kk)*pt(kk,jj)
enddo
enddo
enddo
tmpa=0.
do ii=1,n
tmpa(ii,ii)=ab(3,ii) ! diag
enddo
do ii=2,n
tmpa(ii-1,ii)=ab(2,ii) ! diag+1
enddo
do ii=3,n
tmpa(ii-2,ii)=ab(1,ii) ! diag+2
enddo
do ii=1,n-1
tmpa(ii+1,ii)=ab(4,ii) ! diag-1
enddo
do ii=1,n-2
tmpa(ii+2,ii)=ab(5,ii) ! diag-2
enddo
print *, 'maxabs delta',maxval(abs(tmptot-tmpa)), maxloc(abs(tmptot-tmpa))
EDIT : add variable declaration :
! Local variables
integer :: i,j,k
integer :: info, info2, code
! From pentadiagonale to bi-diagonale
complex(mytype), dimension(5,n) :: ab ! matrice pentadiagonale
real(mytype), dimension(n) :: d ! diagonale matrice bidiagonale
real(mytype), dimension(n-1) :: e ! diag+1 matrice bidiagonale
complex(mytype), dimension(n,n) :: q ! unitary matrix Q
complex(mytype), dimension(n,n) :: pt ! Unitary matrix P'
complex(mytype) :: dummy_argc
complex(mytype), dimension(n) :: work
real(mytype), dimension(n) :: rwork
! From bi-diagonale to SVD
real(mytype), dimension(n,n) :: u ! Left singular vectors
real(mytype), dimension(n,n) :: vt ! Right singular vectors
real(mytype) :: dummy_argr
real(mytype), dimension(3*n*n+4*n) :: work_big
integer, dimension(8*n) :: iwork
! Temp verif sigma
integer :: ii,jj,kk
complex(mytype), dimension(n,n) :: tmpa, tmpqu, tmptot
Thanks
The routine ZGBBRD modify the input array AB. It should be saved in another array before calling the routine. Looks like it works perfectly using this precaution. Thanks.