OpenLibm/slatec/zsqrt.f
Viral B. Shah c977aa998f Add Makefile.extras to build libopenlibm-extras.
Replace amos with slatec
2012-12-31 16:37:05 -05:00

57 lines
1.5 KiB
Fortran

*DECK ZSQRT
SUBROUTINE ZSQRT (AR, AI, BR, BI)
C***BEGIN PROLOGUE ZSQRT
C***SUBSIDIARY
C***PURPOSE Subsidiary to ZBESH, ZBESI, ZBESJ, ZBESK, ZBESY, ZAIRY and
C ZBIRY
C***LIBRARY SLATEC
C***TYPE ALL (ZSQRT-A)
C***AUTHOR Amos, D. E., (SNL)
C***DESCRIPTION
C
C DOUBLE PRECISION COMPLEX SQUARE ROOT, B=CSQRT(A)
C
C***SEE ALSO ZAIRY, ZBESH, ZBESI, ZBESJ, ZBESK, ZBESY, ZBIRY
C***ROUTINES CALLED ZABS
C***REVISION HISTORY (YYMMDD)
C 830501 DATE WRITTEN
C 910415 Prologue converted to Version 4.0 format. (BAB)
C***END PROLOGUE ZSQRT
DOUBLE PRECISION AR, AI, BR, BI, ZM, DTHETA, DPI, DRT
DOUBLE PRECISION ZABS
EXTERNAL ZABS
DATA DRT , DPI / 7.071067811865475244008443621D-1,
1 3.141592653589793238462643383D+0/
C***FIRST EXECUTABLE STATEMENT ZSQRT
ZM = ZABS(AR,AI)
ZM = SQRT(ZM)
IF (AR.EQ.0.0D+0) GO TO 10
IF (AI.EQ.0.0D+0) GO TO 20
DTHETA = DATAN(AI/AR)
IF (DTHETA.LE.0.0D+0) GO TO 40
IF (AR.LT.0.0D+0) DTHETA = DTHETA - DPI
GO TO 50
10 IF (AI.GT.0.0D+0) GO TO 60
IF (AI.LT.0.0D+0) GO TO 70
BR = 0.0D+0
BI = 0.0D+0
RETURN
20 IF (AR.GT.0.0D+0) GO TO 30
BR = 0.0D+0
BI = SQRT(ABS(AR))
RETURN
30 BR = SQRT(AR)
BI = 0.0D+0
RETURN
40 IF (AR.LT.0.0D+0) DTHETA = DTHETA + DPI
50 DTHETA = DTHETA*0.5D+0
BR = ZM*COS(DTHETA)
BI = ZM*SIN(DTHETA)
RETURN
60 BR = ZM*DRT
BI = ZM*DRT
RETURN
70 BR = ZM*DRT
BI = -ZM*DRT
RETURN
END