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_divf.F,v 1.1.1.1 2005/10/21 19:00:00 marcel Exp $
00037
00038 double complex function z_div(a, b)
00039 double precision a(2), b(2), c(2)
00040 double precision ratio, den
00041 double precision abr, abi
00042
00043 abr = b(1)
00044 abi = b(2)
00045 if( abr .lt. 0.) then
00046 abr = - abr
00047 end if
00048 if( abi .lt. 0.) then
00049 abi = - abi
00050 end if
00051 if( abr .le. abi ) then
00052 if(abi .eq. 0) then
00053 C fatal("complex division by zero")
00054 call abort()
00055 end if
00056 ratio = b(1) / b(2)
00057 den = b(2) * (1 + ratio*ratio)
00058 c(1) = (a(1)*ratio + a(2)) / den
00059 c(2) = (a(2)*ratio - a(1)) / den
00060 else
00061 ratio = b(2) / b(1)
00062 den = b(1) * (1 + ratio*ratio)
00063 c(1) = (a(1) + a(2)*ratio) / den
00064 c(2) = (a(2) - a(1)*ratio) / den
00065 end if
00066 z_div = dcmplx(c(1), c(2))
00067 return
00068 end
00069
00070
00071
