All,
Attached is a patch extending the GNU Fortran front-end to support
some additional math intrinsics, enabled with a new compile flag
-fdec-math. The flag adds the COTAN intrinsic (cotangent), as well as
degree versions of all trigonometric intrinsics (SIND, TAND, ACOSD,
etc...). This extension allows for further compatibility with legacy
code that depends on the compiler to support such intrinsic functions.
I would definitely like some peer review on this patch to ensure my
implementation has no unintended mathematical side-effects, such as
rounding errors, or oversights with complex math: I implement the
degree-valued functions by simply converting the argument or result to
degrees/radians as appropriate by multiplying by the factor pi/180 (or
180/pi). In the constant case this is done using mpfr/mpc, and in the
non-constant case the factor multiplication expression is just
inserted into the expression tree where appropriate. The new COTAN
intrinsic is implemented using mpfr_cot in the constant case, and by
replacing the call with a 1/tan expression in the non-constant case
(and in the complex case, since there is no mpc_cot). See the new
functions in simplify.c/iresolve.c for specifics.
I also added a new macro MATH_ALIAS_BUILTIN used in mathbuiltins.def
to define the new COTAN intrinsic. This macro defines a new isym, but
keeps everything else defined normally by DEFINE_MATH_BUILTIN the same
as an existing isym (TAN in this case). The reason for this is to
avoid having to define a new BUILT_IN_COTAN in gcc/builtins.def (or
any other context). As I described above, the simplify/resolve code
for COTAN just wraps TAN. I am not 100% convinced this is the "right"
or "best" way to do this - so feel free to me know if there are any
problems with this approach.
By the way, I don't use intrinsic.c (make_alias) for these because
they need their own simplification/resolution routines to handle the
degree-radian conversion.
As usual the patched compiler bootstraps and regtests on
x86_64-redhat-linux. Questions, comments and concerns are very
welcome. Barring any, is this OK for trunk?
---
Fritz Reese
2016-09-26 Fritz Reese <fritzore...@gmail.com>
New flag -fdec-math for COTAN and degree trig intrinsics.
gcc/fortran/
* lang.opt: New flag -fdec-math.
* options.c (set_dec_flags): Enable with -fdec.
* invoke.texi, gfortran.texi, intrinsic.texi: Update documentation.
* trans-intrinsic.c (MATH_ALIAS_BUILTLIN): New macro for math aliases.
* f95-lang.c (MATH_ALIAS_BUILTIN): New macro for math aliases.
* mathbuiltins.def (MATH_ALIAS_BUILTIN): Use for cotan.
* intrinsics.c (add_functions, do_simplify): New intrinsics
with -fdec-math.
* gfortran.h (gfc_isym_id): New isym GFC_ISYM_COTAN.
* gfortran.h (gfc_resolve_atan2d, gfc_resolve_cotan,
gfc_resolve_trigd, gfc_resolve_atrigd): New prototypes.
* iresolve.c (resolve_trig_call, get_degrees, get_radians,
is_trig_resolved, gfc_resolve_cotan, gfc_resolve_trigd,
gfc_resolve_atrigd, gfc_resolve_atan2d): New functions.
* intrinsics.h (gfc_simplify_atan2d, gfc_simplify_atrigd,
gfc_simplify_cotan, gfc_simplify_trigd): New prototypes.
* simplify.c (simplify_trig_call, degrees_f, radians_f,
gfc_simplify_cotan, gfc_simplify_trigd, gfc_simplify_atrigd,
gfc_simplify_atan2d): New functions.
gcc/testsuite/gfortran.dg/
* dec_math.f90: New testsuite.
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 2b58173..7229d8d 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -559,6 +559,8 @@ gfc_define_builtin (const char *name, tree type, enum built_in_function code,
DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
+/* Defined in trans-intrinsic.c. */
+#define MATH_ALIAS_BUILTIN(newid, id, name, type)
/* Create function types for builtin functions. */
@@ -1244,6 +1246,7 @@ gfc_init_builtin_functions (void)
targetm.init_builtins ();
}
+#undef MATH_ALIAS_BUILTIN
#undef DEFINE_MATH_BUILTIN_C
#undef DEFINE_MATH_BUILTIN
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index d6b92a6..f8f3d4a 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -391,6 +391,7 @@ enum gfc_isym_id
GFC_ISYM_CONVERSION,
GFC_ISYM_COS,
GFC_ISYM_COSH,
+ GFC_ISYM_COTAN,
GFC_ISYM_COUNT,
GFC_ISYM_CPU_TIME,
GFC_ISYM_CSHIFT,
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 3ebe3c7..4f8d2d6 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1466,6 +1466,7 @@ without warning.
* Form feed as whitespace::
* TYPE as an alias for PRINT::
* %LOC as an rvalue::
+* Extended math intrinsics::
@end menu
@node Old-style kind specifications
@@ -2519,6 +2520,33 @@ integer :: i
call sub(%loc(i))
@end smallexample
+@node Extended math intrinsics
+@subsection Extended math intrinsics
+@cindex intrinsics, math
+@cindex intrinsics, trigonometric functions
+
+GNU Fortran supports an extended list of mathematical intrinsics with the
+compile flag @option{-fdec-math}. These intrinsics are described fully in
+@ref{Intrinsic Procedures} where it is noted that they are extensions.
+
+Specifically, @option{-fdec-math} enables the @ref{COTAN} intrinsic, and
+trigonometric intrinsics which accept or produce values in degrees instead of
+radians. Here is a summary of the new intrinsics:
+
+@multitable @columnfractions .5 .5
+@headitem Radians @tab Degrees
+@item @code{@ref{ACOS}} @tab @code{@ref{ACOSD}}*
+@item @code{@ref{ASIN}} @tab @code{@ref{ASIND}}*
+@item @code{@ref{ATAN}} @tab @code{@ref{ATAND}}*
+@item @code{@ref{ATAN2}} @tab @code{@ref{ATAN2D}}*
+@item @code{@ref{COS}} @tab @code{@ref{COSD}}*
+@item @code{@ref{COTAN}}* @tab @code{@ref{COTAND}}*
+@item @code{@ref{SIN}} @tab @code{@ref{SIND}}*
+@item @code{@ref{TAN}} @tab @code{@ref{TAND}}*
+@end multitable
+
+* Enabled with @option{-fdec-math}.
+
@node Extensions not implemented in GNU Fortran
@section Extensions not implemented in GNU Fortran
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index cad54b8..fdc11d8 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -3139,6 +3139,117 @@ add_functions (void)
make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
+ if (flag_dec_math)
+ {
+ add_sym_1 ("acosd", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dr, GFC_STD_GNU,
+ gfc_check_fn_r, gfc_simplify_atrigd, gfc_resolve_atrigd,
+ x, BT_REAL, dr, REQUIRED);
+
+ add_sym_1 ("dacosd", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dd, GFC_STD_GNU,
+ gfc_check_fn_d, gfc_simplify_atrigd, gfc_resolve_atrigd,
+ x, BT_REAL, dd, REQUIRED);
+
+ make_generic ("acosd", GFC_ISYM_ACOS, GFC_STD_GNU);
+
+ add_sym_1 ("asind", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dr, GFC_STD_GNU,
+ gfc_check_fn_r, gfc_simplify_atrigd, gfc_resolve_atrigd,
+ x, BT_REAL, dr, REQUIRED);
+
+ add_sym_1 ("dasind", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dd, GFC_STD_GNU,
+ gfc_check_fn_d, gfc_simplify_atrigd, gfc_resolve_atrigd,
+ x, BT_REAL, dd, REQUIRED);
+
+ make_generic ("asind", GFC_ISYM_ASIN, GFC_STD_GNU);
+
+ add_sym_1 ("atand", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dr, GFC_STD_GNU,
+ gfc_check_fn_r, gfc_simplify_atrigd, gfc_resolve_atrigd,
+ x, BT_REAL, dr, REQUIRED);
+
+ add_sym_1 ("datand", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dd, GFC_STD_GNU,
+ gfc_check_fn_d, gfc_simplify_atrigd, gfc_resolve_atrigd,
+ x, BT_REAL, dd, REQUIRED);
+
+ make_generic ("atand", GFC_ISYM_ATAN, GFC_STD_GNU);
+
+ add_sym_2 ("atan2d",GFC_ISYM_ATAN2,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dr, GFC_STD_GNU,
+ gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_atan2d,
+ y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
+
+ add_sym_2 ("datan2d",GFC_ISYM_ATAN2,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dd, GFC_STD_GNU,
+ gfc_check_datan2, gfc_simplify_atan2d, gfc_resolve_atan2d,
+ y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
+
+ make_generic ("atan2d", GFC_ISYM_ATAN2, GFC_STD_GNU);
+
+ add_sym_1 ("cosd", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dr, GFC_STD_GNU,
+ gfc_check_fn_r, gfc_simplify_trigd, gfc_resolve_trigd,
+ x, BT_REAL, dr, REQUIRED);
+
+ add_sym_1 ("dcosd", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dd, GFC_STD_GNU,
+ gfc_check_fn_d, gfc_simplify_trigd, gfc_resolve_trigd,
+ x, BT_REAL, dd, REQUIRED);
+
+ make_generic ("cosd", GFC_ISYM_COS, GFC_STD_GNU);
+
+ add_sym_1 ("cotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dr, GFC_STD_GNU,
+ gfc_check_fn_rc2008, gfc_simplify_cotan, gfc_resolve_cotan,
+ x, BT_REAL, dr, REQUIRED);
+
+ add_sym_1 ("dcotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dd, GFC_STD_GNU,
+ gfc_check_fn_d, gfc_simplify_cotan, gfc_resolve_cotan,
+ x, BT_REAL, dd, REQUIRED);
+
+ make_generic ("cotan", GFC_ISYM_COTAN, GFC_STD_GNU);
+
+ add_sym_1 ("cotand", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dr, GFC_STD_GNU,
+ gfc_check_fn_r, gfc_simplify_trigd, gfc_resolve_trigd,
+ x, BT_REAL, dr, REQUIRED);
+
+ add_sym_1 ("dcotand",GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dd, GFC_STD_GNU,
+ gfc_check_fn_d, gfc_simplify_trigd, gfc_resolve_trigd,
+ x, BT_REAL, dd, REQUIRED);
+
+ make_generic ("cotand", GFC_ISYM_COTAN, GFC_STD_GNU);
+
+ add_sym_1 ("sind", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dr, GFC_STD_GNU,
+ gfc_check_fn_r, gfc_simplify_trigd, gfc_resolve_trigd,
+ x, BT_REAL, dr, REQUIRED);
+
+ add_sym_1 ("dsind", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dd, GFC_STD_GNU,
+ gfc_check_fn_d, gfc_simplify_trigd, gfc_resolve_trigd,
+ x, BT_REAL, dd, REQUIRED);
+
+ make_generic ("sind", GFC_ISYM_SIN, GFC_STD_GNU);
+
+ add_sym_1 ("tand", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dr, GFC_STD_GNU,
+ gfc_check_fn_r, gfc_simplify_trigd, gfc_resolve_trigd,
+ x, BT_REAL, dr, REQUIRED);
+
+ add_sym_1 ("dtand", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
+ dd, GFC_STD_GNU,
+ gfc_check_fn_d, gfc_simplify_trigd, gfc_resolve_trigd,
+ x, BT_REAL, dd, REQUIRED);
+
+ make_generic ("tand", GFC_ISYM_TAN, GFC_STD_GNU);
+ }
+
/* The following function is internally used for coarray libray functions.
"make_from_module" makes it inaccessible for external users. */
add_sym_1 (GFC_PREFIX ("caf_get"), GFC_ISYM_CAF_GET, CLASS_IMPURE, ACTUAL_NO,
@@ -4227,6 +4338,15 @@ do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
goto finish;
}
+ /* Some math intrinsics need to wrap the original expression. */
+ if (specific->simplify.f1 == gfc_simplify_trigd
+ || specific->simplify.f1 == gfc_simplify_atrigd
+ || specific->simplify.f1 == gfc_simplify_cotan)
+ {
+ result = (*specific->simplify.f1) (e);
+ goto finish;
+ }
+
if (specific->simplify.f1 == NULL)
{
result = NULL;
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index f228976..8bba6e0 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -238,6 +238,7 @@ gfc_expr *gfc_simplify_adjustr (gfc_expr *);
gfc_expr *gfc_simplify_aimag (gfc_expr *);
gfc_expr *gfc_simplify_aint (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_all (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_atrigd (gfc_expr *);
gfc_expr *gfc_simplify_dint (gfc_expr *);
gfc_expr *gfc_simplify_anint (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_dnint (gfc_expr *);
@@ -248,6 +249,7 @@ gfc_expr *gfc_simplify_asinh (gfc_expr *);
gfc_expr *gfc_simplify_atan (gfc_expr *);
gfc_expr *gfc_simplify_atanh (gfc_expr *);
gfc_expr *gfc_simplify_atan2 (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_atan2d (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_bessel_j0 (gfc_expr *);
gfc_expr *gfc_simplify_bessel_j1 (gfc_expr *);
gfc_expr *gfc_simplify_bessel_jn (gfc_expr *, gfc_expr *);
@@ -271,6 +273,7 @@ gfc_expr *gfc_simplify_complex (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_conjg (gfc_expr *);
gfc_expr *gfc_simplify_cos (gfc_expr *);
gfc_expr *gfc_simplify_cosh (gfc_expr *);
+gfc_expr *gfc_simplify_cotan (gfc_expr *);
gfc_expr *gfc_simplify_count (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_cshift (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_dcmplx (gfc_expr *, gfc_expr *);
@@ -401,6 +404,7 @@ gfc_expr *gfc_simplify_tiny (gfc_expr *);
gfc_expr *gfc_simplify_trailz (gfc_expr *);
gfc_expr *gfc_simplify_transfer (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_transpose (gfc_expr *);
+gfc_expr *gfc_simplify_trigd (gfc_expr *);
gfc_expr *gfc_simplify_trim (gfc_expr *);
gfc_expr *gfc_simplify_ubound (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_ucobound (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -434,6 +438,7 @@ void gfc_resolve_asinh (gfc_expr *, gfc_expr *);
void gfc_resolve_atan (gfc_expr *, gfc_expr *);
void gfc_resolve_atanh (gfc_expr *, gfc_expr *);
void gfc_resolve_atan2 (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_atan2d (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_atomic_def (gfc_code *);
void gfc_resolve_atomic_ref (gfc_code *);
void gfc_resolve_besn (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -452,6 +457,7 @@ void gfc_resolve_conjg (gfc_expr *, gfc_expr *);
void gfc_resolve_cos (gfc_expr *, gfc_expr *);
void gfc_resolve_cosh (gfc_expr *, gfc_expr *);
void gfc_resolve_count (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_cotan (gfc_expr *, gfc_expr *);
void gfc_resolve_cshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ctime (gfc_expr *, gfc_expr *);
void gfc_resolve_dble (gfc_expr *, gfc_expr *);
@@ -582,6 +588,8 @@ void gfc_resolve_time (gfc_expr *);
void gfc_resolve_time8 (gfc_expr *);
void gfc_resolve_transfer (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_transpose (gfc_expr *, gfc_expr *);
+void gfc_resolve_trigd (gfc_expr *, gfc_expr *);
+void gfc_resolve_atrigd (gfc_expr *, gfc_expr *);
void gfc_resolve_trim (gfc_expr *, gfc_expr *);
void gfc_resolve_ttynam (gfc_expr *, gfc_expr *);
void gfc_resolve_ubound (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 8cca9b1..4f900e5 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -23,6 +23,9 @@ Some basic guidelines for editing this document:
@end ignore
@tex
+\gdef\acosd{\mathop{\rm acosd}\nolimits}
+\gdef\asind{\mathop{\rm asind}\nolimits}
+\gdef\atand{\mathop{\rm atand}\nolimits}
\gdef\acos{\mathop{\rm acos}\nolimits}
\gdef\asin{\mathop{\rm asin}\nolimits}
\gdef\atan{\mathop{\rm atan}\nolimits}
@@ -43,6 +46,7 @@ Some basic guidelines for editing this document:
* @code{ACCESS}: ACCESS, Checks file access modes
* @code{ACHAR}: ACHAR, Character in @acronym{ASCII} collating sequence
* @code{ACOS}: ACOS, Arccosine function
+* @code{ACOSD}: ACOSD, Arccosine function, degrees
* @code{ACOSH}: ACOSH, Inverse hyperbolic cosine function
* @code{ADJUSTL}: ADJUSTL, Left adjust a string
* @code{ADJUSTR}: ADJUSTR, Right adjust a string
@@ -55,10 +59,13 @@ Some basic guidelines for editing this document:
* @code{ANINT}: ANINT, Nearest whole number
* @code{ANY}: ANY, Determine if any values are true
* @code{ASIN}: ASIN, Arcsine function
+* @code{ASIND}: ASIND, Arcsine function, degrees
* @code{ASINH}: ASINH, Inverse hyperbolic sine function
* @code{ASSOCIATED}: ASSOCIATED, Status of a pointer or pointer/target pair
* @code{ATAN}: ATAN, Arctangent function
+* @code{ATAND}: ATAND, Arctangent function, degrees
* @code{ATAN2}: ATAN2, Arctangent function
+* @code{ATAN2D}: ATAN2D, Arctangent function, degrees
* @code{ATANH}: ATANH, Inverse hyperbolic tangent function
* @code{ATOMIC_ADD}: ATOMIC_ADD, Atomic ADD operation
* @code{ATOMIC_AND}: ATOMIC_AND, Atomic bitwise AND operation
@@ -106,7 +113,10 @@ Some basic guidelines for editing this document:
* @code{COMPLEX}: COMPLEX, Complex conversion function
* @code{CONJG}: CONJG, Complex conjugate function
* @code{COS}: COS, Cosine function
+* @code{COSD}: COSD, Cosine function, degrees
* @code{COSH}: COSH, Hyperbolic cosine function
+* @code{COTAN}: COTAN, Cotangent function
+* @code{COTAND}: COTAND, Cotangent function, degrees
* @code{COUNT}: COUNT, Count occurrences of TRUE in an array
* @code{CPU_TIME}: CPU_TIME, CPU time subroutine
* @code{CSHIFT}: CSHIFT, Circular shift elements of an array
@@ -277,6 +287,7 @@ Some basic guidelines for editing this document:
* @code{SIGN}: SIGN, Sign copying function
* @code{SIGNAL}: SIGNAL, Signal handling subroutine (or function)
* @code{SIN}: SIN, Sine function
+* @code{SIND}: SIND, Sine function, degrees
* @code{SINH}: SINH, Hyperbolic sine function
* @code{SIZE}: SIZE, Function to determine the size of an array
* @code{SIZEOF}: SIZEOF, Determine the size in bytes of an expression
@@ -292,6 +303,7 @@ Some basic guidelines for editing this document:
* @code{SYSTEM}: SYSTEM, Execute a shell command
* @code{SYSTEM_CLOCK}: SYSTEM_CLOCK, Time function
* @code{TAN}: TAN, Tangent function
+* @code{TAND}: TAND, Tangent function, degrees
* @code{TANH}: TANH, Hyperbolic tangent function
* @code{THIS_IMAGE}: THIS_IMAGE, Cosubscript index of this image
* @code{TIME}: TIME, Time function
@@ -619,6 +631,62 @@ end program test_acos
@item @emph{See also}:
Inverse function: @ref{COS}
+Degrees function: @ref{ACOSD}
+
+@end table
+
+
+
+@node ACOSD
+@section @code{ACOSD} --- Arccosine function, degrees
+@fnindex ACOSD
+@fnindex DACOSD
+@cindex trigonometric function, cosine, inverse, degrees
+@cindex cosine, inverse, degrees
+
+@table @asis
+@item @emph{Description}:
+@code{ACOSD(X)} computes the arccosine of @var{X} in degrees (inverse of
+@code{COSD(X)}).
+
+@item @emph{Standard}:
+GNU Extension, enabled with @option{-fdec-math}
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ACOSD(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall either be @code{REAL} with a magnitude that is
+less than or equal to one - or the type shall be @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and kind as @var{X}.
+The real part of the result is in degrees and lies in the range
+@math{0 \leq \Re \acos(x) \leq 180}.
+
+@item @emph{Example}:
+@smallexample
+program test_acosd
+ real(8) :: x = 0.866_8
+ x = acosd(x)
+end program test_acosd
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name @tab Argument @tab Return type @tab Standard
+@item @code{ACOSD(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU Extension
+@item @code{DACOSD(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU Extension
+@end multitable
+
+@item @emph{See also}:
+Inverse function: @ref{COSD}
+Radians function: @ref{ACOS}
@end table
@@ -1269,6 +1337,62 @@ end program test_asin
@item @emph{See also}:
Inverse function: @ref{SIN}
+Degrees function: @ref{ASIND}
+
+@end table
+
+
+
+@node ASIND
+@section @code{ASIND} --- Arcsine function, degrees
+@fnindex ASIND
+@fnindex DASIND
+@cindex trigonometric function, sine, inverse, degrees
+@cindex sine, inverse, degrees
+
+@table @asis
+@item @emph{Description}:
+@code{ASIND(X)} computes the arcsine of its @var{X} in degrees (inverse of
+@code{SIND(X)}).
+
+@item @emph{Standard}:
+GNU Extension, enabled with @option{-fdec-math}.
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ASIND(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be either @code{REAL} and a magnitude that is
+less than or equal to one - or be @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and kind as @var{X}.
+The real part of the result is in degrees and lies in the range
+@math{-90 \leq \Re \asin(x) \leq 90}.
+
+@item @emph{Example}:
+@smallexample
+program test_asind
+ real(8) :: x = 0.866_8
+ x = asind(x)
+end program test_asind
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name @tab Argument @tab Return type @tab Standard
+@item @code{ASIND(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU Extension
+@item @code{DASIND(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU Extension
+@end multitable
+
+@item @emph{See also}:
+Inverse function: @ref{SIND}
+Radians function: @ref{ASIN}
@end table
@@ -1458,6 +1582,68 @@ end program test_atan
@item @emph{See also}:
Inverse function: @ref{TAN}
+Degrees function: @ref{ATAND}
+
+@end table
+
+
+
+@node ATAND
+@section @code{ATAND} --- Arctangent function, degrees
+@fnindex ATAND
+@fnindex DATAND
+@cindex trigonometric function, tangent, inverse, degrees
+@cindex tangent, inverse, degrees
+
+@table @asis
+@item @emph{Description}:
+@code{ATAND(X)} computes the arctangent of @var{X} in degrees (inverse of
+@ref{TAND}).
+
+@item @emph{Standard}:
+GNU Extension, enabled with @option{-fdec-math}.
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = ATAND(X)}
+@item @code{RESULT = ATAND(Y, X)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX};
+if @var{Y} is present, @var{X} shall be REAL.
+@item @var{Y} shall be of the same type and kind as @var{X}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and kind as @var{X}.
+If @var{Y} is present, the result is identical to @code{ATAND2(Y,X)}.
+Otherwise, it is the arcus tangent of @var{X}, where the real part of
+the result is in degrees and lies in the range
+@math{-90 \leq \Re \atand(x) \leq 90}.
+
+@item @emph{Example}:
+@smallexample
+program test_atand
+ real(8) :: x = 2.866_8
+ x = atand(x)
+end program test_atand
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name @tab Argument @tab Return type @tab Standard
+@item @code{ATAND(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU Extension
+@item @code{DATAND(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU Extension
+@end multitable
+
+@item @emph{See also}:
+Inverse function: @ref{TAND}
+Radians function: @ref{ATAN}
@end table
@@ -1473,7 +1659,7 @@ Inverse function: @ref{TAN}
@table @asis
@item @emph{Description}:
@code{ATAN2(Y, X)} computes the principal value of the argument
-function of the complex number @math{X + i Y}. This function can
+function of the complex number @math{X + i Y}. This function can
be used to transform from Cartesian into polar coordinates and
allows to determine the angle in the correct quadrant.
@@ -1518,6 +1704,75 @@ end program test_atan2
@item @code{ATAN2(X, Y)} @tab @code{REAL(4) X, Y} @tab @code{REAL(4)} @tab Fortran 77 and later
@item @code{DATAN2(X, Y)} @tab @code{REAL(8) X, Y} @tab @code{REAL(8)} @tab Fortran 77 and later
@end multitable
+
+@item @emph{See also}:
+Alias: @ref{ATAN}
+Degrees function: @ref{ATAN2D}
+
+@end table
+
+
+
+@node ATAN2D
+@section @code{ATAN2D} --- Arctangent function, degrees
+@fnindex ATAN2D
+@fnindex DATAN2D
+@cindex trigonometric function, tangent, inverse, degrees
+@cindex tangent, inverse, degrees
+
+@table @asis
+@item @emph{Description}:
+@code{ATAN2D(Y, X)} computes the principal value of the argument
+function of the complex number @math{X + i Y} in degrees. This function can
+be used to transform from Cartesian into polar coordinates and
+allows to determine the angle in the correct quadrant.
+
+@item @emph{Standard}:
+GNU Extension, enabled with @option{-fdec-math}.
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ATAN2D(Y, X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{Y} @tab The type shall be @code{REAL}.
+@item @var{X} @tab The type and kind type parameter shall be the same as @var{Y}.
+If @var{Y} is zero, then @var{X} must be nonzero.
+@end multitable
+
+@item @emph{Return value}:
+The return value has the same type and kind type parameter as @var{Y}. It
+is the principal value of the complex number @math{X + i Y}. If @var{X}
+is nonzero, then it lies in the range @math{-180 \le \atan (x) \leq 180}.
+The sign is positive if @var{Y} is positive. If @var{Y} is zero, then
+the return value is zero if @var{X} is strictly positive, @math{180} if
+@var{X} is negative and @var{Y} is positive zero (or the processor does
+not handle signed zeros), and @math{-180} if @var{X} is negative and
+@var{Y} is negative zero. Finally, if @var{X} is zero, then the
+magnitude of the result is @math{90}.
+
+@item @emph{Example}:
+@smallexample
+program test_atan2d
+ real(4) :: x = 1.e0_4, y = 0.5e0_4
+ x = atan2d(y,x)
+end program test_atan2d
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name @tab Argument @tab Return type @tab Standard
+@item @code{ATAN2D(X, Y)} @tab @code{REAL(4) X, Y} @tab @code{REAL(4)} @tab GNU Extension
+@item @code{DATAN2D(X, Y)} @tab @code{REAL(8) X, Y} @tab @code{REAL(8)} @tab GNU Extension
+@end multitable
+
+@item @emph{See also}:
+Alias: @ref{ATAND}
+Radians function: @ref{ATAN2}
+
@end table
@@ -3895,6 +4150,67 @@ end program test_cos
@item @emph{See also}:
Inverse function: @ref{ACOS}
+Degrees function: @ref{COSD}
+
+@end table
+
+
+
+@node COSD
+@section @code{COSD} --- Cosine function, degrees
+@fnindex COSD
+@fnindex DCOSD
+@fnindex CCOSD
+@fnindex ZCOSD
+@fnindex CDCOSD
+@cindex trigonometric function, cosine, degrees
+@cindex cosine, degrees
+
+@table @asis
+@item @emph{Description}:
+@code{COSD(X)} computes the cosine of @var{X} in degrees.
+
+@item @emph{Standard}:
+GNU Extension, enabled with @option{-fdec-math}.
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = COSD(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or
+@code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and kind as @var{X}. The real part
+of the result is in degrees. If @var{X} is of the type @code{REAL},
+the return value lies in the range @math{ -1 \leq \cosd (x) \leq 1}.
+
+@item @emph{Example}:
+@smallexample
+program test_cosd
+ real :: x = 0.0
+ x = cosd(x)
+end program test_cosd
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name @tab Argument @tab Return type @tab Standard
+@item @code{COSD(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU Extension
+@item @code{DCOSD(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU Extension
+@item @code{CCOSD(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab GNU Extension
+@item @code{ZCOSD(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension
+@item @code{CDCOSD(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension
+@end multitable
+
+@item @emph{See also}:
+Inverse function: @ref{ACOSD}
+Radians function: @ref{COS}
@end table
@@ -3954,6 +4270,109 @@ Inverse function: @ref{ACOSH}
+@node COTAN
+@section @code{COTAN} --- Cotangent function
+@fnindex COTAN
+@fnindex DCOTAN
+@cindex trigonometric function, cotangent
+@cindex cotangent
+
+@table @asis
+@item @emph{Description}:
+@code{COTAN(X)} computes the cotangent of @var{X}. Equivalent to @code{COS(x)}
+divided by @code{SIN(x)}, or @code{1 / TAN(x)}.
+
+@item @emph{Standard}:
+GNU Extension, enabled with @option{-fdec-math}.
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = COTAN(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has same type and kind as @var{X}, and its value is in radians.
+
+@item @emph{Example}:
+@smallexample
+program test_cotan
+ real(8) :: x = 0.165_8
+ x = cotan(x)
+end program test_cotan
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name @tab Argument @tab Return type @tab Standard
+@item @code{COTAN(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU Extension
+@item @code{DCOTAN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU Extension
+@end multitable
+
+@item @emph{See also}:
+Converse function: @ref{TAN}
+Degrees function: @ref{COTAND}
+@end table
+
+
+
+@node COTAND
+@section @code{COTAND} --- Cotangent function, degrees
+@fnindex COTAND
+@fnindex DCOTAND
+@cindex trigonometric function, cotangent, degrees
+@cindex cotangent, degrees
+
+@table @asis
+@item @emph{Description}:
+@code{COTAND(X)} computes the cotangent of @var{X} in degrees. Equivalent to
+@code{COSD(x)} divided by @code{SIND(x)}, or @code{1 / TAND(x)}.
+
+@item @emph{Standard}:
+GNU Extension, enabled with @option{-fdec-math}.
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = COTAND(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has same type and kind as @var{X}, and its value is in degrees.
+
+@item @emph{Example}:
+@smallexample
+program test_cotand
+ real(8) :: x = 0.165_8
+ x = cotand(x)
+end program test_cotand
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name @tab Argument @tab Return type @tab Standard
+@item @code{COTAND(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU Extension
+@item @code{DCOTAND(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU Extension
+@end multitable
+
+@item @emph{See also}:
+Converse function: @ref{TAND}
+Radians function: @ref{COTAN}
+
+@end table
+
+
+
@node COUNT
@section @code{COUNT} --- Count function
@fnindex COUNT
@@ -12390,7 +12809,66 @@ end program test_sin
@end multitable
@item @emph{See also}:
-@ref{ASIN}
+Inverse function: @ref{ASIN}
+Degrees function: @ref{SIND}
+@end table
+
+
+
+@node SIND
+@section @code{SIND} --- Sine function, degrees
+@fnindex SIND
+@fnindex DSIND
+@fnindex CSIND
+@fnindex ZSIND
+@fnindex CDSIND
+@cindex trigonometric function, sine, degrees
+@cindex sine, degrees
+
+@table @asis
+@item @emph{Description}:
+@code{SIND(X)} computes the sine of @var{X} in degrees.
+
+@item @emph{Standard}:
+GNU Extension, enabled with @option{-fdec-math}.
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = SIND(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or
+@code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has same type and kind as @var{X}, and its value is in degrees.
+
+@item @emph{Example}:
+@smallexample
+program test_sind
+ real :: x = 0.0
+ x = sind(x)
+end program test_sind
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name @tab Argument @tab Return type @tab Standard
+@item @code{SIND(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU Extension
+@item @code{DSIND(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU Extension
+@item @code{CSIND(X)} @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab GNU Extension
+@item @code{ZSIND(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU Extension
+@item @code{CDSIND(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU Extension
+@end multitable
+
+@item @emph{See also}:
+Inverse function: @ref{ASIND}
+Radians function: @ref{SIN}
+
@end table
@@ -13151,7 +13629,7 @@ Elemental function
@end multitable
@item @emph{Return value}:
-The return value has same type and kind as @var{X}.
+The return value has same type and kind as @var{X}, and its value is in radians.
@item @emph{Example}:
@smallexample
@@ -13169,7 +13647,58 @@ end program test_tan
@end multitable
@item @emph{See also}:
-@ref{ATAN}
+Inverse function: @ref{ATAN}
+Degrees function: @ref{TAND}
+@end table
+
+
+
+@node TAND
+@section @code{TAND} --- Tangent function, degrees
+@fnindex TAND
+@fnindex DTAND
+@cindex trigonometric function, tangent, degrees
+@cindex tangent, degrees
+
+@table @asis
+@item @emph{Description}:
+@code{TAND(X)} computes the tangent of @var{X} in degrees.
+
+@item @emph{Standard}:
+GNU Extension, enabled with @option{-fdec-math}.
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = TAND(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has same type and kind as @var{X}, and its value is in degrees.
+
+@item @emph{Example}:
+@smallexample
+program test_tand
+ real(8) :: x = 0.165_8
+ x = tand(x)
+end program test_tand
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name @tab Argument @tab Return type @tab Standard
+@item @code{TAND(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU Extension
+@item @code{DTAND(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU Extension
+@end multitable
+
+@item @emph{See also}:
+Inverse function: @ref{ATAND}
+Radians function: @ref{TAN}
@end table
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 83ca7f7..a14b200 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -242,7 +242,7 @@ full documentation.
Other flags enabled by this switch are:
@option{-fdollar-ok} @option{-fcray-pointer} @option{-fdec-structure}
@option{-fdec-intrinsic-ints} @option{-fdec-static} @option{-ffeed}
-@option{-fdec-type-print}
+@option{-fdec-type-print} @option{-fdec-math}
@item -fdec-structure
@opindex @code{fdec-structure}
@@ -261,6 +261,11 @@ JIAND, etc...). For a complete list of intrinsics see the full documentation.
Enable the use of @code{%LOC} (equivalent to @code{LOC}) on the
right-hand-side of assignments.
+@item -fdec-math
+@opindex @code{fdec-math}
+Enable extra math intrinsics such as COTAN and degree-valued trigonometric
+functions (e.g. TAND, ATAND, etc...).
+
@item -fdec-static
@opindex @code{fdec-static}
Enable DEC-style STATIC and AUTOMATIC attributes to explicitly specify
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index ecea1c3..aab8ec8 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -673,6 +673,87 @@ gfc_resolve_cosh (gfc_expr *f, gfc_expr *x)
}
+/* Our replacement of elements of a trig call with an EXPR_OP (e.g.
+ multiplying the result or operands by a factor to convert to/from degrees)
+ will cause the resolve_* function to be invoked again when resolving the
+ freshly created EXPR_OP. See gfc_resolve_trigd, gfc_resolve_atrigd,
+ gfc_resolve_cotan. We must observe this and avoid recursively creating
+ layers of nested EXPR_OP expressions. */
+
+static bool
+is_trig_resolved (gfc_expr *f)
+{
+ /* We know we've already resolved the function if we see the lib call
+ starting with '__'. */
+ return f->value.function.name != NULL
+ && 0 == strncmp ("__", f->value.function.name, 2);
+}
+
+/* Return a shallow copy of the function expression f. The original expression
+ has its pointers cleared so that it may be freed without affecting the
+ shallow copy. This is similar to gfc_copy_expr, but doesn't perform a deep
+ copy of the argument list, allowing it to be reused somewhere else,
+ setting the expression up nicely for gfc_replace_expr. */
+
+static gfc_expr *
+copy_replace_function_shallow (gfc_expr *f)
+{
+ gfc_expr *fcopy;
+ gfc_actual_arglist *args;
+
+ /* The only thing deep-copied in gfc_copy_expr is args. */
+ args = f->value.function.actual;
+ f->value.function.actual = NULL;
+ fcopy = gfc_copy_expr (f);
+ fcopy->value.function.actual = args;
+
+ /* Clear the old function so the shallow copy is not affected if the old
+ expression is freed. */
+ f->value.function.name = NULL;
+ f->value.function.isym = NULL;
+ f->value.function.actual = NULL;
+ f->value.function.esym = NULL;
+ f->shape = NULL;
+ f->ref = NULL;
+
+ return fcopy;
+}
+
+
+/* Resolve cotan = 1/tan. */
+
+void
+gfc_resolve_cotan (gfc_expr *f, gfc_expr *x)
+{
+ gfc_expr *result, *fcopy, *one;
+
+ if (is_trig_resolved (f))
+ return;
+
+ gfc_resolve_tan (f, x);
+ one = gfc_get_constant_expr (f->ts.type, f->ts.kind, &f->where);
+
+ switch (f->ts.type)
+ {
+ case BT_REAL:
+ mpfr_set_ui (one->value.real, 1, GFC_RND_MODE);
+ break;
+
+ case BT_COMPLEX:
+ mpc_set_ui (one->value.complex, 1, GFC_MPC_RND_MODE);
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+
+ /* Replace f [tan] with 1/f [cotan]. */
+ fcopy = copy_replace_function_shallow (f);
+ result = gfc_divide (one, fcopy);
+ gfc_replace_expr (f, result);
+}
+
+
void
gfc_resolve_count (gfc_expr *f, gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
{
@@ -2578,6 +2659,131 @@ gfc_resolve_tanh (gfc_expr *f, gfc_expr *x)
}
+/* Build an expression for converting degrees to radians. */
+
+static gfc_expr *
+get_radians (gfc_expr *deg)
+{
+ mpfr_t tmp;
+ gfc_expr *result, *factor;
+
+ gcc_assert (deg->ts.type == BT_REAL);
+
+ factor = gfc_get_constant_expr (deg->ts.type, deg->ts.kind, °->where);
+
+ /* Set factor = pi / 180. */
+ mpfr_init (tmp);
+ mpfr_set_d (tmp, 180.0l, GFC_RND_MODE);
+ mpfr_const_pi (factor->value.real, GFC_RND_MODE);
+ mpfr_div (factor->value.real, factor->value.real, tmp, GFC_RND_MODE);
+ mpfr_clear (tmp);
+
+ /* Result is rad = deg * (pi / 180). */
+ result = gfc_multiply (deg, factor);
+ return result;
+}
+
+
+/* Build an expression for converting radians to degrees. */
+
+static gfc_expr *
+get_degrees (gfc_expr *rad)
+{
+ mpfr_t tmp;
+ gfc_expr *result, *factor;
+
+ gcc_assert (rad->ts.type == BT_REAL);
+
+ factor = gfc_get_constant_expr (rad->ts.type, rad->ts.kind, &rad->where);
+
+ /* Set factor = 180 / pi. */
+ mpfr_init (tmp);
+ mpfr_const_pi (tmp, GFC_RND_MODE);
+ mpfr_set_d (factor->value.real, 180.0l, GFC_RND_MODE);
+ mpfr_div (factor->value.real, factor->value.real, tmp, GFC_RND_MODE);
+ mpfr_clear (tmp);
+
+ /* Result is deg = rad * (180 / pi). */
+ result = gfc_multiply (rad, factor);
+ return result;
+}
+
+
+/* Resolve a call to a trig function. */
+
+static void
+resolve_trig_call (gfc_expr *f, gfc_expr *x)
+{
+ switch (f->value.function.isym->id)
+ {
+ case GFC_ISYM_ACOS:
+ return gfc_resolve_acos (f, x);
+ case GFC_ISYM_ASIN:
+ return gfc_resolve_asin (f, x);
+ case GFC_ISYM_ATAN:
+ return gfc_resolve_atan (f, x);
+ case GFC_ISYM_ATAN2:
+ /* NB. arg3 is unused for atan2 */
+ return gfc_resolve_atan2 (f, x, NULL);
+ case GFC_ISYM_COS:
+ return gfc_resolve_cos (f, x);
+ case GFC_ISYM_COTAN:
+ return gfc_resolve_cotan (f, x);
+ case GFC_ISYM_SIN:
+ return gfc_resolve_sin (f, x);
+ case GFC_ISYM_TAN:
+ return gfc_resolve_tan (f, x);
+ default:
+ break;
+ }
+
+ gcc_unreachable ();
+}
+
+/* Resolve degree trig function as trigd (x) = trig (radians (x)). */
+
+void
+gfc_resolve_trigd (gfc_expr *f, gfc_expr *x)
+{
+ if (is_trig_resolved (f))
+ return;
+
+ x = get_radians (x);
+ f->value.function.actual->expr = x;
+
+ resolve_trig_call (f, x);
+}
+
+
+/* Resolve degree inverse trig function as atrigd (x) = degrees (atrig (x)). */
+
+void
+gfc_resolve_atrigd (gfc_expr *f, gfc_expr *x)
+{
+ gfc_expr *result, *fcopy;
+
+ if (is_trig_resolved (f))
+ return;
+
+ resolve_trig_call (f, x);
+
+ fcopy = copy_replace_function_shallow (f);
+ result = get_degrees (fcopy);
+ gfc_replace_expr (f, result);
+}
+
+
+/* Resolve atan2d(x) = degrees(atan2(x)). */
+
+void
+gfc_resolve_atan2d (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED)
+{
+ /* Note that we lose the second arg here - that's okay because it is
+ unused in gfc_resolve_atan2 anyway. */
+ gfc_resolve_atrigd (f, x);
+}
+
+
void
gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
gfc_expr *sub ATTRIBUTE_UNUSED)
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index db24426..46f08f6 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -432,6 +432,10 @@ fdec-loc-rval
Fortran Var(flag_dec_loc_rval)
Enable %LOC as an rval.
+fdec-math
+Fortran Var(flag_dec_math)
+Enable extra math intrinsics.
+
fdec-structure
Fortran
Enable support for DEC STRUCTURE/RECORD.
diff --git a/gcc/fortran/mathbuiltins.def b/gcc/fortran/mathbuiltins.def
index fc7fdc2..5645a7e 100644
--- a/gcc/fortran/mathbuiltins.def
+++ b/gcc/fortran/mathbuiltins.def
@@ -73,3 +73,10 @@ OTHER_BUILTIN (RINT, "rint", 1, true)
OTHER_BUILTIN (ROUND, "round", 1, true)
OTHER_BUILTIN (SCALBN, "scalbn", scalbn, true)
OTHER_BUILTIN (TRUNC, "trunc", 1, true)
+
+/* MATH_ALIAS_BUILTIN (NEWID, OLDID, NAME, ARGTYPE)
+ NEWID The new id of the builtin (to match GFC_ISYM_* in gfortran.h)
+ OLDID The id of the actual builtin to alias ("" GFC_ISYM_*)
+ NAME The name of the new builtin
+ ARGTYPE The type of the arguments, to match that of OLDID */
+MATH_ALIAS_BUILTIN (COTAN, TAN, "cotan", 0)
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index b5c48a9..8b1574f 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -58,6 +58,7 @@ set_dec_flags (int value)
flag_feed = value;
flag_dec_type_print = value;
flag_dec_loc_rval = value;
+ flag_dec_math = value;
}
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index ad547a1..101e838 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -1706,6 +1706,146 @@ gfc_simplify_conjg (gfc_expr *e)
return range_check (result, "CONJG");
}
+/* Return the simplification of the constant expression in icall, or NULL
+ if the expression is not constant. */
+
+static gfc_expr *
+simplify_trig_call (gfc_expr *icall)
+{
+ gfc_isym_id func = icall->value.function.isym->id;
+ gfc_expr *x = icall->value.function.actual->expr;
+
+ /* The actual simplifiers will return NULL for non-constant x. */
+ switch (func)
+ {
+ case GFC_ISYM_ACOS:
+ return gfc_simplify_acos (x);
+ case GFC_ISYM_ASIN:
+ return gfc_simplify_asin (x);
+ case GFC_ISYM_ATAN:
+ return gfc_simplify_atan (x);
+ case GFC_ISYM_COS:
+ return gfc_simplify_cos (x);
+ case GFC_ISYM_COTAN:
+ return gfc_simplify_cotan (x);
+ case GFC_ISYM_SIN:
+ return gfc_simplify_sin (x);
+ case GFC_ISYM_TAN:
+ return gfc_simplify_tan (x);
+ default:
+ break;
+ }
+
+ gfc_internal_error ("in simplify_trig_call(): Bad intrinsic");
+ return NULL;
+}
+
+/* Convert a floating-point number from radians to degrees. */
+
+static void
+degrees_f (mpfr_t x, mp_rnd_t rnd_mode)
+{
+ mpfr_t tmp;
+ mpfr_init (tmp);
+
+ /* Set x = x * 180. */
+ mpfr_set_d (tmp, 180.0l, rnd_mode);
+ mpfr_mul (x, x, tmp, rnd_mode);
+
+ /* Set x = x / pi. */
+ mpfr_const_pi (tmp, rnd_mode);
+ mpfr_div (x, x, tmp, rnd_mode);
+
+ mpfr_clear (tmp);
+}
+
+/* Convert a floating-point number from degrees to radians. */
+
+static void
+radians_f (mpfr_t x, mp_rnd_t rnd_mode)
+{
+ mpfr_t tmp;
+ mpfr_init (tmp);
+
+ /* Set x = x * pi. */
+ mpfr_const_pi (tmp, rnd_mode);
+ mpfr_mul (x, x, tmp, rnd_mode);
+
+ /* Set x = x / 180. */
+ mpfr_set_d (tmp, 180.0l, rnd_mode);
+ mpfr_div (x, x, tmp, rnd_mode);
+
+ mpfr_clear (tmp);
+}
+
+
+/* Convert argument to radians before calling a trig function. */
+
+gfc_expr *
+gfc_simplify_trigd (gfc_expr *icall)
+{
+ gfc_expr *arg;
+
+ arg = icall->value.function.actual->expr;
+
+ if (arg->ts.type != BT_REAL)
+ gfc_internal_error ("in gfc_simplify_trigd(): Bad type");
+
+ if (arg->expr_type == EXPR_CONSTANT)
+ /* Convert constant to radians before passing off to simplifier. */
+ radians_f (arg->value.real, GFC_RND_MODE);
+
+ /* Let the usual simplifier take over - we just simplified the arg. */
+ return simplify_trig_call (icall);
+}
+
+/* Convert result of an inverse trig function to degrees. */
+
+gfc_expr *
+gfc_simplify_atrigd (gfc_expr *icall)
+{
+ gfc_expr *result;
+
+ if (icall->value.function.actual->expr->ts.type != BT_REAL)
+ gfc_internal_error ("in gfc_simplify_atrigd(): Bad type");
+
+ /* See if another simplifier has work to do first. */
+ result = simplify_trig_call (icall);
+
+ if (result && result->expr_type == EXPR_CONSTANT)
+ {
+ /* Convert constant to degrees after passing off to actual simplifier. */
+ degrees_f (result->value.real, GFC_RND_MODE);
+ return result;
+ }
+
+ /* Let gfc_resolve_atrigd take care of the non-constant case. */
+ return NULL;
+}
+
+/* Convert the result of atan2 to degrees. */
+
+gfc_expr *
+gfc_simplify_atan2d (gfc_expr *y, gfc_expr *x)
+{
+ gfc_expr *result;
+
+ if (x->ts.type != BT_REAL || y->ts.type != BT_REAL)
+ gfc_internal_error ("in gfc_simplify_atan2d(): Bad type");
+
+ if (x->expr_type == EXPR_CONSTANT && y->expr_type == EXPR_CONSTANT)
+ {
+ result = gfc_simplify_atan2 (y, x);
+ if (result != NULL)
+ {
+ degrees_f (result->value.real, GFC_RND_MODE);
+ return result;
+ }
+ }
+
+ /* Let gfc_resolve_atan2d take care of the non-constant case. */
+ return NULL;
+}
gfc_expr *
gfc_simplify_cos (gfc_expr *x)
@@ -6244,6 +6384,43 @@ gfc_simplify_sum (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
gfc_expr *
+gfc_simplify_cotan (gfc_expr *x)
+{
+ gfc_expr *result;
+ mpc_t one, *val;
+
+ if (x->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+ switch (x->ts.type)
+ {
+ case BT_REAL:
+ mpfr_cot (result->value.real, x->value.real, GFC_RND_MODE);
+ break;
+
+ case BT_COMPLEX:
+ mpc_init2 (one, mpfr_get_default_prec ());
+ mpc_set_ui (one, 1, GFC_MPC_RND_MODE);
+
+ /* There is no builtin mpc_cot, so compute x = 1 / tan (x). */
+ val = &result->value.complex;
+ mpc_tan (*val, *val, GFC_MPC_RND_MODE);
+ mpc_div (*val, one, *val, GFC_MPC_RND_MODE);
+
+ mpc_clear (one);
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+
+ return range_check (result, "COTAN");
+}
+
+
+gfc_expr *
gfc_simplify_tan (gfc_expr *x)
{
gfc_expr *result;
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index d3f6842..28683b9 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -97,6 +97,12 @@ gfc_intrinsic_map_t;
BUILT_IN_C ## ID ## L, true, true, true, NAME, NULL_TREE, NULL_TREE, \
NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
+#define MATH_ALIAS_BUILTIN(NEWID, ID, NAME, TYPE) \
+ { GFC_ISYM_ ## NEWID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \
+ BUILT_IN_ ## ID ## L, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+ true, false, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \
+ NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
+
#define LIB_FUNCTION(ID, NAME, HAVE_COMPLEX) \
{ GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
END_BUILTINS, END_BUILTINS, END_BUILTINS, \
@@ -125,6 +131,7 @@ static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] =
};
#undef OTHER_BUILTIN
#undef LIB_FUNCTION
+#undef MATH_ALIAS_BUILTIN
#undef DEFINE_MATH_BUILTIN
#undef DEFINE_MATH_BUILTIN_C
@@ -654,6 +661,7 @@ gfc_build_intrinsic_lib_fndecls (void)
#define DEFINE_MATH_BUILTIN(ID, NAME, ARGTYPE)
#define DEFINE_MATH_BUILTIN_C(ID, NAME, ARGTYPE)
+#define MATH_ALIAS_BUILTIN(NEWID, ID, NAME, TYPE)
#define LIB_FUNCTION(ID, NAME, HAVE_COMPLEX)
/* Only these built-ins are actually needed here. These are used directly
@@ -667,6 +675,7 @@ gfc_build_intrinsic_lib_fndecls (void)
#undef OTHER_BUILTIN
#undef LIB_FUNCTION
+#undef MATH_ALIAS_BUILTIN
#undef DEFINE_MATH_BUILTIN
#undef DEFINE_MATH_BUILTIN_C
diff --git a/gcc/testsuite/gfortran.dg/dec_math.f90 b/gcc/testsuite/gfortran.dg/dec_math.f90
new file mode 100644
index 0000000..d9960b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_math.f90
@@ -0,0 +1,287 @@
+! { dg-options "-fdec-math" }
+! { dg-do run }
+!
+! Test extra math intrinsics offered by -fdec-math.
+!
+
+ subroutine cmpf(f1, f2, tolerance, str)
+ implicit none
+ real(4), intent(in) :: f1, f2, tolerance
+ character(len=*), intent(in) :: str
+ if ( abs(f2 - f1) .gt. tolerance ) then
+ write (*, '(A,F12.6,F12.6)') str, f1, f2
+ call abort()
+ endif
+ endsubroutine
+
+ subroutine cmpd(d1, d2, tolerance, str)
+ implicit none
+ real(8), intent(in) :: d1, d2, tolerance
+ character(len=*), intent(in) :: str
+ if ( dabs(d2 - d1) .gt. tolerance ) then
+ write (*, '(A,F12.6,F12.6)') str, d1, d2
+ call abort()
+ endif
+ endsubroutine
+
+implicit none
+
+ real(4), parameter :: pi_f = (4.0_4 * atan(1.0_4))
+ real(8), parameter :: pi_d = (4.0_8 * datan(1.0_8))
+ real(4), parameter :: r2d_f = 180.0_4 / pi_f
+ real(8), parameter :: r2d_d = 180.0_8 / pi_d
+ real(4), parameter :: d2r_f = pi_f / 180.0_4
+ real(8), parameter :: d2r_d = pi_d / 180.0_8
+
+! inputs
+real(4) :: xf, f_i1, f_i2
+real(8) :: xd, d_i1, d_i2
+
+! expected outputs from (oe) default (oxe) expression
+real(4) :: f_oe, f_oxe
+real(8) :: d_oe, d_oxe
+
+! actual outputs from (oa) default (oc) constant (ox) expression
+real(4) :: f_oa, f_oc, f_ox
+real(8) :: d_oa, d_oc, d_ox
+
+! tolerance of the answer: assert |exp-act| <= tol
+real(4) :: f_tol
+real(8) :: d_tol
+
+! equivalence tolerance
+f_tol = 5e-5_4
+d_tol = 5e-6_8
+
+! multiplication factors to test non-constant expressions
+xf = 2.0_4
+xd = 2.0_8
+
+! Input
+f_i1 = 0.68032123_4
+d_i1 = 0.68032123_8
+
+! Expected
+f_oe = r2d_f*acos (f_i1)
+f_oxe = xf*r2d_f*acos (f_i1)
+d_oe = r2d_d*dacos(d_i1)
+d_oxe = xd*r2d_d*dacos(d_i1)
+
+! Actual
+f_oa = acosd (f_i1)
+f_oc = acosd (0.68032123_4)
+f_ox = xf*acosd (f_i1)
+d_oa = dacosd (d_i1)
+d_oc = dacosd (0.68032123_8)
+d_ox = xd*dacosd (0.68032123_8)
+
+call cmpf(f_oe, f_oa, f_tol, "( ) acosd")
+call cmpf(f_oe, f_oc, f_tol, "(c) acosd")
+call cmpf(f_oxe, f_ox, f_tol, "(x) acosd")
+call cmpd(d_oe, d_oa, d_tol, "( ) dacosd")
+call cmpd(d_oe, d_oc, d_tol, "(c) dacosd")
+call cmpd(d_oxe, d_ox, d_tol, "(x) dacosd")
+
+! Input
+f_i1 = 60.0_4
+d_i1 = 60.0_8
+
+! Expected
+f_oe = cos (d2r_f*f_i1)
+f_oxe = xf*cos (d2r_f*f_i1)
+d_oe = cos (d2r_d*d_i1)
+d_oxe = xd*cos (d2r_d*d_i1)
+
+! Actual
+f_oa = cosd (f_i1)
+f_oc = cosd (60.0_4)
+f_ox = xf* cosd (f_i1)
+d_oa = dcosd (d_i1)
+d_oc = dcosd (60.0_8)
+d_ox = xd* cosd (d_i1)
+
+call cmpf(f_oe, f_oa, f_tol, "( ) cosd")
+call cmpf(f_oe, f_oc, f_tol, "(c) cosd")
+call cmpf(f_oxe, f_ox, f_tol, "(x) cosd")
+call cmpd(d_oe, d_oa, d_tol, "( ) dcosd")
+call cmpd(d_oe, d_oc, d_tol, "(c) dcosd")
+call cmpd(d_oxe, d_ox, d_tol, "(x) cosd")
+
+! Input
+f_i1 = 0.79345021_4
+d_i1 = 0.79345021_8
+
+! Expected
+f_oe = r2d_f*asin (f_i1)
+f_oxe = xf*r2d_f*asin (f_i1)
+d_oe = r2d_d*asin (d_i1)
+d_oxe = xd*r2d_d*asin (d_i1)
+
+! Actual
+f_oa = asind (f_i1)
+f_oc = asind (0.79345021_4)
+f_ox = xf* asind (f_i1)
+d_oa = dasind (d_i1)
+d_oc = dasind (0.79345021_8)
+d_ox = xd* asind (d_i1)
+
+call cmpf(f_oe, f_oa, f_tol, "( ) asind")
+call cmpf(f_oe, f_oc, f_tol, "(c) asind")
+call cmpf(f_oxe, f_ox, f_tol, "(x) asind")
+call cmpd(d_oe, d_oa, d_tol, "( ) dasind")
+call cmpd(d_oe, d_oc, d_tol, "(c) dasind")
+call cmpd(d_oxe, d_ox, d_tol, "(x) asind")
+
+! Input
+f_i1 = 60.0_4
+d_i1 = 60.0_8
+
+! Expected
+f_oe = sin (d2r_f*f_i1)
+f_oxe = xf*sin (d2r_f*f_i1)
+d_oe = sin (d2r_d*d_i1)
+d_oxe = xd*sin (d2r_d*d_i1)
+
+! Actual
+f_oa = sind (f_i1)
+f_oc = sind (60.0_4)
+f_ox = xf* sind (f_i1)
+d_oa = dsind (d_i1)
+d_oc = dsind (60.0_8)
+d_ox = xd* sind (d_i1)
+
+call cmpf(f_oe, f_oa, f_tol, "( ) sind")
+call cmpf(f_oe, f_oc, f_tol, "(c) sind")
+call cmpf(f_oxe, f_ox, f_tol, "(x) sind")
+call cmpd(d_oe, d_oa, d_tol, "( ) dsind")
+call cmpd(d_oe, d_oc, d_tol, "(c) dsind")
+call cmpd(d_oxe, d_ox, d_tol, "(x) sind")
+
+! Input
+f_i1 = 2.679676_4
+f_i2 = 1.0_4
+d_i1 = 2.679676_8
+d_i2 = 1.0_8
+
+! Expected
+f_oe = r2d_f*atan2 (f_i1, f_i2)
+f_oxe = xf*r2d_f*atan2 (f_i1, f_i2)
+d_oe = r2d_d*atan2 (d_i1, d_i2)
+d_oxe = xd*r2d_d*atan2 (d_i1, d_i2)
+
+! Actual
+f_oa = atan2d (f_i1, f_i2)
+f_oc = atan2d (2.679676_4, 1.0_4)
+f_ox = xf* atan2d (f_i1, f_i2)
+d_oa = datan2d (d_i1, d_i2)
+d_oc = datan2d (2.679676_8, 1.0_8)
+d_ox = xd* atan2d (d_i1, d_i2)
+
+call cmpf(f_oe, f_oa, f_tol, "( ) atan2d")
+call cmpf(f_oe, f_oc, f_tol, "(c) atan2d")
+call cmpf(f_oxe, f_ox, f_tol, "(x) atan2d")
+call cmpd(d_oe, d_oa, d_tol, "( ) datan2d")
+call cmpd(d_oe, d_oc, d_tol, "(c) datan2d")
+call cmpd(d_oxe, d_ox, d_tol, "(x) atan2d")
+
+! Input
+f_i1 = 1.5874993_4
+d_i1 = 1.5874993_8
+
+! Expected
+f_oe = r2d_f*atan (f_i1)
+f_oxe = xf*r2d_f*atan (f_i1)
+d_oe = r2d_d*atan (d_i1)
+d_oxe = xd*r2d_d*atan (d_i1)
+
+! Actual
+f_oa = atand (f_i1)
+f_oc = atand (1.5874993_4)
+f_ox = xf* atand (f_i1)
+d_oa = datand (d_i1)
+d_oc = datand (1.5874993_8)
+d_ox = xd* atand (d_i1)
+
+call cmpf(f_oe, f_oa, f_tol, "( ) atand")
+call cmpf(f_oe, f_oc, f_tol, "(c) atand")
+call cmpf(f_oxe, f_ox, f_tol, "(x) atand")
+call cmpd(d_oe, d_oa, d_tol, "( ) datand")
+call cmpd(d_oe, d_oc, d_tol, "(c) datand")
+call cmpd(d_oxe, d_ox, d_tol, "(x) atand")
+
+! Input
+f_i1 = 0.6_4
+d_i1 = 0.6_8
+
+! Expected
+f_oe = cotan (d2r_f*f_i1)
+f_oxe = xf*cotan (d2r_f*f_i1)
+d_oe = cotan (d2r_d*d_i1)
+d_oxe = xd*cotan (d2r_d*d_i1)
+
+! Actual
+f_oa = cotand (f_i1)
+f_oc = cotand (0.6_4)
+f_ox = xf* cotand (f_i1)
+d_oa = dcotand (d_i1)
+d_oc = dcotand (0.6_8)
+d_ox = xd* cotand (d_i1)
+
+call cmpf(f_oe, f_oa, f_tol, "( ) cotand")
+call cmpf(f_oe, f_oc, f_tol, "(c) cotand")
+call cmpf(f_oxe, f_ox, f_tol, "(x) cotand")
+call cmpd(d_oe, d_oa, d_tol, "( ) dcotand")
+call cmpd(d_oe, d_oc, d_tol, "(c) dcotand")
+call cmpd(d_oxe, d_ox, d_tol, "(x) cotand")
+
+! Input
+f_i1 = 0.6_4
+d_i1 = 0.6_8
+
+! Expected
+f_oe = 1.0_4/tan (f_i1)
+f_oxe = xf* 1.0_4/tan (f_i1)
+d_oe = 1.0_8/dtan (d_i1)
+d_oxe = xd*1.0_8/dtan (d_i1)
+
+! Actual
+f_oa = cotan (f_i1)
+f_oc = cotan (0.6_4)
+f_ox = xf* cotan (f_i1)
+d_oa = dcotan (d_i1)
+d_oc = dcotan (0.6_8)
+d_ox = xd* cotan (d_i1)
+
+call cmpf(f_oe, f_oa, f_tol, "( ) cotan")
+call cmpf(f_oe, f_oc, f_tol, "(c) cotan")
+call cmpf(f_oxe, f_ox, f_tol, "(x) cotan")
+call cmpd(d_oe, d_oa, d_tol, "( ) dcotan")
+call cmpd(d_oe, d_oc, d_tol, "(c) dcotan")
+call cmpd(d_oxe, d_ox, d_tol, "(x) cotan")
+
+! Input
+f_i1 = 60.0_4
+d_i1 = 60.0_8
+
+! Expected
+f_oe = tan (d2r_f*f_i1)
+f_oxe = xf*tan (d2r_f*f_i1)
+d_oe = tan (d2r_d*d_i1)
+d_oxe = xd*tan (d2r_d*d_i1)
+
+! Actual
+f_oa = tand (f_i1)
+f_oc = tand (60.0_4)
+f_ox = xf* tand (f_i1)
+d_oa = dtand (d_i1)
+d_oc = dtand (60.0_8)
+d_ox = xd* tand (d_i1)
+
+call cmpf(f_oe, f_oa, f_tol, "( ) tand")
+call cmpf(f_oe, f_oc, f_tol, "(c) tand")
+call cmpf(f_oxe, f_ox, f_tol, "(x) tand")
+call cmpd(d_oe, d_oa, d_tol, "( ) dtand")
+call cmpd(d_oe, d_oc, d_tol, "(c) dtand")
+call cmpd(d_oxe, d_ox, d_tol, "(x) tand")
+
+end
