coline.f

Go to the documentation of this file.

      SUBROUTINE coline                                                        
     i          (iclma, iclmb, iclmc, lblclm, gciclm,                          
     o           coangl)                                                       
C-----------------------------------------------------------------------       
C   MODULE NAME:  STCOLINE                                                     
C                                                                              
C                                                                              
C   PURPOSE:  TO COMPUTE COLINEAR FUNCTION FOR STAR CLUMP TRIPLET              
C                                                                              
C                                                                              
C   ARGUMENT LIST:                                                             
C   ARGUMENT I/O TYPE DIMENS DESCRIPTION                                       
C   -------- --- ---- ------ -----------                                       
C   ICLMA    I   I*4         CLUMP NUMBER OF FIRST CLUMP OF TRIPLET            
C   ICLMB    I   I*4         CLUMP NUMBER OF SECOND CLUMP OF TRIPLET           
C   ICLMC    I   I*4         CLUMP NUMBER OF THIRD CLUMP OF TRIPLET            
C   LBLCLM   I   I*4         CLUMP LABLES                                      
C   GCICLM   I   R*4   3,*   AVERAGE CLUMP POSITIONS GCI                       
C   COANGL     O R*8         COLINEARITY ANGLE                                 
C                                                                              
C                                                                              
C   COMMON BLOCK VARIABLES USED:                                               
C   COMMON   VAR    I/O   VAR    I/O   VAR    I/O   VAR    I/O                 
C   ------   ---    ---   ---    ---   ---    ---   ---    ---                 
C   CMDEBG   LEVDBG I     LUDBUG I                                             
C                                                                              
C       ++INCLUDE STCMDEBG                                                      
      INTEGER*4 LEVDBG(8),LUDBUG
      COMMON /cmdebg/levdbg,ludbug
C                                                                              
C   EXTERNAL FILES REFERENCED:                                                 
C   FILENAME      OPERATION   FORTRAN UNIT ID                                  
C   --------      ---------   ---------------                                  
C   NONE                                                                       
C                                                                              
C   EXTERNAL REFERENCES:                                                       
C   --------------------------------------------------------------------       
C   UTDANGLE - FUNCTION TO COMPUTE ANGULAR SEPARATIONS BETWEEN VECTORS         
C                                                                              
C                                                                              
C   SUBROUTINE CALLED FROM:                                                    
C   --------------------------------------------------------------------       
C     STTRIPLT - STAR MATCHING TRIPLET ALGORITHM                               
C                                                                              
C                                                                              
C   CONSTRAINTS, RESTRICTIONS, MESSAGES, NOTES:                                
C   --------------------------------------------------------------------       
C   NONE                                                                       
C                                                                              
C   REQUIREMENTS REFERENCES:                                                   
C   --------------------------------------------------------------------       
C   UARS FDSS SPECS 3.1.1.5  (F5.3)                                            
C                                                                              
C   DEVELOPMENT HISTORY:                                                       
C   DATE     AUTHOR              DESCRIPTION                                   
C   -------- ------              -----------                                   
C   8/  8/88  R.J. BURLEY         DESIGN                                       
C   5/ 18/89  R.J. BURLEY         CODED                                        
C   10/24/89  R.J. BURLEY         SUBTRACT LARGEST ANGULAR SEPARATION          
C                                 FROM THE SUM OF THE OTHER 2, NOT             
C                                 VICE VERSA.                                  
C   11/ 6/89  R.J. BURLEY         ADD CLUMP LABLES                             
C-----------------------------------------------------------------------       
C   METHOD:                                                                    
C     COMPUTE ROTATION ANGLES BETWEEN 3 AVG CLUMP POSITIONS                  
C     RETURN THE SMALLEST ANGLE OF THE 3                             
C     REFERENCE:  WERTZ, APPENDIX A, EQ. A-2
C-----------------------------------------------------------------------       
C                                                                              
C     * DEFINE PARAMETER VARIABLES                                             
      real*8    coangl                                                         
C                                                                              
      real*4    gciclm(3,*)                                                    
C                                                                              
      INTEGER*4 LBLCLM(*),  ICLMA   , ICLMB    , ICLMC                         
C                                                                              
C     * DECLARE LOCAL VARIABLES                                                
      real*8    dangle   , angdif   , toler                                    
      real*8    e2clma(3), e2clmb(3), e2clmc(3)                                
      real*8    enclma(3), enclmb(3), enclmc(3), emag                     
      real*8    cang12   , cang13   , cang23   , pi , pio2
      real*8    cang1    , cang2    , cang3
      real*4    clma(3)  , clmb(3)  , clmc(3)
      INTEGER*4 IAXIS                                                          
      DATA      toler /0.99d0/                                                 
      DATA pi/3.14159265359d0/,pio2/1.570796327/
                                                                               
C                                                                              
C                                      INITIALIZE ROUTINE                      
C      IF (LEVDBG(7) .NE. 0) WRITE (LUDBUG,1000)                                
C                                                                              
C                                      COMPUTE ROTATION ANGLES             
      DO 100 iaxis = 1,3                                                       
        e2clma(iaxis) = gciclm(iaxis,iclma)                                    
        e2clmb(iaxis) = gciclm(iaxis,iclmb)                                    
        e2clmc(iaxis) = gciclm(iaxis,iclmc)                                    
100   CONTINUE                                                                 
      cang12 = dangle(e2clma,e2clmb, toler, angdif)                            
      cang13 = dangle(e2clma,e2clmc, toler, angdif)                            
      cang23 = dangle(e2clmb,e2clmc, toler, angdif)                            
 
      cang1 = acos((cos(cang23) - cos(cang12)*cos(cang13))/
     *  (sin(cang12)*sin(cang13)))
      cang2 = acos((cos(cang13) - cos(cang12)*cos(cang23))/
     *  (sin(cang12)*sin(cang23)))
      cang3 = acos((cos(cang12) - cos(cang13)*cos(cang23))/
     *  (sin(cang13)*sin(cang23)))
C                                                                              
C                                      FIND THE SMALLEST ANGLE            
      coangl = dmin1(cang1,cang2,cang3)
C                                                                              
C                                      DEBUG                                   
      IF (levdbg(7) .GE. 4) THEN                                               
        WRITE (ludbug,4000) lblclm(iclma), lblclm(iclmb),                      
     1                      lblclm(iclmc), coangl                              
      ENDIF                                                                    
C                                                                              
C                                      NORMAL TERMINATION                      
C      IF (LEVDBG(7) .NE. 0) WRITE (LUDBUG,2000)                                
      RETURN                                                                   
C                                                                              
C                                      FORMAT SECTION                          
1000  FORMAT(' *** ENTER COLINE ***')                                          
2000  FORMAT(' *** EXIT  COLINE ***')                                          
C4000  FORMAT(' STCOLINE DEBUG: ',                                             
4000  FORMAT(' COLINEAR ANGLE BETWEEN CLUMPS',3(2x,i6),' = ',d12.6)          
      END