Can anyone please explain what is wrong here?
I and M are integers and ZI is IMPLICIT REAL*8
So, I think this is okay the following line:
ZI = DCOS(FLOAT(2*( I - 1) + 1)*3.1415927/FlOAT(2*M))
but I got:
Error: ‘x’ argument of ‘dcos’ intrinsic at (1) must be double precision
Any help is appreciated.
On Sunday, March 20, 2022 at 10:18:29 AM UTC+11, ritchie31 wrote:Thank you for your answer.Sorry, that "I" in FLOAT was lower case L. I did change that.
Can anyone please explain what is wrong here?
I and M are integers and ZI is IMPLICIT REAL*8
So, I think this is okay the following line:
ZI = DCOS(FLOAT(2*( I - 1) + 1)*3.1415927/FlOAT(2*M))
but I got:
Error: ‘x’ argument of ‘dcos’ intrinsic at (1) must be double precision
Any help is appreciated.It's telling you what is wrong. The argument is not double precision.
Your argument is single precision.
As well as that, you have mis-spelled "float" as "fioat".
The kind of ZI is irrelevant.
On Saturday, March 19, 2022 at 4:18:29 PM UTC-7, ritchie31 wrote:It is not accepting that.
Can anyone please explain what is wrong here?
I and M are integers and ZI is IMPLICIT REAL*8
So, I think this is okay the following line:
ZI = DCOS(FLOAT(2*( I - 1) + 1)*3.1415927/FlOAT(2*M))The traditional solution is to use DFLOAT instead of FLOAT.
Error: ‘x’ argument of ‘dcos’ intrinsic at (1) must be double precision
Can anyone please explain what is wrong here?
I and M are integers and ZI is IMPLICIT REAL*8
So, I think this is okay the following line:
ZI = DCOS(FLOAT(2*( I - 1) + 1)*3.1415927/FlOAT(2*M))
Error: ‘x’ argument of ‘dcos’ intrinsic at (1) must be double precision
On Saturday, March 19, 2022 at 8:12:09 PM UTC-7, ritchie31 wrote:Thank you very much!
(snip, I wrote)
The traditional solution is to use DFLOAT instead of FLOAT.
It is not accepting that.In that case, the next to traditional solution is DBLE(FLOAT(I))
I use gfortran.
(And both of those are in the newest standard, so that should work.)
The more modern solution is REAL(I, KIND(1.D0))
On Saturday, March 19, 2022 at 10:26:28 PM UTC-5, gah4 wrote:
On Saturday, March 19, 2022 at 8:12:09 PM UTC-7, ritchie31 wrote:
(snip, I wrote)
The traditional solution is to use DFLOAT instead of FLOAT.
It is not accepting that.In that case, the next to traditional solution is DBLE(FLOAT(I))
I use gfortran.
(And both of those are in the newest standard, so that should work.)
The more modern solution is REAL(I, KIND(1.D0))Thank you very much!
DBLE worked!
Can anyone please explain what is wrong here?
I and M are integers and ZI is IMPLICIT REAL*8
So, I think this is okay the following line:
ZI = DCOS(FLOAT(2*( I - 1) + 1)*3.1415927/FlOAT(2*M))
"ritchie31" wrote in messageI agree with using a double precision calculation of pi. That would fix the problem.
news:4d303cee-275c-4f8a...@googlegroups.com...
On Saturday, March 19, 2022 at 10:26:28 PM UTC-5, gah4 wrote:
On Saturday, March 19, 2022 at 8:12:09 PM UTC-7, ritchie31 wrote:
(snip, I wrote)
The traditional solution is to use DFLOAT instead of FLOAT.
It is not accepting that.In that case, the next to traditional solution is DBLE(FLOAT(I))
I use gfortran.
(And both of those are in the newest standard, so that should work.)
But it's the wrong solution because the inputs aren't double precision. Instead, I propose that you add the declarationThe more modern solution is REAL(I, KIND(1.D0))Thank you very much!
DBLE worked!
DOUBLE PRECISION, PARAMETER:: PI = 4*ATAN(1.0D0)
Then you could use this double precision realization of pi later as
ZI = DCOS((2*( I - 1) + 1)*PI/(2*M))
I agree with using a double precision calculation of pi. That would fix the problem.
For clarity, I would also use double precision rad ; rad = (2*( I - 1) + 1)*PI/(2*M)
There would be no precision loss with or without FLOAT, as 2*(I-1)+1 and 2*m are the same when converted to real or double precision.
Why use DCOS, as COS is generic ?
On Saturday, March 19, 2022 at 8:51:09 PM UTC-5, Robin Vowels wrote:.
On Sunday, March 20, 2022 at 10:18:29 AM UTC+11, ritchie31 wrote:
Can anyone please explain what is wrong here?
I and M are integers and ZI is IMPLICIT REAL*8
So, I think this is okay the following line:
ZI = DCOS(FLOAT(2*( I - 1) + 1)*3.1415927/FlOAT(2*M))
but I got:
Error: ‘x’ argument of ‘dcos’ intrinsic at (1) must be double precision
Any help is appreciated.It's telling you what is wrong. The argument is not double precision.
Your argument is single precision.
As well as that, you have mis-spelled "float" as "fioat".
The kind of ZI is irrelevant.
Thank you for your answer.Sorry, that "I" in FLOAT was lower case L. I did change that..
How can I change my declaration to Double precision?
Do I have to do something different with the integer I?
On Sunday, March 20, 2022 at 7:40:08 PM UTC+11, James Van Buskirk wrote:
"ritchie31" wrote in message
news:4d303cee-275c-4f8a...@googlegroups.com...
On Saturday, March 19, 2022 at 10:26:28 PM UTC-5, gah4 wrote:
On Saturday, March 19, 2022 at 8:12:09 PM UTC-7, ritchie31 wrote:
(snip, I wrote)
The traditional solution is to use DFLOAT instead of FLOAT.
It is not accepting that.In that case, the next to traditional solution is DBLE(FLOAT(I))
I use gfortran.
(And both of those are in the newest standard, so that should work.)
But it's the wrong solution because the inputs aren't double precision. Instead, I propose that you add the declarationThe more modern solution is REAL(I, KIND(1.D0))Thank you very much!
DBLE worked!
DOUBLE PRECISION, PARAMETER:: PI = 4*ATAN(1.0D0)
Then you could use this double precision realization of pi later as
ZI = DCOS((2*( I - 1) + 1)*PI/(2*M))I agree with using a double precision calculation of pi. That would fix the problem.
For clarity, I would also use double precision rad ; rad = (2*( I - 1) + 1)*PI/(2*M)
There would be no precision loss with or without FLOAT, as 2*(I-1)+1 and 2*m are the same when converted to real or double precision.
Why use DCOS, as COS is generic ?
ritchie31 <medi...@gmail.com> schrieb:
Can anyone please explain what is wrong here?
I and M are integers and ZI is IMPLICIT REAL*8
So, I think this is okay the following line:
ZI = DCOS(FLOAT(2*( I - 1) + 1)*3.1415927/FlOAT(2*M))There are a few issues with that line.
It is generally not a good idea to use the specific intrinsic
functions. You can use the generic COS instead, which takes the
type of its argument (which has to be real, of course). This was
introduced in Fortran 77, your code may be older.
If you want to do use double precision, then you should use DBLE.
The constant 3.1415927 is a single precision constant, and has
fewer digits than would be required for double precision accurracy.
You get no benefit from double precision when you use this formula.
Consider
program x
double precision pi, a
pi = atan(1.d0)*4
a = 3.1415927
print *,pi
print *,a
end program x
which yields (with gfortran)
3.1415926535897931
3.1415927410125732
(note that the last digit is off by one, but the number, when
read in, gets the exact binary pattern of pi back)
You should either put in 3.141592741012573D0 as your constant,
or, much better, declare it as a parameter. Modern Fortran
and modern compilers will accept
double precision, parameter :: pi = 4*atan(1.d0)
or, if you prefer older style
DOUBLE PRECISION PI
PARAMETER (PI = 3.141592741012573D0)
or, using the new
DOUBLE PRECISION PI
PARAMETER (PI = 4*ATAN(1.D0))
Several other variants and combinations are also possible
(of course).
On Saturday, March 19, 2022 at 4:18:29 PM UTC-7, ritchie31 wrote:.
Can anyone please explain what is wrong here?
I and M are integers and ZI is IMPLICIT REAL*8
So, I think this is okay the following line:
ZI = DCOS(FLOAT(2*( I - 1) + 1)*3.1415927/FlOAT(2*M))The traditional solution is to use DFLOAT instead of FLOAT.
Error: ‘x’ argument of ‘dcos’ intrinsic at (1) must be double precision
"ritchie31" wrote in message
news:4d303cee-275c-4f8a...@googlegroups.com...
On Saturday, March 19, 2022 at 10:26:28 PM UTC-5, gah4 wrote:
On Saturday, March 19, 2022 at 8:12:09 PM UTC-7, ritchie31 wrote:
(snip, I wrote)
The traditional solution is to use DFLOAT instead of FLOAT.
It is not accepting that.In that case, the next to traditional solution is DBLE(FLOAT(I))
I use gfortran.
(And both of those are in the newest standard, so that should work.)
But it's the wrong solution because the inputs aren't double precision. Instead, I propose that you add the declarationThe more modern solution is REAL(I, KIND(1.D0))Thank you very much!
DBLE worked!
DOUBLE PRECISION, PARAMETER:: PI = 4*ATAN(1.0D0)
Then you could use this double precision realization of pi later as
ZI = DCOS((2*( I - 1) + 1)*PI/(2*M))
scale=50 pi=3.14159265358979323846264338327950288419716939937510582097494459230781640628620899862803482534211706798214808651328230664709
i=3
m=8
c( (2*(i-1)+1)*pi/ (2*m) )
i=30
m=30
c( (2*(i-1)+1)*pi/ (2*m) )
i=2147483647
m=2147483647
c( (2*(i-1)+1)*pi/ (2*m) )
i=2147483647/2+1000
m=2147483647/2+1234
c( (2*(i-1)+1)*pi/ (2*m) )
```
we get
.55557023301960222474283081394853287437493719075480 -.99862953475457387378449205843943658059095229076778 -.99999999999999999973248383642001669587197950999122 -.99999999999976462804957484993760994845013547247662
program show
! using an appropriate kind instead of explicitly using DOUBLE PRECISION integer,parameter :: dp=kind(0.0d0)
! getting a more accurate representation of PI appropriate for the KIND used real(kind=dp),parameter :: PI=4*atan(1.0_dp)
integer :: i,m
real(kind=dp) :: zi, zi_old
i=3
m=8
call printme()
i=30
m=30
call printme()
i=huge(0)
m=huge(0)
call printme()
i=huge(0)/2+1000
m=huge(0)/2+1234
call printme()
contains
subroutine printme()
! convert integers early to prevent overflow
write(*,*)'I=',i,'M=',m
zi = cos( (2*real(i-1,kind=dp)+1)*PI/ (2*real(m,kind=dp)) )
write(*,*)zi
! using generic and simple statement with just PI double precision write(*,*)cos( (2*(i-1)+1)*PI/ (2*m) )
! original except change FLOAT() to DFLOAT()
ZI_old = DCOS(DFLOAT(2*( I - 1) + 1)*3.1415927/DFlOAT(2*M))
write(*,*)zi_old
end subroutine printme
end program show
I= 3 M= 8
0.555570233019602
0.555570233019602
0.555570210304169
I= 30 M= 30
-0.998629534754574
-0.998629534754574
-0.998629539253669
I= 2147483647 M= 2147483647
-1.00000000000000
-1.836970198721030E-016
1.311341700055869E-007
I= 1073742823 M= 1073741828
-0.999999999995767
-0.999999999995767
-0.999999999996017
.55557023301960222474283081394853287437493719075480 -.99862953475457387378449205843943658059095229076778 -.99999999999999999973248383642001669587197950999122 -.99999999999976462804957484993760994845013547247662
real(kind=dp) :: ri, rmSo the summary conclusion seems to be to avoid implicit conversion
ri=i
rm=m
! CONCENSUS ???
program show
! using an appropriate kind instead of explicitly using DOUBLE PRECISION integer,parameter :: dp=kind(0.0d0)
! getting a more accurate representation of PI appropriate for the KIND used real(kind=dp),parameter :: PI=4*atan(1.0_dp)
integer :: i,m
real(kind=dp) :: zi, ri, rm
i=3
m=8
! no implicit type conversions avoids several issues, such as inadvertent
! integer overflow
ri=real(i,kind=dp)
rm=real(m,kind=dp)
zi=cos( (2.0_dp*(ri-1.0_dp)+1.0_dp)*PI/ (2.0_dp*rm) )
end program show
Can anyone please explain what is wrong here?
I and M are integers and ZI is IMPLICIT REAL*8
So, I think this is okay the following line:
ZI = DCOS(FLOAT(2*( I - 1) + 1)*3.1415927/FlOAT(2*M))
but I got:
Error: ‘x’ argument of ‘dcos’ intrinsic at (1) must be double precision
Any help is appreciated.
Regards
So the OP could have just been told to use
zi = cos( (2*(i-1)+1)*4*atan(1.0d0)/ (2*m) )
as long as he does not use large values of I and M but it would not have
been nearly as edifying :>.
So the OP could have just been told to use
zi = cos( (2*(i-1)+1)*4*atan(1.0d0)/ (2*m) )
as long as he does not use large values of I and M but it would not have
been nearly as edifying :>.
In case anyone didn't try it, if you ask "Alexa, what is the tangent of 90 degrees?"
you get 677731.1456.
I didn't actually try to figure out where that came from.
The first thing that routines like COS or TAN do, is to divide by some multiple of pi, maybe pi/2 to find the octant of the angle. There is a
good chance that, even if you use the most accurate pi for the precision
in use, that it isn't the hoped-for exact multiple.
Some languages have degree trigonometric functions which make this
a little easier to get right, when the actual source of the argument isn't
in radians. Multiplying by pi, and then dividing by pi/2, isn't the best
way to make things come out right.
I thought that they were in a more recent version of Fortran, but I don't see them in one that I have available.
program nobody_is_perfect
use, intrinsic :: iso_fortran_env, only : real_kinds,real32,real64,real128 implicit none
write(*,*) tan(2*atan(1.0_real32))
write(*,*) tan(2*atan(1.0_real64))
write(*,*) tan(2*atan(1.0_real128))
block
integer :: lun, i
character(len=:),allocatable :: scratch_(:)
scratch_=[ CHARACTER(LEN=128) :: &
'scale=1002',& 'pi=3.141592653589793238462643383279502884197169399375105820974944592307\',& '81640628620899862803482534211706798214808651328230664709384460955058\',& '22317253594081284811174502841027019385211055596446229489549303819644\',& '28810975665933446128475648233786783165271201909145648566923460348610\',& '45432664821339360726024914127372458700660631558817488152092096282925\',& '40917153643678925903600113305305488204665213841469519415116094330572\',& '70365759591953092186117381932611793105118548074462379962749567351885\',& '75272489122793818301194912983367336244065664308602139494639522473719\',& '07021798609437027705392171762931767523846748184676694051320005681271\',& '45263560827785771342757789609173637178721468440901224953430146549585\',& '37105079227968925892354201995611212902196086403441815981362977477130\',& '99605187072113499999983729780499510597317328160963185950244594553469\',& '08302642522308253344685035261931188171010003137838752886587533208381\',& '42061717766914730359825349042875546873115956286388235378759375195778\',& '18577805321712268066130019278766111959092164201988',&
's(pi/2)/c(pi/2)',&
'']
open(file='_scratch',newunit=lun) write(lun,'(a)')(trim(scratch_(i)),i=1,size(scratch_))
call execute_command_line('bc -l < _scratch')
end block
end program nobody_is_perfect
-2.2877332E+07
1.633123935319537E+016
2.306323558737156172766198381637374E+0034 14492753623188405797101449275362318840579710144927536231884057971014\ 49275362318840579710144927536231884057971014492753623188405797101449\ 27536231884057971014492753623188405797101449275362318840579710144927\ 53623188405797101449275362318840579710144927536231884057971014492753\ 62318840579710144927536231884057971014492753623188405797101449275362\ 31884057971014492753623188405797101449275362318840579710144927536231\ 88405797101449275362318840579710144927536231884057971014492753623188\ 40579710144927536231884057971014492753623188405797101449275362318840\ 57971014492753623188405797101449275362318840579710144927536231884057\ 97101449275362318840579710144927536231884057971014492753623188405797\ 10144927536231884057971014492753623188405797101449275362318840579710\ 14492753623188405797101449275362318840579710144927536231884057971014\ 49275362318840579710144927536231884057971014492753623188405797101449\ 27536231884057971014492753623188405797101449275362318840579710144927\ 5362318840579710144927536231884057971014492753623.188405797101449275\ 36231884057971014492753623188405797101449275362318840579710144927536\ 23188405797101449275362318840579710144927536231884057971014492753623\ 18840579710144927536231884057971014492753623188405797101449275362318\ 84057971014492753623188405797101449275362318840579710144927536231884\ 05797101449275362318840579710144927536231884057971014492753623188405\ 79710144927536231884057971014492753623188405797101449275362318840579\ 71014492753623188405797101449275362318840579710144927536231884057971\ 01449275362318840579710144927536231884057971014492753623188405797101\ 44927536231884057971014492753623188405797101449275362318840579710144\ 92753623188405797101449275362318840579710144927536231884057971014492\ 75362318840579710144927536231884057971014492753623188405797101449275\ 36231884057971014492753623188405797101449275362318840579710144927536\ 23188405797101449275362318840579710144927536231884057971014492753623\ 18840579710144927536231884057971014492753623188405797101449275362318\ 84057971014492753623188405797101
On 3/19/22 6:18 PM, ritchie31 wrote:.
Can anyone please explain what is wrong here?
I and M are integers and ZI is IMPLICIT REAL*8
So, I think this is okay the following line:
ZI = DCOS(FLOAT(2*( I - 1) + 1)*3.1415927/FlOAT(2*M))
but I got:
Error: ‘x’ argument of ‘dcos’ intrinsic at (1) must be double precision
Any help is appreciated.Wow, there is a lot to unpack in that statement, and many of the
Regards
suggestions in this thread are off mark.
First, it does not matter what is the type or kind of ZI. The expression
on the right is evaluated as it stands regardless.
Second, you almost certainly should not be using specific intrinsic functions such as DCOS, FLOAT, DFLOAT, DBLE,
and so on as many have
suggested. There are times to use those kinds of functions, when
purposely doing mixed-precision arithmetic, but your application is
probably not one of those.
So how should this be written if you want to have simple and robust
code? First, the value of PI in the expression above is single
precision. That is, it is the default real kind. If you want extended precision, then you should either declare the constant appropriately or
you should specify the appropriate kind of the literal constant and add
in the missing digits. Let's do it like this, not because this is
inherently better than other approaches, but because no one else has suggested this yet.
integer, parameter :: wp = selected_real_kind(14)
REAL(WP), PARAMETER:: PI = 4 * ATAN(1.0_wp)
The wp parameter is appropriate for double precision on many machines,
but that is a way to specify the minimum precision independently of what your compiler thinks is the default. That is more or less the modern standard equivalent to REAL*8. You could also declare things like
integer, parameter :: wp = kind(1.0d0)
to force the working precision to be what your compiler thinks is double precision. Or, you could declare it as
integer, parameter :: wp = kind(ZI)
where ZI has been declared elsewhere, maybe in a module, but you might
not know what it is, you just know that you want to be consistent with
that kind. With the appropriate kind defined, you could also specify the literal constant as, for example,
3.1415926535897931_wp
either in a parameter definition or in the original expression itself. I don't really recommend that latter option, but if you wanted to do that,.
it would at least be better than specifying the literal constant to have
the incorrect kind.
In any case, once PI is defined to be of the correct type and kind for
the expression you want to evaluate, and to have the correct value for
that kind. Then you can evaluate the expression as
ZI = COS( (2*( I - 1) + 1) * PI / (2*M))
The COS intrinsic is generic, so it evaluates its result to be.
consistent with whatever its argument is. What is that? Fortran has well defined rules for evaluating expressions of mixed type. In that
expression, the (2*(I-1)+1) will be evaluated as an integer expression because it is enclosed in parentheses. The kind will be KIND(I), which
is probably whatever the compiler thinks is the default integer kind. If
the values don't get too big, that will be fine. If they get up around
10**9 or so, then you might need to worry about integer overflow, which
is usually silent at runtime, so you should beware of that. Similarly,
the (2*M) part of the expression is also evaluated as an integer
expression of KIND(M).
Without further knowledge of the declarations,.
that is all that we can say about the integer factors in the expression.
If I or M are nondefault kind, say they are 64-bit integers, then the expressions will be evaluated with the higher precision of that kind or
the default kind. That is, either the value of I will be converted to
the default kind, or the default kind values of 2 and 1 will be
converted to the declared kind of I or M. The language gives you control over those conversions if you don't want the default behavior. The
advantage of avoiding the specific intrinsic functions is that in the
future if the kind values need to change, say because some compiler has different defaults, then you only need to change the wp parameter declaration to get the correct results, you don't need to go back into
the code and change each occurrence in each expression of a
kind-specific intrinsic function. If you take care and write your code
the right way, then that wp parameter can be changed in a single place,
and that change will propagate throughout your entire program with no further manual changes.
Then an expression equivalent to
K*PI/L
is evaluated, where K and L are the values of those integer expressions
of their appropriate kinds. The compiler is free to evaluate that in
either of two ways, (K*PI)/L or as K*(PI/L). In the first case, the
value of K is converted to a real value with the same kind as PI, the multiplication is done with that precision. Then the value of L is
converted to real with kind(PI) and the final division is performed. The other option is to convert L first, then divide, then convert K, and
then multiply the result. There usually isn't any need to specify which
of those are chosen, so you can let the compiler decide. It might be
able to optimize those operations a little by reusing a register value,
or perhaps by reusing a previous conversion from a nearby statement. You
may not get the same value for those two expressions, but they should be
the same except possibly for the last bit or two, which is really all
you can expect from floating point arithmetic.
Some programmers like to specify type conversions explicitly.
Particularly those using other languages with different implicit
conversion semantics. In that case, then one might write the original expression as something like
ZI = COS( REAL(2*(I-1)+1,KIND=wp) * PI / REAL(2*M,KIND=wp) )
Others prefer the shorter version. The important point though is that
this longer expression evaluation does not require any more effort than
the shorter expression, it will compile to exactly the same
instructions. It is just specifying explicitly what the compiler is
required already to do implicitly.
In any case, you then have the real argument evaluated without
significant loss of precision for the COS() evaluation. COS is generic,
so it takes whatever KIND it argument has, and evaluates the result in
that precision. At this point, if PI has been declared incorrectly, or
if it had been specified with the wrong kind as in the original code,
then it would produce results with that wrong precision. But if PI has
been declared correctly, then it will be evaluated with the correct precision, no less and no more.
After COS() is evaluated, then the value is assigned to the ZI variable.
If your declarations were consistent, then that assignment is just a register to memory copy. If they were inconsistent, then the computed
value must be further converted to the correct real kind. Fortran does
all that conversion work for you by default. If you want the conversions
to be done differently, then you can use INT() and REAL() intrinsic functions to make all of it explicit, and you can add additional
parentheses to force specific orders of evaluation of the subexpressions.
so to summarize, using an arbitrary precision calculation from the
GNU/Linux version of bc(1) and some somewhat arbitrary I and M values to
get a few reference values:
scale=50 pi=3.14159265358979323846264338327950288419716939937510582097494459230781640628620899862803482534211706798214808651328230664709
i=3
m=8
c( (2*(i-1)+1)*pi/ (2*m) )
i=30
m=30
c( (2*(i-1)+1)*pi/ (2*m) )
i=2147483647
m=2147483647
c( (2*(i-1)+1)*pi/ (2*m) )
i=2147483647/2+1000
m=2147483647/2+1234
c( (2*(i-1)+1)*pi/ (2*m) )
```
we get
.55557023301960222474283081394853287437493719075480 -.99862953475457387378449205843943658059095229076778 -.99999999999999999973248383642001669587197950999122 -.99999999999976462804957484993760994845013547247662
And then compare the original with a minimal change from FLOAT to DFLOAT
to the simplest generic syntax and a statement corrected to explicitly
handle all type conversions to double precision we get
program show
! using an appropriate kind instead of explicitly using DOUBLE PRECISION integer,parameter :: dp=kind(0.0d0)
! getting a more accurate representation of PI appropriate for the KIND used
real(kind=dp),parameter :: PI=4*atan(1.0_dp)
integer :: i,m
real(kind=dp) :: zi, zi_old
i=3
m=8
call printme()
i=30
m=30
call printme()
i=huge(0)
m=huge(0)
call printme()
i=huge(0)/2+1000
m=huge(0)/2+1234
call printme()
contains
subroutine printme()
! convert integers early to prevent overflow
write(*,*)'I=',i,'M=',m
zi = cos( (2*real(i-1,kind=dp)+1)*PI/ (2*real(m,kind=dp)) )
write(*,*)zi
! using generic and simple statement with just PI double precision write(*,*)cos( (2*(i-1)+1)*PI/ (2*m) )
! original except change FLOAT() to DFLOAT()
ZI_old = DCOS(DFLOAT(2*( I - 1) + 1)*3.1415927/DFlOAT(2*M)) write(*,*)zi_old
end subroutine printme
end program show
.I= 3 M= 8
0.555570233019602
0.555570233019602
0.555570210304169
I= 30 M= 30
-0.998629534754574
-0.998629534754574
-0.998629539253669
I= 2147483647 M= 2147483647
-1.00000000000000
-1.836970198721030E-016
1.311341700055869E-007
I= 1073742823 M= 1073741828
-0.999999999995767
-0.999999999995767
-0.999999999996017
compared to the "reference" values
.55557023301960222474283081394853287437493719075480 -.99862953475457387378449205843943658059095229076778 -.99999999999999999973248383642001669587197950999122 -.99999999999976462804957484993760994845013547247662
So a simple statement using generics (that happens to cause automatic promotion) can get good answers over a wide range of input values
and is much more readable; but to harden the routine over the entire
range of values for integer inputs and to not use "hidden" conversions
it is best to not depend on automatic promotion of variables as all,
possibly introducing new variables to make it more readable, such as
real(kind=dp) :: ri, rmSo the summary conclusion seems to be to avoid implicit conversion
ri=i
rm=m
entirely? There are times where integers make it much more explicit
that the compiler can optimize certain calculations, I would say.
! CONCENSUS ???
program show
! using an appropriate kind instead of explicitly using DOUBLE PRECISION integer,parameter :: dp=kind(0.0d0)
! getting a more accurate representation of PI appropriate for the KIND used
real(kind=dp),parameter :: PI=4*atan(1.0_dp)
integer :: i,m
real(kind=dp) :: zi, ri, rm
i=3
m=8
! no implicit type conversions avoids several issues, such as inadvertent
! integer overflow
ri=real(i,kind=dp)
rm=real(m,kind=dp)
zi=cos( (2.0_dp*(ri-1.0_dp)+1.0_dp)*PI/ (2.0_dp*rm) )
end program show
So the OP could have just been told to use.
zi = cos( (2*(i-1)+1)*4*atan(1.0d0)/ (2*m) )
as long as he does not use large values of I and M but it would not have
been nearly as edifying :>.
On Monday, March 21, 2022 at 4:46:01 AM UTC+11, John wrote:
so to summarize, using an arbitrary precision calculation from the GNU/Linux version of bc(1) and some somewhat arbitrary I and M values to get a few reference values:
scale=50 pi=3.14159265358979323846264338327950288419716939937510582097494459230781640628620899862803482534211706798214808651328230664709
i=3
m=8
c( (2*(i-1)+1)*pi/ (2*m) )
i=30
m=30
c( (2*(i-1)+1)*pi/ (2*m) )
i=2147483647
m=2147483647
c( (2*(i-1)+1)*pi/ (2*m) )
i=2147483647/2+1000
m=2147483647/2+1234
c( (2*(i-1)+1)*pi/ (2*m) )
```
we get
.55557023301960222474283081394853287437493719075480 -.99862953475457387378449205843943658059095229076778 -.99999999999999999973248383642001669587197950999122 -.99999999999976462804957484993760994845013547247662
And then compare the original with a minimal change from FLOAT to DFLOAT
to the simplest generic syntax and a statement corrected to explicitly handle all type conversions to double precision we get
program show
! using an appropriate kind instead of explicitly using DOUBLE PRECISION integer,parameter :: dp=kind(0.0d0)
! getting a more accurate representation of PI appropriate for the KIND used
real(kind=dp),parameter :: PI=4*atan(1.0_dp)
integer :: i,m
real(kind=dp) :: zi, zi_old
i=3
m=8
call printme()
i=30
m=30
call printme()
i=huge(0)
m=huge(0)
call printme()
i=huge(0)/2+1000
m=huge(0)/2+1234
call printme()
contains
subroutine printme()
! convert integers early to prevent overflow
write(*,*)'I=',i,'M=',m
zi = cos( (2*real(i-1,kind=dp)+1)*PI/ (2*real(m,kind=dp)) )
write(*,*)zi
! using generic and simple statement with just PI double precision write(*,*)cos( (2*(i-1)+1)*PI/ (2*m) )
! original except change FLOAT() to DFLOAT()
ZI_old = DCOS(DFLOAT(2*( I - 1) + 1)*3.1415927/DFlOAT(2*M)) write(*,*)zi_old
end subroutine printme
end program show
Perhaps I should have marked them with a comment, but comparing the reference values to the results.I= 3 M= 8
0.555570233019602
0.555570233019602
0.555570210304169
I= 30 M= 30
-0.998629534754574
-0.998629534754574
-0.998629539253669
I= 2147483647 M= 2147483647
-1.00000000000000
integer overflow occurs here, attempting to evaluate 2*(i-1) or 2*M,
and no further values are printed.
Try turning on checks for integer overflow.
-1.836970198721030E-016
1.311341700055869E-007
I= 1073742823 M= 1073741828
-0.999999999995767
-0.999999999995767
-0.999999999996017
compared to the "reference" values
.55557023301960222474283081394853287437493719075480 -.99862953475457387378449205843943658059095229076778 -.99999999999999999973248383642001669587197950999122 -.99999999999976462804957484993760994845013547247662
So a simple statement using generics (that happens to cause automatic promotion) can get good answers over a wide range of input values
and is much more readable; but to harden the routine over the entire
range of values for integer inputs and to not use "hidden" conversions
it is best to not depend on automatic promotion of variables as all, possibly introducing new variables to make it more readable, such as
real(kind=dp) :: ri, rmSo the summary conclusion seems to be to avoid implicit conversion entirely? There are times where integers make it much more explicit
ri=i
rm=m
that the compiler can optimize certain calculations, I would say.
! CONCENSUS ???
program show
! using an appropriate kind instead of explicitly using DOUBLE PRECISION integer,parameter :: dp=kind(0.0d0)
! getting a more accurate representation of PI appropriate for the KIND used
real(kind=dp),parameter :: PI=4*atan(1.0_dp)
integer :: i,m
real(kind=dp) :: zi, ri, rm
i=3
m=8
! no implicit type conversions avoids several issues, such as inadvertent ! integer overflow
ri=real(i,kind=dp)
rm=real(m,kind=dp)
zi=cos( (2.0_dp*(ri-1.0_dp)+1.0_dp)*PI/ (2.0_dp*rm) )
end program show
In case anyone didn't try it, if you ask "Alexa, what is the tangent of 90 degrees?"
you get 677731.1456.
I didn't actually try to figure out where that came from.
The first thing that routines like COS or TAN do, is to divide by some multiple of pi, maybe pi/2 to find the octant of the angle. There is a
good chance that, even if you use the most accurate pi for the precision
in use, that it isn't the hoped-for exact multiple.
Some languages have degree trigonometric functions which make this
a little easier to get right, when the actual source of the argument isn't
in radians.
Can anyone please explain what is wrong here?
I and M are integers and ZI is IMPLICIT REAL*8
So, I think this is okay the following line:
ZI = DCOS(FLOAT(2*( I - 1) + 1)*3.1415927/FlOAT(2*M))
but I got:
Error: ‘x’ argument of ‘dcos’ intrinsic at (1) must be double precision
Any help is appreciated.
Regards
Some languages have degree trigonometric functions which make this
a little easier to get right, when the actual source of the argument isn't in radians.
Fortran 202x will contain the functions ACOSD, ASIND, ATAND,
ATAN2D, COSD, SIND, and TAND.
On Sunday, March 20, 2022 at 11:38:30 PM UTC-7, Thomas Koenig wrote:Only 35 years late to my need :)
(snip, I wrote)
Some languages have degree trigonometric functions which make this
a little easier to get right, when the actual source of the argument isn't >>> in radians.
Fortran 202x will contain the functions ACOSD, ASIND, ATAND,
ATAN2D, COSD, SIND, and TAND.
I thought I was remembering that, but couldn't remember which one.
gah4 <ga...@u.washington.edu> schrieb:.
In case anyone didn't try it, if you ask "Alexa, what is the tangent of 90 degrees?"
you get 677731.1456.
I didn't actually try to figure out where that came from.
The first thing that routines like COS or TAN do, is to divide by some multiple of pi, maybe pi/2 to find the octant of the angle. There is a
good chance that, even if you use the most accurate pi for the precision
in use, that it isn't the hoped-for exact multiple.
Some languages have degree trigonometric functions which make thisFortran 202x will contain the functions ACOSD, ASIND, ATAND,
a little easier to get right, when the actual source of the argument isn't in radians.
ATAN2D, COSD, SIND, and TAND.
As regards tand(90.0) gfortran and ifortran do get that "right", but nvfortran does not;
with versions that have it, so I am not quite being fair; but I really do not test most intrinsics
near their edges, having learned that the hard way long ago.
On Mon, 21 Mar 2022 16:41:33 -0000 (UTC)
steve kargl <sgk@REMOVEtroutmask.apl.washington.edu> wrote:
If you find a corner case with sind(), cosd(), or tand() in gfortran,
please file a bug report.
% head -3 gcc/libgfortran/intrinsics/trigd.c
/* Implementation of the degree trignometric functions COSD, SIND, TAND.
Copyright (C) 2020-2022 Free Software Foundation, Inc.
Contributed by Steven G. Kargl <kargl@gcc.gnu.org>
Well , "trignometric" is a typo.
If you find a corner case with sind(), cosd(), or tand() in gfortran,
please file a bug report.
% head -3 gcc/libgfortran/intrinsics/trigd.c
/* Implementation of the degree trignometric functions COSD, SIND, TAND.
Copyright (C) 2020-2022 Free Software Foundation, Inc.
Contributed by Steven G. Kargl <kargl@gcc.gnu.org>
Le samedi 19 mars 2022 à 23:18:29 UTC, ritchie31 a écrit :
Can anyone please explain what is wrong here?
I and M are integers and ZI is IMPLICIT REAL*8
So, I think this is okay the following line:
ZI = DCOS(FLOAT(2*( I - 1) + 1)*3.1415927/FlOAT(2*M))
but I got:
Error: ‘x’ argument of ‘dcos’ intrinsic at (1) must be double precision
Any help is appreciated.
Regards
The angle
"FLOAT(2*( I - 1) + 1)*3.1415927/FlOAT(2*M)"
is heavy in superfluous function calls and operations. It can be simplified as
"(I - 0.5D0)*PI/M"
where PI = 4D0*ATAN(1D0)
has been calculated as a parameter as explained in other posts.
On 3/21/22 6:08 AM, DP wrote:
Le samedi 19 mars 2022 à 23:18:29 UTC, ritchie31 a écrit :
Can anyone please explain what is wrong here?
I and M are integers and ZI is IMPLICIT REAL*8
So, I think this is okay the following line:
ZI = DCOS(FLOAT(2*( I - 1) + 1)*3.1415927/FlOAT(2*M))
but I got:
Error: ‘x’ argument of ‘dcos’ intrinsic at (1) must be double precision
Any help is appreciated.
Regards
The angle
"FLOAT(2*( I - 1) + 1)*3.1415927/FlOAT(2*M)"
is heavy in superfluous function calls and operations. It can be simplified as
"(I - 0.5D0)*PI/M"
where PI = 4D0*ATAN(1D0)
has been calculated as a parameter as explained in other posts.This looks like a good way to rewrite the expression. This eliminates
any possibility of integer overflow during the evaluation of the
expression, and also eliminates the extra arithmetic operations.
As in my previous comment, I would recommend using a kind parameter,
such as wp, to specify the kinds rather than hardwiring them to double precision. REAL*8 usually does mean double precision, but I have used several computers with long words that mapped REAL*8 to single
precision, and also many compilers allow changing the default kinds with options. The fortran KIND approach eliminates all of that ambiguity in
the source code. So with those comments in mind, I might suggest the expression
(I - 0.5_wp) * PI / M
where PI has already been declared to have the wp KIND. This results in consistent conversions of types using the standard fortran semantics. If
you want to make the conversions explicit, then
(real(I,kind=wp) - 0.5_wp) * PI / real(M,kind=wp)
This longer expression should compile to exactly the same instructions because it is doing exactly the same conversions as required by the
default semantics.
Sysop: | Keyop |
---|---|
Location: | Huddersfield, West Yorkshire, UK |
Users: | 159 |
Nodes: | 16 (0 / 16) |
Uptime: | 98:21:49 |
Calls: | 3,209 |
Files: | 10,563 |
Messages: | 3,009,579 |