NASA Ocean Color

ocssw V2022
       SUBROUTINE triplt                                                         
      i          (tangtl, tminco, numclm, lblclm, gciclm, nobclm,                
      i           mrkclm, numstr, klmstr,                                        
      o           mrkstr, skyclm, nrfclm, mapclm,                                
      o           idfclm, numtrp)                                                
 C-----------------------------------------------------------------------        
 C   MODULE NAME:  STTRIPLT                                                      
 C                                                                               
 C                                                                               
 C   PURPOSE: TO IDENTIFY STAR CLUMPS USING TRIPLET STAR MATCHING.               
 C                                                                               
 C                                                                               
 C   ARGUMENT LIST:                                                              
 C   ARGUMENT I/O TYPE DIMENS DESCRIPTION                                        
 C   -------- --- ---- ------ -----------                                        
 C   TANGTL   I   R*8         MAX ANGULAR SEPARATION FOR TRIPLET MATCH           
 C   TMINCO   I   R*8         MINIMUM COLINEARITY ANGLE FOR VALID TRIPLET        
 C   NUMCLM   I   I*4         NUMBER OF CLUMPS                                   
 C   LBLCLM   I   I*4         CLUMP LABELS                                       
 C   GCICLM   I   R*4   3,*   AVERAGE POSITION VEC (GCI) FOR EACH CLUMP          
 C   NOBCLM   I   I*4    *    NUMBER OF OBSERVATIONS PER CLUMP                   
 C   MRKCLM   I O I*4    *    STATUS FLAG FOR EACH CLUMP                         
 C   NUMSTR   I   I*4         NUMBER OF OBSERVATIONS                             
 C   KLMSTR   I   I*4    *    CLUMP NUMBER FOR EACH OBSERVATION                  
 C   MRKSTR   I O I*4    *    STATUS FLAG FOR EACH OBSERVATION                   
 C   SKYCLM   I O R*4 10,3,*  LIST OF CORRECTED REFERENCE STAR POSITIONS         
 C   NRFCLM   I O I*4    *    NUMBER OF REFERENCE STARS MATCHED TO CLUMP         
 C   MAPCLM   I O I*4  10,*   LIST OF REFERENCE STAR #'S MATCHED TO CLUMP        
 C   IDFCLM     O I*4    *    IDENTIFICATION FLAG FOR EACH CLUMP                 
 C   NUMTRP     O I*4         NUMBER OF VALID CLUMP TRIPLETS CHECKED             
 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   CMCONV   DTR    I                                                           
 C                                                                               
 C      ++INCLUDE STCMDEBG                                                       
 C      ++INCLUDE AECMCONV                                                       
       INTEGER*4 LEVDBG(8),LUDBUG
       COMMON /cmdebg/levdbg,ludbug
       real*8 pi,radeg,re,rem,f,omf2,omegae
       COMMON /gconst/pi,radeg,re,rem,f,omf2,omegae
 C                                                                               
 C   EXTERNAL FILES REFERENCED:                                                  
 C   FILENAME      OPERATION   FORTRAN UNIT ID                                   
 C   --------      ---------   ---------------                                   
 C   NONE                                                                        
 C                                                                               
 C   EXTERNAL REFERENCES:                                                        
 C   --------------------------------------------------------------------        
 C   STCOLINE - TEST COLINEAR ACCEPTABILITY OF CLUMP TRIPLET                     
 C   UTDANGLE - FUNCTION TO COMPUTE ANGULAR SEPARATION BETWEEN 2 VECTORS         
 C                                                                               
 C   SUBROUTINE CALLED FROM:                                                     
 C   --------------------------------------------------------------------        
 C     STIDENTY - STAR MATCHING DRIVER                                           
 C                                                                               
 C                                                                               
 C   CONSTRAINTS, RESTRICTIONS, MESSAGES, NOTES:                                 
 C   --------------------------------------------------------------------        
 C   NONE                                                                        
 C                                                                               
 C   REQUIREMENTS REFERENCES:                                                    
 C   --------------------------------------------------------------------        
 C   UARS FDSS SPECS 3.1.1.5 (FUNCTION 3)                                        
 C                                                                               
 C                                                                               
 C   DEVELOPMENT HISTORY:                                                        
 C   DATE     AUTHOR              DESCRIPTION                                    
 C   -------- ------              -----------                                    
 C   8/ 3/88  R.J. BURLEY         DESIGN                                         
 C   5/18/89  R.J. BURLEY         CODED                                          
 C  10/17/89  R.J. BURLEY         ADD FLAGGING OF UNIDENTIFIED CLUMPS AND        
 C                                CORRECT FLAGGING OF OBSERVATIONS.              
 C  10/19/89  R.J. BURLEY         PUT CATALOG STAR INDEX NUMBER IN MAPCLM        
 C                                ARRAY INSTEAD OF BEST MATCH NUMBER.            
 C  10/24/89  R.J. BURLEY         CONVERT MINIMUM COLINEARITY ANGLE TO           
 C                                TO RADIANS.                                    
 C  11/ 2/89  R.J. BURLEY         MODIFY DEBUG                                   
 C  11/ 6/89  R.J. BURLEY         ADD LBLCLM GESS ARRAY                          
 C-----------------------------------------------------------------------        
 C   METHOD:                                                                     
 C   CONVERT TRIPLET ANGULAR SEPARATION TOLERANCE TO RADIANS                     
 C   CONVERT MINIMUM COLINEARITY ANGLE TO RADIANS                                
 C   SET NUMTRP TO ZERO                                                          
 C   RESET ALL CLUMP ID FLAGS AS UNIDENTIFIED IN IDFCLM ARRAY                    
 C                                                                               
 C   DO FOR ICLMPA = 1 TO (NUMCLM-2)                                             
 C     DO FOR ICLMPB = (ICLMPA+1) TO (NUMCLM-1)                                  
 C       DO FOR ICLMPC = (ICLMPB+1) TO NUMCLM                                    
 C                                                                               
 C!        * TEST VALIDITY OF CLUMP TRIPLET                                      
 C         CALL COLINE TO TEST COLINEAR ACCEPTABILITY OF CLUMP TRIPLET           
 C         IF (ALL HAVE >=1 REF STAR).AND.(ALL HAVE MRKCLM FLAG = 0).AND.        
 C           (1 OR MORE IS UNIDENTIFIED).AND.(COLINEARITY > TIMINCO) THEN        
 C             INCREMENT NUMBER OF VALID TRIPLETS COUNT                          
 C             COMPUTE SUM OF ANGULAR SEPARATIONS OF CLUMP TRIPLET               
 C             SET NUMBER OF TRIPLET MATCHES TO ZERO                             
 C             CURRENT SMALLEST DIFFERENCE = SOME MAXIMUM VALUE                  
 C                                                                               
 C!            * TEST ALL REFERENCE STAR COMBINATIONS                            
 C             DO FOR ALL REFERENCE STARS MATCHED TO CLUMPA                      
 C               DO FOR ALL REFERENCE STARS MATCHED TO CLUMPB                    
 C                 DO FOR ALL REFERENCE STARS MATCHED TO CLUMPC                  
 C                   COMPUTE SUM OF ANG SEPS OF REF STAR TRIPLET                 
 C                   COMPUTE DIFFERENCE BETWEEN SUM OF CLUMP TRIPLET             
 C                    ANGLES AND STAR TRIPLET ANGLES                             
 C                   IF ((DIFFERENCE <= CURRENT SMALLEST DIFFERENCE).AND.        
 C                       (DIFFERENCE < TOLERANCE)) THEN                          
 C                     IF (DIFFERENCE = CURRENT SMALLEST DIFFERENCE) THEN        
 C                       INCREMENT NUMBER OF MATCHES                             
 C                     ELSE                                                      
 C                       NUMBER OF MATCHES = 1                                   
 C                     ENDIF                                                     
 C                     SET CURRENT SMALLEST DIFFERENCE = DIFFERENCE              
 C                     SAVE THE REF STAR #'S WHICH MADE THIS TRIPLET             
 C                   ENDIF                                                       
 C                 ENDDO FOR                                                     
 C               ENDDO FOR                                                       
 C             ENDDO FOR                                                         
 C                                                                               
 C             IF (NUMBER OF MATCHES = 0) THEN                                   
 C               MARK CLUMPS AS UNIDENTIFIED IF NOT YET IDENTIFIED               
 C             ELSE IF (NUMBER OF MATCHES > 1) THEN                              
 C               MARK CLUMPS AS QUESTIONABLE IF NOT YET IDENTIFIED               
 C             ELSE                                                              
 C               MARK CLUMPS AS IDENTIFIED, SAVE REFERENCE STAR NUMBERS          
 C               WIPE OUT ANY OTHER REFERENCE STARS MATCHED TO CLUMP             
 C             ENDIF                                                             
 C           ENDIF                                                               
 C         ENDIF                                                                 
 C                                                                               
 C       ENDDO FOR                                                               
 C     ENDDO FOR                                                                 
 C   ENDDO FOR                                                                   
 C                                                                               
 C   DO FOR ALL CLUMPS                                                           
 C     IF (CLUMP HAS NOT BEEN IDENTIFIED BY TRIPLT ALGORITHM) THEN               
 C       SET ITS MRKCLM FLAG TO 15.                                              
 C   ENDDO FOR                                                                   
 C   DO FOR ALL OBSERVATIONS                                                     
 C     SET MRKSTR FLAG TO 17 IF IT IS IN A CLUMP MARKED AS UNIDENTIFIED          
 C   ENDDO FOR                                                                   
 C   RETURN                                                                      
 C-----------------------------------------------------------------------        
 C                                                                               
 C     * DEFINE PARAMETER VARIABLES                                              
       real*8    tangtl      , tminco                                            
 C                                                                               
       real*4    gciclm(3,*) , skyclm(10,3,*)                                    
 C                                                                               
       INTEGER*4 NUMCLM      , LBLCLM(*)   , NOBCLM(*)                           
       INTEGER*4 MRKCLM(*)   , IDFCLM(*)   , NUMSTR       , KLMSTR(*)            
       INTEGER*4 MRKSTR(*)   , NRFCLM(*)   , MAPCLM(10,*) , NUMTRP               
 C                                                                               
 C                                                                               
 C     * DECLARE LOCAL VARIABLES                                                 
       real*8    rangtl   , angdif   , toler    , besta , rmax  , coangl         
       real*8    cangab   , cangac   , cangbc   , cangle, dangle, rminco         
       real*8    rang12   , rang13   , rang23   , rangle                         
       real*8    e2clma(3), e2clmb(3), e2clmc(3)                                 
       real*8    e2ref1(3), e2ref2(3), e2ref3(3)                                 
       INTEGER*4 ICLMA    , ICLMB    , ICLMC    , IREF1  , IREF2 , IREF3         
       INTEGER*4 IMATCH   , IBEST1   , IBEST2   , IBEST3 , ISTR                  
       LOGICAL*4 L_GOOD   , L_MTCH   , L_NOID                                    
       DATA      toler /0.99d0/                                                  
       DATA      rmax  /999999.0d0/                                              
 C                                                                               
 C                                                                               
 C                                      INITIALIZE ROUTINE                       
       IF (levdbg(7) .NE. 0) WRITE (ludbug,1000)                                 
       IF (levdbg(7) .GE. 1) WRITE (ludbug,3999) tangtl,tminco                   
 C                                                                               
 C                                      INITIALIZE ALGORITHM                     
       numtrp = 0                                                                
 C      RANGTL = TANGTL * DTR                                                    
 C      RMINCO = TMINCO * DTR                                                    
       rangtl = tangtl / radeg                                                   
       rminco = tminco / radeg                                                   
       IF (levdbg(7) .GE. 1) WRITE (ludbug,3999) rangtl,rminco                   
       DO 100 iclma = 1,numclm                                                   
         idfclm(iclma) = 0                                                       
 100   CONTINUE                                                                  
 C
       istr = 1
       dowhile(nrfclm(istr).LT.1)
         istr = istr + 1
       END DO                                                                               
 C                                      PERFORM TRIPLET CLUMP MATCHING           
       DO 700 iclma = istr,(numclm-2)                                               
         DO 600 iclmb = (iclma+1),(numclm-1)                                     
           DO 500 iclmc = (iclmb+1),numclm                                       
 C                                                                               
 C                                      TEST IF CLUMPS MAKE VALID TRIPLET        
             IF ((mrkclm(iclma) .EQ. 0).AND.(mrkclm(iclmb) .EQ. 0).AND.          
      1          (mrkclm(iclmc) .EQ. 0)) THEN                                    
               l_good = .true.                                                   
             ELSE                                                                
               l_good = .false.                                                  
             ENDIF                                                               
             IF ((nrfclm(iclma) .GE. 1).AND.(nrfclm(iclmb) .GE. 1).AND.          
      1          (nrfclm(iclmc) .GE. 1)) THEN                                    
               l_mtch = .true.                                                   
             ELSE                                                                
               l_mtch = .false.                                                  
             ENDIF                                                               
             IF ((idfclm(iclma) .EQ. 0).OR.(idfclm(iclmb) .EQ. 0).OR.            
      1          (idfclm(iclmc) .EQ. 0)) THEN                                    
               l_noid = .true.                                                   
             ELSE                                                                
               l_noid   = .false.                                                
             ENDIF                                                               
             IF (l_good .AND. l_mtch .AND. l_noid) THEN                       
             CALL coline (iclma, iclmb, iclmc, lblclm, gciclm, coangl)           
             IF (coangl .GT. rminco) THEN                                      
 C                                                                               
 C                                      VALID CLUMP TRIPLET                      
               numtrp = numtrp + 1                                               
 C                                                                               
 C                                      FIND SUM OF ANGULAR SEPARATIONS          
               e2clma(1) = dble(gciclm(1,iclma))                                 
               e2clma(2) = dble(gciclm(2,iclma))                                 
               e2clma(3) = dble(gciclm(3,iclma))                                 
               e2clmb(1) = dble(gciclm(1,iclmb))                                 
               e2clmb(2) = dble(gciclm(2,iclmb))                                 
               e2clmb(3) = dble(gciclm(3,iclmb))                                 
               e2clmc(1) = dble(gciclm(1,iclmc))                                 
               e2clmc(2) = dble(gciclm(2,iclmc))                                 
               e2clmc(3) = dble(gciclm(3,iclmc))                                 
               cangab    = dangle(e2clma, e2clmb, toler, angdif)                 
               cangbc    = dangle(e2clmb, e2clmc, toler, angdif)                 
               cangac    = dangle(e2clma, e2clmc, toler, angdif)                 
               cangle    = cangab + cangbc + cangac                              
 C                                                                               
 C                                      PERFORM TRIPLET STAR MATCHING            
               imatch = 0                                                        
               besta  = rmax                                                     
               DO 400 iref1 = 1,nrfclm(iclma)                                    
                 DO 300 iref2 = 1,nrfclm(iclmb)                                  
                   DO 200 iref3 = 1,nrfclm(iclmc)                                
 C                                                                               
 C                                      COMPUTE SUM OF ANGLES BETWEEN            
 C                                      REFERENCE STARS                          
                     e2ref1(1) = dble(skyclm(iref1,1,iclma))                     
                     e2ref1(2) = dble(skyclm(iref1,2,iclma))                     
                     e2ref1(3) = dble(skyclm(iref1,3,iclma))                     
                     e2ref2(1) = dble(skyclm(iref2,1,iclmb))                     
                     e2ref2(2) = dble(skyclm(iref2,2,iclmb))                     
                     e2ref2(3) = dble(skyclm(iref2,3,iclmb))                     
                     e2ref3(1) = dble(skyclm(iref3,1,iclmc))                     
                     e2ref3(2) = dble(skyclm(iref3,2,iclmc))                     
                     e2ref3(3) = dble(skyclm(iref3,3,iclmc))                     
                     rang12    = dangle(e2ref1, e2ref2, toler, angdif)           
                     rang13    = dangle(e2ref1, e2ref3, toler, angdif)           
                     rang23    = dangle(e2ref2, e2ref3, toler, angdif)           
                     rangle    = rang12 + rang13 + rang23                        
 C                                                                               
 C                                      COMPUTE DIFFERENCE BETWEEN SUMS          
 C                    ANGDIF = DABS(CANGLE - RANGLE)                           
                     angdif = dabs(cangab - rang12)                              
      *                     + dabs(cangac - rang13)                              
      *                     + dabs(cangbc - rang23)                              
 C                                                                               
 C                                      SAVE BEST FIT WITHIN RANGTL LIMIT        
                     IF ((angdif.LE.besta).AND.(angdif.LT.rangtl)) THEN          
                        IF (angdif .EQ. besta) THEN                              
                          imatch = imatch + 1                                    
                        ELSE                                                     
                          imatch = 1                                             
                        ENDIF                                                    
                        besta  = angdif                                          
                        ibest1 = iref1                                           
                        ibest2 = iref2                                           
                        ibest3 = iref3                                           
                     ENDIF                                                       
 C                                                                               
 C                                      INTERMEDIATE DEBUG                       
                     IF (levdbg(7) .GE. 4) THEN                                  
                       WRITE (ludbug,4000) lblclm(iclma),                        
      1                     lblclm(iclmb), lblclm(iclmc), cangle                 
                       WRITE (ludbug,4010) iref1, iref2, iref3,                  
      1                     mapclm(iref1,iclma), mapclm(iref2,iclmb),            
      2                     mapclm(iref3,iclmc), rangle                          
                       WRITE (ludbug,4020) angdif, besta, imatch                 
                     ENDIF                                                       
 C                                                                               
 C                                                                               
 200               CONTINUE                                                      
 300             CONTINUE                                                        
 400           CONTINUE                                                          
 C                                                                               
 C                                                                               
               IF (imatch .EQ. 0) THEN                                           
 C                                      MARK CLUMPS AS UNIDENTIFIED              
                 IF (idfclm(iclma) .NE. 2) idfclm(iclma) = 0                     
                 IF (idfclm(iclmb) .NE. 2) idfclm(iclmb) = 0                     
                 IF (idfclm(iclmc) .NE. 2) idfclm(iclmc) = 0                     
               ELSE IF (imatch .GT. 1) THEN                                      
 C                                      MARK CLUMPS AS QUESTIONABLE              
                 IF (idfclm(iclma) .NE. 2) idfclm(iclma) = 1                     
                 IF (idfclm(iclmb) .NE. 2) idfclm(iclmb) = 1                     
                 IF (idfclm(iclmc) .NE. 2) idfclm(iclmb) = 1                     
               ELSE                                                              
 C                                                                               
 C                                      MARK CLUMPS AS IDENTIFIED                
                 idfclm(iclma) = 2                                               
                 idfclm(iclmb) = 2                                               
                 idfclm(iclmc) = 2                                               
 C                                                                               
 C                                      CLUMPS NOW HAVE ONLY 1 MATCH             
                 nrfclm(iclma) = 1                                               
                 nrfclm(iclmb) = 1                                               
                 nrfclm(iclmc) = 1                                               
 C                                                                               
 C                                      SAVE BEST MATCH AT FRONT OF LIST         
                 mapclm(1,iclma)   = mapclm(ibest1,iclma)                        
                 mapclm(1,iclmb)   = mapclm(ibest2,iclmb)                        
                 mapclm(1,iclmc)   = mapclm(ibest3,iclmc)                        
 C                                                                               
 C                                      SAVE BEST MATCH STAR POSITIONS           
                 skyclm(1,1,iclma) = skyclm(ibest1,1,iclma)                      
                 skyclm(1,2,iclma) = skyclm(ibest1,2,iclma)                      
                 skyclm(1,3,iclma) = skyclm(ibest1,3,iclma)                      
                 skyclm(1,1,iclmb) = skyclm(ibest2,1,iclmb)                      
                 skyclm(1,2,iclmb) = skyclm(ibest2,2,iclmb)                      
                 skyclm(1,3,iclmb) = skyclm(ibest2,3,iclmb)                      
                 skyclm(1,1,iclmc) = skyclm(ibest3,1,iclmc)                      
                 skyclm(1,2,iclmc) = skyclm(ibest3,2,iclmc)                      
                 skyclm(1,3,iclmc) = skyclm(ibest3,3,iclmc)                      
               ENDIF                                                             
             ENDIF                                                               
             ENDIF                                                               
 C                                                                               
 C                                                                               
 500       CONTINUE                                                              
 600     CONTINUE                                                                
 700   CONTINUE                                                                  
 C                                                                               
 C                                      FLAG UNIDENTIFIED CLUMPS                 
       DO 800 iclma=1,numclm                                                     
         IF ((mrkclm(iclma) .EQ. 0).AND.                                         
      1      (idfclm(iclma) .EQ. 0)) mrkclm(iclma) = 15                          
 800   CONTINUE                                                                  
 C                                                                               
 C                                      FLAG UNIDENTIFIED OBSERVATIONS           
       DO 900 istr = 1,numstr                                                    
         IF (mrkclm(klmstr(istr)) .EQ. 15) mrkstr(istr) = 17                     
 900   CONTINUE                                                                  
 C                                                                               
 C                                                                               
 C                                      OUTGOING DEBUG                           
       IF (levdbg(7) .GE. 3) THEN                                                
         WRITE (ludbug,5000)                                                     
         DO 950 iclma=1,numclm                                                   
           WRITE (ludbug,5010) lblclm(iclma),mrkclm(iclma),idfclm(iclma)         
           DO 930 imatch=1,nrfclm(iclma)                                         
             WRITE (ludbug,5020) imatch, mapclm(imatch,iclma),                   
      1                          (skyclm(imatch,i,iclma),i=1,3)                  
 930       CONTINUE                                                              
 950     CONTINUE                                                                
       ENDIF                                                                     
 C                                                                               
 C                                      NORMAL TERMINATION                       
       IF (levdbg(7) .NE. 0) WRITE (ludbug,2000)                                 
       RETURN                                                                    
 C                                                                               
 C                                      FORMAT SECTION                           
 1000  FORMAT(' *** ENTER TRIPLT ***')                                           
 2000  FORMAT(' *** EXIT  TRIPLT ***')                                           
 3999  FORMAT(' TRIPLET PARAMETERS: TANGTL=',d12.6,' TMINCO=',d12.6)             
 4000  FORMAT(' INTERMEDIATE DEBUG: '/,                                          
      1       4x,'CLUMP TRIPLT=',i8,2x,i8,2x,i8,' SEPARATION=',d12.6)            
 4010  FORMAT(4x,'STAR TRIPLT =',i8,2x,i8,2x,i8,' CATALOG #S=',                  
      1       i8,2x,i8,2x,i8,' SEPARATION=',d12.6)                               
 4020  FORMAT(4x,'ANGDIF=',d12.6,' BEST YET=',d12.6,' MATCH #=',i8)              
 5000  FORMAT(' STAR CLUMP TABLE AFTER TRIPLT ALGORITHM')                        
 5010  FORMAT(' CLUMP=',i6,' STATUS=',i6,' IDFLAG=',i6)                          
 5020  FORMAT(10x,'MATCH#',i4,' CATINDEX=',i8,' POSITION=',3(f13.6,1x))          
       END