dunvec.f

Go to the documentation of this file.

CCCC                                                                            
C                                                                               
      SUBROUTINE dunvec (A, AU, AMAG)                                           
C                                                                               
    1 FORMAT(' *** SUBROUTINE DUNVEC  MARCH 11, 1987 ***')                      
C                                                                               
C-----LANGUAGE - VS FORTRAN                                                     
C                                                                               
C-----FUNCTION -  UNITIZES A VECTOR AND COMPUTES ITS MAGNITUDE                  
C                                                                               
C-----MATHEMATICAL METHOD -                                                     
C                                                                               
C-----ARGUMENTS -                                                               
C     ARGUMENT    TYPE  IO  DESCRIPTION                                         
C     --------    ----  --  -----------                                         
C     A(3)        R*8   I   INPUT VECTOR                                        
C     AU(3)       R*8   O   OUTPUT UNIT VECTOR OF A                             
C     AMAG        R*8   O   MAGNITUDE OF A                                      
C                                                                               
C-----EXTERNAL REFERENCES - NONE                                                
C                                                                               
C-----CALLED BY - ANY                                                           
C                                                                               
C-----COMMONS REFERENCED - NONE                                                 
C                                                                               
C-----ERROR HANDLING - NONE                                                     
C                                                                               
C-----FILES REFERENCED - NONE                                                   
C                                                                               
C-----DESIGNER - R. COON  CSC  03/01/87                                         
C                                                                               
C-----PROGRAMMER - R. COON  CSC  MARCH 11, 1987                                 
C                                                                               
C-----VERIFIED BY - K. P. WASCZKIEWICZ  CSC  MARCH 11, 1987                     
C                                                                               
C-----MODIFICATIONS -                                                           
C     NAME DATE DESCRIPTION                                                     
C M. WOOLSEY  JAN.89  INSTALLED UNDERFLOW ERROR TRAP                            
CCCC                                                                            
C     DECLARE ARGUMENTS                                                         
      real*8 a(3), au(3), amag                                                  
C                                                                               
      amag = dsqrt(a(1)**2 + a(2)**2 + a(3)**2)                                 
      IF (amag .NE. 0.0d+00 .AND. dabs(amag) .LT. 1.0d32) THEN                 
        IF (dabs(a(1)) .GT. 1.0d-32) THEN                                     
          au(1)=a(1)/amag                                                       
        ELSE                                                                    
          au(1) = 0.d0                                                         
        END IF                                                                  
        IF (dabs(a(2)) .GT. 1.0d-32) THEN                                     
          au(2)=a(2)/amag                                                       
        ELSE                                                                    
          au(2) = 0.d0                                                         
        END IF                                                                  
        IF (dabs(a(3)) .GT. 1.0d-32) THEN                                     
          au(3)=a(3)/amag                                                       
        ELSE                                                                    
          au(3) = 0.d0                                                         
        END IF                                                                  
      ELSE                                                                      
        au(1)=0.0d+00                                                           
        au(2)=0.0d+00                                                           
        au(3)=0.0d+00                                                           
      END IF                                                                    
C                                                                               
      RETURN                                                                    
      END