1      SUBROUTINE FILM(NRALEN,NBTOUR,IBOUNCE,IFILM,NUMPT,NUMANI
2     &               ,XX,LXX,NDX,YY,LYY,NDY,XX0,YY0)
3C
4      INCLUDE 'param.f'
5      REAL*8    XX(*),YY(*)
6      LOGICAL*4 LXX(*),LYY(*)
7C
8      CHARACTER*10 COMPT
9      CALL GSLT(0)
10      CALL GSLW(1)
11      CALL GSLSS(1)
12      CALL GSPATF(0)
13      CALL GSPAT(16)
14      CALL ASFCOL(4)
15C
16      IF (IFILM.GE.2) THEN
17        XCOM = XMIN+.01*(XMAX-XMIN)
18        YCOM = YMIN+.01*(YMAX-YMIN)
19      ELSE
20        XCOM = XX0+.01*(XMAX-XMIN)
21        YCOM = YY0+.01*(YMAX-YMIN)
22      ENDIF
23      IF (NRALEN.GT.0) TEMPSAPERDRE = REAL(NRALEN)*0.001
24      CALL GSCOL(7)
25      CALL METS_CURSEUR(.5*(XMIN+XMAX),.5*(YMIN+YMAX))
26      IF (IFILM.EQ.1) THEN
27        CALL VRAIECOORD(XMIN,YMAX,IX0,IY0)
28        CALL VRAIECOORD(XMAX,YMIN,IX1,IY1)
29        ILARG = IX1-IX0
30        IHAUT = IY1-IY0
31        IX0 = IX0+1
32        IX1 = IX1-1
33        IY0 = IY0+1
34        IY1 = IY1-1
35        ILARG = ILARG-2
36        IHAUT = IHAUT-2
37        DO ITOUR=1,NBTOUR
38          CALL ASFCOL(4)
39          WRITE(COMPT(1:3),'(I2,":")') ITOUR
40          DO IC=1,NCOURB
41            WRITE(COMPT(4:7),'(I4)') IC
42            CALL GSBND(XX0,XMAX,YY0,YMAX)
43            CALL GSCHAR2(XCOM,YCOM,7,COMPT)
44            CALL TRACE2(IC,IX0,IX1,IY0,IY1,ILARG,IHAUT
45     &                 ,XX,LXX,NDX,YY,LYY,NDY)
46            IF (NRALEN.GT.0) CALL PERDDUTEMPS(TEMPSAPERDRE)
47          ENDDO
48          IF (IBOUNCE.EQ.1) THEN
49            CALL ASFCOL(1)
50            DO IC=NCOURB,1,-1
51              WRITE(COMPT(4:7),'(I4)') IC
52              CALL GSBND(XX0,XMAX,YY0,YMAX)
53              CALL GSCHAR2(XCOM,YCOM,7,COMPT)
54              CALL TRACE2(IC,IX0,IX1,IY0,IY1,ILARG,IHAUT
55     &                   ,XX,LXX,NDX,YY,LYY,NDY)
56              IF (NRALEN.GT.0) CALL PERDDUTEMPS(TEMPSAPERDRE)
57            ENDDO
58          ENDIF
59        ENDDO
60      ELSE
61        DO ITOUR=1,NBTOUR
62          WRITE(COMPT(1:3),'(I2,":")') ITOUR
63          ICOMP = 0
64          IF (NUMPT.GT.0) THEN
65            CALL GSMIX(1)
66            DO IC=1,NCOURB
67              IF (IMONO.EQ.1) THEN
68                ICOLOR = ICOL(IC)
69                CALL GSCOL(ICOLOR)
70              ENDIF
71              CALL GSLW(IGROS+IEPL(IC))
72              IREACH(IC) = MAX(2,MIN(NUMPT,NPOINT(IC)))
73              ICOMP = MAX(ICOMP,IREACH(IC))
74              CALL GSPLNE_SPEED(IREACH(IC),XPOINT(NDEB(IC)+1)
75     &                                    ,YPOINT(NDEB(IC)+1))
76            ENDDO
77          ELSE
78            DO IC=1,NCOURB
79              IREACH(IC) = 1
80            ENDDO
81          ENDIF
82          IFINI = 1
83 1000     CALL GSCOL(7)
84          WRITE(COMPT(4:9),'(I6)') ICOMP
85          CALL GSCHAR2(XCOM,YCOM,9,COMPT)
86          CALL GSLW(IGROS-1)
87          IF (NRALEN.GT.0) CALL PERDDUTEMPS(TEMPSAPERDRE)
88          IF (IFINI.NE.0) THEN
89            IFINI = 0
90            ICOMP = 0
91            DO IC=1,NCOURB
92              IF (IMONO.EQ.1) THEN
93                ICOLOR = ICOL(IC)
94                CALL GSCOL(ICOLOR)
95              ENDIF
96              CALL GSLW(IGROS+IEPL(IC))
97              NP = MIN(NUMANI,NPOINT(IC)-IREACH(IC))+1
98              IF (NP.GT.1) THEN
99                CALL GSPLNE_SPEED(NP,XPOINT(IREACH(IC)+NDEB(IC))
100     &                              ,YPOINT(IREACH(IC)+NDEB(IC)))
101                IF (NUMPT.GT.0) THEN
102                  ID = IREACH(IC)-NUMPT+1
103                  CALL GSMIX(1)
104                  CALL GSPLNE_SPEED(NP,XPOINT(ID+NDEB(IC))
105     &                                ,YPOINT(ID+NDEB(IC)))
106                  CALL GSMOVE(XPOINT(ID+NDEB(IC)),YPOINT(ID+NDEB(IC)))
107                  CALL GSLINE(XPOINT(ID+NDEB(IC)),YPOINT(ID+NDEB(IC)))
108                  CALL GSMIX(0)
109                ENDIF
110                IREACH(IC) = IREACH(IC)+NP-1
111                ICOMP = MAX(ICOMP,IREACH(IC))
112                IF (IREACH(IC).LT.NPOINT(IC)) IFINI = 1
113              ENDIF
114            ENDDO
115            GOTO 1000
116          ENDIF
117          CALL GSMIX(1)
118          IF (IBOUNCE.EQ.0) THEN
119            DO IC=1,NCOURB
120              IF (IMONO.EQ.1) THEN
121                ICOLOR = ICOL(IC)
122                CALL GSCOL(ICOLOR)
123              ENDIF
124              CALL GSLW(IGROS+IEPL(IC))
125              IF (NUMPT.EQ.0) THEN
126                CALL GSPLNE_SPEED(NPOINT(IC),XPOINT(1+NDEB(IC))
127     &                                      ,YPOINT(1+NDEB(IC)))
128              ELSE
129                NP = MAX(2,MIN(NUMPT,NPOINT(IC)))
130                II = NPOINT(IC)-NP+1
131                CALL GSPLNE_SPEED(NP,XPOINT(II+NDEB(IC))
132     &                              ,YPOINT(II+NDEB(IC)))
133              ENDIF
134            ENDDO
135          ELSE
136            IFINI = 1
137 2000       CALL GSMIX(0)
138            CALL GSCOL(7)
139            WRITE(COMPT(4:9),'(I6)') ICOMP
140            CALL GSCHAR2(XCOM,YCOM,9,COMPT)
141            CALL GSLW(IGROS-1)
142            IF (NRALEN.GT.0) CALL PERDDUTEMPS(TEMPSAPERDRE)
143            CALL GSMIX(1)
144            IF (IFINI.NE.0) THEN
145              IFINI = 0
146              ICOMP = 0
147              DO IC=1,NCOURB
148                IF (IMONO.EQ.1) THEN
149                  ICOLOR = ICOL(IC)
150                  CALL GSCOL(ICOLOR)
151                ENDIF
152                CALL GSLW(IGROS+IEPL(IC))
153                NP = MIN(NUMANI,IREACH(IC))+1
154                IF (NP.GT.1) THEN
155                  ID = IREACH(IC)-NP+1
156                  CALL GSPLNE_SPEED(NP,XPOINT(ID+NDEB(IC))
157     &                                ,YPOINT(ID+NDEB(IC)))
158                  CALL GSMOVE(XPOINT(IREACH(IC)+NDEB(IC))
159     &                       ,YPOINT(IREACH(IC)+NDEB(IC)))
160                  CALL GSLINE(XPOINT(IREACH(IC)+NDEB(IC))
161     &                       ,YPOINT(IREACH(IC)+NDEB(IC)))
162                  IF (NUMPT.GT.0) THEN
163                    ID = IREACH(IC)-NUMPT+1
164                    CALL GSMIX(0)
165                    CALL GSPLNE_SPEED(NP,XPOINT(ID+NDEB(IC))
166     &                                  ,YPOINT(ID+NDEB(IC)))
167                    CALL GSMOVE(XPOINT(ID+NDEB(IC))
168     &                         ,YPOINT(ID+NDEB(IC)))
169                    CALL GSLINE(XPOINT(ID+NDEB(IC))
170     &                         ,YPOINT(ID+NDEB(IC)))
171                    CALL GSMIX(1)
172                  ENDIF
173                  IREACH(IC) = IREACH(IC)-NP+1
174                  ICOMP = MAX(ICOMP,IREACH(IC))
175                  IF (IREACH(IC).GT.0) IFINI = 1
176                ENDIF
177              ENDDO
178              GOTO 2000
179            ENDIF
180          ENDIF
181          CALL GSMIX(0)
182        ENDDO
183      ENDIF
184C
185      END
186C-----------------------------------------------------------------------
187      SUBROUTINE TRACE2(ICOURB,IX0,IX1,IY0,IY1,ILARG,IHAUT
188     &                 ,XX,LXX,NDX,YY,LYY,NDY)
189      INCLUDE 'param.f'
190      REAL*8    XX(*),YY(*)
191      LOGICAL*4 LXX(*),LYY(*)
192C
193      CALL GSPROGRE(1)
194      CALL x11effacepix
195      CALL GSBND(XMIN,XMAX,YMIN,YMAX)
196      IF (IQUADR.LT.0) CALL AXES(XX,LXX,NDX,YY,LYY,NDY,0,0)
197      IF (ILT(1).GE.0) THEN
198        CALL GSCOL(ICOL(1))
199        CALL GSLW(IGROS+IEPL(1))
200        CALL GSLT(ILT(1))
201        CALL GSPLNE_SPEED(NPOINT(ICOURB),XPOINT(1+NDEB(ICOURB))
202     &                                  ,YPOINT(1+NDEB(ICOURB)))
203      ENDIF
204      IF (NMARK(1).GT.0) THEN
205        CALL GSCOL(ICOLM(1))
206        CALL GSMS(NMARK(1))
207        CALL GSMB(TM(1)*XMB,TM(1)*YMB)
208        CALL GSMRKS(NPOINT(ICOURB),XPOINT(1+NDEB(ICOURB))
209     &                            ,YPOINT(1+NDEB(ICOURB)))
210      ENDIF
211      CALL AXES(XX,LXX,NDX,YY,LYY,NDY,1,1)
212      CALL GSPROGRE(0)
213      CALL x11metrect2(IX0,IY0,ILARG,IHAUT,IX0,IY0)
214      CALL viderbuff2()
215      IF (ILT(1).NE.0) CALL GSLT(0)
216      END
217C--------------------------------------------------------------------
218      SUBROUTINE GENERIQUE(NRALEN,XCOM,YCOM)
219C
220      INCLUDE 'param.f'
221C
222      CHARACTER*6 COMPT
223C
224      NRALEN2 = NRALEN*NCOURB
225      CALL GSCOL(4)
226      COMPT = '     1'
227      CALL GSCHAR2(XCOM,YCOM,6,COMPT)
228      DO K=1,NRALEN2
229        CALL GSPLNE_SPEED(NPOINT(1),XPOINT(1),YPOINT(1))
230      ENDDO
231      WRITE(COMPT,'("1/",I4)') NCOURB
232      CALL GSCHAR2(XCOM,YCOM,6,COMPT)
233      DO K=1,NRALEN2
234        CALL GSPLNE_SPEED(NPOINT(NCOURB),XPOINT(1+NDEB(NCOURB))
235     &                                  ,YPOINT(1+NDEB(NCOURB)))
236      ENDDO
237      CALL GSCOL(0)
238      WRITE(COMPT,'(I6)') NCOURB
239      CALL GSCHAR2(XCOM,YCOM,6,COMPT)
240      DO K=1,NRALEN2
241        CALL GSPLNE_SPEED(NPOINT(1),XPOINT(1),YPOINT(1))
242      ENDDO
243      DO K=1,NRALEN2
244        CALL GSPLNE_SPEED(NPOINT(NCOURB),XPOINT(1+NDEB(NCOURB))
245     &                                  ,YPOINT(1+NDEB(NCOURB)))
246      ENDDO
247      CALL GSCOL(4)
248      COMPT = '     1'
249      CALL GSCHAR2(XCOM,YCOM,6,COMPT)
250      DO K=1,NRALEN2
251        CALL GSPLNE_SPEED(NPOINT(1),XPOINT(1),YPOINT(1))
252      ENDDO
253      END
254