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
|
*DECK XCWSRT
SUBROUTINE XCWSRT(IPRT,MXSEG,SEGLEN,NRSEG,NNSEG,NTSEG)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Sort region intersection by position.
*
*Copyright:
* Copyright (C) 1994 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
* IPRT print level.
* MXSEG current maximum track length.
*
*Parameters: input/output
* SEGLEN length of track.
* NRSEG region crossed by track.
* NNSEG region crossed by track (left).
*
*Parameters: output
* NTSEG total number of segments.
*
*----------------------------------------------------------------------
*
PARAMETER (IUNOUT=6)
INTEGER IPRT,MXSEG,NRSEG(*),NNSEG(*),NTSEG
DOUBLE PRECISION SEGLEN(*)
*----
* LOCAL VARIABLES
*----
INTEGER REFNR,REFNN
DOUBLE PRECISION REFSL
*----
* REMOVE TERM WITH NRSEG<=0
*----
NTSEG=0
DO 100 IS=1,MXSEG-1
IF(NRSEG(IS).GT.0) THEN
NTSEG=NTSEG+1
NRSEG(NTSEG)=NRSEG(IS)
NNSEG(NTSEG)=NNSEG(IS)
SEGLEN(NTSEG)=SEGLEN(IS)
ENDIF
100 CONTINUE
NSEG=NTSEG+1
NRSEG(NSEG)=NRSEG(MXSEG)
NNSEG(NSEG)=NNSEG(MXSEG)
SEGLEN(NSEG)=SEGLEN(MXSEG)
IF(IPRT.GE.200) THEN
WRITE(IUNOUT,6000)
WRITE(IUNOUT,6010) (IIJJ,SEGLEN(IIJJ),NNSEG(IIJJ),
> NRSEG(IIJJ),IIJJ=1,NSEG)
ENDIF
*----
* SORT FROM MINIMUM TO MAXIMUM
*----
DO 110 IS=2,NSEG
REFSL=SEGLEN(IS)
REFNR=NRSEG(IS)
REFNN=NNSEG(IS)
DO 111 JS=IS-1,1,-1
KS=JS
IF(SEGLEN(JS).GT.REFSL) THEN
SEGLEN(JS+1)=SEGLEN(JS)
NRSEG(JS+1)=NRSEG(JS)
NNSEG(JS+1)=NNSEG(JS)
ELSE
GO TO 112
ENDIF
111 CONTINUE
KS=0
112 CONTINUE
SEGLEN(KS+1)=REFSL
NRSEG(KS+1)=REFNR
NNSEG(KS+1)=REFNN
110 CONTINUE
IF(IPRT.GE.200) THEN
WRITE(IUNOUT,6001)
WRITE(IUNOUT,6010) (IIJJ,SEGLEN(IIJJ),NNSEG(IIJJ),
> NRSEG(IIJJ),IIJJ=1,NSEG)
ENDIF
*----
* CHECK FOR ROD INTERSECTION WITH ANNULUS OR
* ANNULUS LOCATED BETWEEN ROD SETS
*----
DO 120 IS=1,NSEG
NTB=NRSEG(IS)
NFB=NNSEG(IS)
IF(NTB.GT.0) THEN
IF(NTB.LT.NFB) THEN
DO 121 JS=IS+1,NSEG
NTE=NRSEG(JS)
NFE=NNSEG(JS)
IF((NTE.EQ.NFB).AND.(NFE.EQ.NTB)) GO TO 122
IF(NTE.GT.NTB) THEN
NRSEG(JS)=NTB
ENDIF
IF(ABS(NFE).GT.NTB) THEN
IF(NFE.LT.0) THEN
NNSEG(JS)=-NTB
ELSE
NNSEG(JS)=NTB
ENDIF
ENDIF
121 CONTINUE
ENDIF
ENDIF
122 CONTINUE
IF(NFB.GT.0) THEN
DO 123 JS=IS-1,1,-1
NTE=NRSEG(JS)
IF(NTE.GT.0) THEN
IF(NFB.NE.NTE) THEN
NRSEG(IS)=0
ENDIF
GO TO 124
ENDIF
123 CONTINUE
ENDIF
124 CONTINUE
120 CONTINUE
*----
* REMOVE NEW TERMS WITH NRSEG<=0
*----
NTSEG=0
DO 130 IS=1,NSEG-1
IF(NRSEG(IS).GT.0) THEN
NTSEG=NTSEG+1
NRSEG(NTSEG)=NRSEG(IS)
NNSEG(NTSEG)=NNSEG(IS)
SEGLEN(NTSEG)=SEGLEN(IS)
ENDIF
130 CONTINUE
NSEG=NTSEG+1
NRSEG(NSEG)=NRSEG(MXSEG)
NNSEG(NSEG)=NNSEG(MXSEG)
SEGLEN(NSEG)=SEGLEN(MXSEG)
RETURN
*----
* FORMATS
*----
6000 FORMAT(' COMPRESSED TRACKING FILE'/
>5X,'NUMBER',7X,'POSITION',4X,'BEFORE',5X,'AFTER')
6001 FORMAT(' SORTED TRACKING FILE'/
>5X,'NUMBER',7X,'POSITION',4X,'BEFORE',5X,'AFTER')
6010 FORMAT((1X,I10,F15.7,2I10))
END
|
