swapcl.f

Go to the documentation of this file.

      SUBROUTINE swapcl                                                         
     i    (iclmp1, iclmp2, ifxclm,                                              
     o     lblclm, timclm, briclm, gciclm, vrmclm, vrpclm, nobclm,              
     o     mrkclm, idfclm, nrfclm, mapclm, skyclm)                              
C-----------------------------------------------------------------------        
C   MODULE NAME: STSWAPCL                                                       
C                                                                               
C                                                                               
C   PURPOSE: TO SWAP ALL ELEMENTS OF 2 DIFFERENT CLUMPS DURING SORT.            
C                                                                               
C                                                                               
C   ARGUMENT LIST:                                                              
C   ARGUMENT I/O TYPE DIMENS DESCRIPTION                                        
C   -------- --- ---- ------ -----------                                        
C   ICLMP1   I   I*4         FIRST OF 2 CLUMPS TO SWAP                          
C   ICLMP2   I   I*4         SECOND CLUMP TO SWAP                               
C   IFXCLM   I   I*4         MAX NUMBER OF REF STAR MATCHES PER CLUMP           
C   LBLCLM   I O I*4    *    CLUMP LABELS                                       
C   TIMCLM   I O R*8    *    AVERAGE CLUMP TIMES                                
C   BRICLM   I O R*4    *    AVERAGE CLUMP MAGNITUDES                           
C   GCICLM   I O R*4   3,*   AVERAGE CLUMP POSITIONS (GCI)                      
C   VRMCLM   I O R*4    *    CLUMP MAGNITUDE VARIANCES                          
C   VRPCLM   I O R*4    *    CLUMP POSITION VARIANCES                           
C   NOBCLM   I O I*4    *    NUMBER OF OBSERVATIONS IN EACH CLUMP               
C   MRKCLM   I O I*4    *    STATUS FLAG FOR EACH CLUMP                         
C   IDFCLM   I O I*4    *    IDENTIFICATION FLAG FOR EACH CLUMP                 
C   NRFCLM   I O I*4    *    # OF REFERENCE STAR MATCHES FOR EACH CLUMP         
C   MAPCLM   I O I*4  10,*   SKYMAP ID NUMBER OF REFERENCE STAR MATCHES         
C   SKYCLM   I O R*4 10,3,*  LIST OF CORRECTED REFERENCE STAR POSITIONS         
C                               (MATCH#,AXIS,CLUMP#)                            
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     NONE                                                                      
C                                                                               
C   SUBROUTINE CALLED FROM:                                                     
C   --------------------------------------------------------------------        
C     STSORTCL - STAR MATCHING SORT ROUTINE                                     
C                                                                               
C   CONSTRAINTS, RESTRICTIONS, MESSAGES, NOTES:                                 
C   --------------------------------------------------------------------        
C   NONE                                                                        
C                                                                               
C   REQUIREMENTS REFERENCES:                                                    
C   --------------------------------------------------------------------        
C   NONE                                                                        
C                                                                               
C   DEVELOPMENT HISTORY:                                                        
C   DATE     AUTHOR              DESCRIPTION                                    
C   -------- ------              -----------                                    
C   8/ 3/88   R.J. BURLEY         DESIGN                                        
C   5/16/89   R.J. BURLEY         CODED                                         
C  11/ 6/89   R.J. BURLEY         ADD LBLCLM GESS ARRAY                         
C-----------------------------------------------------------------------        
C   METHOD:                                                                     
C     PUT ALL ELEMENTS OF ICLMP1 INTO TEMP VARIABLES                            
C     PUT ALL ELEMENTS OF ICLMP2 INTO ICLMP1                                    
C     PUT ALL ELEMENTS OF TEMP VARIABLES INTO ICLMP2                            
C     RETURN                                                                    
C-----------------------------------------------------------------------        
C                                                                               
C     * DEFINE PARAMETER VARIABLES                                              
      real*8    timclm(*)                                                       
C                                                                               
      real*4    briclm(*), gciclm(3,*), vrmclm(*)   , vrpclm(*)                 
      real*4    skyclm(10,3,*)                                                  
C                                                                               
      INTEGER*4 ICLMP1   , ICLMP2     , IFXCLM      , LBLCLM(*)                 
      INTEGER*4 NOBCLM(*), MRKCLM(*)  , IDFCLM(*)   , NRFCLM(*)                 
      INTEGER*4 MAPCLM(10,*)                                                    
C                                                                               
C     * DECLARE LOCAL VARIABLES                                                 
      real*8    temp8                                                           
      real*4    temp4                                                           
      INTEGER*4 ITEMP, IAXIS, IMATCH                                            
C                                                                               
C                                      INITIALIZE ROUTINE                       
C      IF (LEVDBG(7) .NE. 0) WRITE (LUDBUG,1000)                                 
C                                                                               
C                                      SWAP CLUMP LABELS                        
      itemp = lblclm(iclmp1)                                                    
      lblclm(iclmp1) = lblclm(iclmp2)                                           
      lblclm(iclmp2) = itemp                                                    
C                                                                               
C                                      SWAP CLUMP TIME                          
      temp8 = timclm(iclmp1)                                                    
      timclm(iclmp1) = timclm(iclmp2)                                           
      timclm(iclmp2) = temp8                                                    
C                                                                               
C                                      SWAP CLUMP POSITIONS                     
      DO 100 iaxis=1,3                                                          
        temp4 = gciclm(iaxis,iclmp1)                                            
        gciclm(iaxis,iclmp1) = gciclm(iaxis,iclmp2)                             
        gciclm(iaxis,iclmp2) = temp4                                            
100   CONTINUE                                                                  
C                                                                               
C                                      SWAP CLUMP MAGNITUDE                     
      temp4 = briclm(iclmp1)                                                    
      briclm(iclmp1) = briclm(iclmp2)                                           
      briclm(iclmp2) = temp4                                                    
C                                                                               
C                                      SWAP CLUMP MAGNITUDE VARIANCE            
      temp4 = vrmclm(iclmp1)                                                    
      vrmclm(iclmp1) = vrmclm(iclmp2)                                           
      vrmclm(iclmp2) = temp4                                                    
C                                                                               
C                                      SWAP CLUMP POSITION VARIANCE             
      temp4 = vrpclm(iclmp1)                                                    
      vrpclm(iclmp1) = vrpclm(iclmp2)                                           
      vrpclm(iclmp2) = temp4                                                    
C                                                                               
C                                      SWAP NUMBER OF OBSERVATIONS              
      itemp = nobclm(iclmp1)                                                    
      nobclm(iclmp1) = nobclm(iclmp2)                                           
      nobclm(iclmp2) = itemp                                                    
C                                                                               
C                                      SWAP CLUMP STATUS FLAGS                  
      itemp = mrkclm(iclmp1)                                                    
      mrkclm(iclmp1) = mrkclm(iclmp2)                                           
      mrkclm(iclmp2) = itemp                                                    
C                                                                               
C                                      SWAP IDENTIFICATION FLAGS                
      itemp = idfclm(iclmp1)                                                    
      idfclm(iclmp1) = idfclm(iclmp2)                                           
      idfclm(iclmp2) = itemp                                                    
C                                                                               
C                                      SWAP NUMBER OF MATCHES                   
      itemp = nrfclm(iclmp1)                                                    
      nrfclm(iclmp1) = nrfclm(iclmp2)                                           
      nrfclm(iclmp2) = itemp                                                    
C                                                                               
C                                      SWAP MATCH CATALOG #'S                   
      DO 200 imatch=1,10                                                        
        itemp = mapclm(imatch,iclmp1)                                           
        mapclm(imatch,iclmp1) = mapclm(imatch,iclmp2)                           
        mapclm(imatch,iclmp2) = itemp                                           
200   CONTINUE                                                                  
C                                                                               
C                                      SWAP CORRECTED REFERENCE                 
C                                      STAR POSITIONS                           
      DO 400 imatch=1,10                                                        
        DO 300 iaxis=1,3                                                        
          temp4 = skyclm(imatch,iaxis,iclmp1)                                   
          skyclm(imatch,iaxis,iclmp1) = skyclm(imatch,iaxis,iclmp2)             
          skyclm(imatch,iaxis,iclmp2) = temp4                                   
300     CONTINUE                                                                
400   CONTINUE                                                                  
C                                                                               
C                                      NORMAL TERMINATION                       
C      IF (LEVDBG(7) .NE. 0) WRITE (LUDBUG,2000)                                 
      RETURN                                                                    
C                                                                               
C                                      FORMAT SECTION                           
1000  FORMAT(' *** ENTER SWAPCL *** ')                                          
2000  FORMAT(' *** EXIT  SWAPCL *** ')                                          
      END