DIVP Subroutine

subroutine DIVP(XXXX, YYYY, ZZZZ, IERR)

Uses

  • proc~~divp~~UsesGraph proc~divp DIVP module~real_precision REAL_PRECISION proc~divp->module~real_precision

Arguments

Type IntentOptional Attributes Name
real(kind=R8), intent(in), DIMENSION(2) :: XXXX
real(kind=R8), intent(in), DIMENSION(2) :: YYYY
real(kind=R8), intent(out), DIMENSION(2) :: ZZZZ
integer, intent(out) :: IERR

Variables

Type Visibility Attributes Name Initial
real(kind=R8), public :: DENOM
real(kind=R8), public :: XNUM

Source Code

      SUBROUTINE DIVP(XXXX,YYYY,ZZZZ,IERR)
C
C THIS SUBROUTINE PERFORMS DIVISION  OF COMPLEX NUMBERS:
C ZZZZ = XXXX/YYYY
C
C ON INPUT:
C
C XXXX  IS AN ARRAY OF LENGTH TWO REPRESENTING THE FIRST COMPLEX
C       NUMBER, WHERE XXXX(1) = REAL PART OF XXXX AND XXXX(2) =
C       IMAGINARY PART OF XXXX.
C
C YYYY  IS AN ARRAY OF LENGTH TWO REPRESENTING THE SECOND COMPLEX
C       NUMBER, WHERE YYYY(1) = REAL PART OF YYYY AND YYYY(2) =
C       IMAGINARY PART OF YYYY.
C
C ON OUTPUT:
C
C ZZZZ  IS AN ARRAY OF LENGTH TWO REPRESENTING THE RESULT OF
C       THE DIVISION, ZZZZ = XXXX/YYYY, WHERE ZZZZ(1) =
C       REAL PART OF ZZZZ AND ZZZZ(2) = IMAGINARY PART OF ZZZZ.
C
C IERR =
C  1   IF DIVISION WOULD HAVE CAUSED OVERFLOW.  IN THIS CASE, THE
C      APPROPRIATE PARTS OF ZZZZ ARE SET EQUAL TO THE LARGEST
C      FLOATING POINT NUMBER, AS GIVEN BY FUNCTION  HUGE .
C
C  0   IF DIVISION DOES NOT CAUSE OVERFLOW.
C
C DECLARATION OF INPUT
      USE REAL_PRECISION
      REAL (KIND=R8), DIMENSION(2), INTENT(IN):: XXXX,YYYY
C
C DECLARATION OF OUTPUT
      INTEGER, INTENT(OUT):: IERR
      REAL (KIND=R8), DIMENSION(2), INTENT(OUT):: ZZZZ
C
C DECLARATION OF VARIABLES
      REAL (KIND=R8):: DENOM,XNUM
C
      IERR = 0
      DENOM = YYYY(1)*YYYY(1) + YYYY(2)*YYYY(2)
      XNUM    =   XXXX(1)*YYYY(1) + XXXX(2)*YYYY(2)
      IF (ABS(DENOM) .GE. 1.0  .OR.  ( ABS(DENOM) .LT. 1.0   .AND.
     & ABS(XNUM)/HUGE(1.0_R8) .LT. ABS(DENOM) ) ) THEN
            ZZZZ(1) = XNUM/DENOM
          ELSE
            ZZZZ(1) = HUGE(1.0_R8)
            IERR =1
          END IF
      XNUM    =   XXXX(2)*YYYY(1) - XXXX(1)*YYYY(2)
      IF (ABS(DENOM) .GE. 1.0  .OR.  ( ABS(DENOM) .LT. 1.0   .AND.
     & ABS(XNUM)/HUGE(1.0_R8) .LT. ABS(DENOM) ) ) THEN
            ZZZZ(2) = XNUM/DENOM
          ELSE
            ZZZZ(2) = HUGE(1.0_R8)
            IERR =1
          END IF
      RETURN
      END SUBROUTINE DIVP