1      SUBROUTINE GSPLNE (N,X,Y)
2      PARAMETER (NMAX=10000,NMAX2=1000)
3      REAL*4 X(*),Y(*)
4      INCLUDE 'Parametres.f'
5c
6      if (ipostscript.eq.1) then
7        nma = nmax
8      else
9        if (sauve_graphic) then
10          xc = xdecalmarc
11     &         + facteurmarc*(xcourant-origine_x) / facteur_en_x
12          yc = ydecalmarc
13     &         + facteurmarc*(ycourant-origine_y) / facteur_en_y
14          write(isgr,*) xc,yc
15          do i=1,n
16            write(isgr,*) xdecalmarc + facteurmarc*x(i)
17     &           ,ydecalmarc + facteurmarc*y(i)
18          enddo
19          write(isgr,*) ' '
20          return
21        endif
22        nma = nmax2
23        if (ityp_ligne.ne.ityp_ligne_pend
24     &  .or.epais_ligne.ne.epais_ligne_pend) call ecrligne(bid,ibid,0)
25        xxxx = origine_x + facteur_en_x*X(n)
26        yyyy = origine_y + facteur_en_y*Y(n)
27        if (xxxx.eq.xcourant.and.yyyy.eq.ycourant.and.n.le.nma) then
28          iclose = 1
29        else
30          iclose = 0
31        endif
32      endif
33      nn = n
34      ipoint = 1
35c
36    1 nnn = min(nn,nma)
37      call gsplne_loc(nnn,x(ipoint),y(ipoint),iclose)
38      xcourant = origine_x + facteur_en_x*X(ipoint+nnn-1)
39      ycourant = origine_y + facteur_en_y*Y(ipoint+nnn-1)
40      nn = nn-nma
41      if (nn.gt.0) then
42        ipoint = ipoint+nnn
43        if (nn.eq.1) then
44          call gsmove(x(ipoint-1),y(ipoint-1))
45          call gsline(x(ipoint),y(ipoint))
46        else
47          goto 1
48        endif
49      endif
50      END
51
52