OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
identy.f
Go to the documentation of this file.
1  SUBROUTINE identy
2  i (eptime, imatch, dangtl, dmagtl, pangtl, tangtl,
3  i tminco, smaglm, iqlimt, maxcat, idncat, datcat,
4  i ifxclm, numclm, timclm, gciclm, briclm, vrmclm,
5  i vrpclm, nobclm, mrkclm, numstr, klmstr,
6  o mrkstr, lblclm, idfclm, nrfclm, mapclm, skyclm, idfhst,
7  o ircode)
8 C-----------------------------------------------------------------------
9 C MODULE NAME: STIDENTY
10 C
11 C PURPOSE: TO IDENTIFY CLUMPS WITH STARS IN THE REFERENCE CATALOG
12 C AND TO CORRECT MATCHES FOR EARTH AND S/C VELOCITY.
13 C
14 C ARGUMENT LIST:
15 C ARGUMENT I/O TYPE DIMENS DESCRIPTION
16 C -------- --- ---- ------ -----------
17 C EPTIME I R*8 EPOCH TIME FOR SOLUTION (SECS SINCE 1/1/72)
18 C IMATCH I I*4 MATCH TYPE (1=DIRECT,2=DOUBLET,3=TRIPLET)
19 C DANGTL I R*8 DIRECT MATCH MAX ANGULAR DIF TOLERANCE
20 C DMAGTL I R*8 DIRECT MATCH MAX MAGNITUDE DIF TOLERANCE
21 C PANGTL I R*8 PAIRWISE MATCH MAX ANGULAR DIF TOLERANCE
22 C TANGTL I R*8 TRIPLET MATCH MAX ANGULAR TOLERANCE
23 C TMINCO I R*8 TRIPLET MATCH MINIMUM COLINEARITY ANGLE
24 C SMAGLM I R*4 STAR MAGNITUDE LIMIT (MINIMUM MAGNITUDE)
25 C IQLIMT I I*4 6 CATALOG STAR QUALITY LIMITS
26 C (1=VARIABLILITY,2=COLOR,3=MULTIPLICITY,
27 C 4=NEAR NEIGHBORS, 5=POSITION ERROR,
28 C 6=MAGNITUDE ERROR)
29 C MAXCAT I I*4 MAX NUMBER OF REFERENCE STARS IN CATALOG
30 C IDNCAT I I*4 * REFERENCE STAR SKYMAP ID NUMBERS
31 C DATCAT I R*4 7,* CATALOG DATA (1=X AXIS,2=Y AXIS,3=Z AXIS,
32 C 4=MAGNITUDE,5=MOTION,
33 C 6=QUALITY,7=COLOR)
34 C IFXCLM I I*4 MAX NUMBER OF REF STAR MATCHES PER CLUMP
35 C (I.E. 1ST DIM OF MAPCLM & SKYCLM ARRAYS)
36 C NUMCLM I I*4 NUMBER OF CLUMPS
37 C TIMCLM I R*8 * AVERAGE CLUMP TIMES
38 C GCICLM I R*4 3,* AVERAGE CLUMP POSITIONS GCI
39 C BRICLM I R*4 * AVERAGE CLUMP MAGNITUDES
40 C VRMCLM I R*4 * CLUMP MAGNITUDE VARIANCE
41 C VRPCLM I R*4 * CLUMP POSITION VARIANCE
42 C NOBCLM I I*4 * NUMBER OF OBSERVATIONS PER CLUMP
43 C MRKCLM I I*4 * CLUMP STATUS FLAGS
44 C NUMSTR I I*4 NUMBER OF OBSERVATIONS
45 C KLMSTR I I*4 * CLUMP NUMBER FOR EACH OBSERVATION
46 C MRKSTR I O I*4 * STATUS FLAG FOR EACH OBSERVATION
47 C LBLCLM I O I*4 * CLUMP LABELS
48 C IDFCLM O I*4 * CLUMP IDENTIFICATION FLAGS
49 C NRFCLM O I*4 * NUMBER OF REFERENCE STARS MATCHES PER CLUMP
50 C MAPCLM O I*4 10,* LIST OF REFERENCE STAR #'S MATCHED TO CLUMP
51 C SKYCLM O R*4 10,3,* LIST OF CORRECTED REFERENCE STAR POSITIONS
52 C (MATCH#,AXIS,CLUMP#)
53 C IDFHST IO I*4 * FHST NUMBER FOR EACH CLUMP
54 C IRCODE O I*4 ERROR FLAG (0=NO ERROR, 1= ERROR)
55 C
56 C
57 C COMMON BLOCK VARIABLES USED:
58 C COMMON VAR I/O VAR I/O VAR I/O VAR I/O
59 C ------ --- --- --- --- --- --- --- ---
60 C CMLUNS LUCAT I
61 C CMDEBG LEVDBG I LUDBUG I
62 C CMSMSG IMSGNM I IVARLN I IDSTFG I IRC I
63 C C$VDAT I C$SBID I
64  IMPLICIT NONE
65 C ++INCLUDE STCMDEBG
66 C ++INCLUDE STCMLUNS
67 C ++INCLUDE STCMSMSG
68  INTEGER*4 LEVDBG(8),LUDBUG
69  COMMON /cmdebg/levdbg,ludbug
70 C
71 C
72 C EXTERNAL FILES REFERENCED:
73 C FILENAME OPERATION FORTRAN UNIT ID
74 C -------- --------- ---------------
75 C NONE
76 C
77 C EXTERNAL REFERENCES:
78 C --------------------------------------------------------------------
79 C CORECT - CORRECT REFERENCE STAR MATCHES FOR SPACECRAFT AND
80 C EARTH VELOCITY ABBERATION
81 C DMATCH - DIRECT MATCH ALGORITHM
82 C DOUBLT - DOUBLET MATCH ALGORITHM
83 C GETCAT - GET STAR CATALOG DATA
84 C SORTCL - SORT CLUMPS BY RESULTS OF DIRECT MATCH
85 C TRIPLT - TRIPLET MATCH ALGORITHM
86 C UTMSG - MESSAGE OUTPUT UTILITY
87 C
88 C SUBROUTINE CALLED FROM:
89 C --------------------------------------------------------------------
90 C STIDSTAR - STAR IDENTIFICATION PROCESSING DRIVER
91 C
92 C CONSTRAINTS, RESTRICTIONS, MESSAGES, NOTES:
93 C --------------------------------------------------------------------
94 C NONE
95 C
96 C REQUIREMENTS REFERENCES:
97 C --------------------------------------------------------------------
98 C UARS FDSS SPECS PAGES 3.1.1.5-17 TO 3.1.1.5-19 (F3-1A TO F3-4)
99 C
100 C DEVELOPMENT HISTORY:
101 C DATE AUTHOR DESCRIPTION
102 C -------- ------ -----------
103 C 8 / 1/88 R.J. BURLEY DESIGN
104 C 5 /17/89 R.J. BURLEY CODED
105 C 10/10/89 R.J. BURLEY DIRECT MATCH ALGORITHM NAME CHANGED
106 C FROM DIRECT TO DMATCH, BECAUSE DIRECT
107 C IS A GESS RESERVED WORD.
108 C 11/ 2/89 R.J. BURLEY USE UTMSG TO ADVISE USER WHEN MATCHING
109 C ALGORITHM DEFAULTS FROM IMATCH.
110 C 11/ 6/89 R.J. BURLEY ADD LBLCLM GESS ARRAY
111 C 02/ 3/92 C. C. YEH ADD IDFHST (MTASS-11)
112 C 9/30/92 D. MUCCI MTASS 151 REMOVED EPTIME FROM THE
113 C CALL TO STCORECT AND ADDED MRKCLM.
114 C-----------------------------------------------------------------------
115 C METHOD:
116 C CALL GETCAT TO GET STAR CATALOG
117 C IF (AN ERROR OCCURED IN GETCAT) WRITE MESSAGE AND ABORT
118 C
119 C CALL DMATCH TO PERFORM DIRECT MATCH ALGORITHM
120 C IF (AN ERROR OCCURED IN DMATCH) WRITE MESSAGE AND ABORT
121 C
122 C CALL CORECT TO PERFORM VELOCITY ABBERATION CORRECTION
123 C IF (AN ERROR OCCURED IN CORECT) WRITE MESSAGE AND ABORT
124 C
125 C IF (NUMCLM > 1) THEN
126 C CALL SORTCL TO SORT CLUMPS IN ASCEND ORDER OF REF STAR MATCHES
127 C ENDIF
128 C
129 C IF ((IMATCH=3).AND.(NUMCLM >= 3)) THEN
130 C CALL TRIPLT TO PERFORM TRIPLET MATCH ALGORITHM
131 C ENDIF
132 C
133 C IF ((IMATCH=2).AND.(NUMCLM >= 2)) THEN
134 C CALL DOUBLT TO PERFORM DOUBLET MATCH ALGORITHM
135 C IF (# VALID DOUBLETS = 0) THEN
136 C CALL UTMSG TO ADVISE USER THAT OUTPUT WILL BE FROM DMATCH
137 C ENDIF
138 C ELSE IF ((IMATCH=3).AND.( # VALID TRIPLETS = 0).AND.
139 C (NUMCLM >= 2)) THEN
140 C CALL UTMSG TO ADVISE USER THAT STARID IS DEFAULTING TO DOUBLT
141 C CALL DOUBLT TO PERFORM DOUBLET MATCH ALGORITHM
142 C IF (# VALID DOUBLETS = 0) THEN
143 C CALL UTMSG TO ADVISE USER THAT OUTPUT WILL BE FROM DMATCH
144 C ENDIF
145 C ENDIF
146 C RETURN
147 C-----------------------------------------------------------------------
148 C
149 C * DEFINE PARAMETER VARIABLES
150  real*8 eptime , dangtl , dmagtl , pangtl
151  real*8 tangtl , tminco , timclm(*)
152 C
153  real*4 smaglm , datcat(7,*)
154  real*4 gciclm(3,*) , briclm(*) , vrmclm(*)
155  real*4 vrpclm(*) , skyclm(10,3,*)
156 C
157  INTEGER*4 IQLIMT(6) , IMATCH , MAXCAT , IDNCAT(*)
158  INTEGER*4 NUMCLM , NOBCLM(*) , MRKCLM(*), NUMSTR
159  INTEGER*4 KLMSTR(*) , MRKSTR(*) , IDFCLM(*), NRFCLM(*)
160  INTEGER*4 LBLCLM(*) , MAPCLM(10,*) , IFXCLM , IRCODE
161  INTEGER*4 IDFHST(*)
162 C
163 C * DECLARE LOCAL VARIABLES
164  INTEGER*4 IERR , NUMTRP , NUMDUB , NUMCAT ,LUCAT
165 C
166 C INITIALIZE ROUTINE
167  IF (levdbg(7) .NE. 0) WRITE (ludbug,1000)
168  ircode = 0
169 C
170 CC -GET STAR DATA FROM CATALOG
171 C
172  CALL getcat(lucat , eptime, maxcat, smaglm, iqlimt,
173  1 numcat, idncat, datcat, ierr)
174  IF (ierr .NE. 0) THEN
175  IF (levdbg(7) .NE. 0) WRITE (ludbug,6000) ierr
176  ircode = 1
177  GO TO 9999
178  ENDIF
179 C
180 CC -PERFORM DIRECT MATCH
181 C
182  CALL dmatch (dangtl, dmagtl, ifxclm, numcat,
183  1 idncat, datcat, numstr, klmstr,
184  2 numclm, lblclm, gciclm, briclm, nobclm,
185  3 mrkclm, mrkstr, idfclm, nrfclm,
186  4 mapclm, skyclm, ierr)
187  IF (ierr .NE. 0) THEN
188  IF (levdbg(7) .NE. 0) WRITE (ludbug,6001) ierr
189  ircode = 1
190  GO TO 9999
191  ENDIF
192 C
193 CC -PERFORM VELOCITY ABBERATION CORRECTION ON MATCHED STARS
194 C
195  CALL corect(idncat, datcat, numclm, lblclm, timclm,
196  * nrfclm, mapclm, mrkclm, skyclm, ierr)
197  IF (ierr .NE. 0) THEN
198  IF (levdbg(7) .NE. 0) WRITE (ludbug,6002) ierr
199  ircode = 1
200  GO TO 9999
201  ENDIF
202 C
203 CC -SORT CLUMPS BY # OF MATCHES
204 C
205  IF (numclm .GT. 1) THEN
206  CALL sortcl (numclm, numstr, ifxclm,
207  1 lblclm, timclm, briclm, gciclm, vrmclm, vrpclm, nobclm,
208  2 mrkclm, idfclm, nrfclm, mapclm, skyclm, klmstr, idfhst)
209  ENDIF
210 C
211 CC -PERFORM TRIPLET MATCHING
212 C
213  IF ((imatch .EQ. 3).AND.(numclm .GE. 3)) THEN
214  CALL triplt (tangtl, tminco, numclm, lblclm, gciclm, nobclm,
215  1 mrkclm, numstr, klmstr, mrkstr, skyclm,
216  2 nrfclm, mapclm, idfclm, numtrp)
217  IF (levdbg(7) .GE. 4) WRITE (ludbug,4000) numtrp
218  ENDIF
219 C
220 CC -PERFORM PAIRWISE MATCHING
221 C
222  IF ((imatch .EQ. 2).AND.(numclm .GE. 2)) THEN
223  CALL doublt (pangtl, numclm, numstr, klmstr, lblclm, gciclm,
224  1 mrkclm, nrfclm, mapclm, skyclm, mrkstr, idfclm,
225  2 numdub)
226 C IF (NUMDUB .EQ. 0) THEN
227 C IMSGNM = 63
228 C IVARLN = 0
229 C CALL UTMSG (C$SBID, IMSGNM, IVARLN, C$VDAT, IDSTFG, IRC)
230 C ENDIF
231  IF (levdbg(7) .GE. 4) WRITE (ludbug,4001) numdub
232  ELSE IF ((imatch .EQ. 3).AND.(numtrp .EQ. 0).AND.
233  1 (numclm .GE. 2)) THEN
234 C IMSGNM = 62
235 C IVARLN = 0
236 C CALL UTMSG (C$SBID, IMSGNM, IVARLN, C$VDAT, IDSTFG, IRC)
237  WRITE(*,*)'NO TRIPLETS FOUND -- ATTEMPTING PAIR MATCHING'
238  CALL doublt (pangtl, numclm, numstr, klmstr, lblclm, gciclm,
239  1 mrkclm, nrfclm, mapclm, skyclm, mrkstr, idfclm,
240  2 numdub)
241 C IF (NUMDUB .EQ. 0) THEN
242 C IMSGNM = 63
243 C IVARLN = 0
244 C CALL UTMSG (C$SBID, IMSGNM, IVARLN, C$VDAT, IDSTFG, IRC)
245 C ENDIF
246  IF (levdbg(7) .GE. 4) WRITE (ludbug,4001) numdub
247  ENDIF
248 9999 CONTINUE
249  IF (levdbg(7) .NE. 0) WRITE (ludbug,2000)
250 C
251 C -FORMAT SECTION
252 C
253 1000 FORMAT(' *** ENTER IDENTY 92/09/30 ***')
254 2000 FORMAT(' *** EXIT IDENTY ***')
255 4000 FORMAT(' TRIPLT MATCH: NUMBER OF VALID TRIPLETS = ',i8)
256 4001 FORMAT(' DOUBLT MATCH: NUMBER OF VALID DOUBLETS = ',i8)
257 6000 FORMAT(' ABEND IDENTY: ERROR RETURN FROM GETCAT = ',i8)
258 6001 FORMAT(' ABEND IDENTY: ERROR RETURN FROM DMATCH = ',i8)
259 6002 FORMAT(' ABEND IDENTY: ERROR RETURN FROM CORECT = ',i8)
260  RETURN
261  END
getcat
subroutine getcat(lucat, eptime, maxcat, smaglm, iqlimt, numcat, idncat, datcat, ierr)
Definition: getcat.f:3
real
#define real
Definition: DbAlgOcean.cpp:26
corect
subroutine corect(IDNCAT, DATCAT, NUMCLM, LBLCLM, TIMCLM, NRFCLM, MAPCLM, MRKCLM, SKYCLM, IERR)
Definition: corect.f:3
doublt
subroutine doublt(PANGTL, NUMCLM, NUMSTR, KLMSTR, LBLCLM, GCICLM, MRKCLM, NRFCLM, MAPCLM, SKYCLM, MRKSTR, IDFCLM, NUMDUB)
Definition: doublt.f:4
triplt
subroutine triplt(TANGTL, TMINCO, NUMCLM, LBLCLM, GCICLM, NOBCLM, MRKCLM, NUMSTR, KLMSTR, MRKSTR, SKYCLM, NRFCLM, MAPCLM, IDFCLM, NUMTRP)
Definition: triplt.f:6
identy
subroutine identy(EPTIME, IMATCH, DANGTL, DMAGTL, PANGTL, TANGTL, TMINCO, SMAGLM, IQLIMT, MAXCAT, IDNCAT, DATCAT, IFXCLM, NUMCLM, TIMCLM, GCICLM, BRICLM, VRMCLM, VRPCLM, NOBCLM, MRKCLM, NUMSTR, KLMSTR, MRKSTR, LBLCLM, IDFCLM, NRFCLM, MAPCLM, SKYCLM, IDFHST, IRCODE)
Definition: identy.f:8
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
sortcl
subroutine sortcl(NUMCLM, NUMSTR, IFXCLM, LBLCLM, TIMCLM, BRICLM, GCICLM, VRMCLM, VRPCLM, NOBCLM, MRKCLM, IDFCLM, NRFCLM, MAPCLM, SKYCLM, KLMSTR, IDFHST)
Definition: sortcl.f:5


ABOUT

Our Team

Contact Us

DATA

Get Started

Find Data

Use Data

TOOLS

SeaBASS

SeaDAS

Giovanni Data Visualizer

Worldview Mapping Interface

Mission Quality Monitor

HELP

Level 1 & 2 Browser Help

Level 3 & 4 Browser Help

File Search Help

Search & Download Help

Earthdata Forum

Join Mailing List

How to Cite Data

CONNECT WITH US
COMPLIANCE

Web Privacy Policy

Data & Information Policy

Communications Policy

Accessibility Policy

Freedom of Information Act

USA.gov

Responsible NASA Official: Sean Bailey
Curator: OceanColor Webmaster