00001 SUBROUTINE SLADIV( A, B, C, D, P, Q ) 00002 * 00003 * -- LAPACK auxiliary routine (version 3.2) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 REAL A, B, C, D, P, Q 00010 * .. 00011 * 00012 * Purpose 00013 * ======= 00014 * 00015 * SLADIV performs complex division in real arithmetic 00016 * 00017 * a + i*b 00018 * p + i*q = --------- 00019 * c + i*d 00020 * 00021 * The algorithm is due to Robert L. Smith and can be found 00022 * in D. Knuth, The art of Computer Programming, Vol.2, p.195 00023 * 00024 * Arguments 00025 * ========= 00026 * 00027 * A (input) REAL 00028 * B (input) REAL 00029 * C (input) REAL 00030 * D (input) REAL 00031 * The scalars a, b, c, and d in the above expression. 00032 * 00033 * P (output) REAL 00034 * Q (output) REAL 00035 * The scalars p and q in the above expression. 00036 * 00037 * ===================================================================== 00038 * 00039 * .. Local Scalars .. 00040 REAL E, F 00041 * .. 00042 * .. Intrinsic Functions .. 00043 INTRINSIC ABS 00044 * .. 00045 * .. Executable Statements .. 00046 * 00047 IF( ABS( D ).LT.ABS( C ) ) THEN 00048 E = D / C 00049 F = C + D*E 00050 P = ( A+B*E ) / F 00051 Q = ( B-A*E ) / F 00052 ELSE 00053 E = C / D 00054 F = D + C*E 00055 P = ( B+A*E ) / F 00056 Q = ( -A+B*E ) / F 00057 END IF 00058 * 00059 RETURN 00060 * 00061 * End of SLADIV 00062 * 00063 END
1.7.2