00001 C
00002 C
00003 C Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved.
00004 C
00005 C This program is free software; you can redistribute it and/or modify it
00006 C under the terms of version 2.1 of the GNU Lesser General Public License
00007 C as published by the Free Software Foundation.
00008 C
00009 C This program is distributed in the hope that it would be useful, but
00010 C WITHOUT ANY WARRANTY; without even the implied warranty of
00011 C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
00012 C
00013 C Further, this software is distributed without any warranty that it is
00014 C free of the rightful claim of any third person regarding infringement
00015 C or the like. Any license provided herein, whether implied or
00016 C otherwise, applies only to this software file. Patent licenses, if
00017 C any, provided herein do not apply to combinations of this program with
00018 C other software, or any other product whatsoever.
00019 C
00020 C You should have received a copy of the GNU Lesser General Public
00021 C License along with this program; if not, write the Free Software
00022 C Foundation, Inc., 59 Temple Place - Suite 330, Boston MA 02111-1307,
00023 C USA.
00024 C
00025 C Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky,
00026 C Mountain View, CA 94043, or:
00027 C
00028 C http://www.sgi.com
00029 C
00030 C For further information regarding this notice, see:
00031 C
00032 C http://oss.sgi.com/projects/GenInfo/NoticeExplan
00033 C
00034 C
00035
00036 C $Header: /proj/osprey/CVS/open64/osprey1.0/libF77/z_sqrtf.F,v 1.1.1.1 2005/10/21 19:00:00 marcel Exp $
00037
00038 double complex function z_sqrt(z)
00039 double precision z(2), mag, r, i
00040
00041 mag = abs(dcmplx(z(1), z(2)))
00042 if (mag .eq. 0.0) then
00043 z_sqrt = (0.0, 0.0)
00044 return
00045 else
00046 if (z(1) .gt. 0.0) then
00047 r = sqrt(0.5 * (mag + z(1)))
00048 i = (z(2) / r) * 0.5
00049 else
00050 i = sqrt(0.5 * (mag - z(1)))
00051 if (z(2) .lt. 0.0) i = -i
00052 r = (z(2) / i) * 0.5
00053 end if
00054 z_sqrt = dcmplx(r, i)
00055 return
00056 end if
00057 end
