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.
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
I'm trying to learn Fortran (unfortunately a necessity for my research group) - one of the tasks I set myself was to package one of the necessary functions (Associated Legendre polynomials) from the Numerical Recipes book into a fortran 03 compliant module. The original program (f77) has some error handling in the form of the following:
if(m.lt.0.or.m.gt.1.or.abs(x).gt.1)pause 'bad arguments in plgndr'
Pause seems to have been deprecated since f77 as using this line gives me a compiling error, so I tried the following:
module sha_helper
implicit none
public :: plgndr, factorial!, ylm
contains
! numerical recipes Associated Legendre Polynomials rewritten for f03
function plgndr(l,m,x) result(res_plgndr)
integer, intent(in) :: l, m
real, intent(in) :: x
real :: res_plgndr, fact, pll, pmm, pmmp1, somx2
integer :: i,ll
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
res_plgndr=-10e6 !return a ridiculous value
else
pmm = 1.
if (m.gt.0) then
somx2 = sqrt((1.-x)*(1.+x))
fact = 1.
do i = 1, m
pmm = -pmm*fact*somx2
fact = fact+2
end do
end if
if (l.eq.m) then
res_plgndr = pmm
else
pmmp1 = x*(2*m+1)*pmm
if(l.eq.m+1) then
res_plgndr = pmmp1
else
do ll = m+2, l
pll = (x*(2*ll-1)*pmmp1-(ll+m-1)*pmm)/(ll-m)
pmm = pmmp1
pmmp1 = pll
end do
res_plgndr = pll
end if
end if
end if
end function plgndr
recursive function factorial(n) result(factorial_result)
integer, intent(in) :: n
integer, parameter :: RegInt_K = selected_int_kind(20) !should be enough for the factorials I am using
integer (kind = RegInt_K) :: factorial_result
if (n <= 0) then
factorial_result = 1
else
factorial_result = n * factorial(n-1)
end if
end function factorial
! function ylm(l,m,theta,phi) result(res_ylm)
! integer, intent(in) :: l, m
! real, intent(in) :: theta, phi
! real :: res_ylm, front_block
! real, parameter :: pi = 3.1415926536
! front_block = sqrt((2*l+1)*factorial(l-abs(m))/(4*pi*))
! end function ylm
end module sha_helper
The main code after the else works, but if I execute my main program and call the function with bad values, the program freezes before executing the print statement. I know that the print statement is the problem, as commenting it out allows the function to execute normally, returning -10e6 as the value. Ideally, I would like the program to crash after giving a user readable error message, as giving bad values to the plgndr function is a fatal error for the program. The function plgndr is being used by the program sha_lmc. Currently all this does is read some arrays and then print a value of plgndr for testing (early days). The function ylm in the module sha_helper is also not finished, hence it is commented out. The code compiles using gfortran sha_helper.f03 sha_lmc.f03 -o sha_lmc, and
gfortran --version
GNU Fortran (GCC) 4.8.2
!Spherical Harmonic Bayesian Analysis testbed for Lagrangian Dynamical Monte Carlo
program sha_analysis
use sha_helper
implicit none
!Analysis Parameters
integer, parameter :: harm_order = 6
integer, parameter :: harm_array_length = (harm_order+1)**2
real, parameter :: coeff_lo = -0.1, coeff_hi = 0.1, data_err = 0.01 !for now, data_err fixed rather than heirarchical
!Monte Carlo Parameters
integer, parameter :: run = 100000, burn = 50000, thin = 100
real, parameter :: L = 1.0, e = 1.0
!Variables needed by the program
integer :: points, r, h, p, counter = 1
real, dimension(:), allocatable :: x, y, z
real, dimension(harm_array_length) :: l_index_list, m_index_list
real, dimension(:,:), allocatable :: g_matrix
!Open the file, allocate the x,y,z arrays and read the file
open(1, file = 'Average_H_M_C_PcP_boschi_1200.xyz', status = 'old')
read(1,*) points
allocate(x(points))
allocate(y(points))
allocate(z(points))
print *, "Number of Points: ", points
readloop: do r = 1, points
read(1,*) x(r), y(r), z(r)
end do readloop
!Set up the forwards model
allocate(g_matrix(harm_array_length,points))
!Generate the l and m values of spherical harmonics
hloop: do h = 0, harm_order
ploop: do p = -h,h
l_index_list(counter) = h
m_index_list(counter) = p
counter = counter + 1
end do ploop
end do hloop
print *, plgndr(1,2,0.1)
!print *, ylm(1,1,0.1,0.1)
end program sha_analysis
Your program does what is known as recursive IO - the initial call to plgndr is in the output item list of an IO statement (a print statement) [directing output to the console] - inside that function you then also attempt to execute another IO statement [that outputs to the console]. This is not permitted - see 9.11p2 and p3 of F2003 or 9.12p2 of F2008.
A solution is to separate the function invocation from the io statement in the main program, i.e.
REAL :: a_temporary
...
a_temporary = plgndr(1,2,0.1)
PRINT *, a_temporary
Other alternatives in F2008 (but not F2003 - hence the [ ] parts in the first paragraph) include directing the output from the function to a different logical unit (note that WRITE (*, ... and PRINT ... reference the same unit).
In F2008 you could also replace the WRITE statement with a STOP statement with a message (the message must be a constant - which wouldn't let you report the problematic values).
The potential for inadvertently invoking recursive IO is part of the reason that some programming styles discourage conducting IO in functions.
Try:
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
stop
else
...
end if
I do not understand why this one is evaluated as false.
A = .false.
B = .true.
(A .eqv. .true. .or. B .eqv. .true.) gives me .false.
I have to add parenthesis to make my conditional statement work. Could anybody explain this to me?
I think it's the order of operations. .or. I think has a higher order of operations than .eqv.
So your statement is equivalent to
((A .eqv. (.true. .or. B)) .eqv. .true.)
((A .eqv. .true. ) .eqv. .true.)
( .false. .eqv. .true.)
.false.
Not sure, though.
Either way, it's easy to force the intended order with parentheses:
((A .eqv. .true.) .or. (B .eqv. .true.))
(Of course, your example can be condensed into (A .or. B), but I guess that wasn't the point ;) )
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
I'm trying to learn Fortran (unfortunately a necessity for my research group) - one of the tasks I set myself was to package one of the necessary functions (Associated Legendre polynomials) from the Numerical Recipes book into a fortran 03 compliant module. The original program (f77) has some error handling in the form of the following:
if(m.lt.0.or.m.gt.1.or.abs(x).gt.1)pause 'bad arguments in plgndr'
Pause seems to have been deprecated since f77 as using this line gives me a compiling error, so I tried the following:
module sha_helper
implicit none
public :: plgndr, factorial!, ylm
contains
! numerical recipes Associated Legendre Polynomials rewritten for f03
function plgndr(l,m,x) result(res_plgndr)
integer, intent(in) :: l, m
real, intent(in) :: x
real :: res_plgndr, fact, pll, pmm, pmmp1, somx2
integer :: i,ll
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
res_plgndr=-10e6 !return a ridiculous value
else
pmm = 1.
if (m.gt.0) then
somx2 = sqrt((1.-x)*(1.+x))
fact = 1.
do i = 1, m
pmm = -pmm*fact*somx2
fact = fact+2
end do
end if
if (l.eq.m) then
res_plgndr = pmm
else
pmmp1 = x*(2*m+1)*pmm
if(l.eq.m+1) then
res_plgndr = pmmp1
else
do ll = m+2, l
pll = (x*(2*ll-1)*pmmp1-(ll+m-1)*pmm)/(ll-m)
pmm = pmmp1
pmmp1 = pll
end do
res_plgndr = pll
end if
end if
end if
end function plgndr
recursive function factorial(n) result(factorial_result)
integer, intent(in) :: n
integer, parameter :: RegInt_K = selected_int_kind(20) !should be enough for the factorials I am using
integer (kind = RegInt_K) :: factorial_result
if (n <= 0) then
factorial_result = 1
else
factorial_result = n * factorial(n-1)
end if
end function factorial
! function ylm(l,m,theta,phi) result(res_ylm)
! integer, intent(in) :: l, m
! real, intent(in) :: theta, phi
! real :: res_ylm, front_block
! real, parameter :: pi = 3.1415926536
! front_block = sqrt((2*l+1)*factorial(l-abs(m))/(4*pi*))
! end function ylm
end module sha_helper
The main code after the else works, but if I execute my main program and call the function with bad values, the program freezes before executing the print statement. I know that the print statement is the problem, as commenting it out allows the function to execute normally, returning -10e6 as the value. Ideally, I would like the program to crash after giving a user readable error message, as giving bad values to the plgndr function is a fatal error for the program. The function plgndr is being used by the program sha_lmc. Currently all this does is read some arrays and then print a value of plgndr for testing (early days). The function ylm in the module sha_helper is also not finished, hence it is commented out. The code compiles using gfortran sha_helper.f03 sha_lmc.f03 -o sha_lmc, and
gfortran --version
GNU Fortran (GCC) 4.8.2
!Spherical Harmonic Bayesian Analysis testbed for Lagrangian Dynamical Monte Carlo
program sha_analysis
use sha_helper
implicit none
!Analysis Parameters
integer, parameter :: harm_order = 6
integer, parameter :: harm_array_length = (harm_order+1)**2
real, parameter :: coeff_lo = -0.1, coeff_hi = 0.1, data_err = 0.01 !for now, data_err fixed rather than heirarchical
!Monte Carlo Parameters
integer, parameter :: run = 100000, burn = 50000, thin = 100
real, parameter :: L = 1.0, e = 1.0
!Variables needed by the program
integer :: points, r, h, p, counter = 1
real, dimension(:), allocatable :: x, y, z
real, dimension(harm_array_length) :: l_index_list, m_index_list
real, dimension(:,:), allocatable :: g_matrix
!Open the file, allocate the x,y,z arrays and read the file
open(1, file = 'Average_H_M_C_PcP_boschi_1200.xyz', status = 'old')
read(1,*) points
allocate(x(points))
allocate(y(points))
allocate(z(points))
print *, "Number of Points: ", points
readloop: do r = 1, points
read(1,*) x(r), y(r), z(r)
end do readloop
!Set up the forwards model
allocate(g_matrix(harm_array_length,points))
!Generate the l and m values of spherical harmonics
hloop: do h = 0, harm_order
ploop: do p = -h,h
l_index_list(counter) = h
m_index_list(counter) = p
counter = counter + 1
end do ploop
end do hloop
print *, plgndr(1,2,0.1)
!print *, ylm(1,1,0.1,0.1)
end program sha_analysis
Your program does what is known as recursive IO - the initial call to plgndr is in the output item list of an IO statement (a print statement) [directing output to the console] - inside that function you then also attempt to execute another IO statement [that outputs to the console]. This is not permitted - see 9.11p2 and p3 of F2003 or 9.12p2 of F2008.
A solution is to separate the function invocation from the io statement in the main program, i.e.
REAL :: a_temporary
...
a_temporary = plgndr(1,2,0.1)
PRINT *, a_temporary
Other alternatives in F2008 (but not F2003 - hence the [ ] parts in the first paragraph) include directing the output from the function to a different logical unit (note that WRITE (*, ... and PRINT ... reference the same unit).
In F2008 you could also replace the WRITE statement with a STOP statement with a message (the message must be a constant - which wouldn't let you report the problematic values).
The potential for inadvertently invoking recursive IO is part of the reason that some programming styles discourage conducting IO in functions.
Try:
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
stop
else
...
end if