1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
|
*DECK XCWROD
SUBROUTINE XCWROD(NRIN,NRODS,NRODR,RODR,RODP,RADC,NFSEG,NLSEG,
> SEGLEN,NRSEG,NNSEG)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Perform rod tracking for 2-D cluster geometry.
*
*Copyright:
* Copyright (C) 1992 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version
*
*Author(s): G.Marleau
*
*Parameters: input
* NRIN current region number.
* NRODS integer description of rod type:
* NRODS(1) = number of rod;
* NRODS(2) = number of subrods in rod.
* NRODR subrod region.
* RODR subrod radius.
* RODP rod position:
* RODP(1,IRD) = X-position;
* RODP(2,IRD) = Y-position.
* RADC Y-position of track.
*
*Parameters: output
* NFSEG initial segment position.
* NLSEG final segment position.
* SEGLEN length of track.
* NRSEG region crossed by track.
* NNSEG region crossed by track (left).
*
*----------------------------------------------------------------------
*
INTEGER NRIN,NRODS(2),NRODR,NFSEG,NLSEG,NRSEG(*),NNSEG(*)
REAL RODR(*),RODP(2,*)
DOUBLE PRECISION SEGLEN(*),RADC,RADR,RADR2
*----
* FILL IN SEGLEN FROM THE END STARTING WITH ROD FURTHER FROM
* TRACK STARTING POINT UNTIL CENTER OF TRACK REACHED
*----
NPROD=(NRODS(1)+3)/2
NSBR=NRODS(2)
IF(RADC.GE.0.0D0) THEN
IPDEB=1
IPFIN=NPROD
IPSTP=1
IMDEB=NPROD
IMFIN=1
IMSTP=-1
ELSE
RADR=RODP(2,1)-RADC
IF(ABS(RADR).LT.RODR(NSBR)) THEN
IPDEB=NRODS(1)+1
IPFIN=MAX(2,NRODS(1)+1-NPROD)
ELSE
IPDEB=NRODS(1)
IPFIN=MAX(1,NRODS(1)-NPROD)
ENDIF
IPSTP=-1
IMDEB=IPFIN
IMFIN=IPDEB
IMSTP=1
ENDIF
NXSEG=NLSEG
DO 100 IRZ=IPDEB,IPFIN,IPSTP
IF(IRZ.EQ.NRODS(1)+1) THEN
IRD=1
ELSE
IRD=IRZ
ENDIF
RADR=RODP(2,IRD)-RADC
RADR2=RADR*RADR
NREG=NRIN
IF( ABS(RADR).LT.RODR(NSBR) ) THEN
*----
* ROD INTERCEPS
*----
XTRA=SQRT(RODR(NSBR)*RODR(NSBR)-REAL(RADR2))
XLST=RODP(1,IRD)+XTRA
XFST=RODP(1,IRD)-XTRA
IF(XLST.LT.0.0) THEN
*----
* CENTER OF TRACK REACHED/EXIT
*----
GO TO 1000
ELSE
*----
* SET POINTERS TO SEGLEN VECTOR W.R.T. LAST POSITION FREE
*----
NFLSEG=NXSEG-2*NSBR
NLLSEG=NXSEG
NXSEG=NFLSEG
ENDIF
SEGLEN(NLLSEG)=XLST
NRSEG(NLLSEG)=NREG
NNSEG(NFLSEG+1)=-NREG
NLLSEG=NLLSEG-1
NREG=NRODR
NFLSEG=NFLSEG+1
SEGLEN(NFLSEG)=XFST
NRSEG(NFLSEG)=NREG
NNSEG(NLLSEG+1)=-NREG
DO 110 ISBR=NSBR-1,1,-1
IF( ABS(RADR).LT.RODR(ISBR) ) THEN
*----
* SUBROD INTERCEPS
*----
XTRA=SQRT(RODR(ISBR)*RODR(ISBR)-REAL(RADR2))
SEGLEN(NLLSEG)=RODP(1,IRD)+XTRA
NRSEG(NLLSEG)=NREG
NNSEG(NFLSEG+1)=-NREG
NLLSEG=NLLSEG-1
NREG=NREG-1
NFLSEG=NFLSEG+1
SEGLEN(NFLSEG)=RODP(1,IRD)-XTRA
NRSEG(NFLSEG)=NREG
NNSEG(NLLSEG+1)=-NREG
ENDIF
110 CONTINUE
ENDIF
100 CONTINUE
1000 CONTINUE
NLSEG=NXSEG
*----
* FILL IN SEGLEN FROM THE BEGINNING STARTING WITH ROD CLOSEST FROM
* TRACK STARTING POINT UNTIL CENTER OF TRACK REACHED
*----
NXSEG=NFSEG
DO 200 IRZ=IMDEB,IMFIN,IMSTP
IF(IRZ.EQ.NRODS(1)+1) THEN
IRD=1
ELSE
IRD=IRZ
ENDIF
RADR=RODP(2,IRD)-RADC
RADR2=RADR*RADR
NREG=NRIN
IF( ABS(RADR).LT.RODR(NSBR) ) THEN
*----
* ROD INTERCEPS
*----
XTRA=SQRT(RODR(NSBR)*RODR(NSBR)-REAL(RADR2))
XLST=RODP(1,IRD)+XTRA
XFST=RODP(1,IRD)-XTRA
IF(XLST.LT.0.0) THEN
*----
* SET POINTERS TO SEGLEN VECTOR W.R.T. FIRST POSITION FREE
*----
NLLSEG=NXSEG+2*NSBR
NFLSEG=NXSEG
NXSEG=NLLSEG
ELSE
*----
* CENTER OF TRACK REACHED/EXIT
*----
GO TO 2000
ENDIF
SEGLEN(NLLSEG)=XLST
NRSEG(NLLSEG)=NREG
NNSEG(NFLSEG+1)=-NREG
NLLSEG=NLLSEG-1
NREG=NRODR
NFLSEG=NFLSEG+1
SEGLEN(NFLSEG)=XFST
NRSEG(NFLSEG)=NREG
NNSEG(NLLSEG+1)=-NREG
DO 210 ISBR=NSBR-1,1,-1
IF( ABS(RADR).LT.RODR(ISBR) ) THEN
*----
* SUBROD INTERCEPS
*----
XTRA=SQRT(RODR(ISBR)*RODR(ISBR)-REAL(RADR2))
SEGLEN(NLLSEG)=RODP(1,IRD)+XTRA
NRSEG(NLLSEG)=NREG
NNSEG(NFLSEG+1)=-NREG
NLLSEG=NLLSEG-1
NREG=NREG-1
NFLSEG=NFLSEG+1
SEGLEN(NFLSEG)=RODP(1,IRD)-XTRA
NRSEG(NFLSEG)=NREG
NNSEG(NLLSEG+1)=-NREG
ENDIF
210 CONTINUE
ENDIF
200 CONTINUE
2000 CONTINUE
NFSEG=NXSEG
RETURN
END
|
