| Type | Intent | Optional | 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 |
| Type | Visibility | Attributes | Name | Initial | |||
|---|---|---|---|---|---|---|---|
| real(kind=R8), | public | :: | DENOM | ||||
| real(kind=R8), | public | :: | XNUM |
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