[u/mrichter/AliRoot.git] / GEANT321 / gdraw / gdrawv.F

*
* $Id$
*
* $Log$
* Revision 1.2  1996/09/30 13:37:24  ravndal
* Backward compatibility for view banks
*
* Revision 1.1.1.1  1995/10/24 10:20:27  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.27  by  S.Giani
*-- Author :
      SUBROUTINE GDRAWV(U,V,NP)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *       GDRAWV stores sparse segments ( NP = 2 ) in a buffer.    *
C.    *       When the buffer is full it is scanned to collect         *
C.    *       segments into polylines ( NP > 2 ), that will be         *
C.    *       drawn by the GDRAWP routine.                             *
C.    *                                                                *
C.    *       Variables used in the routine :                          *
C.    *                                                                *
C.    *       EPS    = Error range of user coordinates until which     *
C.    *                they are considered as coincident points        *
C.    *                                                                *
C.    *       I0     = Pointer to starting point of polyline (in X,Y)  *
C.    *       I1     = Pointer to starting point of segment (in X,Y)   *
C.    *       I2     = Pointer to ending point of segment (in X,Y)     *
C.    *       INEW   = Number of points of polyline (in XNEW,YNEW)     *
C.    *                                                                *
C.    *       NSEG   = Current number of segments                      *
C.    *       MAXSEG = Max number of segments                          *
C.    *       MAXNEW = Max length of polyline                          *
C.    *                                                                *
C.    *       X      = Vector of x-coordinates of input segments       *
C.    *       Y      = Vector of y-coordinates of input segments       *
C.    *       IEMPTY = Vector to flag empty points; if IEMPTY(I)=1     *
C.    *                then X(I),Y(I) has been already linked          *
C.    *                                                                *
C.    *                (X,Y,IEMPTY are dimensioned to MAXSEG*2)        *
C.    *                                                                *
C.    *       IATTL  = Vector of attributes of input segments,         *
C.    *                dimensioned to MAXSEG                           *
C.    *                                                                *
C.    *       XNEW   = Vector of x-coordinates of output polyline      *
C.    *       YNEW   = Vector of y-coordinates of output polyline      *
C.    *                                                                *
C.    *                (XNEW,YNEW are dimensioned to MAXNEW)           *
C.    *                                                                *
C.    *       LUDEB  = If < 0 then no debug printout will be done      *
C.    *                                                                *
C.    *       ISTF   = Flag for statistics printout;                   *
C.    *                if ISTF=1 a statistics of polylines length      *
C.    *                will be done (to be printed interactively)      *
C.    *                                                                *
C.    *       LINBUF = Flag to determine if GDRAWV has to perform      *
C.    *                line buffering logic (LINBUF=1) or not          *
C.    *                                                                *
C.    *    ==>Called by : <USER>, <GXINT>, GDAHIT, GDARC, GDARR,       *
C.    *                   GDCIRC, GDCIRR, GDCIRY, GDCUT, GDHEAD,       *
C.    *                   GDLINE, GDMAN, GDPRTR, GDRAW, GDRECT,        *
C.    *                   GDSCAL, GDSHOW, GDSURF, GDTREE               *
C.    *       Author : P.Zanarini   S.Giani 1992  *********            *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gcdraw.inc"
#include "geant321/gcvolu.inc"
#include "geant321/gcunit.inc"
#include "geant321/gcspee.inc"
      CHARACTER*80 ILINE
      DIMENSION U(*),V(*)
      DIMENSION X(160),Y(160),IEMPTY(160)
      DIMENSION IATTL(80)
      DIMENSION XNEW(45),YNEW(45)
      DIMENSION IDBIST(2,20),IDBERR(10)
      SAVE X,Y,IEMPTY,IATTL,IDBIST,IDBERR,XNEW,YNEW
      SAVE MAXSEG,MAXNEW,EPS,LUDEB,ISTF,NSEG,INEW
      DATA MAXSEG/80/
      DATA MAXNEW/45/
      DATA EPS/0.00001/
      DATA LUDEB/-1/
      DATA ISTF/0/
      DATA IDBERR,IDBIST/50*0/
C.
C.    ------------------------------------------------------------------
C.
      IF (NP.EQ.-1) THEN
C
C             Initialize (open) the line buffer
C
         LINBUF=1
         NSEG=0
         INEW=0
         GO TO 999
C
      ELSE IF (NP.EQ.0) THEN
C
C             Empties (close) the line buffer
C
         LINBUF=0
         GO TO 10
C
      ELSE IF (NP.GT.2) THEN
C
C             Call directly GDRAWP
C
         CALL GDRAWP(U,V,NP)
         GO TO 999
C
C
      ELSE IF (LINBUF.EQ.0) THEN
C
C             Call directly GDRAWP
C
         CALL GDRAWP(U,V,NP)
         GO TO 999
C
      ENDIF
C
      LTY=IBITS(LINATT,10,3)
      CALL UCTOH('ON  ',IFLH,4,4)
      IF(LTY.NE.6.AND.IHIDEN.EQ.IFLH)THEN
         CALL GDRAWP(U,V,NP)
         GO TO 999
      ENDIF
C             Fill the line buffer
C
      NSEG=NSEG+1
      IATTL(NSEG)=LINATT
C
      NPOINT=NSEG*2
      X(NPOINT-1)=U(1)
      Y(NPOINT-1)=V(1)
      X(NPOINT)=U(2)
      Y(NPOINT)=V(2)
C
      IF (NSEG.NE.MAXSEG) GO TO 999
C
C             Line buffer full : check for joined lines
C
C             Initialisation phase
C
   10 CONTINUE
C
      I0=1
      INEW=0
      NPOINT=NSEG*2
C
      DO 20 I=1,NPOINT
         IEMPTY(I)=0
   20 CONTINUE
C
C             Loop phase
C
   30 CONTINUE
C
      NPOINT=NSEG*2
C
      DO 40 K=I0,NPOINT
         IF (IEMPTY(K).EQ.0) GO TO 50
   40 CONTINUE
C
C             Buffer empty
C
      NSEG=0
      GO TO 999
C
   50 CONTINUE
C
      KDIV2=(K+1)/2
      IF (INEW.EQ.0) LINATT=IATTL(KDIV2)
C
      I1=K
      INEW=INEW+1
      XNEW(INEW)=X(I1)
      YNEW(INEW)=Y(I1)
      IEMPTY(I1)=1
      I0=I1
C
   60 CONTINUE
C
      IF ((I1/2)*2.EQ.I1) THEN
         I2=I1-1
      ELSE
         I2=I1+1
      ENDIF
C
      I2DIV2=(I2+1)/2
      IF (INEW.EQ.0) LINATT=IATTL(I2DIV2)
C
      INEW=INEW+1
      XNEW(INEW)=X(I2)
      YNEW(INEW)=Y(I2)
      IEMPTY(I2)=1
C
      IF (INEW.EQ.MAXNEW) THEN
         IF (LUDEB.GE.0) THEN
            WRITE (CHMAIL,10000) NAMES(NLEVEL),INEW
            CALL GMAIL(0,0)
         ENDIF
         IDBERR(1)=IDBERR(1)+1
         GO TO 70
      ENDIF
C
C             Link is closed ?
C
      IF ((X(I2).LT.X(I0)-EPS).OR.(X(I2).GT.X(I0)+EPS)) GO TO 140
      IF ((Y(I2).LT.Y(I0)-EPS).OR.(Y(I2).GT.Y(I0)+EPS)) GO TO 140
C
C             Link closed
C
   70 CONTINUE
C
      IF (INEW.GT.3) THEN
         CALL GDRAWP(XNEW,YNEW,INEW)
      ELSE
         IF (INEW.EQ.3) CALL GDRAWP(XNEW,YNEW,INEW)
         IF (LUDEB.GE.0) THEN
            WRITE (CHMAIL,10100) NAMES(NLEVEL),INEW
            CALL GMAIL(0,0)
         ENDIF
         IDBERR(2)=IDBERR(2)+1
      ENDIF
C
   80 CONTINUE
C
C             Do some statistics if in statistics mode
C
      IF (ISTF.EQ.1) THEN
         IF (INEW.LE.3) GO TO 120
         LENPOL=INEW-1
   90    CONTINUE
         DO 100 I=1,20
            IF (LENPOL.EQ.IDBIST(1,I)) THEN
               IDBIST(2,I)=IDBIST(2,I)+1
               GO TO 120
            ENDIF
  100    CONTINUE
         DO 110 I=1,20
            IF (IDBIST(1,I).EQ.0) THEN
               IDBIST(1,I)=LENPOL
               GO TO 90
            ENDIF
  110    CONTINUE
         WRITE (CHMAIL,10800) LENPOL
         CALL GMAIL(0,0)
  120    CONTINUE
      ENDIF
C
      IF (LUDEB.LT.0) GO TO 130
C
C             Do some printout if in debugging mode
C
      LENPOL=INEW-1
      WRITE (CHMAIL,10400) NAMES(NLEVEL),LENPOL
      CALL GMAIL(0,0)
      IC0=I0/2
      IF ((I0/2)*2.NE.I0) IC0=IC0+1
      IC1=I1/2
      IF ((I1/2)*2.NE.I1) IC1=IC1+1
      ILINE=' '
      ILINE(IC1:IC1)='1'
      ILINE(IC0:IC0)='0'
      WRITE (CHMAIL,10500) I0,I1,I2,INEW,NSEG
      CALL GMAIL(1,0)
      WRITE (CHMAIL,10600) ILINE(1:NSEG)
      CALL GMAIL(0,0)
      NPOINT=NSEG*2
      NPOIN1=NPOINT-1
      WRITE (CHMAIL,10700) (IEMPTY(JJ),JJ=1,NPOIN1,2)
      CALL GMAIL(0,0)
      WRITE (CHMAIL,10700) (IEMPTY(JJ),JJ=2,NPOINT,2)
      CALL GMAIL(0,0)
C
  130 CONTINUE
      INEW=0
      GO TO 30
C
  140 CONTINUE
C
      NPOINT=NSEG*2
C
C             Compute starting point of next segment
C
      NEXT=0
C
      DO 150 K=I0,NPOINT
         IF (K.EQ.I2) GO TO 150
         IF ((X(I2).LT.X(K)-EPS).OR.(X(I2).GT.X(K)+EPS)) GO TO 150
         IF ((Y(I2).LT.Y(K)-EPS).OR.(Y(I2).GT.Y(K)+EPS)) GO TO 150
         NEXT=K
         GO TO 160
  150 CONTINUE
C
  160 CONTINUE
C
      IF (NEXT.NE.0) THEN
         I1=NEXT
         IEMPTY(I1)=1
         GO TO 60
      ENDIF
C
      IF (I0.EQ.1) THEN
         CALL GDRAWP(XNEW,YNEW,INEW)
         IF (LUDEB.GE.0) THEN
            WRITE (CHMAIL,10200) NAMES(NLEVEL),INEW
            CALL GMAIL(0,0)
         ENDIF
         IDBERR(3)=IDBERR(3)+1
         GO TO 80
      ENDIF
C
C             Reset flag : next call to GDRAWV will re-process
C             the points now forming an open polyline, trying then
C             (with the new points stored) to form a closed polyline
C
      DO 170 I=I0,NPOINT
         IEMPTY(I)=0
  170 CONTINUE
C
      NSEGOL=NSEG
C
C             Try to see if the buffers can be shifted
C
  180 CONTINUE
C
      DO 190 NLIN=1,NSEG
         IF (IEMPTY(NLIN*2).EQ.0) GO TO 210
  190 CONTINUE
C
      IF (NSEG.NE.NSEGOL) THEN
C
C             The buffers have been shifted enough
C
         GO TO 230
C
      ELSE
C
C             The buffers cannot be shifted at all
C
         IF (LUDEB.GE.0) THEN
            WRITE (CHMAIL,10300) NAMES(NLEVEL)
            CALL GMAIL(0,0)
         ENDIF
         IDBERR(4)=IDBERR(4)+1
         LINATT=IATTL(1)
         DO 200 I=1,NSEG
            J=I*2-1
            CALL GDRAWP(X(J),Y(J),2)
  200    CONTINUE
         INEW=0
         GO TO 30
C
      ENDIF
C
  210 CONTINUE
C
C             Shift the buffers
C
      IF (NLIN.EQ.1) GO TO 230
      NSEG=NSEG-NLIN+1
      N=NSEG*2
      J=NLIN*2-2
      DO 220 I=1,N
         X(I) = X(J+I)
         Y(I) = Y(J+I)
         IEMPTY(I) = IEMPTY(J+I)
  220 CONTINUE
      CALL UCOPY(IATTL(NLIN),IATTL(1),NSEG)
C
      IF (NSEG.GT.0) GO TO 180
C
      GO TO 999
C
  230 CONTINUE
C
C             If last call to GDRAWV (NP=0, i.e. close the buffer)
C             and some lines have still to be processed (NSEG>0)
C             then don't RETURN but re-execute the body of GDRAWV
C
      IF (NP.EQ.0.AND.NSEG.GT.0) GO TO 10
C
10000 FORMAT (' *** GDRAWV: ERROR 1 -  NAME = ',A4,' INEW = ',I3)
10100 FORMAT (' *** GDRAWV: ERROR 2 -  NAME = ',A4,' INEW = ',I3)
10200 FORMAT (' *** GDRAWV: ERROR 3 -  NAME = ',A4,' INEW = ',I3)
10300 FORMAT (' *** GDRAWV: ERROR 4 -  NAME = ',A4)
10400 FORMAT (' *** GDRAWV: GDRAWP called for ',A4,' (',I2,' segments)')
10500 FORMAT (' LOOP : I0=',I3,' - I1=',I3,' - I2=',I3,
     +        ' - INEW=',I3,' - NSEG=',I3)
10600 FORMAT (1X,A)
10700 FORMAT (1X,80I1)
10800 FORMAT (' *** STATISTICS OVERFLOW ***   LENPOL =',I3)
  999 END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.2 1996/09/30 13:37:24 ravndal
	6	* Backward compatibility for view banks
	7	*
	8	* Revision 1.1.1.1 1995/10/24 10:20:27 cernlib
	9	* Geant
	10	*
	11	*
	12	#include "geant321/pilot.h"
	13	*CMZ : 3.21/02 29/03/94 15.41.27 by S.Giani
	14	*-- Author :
	15	SUBROUTINE GDRAWV(U,V,NP)
	16	C.
	17	C. ******************************************************************
	18	C. * *
	19	C. * GDRAWV stores sparse segments ( NP = 2 ) in a buffer. *
	20	C. * When the buffer is full it is scanned to collect *
	21	C. * segments into polylines ( NP > 2 ), that will be *
	22	C. * drawn by the GDRAWP routine. *
	23	C. * *
	24	C. * Variables used in the routine : *
	25	C. * *
	26	C. * EPS = Error range of user coordinates until which *
	27	C. * they are considered as coincident points *
	28	C. * *
	29	C. * I0 = Pointer to starting point of polyline (in X,Y) *
	30	C. * I1 = Pointer to starting point of segment (in X,Y) *
	31	C. * I2 = Pointer to ending point of segment (in X,Y) *
	32	C. * INEW = Number of points of polyline (in XNEW,YNEW) *
	33	C. * *
	34	C. * NSEG = Current number of segments *
	35	C. * MAXSEG = Max number of segments *
	36	C. * MAXNEW = Max length of polyline *
	37	C. * *
	38	C. * X = Vector of x-coordinates of input segments *
	39	C. * Y = Vector of y-coordinates of input segments *
	40	C. * IEMPTY = Vector to flag empty points; if IEMPTY(I)=1 *
	41	C. * then X(I),Y(I) has been already linked *
	42	C. * *
	43	C. * (X,Y,IEMPTY are dimensioned to MAXSEG2)
	44	C. * *
	45	C. * IATTL = Vector of attributes of input segments, *
	46	C. * dimensioned to MAXSEG *
	47	C. * *
	48	C. * XNEW = Vector of x-coordinates of output polyline *
	49	C. * YNEW = Vector of y-coordinates of output polyline *
	50	C. * *
	51	C. * (XNEW,YNEW are dimensioned to MAXNEW) *
	52	C. * *
	53	C. * LUDEB = If < 0 then no debug printout will be done *
	54	C. * *
	55	C. * ISTF = Flag for statistics printout; *
	56	C. * if ISTF=1 a statistics of polylines length *
	57	C. * will be done (to be printed interactively) *
	58	C. * *
	59	C. * LINBUF = Flag to determine if GDRAWV has to perform *
	60	C. * line buffering logic (LINBUF=1) or not *
	61	C. * *
	62	C. * ==>Called by : <USER>, <GXINT>, GDAHIT, GDARC, GDARR, *
	63	C. * GDCIRC, GDCIRR, GDCIRY, GDCUT, GDHEAD, *
	64	C. * GDLINE, GDMAN, GDPRTR, GDRAW, GDRECT, *
65	C. * GDSCAL, GDSHOW, GDSURF, GDTREE *
66	C. * Author : P.Zanarini S.Giani 1992 ********* *
67	C. * *
68	C. ******************************************************************
69	C.
70	#include "geant321/gcbank.inc"
71	#include "geant321/gcdraw.inc"
72	#include "geant321/gcvolu.inc"
73	#include "geant321/gcunit.inc"
74	#include "geant321/gcspee.inc"
75	CHARACTER*80 ILINE
76	DIMENSION U(),V()
77	DIMENSION X(160),Y(160),IEMPTY(160)
78	DIMENSION IATTL(80)
79	DIMENSION XNEW(45),YNEW(45)
80	DIMENSION IDBIST(2,20),IDBERR(10)
81	SAVE X,Y,IEMPTY,IATTL,IDBIST,IDBERR,XNEW,YNEW
82	SAVE MAXSEG,MAXNEW,EPS,LUDEB,ISTF,NSEG,INEW
83	DATA MAXSEG/80/
84	DATA MAXNEW/45/
85	DATA EPS/0.00001/
86	DATA LUDEB/-1/
87	DATA ISTF/0/
88	DATA IDBERR,IDBIST/50*0/
89	C.
90	C. ------------------------------------------------------------------
91	C.
92	IF (NP.EQ.-1) THEN
93	C
94	C Initialize (open) the line buffer
95	C
96	LINBUF=1
97	NSEG=0
98	INEW=0
99	GO TO 999
100	C
101	ELSE IF (NP.EQ.0) THEN
102	C
103	C Empties (close) the line buffer
104	C
105	LINBUF=0
106	GO TO 10
107	C
108	ELSE IF (NP.GT.2) THEN
109	C
110	C Call directly GDRAWP
111	C
112	CALL GDRAWP(U,V,NP)
113	GO TO 999
114	C
115	C
116	ELSE IF (LINBUF.EQ.0) THEN
117	C
118	C Call directly GDRAWP
119	C
120	CALL GDRAWP(U,V,NP)
121	GO TO 999
122	C
123	ENDIF
124	C
125	LTY=IBITS(LINATT,10,3)
126	CALL UCTOH('ON ',IFLH,4,4)
127	IF(LTY.NE.6.AND.IHIDEN.EQ.IFLH)THEN
128	CALL GDRAWP(U,V,NP)
129	GO TO 999
130	ENDIF
131	C Fill the line buffer
132	C
133	NSEG=NSEG+1
134	IATTL(NSEG)=LINATT
135	C
136	NPOINT=NSEG*2
137	X(NPOINT-1)=U(1)
138	Y(NPOINT-1)=V(1)
139	X(NPOINT)=U(2)
140	Y(NPOINT)=V(2)
141	C
142	IF (NSEG.NE.MAXSEG) GO TO 999
143	C
144	C Line buffer full : check for joined lines
145	C
146	C Initialisation phase
147	C
148	10 CONTINUE
149	C
150	I0=1
151	INEW=0
152	NPOINT=NSEG*2
153	C
154	DO 20 I=1,NPOINT
155	IEMPTY(I)=0
156	20 CONTINUE
157	C
158	C Loop phase
159	C
160	30 CONTINUE
161	C
162	NPOINT=NSEG*2
163	C
164	DO 40 K=I0,NPOINT
165	IF (IEMPTY(K).EQ.0) GO TO 50
166	40 CONTINUE
167	C
168	C Buffer empty
169	C
170	NSEG=0
171	GO TO 999
172	C
173	50 CONTINUE
174	C
175	KDIV2=(K+1)/2
176	IF (INEW.EQ.0) LINATT=IATTL(KDIV2)
177	C
178	I1=K
179	INEW=INEW+1
180	XNEW(INEW)=X(I1)
181	YNEW(INEW)=Y(I1)
182	IEMPTY(I1)=1
183	I0=I1
184	C
185	60 CONTINUE
186	C
187	IF ((I1/2)*2.EQ.I1) THEN
188	I2=I1-1
189	ELSE
190	I2=I1+1
191	ENDIF
192	C
193	I2DIV2=(I2+1)/2
194	IF (INEW.EQ.0) LINATT=IATTL(I2DIV2)
195	C
196	INEW=INEW+1
197	XNEW(INEW)=X(I2)
198	YNEW(INEW)=Y(I2)
199	IEMPTY(I2)=1
200	C
201	IF (INEW.EQ.MAXNEW) THEN
202	IF (LUDEB.GE.0) THEN
203	WRITE (CHMAIL,10000) NAMES(NLEVEL),INEW
204	CALL GMAIL(0,0)
205	ENDIF
206	IDBERR(1)=IDBERR(1)+1
207	GO TO 70
208	ENDIF
209	C
210	C Link is closed ?
211	C
212	IF ((X(I2).LT.X(I0)-EPS).OR.(X(I2).GT.X(I0)+EPS)) GO TO 140
213	IF ((Y(I2).LT.Y(I0)-EPS).OR.(Y(I2).GT.Y(I0)+EPS)) GO TO 140
214	C
215	C Link closed
216	C
217	70 CONTINUE
218	C
219	IF (INEW.GT.3) THEN
220	CALL GDRAWP(XNEW,YNEW,INEW)
221	ELSE
222	IF (INEW.EQ.3) CALL GDRAWP(XNEW,YNEW,INEW)
223	IF (LUDEB.GE.0) THEN
224	WRITE (CHMAIL,10100) NAMES(NLEVEL),INEW
225	CALL GMAIL(0,0)
226	ENDIF
227	IDBERR(2)=IDBERR(2)+1
228	ENDIF
229	C
230	80 CONTINUE
231	C
232	C Do some statistics if in statistics mode
233	C
234	IF (ISTF.EQ.1) THEN
235	IF (INEW.LE.3) GO TO 120
236	LENPOL=INEW-1
237	90 CONTINUE
238	DO 100 I=1,20
239	IF (LENPOL.EQ.IDBIST(1,I)) THEN
240	IDBIST(2,I)=IDBIST(2,I)+1
241	GO TO 120
242	ENDIF
243	100 CONTINUE
244	DO 110 I=1,20
245	IF (IDBIST(1,I).EQ.0) THEN
246	IDBIST(1,I)=LENPOL
247	GO TO 90
248	ENDIF
249	110 CONTINUE
250	WRITE (CHMAIL,10800) LENPOL
251	CALL GMAIL(0,0)
252	120 CONTINUE
253	ENDIF
254	C
255	IF (LUDEB.LT.0) GO TO 130
256	C
257	C Do some printout if in debugging mode
258	C
259	LENPOL=INEW-1
260	WRITE (CHMAIL,10400) NAMES(NLEVEL),LENPOL
261	CALL GMAIL(0,0)
262	IC0=I0/2
263	IF ((I0/2)*2.NE.I0) IC0=IC0+1
264	IC1=I1/2
265	IF ((I1/2)*2.NE.I1) IC1=IC1+1
266	ILINE=' '
267	ILINE(IC1:IC1)='1'
268	ILINE(IC0:IC0)='0'
269	WRITE (CHMAIL,10500) I0,I1,I2,INEW,NSEG
270	CALL GMAIL(1,0)
271	WRITE (CHMAIL,10600) ILINE(1:NSEG)
272	CALL GMAIL(0,0)
273	NPOINT=NSEG*2
274	NPOIN1=NPOINT-1
275	WRITE (CHMAIL,10700) (IEMPTY(JJ),JJ=1,NPOIN1,2)
276	CALL GMAIL(0,0)
277	WRITE (CHMAIL,10700) (IEMPTY(JJ),JJ=2,NPOINT,2)
278	CALL GMAIL(0,0)
279	C
280	130 CONTINUE
281	INEW=0
282	GO TO 30
283	C
284	140 CONTINUE
285	C
286	NPOINT=NSEG*2
287	C
288	C Compute starting point of next segment
289	C
290	NEXT=0
291	C
292	DO 150 K=I0,NPOINT
293	IF (K.EQ.I2) GO TO 150
294	IF ((X(I2).LT.X(K)-EPS).OR.(X(I2).GT.X(K)+EPS)) GO TO 150
295	IF ((Y(I2).LT.Y(K)-EPS).OR.(Y(I2).GT.Y(K)+EPS)) GO TO 150
296	NEXT=K
297	GO TO 160
298	150 CONTINUE
299	C
300	160 CONTINUE
301	C
302	IF (NEXT.NE.0) THEN
303	I1=NEXT
304	IEMPTY(I1)=1
305	GO TO 60
306	ENDIF
307	C
308	IF (I0.EQ.1) THEN
309	CALL GDRAWP(XNEW,YNEW,INEW)
310	IF (LUDEB.GE.0) THEN
311	WRITE (CHMAIL,10200) NAMES(NLEVEL),INEW
312	CALL GMAIL(0,0)
313	ENDIF
314	IDBERR(3)=IDBERR(3)+1
315	GO TO 80
316	ENDIF
317	C
318	C Reset flag : next call to GDRAWV will re-process
319	C the points now forming an open polyline, trying then
320	C (with the new points stored) to form a closed polyline
321	C
322	DO 170 I=I0,NPOINT
323	IEMPTY(I)=0
324	170 CONTINUE
325	C
326	NSEGOL=NSEG
327	C
328	C Try to see if the buffers can be shifted
329	C
330	180 CONTINUE
331	C
332	DO 190 NLIN=1,NSEG
333	IF (IEMPTY(NLIN*2).EQ.0) GO TO 210
334	190 CONTINUE
335	C
336	IF (NSEG.NE.NSEGOL) THEN
337	C
338	C The buffers have been shifted enough
339	C
340	GO TO 230
341	C
342	ELSE
343	C
344	C The buffers cannot be shifted at all
345	C
346	IF (LUDEB.GE.0) THEN
347	WRITE (CHMAIL,10300) NAMES(NLEVEL)
348	CALL GMAIL(0,0)
349	ENDIF
350	IDBERR(4)=IDBERR(4)+1
351	LINATT=IATTL(1)
352	DO 200 I=1,NSEG
353	J=I*2-1
354	CALL GDRAWP(X(J),Y(J),2)
355	200 CONTINUE
356	INEW=0
357	GO TO 30
358	C
359	ENDIF
360	C
361	210 CONTINUE
362	C
363	C Shift the buffers
364	C
365	IF (NLIN.EQ.1) GO TO 230
366	NSEG=NSEG-NLIN+1
367	N=NSEG*2
368	J=NLIN*2-2
369	DO 220 I=1,N
370	X(I) = X(J+I)
371	Y(I) = Y(J+I)
372	IEMPTY(I) = IEMPTY(J+I)
373	220 CONTINUE
374	CALL UCOPY(IATTL(NLIN),IATTL(1),NSEG)
375	C
376	IF (NSEG.GT.0) GO TO 180
377	C
378	GO TO 999
379	C
380	230 CONTINUE
381	C
382	C If last call to GDRAWV (NP=0, i.e. close the buffer)
383	C and some lines have still to be processed (NSEG>0)
384	C then don't RETURN but re-execute the body of GDRAWV
385	C
386	IF (NP.EQ.0.AND.NSEG.GT.0) GO TO 10
387	C
388	10000 FORMAT (' *** GDRAWV: ERROR 1 - NAME = ',A4,' INEW = ',I3)
389	10100 FORMAT (' *** GDRAWV: ERROR 2 - NAME = ',A4,' INEW = ',I3)
390	10200 FORMAT (' *** GDRAWV: ERROR 3 - NAME = ',A4,' INEW = ',I3)
391	10300 FORMAT (' *** GDRAWV: ERROR 4 - NAME = ',A4)
392	10400 FORMAT (' *** GDRAWV: GDRAWP called for ',A4,' (',I2,' segments)')
393	10500 FORMAT (' LOOP : I0=',I3,' - I1=',I3,' - I2=',I3,
394	+ ' - INEW=',I3,' - NSEG=',I3)
395	10600 FORMAT (1X,A)
396	10700 FORMAT (1X,80I1)
397	10800 FORMAT (' * STATISTICS OVERFLOW * LENPOL =',I3)
398	999 END