NASA Ocean Color

ocssw V2022
       SUBROUTINE dmatch (DANGTL, DMAGTL, IFXCLM, NUMCAT,                       
      I                   IDNCAT, DATCAT, NUMSTR, KLMSTR,                       
      I                   NUMCLM, LBLCLM, GCICLM, BRICLM, NOBCLM,               
      O                   MRKCLM, MRKSTR, IDFCLM, NRFCLM,                       
      O                   MAPCLM, SKYCLM, IRCODE)                               
 C-----------------------------------------------------------------------       
 C   MODULE NAME: STDMATCH                                                      
 C                                                                              
 C   PURPOSE: TO PERFORM DIRECT MATCH ALGORITHM ON CLUMPS.                      
 C                                                                              
 C                                                                              
 C   ARGUMENT LIST:                                                             
 C   ARGUMENT I/O TYPE DIMENS DESCRIPTION                                       
 C   -------- --- ---- ------ -----------                                       
 C   DANGTL   I   R*8         MAX ANGULAR SEPARATION FOR MATCH (DEGREES)        
 C   DMAGTL   I   R*8         MAX MAGNITUDE DIFFERENCE FOR MATCH                
 C   IFXCLM   I   I*4         MAX NUMBER OF REF STAR MATCHES :ARRAY DIM         
 C   NUMCAT   I   I*4         NUMBER OF REFERENCE STARS IN CATALOG              
 C   IDNCAT   I   I*4    *    SKYMAP REFERENCE STAR NUMBERS IN CATALOG          
 C   DATCAT   I   R*4   7,*   CATALOG DATA (1=X AXIS,2=Y AXIS,3=Z AXIS,         
 C                                          4=MAGNITUDE,5=MOTION,               
 C                                          6=QUALITY,7=COLOR)                  
 C   NUMSTR   I   I*4         NUMBER OF OBSERVATIONS                            
 C   KLMSTR   I   I*4    *    CLUMP NUMBER FOR EACH OBSERVATION                 
 C   NUMCLM   I   I*4         NUMBER OF CLUMPS PER TRACKER                      
 C   LBLCLM   I   I*4    *    CLUMP LABELS                                      
 C   GCICLM   I   R*4   3,*   AVERAGE POSITION VEC (GCI) FOR EACH CLUMP         
 C   BRICLM   I   R*4    *    AVERAGE MAGNITUDE FOR EACH CLUMP                  
 C   NOBCLM   I   I*4    *    NUMBER OF OBSERVATIONS IN EACH CLUMP              
 C   MRKCLM   I O I*4    *    STATUS FLAG FOR EACH CLUMP                        
 C   MRKSTR   I O I*4    *    STATUS FLAG FOR EACH OBSERVATION                  
 C   IDFCLM     O I*4    *    CLUMP IDENTIFICATION FLAG                         
 C   NRFCLM     O I*4    *    NUMBER OF REFERENCE STARS MATCHED TO CLUMP        
 C   MAPCLM     O I*4  10,*   LIST OF REF STAR NUMBERS MATCHED TO CLUMP         
 C   SKYCLM     O R*4 10,3,*  LIST OF CORRECTED REFERENCE STAR POSITIONS        
 C   IRCODE     O I*4         ERROR FLAG (0=NO ERROR, 1=ERROR)                  
 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   CMSMSG   IMSGNM I     IVARLN I     IDSTFG I     IRC    I                   
 C            C$VDAT I     C$SBID I                                             
 C   CMCONV   DTR    I                                                          
 C                                                                              
 C       ++INCLUDE STCMDEBG                                                      
 C       ++INCLUDE STCMSMSG                                                      
 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:                                                 l
 C   FILENAME      OPERATION   FORTRAN UNIT ID                                  
 C   --------      ---------   ---------------                                  
 C   NONE                                                                       
 C                                                                              
 C   EXTERNAL REFERENCES:                                                       
 C   --------------------------------------------------------------------       
 C   STDIRINI - INITIALIZE DIRECT MATCH ALGORITHM AND DATA                      
 C   UTDANGLE - FUNCTION TO COMPUTE ANGULAR SEPARATION BETWEEN 2 VECTORS        
 C   UTMSG    - OUTPUT AN ERROR MESSAGE                                         
 C                                                                              
 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 PAGE 3.1.1.5-17 F3-1A TO F3-1B                             
 C                                                                              
 C   DEVELOPMENT HISTORY:                                                       
 C   DATE      AUTHOR              DESCRIPTION                                  
 C   --------  ------              -----------                                  
 C   8/2/88    R.J. BURLEY         DESIGN                                       
 C   5/8/89    R.J. BURLEY         CODED                                        
 C   10/10/89  R.J. BURLEY         ROUTINE NAME CHANGED FROM DIRECT TO          
 C                                 DMATCH BECAUSE DIRECT IS A RESERVED          
 C                                 NAME IN GESS.                                
 C   10/12/89  R.J. BURLEY         IMPROVE DEBUG                                
 C   11/ 2/89  R.J. BURLEY         CORRECT IDFCLM VALUES                        
 C   11/ 6/89  R.J. BURLEY         ADD LBLCLM GESS ARRAY                        
 C-----------------------------------------------------------------------       
 C   METHOD:                                                                    
 C     CALL DIRINI TO INITIALIZE CLUMP AND OBSERVATION ID FIELDS                
 C                                                                              
 C!    * MATCH CLUMPS WITH REFERENCE STARS                                      
 C     DO FOR ALL CLUMPS                                                        
 C       IF (MRKCLM FLAG INDICATES THAT CLUMP IS GOOD) THEN                     
 C         DO FOR ALL REFERENCE STARS IN CATALOG  (1 TO NUMCAT)                 
 C           USE DANGLE TO COMPUTE ANGULAR SEPARATION BETWEEN AVG CLUMP         
 C             POSITION AND REFERENCE STAR POSITION                             
 C           COMPUTE ABSOLUTE VALUE OF MAGNITUDE DIFFERENCE BETWEEN CLUMP       
 C             AND REFERENCE STAR                                               
 C           IF ((ANGULAR SEPARATION < DANGTL).AND.                             
 C               (MAGNITUDE DIFFERENCE < DMAGTL)) THEN                          
 C!            WITHIN TOLERANCE, SAVE REF STAR NUMBER IN LIST OF MATCHES        
 C!             FOR CURRENT CLUMP AS FOLLOWS:                                   
 C             NRFCLM(CLUMP#) = NRFCLM(CLUMP#)+1                                
 C             IF (NRFCLM(CLUMP#) > IFXCLM) THEN                                
 C               IRCODE = 1   OVERFILL OF MATCH ARRAY SPACE                     
 C               ABORT TO ERROR_HANDLE                                          
 C             ELSE                                                             
 C               MAPCLM(NRFCLM(CLUMP#),CLUMP#)=IDNCAT(REF STAR#)                
 C             ENDIF                                                            
 C           ENDIF                                                              
 C         ENDDO FOR                                                            
 C       ENDIF                                                                  
 C     ENDDO FOR                                                                
 C                                                                              
 C     DO FOR ALL CLUMPS (1 TO NUMCLM)                                          
 C       IF (# OF REFERENCE STAR MATCHES FOR CLUMP = 0) THEN                    
 C         IDFCLM(CLUMP#) = 0    MARK CLUMP AS UNIDENTIFIED                     
 C         SET MRKCLM FLAG TO 14 TO INDICATE UNIDENTIFIED                       
 C         DO FOR ALL OBSERVATIONS                                              
 C           IF (OBSERVATION IS IN CURRENT CLUMP AND THE OBSERVATION            
 C               HAS NOT YET BEEN DROPPED) THEN                                 
 C             SET FLAG IN MRKSTR ARRAY TO 16 INDICATING THE OBSERVATION        
 C               HAS BEEN DROPPED DUE TO NON-IDENTIFICATION                     
 C           ENDIF                                                              
 C         ENDDO FOR                                                            
 C       ELSE IF (# OF REFERENCE STAR MATCHES FOR CLUMP = 1) THEN               
 C         IDFCLM(CLUMP#) = 2    MARK CLUMP AS IDENTIFIED                       
 C       ELSE MORE THAN 1 REFERENCE STAR MATCH FOR CLUMP                        
 C         IDFCLM(CLUMP#) = 1    MARK CLUMP AS QUESTIONABLE MATCH               
 C         COMPUTE BEST POSITION MATCH FROM CANDIDATE REF STARS AND             
 C           PLACE THIS REF STAR AT BEGINNING OF REF STAR LIST FOR              
 C           THIS CLUMP.                                                        
 C       ENDIF                                                                  
 C     ENDDO FOR                                                                
 C                                                                              
 C                                                                              
 C     RETURN                                                                   
 C     -------------                                                            
 C     ERROR_HANDLE:                                                            
 C     DO CASE OF ERROR CONDITION                                               
 C       IRCODE = 1:  CALL UTMSG TO OUTPUT ERROR MESSAGE                        
 C     ENDCASE                                                                  
 C     RETURN                                                                   
 C-----------------------------------------------------------------------       
 C                                                                              
 C     * DEFINE PARAMETER VARIABLES                                             
       real*8    dangtl      , dmagtl                                           
 C                                                                              
       real*4    datcat(7,*) , gciclm(3,*), briclm(*), skyclm(10,3,*)           
 C                                                                              
       INTEGER*4 IFXCLM      , NUMCAT     , IDNCAT(*)                           
       INTEGER*4 NUMSTR      , KLMSTR(*)  , MRKSTR(*)                           
       INTEGER*4 NUMCLM      , LBLCLM(*)  , NOBCLM(*)                           
       INTEGER*4 MRKCLM(*)   , IDFCLM(*)  , NRFCLM(*)                           
       INTEGER*4 MAPCLM(10,*), IRCODE                                           
 C                                                                              
 C     * DECLARE LOCAL VARIABLES                                                
       real*8    angsep  , angdif   , toler    , dangle, besta                  
       real*8    e2clm(3), e2ref(3) , ue2ref(3), rangtl, rmagdf, rmax           
       INTEGER*4 ICLM    , ISTAR    , IOBS     , IBEST , ITEMP , IMATCH         
       INTEGER*4 I                                                              
       DATA toler /0.99d0/                                                      
       DATA rmax  /999999.0d0/                                                  
 C                                                                              
 C                                      INITIALIZE ROUTINE                      
       ircode = 0                                                               
       IF (levdbg(7) .NE. 0) WRITE (ludbug,1000)                                
 C                                                                              
 C                                      INITIALIZE ALGORITHM                    
       CALL dirini (numstr, numclm, ifxclm,                                     
      1             mrkclm, idfclm, nrfclm, mapclm, skyclm, mrkstr)             
 C                                                                              
 C                                                                              
 C                                      CONVERT ANGULAR SEPARATION              
 C                                      TOLERANCE TO RADIANS                    
 C     RANGTL = DANGTL * DTR                                                    
       rangtl = dangtl / radeg                                                 
       IF (levdbg(7) .GE. 1) WRITE (ludbug,4000) rangtl, dmagtl                 
 C                                                                              
 C                                                                              
 C                                      MATCH CLUMPS WITH REFERENCE STARS       
       DO 200 iclm = 1,numclm                                                   
         IF (mrkclm(iclm) .EQ. 0) THEN                                          
 C                                                                              
 C                                      INTERMEDIATE DEBUG                      
           IF (levdbg(7) .GE. 4) THEN                                           
             WRITE (ludbug,4010) lblclm(iclm),(gciclm(i,iclm),i=1,3),           
      1                          briclm(iclm)                                   
           ENDIF                                                                
 C                                                                              
 C                                      COMPARE CLUMP WITH ALL STARS            
           DO 100 istar = 1,numcat                                              
 C                                                                              
 C                                      COMPUTE ANGLE BETWEEN VECTORS           
             e2clm(1) = dble(gciclm(1,iclm))                                    
             e2clm(2) = dble(gciclm(2,iclm))                                    
             e2clm(3) = dble(gciclm(3,iclm))                                    
             e2ref(1) = dble(datcat(1,istar))                                   
             e2ref(2) = dble(datcat(2,istar))                                   
             e2ref(3) = dble(datcat(3,istar))                                   
             angsep   = dangle(e2clm, e2ref, toler, angdif)                     
 C                                                                              
 C                                      COMPUTE MAGNITUDE DIFFERENCE            
             rmagdf = dble(abs(briclm(iclm)-datcat(4,istar)))                   
 C                                                                              
 C                                      TEST FOR MATCH                          
             IF ((angsep .LT. rangtl).AND.(rmagdf .LT. dmagtl)) THEN            
               nrfclm(iclm) = nrfclm(iclm) + 1                                  
 C                                                                              
 C                                      INTERMEDIATE DEBUG                      
               IF (levdbg(7) .GE. 4) THEN                                       
                 WRITE (ludbug,4020) nrfclm(iclm), istar, idncat(istar),        
      1                 angsep, rmagdf                                          
               ENDIF                                                            
               IF (nrfclm(iclm) .GT. ifxclm) THEN                               
                 ircode = 1                                                     
                 GO TO 9999                                                     
               ELSE                                                             
                 mapclm(nrfclm(iclm),iclm) = istar                              
               ENDIF                                                            
             ENDIF                                                              
 100       CONTINUE                                                             
         ENDIF                                                                  
 200   CONTINUE                                                                 
 C                                                                              
 C                                                                              
 C                                      MATCH OBSERVATIONS WITH THE             
 C                                      REFERENCE STARS FROM ABOVE              
       DO 500 iclm = 1,numclm                                                   
         IF (nrfclm(iclm) .EQ. 0) THEN                                          
 C                                      FLAG CLUMP AND ALL OBSERVATIONS         
 C                                      IN CLUMP AS UNIDENTIFIED                
           idfclm(iclm) = 0                                                     
           mrkclm(iclm) = 14                                                    
           DO 300 iobs  = 1,numstr                                              
             IF ((klmstr(iobs).EQ. iclm).AND.(mrkstr(iobs).EQ. 0)) THEN         
               mrkstr(iobs) = 16                                                
             ENDIF                                                              
 300       CONTINUE                                                             
         ELSE IF (nrfclm(iclm) .EQ. 1) THEN                                     
 C                                      FLAG CLUMP AS IDENTIFIED                
           idfclm(iclm) = 2                                                     
         ELSE                                                                   
 C                                      FLAG CLUMP AS QUESTIONABLE MATCH        
 C                                      AND INITIALIZE BEST MATCH LOOP          
           idfclm(iclm) = 1                                                     
           e2clm(1) = dble(gciclm(1,iclm))                                      
           e2clm(2) = dble(gciclm(2,iclm))                                      
           e2clm(3) = dble(gciclm(3,iclm))                                      
           besta    = rmax                                                      
           ibest    = 0                                                         
 C                                                                              
 C                                      COMPUTE BEST MATCH, BY POSITION         
 C                                      OF CANDIDATE REFERENCE STARS            
           DO 400 imatch = 1,nrfclm(iclm)                                       
             istar    = mapclm(imatch,iclm)                                     
             e2ref(1) = dble(datcat(1,istar))                                   
             e2ref(2) = dble(datcat(2,istar))                                   
             e2ref(3) = dble(datcat(3,istar))                                   
             angsep = dangle(e2clm, e2ref, toler, angdif)                       
             IF (angsep .LT. besta) THEN                                        
               besta = angsep                                                   
               ibest = imatch                                                   
             ENDIF                                                              
 400       CONTINUE                                                             
 C                                                                              
 C                                      MOVE BEST MATCH TO FRONT OF LIST        
           itemp = mapclm(1,iclm)                                               
           mapclm(1,iclm) = mapclm(ibest,iclm)                                  
           mapclm(ibest,iclm) = itemp                                           
         ENDIF                                                                  
 500   CONTINUE                                                                 
 C                                                                              
 C                                                                              
 C                                      NORMAL TERMINATION                      
       IF (levdbg(7) .NE. 0) WRITE (ludbug,2000)                                
       RETURN                                                                   
 C                                                                              
 C                                      ERROR HANDLING                          
 9999  CONTINUE                                                                 
       IF (levdbg(7) .NE. 0) WRITE (ludbug,3000)                                
       IF (ircode .EQ. 1) THEN                                                  
 c        IMSGNM = 60                                                            
 c        IVARLN = 0                                                             
 c        CALL UTMSG (C$SBID, IMSGNM, IVARLN, C$VDAT, IDSTFG, IRC)               
         IF (levdbg(7) .GE. 4) WRITE (ludbug,6000) iclm                         
       ENDIF                                                                    
       RETURN                                                                   
 C                                                                              
 C                                      FORMAT SECTION                          
 1000  FORMAT(' *** ENTER DMATCH ***')                                          
 2000  FORMAT(' *** EXIT  DMATCH ***')                                          
 3000  FORMAT(' *** ABEND DMATCH ***')                                          
 4000  FORMAT(' DIRECT MATCH MAX ANGSEP=',d14.6,' RADIANS AND',                 
      1       ' MAGDIF MAX=',d14.6)                                             
 4010  FORMAT(' WORKING ON CLUMP ',i6,' GCI=',3(f14.6,1x),' MAG=',f14.6)        
 4020  FORMAT('         MATCH ',i4,' STARINDEX=',i6,' SKYMAP#=',i10,            
      1               ' ANGSEP=',d14.6,' MAGDIF=',d14.6)                        
 6000  FORMAT(' DIRECT: MATCH TABLE OVERFILL WHILE MATCHING CLUMP ',i6)         
       END                                                                      
real
#define real
Definition: DbAlgOcean.cpp:26
dirini
subroutine dirini(NUMSTR, NUMCLM, IFXCLM, MRKCLM, IDFCLM, NRFCLM, MAPCLM, SKYCLM, MRKSTR)
Definition: dirini.f:4
dmatch
subroutine dmatch(DANGTL, DMAGTL, IFXCLM, NUMCAT, IDNCAT, DATCAT, NUMSTR, KLMSTR, NUMCLM, LBLCLM, GCICLM, BRICLM, NOBCLM, MRKCLM, MRKSTR, IDFCLM, NRFCLM, MAPCLM, SKYCLM, IRCODE)
Definition: dmatch.f:6
abs
#define abs(a)
Definition: misc.h:90
dangle
real *8 function dangle(A, B, TOLER, ANG)
Definition: dangle.f:62