+2009-07-25 Tobias Burnus <burnus@net-b.de>
+ Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ PR fortran/33197
+ * intrinsic.c (add_functions): Support complex arguments for
+ acos,acosh,asin,asinh,atan,atanh.
+ * invoke.texi (ACOS,ACOSH,ASIN,ASINH,ATAN,ATANH): Support
+ complex arguments.
+ * simplify.c (gfc_simplify_acos,gfc_simplify_acosh,
+ gfc_simplify_asin,gfc_simplify_asinh,gfc_simplify_atan,
+ gfc_simplify_atanh,gfc_simplify_atan,gfc_simplify_asinh,
+ gfc_simplify_acosh,gfc_simplify_atanh): Support
+ complex arguments.
+
2009-07-25 Richard Guenther <rguenther@suse.de>
PR fortran/40005
make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
- gfc_check_fn_r, gfc_simplify_acos, gfc_resolve_acos,
+ gfc_check_fn_rc2008, gfc_simplify_acos, gfc_resolve_acos,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
- GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_acosh,
+ GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_acosh,
gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
- gfc_check_fn_r, gfc_simplify_asin, gfc_resolve_asin,
+ gfc_check_fn_rc2008, gfc_simplify_asin, gfc_resolve_asin,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
- GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_asinh,
+ GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_asinh,
gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
- gfc_check_fn_r, gfc_simplify_atan, gfc_resolve_atan,
+ gfc_check_fn_rc2008, gfc_simplify_atan, gfc_resolve_atan,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
- GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_atanh,
+ GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_atanh,
gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
@code{ACOS(X)} computes the arccosine of @var{X} (inverse of @code{COS(X)}).
@item @emph{Standard}:
-Fortran 77 and later
+Fortran 77 and later, for a complex argument Fortran 2008 or later
@item @emph{Class}:
Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
-@item @var{X} @tab The type shall be @code{REAL} with a magnitude that is
-less than or equal to one.
+@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 type @code{REAL} and it lies in the
-range @math{ 0 \leq \acos(x) \leq \pi}. The return value if of the same
-kind as @var{X}.
+The return value is of the same type and kind as @var{X}.
+The real part of the result is in radians and lies in the range
+@math{0 \leq \Re \acos(x) \leq \pi}.
@item @emph{Example}:
@smallexample
@end multitable
@item @emph{Return value}:
-The return value has the same type and kind as @var{X}
+The return value has the same type and kind as @var{X}. If @var{X} is
+complex, the imaginary part of the result is in radians and lies between
+@math{ 0 \leq \Im \acosh(x) \leq \pi}.
@item @emph{Example}:
@smallexample
@code{ASIN(X)} computes the arcsine of its @var{X} (inverse of @code{SIN(X)}).
@item @emph{Standard}:
-Fortran 77 and later
+Fortran 77 and later, for a complex argument Fortran 2008 or later
@item @emph{Class}:
Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
-@item @var{X} @tab The type shall be @code{REAL}, and a magnitude that is
-less than or equal to one.
+@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 type @code{REAL} and it lies in the
-range @math{-\pi / 2 \leq \asin (x) \leq \pi / 2}. The kind type
-parameter is the same as @var{X}.
+The return value is of the same type and kind as @var{X}.
+The real part of the result is in radians and lies in the range
+@math{-\pi/2 \leq \Re \asin(x) \leq \pi/2}.
@item @emph{Example}:
@smallexample
@end multitable
@item @emph{Return value}:
-The return value is of the same type and kind as @var{X}.
+The return value is of the same type and kind as @var{X}. If @var{X} is
+complex, the imaginary part of the result is in radians and lies between
+@math{-\pi/2 \leq \Im \asinh(x) \leq \pi/2}.
@item @emph{Example}:
@smallexample
@code{ATAN(X)} computes the arctangent of @var{X}.
@item @emph{Standard}:
-Fortran 77 and later
+Fortran 77 and later, for a complex argument Fortran 2008 or later
@item @emph{Class}:
Elemental function
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
-@item @var{X} @tab The type shall be @code{REAL}.
+@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
@end multitable
@item @emph{Return value}:
-The return value is of type @code{REAL} and it lies in the
-range @math{ - \pi / 2 \leq \atan (x) \leq \pi / 2}.
+The return value is of the same type and kind as @var{X}.
+The real part of the result is in radians and lies in the range
+@math{-\pi/2 \leq \Re \atan(x) \leq \pi/2}.
@item @emph{Example}:
@smallexample
@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}. If @var{X} is
+complex, the imaginary part of the result is in radians and lies between
+@math{-\pi/2 \leq \Im \atanh(x) \leq \pi/2}.
@item @emph{Example}:
@smallexample
@end multitable
@item @emph{Return value}:
-The return value is of type @code{REAL} and it lies in the
-range @math{ -1 \leq \cos (x) \leq 1}. The kind type
-parameter is the same as @var{X}.
+The return value is of the same type and kind as @var{X}. The real part
+of the result is in radians. If @var{X} is of the type @code{REAL},
+the return value lies in the range @math{ -1 \leq \cos (x) \leq 1}.
@item @emph{Example}:
@smallexample
if (x->expr_type != EXPR_CONSTANT)
return NULL;
- if (mpfr_cmp_si (x->value.real, 1) > 0
- || mpfr_cmp_si (x->value.real, -1) < 0)
+ switch (x->ts.type)
{
- gfc_error ("Argument of ACOS at %L must be between -1 and 1",
- &x->where);
- return &gfc_bad_expr;
+ case BT_REAL:
+ if (mpfr_cmp_si (x->value.real, 1) > 0
+ || mpfr_cmp_si (x->value.real, -1) < 0)
+ {
+ gfc_error ("Argument of ACOS at %L must be between -1 and 1",
+ &x->where);
+ return &gfc_bad_expr;
+ }
+ break;
+ case BT_COMPLEX:
+ return NULL;
+ default:
+ gfc_internal_error ("in gfc_simplify_cos(): Bad type");
}
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
if (x->expr_type != EXPR_CONSTANT)
return NULL;
- if (mpfr_cmp_si (x->value.real, 1) < 0)
+ switch (x->ts.type)
{
- gfc_error ("Argument of ACOSH at %L must not be less than 1",
- &x->where);
- return &gfc_bad_expr;
- }
-
- result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+ case BT_REAL:
+ if (mpfr_cmp_si (x->value.real, 1) < 0)
+ {
+ gfc_error ("Argument of ACOSH at %L must not be less than 1",
+ &x->where);
+ return &gfc_bad_expr;
+ }
- mpfr_acosh (result->value.real, x->value.real, GFC_RND_MODE);
+ result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+ mpfr_acosh (result->value.real, x->value.real, GFC_RND_MODE);
+ break;
+ case BT_COMPLEX:
+ return NULL;
+ default:
+ gfc_internal_error ("in gfc_simplify_cos(): Bad type");
+ }
return range_check (result, "ACOSH");
}
if (x->expr_type != EXPR_CONSTANT)
return NULL;
- if (mpfr_cmp_si (x->value.real, 1) > 0
- || mpfr_cmp_si (x->value.real, -1) < 0)
+ switch (x->ts.type)
{
- gfc_error ("Argument of ASIN at %L must be between -1 and 1",
- &x->where);
- return &gfc_bad_expr;
+ case BT_REAL:
+ if (mpfr_cmp_si (x->value.real, 1) > 0
+ || mpfr_cmp_si (x->value.real, -1) < 0)
+ {
+ gfc_error ("Argument of ASIN at %L must be between -1 and 1",
+ &x->where);
+ return &gfc_bad_expr;
+ }
+ result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+ mpfr_asin (result->value.real, x->value.real, GFC_RND_MODE);
+ break;
+ case BT_COMPLEX:
+ return NULL;
+ default:
+ gfc_internal_error ("in gfc_simplify_cos(): Bad type");
}
- result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
-
- mpfr_asin (result->value.real, x->value.real, GFC_RND_MODE);
-
return range_check (result, "ASIN");
}
if (x->expr_type != EXPR_CONSTANT)
return NULL;
- result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
-
- mpfr_asinh (result->value.real, x->value.real, GFC_RND_MODE);
+ switch (x->ts.type)
+ {
+ case BT_REAL:
+ result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+ mpfr_asinh (result->value.real, x->value.real, GFC_RND_MODE);
+ break;
+ case BT_COMPLEX:
+ return NULL;
+ default:
+ gfc_internal_error ("in gfc_simplify_cos(): Bad type");
+ }
return range_check (result, "ASINH");
}
if (x->expr_type != EXPR_CONSTANT)
return NULL;
- result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
-
- mpfr_atan (result->value.real, x->value.real, GFC_RND_MODE);
+ switch (x->ts.type)
+ {
+ case BT_REAL:
+ result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+ mpfr_atan (result->value.real, x->value.real, GFC_RND_MODE);
+ break;
+ case BT_COMPLEX:
+ return NULL;
+ default:
+ gfc_internal_error ("in gfc_simplify_cos(): Bad type");
+ }
return range_check (result, "ATAN");
}
if (x->expr_type != EXPR_CONSTANT)
return NULL;
- if (mpfr_cmp_si (x->value.real, 1) >= 0
- || mpfr_cmp_si (x->value.real, -1) <= 0)
+ switch (x->ts.type)
{
- gfc_error ("Argument of ATANH at %L must be inside the range -1 to 1",
- &x->where);
- return &gfc_bad_expr;
- }
-
- result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+ case BT_REAL:
+ if (mpfr_cmp_si (x->value.real, 1) >= 0
+ || mpfr_cmp_si (x->value.real, -1) <= 0)
+ {
+ gfc_error ("Argument of ATANH at %L must be inside the range -1 "
+ "to 1", &x->where);
+ return &gfc_bad_expr;
+ }
- mpfr_atanh (result->value.real, x->value.real, GFC_RND_MODE);
+ result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+ mpfr_atanh (result->value.real, x->value.real, GFC_RND_MODE);
+ break;
+ case BT_COMPLEX:
+ return NULL;
+ default:
+ gfc_internal_error ("in gfc_simplify_cos(): Bad type");
+ }
return range_check (result, "ATANH");
}
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
- mpfr_cosh (result->value.real, x->value.real, GFC_RND_MODE);
+ if (x->ts.type == BT_REAL)
+ mpfr_cosh (result->value.real, x->value.real, GFC_RND_MODE);
+ else if (x->ts.type == BT_COMPLEX)
+ {
+#if HAVE_mpc
+ mpc_cosh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+#else
+ gfc_free_expr (result);
+ return NULL;
+#endif
+ }
+ else
+ gcc_unreachable ();
return range_check (result, "COSH");
}
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
- mpfr_sinh (result->value.real, x->value.real, GFC_RND_MODE);
+ if (x->ts.type == BT_REAL)
+ mpfr_sinh (result->value.real, x->value.real, GFC_RND_MODE);
+ else if (x->ts.type == BT_COMPLEX)
+ {
+#if HAVE_mpc
+ mpc_sinh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+#else
+ gfc_free_expr (result);
+ return NULL;
+#endif
+ }
+ else
+ gcc_unreachable ();
+
return range_check (result, "SINH");
}
gfc_expr *
gfc_simplify_tan (gfc_expr *x)
{
- int i;
gfc_expr *result;
if (x->expr_type != EXPR_CONSTANT)
return NULL;
- i = gfc_validate_kind (BT_REAL, x->ts.kind, false);
-
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
- mpfr_tan (result->value.real, x->value.real, GFC_RND_MODE);
+ if (x->ts.type == BT_REAL)
+ mpfr_tan (result->value.real, x->value.real, GFC_RND_MODE);
+ else if (x->ts.type == BT_COMPLEX)
+ {
+#if HAVE_mpc
+ mpc_tan (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+#else
+ gfc_free_expr (result);
+ return NULL;
+#endif
+ }
+ else
+ gcc_unreachable ();
return range_check (result, "TAN");
}
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
- mpfr_tanh (result->value.real, x->value.real, GFC_RND_MODE);
+ if (x->ts.type == BT_REAL)
+ mpfr_tanh (result->value.real, x->value.real, GFC_RND_MODE);
+ else if (x->ts.type == BT_COMPLEX)
+ {
+#if HAVE_mpc
+ mpc_tanh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+#else
+ gfc_free_expr (result);
+ return NULL;
+#endif
+ }
+ else
+ gcc_unreachable ();
return range_check (result, "TANH");
+2009-07-25 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/33197
+ * gfortran.dg/complex_intrinsic_5.f90: New test.
+ * gfortran.dg/complex_intrinsic_7.f90: New test.
+
2009-07-25 Martin Jambor <mjambor@suse.cz>
* gcc.c-torture/execute/pr17377.c: Add noclone attribute to function y.
--- /dev/null
+! { dg-do run }
+!
+! PR fortran/33197
+!
+! Complex inverse trigonometric functions
+! and complex inverse hyperbolic functions
+!
+! Run-time evaluation check
+!
+module test
+ implicit none
+ real(4), parameter :: eps4 = epsilon(0.0_4)*2.0_4
+ real(8), parameter :: eps8 = epsilon(0.0_8)*2.0_8
+ interface check
+ procedure check4, check8
+ end interface check
+contains
+ SUBROUTINE check4(z, zref)
+ complex(4), intent(in) :: z, zref
+ if ( abs (real(z)-real(zref)) > eps4 &
+ .or.abs (aimag(z)-aimag(zref)) > eps4) then
+ print '(a,/,2((2g0," + I ",g0),/))', "check4:"," z=",z,'zref=',zref
+ print '(a,g0," + I*",g0," eps=",g0)', 'Diff: ', &
+ real(z)-real(zref), &
+ aimag(z)-aimag(zref), eps4
+ call abort()
+ end if
+ END SUBROUTINE check4
+ SUBROUTINE check8(z, zref)
+ complex(8), intent(in) :: z, zref
+ if ( abs (real(z)-real(zref)) > eps8 &
+ .or.abs (aimag(z)-aimag(zref)) > eps8) then
+ print '(a,/,2((2g0," + I ",g0),/))', "check8:"," z=",z,'zref=',zref
+ print '(a,g0," + I*",g0," eps=",g0)', 'Diff: ', &
+ real(z)-real(zref), &
+ aimag(z)-aimag(zref), eps8
+ call abort()
+ end if
+ END SUBROUTINE check8
+end module test
+
+PROGRAM ArcTrigHyp
+ use test
+ IMPLICIT NONE
+ complex(4), volatile :: z4
+ complex(8), volatile :: z8
+
+!!!!! ZERO !!!!!!
+
+ ! z = 0
+ z4 = cmplx(0.0_4, 0.0_4, kind=4)
+ z8 = cmplx(0.0_8, 0.0_8, kind=8)
+
+ ! Exact: 0
+ call check(asin(z4), cmplx(0.0_4, 0.0_4, kind=4))
+ call check(asin(z8), cmplx(0.0_8, 0.0_8, kind=8))
+ ! Exact: Pi/2 = 1.5707963267948966192313216916397514
+ call check(acos(z4), cmplx(1.57079632679489661920_4, 0.0_4, kind=4))
+ call check(acos(z8), cmplx(1.57079632679489661920_8, 0.0_8, kind=8))
+ ! Exact: 0
+ call check(atan(z4), cmplx(0.0_4, 0.0_4, kind=4))
+ call check(atan(z8), cmplx(0.0_8, 0.0_8, kind=8))
+ ! Exact: 0
+ call check(asinh(z4), cmplx(0.0_4, 0.0_4, kind=4))
+ call check(asinh(z8), cmplx(0.0_8, 0.0_8, kind=8))
+ ! Exact: I*Pi/2 = I*1.5707963267948966192313216916397514
+ call check(acosh(z4), cmplx(0.0_4, 1.57079632679489661920_4, kind=4))
+ call check(acosh(z8), cmplx(0.0_8, 1.57079632679489661920_8, kind=8))
+ ! Exact: 0
+ call check(atanh(z4), cmplx(0.0_4, 0.0_4, kind=4))
+ call check(atanh(z8), cmplx(0.0_8, 0.0_8, kind=8))
+
+
+!!!!! POSITIVE NUMBERS !!!!!!
+
+ ! z = tanh(1.0)
+ z4 = cmplx(0.76159415595576488811945828260479359_4, 0.0_4, kind=4)
+ z8 = cmplx(0.76159415595576488811945828260479359_8, 0.0_8, kind=8)
+
+ ! Numerically: 0.86576948323965862428960184619184444
+ call check(asin(z4), cmplx(0.86576948323965862428960184619184444_4, 0.0_4, kind=4))
+ call check(asin(z8), cmplx(0.86576948323965862428960184619184444_8, 0.0_8, kind=8))
+ ! Numerically: 0.70502684355523799494171984544790700
+ call check(acos(z4), cmplx(0.70502684355523799494171984544790700_4, 0.0_4, kind=4))
+ call check(acos(z8), cmplx(0.70502684355523799494171984544790700_8, 0.0_8, kind=8))
+ ! Numerically: 0.65088016802300754993807813168285564
+ call check(atan(z4), cmplx(0.65088016802300754993807813168285564_4, 0.0_4, kind=4))
+ call check(atan(z8), cmplx(0.65088016802300754993807813168285564_8, 0.0_8, kind=8))
+ ! Numerically: 0.70239670712987482778422106260749699
+ call check(asinh(z4), cmplx(0.70239670712987482778422106260749699_4, 0.0_4, kind=4))
+ call check(asinh(z8), cmplx(0.70239670712987482778422106260749699_8, 0.0_8, kind=8))
+ ! Numerically: 0.70502684355523799494171984544790700*I
+ call check(acosh(z4), cmplx(0.0_4, 0.70502684355523799494171984544790700_4, kind=4))
+ call check(acosh(z8), cmplx(0.0_8, 0.70502684355523799494171984544790700_8, kind=8))
+ ! Exact: 1
+ call check(atanh(z4), cmplx(1.0_4, 0.0_4, kind=4))
+ call check(atanh(z8), cmplx(1.0_8, 0.0_8, kind=8))
+
+
+ ! z = I*tanh(1.0)
+ z4 = cmplx(0.0_4, 0.76159415595576488811945828260479359_4, kind=4)
+ z8 = cmplx(0.0_8, 0.76159415595576488811945828260479359_8, kind=8)
+
+ ! Numerically: I*0.70239670712987482778422106260749699
+ call check(asin(z4), cmplx(0.0_4, 0.70239670712987482778422106260749699_4, kind=4))
+ call check(asin(z8), cmplx(0.0_8, 0.70239670712987482778422106260749699_8, kind=8))
+ ! Numerically: 1.5707963267948966192313216916397514 - I*0.7023967071298748277842210626074970
+ call check(acos(z4), cmplx(1.5707963267948966192313216916397514_4, -0.7023967071298748277842210626074970_4, kind=4))
+ call check(acos(z8), cmplx(1.5707963267948966192313216916397514_8, -0.7023967071298748277842210626074970_8, kind=8))
+ ! Exact: I*1
+ call check(atan(z4), cmplx(0.0_4, 1.0_4, kind=4))
+ call check(atan(z8), cmplx(0.0_8, 1.0_8, kind=8))
+ ! Numerically: I*0.86576948323965862428960184619184444
+ call check(asinh(z4), cmplx(0.0_4, 0.86576948323965862428960184619184444_4, kind=4))
+ call check(asinh(z8), cmplx(0.0_8, 0.86576948323965862428960184619184444_8, kind=8))
+ ! Numerically: 0.7023967071298748277842210626074970 + I*1.5707963267948966192313216916397514
+ call check(acosh(z4), cmplx(0.7023967071298748277842210626074970_4, 1.5707963267948966192313216916397514_4, kind=4))
+ call check(acosh(z8), cmplx(0.7023967071298748277842210626074970_8, 1.5707963267948966192313216916397514_8, kind=8))
+ ! Numerically: I*0.65088016802300754993807813168285564
+ call check(atanh(z4), cmplx(0.0_4, 0.65088016802300754993807813168285564_4, kind=4))
+ call check(atanh(z8), cmplx(0.0_8, 0.65088016802300754993807813168285564_8, kind=8))
+
+
+ ! z = (1+I)*tanh(1.0)
+ z4 = cmplx(0.76159415595576488811945828260479359_4, 0.76159415595576488811945828260479359_4, kind=4)
+ z8 = cmplx(0.76159415595576488811945828260479359_8, 0.76159415595576488811945828260479359_8, kind=8)
+
+ ! Numerically: 0.59507386031622633330574869409179139 + I*0.82342412550090412964986631390412834
+ call check(asin(z4), cmplx(0.59507386031622633330574869409179139_4, 0.82342412550090412964986631390412834_4, kind=4))
+ call check(asin(z8), cmplx(0.59507386031622633330574869409179139_8, 0.82342412550090412964986631390412834_8, kind=8))
+ ! Numerically: 0.97572246647867028592557299754796005 - I*0.82342412550090412964986631390412834
+ call check(acos(z4), cmplx(0.97572246647867028592557299754796005_4, -0.82342412550090412964986631390412834_4, kind=4))
+ call check(acos(z8), cmplx(0.97572246647867028592557299754796005_8, -0.82342412550090412964986631390412834_8, kind=8))
+ ! Numerically: 0.83774433133636226305479129936568267 + I*0.43874835208710654149508159123595167
+ call check(atan(z4), cmplx(0.83774433133636226305479129936568267_4, 0.43874835208710654149508159123595167_4, kind=4))
+ call check(atan(z8), cmplx(0.83774433133636226305479129936568267_8, 0.43874835208710654149508159123595167_8, kind=8))
+ ! Numerically: 0.82342412550090412964986631390412834 + I*0.59507386031622633330574869409179139
+ call check(asinh(z4), cmplx(0.82342412550090412964986631390412834_4, 0.59507386031622633330574869409179139_4, kind=4))
+ call check(asinh(z8), cmplx(0.82342412550090412964986631390412834_8, 0.59507386031622633330574869409179139_8, kind=8))
+ ! Numerically: 0.82342412550090412964986631390412834 + I*0.97572246647867028592557299754796005
+ call check(acosh(z4), cmplx(0.82342412550090412964986631390412834_4, 0.97572246647867028592557299754796005_4, kind=4))
+ call check(acosh(z8), cmplx(0.82342412550090412964986631390412834_8, 0.97572246647867028592557299754796005_8, kind=8))
+ ! Numerically: 0.43874835208710654149508159123595167 + I*0.83774433133636226305479129936568267
+ call check(atanh(z4), cmplx(0.43874835208710654149508159123595167_4, 0.83774433133636226305479129936568267_4, kind=4))
+ call check(atanh(z8), cmplx(0.43874835208710654149508159123595167_8, 0.83774433133636226305479129936568267_8, kind=8))
+
+
+ ! z = 1+I
+ z4 = cmplx(1.0_4, 1.0_4, kind=4)
+ z8 = cmplx(1.0_8, 1.0_8, kind=8)
+
+ ! Numerically: 0.66623943249251525510400489597779272 + I*1.06127506190503565203301891621357349
+ call check(asin(z4), cmplx(0.66623943249251525510400489597779272_4, 1.06127506190503565203301891621357349_4, kind=4))
+ call check(asin(z8), cmplx(0.66623943249251525510400489597779272_8, 1.06127506190503565203301891621357349_8, kind=8))
+ ! Numerically: 0.90455689430238136412731679566195872 - I*1.06127506190503565203301891621357349
+ call check(acos(z4), cmplx(0.90455689430238136412731679566195872_4, -1.06127506190503565203301891621357349_4, kind=4))
+ call check(acos(z8), cmplx(0.90455689430238136412731679566195872_8, -1.06127506190503565203301891621357349_8, kind=8))
+ ! Numerically: 1.01722196789785136772278896155048292 + I*0.40235947810852509365018983330654691
+ call check(atan(z4), cmplx(1.01722196789785136772278896155048292_4, 0.40235947810852509365018983330654691_4, kind=4))
+ call check(atan(z8), cmplx(1.01722196789785136772278896155048292_8, 0.40235947810852509365018983330654691_8, kind=8))
+ ! Numerically: 1.06127506190503565203301891621357349 + I*0.66623943249251525510400489597779272
+ call check(asinh(z4), cmplx(1.06127506190503565203301891621357349_4, 0.66623943249251525510400489597779272_4, kind=4))
+ call check(asinh(z8), cmplx(1.06127506190503565203301891621357349_8, 0.66623943249251525510400489597779272_8, kind=8))
+ ! Numerically: 1.06127506190503565203301891621357349 + I*0.90455689430238136412731679566195872
+ call check(acosh(z4), cmplx(1.06127506190503565203301891621357349_4, 0.90455689430238136412731679566195872_4, kind=4))
+ call check(acosh(z8), cmplx(1.06127506190503565203301891621357349_8, 0.90455689430238136412731679566195872_8, kind=8))
+ ! Numerically: 0.40235947810852509365018983330654691 + I*1.01722196789785136772278896155048292
+ call check(atanh(z4), cmplx(0.40235947810852509365018983330654691_4, 1.01722196789785136772278896155048292_4, kind=4))
+ call check(atanh(z8), cmplx(0.40235947810852509365018983330654691_8, 1.01722196789785136772278896155048292_8, kind=8))
+
+
+ ! z = (1+I)*1.1
+ z4 = cmplx(1.1_4, 1.1_4, kind=4)
+ z8 = cmplx(1.1_8, 1.1_8, kind=8)
+
+ ! Numerically: 0.68549840630267734494444454677951503 + I*1.15012680127435581678415521738176733
+ call check(asin(z4), cmplx(0.68549840630267734494444454677951503_4, 1.15012680127435581678415521738176733_4, kind=4))
+ call check(asin(z8), cmplx(0.68549840630267734494444454677951503_8, 1.15012680127435581678415521738176733_8, kind=8))
+ ! Numerically: 0.8852979204922192742868771448602364 - I*1.1501268012743558167841552173817673
+ call check(acos(z4), cmplx(0.8852979204922192742868771448602364_4, -1.1501268012743558167841552173817673_4, kind=4))
+ call check(acos(z8), cmplx(0.8852979204922192742868771448602364_8, -1.1501268012743558167841552173817673_8, kind=8))
+ ! Numerically: 1.07198475450905931839240655913126728 + I*0.38187020129010862908881230531688930
+ call check(atan(z4), cmplx(1.07198475450905931839240655913126728_4, 0.38187020129010862908881230531688930_4, kind=4))
+ call check(atan(z8), cmplx(1.07198475450905931839240655913126728_8, 0.38187020129010862908881230531688930_8, kind=8))
+ ! Numerically: 1.15012680127435581678415521738176733 + I*0.68549840630267734494444454677951503
+ call check(asinh(z4), cmplx(1.15012680127435581678415521738176733_4, 0.68549840630267734494444454677951503_4, kind=4))
+ call check(asinh(z8), cmplx(1.15012680127435581678415521738176733_8, 0.68549840630267734494444454677951503_8, kind=8))
+ ! Numerically: 1.1501268012743558167841552173817673 + I*0.8852979204922192742868771448602364
+ call check(acosh(z4), cmplx(1.1501268012743558167841552173817673_4, 0.8852979204922192742868771448602364_4, kind=4))
+ call check(acosh(z8), cmplx(1.1501268012743558167841552173817673_8, 0.8852979204922192742868771448602364_8, kind=8))
+ ! Numerically: 0.38187020129010862908881230531688930 + I*1.07198475450905931839240655913126728
+ call check(atanh(z4), cmplx(0.38187020129010862908881230531688930_4, 1.07198475450905931839240655913126728_4, kind=4))
+ call check(atanh(z8), cmplx(0.38187020129010862908881230531688930_8, 1.07198475450905931839240655913126728_8, kind=8))
+
+
+!!!!! Negative NUMBERS !!!!!!
+ ! z = -(1+I)*1.1
+ z4 = cmplx(-1.1_4, -1.1_4, kind=4)
+ z8 = cmplx(-1.1_8, -1.1_8, kind=8)
+
+ ! Numerically: -0.68549840630267734494444454677951503 - I*1.15012680127435581678415521738176733
+ call check(asin(z4), cmplx(-0.68549840630267734494444454677951503_4, -1.15012680127435581678415521738176733_4, kind=4))
+ call check(asin(z8), cmplx(-0.68549840630267734494444454677951503_8, -1.15012680127435581678415521738176733_8, kind=8))
+ ! Numerically: 2.2562947330975739641757662384192665 + I*1.1501268012743558167841552173817673
+ call check(acos(z4), cmplx(2.2562947330975739641757662384192665_4, 1.1501268012743558167841552173817673_4, kind=4))
+ call check(acos(z8), cmplx(2.2562947330975739641757662384192665_8, 1.1501268012743558167841552173817673_8, kind=8))
+ ! Numerically: -1.07198475450905931839240655913126728 - I*0.38187020129010862908881230531688930
+ call check(atan(z4), cmplx(-1.07198475450905931839240655913126728_4, -0.38187020129010862908881230531688930_4, kind=4))
+ call check(atan(z8), cmplx(-1.07198475450905931839240655913126728_8, -0.38187020129010862908881230531688930_8, kind=8))
+ ! Numerically: -1.15012680127435581678415521738176733 - I*0.68549840630267734494444454677951503
+ call check(asinh(z4), cmplx(-1.15012680127435581678415521738176733_4, -0.68549840630267734494444454677951503_4, kind=4))
+ call check(asinh(z8), cmplx(-1.15012680127435581678415521738176733_8, -0.68549840630267734494444454677951503_8, kind=8))
+ ! Numerically: 1.1501268012743558167841552173817673 - I*2.2562947330975739641757662384192665
+ call check(acosh(z4), cmplx(1.1501268012743558167841552173817673_4, -2.2562947330975739641757662384192665_4, kind=4))
+ call check(acosh(z8), cmplx(1.1501268012743558167841552173817673_8, -2.2562947330975739641757662384192665_8, kind=8))
+ ! Numerically: 0.38187020129010862908881230531688930 + I*1.07198475450905931839240655913126728
+ call check(atanh(z4), cmplx(-0.38187020129010862908881230531688930_4, -1.07198475450905931839240655913126728_4, kind=4))
+ call check(atanh(z8), cmplx(-0.38187020129010862908881230531688930_8, -1.07198475450905931839240655913126728_8, kind=8))
+END PROGRAM ArcTrigHyp
+
+! { dg-final { cleanup-modules "test" } }
--- /dev/null
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/33197
+! PR fortran/40728
+!
+! Complex inverse trigonometric functions
+! and complex inverse hyperbolic functions
+!
+! Argument type check
+!
+
+PROGRAM ArcTrigHyp
+ IMPLICIT NONE
+ real(4), volatile :: r4
+ real(8), volatile :: r8
+ complex(4), volatile :: z4
+ complex(8), volatile :: z8
+
+ r4 = 0.0_4
+ r8 = 0.0_8
+ z4 = cmplx(0.0_4, 0.0_4, kind=4)
+ z8 = cmplx(0.0_8, 0.0_8, kind=8)
+
+ r4 = asin(r4)
+ r8 = asin(r8)
+ r4 = acos(r4)
+ r8 = acos(r8)
+ r4 = atan(r4)
+ r8 = atan(r8)
+
+! a(sin,cos,tan)h cannot be checked as they are not part of
+! Fortran 2003 - not even for real arguments
+
+ z4 = asin(z4) ! { dg-error "Fortran 2008: COMPLEX argument" }
+ z8 = asin(z8) ! { dg-error "Fortran 2008: COMPLEX argument" }
+ z4 = acos(z4) ! { dg-error "Fortran 2008: COMPLEX argument" }
+ z8 = acos(z8) ! { dg-error "Fortran 2008: COMPLEX argument" }
+ z4 = atan(z4) ! { dg-error "Fortran 2008: COMPLEX argument" }
+ z8 = atan(z8) ! { dg-error "Fortran 2008: COMPLEX argument" }
+END PROGRAM ArcTrigHyp
--- /dev/null
+! { dg-do compile }
+! { dg-require-effective-target mpc }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/33197
+!
+! Fortran 2008 complex trigonometric functions: tan, cosh, sinh, tanh
+!
+! Compile-time simplificiations
+!
+implicit none
+real(4), parameter :: pi = 2*acos(0.0_4)
+real(8), parameter :: pi8 = 2*acos(0.0_8)
+real(4), parameter :: eps = 10*epsilon(0.0_4)
+real(8), parameter :: eps8 = 10*epsilon(0.0_8)
+complex(4), parameter :: z0_0 = cmplx(0.0_4, 0.0_4, kind=4)
+complex(4), parameter :: z1_1 = cmplx(1.0_4, 1.0_4, kind=4)
+complex(4), parameter :: zp_p = cmplx(pi, pi, kind=4)
+complex(8), parameter :: z80_0 = cmplx(0.0_8, 0.0_8, kind=8)
+complex(8), parameter :: z81_1 = cmplx(1.0_8, 1.0_8, kind=8)
+complex(8), parameter :: z8p_p = cmplx(pi8, pi8, kind=8)
+
+if (abs(tan(z0_0) - cmplx(0.0,0.0,4)) > eps) call abort()
+if (abs(tan(z1_1) - cmplx(0.27175257,1.0839232,4)) > eps) call abort()
+if (abs(tan(z80_0) - cmplx(0.0_8,0.0_8,8)) > eps8) call abort()
+if (abs(tan(z81_1) - cmplx(0.27175258531951174_8,1.0839233273386946_8,8)) > eps8) call abort()
+
+if (abs(cosh(z0_0) - cmplx(1.0,0.0,4)) > eps) call abort()
+if (abs(cosh(z1_1) - cmplx(0.83372992,0.98889768,4)) > eps) call abort()
+if (abs(cosh(z80_0) - cmplx(1.0_8,0.0_8,8)) > eps8) call abort()
+if (abs(cosh(z81_1) - cmplx(0.83373002513114913_8,0.98889770576286506_8,8)) > eps8) call abort()
+
+if (abs(sinh(z0_0) - cmplx(0.0,0.0,4)) > eps) call abort()
+if (abs(sinh(z1_1) - cmplx(0.63496387,1.2984575,4)) > eps) call abort()
+if (abs(sinh(z80_0) - cmplx(0.0_8,0.0_8,8)) > eps8) call abort()
+if (abs(sinh(z81_1) - cmplx(0.63496391478473613_8,1.2984575814159773_8,8)) > eps8) call abort()
+
+if (abs(tanh(z0_0) - cmplx(0.0,0.0,4)) > eps) call abort()
+if (abs(tanh(z1_1) - cmplx(1.0839232,0.27175257,4)) > eps) call abort()
+if (abs(tanh(z80_0) - cmplx(0.0_8,0.0_8,8)) > eps8) call abort()
+if (abs(tanh(z81_1) - cmplx(1.0839233273386946_8,0.27175258531951174_8,8)) > eps8) call abort()
+
+end
+! { dg-final { scan-tree-dump-times "abort" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+2009-07-25 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/33197
+ * intrinsics/c99_functions.c (cacosf,cacos,cacosl,casinf,
+ casin,casind,catanf,catan,catanl,cacoshf,cacosh,cacoshl,
+ casinhf,casinh,casinhf,catanhf,catanh,catanhl): New functions.
+ * c99_protos.h: Add prototypes for those.
+
2009-07-24 Jakub Jelinek <jakub@redhat.com>
PR fortran/40643
#endif
+/* Complex ACOS. */
+
+#if !defined(HAVE_CACOSF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
+#define HAVE_CACOSF 1
+extern complex float cacosf (complex float z);
+#endif
+
+#if !defined(HAVE_CACOS) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
+#define HAVE_CACOS 1
+extern complex double cacos (complex double z);
+#endif
+
+#if !defined(HAVE_CACOSL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
+#define HAVE_CACOSL 1
+extern complex long double cacosl (complex long double z);
+#endif
+
+
+/* Complex ASIN. */
+
+#if !defined(HAVE_CASINF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
+#define HAVE_CASINF 1
+extern complex float casinf (complex float z);
+#endif
+
+#if !defined(HAVE_CASIN) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
+#define HAVE_CASIN 1
+extern complex double casin (complex double z);
+#endif
+
+#if !defined(HAVE_CASINL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
+#define HAVE_CASINL 1
+extern complex long double casinl (complex long double z);
+#endif
+
+
+/* Complex ATAN. */
+
+#if !defined(HAVE_CATANF) && defined(HAVE_CLOGF)
+#define HAVE_CATANF 1
+extern complex float catanf (complex float z);
+#endif
+
+#if !defined(HAVE_CATAN) && defined(HAVE_CLOG)
+#define HAVE_CATAN 1
+extern complex double catan (complex double z);
+#endif
+
+#if !defined(HAVE_CATANL) && defined(HAVE_CLOGL)
+#define HAVE_CATANL 1
+extern complex long double catanl (complex long double z);
+#endif
+
+
+/* Complex ASINH. */
+
+#if !defined(HAVE_CASINHF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
+#define HAVE_CASINHF 1
+extern complex float casinhf (complex float z);
+#endif
+
+
+#if !defined(HAVE_CASINH) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
+#define HAVE_CASINH 1
+extern complex double casinh (complex double z);
+#endif
+
+#if !defined(HAVE_CASINHL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
+#define HAVE_CASINHL 1
+extern complex long double casinhl (complex long double z);
+#endif
+
+
+/* Complex ACOSH. */
+
+#if !defined(HAVE_CACOSHF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
+#define HAVE_CACOSHF 1
+extern complex float cacoshf (complex float z);
+#endif
+
+#if !defined(HAVE_CACOSH) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
+#define HAVE_CACOSH 1
+extern complex double cacosh (complex double z);
+#endif
+
+#if !defined(HAVE_CACOSHL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
+#define HAVE_CACOSHL 1
+extern complex long double cacoshl (complex long double z);
+#endif
+
+
+/* Complex ATANH. */
+
+#if !defined(HAVE_CATANHF) && defined(HAVE_CLOGF)
+#define HAVE_CATANHF 1
+extern complex float catanhf (complex float z);
+#endif
+
+#if !defined(HAVE_CATANH) && defined(HAVE_CLOG)
+#define HAVE_CATANH 1
+extern complex double catanh (complex double z);
+#endif
+
+#if !defined(HAVE_CATANHL) && defined(HAVE_CLOGL)
+#define HAVE_CATANHL 1
+extern complex long double catanhl (complex long double z);
+#endif
+
+
/* Gamma-related prototypes. */
#if !defined(HAVE_TGAMMA)
#define HAVE_TGAMMA 1
#endif
+/* Complex ASIN. Returns wrongly NaN for infinite arguments.
+ Algorithm taken from Abramowitz & Stegun. */
+
+#if !defined(HAVE_CASINF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
+#define HAVE_CASINF 1
+complex float
+casinf (complex float z)
+{
+ return -I*clogf (I*z + csqrtf (1.0f-z*z));
+}
+#endif
+
+
+#if !defined(HAVE_CASIN) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
+#define HAVE_CASIN 1
+complex double
+casin (complex double z)
+{
+ return -I*clog (I*z + csqrt (1.0-z*z));
+}
+#endif
+
+
+#if !defined(HAVE_CASINL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
+#define HAVE_CASINL 1
+complex long double
+casinl (complex long double z)
+{
+ return -I*clogl (I*z + csqrtl (1.0L-z*z));
+}
+#endif
+
+
+/* Complex ACOS. Returns wrongly NaN for infinite arguments.
+ Algorithm taken from Abramowitz & Stegun. */
+
+#if !defined(HAVE_CACOSF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
+#define HAVE_CACOSF 1
+complex float
+cacosf (complex float z)
+{
+ return -I*clogf (z + I*csqrtf(1.0f-z*z));
+}
+#endif
+
+
+complex double
+#if !defined(HAVE_CACOS) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
+#define HAVE_CACOS 1
+cacos (complex double z)
+{
+ return -I*clog (z + I*csqrt (1.0-z*z));
+}
+#endif
+
+
+#if !defined(HAVE_CACOSL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
+#define HAVE_CACOSL 1
+complex long double
+cacosl (complex long double z)
+{
+ return -I*clogl (z + I*csqrtl (1.0L-z*z));
+}
+#endif
+
+
+/* Complex ATAN. Returns wrongly NaN for infinite arguments.
+ Algorithm taken from Abramowitz & Stegun. */
+
+#if !defined(HAVE_CATANF) && defined(HAVE_CLOGF)
+#define HAVE_CACOSF 1
+complex float
+catanf (complex float z)
+{
+ return I*clogf ((I+z)/(I-z))/2.0f;
+}
+#endif
+
+
+#if !defined(HAVE_CATAN) && defined(HAVE_CLOG)
+#define HAVE_CACOS 1
+complex double
+catan (complex double z)
+{
+ return I*clog ((I+z)/(I-z))/2.0;
+}
+#endif
+
+
+#if !defined(HAVE_CATANL) && defined(HAVE_CLOGL)
+#define HAVE_CACOSL 1
+complex long double
+catanl (complex long double z)
+{
+ return I*clogl ((I+z)/(I-z))/2.0L;
+}
+#endif
+
+
+/* Complex ASINH. Returns wrongly NaN for infinite arguments.
+ Algorithm taken from Abramowitz & Stegun. */
+
+#if !defined(HAVE_CASINHF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
+#define HAVE_CASINHF 1
+complex float
+casinhf (complex float z)
+{
+ return clogf (z + csqrtf (z*z+1.0f));
+}
+#endif
+
+
+#if !defined(HAVE_CASINH) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
+#define HAVE_CASINH 1
+complex double
+casinh (complex double z)
+{
+ return clog (z + csqrt (z*z+1.0));
+}
+#endif
+
+
+#if !defined(HAVE_CASINHL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
+#define HAVE_CASINHL 1
+complex long double
+casinhl (complex long double z)
+{
+ return clogl (z + csqrtl (z*z+1.0L));
+}
+#endif
+
+
+/* Complex ACOSH. Returns wrongly NaN for infinite arguments.
+ Algorithm taken from Abramowitz & Stegun. */
+
+#if !defined(HAVE_CACOSHF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF)
+#define HAVE_CACOSHF 1
+complex float
+cacoshf (complex float z)
+{
+ return clogf (z + csqrtf (z-1.0f) * csqrtf (z+1.0f));
+}
+#endif
+
+
+#if !defined(HAVE_CACOSH) && defined(HAVE_CLOG) && defined(HAVE_CSQRT)
+#define HAVE_CACOSH 1
+complex double
+cacosh (complex double z)
+{
+ return clog (z + csqrt (z-1.0) * csqrt (z+1.0));
+}
+#endif
+
+
+#if !defined(HAVE_CACOSHL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL)
+#define HAVE_CACOSHL 1
+complex long double
+cacoshl (complex long double z)
+{
+ return clogl (z + csqrtl (z-1.0L) * csqrtl (z+1.0L));
+}
+#endif
+
+
+/* Complex ATANH. Returns wrongly NaN for infinite arguments.
+ Algorithm taken from Abramowitz & Stegun. */
+
+#if !defined(HAVE_CATANHF) && defined(HAVE_CLOGF)
+#define HAVE_CATANHF 1
+complex float
+catanhf (complex float z)
+{
+ return clogf ((1.0f+z)/(1.0f-z))/2.0f;
+}
+#endif
+
+
+#if !defined(HAVE_CATANH) && defined(HAVE_CLOG)
+#define HAVE_CATANH 1
+complex double
+catanh (complex double z)
+{
+ return clog ((1.0+z)/(1.0-z))/2.0;
+}
+#endif
+
+#if !defined(HAVE_CATANHL) && defined(HAVE_CLOGL)
+#define HAVE_CATANHL 1
+complex long double
+catanhl (complex long double z)
+{
+ return clogl ((1.0L+z)/(1.0L-z))/2.0L;
+}
+#endif
+
+
#if !defined(HAVE_TGAMMA)
#define HAVE_TGAMMA 1
projects / thirdparty / gcc.git / commitdiff
