OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
coline.f
Go to the documentation of this file.
1  SUBROUTINE coline
2  i (iclma, iclmb, iclmc, lblclm, gciclm,
3  o coangl)
4 C-----------------------------------------------------------------------
5 C MODULE NAME: STCOLINE
6 C
7 C
8 C PURPOSE: TO COMPUTE COLINEAR FUNCTION FOR STAR CLUMP TRIPLET
9 C
10 C
11 C ARGUMENT LIST:
12 C ARGUMENT I/O TYPE DIMENS DESCRIPTION
13 C -------- --- ---- ------ -----------
14 C ICLMA I I*4 CLUMP NUMBER OF FIRST CLUMP OF TRIPLET
15 C ICLMB I I*4 CLUMP NUMBER OF SECOND CLUMP OF TRIPLET
16 C ICLMC I I*4 CLUMP NUMBER OF THIRD CLUMP OF TRIPLET
17 C LBLCLM I I*4 CLUMP LABLES
18 C GCICLM I R*4 3,* AVERAGE CLUMP POSITIONS GCI
19 C COANGL O R*8 COLINEARITY ANGLE
20 C
21 C
22 C COMMON BLOCK VARIABLES USED:
23 C COMMON VAR I/O VAR I/O VAR I/O VAR I/O
24 C ------ --- --- --- --- --- --- --- ---
25 C CMDEBG LEVDBG I LUDBUG I
26 C
27 C ++INCLUDE STCMDEBG
28  INTEGER*4 LEVDBG(8),LUDBUG
29  COMMON /cmdebg/levdbg,ludbug
30 C
31 C EXTERNAL FILES REFERENCED:
32 C FILENAME OPERATION FORTRAN UNIT ID
33 C -------- --------- ---------------
34 C NONE
35 C
36 C EXTERNAL REFERENCES:
37 C --------------------------------------------------------------------
38 C UTDANGLE - FUNCTION TO COMPUTE ANGULAR SEPARATIONS BETWEEN VECTORS
39 C
40 C
41 C SUBROUTINE CALLED FROM:
42 C --------------------------------------------------------------------
43 C STTRIPLT - STAR MATCHING TRIPLET ALGORITHM
44 C
45 C
46 C CONSTRAINTS, RESTRICTIONS, MESSAGES, NOTES:
47 C --------------------------------------------------------------------
48 C NONE
49 C
50 C REQUIREMENTS REFERENCES:
51 C --------------------------------------------------------------------
52 C UARS FDSS SPECS 3.1.1.5 (F5.3)
53 C
54 C DEVELOPMENT HISTORY:
55 C DATE AUTHOR DESCRIPTION
56 C -------- ------ -----------
57 C 8/ 8/88 R.J. BURLEY DESIGN
58 C 5/ 18/89 R.J. BURLEY CODED
59 C 10/24/89 R.J. BURLEY SUBTRACT LARGEST ANGULAR SEPARATION
60 C FROM THE SUM OF THE OTHER 2, NOT
61 C VICE VERSA.
62 C 11/ 6/89 R.J. BURLEY ADD CLUMP LABLES
63 C-----------------------------------------------------------------------
64 C METHOD:
65 C COMPUTE ROTATION ANGLES BETWEEN 3 AVG CLUMP POSITIONS
66 C RETURN THE SMALLEST ANGLE OF THE 3
67 C REFERENCE: WERTZ, APPENDIX A, EQ. A-2
68 C-----------------------------------------------------------------------
69 C
70 C * DEFINE PARAMETER VARIABLES
71  real*8 coangl
72 C
73  real*4 gciclm(3,*)
74 C
75  INTEGER*4 LBLCLM(*), ICLMA , ICLMB , ICLMC
76 C
77 C * DECLARE LOCAL VARIABLES
78  real*8 dangle , angdif , toler
79  real*8 e2clma(3), e2clmb(3), e2clmc(3)
80  real*8 enclma(3), enclmb(3), enclmc(3), emag
81  real*8 cang12 , cang13 , cang23 , pi , pio2
82  real*8 cang1 , cang2 , cang3
83  real*4 clma(3) , clmb(3) , clmc(3)
84  INTEGER*4 IAXIS
85  DATA toler /0.99d0/
86  DATA pi/3.14159265359d0/,pio2/1.570796327/
87 
88 C
89 C INITIALIZE ROUTINE
90 C IF (LEVDBG(7) .NE. 0) WRITE (LUDBUG,1000)
91 C
92 C COMPUTE ROTATION ANGLES
93  DO 100 iaxis = 1,3
94  e2clma(iaxis) = gciclm(iaxis,iclma)
95  e2clmb(iaxis) = gciclm(iaxis,iclmb)
96  e2clmc(iaxis) = gciclm(iaxis,iclmc)
97 100 CONTINUE
98  cang12 = dangle(e2clma,e2clmb, toler, angdif)
99  cang13 = dangle(e2clma,e2clmc, toler, angdif)
100  cang23 = dangle(e2clmb,e2clmc, toler, angdif)
101 
102  cang1 = acos((cos(cang23) - cos(cang12)*cos(cang13))/
103  * (sin(cang12)*sin(cang13)))
104  cang2 = acos((cos(cang13) - cos(cang12)*cos(cang23))/
105  * (sin(cang12)*sin(cang23)))
106  cang3 = acos((cos(cang12) - cos(cang13)*cos(cang23))/
107  * (sin(cang13)*sin(cang23)))
108 C
109 C FIND THE SMALLEST ANGLE
110  coangl = dmin1(cang1,cang2,cang3)
111 C
112 C DEBUG
113  IF (levdbg(7) .GE. 4) THEN
114  WRITE (ludbug,4000) lblclm(iclma), lblclm(iclmb),
115  1 lblclm(iclmc), coangl
116  ENDIF
117 C
118 C NORMAL TERMINATION
119 C IF (LEVDBG(7) .NE. 0) WRITE (LUDBUG,2000)
120  RETURN
121 C
122 C FORMAT SECTION
123 1000 FORMAT(' *** ENTER COLINE ***')
124 2000 FORMAT(' *** EXIT COLINE ***')
125 C4000 FORMAT(' STCOLINE DEBUG: ',
126 4000 FORMAT(' COLINEAR ANGLE BETWEEN CLUMPS',3(2x,i6),' = ',d12.6)
127  END
#define real
Definition: DbAlgOcean.cpp:26
#define pi
Definition: vincenty.c:23
subroutine coline(ICLMA, ICLMB, ICLMC, LBLCLM, GCICLM, COANGL)
Definition: coline.f:4
real *8 function dangle(A, B, TOLER, ANG)
Definition: dangle.f:62