share/hompack/fortran/divp.f

   1       SUBROUTINE DIVP(XXXX,YYYY,ZZZZ,IERR)
   2 C
   3 C THIS SUBROUTINE PERFORMS DIVISION  OF COMPLEX NUMBERS:
   4 C ZZZZ = XXXX/YYYY
   5 C
   6 C ON INPUT:
   7 C
   8 C XXXX  IS AN ARRAY OF LENGTH TWO REPRESENTING THE FIRST COMPLEX
   9 C       NUMBER, WHERE XXXX(1) = REAL PART OF XXXX AND XXXX(2) =
  10 C       IMAGINARY PART OF XXXX.
  11 C
  12 C YYYY  IS AN ARRAY OF LENGTH TWO REPRESENTING THE SECOND COMPLEX
  13 C       NUMBER, WHERE YYYY(1) = REAL PART OF YYYY AND YYYY(2) =
  14 C       IMAGINARY PART OF YYYY.
  15 C
  16 C ON OUTPUT:
  17 C
  18 C ZZZZ  IS AN ARRAY OF LENGTH TWO REPRESENTING THE RESULT OF
  19 C       THE DIVISION, ZZZZ = XXXX/YYYY, WHERE ZZZZ(1) =
  20 C       REAL PART OF ZZZZ AND ZZZZ(2) = IMAGINARY PART OF ZZZZ.
  21 C
  22 C IERR =
  23 C  1   IF DIVISION WOULD HAVE CAUSED OVERFLOW.  IN THIS CASE, THE
  24 C      APPROPRIATE PARTS OF ZZZZ ARE SET EQUAL TO THE LARGEST
  25 C      FLOATING POINT NUMBER, AS GIVEN BY FUNCTION  D1MACH .
  26 C
  27 C  0   IF DIVISION DOES NOT CAUSE OVERFLOW.
  28 C
  29 C DECLARATION OF INPUT
  30       DOUBLE PRECISION XXXX,YYYY
  31       DIMENSION XXXX(2),YYYY(2)
  32 C
  33 C DECLARATION OF OUTPUT
  34       INTEGER IERR
  35       DOUBLE PRECISION ZZZZ
  36       DIMENSION ZZZZ(2)
  37 C
  38 C DECLARATION OF VARIABLES
  39       DOUBLE PRECISION DENOM,XNUM,D1MACH
  40 C
  41       IERR = 0
  42       DENOM = YYYY(1)*YYYY(1) + YYYY(2)*YYYY(2)
  43       XNUM    =   XXXX(1)*YYYY(1) + XXXX(2)*YYYY(2)
  44       IF (ABS(DENOM) .GE. 1.0  .OR.  ( ABS(DENOM) .LT. 1.0   .AND.
  45      $ ABS(XNUM)/D1MACH(2) .LT. ABS(DENOM) ) ) THEN
  46             ZZZZ(1) = XNUM/DENOM
  47           ELSE
  48             ZZZZ(1) = D1MACH(2)
  49             IERR =1
  50           END IF
  51       XNUM    =   XXXX(2)*YYYY(1) - XXXX(1)*YYYY(2)
  52       IF (ABS(DENOM) .GE. 1.0  .OR.  ( ABS(DENOM) .LT. 1.0   .AND.
  53      $ ABS(XNUM)/D1MACH(2) .LT. ABS(DENOM) ) ) THEN
  54             ZZZZ(2) = XNUM/DENOM
  55           ELSE
  56             ZZZZ(2) = D1MACH(2)
  57             IERR =1
  58           END IF
  59       RETURN
  60       END