C      GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG
C      G                             G
C      G    GENEVA GROUP GRAPHICS    G 
C      G                             G
C      GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG

C      Version of 15 September 2003

C ******** SUBROUTINE BEGIN_GGG *********
        SUBROUTINE BEGIN_GGG(name)
        IMPLICIT LOGICAL (L)
        INTEGER PFACX,PFACY,PPOSX,PPOSY,PPX,PPY
        CHARACTER*(*) name
        CHARACTER*80 CHALOC1,CHALOC2,CHALOC3,CHALOC4,CHALOC5
        CHARACTER*1 SYMB1(80),SYMB2(80),SYMB4(80),SYMB5(80)
        CHARACTER f90testchar
        EQUIVALENCE (CHALOC1,SYMB1)
        EQUIVALENCE (CHALOC2,SYMB2)
        EQUIVALENCE (CHALOC4,SYMB4)
        EQUIVALENCE (CHALOC5,SYMB5)
        COMMON/SIZES/UDIM,VDIM,UINT,VINT
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/PSTORE/PPOSX,PPOSY,ISTORE,PPX(100000),PPY(100000)
        COMMON/PAPER/PAXMIN,PAXMAX,PAYMIN,PAYMAX
        COMMON/BOUNDINGBOX/IPIXMIN,IPIXMAX,IPIYMIN,IPIYMAX,SCALEFAC
        COMMON/NAMETRANS/CHALOC3
      COMMON/Lf90true/Lf90true
      COMMON/LTEXT/LTEXT,LTEXTEXT
      COMMON/BBC/LBBC,CRED,CGREEN,CBLUE
      COMMON/LSYM/Lsquare,Llosange,Lxstar,Lpstar,
     &Lutri,Ldtri,Lumtri,Ldmtri,Lhardy,Llaurel,Lmpent,Lmhex,Lmmhex,
     &Lpent,Lhex,Lcircle,Lrgbsquare,Lrgblosange,Lrgbxstar,Lrgbpstar,
     &Lrgbutri,Lrgbdtri,Lrgbumtri,Lrgbdmtri,Lrgbhardy,Lrgblaurel,
     &Lrgbmpent,Lrgbmhex,Lrgbmmhex,Lrgbpent,Lrgbhex,Lrgbcircle,Larrow 
C23456789-123456789-123456789-123456789-123456789-123456789-123456789-12

C --- COUPER PAPIER ----------
        PAXMIN=0.
        PAXMAX=16.15
        PAYMIN=0.
        PAYMAX=21.001
        PFACX=8
        PFACY=8
C ------- FILES HANDLING -----------
C    SCRATCH FILE FOR TEXT_LATEX:
        OPEN(27,STATUS='SCRATCH')
        REWIND 27
C    SCRATCH FILE FOR TEXT28:
        OPEN(28,STATUS='SCRATCH')
        REWIND 28
C ----- TESTING COMPILER VERSIONS FOR "\\"-HANDLING -----
        WRITE(28,924)'\\aaa'
 924    format(a3)
        REWIND 28
        READ(28,925)f90testchar
 925    format(1x,a1)
        REWIND 28
        IF(f90testchar.NE.'a')THEN
         Lf90true=.true.
c         write(6,*)'  you have used f90' 
        else
         Lf90true=.false.
c         write(6,*)'  you have used f77' 
        end if
C ------ FINAL OUTPUT FILES ----
      DO  I=1,80
        SYMB1(I)=' '
        SYMB2(I)=' '
        SYMB4(I)=' '
        SYMB5(I)=' '
      END DO
      CHALOC1=name
      CHALOC2=name
      CHALOC4=name
      CHALOC5=name
C ------- ELIMINER BLANCS DE LA FIN ----------
      ILEN=80
      DO I=80,1,-1
       IF(SYMB1(I).EQ.' ')THEN
         ILEN=ILEN-1
       ELSE
         GOTO 43
       END IF
      END DO
  43  NLEN=ILEN
      SYMB1(NLEN+1)='.'
      SYMB1(NLEN+2)='p'
      SYMB1(NLEN+3)='s'
      SYMB2(NLEN+1)='.'
      SYMB2(NLEN+2)='i'
      SYMB2(NLEN+3)='n'
      SYMB2(NLEN+4)='p'
      SYMB4(NLEN+1)='.'
      SYMB4(NLEN+2)='v'
      SYMB4(NLEN+3)='o'
      SYMB4(NLEN+4)='r'
      SYMB5(NLEN+1)='.'
      SYMB5(NLEN+2)='a'
      SYMB5(NLEN+3)='d'
      SYMB5(NLEN+4)='d'
      CHALOC3=CHALOC1
C      WRITE(27,*)(SYMB1(I),I=1,NLEN+3)
      WRITE(27,*)(SYMB1(I),I=1,NLEN)
C ---- FILES FOR PS OUTPUT ------
      OPEN(26,FILE=CHALOC4)
        REWIND 26
      OPEN(29,FILE=CHALOC5)
        REWIND 29
C ---- FILE FOR TEX OUTPUT ------
      OPEN(25,FILE=CHALOC2)
        REWIND 25
C ------ INITIATE BOUNDING BOX ---------
        IPIXMIN=5000
        IPIXMAX=0
        IPIYMIN=5000
        IPIYMAX=0
        SCALEFAC=1.
C ------- INITIATE LOGICAL INSERTVARBS ------
      LTEXT=.FALSE.
      LTEXTEXT=.FALSE.
      LBBC=.FALSE.
      Lsquare=.FALSE.
      Llosange=.FALSE.
      Lxstar=.FALSE.
      Lpstar=.FALSE.
      Lutri=.FALSE.
      Ldtri=.FALSE.
      Lumtri=.FALSE.
      Ldmtri=.FALSE.
      Lhardy=.FALSE.
      Llaurel=.FALSE.
      Lmpent=.FALSE.
      Lmhex=.FALSE.
      Lmmhex=.FALSE.
      Lpent=.FALSE.
      Lhex=.FALSE.
      Lcircle=.FALSE. 
      Lrgbsquare=.FALSE.
      Lrgblosange=.FALSE.
      Lrgbxstar=.FALSE.
      Lrgbpstar=.FALSE.
      Lrgbutri=.FALSE.
      Lrgbdtri=.FALSE.
      Lrgbumtri=.FALSE.
      Lrgbdmtri=.FALSE.
      Lrgbhardy=.FALSE.
      Lrgblaurel=.FALSE.
      Lrgbmpent=.FALSE.
      Lrgbmhex=.FALSE.
      Lrgbmmhex=.FALSE.
      Lrgbpent=.FALSE.
      Lrgbhex=.FALSE.
      Lrgbcircle=.FALSE. 
      Larrow=.FALSE. 
C ------------ PREMIERE IMAGE FOR MASOG ---------------
        UMIN=-UINT/2.-UDIM
        UMAX=UMIN+UDIM
         VMAX=PAYMAX-VINT/2.
         VMIN=VMAX-VDIM
C ---------- VIDER STORE ----------
        ISTORE=0
        CALL SCALE_CHAR(1.)
        CALL THICK_PIXEL(2)
        RETURN
        END


C ******** SUBROUTINE END_GGG ********
        SUBROUTINE END_GGG 
        IMPLICIT INTEGER (P)
        IMPLICIT LOGICAL (L)
        INTEGER LAM100
        CHARACTER*1 IN
        CHARACTER*80 CHALOC3
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/BOUNDINGBOX/IPIXMIN,IPIXMAX,IPIYMIN,IPIYMAX,SCALEFAC
        COMMON/BASE/IN(512),IFIRST,ILAST
        COMMON/NAMETRANS/CHALOC3
      COMMON/Lf90true/Lf90true
      COMMON/LTEXT/LTEXT,LTEXTEXT
      COMMON/BBC/LBBC,CRED,CGREEN,CBLUE
      COMMON/LSYM/Lsquare,Llosange,Lxstar,Lpstar,
     &Lutri,Ldtri,Lumtri,Ldmtri,Lhardy,Llaurel,Lmpent,Lmhex,Lmmhex,
     &Lpent,Lhex,Lcircle,Lrgbsquare,Lrgblosange,Lrgbxstar,Lrgbpstar,
     &Lrgbutri,Lrgbdtri,Lrgbumtri,Lrgbdmtri,Lrgbhardy,Lrgblaurel,
     &Lrgbmpent,Lrgbmhex,Lrgbmmhex,Lrgbpent,Lrgbhex,Lrgbcircle,Larrow 
C ----- ICI, ON EST EN POSTSCRIPT MODE ------
          WRITE(29,*)'showpage'
C ####### ECRIRE LES MACROS SUR FILE 26 ------
C23456789-123456789-123456789-123456789-123456789-123456789-123456789-12
      REWIND(26)
      write(26,9261)
9261  format('%!')
      FF=72.27/600.
      APIXMINFF=IPIXMIN*FF*SCALEFAC
      APIXMAXFF=IPIXMAX*FF*SCALEFAC
      APIYMINFF=IPIYMIN*FF*SCALEFAC
      APIYMAXFF=IPIYMAX*FF*SCALEFAC
      IPIXMINFF=APIXMINFF+0.5
      IPIXMAXFF=APIXMAXFF+0.5
      IPIYMINFF=APIYMINFF+0.5
      IPIYMAXFF=APIYMAXFF+0.5
      write(26,9262)IPIXMINFF,IPIYMINFF,IPIXMAXFF,IPIYMAXFF
9262  format('%%BoundingBox:',4I5)
      write(26,9266)CHALOC3
9266  format('%%Title: ',A30)
      write(26,9268)
9268  format('%%Creator: GGG Fortran Library')
      write(26,9269)
9269  format('%%Pages: 1')
      write(26,9270)
9270  format('%%EndComments')
     
      write(26,*)' '
      write(26,*)'/m{moveto}def'
      write(26,*)'/l{lineto}def'
      write(26,*)'/s{stroke}def'
      write(26,*)'/rm {rmoveto} def' 
      write(26,*)'/rl {rlineto} def' 
      write(26,*)'/n {newpath} def' 
      write(26,*)'/sd {setdash} def' 
      write(26,*)' '
C ------ FILLIN PS MACROS -----
        CALL MACROS_FILL_IN 
C ------- WRITE SCALING --------
      write(26,*)' newpath'
      ASCALE=0.12045*SCALEFAC
      write(26,9305)ASCALE,ASCALE
9305  format(2f8.5,' scale')
      write(26,*)' 1 setlinecap'
      write(26,*)' 1 setlinejoin'
C ----- COLOR BOUNDINGBOX -----
      IF(LBBC)THEN
         WRITE(26,8833)IPIXMIN,IPIYMIN
 8833    FORMAT('gsave',/,'newpath',/,1X,I4,1X,I4,' m')
         WRITE(26,8834)IPIXMAX,IPIYMIN
         WRITE(26,8834)IPIXMAX,IPIYMAX
         WRITE(26,8834)IPIXMIN,IPIYMAX
 8834    FORMAT(1X,I4,1X,I4,' l')
         WRITE(26,*)'closepath'
         WRITE (26,8837) CRED,CGREEN,CBLUE
 8837    FORMAT(3F5.2,' setrgbcolor',/,'fill')
         WRITE(26,*)'grestore'
      END IF

  77  CONTINUE
      !WRITE(6,*)' Postscript files "name.vor" and "name.add" ready'
C ------ WRITE TEX FILE ------
       REWIND(27)
      APIXDIFF=APIXMAXFF-APIXMINFF
      APIYDIFF=APIYMAXFF-APIYMINFF
C ---- DIFFERENT COORDINATES TO WRITE FOR ANOTHER \begin{picture}    
      IF(LTEXTEXT)THEN
       IF(Lf90true)THEN
        WRITE(25,*)'\begin{picture}(0,0)'
       ELSE 
        WRITE(25,*)'\\begin{picture}(0,0)'
       END IF
      ELSE
       IF(Lf90true)THEN
        WRITE(25,9831)APIXDIFF,APIYDIFF
 9831   FORMAT('\begin{picture}(',F5.1,',',F5.1,')(0.,0.)')
       ELSE 
        WRITE(25,9931)APIXDIFF,APIYDIFF
 9931   FORMAT('\\begin{picture}(',F5.1,',',F5.1,')(0.,0.)')
       END IF
      END IF
       READ(27,996)(IN(I),I=1,80)
       IFIRST=1
       ILAST=80
  58   CONTINUE
       IF(IN(ILAST).EQ.' ')THEN
           ILAST=ILAST-1
           GOTO 58
       END IF
       IN(ILAST+1)='}'
       IF(IN(IFIRST).EQ.' ')IFIRST=2
       IF(Lf90true)THEN
        WRITE(25,9834)(IN(I),I=IFIRST,ILAST+1)
 9834   FORMAT('  \GGGepsfig{',90A1)
       ELSE
        WRITE(25,9934)(IN(I),I=IFIRST,ILAST+1)
 9934   FORMAT('  \\GGGepsfig{',90A1)
       END IF
C ----- LAST LINE ---- 
      IF(LTEXTEXT)THEN
       IF(Lf90true)THEN
        WRITE(25,*)'\end{picture}%'
       ELSE 
        WRITE(25,*)'\\end{picture}%'
       END IF
      ELSE
       IF(Lf90true)THEN
        WRITE(25,*)'\end{picture}'
       ELSE 
        WRITE(25,*)'\\end{picture}'
       END IF
      END IF
C ----- WRITE EVENTUEL TEXT COMMANDS -----
C 
C  these parts are "stolen" from "Martin's Grapher Library" !
C 
      IF(LTEXTEXT)THEN
      APIXBEG=APIXMINFF
      APIYBEG=APIYMINFF
       IF(Lf90true)THEN
      WRITE(25,9835)APIXDIFF,APIYDIFF,APIXBEG,APIYBEG
 9835 FORMAT('\begin{picture}(',F5.1,',',F5.1,')(',F6.1,',',F6.1,')')
       ELSE 
      WRITE(25,9935)APIXDIFF,APIYDIFF,APIXBEG,APIYBEG
 9935 FORMAT('\\begin{picture}(',F5.1,',',F5.1,')(',F6.1,',',F6.1,')')
       END IF
  60   CONTINUE
C ----- READ NEW FORMULA -----      
C23456789-123456789-123456789-123456789-123456789-123456789-123456789-12
       READ(27,*,END=78)INDEX,ISHUTUP,IPX,IPY,LAM100,MU100,
     &ROT,GRAY,GREEN,BLUE
       READ(27,996)(IN(I),I=1,80)
 996   FORMAT(80A1)
       IFIRST=1
       ILAST=80
  70   CONTINUE
       IF(IN(ILAST).EQ.' ')THEN
           ILAST=ILAST-1
           GOTO 70
       END IF
       ILAST=MAX(ILAST,1)
C ---- DISTINGUISH CONTINUATION LINES ----
       IF(ISHUTUP.EQ.1)THEN 
        IN(ILAST+1)='}'
        ILAST1=ILAST+1
       ELSE
        ILAST1=ILAST
       END IF
       IF(IN(IFIRST).EQ.' ')IFIRST=2
       APXFF=IPX*FF
       APYFF=IPY*FF
C ######### NO SHIFT ##########
       IF(LAM100.EQ.0.AND.MU100.EQ.0)THEN
C ------ INDEX=1, GGGput --------
        IF(INDEX.EQ.1)THEN
         IF(Lf90true)THEN
          WRITE(25,9841)APXFF,APYFF,(IN(I),I=IFIRST,ILAST1)
         ELSE 
          WRITE(25,9941)APXFF,APYFF,(IN(I),I=IFIRST,ILAST1)
         END IF
        END IF
 9841   FORMAT('  \GGGput(',F6.2,',',F6.2,'){',90A1)
 9941   FORMAT('  \\GGGput(',F6.2,',',F6.2,'){',90A1)
C ------ INDEX=2, GGGputR --------
        IF(INDEX.EQ.2)THEN
         IF(Lf90true)THEN
          WRITE(25,9842)APXFF,APYFF,ROT,(IN(I),I=IFIRST,ILAST1)
         ELSE 
          WRITE(25,9942)APXFF,APYFF,ROT,(IN(I),I=IFIRST,ILAST1)
         END IF
        END IF
 9842   FORMAT('  \GGGputR(',F6.2,',',F6.2,')[',F7.2,']{',90A1)
 9942   FORMAT('  \\GGGputR(',F6.2,',',F6.2,')[',F7.2,']{',90A1)
C ------ INDEX=3, GGGputRG --------
        IF(INDEX.EQ.3)THEN
         IF(Lf90true)THEN
          WRITE(25,9843)GRAY,APXFF,APYFF,ROT,(IN(I),I=IFIRST,ILAST1)
         ELSE 
          WRITE(25,9943)GRAY,APXFF,APYFF,ROT,(IN(I),I=IFIRST,ILAST1)
         END IF
        END IF
 9843   FORMAT('  \GGGputRG(',F4.2,')(',
     &F6.2,',',F6.2,')[',F7.2,']{',90A1)
 9943   FORMAT('  \\GGGputRG(',F4.2,')(',
     &F6.2,',',F6.2,')[',F7.2,']{',90A1)
C ------ INDEX=4, GGGputRRGB --------
        IF(INDEX.EQ.4)THEN
         IF(Lf90true)THEN
          WRITE(25,9844)GRAY,GREEN,BLUE,
     &APXFF,APYFF,ROT,(IN(I),I=IFIRST,ILAST1)
         ELSE 
          WRITE(25,9944)GRAY,GREEN,BLUE,
     &APXFF,APYFF,ROT,(IN(I),I=IFIRST,ILAST1)
         END IF
        END IF
 9844   FORMAT('  \GGGputRRGB(',F4.2,1X,F4.2,1X,F4.2,')(',
     &F6.2,',',F6.2,')[',F7.2,']{',90A1)
 9944   FORMAT('  \\GGGputRRGB(',F4.2,1X,F4.2,1X,F4.2,')('
     &,F6.2,',',F6.2,')[',F7.2,']{',90A1)
       ELSE
C ######### WITH SHIFT ##########
C ------ INDEX=1, GGGput --------
        IF(INDEX.EQ.1)THEN
         IF(Lf90true)THEN
          WRITE(25,9851)LAM100,MU100,APXFF,APYFF,
     &(IN(I),I=IFIRST,ILAST1)
         ELSE 
          WRITE(25,9951)LAM100,MU100,APXFF,APYFF,
     &(IN(I),I=IFIRST,ILAST1)
         END IF
        END IF
 9851   FORMAT('  \GGGput[',I5,',',I5,'](',F6.2,',',F6.2,'){',90A1)
 9951   FORMAT('  \\GGGput[',I5,',',I5,'](',F6.2,',',F6.2,'){',90A1)
C ------ INDEX=2, GGGputR --------
        IF(INDEX.EQ.2)THEN
         IF(Lf90true)THEN
          WRITE(25,9852)LAM100,MU100,APXFF,APYFF,ROT,
     &(IN(I),I=IFIRST,ILAST1)
         ELSE 
          WRITE(25,9952)LAM100,MU100,APXFF,APYFF,ROT,
     &(IN(I),I=IFIRST,ILAST1)
         END IF
        END IF
 9852   FORMAT('  \GGGputR[',I5,',',I5,'](',
     &F6.2,',',F6.2,')[',F7.2,']{',90A1)
 9952   FORMAT('  \\GGGputR[',I5,',',I5,'](',
     &F6.2,',',F6.2,')[',F7.2,']{',90A1)
C ------ INDEX=3, GGGputRG --------
        IF(INDEX.EQ.3)THEN
         IF(Lf90true)THEN
          WRITE(25,9853)LAM100,MU100,GRAY,APXFF,
     &APYFF,ROT,(IN(I),I=IFIRST,ILAST1)
         ELSE 
          WRITE(25,9953)LAM100,MU100,GRAY,APXFF,APYFF,
     &ROT,(IN(I),I=IFIRST,ILAST1)
         END IF
        END IF
 9853   FORMAT('  \GGGputRG[',I5,',',I5,'](',F4.2,')(',
     &F6.2,',',F6.2,')[',F7.2,']{',90A1)
 9953   FORMAT('  \\GGGputRG[',I5,',',I5,'](',F4.2,')(',
     &F6.2,',',F6.2,')[',F7.2,']{',90A1)
C ------ INDEX=4, GGGputRRGB --------
        IF(INDEX.EQ.4)THEN
         IF(Lf90true)THEN
          WRITE(25,9854)LAM100,MU100,GRAY,GREEN,BLUE,
     &APXFF,APYFF,ROT,(IN(I),I=IFIRST,ILAST1)
         ELSE 
          WRITE(25,9954)LAM100,MU100,GRAY,GREEN,BLUE,
     &APXFF,APYFF,ROT,(IN(I),I=IFIRST,ILAST1)
         END IF
        END IF
 9854   FORMAT('  \GGGputRRGB[',I5,',',I5,'](',
     &F4.2,1X,F4.2,1X,F4.2,')(',F6.2,',',F6.2,')[',F7.2,']{',90A1)
 9954   FORMAT('  \\GGGputRRGB[',I5,',',I5,'](',
     &F4.2,1X,F4.2,1X,F4.2,')(',F6.2,',',F6.2,')[',F7.2,']{',90A1)
       END IF
C ------ INDEX=9, CONTINUATION LINES --------
       IF(INDEX.EQ.9)THEN
        WRITE(25,9949)(IN(I),I=IFIRST,ILAST1)
       END IF
 9949  FORMAT(90A1)
       GOTO 60
  78   CONTINUE
       IF(Lf90true)THEN
       WRITE(25,*)'\end{picture}'
       ELSE 
       WRITE(25,*)'\\end{picture}'
       END IF
      END IF
      !WRITE(6,*)' TeX file ready'
      RETURN
      END


C ------ SUBROUTINE MACROS_FILL_IN FOR POSTSCRIPT ------
      SUBROUTINE MACROS_FILL_IN 
      IMPLICIT LOGICAL (L)
      COMMON/LTEXT/LTEXT,LTEXTEXT
      COMMON/LSYM/Lsquare,Llosange,Lxstar,Lpstar,
     &Lutri,Ldtri,Lumtri,Ldmtri,Lhardy,Llaurel,Lmpent,Lmhex,Lmmhex,
     &Lpent,Lhex,Lcircle,Lrgbsquare,Lrgblosange,Lrgbxstar,Lrgbpstar,
     &Lrgbutri,Lrgbdtri,Lrgbumtri,Lrgbdmtri,Lrgbhardy,Lrgblaurel,
     &Lrgbmpent,Lrgbmhex,Lrgbmmhex,Lrgbpent,Lrgbhex,Lrgbcircle,Larrow 
      IF(LTEXT)THEN
      write(26,*)'/expodict 5 dict def'
      write(26,*)'/exposhow'
      write(26,*)'  {expodict begin'
      write(26,*)'   /exponent exch def'
      write(26,*)'   /regularfont currentfont def'
      write(26,*)'   /expofont currentfont [.7 0 0 .65 0 0]'
      write(26,*)'    makefont def'
      write(26,*)'   gsave'
      write(26,*)'     newpath'
      write(26,*)'     0 0 moveto'
      write(26,*)'     (1) true charpath'
      write(26,*)'     flattenpath pathbbox'
      write(26,*)'     /height exch def pop pop pop'
      write(26,*)'   grestore'
      write(26,*)'   0 .5 height mul rmoveto'
      write(26,*)'   expofont setfont exponent show'
      write(26,*)'   0 .5 height mul neg rmoveto'  
      write(26,*)'   regularfont setfont'
      write(26,*)'   end'
      write(26,*)'  }def'
      write(26,*)' '
      write(26,*)'/indexdict 5 dict def'
      write(26,*)'/indexshow'
      write(26,*)'  {indexdict begin'
      write(26,*)'   /index exch def'
      write(26,*)'   /regularfont currentfont def'
      write(26,*)'   /indexfont currentfont [.7 0 0 .65 0 0]'
      write(26,*)'    makefont def'
      write(26,*)'   gsave'
      write(26,*)'     newpath'
      write(26,*)'     0 0 moveto'
      write(26,*)'     (1) true charpath'
      write(26,*)'     flattenpath pathbbox'
      write(26,*)'     /height exch def pop pop pop'
      write(26,*)'   grestore'
      write(26,*)'   0 .4 height mul neg rmoveto'
      write(26,*)'   indexfont setfont index show'
      write(26,*)'   0 .4 height mul rmoveto'   
      write(26,*)'   regularfont setfont' 
      write(26,*)'   end'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lsquare)THEN
      write(26,*)'/square'
      write(26,*)'  {/gris exch def'
      write(26,*)'   /length exch def' 
      write(26,*)'   /yy exch def'  
      write(26,*)'   /xx exch def' 
      write(26,*)'   /ll length 10 mul def' 
      write(26,*)'   /length2 ll 2 mul def' 
      write(26,*)'   xx yy moveto'
      write(26,*)'   ll neg ll neg rmoveto'
      write(26,*)'   length2 0 rlineto'
      write(26,*)'   0 length2 rlineto'
      write(26,*)'   length2 neg 0 rlineto' 
      write(26,*)'   closepath'
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill'
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Llosange)THEN
      write(26,*)'/losange'
      write(26,*)'  {/gris exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def' 
      write(26,*)'   /xx exch def' 
      write(26,*)'   xx yy moveto'
      write(26,*)'   /length len 14 mul def'
      write(26,*)'   0 length neg rmoveto'
      write(26,*)'   length length rlineto'
      write(26,*)'   length neg length rlineto'
      write(26,*)'   length neg length neg rlineto' 
      write(26,*)'   closepath'
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill'
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lxstar)THEN
      write(26,*)'/xstar'
      write(26,*)'  {/gris exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def' 
      write(26,*)'   /xx exch def'  
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l5 len 5 mul def'
      write(26,*)'   /l7 len 7 mul def'
      write(26,*)'   /l12 len 12 mul def' 
      write(26,*)'   gsave'
      write(26,*)'   l5 0 rmoveto'
      write(26,*)'   4 {l7 l12 rlineto'
      write(26,*)'      l12 neg l7 neg rlineto'
      write(26,*)'      90 rotate} repeat'
      write(26,*)'   closepath  '
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill' 
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lpstar)THEN
      write(26,*)'/pstar'
      write(26,*)'  {/gris exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def'  
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto' 
      write(26,*)'   /l5 len 5 mul def'
      write(26,*)'   /l7 len 7 mul def'
      write(26,*)'   /l12 len 12 mul def' 
      write(26,*)'   gsave'
      write(26,*)'   45 rotate'
      write(26,*)'   l5 0 rmoveto'
      write(26,*)'   4 {l7 l12 rlineto'
      write(26,*)'      l12 neg l7 neg rlineto'
      write(26,*)'      90 rotate} repeat'
      write(26,*)'   closepath  '
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lutri)THEN
      write(26,*)'/utri'
      write(26,*)'  {/gris exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l16 len 15 mul def '
      write(26,*)'   /ll l16 3 sqrt mul def ' 
      write(26,*)'   gsave'
      write(26,*)'   0 l16 rmoveto'
      write(26,*)'   -60 rotate'
      write(26,*)'   3 {ll 0 rlineto'
      write(26,*)'      -120 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill' 
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Ldtri)THEN
      write(26,*)'/dtri'
      write(26,*)'  {/gris exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l16 len 15 mul def '
      write(26,*)'   /ll l16 3 sqrt mul def ' 
      write(26,*)'   gsave'
      write(26,*)'   0 l16 neg rmoveto'
      write(26,*)'   60 rotate'
      write(26,*)'   3 {ll 0 rlineto'
      write(26,*)'      120 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lumtri)THEN
      write(26,*)'/umtri'
      write(26,*)'  {/gris exch def'
      write(26,*)'   /len exch def '
      write(26,*)'   /yy exch def  '
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l4 len 4 mul def '
      write(26,*)'   /l16 len 18 mul def '
      write(26,*)'   /ll l16 .75 sqrt mul def '
      write(26,*)'   gsave'
      write(26,*)'   0 l16 rmoveto'
      write(26,*)'   -60 rotate'
      write(26,*)'   3 {ll l4 neg rlineto'
      write(26,*)'      ll l4 rlineto'
      write(26,*)'      -120 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill' 
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Ldmtri)THEN
      write(26,*)'/dmtri'
      write(26,*)'  {/gris exch def'
      write(26,*)'   /len exch def '
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l4 len 4 mul def' 
      write(26,*)'   /l16 len 18 mul def '
      write(26,*)'   /ll l16 .75 sqrt mul def ' 
      write(26,*)'   gsave'
      write(26,*)'   0 l16 neg rmoveto'
      write(26,*)'   60 rotate'
      write(26,*)'   3 {ll l4 rlineto'
      write(26,*)'      ll l4 neg rlineto'
      write(26,*)'      120 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lhardy)THEN
      write(26,*)'/hardy'
      write(26,*)'  {/gris exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l3 len 3 mul def' 
      write(26,*)'   /l8 len 8 mul def '
      write(26,*)'   /l11 len 11 mul def' 
      write(26,*)'   /l22 len 22 mul def '  
      write(26,*)'   gsave'
      write(26,*)'   0 l3 rmoveto'
      write(26,*)'   2 {l11 l8 rlineto'
      write(26,*)'      0 l22 neg rlineto'
      write(26,*)'      l11 neg l8 rlineto'
      write(26,*)'      180 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Llaurel)THEN
      write(26,*)'/laurel'
      write(26,*)'  {/gris exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l3 len 3 mul def '
      write(26,*)'   /l8 len 8 mul def '
      write(26,*)'   /l11 len 11 mul def '
      write(26,*)'   /l22 len 22 mul def '
      write(26,*)'   gsave'
      write(26,*)'   90 rotate'
      write(26,*)'   0 l3 rmoveto'
      write(26,*)'   2 {l11 l8 rlineto'
      write(26,*)'      0 l22 neg rlineto'
      write(26,*)'      l11 neg l8 rlineto'
      write(26,*)'      180 rotate} repeat'
      write(26,*)'   closepath  '
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill '
      write(26,*)'   grestore  '
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lmpent)THEN
      write(26,*)'/mpent'
      write(26,*)'  {/gris exch def'
      write(26,*)'   /len exch def '
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto'
      write(26,*)'   /tan 36 sin 36 cos div def '
      write(26,*)'   /l16 len 15 mul def '
      write(26,*)'   /ll l16 36 sin mul def '
      write(26,*)'   /l4 ll tan mul def' 
      write(26,*)'   gsave'
      write(26,*)'   0 l16 rmoveto'
      write(26,*)'   -36 rotate'
      write(26,*)'   5 {ll l4 neg rlineto'
      write(26,*)'      ll l4 rlineto'
      write(26,*)'      -72 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def' 
      write(26,*)' '
      END IF
      IF(Lmhex)THEN
      write(26,*)'/mhex'
      write(26,*)'  {/gris exch def'
      write(26,*)'   /len exch def '
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto'
      write(26,*)'   /l16 len 14 mul def '
      write(26,*)'   /ll l16 .5 mul def' 
      write(26,*)'   /l4 ll 1 3 div sqrt mul def '
      write(26,*)'   gsave'
      write(26,*)'   0 l16 rmoveto'
      write(26,*)'   -30 rotate'
      write(26,*)'   6 {ll l4 neg rlineto'
      write(26,*)'      ll l4 rlineto'
      write(26,*)'      -60 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def '
      write(26,*)' '
      END IF
      IF(Lmmhex)THEN
      write(26,*)'/mmhex'
      write(26,*)'  {/gris exch def'
      write(26,*)'   /len exch def '
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto'
      write(26,*)'   /l16 len 17 mul def' 
      write(26,*)'   /ll l16 .5 mul def '
      write(26,*)'   /l4 l16 1 3 div sqrt mul def '
      write(26,*)'   gsave'
      write(26,*)'   0 l16 rmoveto'
      write(26,*)'   -30 rotate'
      write(26,*)'   6 {ll l4 neg rlineto'
      write(26,*)'      ll l4 rlineto'
      write(26,*)'      -60 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def '
      write(26,*)' '
      END IF
      IF(Lpent)THEN
      write(26,*)'/pent'
      write(26,*)'  {/gris exch def'
      write(26,*)'   /len exch def '
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def  '
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l16 len 13 mul def '
      write(26,*)'   /ll l16 36 sin 2 mul mul def'  
      write(26,*)'   gsave'
      write(26,*)'   0 l16 rmoveto'
      write(26,*)'   -36 rotate'
      write(26,*)'   5 {ll 0 rlineto'
      write(26,*)'      -72 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lhex)THEN
      write(26,*)'/hex'
      write(26,*)'  {/gris exch def'
      write(26,*)'   /len exch def '
      write(26,*)'   /yy exch def  '
      write(26,*)'   /xx exch def  '
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l16 len 12 mul def '
      write(26,*)'   gsave'
      write(26,*)'   0 l16 rmoveto'
      write(26,*)'   -30 rotate'
      write(26,*)'   6 {l16 0 rlineto'
      write(26,*)'      -60 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill' 
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lcircle)THEN
      write(26,*)'/circle '
      write(26,*)'  {/gris exch def'
      write(26,*)'   /rad exch def'  
      write(26,*)'   /yy exch def'  
      write(26,*)'   /xx exch def' 
      write(26,*)'   xx yy moveto '
      write(26,*)'  /radl rad 12 mul def'
      write(26,*)'   radl 0 rmoveto'
      write(26,*)'   xx yy radl 0 360 arc'
      write(26,*)'   gsave'
      write(26,*)'    gris setgray fill '
      write(26,*)'   grestore '
      write(26,*)'   stroke'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lrgbsquare)THEN
      write(26,*)'/rgbsquare'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /length exch def' 
      write(26,*)'   /yy exch def  '
      write(26,*)'   /xx exch def '
      write(26,*)'   /ll length 10 mul def '
      write(26,*)'   /length2 ll 2 mul def '
      write(26,*)'   xx yy moveto'
      write(26,*)'   ll neg ll neg rmoveto'
      write(26,*)'   length2 0 rlineto'
      write(26,*)'   0 length2 rlineto'
      write(26,*)'   length2 neg 0 rlineto ' 
      write(26,*)'   closepath  '
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill '
      write(26,*)'   grestore   '
      write(26,*)'   stroke'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lrgblosange)THEN
      write(26,*)'/rgblosange'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /len exch def'
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto '
      write(26,*)'   /length len 14 mul def'
      write(26,*)'   0 length neg rmoveto'
      write(26,*)'   length length rlineto'
      write(26,*)'   length neg length rlineto'
      write(26,*)'   length neg length neg rlineto ' 
      write(26,*)'   closepath  '
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill' 
      write(26,*)'   grestore  '
      write(26,*)'   stroke'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lrgbxstar)THEN
      write(26,*)'/rgbxstar'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def'  
      write(26,*)'   /xx exch def'  
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l5 len 5 mul def'
      write(26,*)'   /l7 len 7 mul def'
      write(26,*)'   /l12 len 12 mul def '
      write(26,*)'   gsave'
      write(26,*)'   l5 0 rmoveto'
      write(26,*)'   4 {l7 l12 rlineto'
      write(26,*)'      l12 neg l7 neg rlineto'
      write(26,*)'      90 rotate} repeat'
      write(26,*)'   closepath  '
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lrgbpstar)THEN
      write(26,*)'/rgbpstar'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /len exch def '
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def' 
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l5 len 5 mul def'
      write(26,*)'   /l7 len 7 mul def'
      write(26,*)'   /l12 len 12 mul def '
      write(26,*)'   gsave'
      write(26,*)'   45 rotate'
      write(26,*)'   l5 0 rmoveto'
      write(26,*)'   4 {l7 l12 rlineto'
      write(26,*)'      l12 neg l7 neg rlineto'
      write(26,*)'      90 rotate} repeat'
      write(26,*)'   closepath ' 
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill' 
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lrgbutri)THEN
      write(26,*)'/rgbutri'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /len exch def '
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l16 len 15 mul def '
      write(26,*)'   /ll l16 3 sqrt mul def ' 
      write(26,*)'   gsave'
      write(26,*)'   0 l16 rmoveto'
      write(26,*)'   -60 rotate'
      write(26,*)'   3 {ll 0 rlineto'
      write(26,*)'      -120 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lrgbdtri)THEN
      write(26,*)'/rgbdtri'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def'  
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l16 len 15 mul def '
      write(26,*)'   /ll l16 3 sqrt mul def ' 
      write(26,*)'   gsave'
      write(26,*)'   0 l16 neg rmoveto'
      write(26,*)'   60 rotate'
      write(26,*)'   3 {ll 0 rlineto'
      write(26,*)'      120 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill' 
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lrgbumtri)THEN
      write(26,*)'/rgbumtri'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def'  
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l4 len 4 mul def '
      write(26,*)'   /l16 len 18 mul def '
      write(26,*)'   /ll l16 .75 sqrt mul def '
      write(26,*)'   gsave'
      write(26,*)'   0 l16 rmoveto'
      write(26,*)'   -60 rotate'
      write(26,*)'   3 {ll l4 neg rlineto'
      write(26,*)'      ll l4 rlineto'
      write(26,*)'      -120 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lrgbdmtri)THEN
      write(26,*)'/rgbdmtri'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l4 len 4 mul def' 
      write(26,*)'   /l16 len 18 mul def '
      write(26,*)'   /ll l16 .75 sqrt mul def ' 
      write(26,*)'   gsave'
      write(26,*)'   0 l16 neg rmoveto'
      write(26,*)'   60 rotate'
      write(26,*)'   3 {ll l4 rlineto'
      write(26,*)'      ll l4 neg rlineto'
      write(26,*)'      120 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lrgbhardy)THEN
      write(26,*)'/rgbhardy'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l3 len 3 mul def '
      write(26,*)'   /l8 len 8 mul def '
      write(26,*)'   /l11 len 11 mul def'
      write(26,*)'   /l22 len 22 mul def '  
      write(26,*)'   gsave'
      write(26,*)'   0 l3 rmoveto'
      write(26,*)'   2 {l11 l8 rlineto'
      write(26,*)'      0 l22 neg rlineto'
      write(26,*)'      l11 neg l8 rlineto'
      write(26,*)'      180 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lrgblaurel)THEN
      write(26,*)'/rgblaurel'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def'  
      write(26,*)'   /xx exch def'  
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l3 len 3 mul def '
      write(26,*)'   /l8 len 8 mul def '
      write(26,*)'   /l11 len 11 mul def '
      write(26,*)'   /l22 len 22 mul def '
      write(26,*)'   gsave'
      write(26,*)'   90 rotate'
      write(26,*)'   0 l3 rmoveto'
      write(26,*)'   2 {l11 l8 rlineto'
      write(26,*)'      0 l22 neg rlineto'
      write(26,*)'      l11 neg l8 rlineto'
      write(26,*)'      180 rotate} repeat'
      write(26,*)'   closepath ' 
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill '
      write(26,*)'   grestore  '
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lrgbmpent)THEN
      write(26,*)'/rgbmpent'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto'
      write(26,*)'   /tan 36 sin 36 cos div def '
      write(26,*)'   /l16 len 15 mul def '
      write(26,*)'   /ll l16 36 sin mul def' 
      write(26,*)'   /l4 ll tan mul def '
      write(26,*)'   gsave'
      write(26,*)'   0 l16 rmoveto'
      write(26,*)'   -36 rotate'
      write(26,*)'   5 {ll l4 neg rlineto'
      write(26,*)'      ll l4 rlineto'
      write(26,*)'      -72 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill' 
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def '
      write(26,*)' ' 
      END IF
      IF(Lrgbmhex)THEN
      write(26,*)'/rgbmhex'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def'  
      write(26,*)'   /xx exch def'  
      write(26,*)'   xx yy moveto'
      write(26,*)'   /l16 len 14 mul def' 
      write(26,*)'   /ll l16 .5 mul def '
      write(26,*)'   /l4 ll 1 3 div sqrt mul def '
      write(26,*)'   gsave'
      write(26,*)'   0 l16 rmoveto'
      write(26,*)'   -30 rotate'
      write(26,*)'   6 {ll l4 neg rlineto'
      write(26,*)'      ll l4 rlineto'
      write(26,*)'      -60 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def '
      write(26,*)' '
      END IF
      IF(Lrgbmmhex)THEN
      write(26,*)'/rgbmmhex'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /len exch def '
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def ' 
      write(26,*)'   xx yy moveto'
      write(26,*)'   /l16 len 17 mul def' 
      write(26,*)'   /ll l16 .5 mul def '
      write(26,*)'   /l4 l16 1 3 div sqrt mul def' 
      write(26,*)'   gsave'
      write(26,*)'   0 l16 rmoveto'
      write(26,*)'   -30 rotate'
      write(26,*)'   6 {ll l4 neg rlineto'
      write(26,*)'      ll l4 rlineto'
      write(26,*)'      -60 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill' 
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def' 
      write(26,*)' '
      END IF
      IF(Lrgbpent)THEN
      write(26,*)'/rgbpent'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /len exch def' 
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def'  
      write(26,*)'   xx yy moveto' 
      write(26,*)'   /l16 len 13 mul def' 
      write(26,*)'   /ll l16 36 sin 2 mul mul def ' 
      write(26,*)'   gsave'
      write(26,*)'   0 l16 rmoveto'
      write(26,*)'   -36 rotate'
      write(26,*)'   5 {ll 0 rlineto'
      write(26,*)'      -72 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lrgbhex)THEN
      write(26,*)'/rgbhex'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /len exch def '
      write(26,*)'   /yy exch def  '
      write(26,*)'   /xx exch def  '
      write(26,*)'   xx yy moveto '
      write(26,*)'   /l16 len 12 mul def' 
      write(26,*)'   gsave'
      write(26,*)'   0 l16 rmoveto'
      write(26,*)'   -30 rotate'
      write(26,*)'   6 {l16 0 rlineto'
      write(26,*)'      -60 rotate} repeat'
      write(26,*)'   closepath '
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill '
      write(26,*)'   grestore'
      write(26,*)'   stroke'
      write(26,*)'   grestore'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Lrgbcircle)THEN
      write(26,*)'/rgbcircle'
      write(26,*)'  {/blue exch def'
      write(26,*)'   /green exch def'
      write(26,*)'   /red exch def'
      write(26,*)'   /rad exch def ' 
      write(26,*)'   /yy exch def ' 
      write(26,*)'   /xx exch def '
      write(26,*)'   xx yy moveto '
      write(26,*)'  /radl rad 12 mul def'
      write(26,*)'   radl 0 rmoveto'
      write(26,*)'   xx yy radl 0 360 arc'
      write(26,*)'   gsave'
      write(26,*)'    red green blue setrgbcolor fill' 
      write(26,*)'   grestore' 
      write(26,*)'   stroke'
      write(26,*)'  }def'
      write(26,*)' '
      END IF
      IF(Larrow)THEN
      write(26,*)'/adict 5 dict def'
      write(26,*)'/ato'
      write(26,*)' {adict begin'
      write(26,*)' /len exch def'
      write(26,*)' /py exch def'
      write(26,*)' /px exch def'
      write(26,*)' currentpoint'
      write(26,*)' /opy exch def'
      write(26,*)' /opx exch def'
      write(26,*)' px py l'
      write(26,*)' gsave'
      write(26,*)'  [] 0 sd'
      write(26,*)'  0 setlinejoin'
      write(26,*)'  px py translate'
      write(26,*)'  px opx ne py opy ne or'
      write(26,*)'  { py opy sub px opx sub atan rotate'
      write(26,*)'  n'
      write(26,*)'  0 0 m'
      write(26,*)'  len neg len 3 div rl'
      write(26,*)'  len 5 div len 3 div neg rl'
      write(26,*)'  len 5 div neg len 3 div neg rl'
      write(26,*)'  closepath gsave fill grestore s}{0 0 m 0 0 l}ifelse'
      write(26,*)' grestore end'
      write(26,*)'} def'
      END IF
      RETURN
      END

        SUBROUTINE SCALE_PICTURE(SCALE)
        COMMON/BOUNDINGBOX/IPIXMIN,IPIXMAX,IPIYMIN,IPIYMAX,SCALEFAC
        SCALEFAC=SCALE
        RETURN
        END

C *********** SUBROUTINE MASOG ***********
        SUBROUTINE MASOG(XMIN,XMAX,YMIN,YMAX)
        INTEGER PFACX,PFACY
C --------- TAILLE DU PETIT IMAGE EN CM --------------
        COMMON/SIZES/UDIM,VDIM,UINT,VINT
C -------- LOCATION DE L'IMAGE EN CM ---------
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
C -------- BORNES EN X ET Y -----------
        COMMON/PICTURE_LIMITS/XXMIN,XXMAX,YYMIN,YYMAX,XDEL,YDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
C ------- DIMENSION MAXIMALE DU PAPIER ----------
        COMMON/PAPER/PAXMIN,PAXMAX,PAYMIN,PAYMAX
        COMMON/BOUNDINGBOX/IPIXMIN,IPIXMAX,IPIYMIN,IPIYMAX,SCALEFAC
C -------- BORNES EN X ET Y -----------
        XXMIN=XMIN
        XXMAX=XMAX
        YYMIN=YMIN
        YYMAX=YMAX
        XDEL=XMAX-XMIN
        YDEL=YMAX-YMIN
C -------- IMAGE PROCHAIN EN DIR U -------------
        IF(UMAX+(UDIM+UINT).LE.PAXMAX)THEN
          UMIN=UMIN+(UDIM+UINT)
          UMAX=UMAX+(UDIM+UINT)
          UDEL=UMAX-UMIN
          VDEL=VMAX-VMIN
          GOTO 20
        END IF
C -------- IMAGE PROCHAIN EN DIR V -----------
        IF(VMIN-(VDIM+VINT).GE.PAYMIN)THEN
          VMAX=VMIN-VINT
          VMIN=VMAX-VDIM
          UMIN=UINT/2.
          UMAX=UMIN+UDIM
          UDEL=UMAX-UMIN
          VDEL=VMAX-VMIN
          GOTO 20
        END IF
C ---------- ICI ON REVIENT,PAR MANQUE DE PLACE, AU DEBUT -----------
        UMIN=UINT/2.
        UMAX=UMIN+UDIM
         VMAX=PAYMAX-VINT/2.
         VMIN=VMAX-VDIM
        UDEL=UMAX-UMIN
        VDEL=VMAX-VMIN
C ------- ADJUST BOUNDINGBOX -------
   20   IPIX1=UMIN*600./2.54
        IPIX2=UMAX*600./2.54
        IPIY1=VMIN*600./2.54
        IPIY2=VMAX*600./2.54
        IPIXMIN=MIN(IPIXMIN,IPIX1)
        IPIXMAX=MAX(IPIXMAX,IPIX2)
        IPIYMIN=MIN(IPIYMIN,IPIY1)
        IPIYMAX=MAX(IPIYMAX,IPIY2)
        RETURN
        END

C *********** SUBROUTINE MICKEY_MOUSE ***********
        SUBROUTINE MICKEY_MOUSE(I,J,XMIN,XMAX,YMIN,YMAX)
        INTEGER PFACX,PFACY
C --------- TAILLE DU PETIT IMAGE EN CM --------------
        COMMON/SIZES/UDIM,VDIM,UINT,VINT
C -------- LOCATION DE L'IMAGE EN CM ---------
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
C -------- BORNES EN X ET Y -----------
        COMMON/PICTURE_LIMITS/XXMIN,XXMAX,YYMIN,YYMAX,XDEL,YDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
C ------- DIMENSION MAXIMALE DU PAPIER ----------
        COMMON/PAPER/PAXMIN,PAXMAX,PAYMIN,PAYMAX
        COMMON/BOUNDINGBOX/IPIXMIN,IPIXMAX,IPIYMIN,IPIYMAX,SCALEFAC
C -------- BORNES EN X ET Y -----------

        XXMIN=XMIN
        XXMAX=XMAX
        YYMIN=YMIN
        YYMAX=YMAX
        XDEL=XMAX-XMIN
        YDEL=YMAX-YMIN
C ---- POSITION FRACTIONNAIRE ----
        AI=I
        IF(ABS(I).GT.500)THEN
         AI=AI/1000.
        END IF
        AJ=J
        IF(ABS(J).GT.500)THEN
         AJ=AJ/1000.
        END IF
C ----- POSITION PAPIER ------
        UMIN=UINT/2.+(AJ-1)*(UINT+UDIM)
        UMAX=UMIN+UDIM
        IF(AI.GE.0)THEN
         VMAX=PAYMAX-VINT/2.-(AI-1)*(VINT+VDIM)
         VMIN=VMAX-VDIM
        ELSE
         VMIN=PAYMIN+VINT/2.-(AI+1)*(VINT+VDIM)
         VMAX=VMIN+VDIM
        END IF
        UDEL=UMAX-UMIN
        VDEL=VMAX-VMIN
C ------- ADJUST BOUNDINGBOX -------
        IPIX1=UMIN*600./2.54
        IPIX2=UMAX*600./2.54
        IPIY1=VMIN*600./2.54
        IPIY2=VMAX*600./2.54
        IPIXMIN=MIN(IPIXMIN,IPIX1)
        IPIXMAX=MAX(IPIXMAX,IPIX2)
        IPIYMIN=MIN(IPIYMIN,IPIY1)
        IPIYMAX=MAX(IPIYMAX,IPIY2)
        RETURN
        END

C ************ SUBROUTINE PAPER_CORNERS ***********
      SUBROUTINE PAPER_CORNERS(U1,V1,U2,V2)
C -------- LOCATION DE L'IMAGE EN CM ---------
      COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
C ------- DIMENSION MAXIMALE DU PAPIER ----------
        COMMON/PAPER/PAXMIN,PAXMAX,PAYMIN,PAYMAX
        COMMON/BOUNDINGBOX/IPIXMIN,IPIXMAX,IPIYMIN,IPIYMAX,SCALEFAC
      UMIN=MIN(U1,U2)
      UMAX=MAX(U1,U2)
      UDEL=UMAX-UMIN
      IF(UDEL.LE.0.)WRITE(6,*)'  WARNING: PAPER WINDOW ZERO WIDTH.'
      VSMALL=MIN(V1,V2)
      VBIG=MAX(V1,V2)
      VDEL=VBIG-VSMALL
      IF(VDEL.LE.0.)WRITE(6,*)'  WARNING: PAPER WINDOW ZERO HEIGTH.'
      VMIN=PAYMIN+0.00001+VSMALL
      VMAX=VMIN+VDEL
C ------- ADJUST BOUNDINGBOX -------
        IPIX1=UMIN*600./2.54
        IPIX2=UMAX*600./2.54
        IPIY1=VMIN*600./2.54
        IPIY2=VMAX*600./2.54
        IPIXMIN=MIN(IPIXMIN,IPIX1)
        IPIXMAX=MAX(IPIXMAX,IPIX2)
        IPIYMIN=MIN(IPIYMIN,IPIY1)
        IPIYMAX=MAX(IPIYMAX,IPIY2)
      RETURN
      END

C ************ SUBROUTINE XY_LIMITS ***********
      SUBROUTINE XY_LIMITS(XMIN,XMAX,YMIN,YMAX)
C -------- BORNES EN X ET Y -----------
        COMMON/PICTURE_LIMITS/XXMIN,XXMAX,YYMIN,YYMAX,XDEL,YDEL
        XXMIN=XMIN
        XXMAX=XMAX
        YYMIN=YMIN
        YYMAX=YMAX
        XDEL=XMAX-XMIN
        YDEL=YMAX-YMIN
        IF(XDEL.EQ.0.)WRITE(6,*)'  WARNING: XMAX=XMIN.'
        IF(YDEL.EQ.0.)WRITE(6,*)'  WARNING: YMAX=YMIN.'
        RETURN
        END


C ********* SUBROUTINE SELECT_LINE_TYPE *********
        SUBROUTINE SELECT_LINE_TYPE(ITYPE)
        INTEGER PFACX,PFACY
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/THICK/JTHICK
        JTYPE=MOD(ITYPE,8)
        LTNEW=JTYPE
                IF(LTNEW.EQ.0)THEN
                  I1=2
                  I2=6*(JTHICK)
                  WRITE(29,880)I1,I2
 880              FORMAT('[',I5,1X,I5,'] 0 setdash')
                END IF
                IF(LTNEW.EQ.1)THEN
                  I1=1
                  I2=4*(JTHICK)
                  WRITE(29,881)I1,I2
 881              FORMAT('[',I5,1X,I5,'] 0 setdash')
                END IF
                IF(LTNEW.EQ.2)THEN
                  I1=6*(JTHICK)
                  I2=4*(JTHICK)
                  WRITE(29,882)I1,I2
 882              FORMAT('[',I5,1X,I5,'] 0 setdash')
                END IF
                IF(LTNEW.EQ.3)THEN
                  I1=1
                  I2=4*(JTHICK)
                  I3=9*(JTHICK)
                  I4=4*(JTHICK)
                  WRITE(29,883)I1,I2,I3,I4
 883              FORMAT('[',I5,1X,I5,1X,I5,1X,I5,'] 0 setdash')
                END IF
                IF(LTNEW.EQ.4)THEN
                  I1=1
                  I2=3*(JTHICK)
                  I3=1
                  I4=3*(JTHICK)
                  I5=9*(JTHICK)
                  I6=3*(JTHICK)
                  WRITE(29,884)I1,I2,I3,I4,I5,I6
 884   FORMAT('[',I5,1X,I5,1X,I5,1X,I5,1X,I5,1X,I5,'] 0 setdash')
                END IF
                IF(LTNEW.EQ.5)THEN
                  I1=1
                  I2=3*(JTHICK)
                  I3=1
                  I4=3*(JTHICK)
                  I5=1
                  I6=3*(JTHICK)
                  I7=9*(JTHICK)
                  I8=3*(JTHICK)
                  WRITE(29,885)I1,I2,I3,I4,I5,I6,I7,I8
 885  FORMAT('[',I5,1X,I5,1X,I5,1X,I5,1X,I5,1X,I5,1X,I5,1X,I5,
     &          '] 0 setdash')
                END IF
                IF(LTNEW.EQ.6)THEN
                  I1=16*(JTHICK)
                  I2=6*(JTHICK)
                  WRITE(29,886)I1,I2
 886              FORMAT('[',I5,1X,I5,'] 0 setdash')
                END IF
                IF(LTNEW.EQ.7)WRITE(29,887)
 887              FORMAT('[] 0 setdash')
        RETURN
        END

C ********* INTEGER FUNCTION PIXEL_X ********
        INTEGER FUNCTION PIXEL_X(X)
        IMPLICIT INTEGER (P)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        USUB=UMIN+(X-XMIN)/XDEL*UDEL
            INTEG=USUB*600./2.54
            PIXEL_X=INTEG
        RETURN
        END

C ********* REAL FUNCTION VAL_PIXEL_X ********
        REAL FUNCTION VAL_PIXEL_X(PX)
        IMPLICIT INTEGER (P)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
         VAL_PIXEL_X=XMIN+((2.54*PX/600.)-UMIN)*XDEL/UDEL
        RETURN
        END

C ********* INTEGER FUNCTION PIXEL_Y ********
        INTEGER FUNCTION PIXEL_Y(Y)
        IMPLICIT INTEGER (P)
        REAL*4 PAXMIN,PAXMAX,PAYMIN,PAYMAX
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/PAPER/PAXMIN,PAXMAX,PAYMIN,PAYMAX
        VSUB=VMIN+(Y-YMIN)/YDEL*VDEL
            INTEG=(VSUB-PAYMIN)*600./2.54
            INTEG=MIN(30000,MAX(-30000,INTEG))
            PIXEL_Y=INTEG
        RETURN
        END

C ********* REAL FUNCTION VAL_PIXEL_Y ********
        REAL FUNCTION VAL_PIXEL_Y(PY)
        IMPLICIT INTEGER (P)
        REAL*4 PAXMIN,PAXMAX,PAYMIN,PAYMAX
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/PAPER/PAXMIN,PAXMAX,PAYMIN,PAYMAX
         VAL_PIXEL_Y=YMIN+(2.54*PY/600.+PAYMIN-VMIN)*YDEL/VDEL
        RETURN
        END


C ********* SUBROUTINE LINE_DRAW **********
        SUBROUTINE LINE_DRAW(PLOTX,PLOTY,LOTN)
        IMPLICIT INTEGER (P)
        DIMENSION PLOTX(LOTN),PLOTY(LOTN)
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/PSTORE/PPOSX,PPOSY,LSTORE,PPX(100000),PPY(100000)
        COMMON/THICK/JTHICK
C -------NOUVEAU TRAIT ? ------------
        IF(LSTORE.EQ.0)GOTO 3
C -------- TRAIT CONTINUE ? ---------
        IF(PLOTX(1).EQ.PPOSX.AND.PLOTY(1).EQ.PPOSY)GOTO 4
C -------- DESSINER TRAIT RESTANT --------
        CALL VIDANGE
C -------- ALLER AU NOUVEAU POINT INITIAL ---------
  3     CONTINUE
        WRITE(29,8492)PLOTX(1),PLOTY(1)
 8492         FORMAT(I5,I5,' m')
C -------- ON RAJOUTE DES POINTS ---------
   4    CONTINUE
        IF(LOTN.GE.2)THEN
            DO 1 I=2,LOTN
            LSTORE=LSTORE+1
            PPX(LSTORE)=PLOTX(I)
    1       PPY(LSTORE)=PLOTY(I)
        END IF
C -------- MARQUER ANCIENNE POSITION ----------
        PPOSX=PLOTX(LOTN)
        PPOSY=PLOTY(LOTN)
        RETURN
        END

C ******** SUBROUTINE VIDANGE *********
        SUBROUTINE VIDANGE
C ------ VIDANGE DES DERNIERS TRAITS AVANT DE FAIRE AUTRE CHOSE ---
        IMPLICIT INTEGER (P)
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/PSTORE/PPOSX,PPOSY,LSTORE,PPX(100000),PPY(100000)
        IF(LSTORE.GT.0)THEN
 40           CONTINUE
              IF(LSTORE.GT.101)THEN
                WRITE(29,81)(PPX(J),PPY(J),J=1,100)
                WRITE(29,*)'s'
                WRITE(29,82)PPX(100),PPY(100)
                DO 41 I=101,LSTORE
                PPX(I-100)=PPX(I)
 41             PPY(I-100)=PPY(I)
                LSTORE=LSTORE-100
                GOTO 40 
              ELSE
                WRITE(29,81)(PPX(J),PPY(J),J=1,LSTORE)
                WRITE(29,*)'s'
              END IF
 81         FORMAT(I5,I5,2H l)
 82         FORMAT(I5,I5,2H m)
            LSTORE=0
        END IF
        RETURN
        END

C ********* SUBROUTINE FRAME ***********
        SUBROUTINE FRAME
        IMPLICIT INTEGER (P)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        DIMENSION PLOTX(5),PLOTY(5)
        ENTRY FRAMG
        PLOTX(1)=PIXEL_X(XMIN)
        PLOTY(1)=PIXEL_Y(YMIN)
        PLOTX(2)=PIXEL_X(XMAX)
        PLOTY(2)=PIXEL_Y(YMIN)
        PLOTX(3)=PIXEL_X(XMAX)
        PLOTY(3)=PIXEL_Y(YMAX)
        PLOTX(4)=PIXEL_X(XMIN)
        PLOTY(4)=PIXEL_Y(YMAX)
        PLOTX(5)=PIXEL_X(XMIN)
        PLOTY(5)=PIXEL_Y(YMIN)
        CALL LINE_DRAW(PLOTX,PLOTY,5)
        CALL VIDANGE
        RETURN
        END


C ******** SUBROUTINE GREATER_BOUNDINGBOX ********
      SUBROUTINE GREATER_BOUNDINGBOX(U1GR,U2GR,V1GR,V2GR)
        COMMON/BOUNDINGBOX/IPIXMIN,IPIXMAX,IPIYMIN,IPIYMAX,SCALEFAC
        IPIX1=U1GR*600./2.54
        IPIX2=U2GR*600./2.54
        IPIY1=V1GR*600./2.54
        IPIY2=V2GR*600./2.54
        IPIXMIN=IPIXMIN-IPIX1
        IPIXMAX=IPIXMAX+IPIX2
        IPIYMIN=IPIYMIN-IPIY1
        IPIYMAX=IPIYMAX+IPIY2
        RETURN
        END


C ******** SUBROUTINE COLOR_BOUNDINGBOX ********
      SUBROUTINE COLOR_BOUNDINGBOX(COL)
      CHARACTER*(*) COL
      LOGICAL LBBC
      COMMON/BBC/LBBC,CRED,CGREEN,CBLUE
c --- white ---
      CRED=1.
      CGREEN=1.
      CBLUE=1.
c --- other colors ---
      IF (COL.EQ.'black')THEN
       CRED=0.
       CGREEN=0.
       CBLUE=0.
      END IF
      IF (COL.EQ.'blue')THEN
       CRED=0.
       CGREEN=0.
       CBLUE=1.
      END IF
      IF (COL.EQ.'green')THEN
       CRED=0.
       CGREEN=1.
       CBLUE=0.
      END IF
      IF (COL.EQ.'red')THEN
       CRED=1.
       CGREEN=0.
       CBLUE=0.
      END IF
      IF (COL.EQ.'pink')THEN
       CRED=1.
       CGREEN=0.25
       CBLUE=1.
      END IF
      IF (COL.EQ.'violet')THEN
       CRED=0.65
       CGREEN=0.
       CBLUE=0.85
      END IF
      IF (COL.EQ.'yellow')THEN
       CRED=1.
       CGREEN=1.
       CBLUE=0.
      END IF
      IF (COL.EQ.'orange')THEN
       CRED=1.
       CGREEN=0.3
       CBLUE=0.
      END IF
      LBBC=.TRUE.
      RETURN
      END

C ******** SUBROUTINE RGB_COLOR_BOUNDINGBOX ********
      SUBROUTINE RGB_COLOR_BOUNDINGBOX(RED,GREEN,BLUE)
      LOGICAL LBBC
      COMMON/BBC/LBBC,CRED,CGREEN,CBLUE

       CRED=RED
       CGREEN=GREEN
       CBLUE=BLUE

      LBBC=.TRUE.
      RETURN
      END



C ********* SUBROUTINE CLOSE_FILL ***********
        SUBROUTINE CLOSE_FILL(XDES,YDES,NDES,GREY,STROKE)
        IMPLICIT INTEGER (P)
        DIMENSION PLOTX(5005),PLOTY(5005)
        DIMENSION XDES(NDES+10),YDES(NDES+10)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        LOGICAL STROKE,GREYONLY 
C --------- POSTSCRIPT MODE --------
        GREYONLY=.TRUE.
        GOTO 30
C -------- ENTRY RGB_CLOSE_FILL --------
        ENTRY RGB_CLOSE_FILL(XDES,YDES,NDES,RED,GREEN,BLUE,STROKE)
C --------- POSTSCRIPT MODE --------
        GREYONLY=.FALSE.
C ------ MARCHONS ENSEMBLE ------
 30     CONTINUE
        DO 3 I=2,NDES
        X1=XDES(I-1)
        X2=XDES(I)
        Y1=YDES(I-1)
        Y2=YDES(I)
        XD=X2-X1
        YD=Y2-Y1
        IF(ABS(XD).GT.1.E-10)THEN
            Q1X=(XMIN-X1)/XD
            Q2X=(XMAX-X1)/XD
            IF(XD.GT.0.)THEN
                SX=Q1X
                TX=Q2X
            ELSE
                SX=Q2X
                TX=Q1X
            END IF
        ELSE
            IF(XMIN.LE.X1.AND.X1.LE.XMAX)THEN
               SX=0.
               TX=1.
            ELSE
               SX=1.
               TX=0.
            END IF
        END IF
        IF(ABS(YD).GT.1.E-10)THEN
            Q1Y=(YMIN-Y1)/YD
            Q2Y=(YMAX-Y1)/YD
            IF(YD.GT.0.)THEN
                SY=Q1Y
                TY=Q2Y
            ELSE
                SY=Q2Y
                TY=Q1Y
            END IF
        ELSE
            IF(YMIN.LE.Y1.AND.Y1.LE.YMAX)THEN
                SY=0.
                TY=1.
            ELSE
                SY=1.
                TY=0.
            END IF
        END IF
        S=AMAX1(SX,SY,0.)
        T=AMIN1(TX,TY,1.)
        IF(S.LT.T)THEN
          PLOTX(I-1)=PIXEL_X(X1+S*XD)
          PLOTY(I-1)=PIXEL_Y(Y1+S*YD)
          PLOTX(I)=PIXEL_X(X1+T*XD)
          PLOTY(I)=PIXEL_Y(Y1+T*YD)
        ELSE 
          IF(I.EQ.2)THEN
            PLOTX(1)=PIXEL_X(MAX(XMIN,MIN(XMAX,X1)))
            PLOTY(1)=PIXEL_Y(MAX(YMIN,MIN(YMAX,Y1)))
          END IF
          PLOTX(I)=PIXEL_X(MAX(XMIN,MIN(XMAX,X2)))
          PLOTY(I)=PIXEL_Y(MAX(YMIN,MIN(YMAX,Y2)))
        END IF
    3   CONTINUE
         WRITE(29,8833)PLOTX(1),PLOTY(1)
 8833    FORMAT('gsave',/,'newpath',/,1X,I4,1X,I4,' m')
         DO 4 I=2,NDES
         WRITE(29,8834)PLOTX(I),PLOTY(I)
 8834    FORMAT(1X,I4,1X,I4,' l')
   4     CONTINUE
         WRITE(29,*)'closepath'
         IF(STROKE)WRITE(29,*)'gsave'
         IF(.NOT.GREYONLY)THEN
          WRITE (29,8837) RED,GREEN,BLUE
 8837     FORMAT(3F5.2,' setrgbcolor',/,'fill')
         ELSE
          WRITE(29,8835)GREY
 8835    FORMAT(F4.2,' setgray',/,'fill')
         END IF
         IF(STROKE)WRITE(29,8836)
 8836    FORMAT('grestore',/,'s')
         WRITE(29,*)'grestore'
      RETURN
      END



C *********      SUBROUTINE SETGRAY  *********
      SUBROUTINE SETGRAY(GRAY)
      INTEGER PFACX,PFACY
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
      WRITE(29,8833)GRAY
 8833 FORMAT(F4.2,' setgray')
      RETURN
      END

C ********* SUBROUTINE LING ***********
        SUBROUTINE LING(XDES,YDES,N)
        INTEGER PLOTX,PLOTY,PIXEL_X,PIXEL_Y
        DIMENSION PLOTX(2),PLOTY(2)
        DIMENSION XDES(N),YDES(N)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        IF(N.LE.1)RETURN
        DO 5 I=2,N
        X1=XDES(I-1)
        X2=XDES(I)
        Y1=YDES(I-1)
        Y2=YDES(I)
        XD=X2-X1
        YD=Y2-Y1
        IF(ABS(XD).GT.1.E-10)THEN
            Q1X=(XMIN-X1)/XD
            Q2X=(XMAX-X1)/XD
            IF(XD.GT.0.)THEN
                SX=Q1X
                TX=Q2X
            ELSE
                SX=Q2X
                TX=Q1X
            END IF
        ELSE
            IF(XMIN.LE.X1.AND.X1.LE.XMAX)THEN
               SX=0.
               TX=1.
            ELSE
               SX=1.
               TX=0.
            END IF
        END IF
        IF(ABS(YD).GT.1.E-10)THEN
            Q1Y=(YMIN-Y1)/YD
            Q2Y=(YMAX-Y1)/YD
            IF(YD.GT.0.)THEN
                SY=Q1Y
                TY=Q2Y
            ELSE
                SY=Q2Y
                TY=Q1Y
            END IF
        ELSE
            IF(YMIN.LE.Y1.AND.Y1.LE.YMAX)THEN
                SY=0.
                TY=1.
            ELSE
                SY=1.
                TY=0.
            END IF
        END IF
        S=AMAX1(SX,SY,0.)
        T=AMIN1(TX,TY,1.)
        IF(S.LT.T)THEN
          PLOTX(1)=PIXEL_X(X1+S*XD)
          PLOTY(1)=PIXEL_Y(Y1+S*YD)
          PLOTX(2)=PIXEL_X(X1+T*XD)
          PLOTY(2)=PIXEL_Y(Y1+T*YD)
          CALL LINE_DRAW(PLOTX,PLOTY,2)
        END IF
    5   CONTINUE
        CALL VIDANGE
        RETURN
        END

C ********* SUBROUTINE LING_OPEN ***********
        SUBROUTINE LING_OPEN(XDES,YDES,N)
        INTEGER PLOTX,PLOTY,PIXEL_X,PIXEL_Y
        DIMENSION PLOTX(2),PLOTY(2)
        DIMENSION XDES(N),YDES(N)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        IF(N.LE.1)RETURN
        DO 5 I=2,N
        X1=XDES(I-1)
        X2=XDES(I)
        Y1=YDES(I-1)
        Y2=YDES(I)
          PLOTX(1)=PIXEL_X(X1)
          PLOTY(1)=PIXEL_Y(Y1)
          PLOTX(2)=PIXEL_X(X2)
          PLOTY(2)=PIXEL_Y(Y2)
          CALL LINE_DRAW(PLOTX,PLOTY,2)
    5   CONTINUE
        CALL VIDANGE
        RETURN
        END


        SUBROUTINE LING_RELAD(XDES,YDES,NDES)
        INTEGER PLOTX,PLOTY,PIXEL_X,PIXEL_Y
        DIMENSION PLOTX(2000),PLOTY(2000)
        DIMENSION XDES(NDES),YDES(NDES)
        COMMON/PICTURE_LIMITS/XXMIN,XXMAX,YYMIN,YYMAX,XDEL,YDEL
        DO 5 IDES=1,NDES
        XPOS=XXMIN+XDES(IDES)*XDEL
        YPOS=YYMIN+YDES(IDES)*YDEL
        PLOTX(IDES)=PIXEL_X(XPOS)
        PLOTY(IDES)=PIXEL_Y(YPOS)
   5    CONTINUE
        CALL LINE_DRAW(PLOTX,PLOTY,NDES)
        CALL VIDANGE
        RETURN
        END


      SUBROUTINE BUBBLES(XDES,YDES,N1,N2,NDIF,AMMBIG,AMMSML,GREY,SYM)
      IMPLICIT LOGICAL (L)
      INTEGER PFACX,PFACY,PPOSX,PPOSY,PIXEL_X,PIXEL_Y
      CHARACTER*(*) SYM
      CHARACTER*23 STRING
      DIMENSION XDES(N2),YDES(N2)
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
      COMMON/LSYM/Lsquare,Llosange,Lxstar,Lpstar,
     &Lutri,Ldtri,Lumtri,Ldmtri,Lhardy,Llaurel,Lmpent,Lmhex,Lmmhex,
     &Lpent,Lhex,Lcircle,Lrgbsquare,Lrgblosange,Lrgbxstar,Lrgbpstar,
     &Lrgbutri,Lrgbdtri,Lrgbumtri,Lrgbdmtri,Lrgbhardy,Lrgblaurel,
     &Lrgbmpent,Lrgbmhex,Lrgbmmhex,Lrgbpent,Lrgbhex,Lrgbcircle,Larrow 
C ---------- ICI ON EST EN VERSION POSTSCRIPT --------
C ----- LOGICALS ------
         IF(SYM.EQ.'circle')Lcircle=.TRUE.
         IF(SYM.EQ.'square')Lsquare=.TRUE.
         IF(SYM.EQ.'losange')Llosange=.TRUE.
         IF(SYM.EQ.'xstar')Lxstar=.TRUE.
         IF(SYM.EQ.'pstar')Lpstar=.TRUE.
         IF(SYM.EQ.'utri')Lutri=.TRUE.
         IF(SYM.EQ.'dtri')Ldtri=.TRUE.
         IF(SYM.EQ.'umtri')Lumtri=.TRUE.
         IF(SYM.EQ.'dmtri')Ldmtri=.TRUE.
         IF(SYM.EQ.'hardy')Lhardy=.TRUE.
         IF(SYM.EQ.'laurel')Llaurel=.TRUE.
         IF(SYM.EQ.'mpent')Lmpent=.TRUE.
         IF(SYM.EQ.'mhex')Lmhex=.TRUE.
         IF(SYM.EQ.'pent')Lpent=.TRUE.
         IF(SYM.EQ.'hex')Lhex=.TRUE.
         IF(SYM.EQ.'mmhex')Lmmhex=.TRUE.
      FFAC=2.
      DO 5 N=1,N2
      IF(XMIN.LE.XDES(N).AND.XDES(N).LE.XMAX)THEN
       IF(YMIN.LE.YDES(N).AND.YDES(N).LE.YMAX)THEN
         PPOSX=PIXEL_X(XDES(N))
         PPOSY=PIXEL_Y(YDES(N))
         REWIND 28
         IF(MOD(N,NDIF).EQ.MOD(N1,NDIF))THEN
            WRITE(28,9932)PPOSX,PPOSY,AMMBIG*FFAC,GREY
         ELSE
            IF(AMMSML.GT.0.)THEN
               WRITE(28,9932)PPOSX,PPOSY,AMMSML*FFAC,GREY
            END IF
         END IF
 9932    FORMAT(2I5,1X,F6.2,1X,F5.2)
         REWIND 28
         READ(28,9933)STRING
 9933    FORMAT(A23)
         REWIND 28
         WRITE(29,*)STRING,' ',SYM
       END IF
      END IF
   5  CONTINUE
C ---------- RETURN -------------
      RETURN
      END
 
      SUBROUTINE BUBBLES_OPEN(
     &             XDES,YDES,N1,N2,NDIF,AMMBIG,AMMSML,GREY,SYM)
      IMPLICIT LOGICAL (L)
      INTEGER PFACX,PFACY,PPOSX,PPOSY,PIXEL_X,PIXEL_Y
      CHARACTER*(*) SYM
      CHARACTER*23 STRING
      DIMENSION XDES(N2),YDES(N2)
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
      COMMON/LSYM/Lsquare,Llosange,Lxstar,Lpstar,
     &Lutri,Ldtri,Lumtri,Ldmtri,Lhardy,Llaurel,Lmpent,Lmhex,Lmmhex,
     &Lpent,Lhex,Lcircle,Lrgbsquare,Lrgblosange,Lrgbxstar,Lrgbpstar,
     &Lrgbutri,Lrgbdtri,Lrgbumtri,Lrgbdmtri,Lrgbhardy,Lrgblaurel,
     &Lrgbmpent,Lrgbmhex,Lrgbmmhex,Lrgbpent,Lrgbhex,Lrgbcircle,Larrow 
C ---------- ICI ON EST EN VERSION POSTSCRIPT --------
C ----- LOGICALS ------
         IF(SYM.EQ.'circle')Lcircle=.TRUE.
         IF(SYM.EQ.'square')Lsquare=.TRUE.
         IF(SYM.EQ.'losange')Llosange=.TRUE.
         IF(SYM.EQ.'xstar')Lxstar=.TRUE.
         IF(SYM.EQ.'pstar')Lpstar=.TRUE.
         IF(SYM.EQ.'utri')Lutri=.TRUE.
         IF(SYM.EQ.'dtri')Ldtri=.TRUE.
         IF(SYM.EQ.'umtri')Lumtri=.TRUE.
         IF(SYM.EQ.'dmtri')Ldmtri=.TRUE.
         IF(SYM.EQ.'hardy')Lhardy=.TRUE.
         IF(SYM.EQ.'laurel')Llaurel=.TRUE.
         IF(SYM.EQ.'mpent')Lmpent=.TRUE.
         IF(SYM.EQ.'mhex')Lmhex=.TRUE.
         IF(SYM.EQ.'pent')Lpent=.TRUE.
         IF(SYM.EQ.'hex')Lhex=.TRUE.
         IF(SYM.EQ.'mmhex')Lmmhex=.TRUE.
      FFAC=2.
      DO 5 N=1,N2
         PPOSX=PIXEL_X(XDES(N))
         PPOSY=PIXEL_Y(YDES(N))
         REWIND 28
         IF(MOD(N,NDIF).EQ.MOD(N1,NDIF))THEN
            WRITE(28,9932)PPOSX,PPOSY,AMMBIG*FFAC,GREY
         ELSE
            WRITE(28,9932)PPOSX,PPOSY,AMMSML*FFAC,GREY
         END IF
 9932    FORMAT(2I5,1X,F6.2,1X,F5.2)
         REWIND 28
         READ(28,9933)STRING
 9933    FORMAT(A23)
         REWIND 28
         WRITE(29,*)STRING,' ',SYM
   5  CONTINUE
C ---------- RETURN -------------
      RETURN
      END
c 
      SUBROUTINE BUBBLE(XX,YY,AMMBIG,GREY,SYM)
C ------- PLACER UNE SEULE BUBBLE ----
      IMPLICIT LOGICAL (L)
      INTEGER PFACX,PFACY,PPOSX,PPOSY,PIXEL_X,PIXEL_Y
      CHARACTER*(*) SYM
      CHARACTER*23 STRING
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
      COMMON/LSYM/Lsquare,Llosange,Lxstar,Lpstar,
     &Lutri,Ldtri,Lumtri,Ldmtri,Lhardy,Llaurel,Lmpent,Lmhex,Lmmhex,
     &Lpent,Lhex,Lcircle,Lrgbsquare,Lrgblosange,Lrgbxstar,Lrgbpstar,
     &Lrgbutri,Lrgbdtri,Lrgbumtri,Lrgbdmtri,Lrgbhardy,Lrgblaurel,
     &Lrgbmpent,Lrgbmhex,Lrgbmmhex,Lrgbpent,Lrgbhex,Lrgbcircle,Larrow 
C ---------- ICI ON EST EN VERSION POSTSCRIPT --------
C ----- LOGICALS ------
         IF(SYM.EQ.'circle')Lcircle=.TRUE.
         IF(SYM.EQ.'square')Lsquare=.TRUE.
         IF(SYM.EQ.'losange')Llosange=.TRUE.
         IF(SYM.EQ.'xstar')Lxstar=.TRUE.
         IF(SYM.EQ.'pstar')Lpstar=.TRUE.
         IF(SYM.EQ.'utri')Lutri=.TRUE.
         IF(SYM.EQ.'dtri')Ldtri=.TRUE.
         IF(SYM.EQ.'umtri')Lumtri=.TRUE.
         IF(SYM.EQ.'dmtri')Ldmtri=.TRUE.
         IF(SYM.EQ.'hardy')Lhardy=.TRUE.
         IF(SYM.EQ.'laurel')Llaurel=.TRUE.
         IF(SYM.EQ.'mpent')Lmpent=.TRUE.
         IF(SYM.EQ.'mhex')Lmhex=.TRUE.
         IF(SYM.EQ.'pent')Lpent=.TRUE.
         IF(SYM.EQ.'hex')Lhex=.TRUE.
         IF(SYM.EQ.'mmhex')Lmmhex=.TRUE.
      FFAC=2.
      IF(XMIN.LE.XX.AND.XX.LE.XMAX)THEN
       IF(YMIN.LE.YY.AND.YY.LE.YMAX)THEN
         PPOSX=PIXEL_X(XX)
         PPOSY=PIXEL_Y(YY)
         REWIND 28
         WRITE(28,9932)PPOSX,PPOSY,AMMBIG*FFAC,GREY
 9932    FORMAT(2I5,1X,F6.2,1X,F5.2)
         REWIND 28
         READ(28,9933)STRING
 9933    FORMAT(A23)
         WRITE(29,*)STRING,' ',SYM
         REWIND 28
       END IF
      END IF
C ---------- RETURN -------------
      RETURN
      END
c 
      SUBROUTINE RGB_BUBBLE(XX,YY,AMMBIG,RED,GREEN,BLUE,SYM)
C ------- PLACER UNE SEULE BUBBLE ----
      IMPLICIT LOGICAL (L)
      INTEGER PFACX,PFACY,PPOSX,PPOSY,PIXEL_X,PIXEL_Y
      CHARACTER*(*) SYM
      CHARACTER*33 STRING
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
      COMMON/LSYM/Lsquare,Llosange,Lxstar,Lpstar,
     &Lutri,Ldtri,Lumtri,Ldmtri,Lhardy,Llaurel,Lmpent,Lmhex,Lmmhex,
     &Lpent,Lhex,Lcircle,Lrgbsquare,Lrgblosange,Lrgbxstar,Lrgbpstar,
     &Lrgbutri,Lrgbdtri,Lrgbumtri,Lrgbdmtri,Lrgbhardy,Lrgblaurel,
     &Lrgbmpent,Lrgbmhex,Lrgbmmhex,Lrgbpent,Lrgbhex,Lrgbcircle,Larrow 
C ---------- ICI ON EST EN VERSION POSTSCRIPT --------
C ----- LOGICALS ------
         IF(SYM.EQ.'circle')Lrgbcircle=.TRUE.
         IF(SYM.EQ.'square')Lrgbsquare=.TRUE.
         IF(SYM.EQ.'losange')Lrgblosange=.TRUE.
         IF(SYM.EQ.'xstar')Lrgbxstar=.TRUE.
         IF(SYM.EQ.'pstar')Lrgbpstar=.TRUE.
         IF(SYM.EQ.'utri')Lrgbutri=.TRUE.
         IF(SYM.EQ.'dtri')Lrgbdtri=.TRUE.
         IF(SYM.EQ.'umtri')Lrgbumtri=.TRUE.
         IF(SYM.EQ.'dmtri')Lrgbdmtri=.TRUE.
         IF(SYM.EQ.'hardy')Lrgbhardy=.TRUE.
         IF(SYM.EQ.'laurel')Lrgblaurel=.TRUE.
         IF(SYM.EQ.'mpent')Lrgbmpent=.TRUE.
         IF(SYM.EQ.'mhex')Lrgbmhex=.TRUE.
         IF(SYM.EQ.'pent')Lrgbpent=.TRUE.
         IF(SYM.EQ.'hex')Lrgbhex=.TRUE.
         IF(SYM.EQ.'mmhex')Lrgbmmhex=.TRUE.
      FFAC=2.
      IF(XMIN.LE.XX.AND.XX.LE.XMAX)THEN
       IF(YMIN.LE.YY.AND.YY.LE.YMAX)THEN
         PPOSX=PIXEL_X(XX)
         PPOSY=PIXEL_Y(YY)
         REWIND 28
         WRITE(28,9932)PPOSX,PPOSY,AMMBIG*FFAC,RED,GREEN,BLUE
 9932    FORMAT(2I5,1X,F6.2,1X,3F5.2)
         REWIND 28
         READ(28,9933)STRING
 9933    FORMAT(A33)
         WRITE(29,*)STRING,' rgb',SYM
         REWIND 28
       END IF
      END IF
C ---------- RETURN -------------
      RETURN
      END
 
      SUBROUTINE BUBBLE_OPEN(XX,YY,AMMBIG,GREY,SYM)
C ------- PLACER UNE SEULE BUBBLE ----
      IMPLICIT LOGICAL (L)
      INTEGER PFACX,PFACY,PPOSX,PPOSY,PIXEL_X,PIXEL_Y
      CHARACTER*(*) SYM
      CHARACTER*23 STRING
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
      COMMON/LSYM/Lsquare,Llosange,Lxstar,Lpstar,
     &Lutri,Ldtri,Lumtri,Ldmtri,Lhardy,Llaurel,Lmpent,Lmhex,Lmmhex,
     &Lpent,Lhex,Lcircle,Lrgbsquare,Lrgblosange,Lrgbxstar,Lrgbpstar,
     &Lrgbutri,Lrgbdtri,Lrgbumtri,Lrgbdmtri,Lrgbhardy,Lrgblaurel,
     &Lrgbmpent,Lrgbmhex,Lrgbmmhex,Lrgbpent,Lrgbhex,Lrgbcircle,Larrow 
C ----- LOGICALS ------
         IF(SYM.EQ.'circle')Lcircle=.TRUE.
         IF(SYM.EQ.'square')Lsquare=.TRUE.
         IF(SYM.EQ.'losange')Llosange=.TRUE.
         IF(SYM.EQ.'xstar')Lxstar=.TRUE.
         IF(SYM.EQ.'pstar')Lpstar=.TRUE.
         IF(SYM.EQ.'utri')Lutri=.TRUE.
         IF(SYM.EQ.'dtri')Ldtri=.TRUE.
         IF(SYM.EQ.'umtri')Lumtri=.TRUE.
         IF(SYM.EQ.'dmtri')Ldmtri=.TRUE.
         IF(SYM.EQ.'hardy')Lhardy=.TRUE.
         IF(SYM.EQ.'laurel')Llaurel=.TRUE.
         IF(SYM.EQ.'mpent')Lmpent=.TRUE.
         IF(SYM.EQ.'mhex')Lmhex=.TRUE.
         IF(SYM.EQ.'pent')Lpent=.TRUE.
         IF(SYM.EQ.'hex')Lhex=.TRUE.
         IF(SYM.EQ.'mmhex')Lmmhex=.TRUE.
C ---------- ICI ON EST EN VERSION POSTSCRIPT --------
      FFAC=2.
         PPOSX=PIXEL_X(XX)
         PPOSY=PIXEL_Y(YY)
         REWIND 28
         WRITE(28,9932)PPOSX,PPOSY,AMMBIG*FFAC,GREY
 9932    FORMAT(2I5,1X,F6.2,1X,F5.2)
         REWIND 28
         READ(28,9933)STRING
 9933    FORMAT(A23)
         WRITE(29,*)STRING,' ',SYM 
         REWIND 28
C ---------- RETURN -------------
      RETURN
      END
 

C ********* SUBROUTINE AXEX ***********
        SUBROUTINE AXEX(X0,Y0,X1,X2,XD,K)
        IMPLICIT INTEGER (P)
        DIMENSION PLOTX(4),PLOTY(4)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
C ------- LONGUEUR DES CRETES --------
        P1=2*PFACY
        P2=5*PFACY
        PY0=PIXEL_Y(Y0)
C ------- PREPARATIONS INITIALES  ----------
        X1H=MAX(X1-1.E-5*(XMAX-XMIN),XMIN)
        X2H=MIN(X2+1.E-5*(XMAX-XMIN),XMAX)
        IF (X2H.LE.X1H) GOTO 77
        XDF=XD/K
        N1=(X1H-X0)/XDF
        N2=(X2H-X0)/XDF
        IF (X1H.LT.X0) N1=N1-1
        IF (X2H.LT.X0) N2=N2-1
        DO 5 I=1,4
  5     PLOTY(I)=PY0
        PX0=PIXEL_X(X1H)
C ------- LES INTERVALLES --------
        DO 10 I=N1,N2
        IF (MOD(I,K).EQ.0) THEN
           PLOTY(2)=PY0+P2
        ELSE
           PLOTY(2)=PY0+P1
        END IF
        PLOTX(1)=PX0
        PLOTX(2)=PX0
        PLOTX(3)=PX0
        IF (I.EQ.N1) PLOTY(2)=PY0
        IF (I.EQ.N2) THEN
           PLOTX(4)=PIXEL_X(X2H)
           CALL LINE_DRAW(PLOTX,PLOTY,4)
           GOTO 77
        END IF
        PX0=PIXEL_X(X0+(I+1)*XDF)
        PLOTX(4)=PX0
  10    CALL LINE_DRAW(PLOTX,PLOTY,4)
C --------- EXIT -----------
  77    CALL VIDANGE
        RETURN
        END

C ********* SUBROUTINE AXEY ***********
        SUBROUTINE AXEY(X0,Y0,Y1,Y2,YD,K)
        IMPLICIT INTEGER (P)
        DIMENSION PLOTX(4),PLOTY(4)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
C ------- LONGUEUR DES CRETES --------
        P1=2*PFACX
        P2=5*PFACX
        PX0=PIXEL_X(X0)
C ------- PREPARATIONS INITIALES  ----------
        Y1H=MAX(Y1-1.E-5*(YMAX-YMIN),YMIN)
        Y2H=MIN(Y2+1.E-5*(YMAX-YMIN),YMAX)
        IF (Y2H.LE.Y1H) GOTO 77
        YDF=YD/K
        N1=(Y1H-Y0)/YDF
        N2=(Y2H-Y0)/YDF
        IF (Y1H.LT.Y0) N1=N1-1
        IF (Y2H.LT.Y0) N2=N2-1
        DO 5 I=1,4
  5     PLOTX(I)=PX0
        PY0=PIXEL_Y(Y1H)
C ------- LES INTERVALLES --------
        DO 10 I=N1,N2
        IF (MOD(I,K).EQ.0) THEN
           PLOTX(2)=PX0+P2
        ELSE
           PLOTX(2)=PX0+P1
        END IF
        PLOTY(1)=PY0
        PLOTY(2)=PY0
        PLOTY(3)=PY0
        IF (I.EQ.N1) PLOTX(2)=PX0
        IF (I.EQ.N2) THEN
           PLOTY(4)=PIXEL_Y(Y2H)
           CALL LINE_DRAW(PLOTX,PLOTY,4)
           GOTO 77
        END IF
        PY0=PIXEL_Y(Y0+(I+1)*YDF)
        PLOTY(4)=PY0
  10    CALL LINE_DRAW(PLOTX,PLOTY,4)
C ------- EXIT -----------
  77    CALL VIDANGE
        RETURN
        END

C ******* SUBROUTINE CIRCLE ********
        SUBROUTINE CIRCLE(XOR,YOR,R)
        DIMENSION XDES(361),YDES(361)
            PI2=2.*3.14159265
            NDES=361
            DO 1 IX=1,NDES
            T=PI2*(IX-1)/FLOAT(NDES-1)
            XDES(IX)=XOR+R*COS(T)
            YDES(IX)=YOR+R*SIN(T)
    1       CONTINUE
            CALL LING(XDES,YDES,NDES)
            RETURN
        END

C *********** SUBROUTINE MOVE_PEN ************
        SUBROUTINE MOVE_PEN(X,Y)
C ----- MOVES PEN TO POINT X,Y --------
        IMPLICIT INTEGER (P)
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        PX=PIXEL_X(X)
        PY=PIXEL_Y(Y)
        WRITE(29,8492)PX,PY
 8492   FORMAT(I5,I5,' m')
        RETURN
        END

C *********** SUBROUTINE PLACE_PIXEL ************
        SUBROUTINE PLACE_PIXEL(X,Y)
C ----- PLACES PIXEL AT POINT X,Y --------
        IMPLICIT INTEGER (P)
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        PX=PIXEL_X(X)
        PY=PIXEL_Y(Y)
        WRITE(29,8492)PX,PY
 8492   FORMAT(I5,I5,' m',/,'s')
        RETURN
        END

C ********** SUBROUTINE TEXT(X,Y,CHAR) ***********
        SUBROUTINE TEXT(X,Y,CHAR)
C ----- WRITES TEXT "CHAR" STARTING AT POSITION X,Y ---------
        INTEGER PFACX,PFACY
        CHARACTER*(*) CHAR
        CHARACTER*80 CHALOC
        CHARACTER*1 SYMB(80)
        CHARACTER*1 TERM(2)
        CHARACTER*18 FORSH
        CHARACTER*22 FOREX
        CHARACTER*23 FORIN
        CHARACTER*1 FORSH2(18)
        CHARACTER*1 FOREX2(22)
        CHARACTER*1 FORIN2(23)
        CHARACTER*1 CHARCH(0:9)
        INTEGER ITERM
        LOGICAL DOLLAR
        LOGICAL LTEXT,LTEXTEXT
        EQUIVALENCE (TERM,ITERM)
        EQUIVALENCE (CHALOC,SYMB)
        EQUIVALENCE (FORSH,FORSH2)
        EQUIVALENCE (FOREX,FOREX2)
        EQUIVALENCE (FORIN,FORIN2)
        COMMON/PICTURE_LIMITS/XXMIN,XXMAX,YYMIN,YYMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/LTEXT/LTEXT,LTEXTEXT
        DATA CHARCH/'0','1','2','3','4','5','6','7','8','9'/
C ------- POSITION INITIALE -------
        XPOS=X
        YPOS=Y
        GOTO 15
C ------ ENTRY TEXT_RELAD 
C ----- WRITES TEXT "CHAR" STARTING AT POSITION X,Y
C        WITH 0<=X<=1 AND 0<=Y<=1 IN RELATIVE ADDRESS ---------
        ENTRY TEXT_RELAD(X,Y,CHAR)
        XPOS=XXMIN+X*XDEL
        YPOS=YYMIN+Y*YDEL
  15    CALL MOVE_PEN(XPOS,YPOS)
C ------- HP LASER ----------
        ENTRY TEXT_APPEND(CHAR)
C ------- ELIMINER BLANCS DE LA FIN ----------
      DO 41 I=1,80
  41  SYMB(I)=' '
      CHALOC=CHAR
      LENTOT=80
      DO 42 I=80,1,-1
      IF(SYMB(I).EQ.' ')THEN
         LENTOT=LENTOT-1
      ELSE
         GOTO 43
      END IF
  42  CONTINUE
C -------- COMPTER NOMBRE DE TERMES ------
  43  NLEN=LENTOT
      DO 44 I=1,80
      IF(SYMB(I).EQ.'^'.OR.SYMB(I).EQ.'_')NLEN=NLEN-1
      IF(SYMB(I).EQ.'$')NLEN=NLEN-2
  44  CONTINUE
C --------POSTSCRIPT -----------------
         LTEXT=.TRUE.
         FORSH='(''('',00A1,'')show'')'
         FOREX='(''('',00A1,'')exposhow'')'
         FORIN='(''('',00A1,'')indexshow'')'
         IF(SYMB(1).NE.'$')THEN
C -------- METTRE ROMAN FONTS ---------
            WRITE(29,8494)SCALEP
         END IF
         NFIRST=1
         NLAST=-100
         DOLLAR=.FALSE.
         ISHOW=0
         DO 59 I=1,LENTOT
         IF(DOLLAR)THEN
            IF(NLAST.GE.NFIRST)THEN
               NDIGIT=NLAST-NFIRST+1
               N1=NDIGIT/10
               N2=MOD(NDIGIT,10)
               FORSH2(6)=CHARCH(N1)
               FORSH2(7)=CHARCH(N2)
               FOREX2(6)=CHARCH(N1)
               FOREX2(7)=CHARCH(N2)
               FORIN2(6)=CHARCH(N1)
               FORIN2(7)=CHARCH(N2)
               IF(ISHOW.EQ.-1)WRITE(29,FORIN)(SYMB(J),J=NFIRST,NLAST)
               IF(ISHOW.EQ. 0)WRITE(29,FORSH)(SYMB(J),J=NFIRST,NLAST)
               IF(ISHOW.EQ. 1)WRITE(29,FOREX)(SYMB(J),J=NFIRST,NLAST)
            END IF
            IF(SYMB(I).EQ.'r')THEN
C ----------- METTRE ROMAN FONTS -------
               WRITE(29,8494)SCALEP
 8494   FORMAT('/Times-Roman findfont ',f10.3,' scalefont setfont')
            END IF
            IF(SYMB(I).EQ.'i')THEN
C ----------- METTRE ITALIC FONTS -------
               WRITE(29,8495)SCALEP
 8495  FORMAT('/Times-Italic findfont ',f10.3,' scalefont setfont')
            END IF
            IF(SYMB(I).EQ.'b')THEN
C ----------- METTRE BOLD FONTS -------
               WRITE(29,8496)SCALEP
 8496  FORMAT('/Times-Bold findfont ',f10.3,' scalefont setfont')
            END IF
            IF(SYMB(I).EQ.'s')THEN
C ----------- METTRE SYMBOLIC AND GREEK FONTS -------
               WRITE(29,8493)SCALEP
 8493  FORMAT('/Symbol findfont ',f10.3,' scalefont setfont')
            END IF
            NFIRST=I+1
            DOLLAR=.FALSE.
            GOTO 59
         END IF
         IF(SYMB(I).EQ.'^'.OR.SYMB(I).EQ.'~'.OR.SYMB(I).EQ.'_')THEN
            IF(NLAST.GE.NFIRST)THEN
               NDIGIT=NLAST-NFIRST+1
               N1=NDIGIT/10
               N2=MOD(NDIGIT,10)
               FORSH2(6)=CHARCH(N1)
               FORSH2(7)=CHARCH(N2)
               FOREX2(6)=CHARCH(N1)
               FOREX2(7)=CHARCH(N2)
               FORIN2(6)=CHARCH(N1)
               FORIN2(7)=CHARCH(N2)
               IF(ISHOW.EQ.-1)WRITE(29,FORIN)(SYMB(J),J=NFIRST,NLAST)
               IF(ISHOW.EQ. 0)WRITE(29,FORSH)(SYMB(J),J=NFIRST,NLAST)
               IF(ISHOW.EQ. 1)WRITE(29,FOREX)(SYMB(J),J=NFIRST,NLAST)
            END IF
         END IF
         IF(SYMB(I).EQ.'$')THEN
            DOLLAR=.TRUE.
            GOTO 59
         END IF
         IF(SYMB(I).EQ.'^')THEN
            ISHOW=1
            NFIRST=I+1
            GOTO 59
         END IF
         IF(SYMB(I).EQ.'~')THEN
            ISHOW=0
            NFIRST=I+1
            GOTO 59
         END IF
         IF(SYMB(I).EQ.'_')THEN
            ISHOW=-1
            NFIRST=I+1
            GOTO 59
         END IF
C --------- METTRE NOUVEL CHARACTER ---------
         NLAST=I
  59     CONTINUE
C -------- ECRIRE LE RESTE ---------------
         IF(NLAST.GE.NFIRST)THEN
            NDIGIT=NLAST-NFIRST+1
            N1=NDIGIT/10
            N2=MOD(NDIGIT,10)
            FORSH2(6)=CHARCH(N1)
            FORSH2(7)=CHARCH(N2)
            FOREX2(6)=CHARCH(N1)
            FOREX2(7)=CHARCH(N2)
            FORIN2(6)=CHARCH(N1)
            FORIN2(7)=CHARCH(N2)
            IF(ISHOW.EQ.-1)WRITE(29,FORIN)(SYMB(J),J=NFIRST,NLAST)
            IF(ISHOW.EQ. 0)WRITE(29,FORSH)(SYMB(J),J=NFIRST,NLAST)
            IF(ISHOW.EQ. 1)WRITE(29,FOREX)(SYMB(J),J=NFIRST,NLAST)
         END IF
         WRITE(29,*)'s'
      RETURN
      END

C ************ SUBROUTINE TEXT28 ****************
        SUBROUTINE TEXT28(X,Y)
C ------ TEXTE, QUI AVAIT ETE ECRIT SUR FILE 28, EST ENVOYE SUR PLOTTER
        CHARACTER*80 CPRINT
        CHARACTER*1 CREAD(80)
        EQUIVALENCE (CPRINT,CREAD)
        REWIND 28
        DO 1 I=1,80
    1   CREAD(I)=' '
        READ(28,99,END=3)(CREAD(I),I=1,80)
99      FORMAT(80A1)
  3     CONTINUE
        CALL TEXT(X,Y,CPRINT)
        REWIND 28
        RETURN
        END

C ************ SUBROUTINE TEXT28_RELAD ****************
        SUBROUTINE TEXT28_RELAD(X,Y)
C ------ COMME TEXT_28, MAIS AVEC ADRESSES RELATIVES -----------
        CHARACTER*80 CPRINT
        CHARACTER*1 CREAD(80)
        EQUIVALENCE (CPRINT,CREAD)
        REWIND 28
        DO 1 I=1,80
    1   CREAD(I)=' '
        READ(28,99,END=3)(CREAD(I),I=1,80)
99      FORMAT(80A1)
  3     CONTINUE
        CALL TEXT_RELAD(X,Y,CPRINT)
        REWIND 28
        RETURN
        END

C ************ SUBROUTINE TEXT28_APPEND ****************
        SUBROUTINE TEXT28_APPEND
C ------ COMME TEXT_28, SANS BOUGER PLUME -----------
        CHARACTER*80 CPRINT
        CHARACTER*1 CREAD(80)
        EQUIVALENCE (CPRINT,CREAD)
        REWIND 28
        DO 1 I=1,80
    1   CREAD(I)=' '
        READ(28,99,END=3)(CREAD(I),I=1,80)
99      FORMAT(80A1)
  3     CONTINUE
        CALL TEXT_APPEND(CPRINT)
        REWIND 28
        RETURN
        END

C ********** SUBROUTINE TEXT_LATEX(X,Y,ALAM,AMU,CHAR) ***********
        SUBROUTINE TEXT_LATEX(X,Y,ALAM,AMU,CHAR)
C ----- WRITES TEXT "CHAR" STARTING AT POSITION X,Y IN TEX MODE -------
        INTEGER PFACX,PFACY,PX,PY
        INTEGER PIXEL_X,PIXEL_Y
        CHARACTER*(*) CHAR
        LOGICAL LTEXT,LTEXTEXT
        COMMON/PICTURE_LIMITS/XXMIN,XXMAX,YYMIN,YYMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/LTEXT/LTEXT,LTEXTEXT
C ------
        ISHUTUP=1
        GOTO 10
C ------ ENTRY BEGIN_TEXT_RELAD_LATEX 
        ENTRY BEGIN_TEXT_LATEX(X,Y,ALAM,AMU,CHAR)
        ISHUTUP=0
C ------- POSITION INITIALE -------
  10    XPOS=X
        YPOS=Y
        GOTO 15
C ------ ENTRY TEXT_RELAD_LATEX 
C ----- WRITES TEXT "CHAR" STARTING AT POSITION X,Y
C        WITH 0<=X<=1 AND 0<=Y<=1 IN RELATIVE ADDRESS ---------
        ENTRY TEXT_RELAD_LATEX(X,Y,ALAM,AMU,CHAR)
        ISHUTUP=1
        GOTO 12
        ENTRY BEGIN_TEXT_RELAD_LATEX(X,Y,ALAM,AMU,CHAR)
        ISHUTUP=0
  12    XPOS=XXMIN+X*XDEL
        YPOS=YYMIN+Y*YDEL
  15    PX=PIXEL_X(XPOS)
        PY=PIXEL_Y(YPOS)
C ----- SHIFTPARAMETERS -----
      LAM100=ALAM*100
      MU100=AMU*100
C -------- WRITE POSTSCRIPT -----------------
      WRITE(27,*)'1 ',ISHUTUP,PX,PY,LAM100,MU100,' 0. 0. 0. 0.'
      WRITE(27,*)CHAR
      LTEXTEXT=.TRUE.
      RETURN
      END

C ****** SUBROUTINE TEXT_LATEX_R(X,Y,ALAM,AMU,ROT,CHAR) *******
        SUBROUTINE TEXT_LATEX_R(X,Y,ALAM,AMU,ROT,CHAR)
C ----- WRITES TEXT "CHAR" STARTING AT POSITION X,Y IN TEX MODE -----
        INTEGER PFACX,PFACY,PX,PY
        INTEGER PIXEL_X,PIXEL_Y
        CHARACTER*(*) CHAR
        LOGICAL LTEXT,LTEXTEXT
        COMMON/PICTURE_LIMITS/XXMIN,XXMAX,YYMIN,YYMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/LTEXT/LTEXT,LTEXTEXT
C ------
        ISHUTUP=1
        GOTO 10
C ------ ENTRY  
        ENTRY BEGIN_TEXT_LATEX_R(X,Y,ALAM,AMU,ROT,CHAR)
        ISHUTUP=0
C ------- POSITION INITIALE -------
  10    XPOS=X
        YPOS=Y
        GOTO 15
C ------ ENTRY  
C ----- WRITES TEXT "CHAR" STARTING AT POSITION X,Y
C        WITH 0<=X<=1 AND 0<=Y<=1 IN RELATIVE ADDRESS ---------
        ENTRY TEXT_RELAD_LATEX_R(X,Y,ALAM,AMU,ROT,CHAR)
        ISHUTUP=1
        GOTO 12
        ENTRY BEGIN_TEXT_RELAD_LATEX_R(X,Y,ALAM,AMU,ROT,CHAR)
        ISHUTUP=0
  12    XPOS=XXMIN+X*XDEL
        YPOS=YYMIN+Y*YDEL
  15    PX=PIXEL_X(XPOS)
        PY=PIXEL_Y(YPOS)
C ----- SHIFTPARAMETERS -----
      LAM100=ALAM*100
      MU100=AMU*100
C -------- WRITE POSTSCRIPT -----------------
      WRITE(27,*)'2 ',ISHUTUP,PX,PY,LAM100,MU100,ROT,' 0. 0. 0.'
      WRITE(27,*)CHAR
      LTEXTEXT=.TRUE.
      RETURN
      END

C ******* SUBROUTINE TEXT_LATEX_RG(X,Y,ALAM,AMU,ROT,GRAY,CHAR) *****
        SUBROUTINE TEXT_LATEX_RG(X,Y,ALAM,AMU,ROT,GRAY,CHAR)
C ----- WRITES TEXT "CHAR" STARTING AT POSITION X,Y IN TEX MODE ----
        INTEGER PFACX,PFACY,PX,PY
        INTEGER PIXEL_X,PIXEL_Y
        CHARACTER*(*) CHAR
        LOGICAL LTEXT,LTEXTEXT
        COMMON/PICTURE_LIMITS/XXMIN,XXMAX,YYMIN,YYMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/LTEXT/LTEXT,LTEXTEXT
C ------
        ISHUTUP=1
        GOTO 10
C ------ ENTRY  
        ENTRY BEGIN_TEXT_LATEX_RG(X,Y,ALAM,AMU,ROT,GRAY,CHAR)
        ISHUTUP=0
C ------- POSITION INITIALE -------
  10    XPOS=X
        YPOS=Y
        GOTO 15
C ------ ENTRY  
C ----- WRITES TEXT "CHAR" STARTING AT POSITION X,Y
C        WITH 0<=X<=1 AND 0<=Y<=1 IN RELATIVE ADDRESS ---------
        ENTRY TEXT_RELAD_LATEX_RG(X,Y,ALAM,AMU,ROT,GRAY,CHAR)
        ISHUTUP=1
        GOTO 12
        ENTRY BEGIN_TEXT_RELAD_LATEX_RG(X,Y,ALAM,AMU,ROT,GRAY,CHAR)
        ISHUTUP=0
  12    XPOS=XXMIN+X*XDEL
        YPOS=YYMIN+Y*YDEL
  15    PX=PIXEL_X(XPOS)
        PY=PIXEL_Y(YPOS)
C ----- SHIFTPARAMETERS -----
      LAM100=ALAM*100
      MU100=AMU*100
C -------- WRITE POSTSCRIPT -----------------
      WRITE(27,*)'3 ',ISHUTUP,PX,PY,LAM100,MU100,ROT,GRAY,' 0. 0.'
      WRITE(27,*)CHAR
      LTEXTEXT=.TRUE.
      RETURN
      END

C ** SUBROUTINE TEXT_LATEX_RRGB(X,Y,ALAM,AMU,ROT,RED,GREEN,BLUE,CHAR) **
      SUBROUTINE TEXT_LATEX_RRGB(X,Y,ALAM,AMU,ROT,RED,GREEN,BLUE,CHAR)
C ----- WRITES TEXT "CHAR" STARTING AT POSITION X,Y IN TEX MODE ----
        INTEGER PFACX,PFACY,PX,PY
        INTEGER PIXEL_X,PIXEL_Y
        CHARACTER*(*) CHAR
        LOGICAL LTEXT,LTEXTEXT
        COMMON/PICTURE_LIMITS/XXMIN,XXMAX,YYMIN,YYMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/LTEXT/LTEXT,LTEXTEXT
C ------
        ISHUTUP=1
        GOTO 10
C ------ ENTRY  
        ENTRY BEGIN_TEXT_LATEX_RRGB
     &(X,Y,ALAM,AMU,ROT,RED,GREEN,BLUE,CHAR)
        ISHUTUP=0
C ------- POSITION INITIALE -------
  10    XPOS=X
        YPOS=Y
        GOTO 15
C ------ ENTRY  
C ----- WRITES TEXT "CHAR" STARTING AT POSITION X,Y
C        WITH 0<=X<=1 AND 0<=Y<=1 IN RELATIVE ADDRESS ---------
        ENTRY TEXT_RELAD_LATEX_RRGB
     &(X,Y,ALAM,AMU,ROT,RED,GREEN,BLUE,CHAR)
        ISHUTUP=1
        GOTO 12
        ENTRY BEGIN_TEXT_RELAD_LATEX_RRGB
     &(X,Y,ALAM,AMU,ROT,RED,GREEN,BLUE,CHAR)
        ISHUTUP=0
  12    XPOS=XXMIN+X*XDEL
        YPOS=YYMIN+Y*YDEL
  15    PX=PIXEL_X(XPOS)
        PY=PIXEL_Y(YPOS)
C ----- SHIFTPARAMETERS -----
      LAM100=ALAM*100
      MU100=AMU*100
C -------- WRITE POSTSCRIPT -----------------
      WRITE(27,*)'4 ',ISHUTUP,PX,PY,LAM100,MU100,ROT,RED,GREEN,BLUE
      WRITE(27,*)CHAR
      LTEXTEXT=.TRUE.
      RETURN
      END

C ********** SUBROUTINES TEXT_LATEX_W ***********
        SUBROUTINE TEXT_LATEX_W(X,Y,ALAM,AMU,CHAR)
C ----- WRITES TEXT "CHAR" IN WHITE BOX -------
        CHARACTER*(*) CHAR
        ROT=0.
        GRAY=1.
        CALL TEXT_LATEX_RG(X,Y,ALAM,AMU,ROT,GRAY,CHAR)
        RETURN
        END
        SUBROUTINE TEXT_RELAD_LATEX_W(X,Y,ALAM,AMU,CHAR)
C ----- WRITES TEXT "CHAR" IN WHITE BOX -------
        CHARACTER*(*) CHAR
        ROT=0.
        GRAY=1.
        CALL TEXT_RELAD_LATEX_RG(X,Y,ALAM,AMU,ROT,GRAY,CHAR)
        RETURN
        END
        SUBROUTINE BEGIN_TEXT_LATEX_W(X,Y,ALAM,AMU,CHAR)
C ----- WRITES TEXT "CHAR" IN WHITE BOX -------
        CHARACTER*(*) CHAR
        ROT=0.
        GRAY=1.
        CALL BEGIN_TEXT_LATEX_RG(X,Y,ALAM,AMU,ROT,GRAY,CHAR)
        RETURN
        END
        SUBROUTINE BEGIN_TEXT_RELAD_LATEX_W(X,Y,ALAM,AMU,CHAR)
C ----- WRITES TEXT "CHAR" IN WHITE BOX -------
        CHARACTER*(*) CHAR
        ROT=0.
        GRAY=1.
        CALL BEGIN_TEXT_RELAD_LATEX_RG(X,Y,ALAM,AMU,ROT,GRAY,CHAR)
        RETURN
        END



      SUBROUTINE CONTINUE_TEXT_LATEX(CHAR)
        CHARACTER*(*) CHAR
        WRITE(27,*)'9 0 0 0 0 0 0. 0. 0. 0.'
        WRITE(27,*)CHAR
      RETURN
      END

      SUBROUTINE END_TEXT_LATEX(CHAR)
        CHARACTER*(*) CHAR
        WRITE(27,*)'9 1 0 0 0 0 0. 0. 0. 0.'
        WRITE(27,*)CHAR
      RETURN
      END

C ********** SUBROUTINE THICK_MARGIN  **************
      SUBROUTINE THICK_BORDER(THICKNESS) 
C ----- SET THICKNESS (IN POINTS) OF WHITE BORDER OF TEXT_LATEX_W
      IMPLICIT LOGICAL (L)
      COMMON/Lf90true/Lf90true
      SCALE=THICKNESS*25.4/72.27
        WRITE(27,*)'9 0 0 0 0 0 0. 0. 0. 0.'
      IF(Lf90true)THEN
       WRITE(27,9850)SCALE
      ELSE
       WRITE(27,9950)SCALE
      END IF
9850  FORMAT(' \GGGborder',F6.2,'mm')
9950  FORMAT(' \\GGGborder',F6.2,'mm')
      RETURN
      END

C ********** SUBROUTINE TEXT_W(X,Y,CHAR) ***********
        SUBROUTINE TEXT_W(X,Y,CHAR)
C ----- WRITES TEXT "CHAR" STARTING AT POSITION X,Y ---------
C ----  WITH WHITE BACK-GROUND ---------- 
        INTEGER PFACX,PFACY
        INTEGER PIXEL_X,PIXEL_Y,PX,PY,PPY
        CHARACTER*(*) CHAR
        CHARACTER*80 CHALOC
        CHARACTER*1 SYMB(80)
        CHARACTER*1 TERM(2)
        CHARACTER*18 FORSH
        CHARACTER*22 FOREX
        CHARACTER*23 FORIN
        CHARACTER*1 FORSH2(18)
        CHARACTER*1 FOREX2(22)
        CHARACTER*1 FORIN2(23)
        CHARACTER*1 CHARCH(0:9)
        INTEGER ITERM
        LOGICAL DOLLAR
        LOGICAL LTEXT,LTEXTEXT
        EQUIVALENCE (TERM,ITERM)
        EQUIVALENCE (CHALOC,SYMB)
        EQUIVALENCE (FORSH,FORSH2)
        EQUIVALENCE (FOREX,FOREX2)
        EQUIVALENCE (FORIN,FORIN2)
        COMMON/PICTURE_LIMITS/XXMIN,XXMAX,YYMIN,YYMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/LTEXT/LTEXT,LTEXTEXT
        DATA CHARCH/'0','1','2','3','4','5','6','7','8','9'/
C ------- POSITION INITIALE -------
        XPOS=X
        YPOS=Y
        GOTO 15
C ------ ENTRY TEXT_RELAD_W 
C ----- WRITES TEXT "CHAR" STARTING AT POSITION X,Y
C        WITH 0<=X<=1 AND 0<=Y<=1 IN RELATIVE ADDRESS ---------
        ENTRY TEXT_RELAD_W(X,Y,CHAR)
        XPOS=XXMIN+X*XDEL
        YPOS=YYMIN+Y*YDEL
  15    CALL MOVE_PEN(XPOS,YPOS)
        ENTRY TEXT_APPEND_W(CHAR)
C ------- ELIMINER BLANCS DE LA FIN ----------
      DO 41 I=1,80
  41  SYMB(I)=' '
      CHALOC=CHAR
      LENTOT=80
      DO 42 I=80,1,-1
      IF(SYMB(I).EQ.' ')THEN
         LENTOT=LENTOT-1
      ELSE
         GOTO 43
      END IF
  42  CONTINUE
C -------- COMPTER NOMBRE DE TERMES ------
  43  NLEN=LENTOT
      DO 44 I=1,80
      IF(SYMB(I).EQ.'^'.OR.SYMB(I).EQ.'_')NLEN=NLEN-1
      IF(SYMB(I).EQ.'$')NLEN=NLEN-2
  44  CONTINUE
C --------POSTSCRIPT -----------------
         LTEXT=.TRUE.
       DO 69 ICASE=1,2
         IF(ICASE.EQ.1)WRITE(29,*)'gsave'
         IF(ICASE.EQ.2)WRITE(29,*)'grestore'
         FORSH='(''('',00A1,'')show'')'
         FOREX='(''('',00A1,'')exposhow'')'
         FORIN='(''('',00A1,'')indexshow'')'
         IF(SYMB(1).NE.'$')THEN
C -------- METTRE ROMAN FONTS ---------
            WRITE(29,8494)SCALEP
         END IF
         NFIRST=1
         NLAST=-100
         DOLLAR=.FALSE.
         ISHOW=0
         DO 59 I=1,LENTOT
         IF(DOLLAR)THEN
            IF(NLAST.GE.NFIRST)THEN
               NDIGIT=NLAST-NFIRST+1
               N1=NDIGIT/10
               N2=MOD(NDIGIT,10)
               FORSH2(6)=CHARCH(N1)
               FORSH2(7)=CHARCH(N2)
               FOREX2(6)=CHARCH(N1)
               FOREX2(7)=CHARCH(N2)
               FORIN2(6)=CHARCH(N1)
               FORIN2(7)=CHARCH(N2)
               IF(ISHOW.EQ.-1)WRITE(29,FORIN)(SYMB(J),J=NFIRST,NLAST)
               IF(ISHOW.EQ. 0)WRITE(29,FORSH)(SYMB(J),J=NFIRST,NLAST)
               IF(ISHOW.EQ. 1)WRITE(29,FOREX)(SYMB(J),J=NFIRST,NLAST)
            END IF
            IF(SYMB(I).EQ.'r')THEN
C ----------- METTRE ROMAN FONTS -------
               WRITE(29,8494)SCALEP
 8494  FORMAT('/Times-Roman findfont ',f10.3,' scalefont setfont')
            END IF
            IF(SYMB(I).EQ.'i')THEN
C ----------- METTRE ITALIC FONTS -------
               WRITE(29,8495)SCALEP
 8495  FORMAT('/Times-Italic findfont ',f10.3,' scalefont setfont')
            END IF
            IF(SYMB(I).EQ.'b')THEN
C ----------- METTRE BOLD FONTS -------
               WRITE(29,8496)SCALEP
 8496  FORMAT('/Times-Bold findfont ',f10.3,' scalefont setfont')
            END IF
            IF(SYMB(I).EQ.'s')THEN
C ----------- METTRE SYMBOLIC AND GREEK FONTS -------
               WRITE(29,8493)SCALEP
 8493  FORMAT('/Symbol findfont ',f10.3,' scalefont setfont')
            END IF
            NFIRST=I+1
            DOLLAR=.FALSE.
            GOTO 59
         END IF
         IF(SYMB(I).EQ.'^'.OR.SYMB(I).EQ.'~'.OR.SYMB(I).EQ.'_')THEN
            IF(NLAST.GE.NFIRST)THEN
               NDIGIT=NLAST-NFIRST+1
               N1=NDIGIT/10
               N2=MOD(NDIGIT,10)
               FORSH2(6)=CHARCH(N1)
               FORSH2(7)=CHARCH(N2)
               FOREX2(6)=CHARCH(N1)
               FOREX2(7)=CHARCH(N2)
               FORIN2(6)=CHARCH(N1)
               FORIN2(7)=CHARCH(N2)
               IF(ISHOW.EQ.-1)WRITE(29,FORIN)(SYMB(J),J=NFIRST,NLAST)
               IF(ISHOW.EQ. 0)WRITE(29,FORSH)(SYMB(J),J=NFIRST,NLAST)
               IF(ISHOW.EQ. 1)WRITE(29,FOREX)(SYMB(J),J=NFIRST,NLAST)
            END IF
         END IF
         IF(SYMB(I).EQ.'$')THEN
            DOLLAR=.TRUE.
            GOTO 59
         END IF
         IF(SYMB(I).EQ.'^')THEN
            ISHOW=1
            NFIRST=I+1
            GOTO 59
         END IF
         IF(SYMB(I).EQ.'~')THEN
            ISHOW=0
            NFIRST=I+1
            GOTO 59
         END IF
         IF(SYMB(I).EQ.'_')THEN
            ISHOW=-1
            NFIRST=I+1
            GOTO 59
         END IF
C --------- METTRE NOUVEL CHARACTER ---------
         NLAST=I
  59     CONTINUE
C -------- ECRIRE LE RESTE ---------------
         IF(NLAST.GE.NFIRST)THEN
            NDIGIT=NLAST-NFIRST+1
            N1=NDIGIT/10
            N2=MOD(NDIGIT,10)
            FORSH2(6)=CHARCH(N1)
            FORSH2(7)=CHARCH(N2)
            FOREX2(6)=CHARCH(N1)
            FOREX2(7)=CHARCH(N2)
            FORIN2(6)=CHARCH(N1)
            FORIN2(7)=CHARCH(N2)
            IF(ISHOW.EQ.-1)WRITE(29,FORIN)(SYMB(J),J=NFIRST,NLAST)
            IF(ISHOW.EQ. 0)WRITE(29,FORSH)(SYMB(J),J=NFIRST,NLAST)
            IF(ISHOW.EQ. 1)WRITE(29,FOREX)(SYMB(J),J=NFIRST,NLAST)
         END IF
C -------- PLACE WHITE BOX -----------
         IF(ICASE.EQ.1)THEN
C            BORD=0.08
            BORD=0.2
            ADEL=BORD*SCALEP
            WRITE(29,8859)ADEL,-ADEL
 8859 FORMAT('currentpoint',/,'exch ',f10.2,' add exch ',f10.2,
     &' add m')
            WRITE(29,8860)SCALEP*(0.71+2*BORD)
 8860 FORMAT('0 ',F10.2,' rlineto')
            PX=PIXEL_X(XPOS)-SCALEP*BORD
            PY=PIXEL_Y(YPOS)-SCALEP*BORD
            PPY=PY+SCALEP*(0.71+2*BORD)
            WRITE(29,8861)PX,PPY
            WRITE(29,8861)PX,PY
 8861 FORMAT(I5,I5,' l')
            WRITE(29,*)'closepath'
            WRITE(29,*)'1. setgray'
            WRITE(29,*)'fill'
            WRITE(29,*)'0. setgray'
         END IF
         IF(ICASE.EQ.2)WRITE(29,*)'s'
  69     CONTINUE
      RETURN
      END

C ********** SUBROUTINE TEXT_WW(X,Y,CHAR) ***********
        SUBROUTINE TEXT_WW(X,Y,CHAR)
C ----- WRITES TEXT "CHAR" STARTING AT POSITION X,Y ---------
C ----  WITH WHITE BACK-GROUND ---------- 
        INTEGER PFACX,PFACY
        INTEGER PIXEL_X,PIXEL_Y,PX,PY,PPY
        CHARACTER*(*) CHAR
        CHARACTER*80 CHALOC
        CHARACTER*1 SYMB(80)
        CHARACTER*1 TERM(2)
        CHARACTER*18 FORSH
        CHARACTER*22 FOREX
        CHARACTER*23 FORIN
        CHARACTER*1 FORSH2(18)
        CHARACTER*1 FOREX2(22)
        CHARACTER*1 FORIN2(23)
        CHARACTER*1 CHARCH(0:9)
        INTEGER ITERM
        LOGICAL DOLLAR
        LOGICAL LTEXT,LTEXTEXT
        EQUIVALENCE (TERM,ITERM)
        EQUIVALENCE (CHALOC,SYMB)
        EQUIVALENCE (FORSH,FORSH2)
        EQUIVALENCE (FOREX,FOREX2)
        EQUIVALENCE (FORIN,FORIN2)
        COMMON/PICTURE_LIMITS/XXMIN,XXMAX,YYMIN,YYMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/LTEXT/LTEXT,LTEXTEXT
        DATA CHARCH/'0','1','2','3','4','5','6','7','8','9'/
C ------- POSITION INITIALE -------
        XPOS=X
        YPOS=Y
        GOTO 15
C ------ ENTRY TEXT_RELAD_WW 
C ----- WRITES TEXT "CHAR" STARTING AT POSITION X,Y
C        WITH 0<=X<=1 AND 0<=Y<=1 IN RELATIVE ADDRESS ---------
        ENTRY TEXT_RELAD_WW(X,Y,CHAR)
        XPOS=XXMIN+X*XDEL
        YPOS=YYMIN+Y*YDEL
  15    CALL MOVE_PEN(XPOS,YPOS)
        ENTRY TEXT_APPEND_WW(CHAR)
C ------- ELIMINER BLANCS DE LA FIN ----------
      DO 41 I=1,80
  41  SYMB(I)=' '
      CHALOC=CHAR
      LENTOT=80
      DO 42 I=80,1,-1
      IF(SYMB(I).EQ.' ')THEN
         LENTOT=LENTOT-1
      ELSE
         GOTO 43
      END IF
  42  CONTINUE
C -------- COMPTER NOMBRE DE TERMES ------
  43  NLEN=LENTOT
      DO 44 I=1,80
      IF(SYMB(I).EQ.'^'.OR.SYMB(I).EQ.'_')NLEN=NLEN-1
      IF(SYMB(I).EQ.'$')NLEN=NLEN-2
  44  CONTINUE
C --------POSTSCRIPT -----------------
         LTEXT=.TRUE.
       DO 69 ICASE=1,2
         IF(ICASE.EQ.2)CALL MOVE_PEN(XPOS,YPOS)
         FORSH='(''('',00A1,'')show'')'
         FOREX='(''('',00A1,'')exposhow'')'
         FORIN='(''('',00A1,'')indexshow'')'
         IF(SYMB(1).NE.'$')THEN
C -------- METTRE ROMAN FONTS ---------
            WRITE(29,8494)SCALEP
         END IF
         NFIRST=1
         NLAST=-100
         DOLLAR=.FALSE.
         ISHOW=0
         DO 59 I=1,LENTOT
         IF(DOLLAR)THEN
            IF(NLAST.GE.NFIRST)THEN
               NDIGIT=NLAST-NFIRST+1
               N1=NDIGIT/10
               N2=MOD(NDIGIT,10)
               FORSH2(6)=CHARCH(N1)
               FORSH2(7)=CHARCH(N2)
               FOREX2(6)=CHARCH(N1)
               FOREX2(7)=CHARCH(N2)
               FORIN2(6)=CHARCH(N1)
               FORIN2(7)=CHARCH(N2)
               IF(ISHOW.EQ.-1)WRITE(29,FORIN)(SYMB(J),J=NFIRST,NLAST)
               IF(ISHOW.EQ. 0)WRITE(29,FORSH)(SYMB(J),J=NFIRST,NLAST)
               IF(ISHOW.EQ. 1)WRITE(29,FOREX)(SYMB(J),J=NFIRST,NLAST)
            END IF
            IF(SYMB(I).EQ.'r')THEN
C ----------- METTRE ROMAN FONTS -------
               WRITE(29,8494)SCALEP
 8494  FORMAT('/Times-Roman findfont ',f10.3,' scalefont setfont')
            END IF
            IF(SYMB(I).EQ.'i')THEN
C ----------- METTRE ITALIC FONTS -------
               WRITE(29,8495)SCALEP
 8495  FORMAT('/Times-Italic findfont ',f10.3,' scalefont setfont')
            END IF
            IF(SYMB(I).EQ.'b')THEN
C ----------- METTRE BOLD FONTS -------
               WRITE(29,8496)SCALEP
 8496  FORMAT('/Times-Bold findfont ',f10.3,' scalefont setfont')
            END IF
            IF(SYMB(I).EQ.'s')THEN
C ----------- METTRE SYMBOLIC AND GREEK FONTS -------
               WRITE(29,8493)SCALEP
 8493  FORMAT('/Symbol findfont ',f10.3,' scalefont setfont')
            END IF
            NFIRST=I+1
            DOLLAR=.FALSE.
            GOTO 59
         END IF
         IF(SYMB(I).EQ.'^'.OR.SYMB(I).EQ.'~'.OR.SYMB(I).EQ.'_')THEN
            IF(NLAST.GE.NFIRST)THEN
               NDIGIT=NLAST-NFIRST+1
               N1=NDIGIT/10
               N2=MOD(NDIGIT,10)
               FORSH2(6)=CHARCH(N1)
               FORSH2(7)=CHARCH(N2)
               FOREX2(6)=CHARCH(N1)
               FOREX2(7)=CHARCH(N2)
               FORIN2(6)=CHARCH(N1)
               FORIN2(7)=CHARCH(N2)
               IF(ISHOW.EQ.-1)WRITE(29,FORIN)(SYMB(J),J=NFIRST,NLAST)
               IF(ISHOW.EQ. 0)WRITE(29,FORSH)(SYMB(J),J=NFIRST,NLAST)
               IF(ISHOW.EQ. 1)WRITE(29,FOREX)(SYMB(J),J=NFIRST,NLAST)
            END IF
         END IF
         IF(SYMB(I).EQ.'$')THEN
            DOLLAR=.TRUE.
            GOTO 59
         END IF
         IF(SYMB(I).EQ.'^')THEN
            ISHOW=1
            NFIRST=I+1
            GOTO 59
         END IF
         IF(SYMB(I).EQ.'~')THEN
            ISHOW=0
            NFIRST=I+1
            GOTO 59
         END IF
         IF(SYMB(I).EQ.'_')THEN
            ISHOW=-1
            NFIRST=I+1
            GOTO 59
         END IF
C --------- METTRE NOUVEL CHARACTER ---------
         NLAST=I
  59     CONTINUE
C -------- ECRIRE LE RESTE ---------------
         IF(NLAST.GE.NFIRST)THEN
            NDIGIT=NLAST-NFIRST+1
            N1=NDIGIT/10
            N2=MOD(NDIGIT,10)
            FORSH2(6)=CHARCH(N1)
            FORSH2(7)=CHARCH(N2)
            FOREX2(6)=CHARCH(N1)
            FOREX2(7)=CHARCH(N2)
            FORIN2(6)=CHARCH(N1)
            FORIN2(7)=CHARCH(N2)
            IF(ISHOW.EQ.-1)WRITE(29,FORIN)(SYMB(J),J=NFIRST,NLAST)
            IF(ISHOW.EQ. 0)WRITE(29,FORSH)(SYMB(J),J=NFIRST,NLAST)
            IF(ISHOW.EQ. 1)WRITE(29,FOREX)(SYMB(J),J=NFIRST,NLAST)
         END IF
C -------- PLACE WHITE BOX -----------
         IF(ICASE.EQ.1)THEN
C            BORD=0.08
            BORD=0.2
            ADEL=BORD*SCALEP
            WRITE(29,8859)ADEL,-2.*ADEL
 8859 FORMAT('currentpoint',/,'exch ',f10.2,' add exch ',f10.2,
     &' add m')
            WRITE(29,8860)SCALEP*(0.71+3.*BORD)
 8860 FORMAT('0 ',F10.2,' rlineto')
            PX=PIXEL_X(XPOS)-SCALEP*BORD
            PY=PIXEL_Y(YPOS)-SCALEP*2.*BORD
            PPY=PY+SCALEP*(0.71+3.*BORD)
            WRITE(29,8861)PX,PPY
            WRITE(29,8861)PX,PY
 8861 FORMAT(I5,I5,' l')
            WRITE(29,*)'closepath'
            WRITE(29,*)'1. setgray'
            WRITE(29,*)'fill'
            WRITE(29,*)'0. setgray'
         END IF
         IF(ICASE.EQ.2)WRITE(29,*)'s'
  69     CONTINUE
      RETURN
      END

C ************ SUBROUTINE TEXT28_W ****************
        SUBROUTINE TEXT28_W(X,Y)
C ------ TEXTE, QUI AVAIT ETE ECRIT SUR FILE 28, EST ENVOYE SUR PLOTTER
C ------ WITH WHITE BACK-GROUND ---------
        CHARACTER*80 CPRINT
        CHARACTER*1 CREAD(80)
        EQUIVALENCE (CPRINT,CREAD)
        REWIND 28
        DO 1 I=1,80
    1   CREAD(I)=' '
        READ(28,99,END=3)(CREAD(I),I=1,80)
99      FORMAT(80A1)
  3     CONTINUE
        CALL TEXT_W(X,Y,CPRINT)
        REWIND 28
        RETURN
        END

C ************ SUBROUTINE TEXT28_RELAD_W ****************
        SUBROUTINE TEXT28_RELAD_W(X,Y)
C ------ COMME TEXT_28_W, MAIS AVEC ADRESSES RELATIVES -----------
        CHARACTER*80 CPRINT
        CHARACTER*1 CREAD(80)
        EQUIVALENCE (CPRINT,CREAD)
        REWIND 28
        DO 1 I=1,80
    1   CREAD(I)=' '
        READ(28,99,END=3)(CREAD(I),I=1,80)
99      FORMAT(80A1)
  3     CONTINUE
        CALL TEXT_RELAD_W(X,Y,CPRINT)
        REWIND 28
        RETURN
        END
 
C ************ SUBROUTINE TEXT28_RELAD_W ****************
        SUBROUTINE TEXT28_APPEND_W
C ------ COMME TEXT_28_W, MAIS AVEC ADRESSES RELATIVES -----------
        CHARACTER*80 CPRINT
        CHARACTER*1 CREAD(80)
        EQUIVALENCE (CPRINT,CREAD)
        REWIND 28
        DO 1 I=1,80
    1   CREAD(I)=' '
        READ(28,99,END=3)(CREAD(I),I=1,80)
99      FORMAT(80A1)
  3     CONTINUE
        CALL TEXT_APPEND_W(CPRINT)
        REWIND 28
        RETURN
        END
 


C ************ SUBROUTINE SCALE_CHAR(SCALE) *********
        SUBROUTINE SCALE_CHAR(SCALE)
C ------- CHARACTER SIZE = "OPTIONAL" TIMES "SCALE" --------
        IMPLICIT INTEGER (P)
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
            SCALEP=SCALE*100.
            SCALEX=SCALEP*0.5
            SCALEY=SCALEP*0.71
        RETURN
        END

C ********* SUBROUTINE LABEL_X ***********
        SUBROUTINE LABEL_X(X0,Y0,X1,X2,XD,IDIGIT)
C ------- LABEL AXE X, IDIGIT=DECIMAL FIELD WIDTH (0<=IDIGIT<=7) ------
        IMPLICIT INTEGER (P)
        CHARACTER*1 TERM(2)
        CHARACTER*18 PSFMF
        CHARACTER*1 PSFMF2(18)
        CHARACTER*16 PSFMI
        CHARACTER*1 PSFMI2(16)
        CHARACTER*1 CHARCH(9)
        INTEGER ITERM
        EQUIVALENCE (TERM,ITERM)
        EQUIVALENCE (PSFMF,PSFMF2)
        EQUIVALENCE (PSFMI,PSFMI2)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        DATA CHARCH/'1','2','3','4','5','6','7','8','9'/
C ------- PREPARATIONS INITIALES  ---------- 
C -------- DEFINITION OF TERMINATION CHARACTER ----
        ITERM=3
C -------- DEFINE FONTS ----------
         WRITE(29,9493)SCALEP
 9493    FORMAT('/Symbol findfont ',f10.3,' scalefont setfont')
C 9493    FORMAT('/Symbol findfont ',es12.4,' scalefont setfont')
        X1H=MAX(X1-1.E-5*(XMAX-XMIN),XMIN)
        X2H=MIN(X2+1.E-5*(XMAX-XMIN),XMAX)
        IF (X2H.LE.X1H) RETURN
        N1=(X1H-X0)/XD
        N2=(X2H-X0)/XD
        IF(N1.GT.N2)RETURN
        IF((N2-N1).GT.30)THEN
            WRITE(6,*)' label_x, too many labels,.. n1,n2=',n1,n2
            RETURN
        END IF
        DO 7 I=N1-2,N2+2
        XPOS=X0+I*XD
        IF(XPOS.LT.X1H)GOTO 7
        IF(XPOS.GT.X2H)GOTO 7
C -------- DETERMINER FORMAT --------------
        IDIGIS=MAX(0,MIN(7,IDIGIT))
        IF(IDIGIS.GT.0)THEN
            ITOT=IDIGIS+1
        ELSE
            IXPOS=XPOS+SIGN(.499,XPOS)
            ITOT=0
        END IF
        XABS=ABS(XPOS)
        IF(XABS.GE.1.)ITOT=ITOT+1
        IF(XABS.GE.10.)ITOT=ITOT+1
        IF(XABS.GE.100.)ITOT=ITOT+1
        IF(XABS.GE.1000.)ITOT=ITOT+1
        IF(XABS.GE.10000.)ITOT=ITOT+1
        IF(XABS.GE.100000.)ITOT=ITOT+1
        IF(XPOS.LT.0.)ITOT=ITOT+1
        ITOT=MAX(1,ITOT)
        TOT=ITOT
        DELX=-TOT/3.-(TOT-1)/6.
        DELY=-1.
        IF(ITOT.GT.9)THEN
            WRITE(6,*)' label_x, labels too long,.. itot=',itot
            RETURN
        END IF
C -------- DEPLACER PLUME -------------
        CALL MOVE_PEN(XPOS,Y0)
C -------- PLACER LABELS POUR POSTSCRIPT -------
        IF(IDIGIS.GT.0)THEN
            TOT=ITOT-0.5
         ELSE
            TOT=ITOT
         END IF
         DELX=-SCALEP*0.5*0.5*TOT
         DELY=-1.*SCALEP
        WRITE(29,8765)DELX,DELY
 8765   FORMAT(F7.0,' ',F7.0,' rmoveto')
C ------ ICI ON DESSINE UN INTEGER ---------
        IF(IDIGIS.EQ.0)THEN
            PSFMI='(''('',I0,'')show'')'
            PSFMI2(7)=CHARCH(ITOT)
            WRITE(29,PSFMI)IXPOS
        END IF
C --------- ICI ON DESSINE UN FLOATING --------
        IF(IDIGIS.GT.0)THEN
            PSFMF='(''('',F0.0,'')show'')'
cc            PSFMF='(''('',E0.0,'')show'')'
            PSFMF2(7)=CHARCH(ITOT)
            PSFMF2(9)=CHARCH(IDIGIS)
            WRITE(29,PSFMF)XPOS
        END IF
    7   CONTINUE
        RETURN
        END



C ********* SUBROUTINE LABEL_Y ***********
        SUBROUTINE LABEL_Y(X0,Y0,Y1,Y2,YD,IDIGIT)
C ------- LABEL AXE Y, IDIGIT=DECIMAL FIELD WIDTH (0<=IDIGIT<=7) ------
        IMPLICIT INTEGER (P)
        CHARACTER*1 TERM(2)
        CHARACTER*18 PSFMF
        CHARACTER*1 PSFMF2(18)
        CHARACTER*16 PSFMI
        CHARACTER*1 PSFMI2(16)
        CHARACTER*1 CHARCH(9)
        INTEGER ITERM
        EQUIVALENCE (TERM,ITERM)
        EQUIVALENCE (PSFMF,PSFMF2)
        EQUIVALENCE (PSFMI,PSFMI2)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        DATA CHARCH/'1','2','3','4','5','6','7','8','9'/
C ------- PREPARATIONS INITIALES  ---------- 
C -------- DEFINITION OF TERMINATION CHARACTER ----
        ITERM=3
C -------- DEFINE FONTS ----------
         WRITE(29,9493)SCALEP
 9493    FORMAT('/Symbol findfont ',f10.3,' scalefont setfont')
        Y1H=MAX(Y1-1.E-5*(YMAX-YMIN),YMIN)
        Y2H=MIN(Y2+1.E-5*(YMAX-YMIN),YMAX)
        IF (Y2H.LE.Y1H) RETURN
        N1=(Y1H-Y0)/YD
        N2=(Y2H-Y0)/YD
        IF(N1.GT.N2)RETURN
        IF((N2-N1).GT.30)THEN
            WRITE(6,*)' label_Y, too many labels,.. n1,n2=',n1,n2
            RETURN
        END IF
        DO 7 I=N1-2,N2+2
        YPOS=Y0+I*YD
        IF(YPOS.LT.Y1H)GOTO 7
        IF(YPOS.GT.Y2H)GOTO 7
C -------- DETERMINER FORMAT --------------
        IDIGIS=MAX(0,MIN(7,IDIGIT))
        IF(IDIGIS.GT.0)THEN
            ITOT=IDIGIS+1
        ELSE
            IYPOS=YPOS+SIGN(.499,YPOS)
            ITOT=0
        END IF
        YABS=ABS(YPOS)
        IF(YABS.GE.1.)ITOT=ITOT+1
        IF(YABS.GE.10.)ITOT=ITOT+1
        IF(YABS.GE.100.)ITOT=ITOT+1
        IF(YABS.GE.1000.)ITOT=ITOT+1
        IF(YABS.GE.10000.)ITOT=ITOT+1
        IF(YABS.GE.100000.)ITOT=ITOT+1
        IF(YPOS.LT.0.)ITOT=ITOT+1
        ITOT=MAX(1,ITOT)
        TOT=ITOT
        DELX=-TOT-1.
        DELY=-0.25
        IF(ITOT.GT.9)THEN
            WRITE(6,*)' label_Y, labels too long,.. itot=',itot
            RETURN
        END IF
C -------- DEPLACER PLUME -------------
        CALL MOVE_PEN(X0,YPOS)
C -------- PLACER LABELS POUR POSTSCRIPT -------
        IF(IDIGIS.GT.0)THEN
            TOT=ITOT-0.5
         ELSE
            TOT=ITOT
         END IF
         DELX=-SCALEP*0.5*(TOT+0.5)
         DELY=-0.35*SCALEP
        WRITE(29,8765)DELX,DELY
 8765   FORMAT(F7.0,' ',F7.0,' rmoveto')
C ------ ICI ON DESSINE UN INTEGER ---------
        IF(IDIGIS.EQ.0)THEN
            PSFMI='(''('',I0,'')show'')'
            PSFMI2(7)=CHARCH(ITOT)
            WRITE(29,PSFMI)IYPOS
        END IF
C --------- ICI ON DESSINE UN FLOATING --------
        IF(IDIGIS.GT.0)THEN
            PSFMF='(''('',F0.0,'')show'')'
            PSFMF2(7)=CHARCH(ITOT)
            PSFMF2(9)=CHARCH(IDIGIS)
            WRITE(29,PSFMF)YPOS
        END IF
    7   CONTINUE
        RETURN
        END

C ********* SUBROUTINE LABEL_X ***********
        SUBROUTINE LABEL_X_E(X0,Y0,X1,X2,XD,IDIGIT)
C ------- LABEL AXE X, IDIGIT=DECIMAL FIELD WIDTH (0<=IDIGIT<=7) ------
        IMPLICIT INTEGER (P)
        CHARACTER*1 TERM(2)
        CHARACTER*20 PSFMF
        CHARACTER*1 PSFMF2(20)
        CHARACTER*16 PSFMI
        CHARACTER*1 PSFMI2(16)
        CHARACTER*1 CHARCH(9)
        INTEGER ITERM
        EQUIVALENCE (TERM,ITERM)
        EQUIVALENCE (PSFMF,PSFMF2)
        EQUIVALENCE (PSFMI,PSFMI2)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        DATA CHARCH/'1','2','3','4','5','6','7','8','9'/
        REAL XPOS1
C ------- PREPARATIONS INITIALES  ---------- 
C -------- DEFINITION OF TERMINATION CHARACTER ----
        ITERM=3
C -------- DEFINE FONTS ----------
         WRITE(29,9493)SCALEP *0.65
 9493    FORMAT('/Symbol findfont ',f10.3,' scalefont setfont')
C 9493    FORMAT('/Symbol findfont ',es12.4,' scalefont setfont')
        X1H=MAX(X1-1.E-5*(XMAX-XMIN),XMIN)
        X2H=MIN(X2+1.E-5*(XMAX-XMIN),XMAX)
        IF (X2H.LE.X1H) RETURN
        N1=(X1H-X0)/XD
        N2=(X2H-X0)/XD
        IF(N1.GT.N2)RETURN
        IF((N2-N1).GT.30)THEN
            WRITE(6,*)' label_x, too many labels,.. n1,n2=',n1,n2
            RETURN
        END IF
        DO 7 I=N1-2,N2+2
        XPOS=X0+I*XD
        XPOS1=X0+I*XD * 0.9  ! VD modification
        IF(XPOS.LT.X1H)GOTO 7
        IF(XPOS.GT.X2H)GOTO 7
C -------- DETERMINER FORMAT --------------
        IDIGIS=MAX(0,MIN(7,IDIGIT))
        IF(IDIGIS.GT.0)THEN
            ITOT=IDIGIS+1
        ELSE
            IXPOS=XPOS+SIGN(.499,XPOS)
            ITOT=0
        END IF
        XABS=ABS(XPOS)
        IF(XABS.GE.1.)ITOT=ITOT+1
        IF(XABS.GE.10.)ITOT=ITOT+1
        IF(XABS.GE.100.)ITOT=ITOT+1
        IF(XABS.GE.1000.)ITOT=ITOT+1
        IF(XABS.GE.10000.)ITOT=ITOT+1
        IF(XABS.GE.100000.)ITOT=ITOT+1
        IF(XPOS.LT.0.)ITOT=ITOT+1
        ITOT=MAX(1,ITOT)
        TOT=ITOT
        DELX=-TOT/3.-(TOT-1)/6.
        DELY=-1.
        IF(ITOT.GT.9)THEN
            WRITE(6,*)' label_x, labels too long,.. itot=',itot
            RETURN
        END IF
C -------- DEPLACER PLUME -------------
c        XPOS = XPOS -50
        !CALL MOVE_PEN(XPOS,Y0)
        CALL MOVE_PEN(XPOS1,Y0)  ! VD modification
C -------- PLACER LABELS POUR POSTSCRIPT -------
        IF(IDIGIS.GT.0)THEN
            TOT=ITOT-0.5
         ELSE
            TOT=ITOT
         END IF
         DELX=-SCALEP*0.5*0.5*TOT
         DELY=-1.*SCALEP
        WRITE(29,8765)DELX,DELY
c        WRITE(29,8765)DELX/2,DELY/2
 8765   FORMAT(F7.0,' ',F7.0,' rmoveto')
C ------ ICI ON DESSINE UN INTEGER ---------
        IF(IDIGIS.EQ.0)THEN
            PSFMI='(''('',I0,'')show'')'
            PSFMI2(7)=CHARCH(ITOT)
            WRITE(29,PSFMI)IXPOS
        END IF
C --------- ICI ON DESSINE UN FLOATING --------
        IF(IDIGIS.GT.0)THEN
c            PSFMF='(''('',F0.0,'')show'')'
c            PSFMF='(''('',E00.0,'')show'')'
            PSFMF='(''('',ES11.0,'')show'')'
c            PSFMF2(7)='1'
c            PSFMF2(8)=CHARCH(ITOT)
c            PSFMF2(10)=CHARCH(IDIGIS)
c            PSFMF2(11)=CHARCH(3)     
            PSFMF2(11)=CHARCH(IDIGIS)     

            !print*,'####', PSFMF, PSFMF2, IDIGIS

            WRITE(29,PSFMF)XPOS
        END IF
    7   CONTINUE
        RETURN
        END


C ********* SUBROUTINE LABEL_Y_E ***********
        SUBROUTINE LABEL_Y_E(X0,Y0,Y1,Y2,YD,IDIGIT)
C ------- LABEL AXE Y, IDIGIT=DECIMAL FIELD WIDTH (0<=IDIGIT<=7) ------
        IMPLICIT INTEGER (P)
        CHARACTER*1 TERM(2)
        CHARACTER*20 PSFMF
        CHARACTER*1 PSFMF2(20)
        CHARACTER*16 PSFMI
        CHARACTER*1 PSFMI2(16)
        CHARACTER*1 CHARCH(9)
        INTEGER ITERM
        EQUIVALENCE (TERM,ITERM)
        EQUIVALENCE (PSFMF,PSFMF2)
        EQUIVALENCE (PSFMI,PSFMI2)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        DATA CHARCH/'1','2','3','4','5','6','7','8','9'/
C ------- PREPARATIONS INITIALES  ---------- 
C -------- DEFINITION OF TERMINATION CHARACTER ----
        ITERM=3
C -------- DEFINE FONTS ----------
         WRITE(29,9493)SCALEP*0.65
 9493    FORMAT('/Symbol findfont ',f10.3,' scalefont setfont')
        Y1H=MAX(Y1-1.E-5*(YMAX-YMIN),YMIN)
        Y2H=MIN(Y2+1.E-5*(YMAX-YMIN),YMAX)
        IF (Y2H.LE.Y1H) RETURN
        N1=(Y1H-Y0)/YD
        N2=(Y2H-Y0)/YD
        IF(N1.GT.N2)RETURN
        IF((N2-N1).GT.30)THEN
            WRITE(6,*)' label_Y, too many labels,.. n1,n2=',n1,n2
            RETURN
        END IF
        DO 7 I=N1-2,N2+2
        YPOS=Y0+I*YD
        IF(YPOS.LT.Y1H)GOTO 7
        IF(YPOS.GT.Y2H)GOTO 7
C -------- DETERMINER FORMAT --------------
        IDIGIS=MAX(0,MIN(7,IDIGIT))
        IF(IDIGIS.GT.0)THEN
            ITOT=IDIGIS+1
        ELSE
            IYPOS=YPOS+SIGN(.499,YPOS)
            ITOT=0
        END IF
        YABS=ABS(YPOS)
        IF(YABS.GE.1.)ITOT=ITOT+1
        IF(YABS.GE.10.)ITOT=ITOT+1
        IF(YABS.GE.100.)ITOT=ITOT+1
        IF(YABS.GE.1000.)ITOT=ITOT+1
        IF(YABS.GE.10000.)ITOT=ITOT+1
        IF(YABS.GE.100000.)ITOT=ITOT+1
        IF(YPOS.LT.0.)ITOT=ITOT+1
        ITOT=MAX(1,ITOT)
        TOT=ITOT
        DELX=-TOT-1.
        DELY=-0.25
        IF(ITOT.GT.9)THEN
            WRITE(6,*)' label_Y, labels too long,.. itot=',itot
            RETURN
        END IF

c        X0 = X0 - 50
C -------- DEPLACER PLUME -------------
        CALL MOVE_PEN(X0,YPOS)
C -------- PLACER LABELS POUR POSTSCRIPT -------
        IF(IDIGIS.GT.0)THEN
            TOT=ITOT-0.5
         ELSE
            TOT=ITOT
         END IF
! new length of the number in "es" format
         TOT = 7 -0.5
         IF(YPOS.LT.0.)TOT=TOT+0.5



         DELX=-SCALEP*0.5*(TOT+0.5)
         DELY=-0.35*SCALEP
         
c         write(*,'(a6,i5, 5es12.4)') '???',ITOT, DELX, SCALEP, TOT, 
c     *        YPOS, YABS

        WRITE(29,8765)DELX,DELY
 8765   FORMAT(F7.0,' ',F7.0,' rmoveto')
C ------ ICI ON DESSINE UN INTEGER ---------
        IF(IDIGIS.EQ.0)THEN
            PSFMI='(''('',I0,'')show'')'
            PSFMI2(7)=CHARCH(ITOT)
            WRITE(29,PSFMI)IYPOS
        END IF
C --------- ICI ON DESSINE UN FLOATING --------
        IF(IDIGIS.GT.0)THEN
c            PSFMF='(''('',F0.0,'')show'')'
c            PSFMF='(''('',E00.0,'')show'')'
            PSFMF='(''('',ES11.0,'')show'')'
c            PSFMF2(7)='1'
c            PSFMF2(8)=CHARCH(ITOT)
c            PSFMF2(10)=CHARCH(IDIGIS)
            PSFMF2(11)=CHARCH(1)
c            print*,'!!!!',PSFMF
            WRITE(29,PSFMF)YPOS
        END IF
    7   CONTINUE
        RETURN
        END



C ********* SUBROUTINE LABEL_X_W ***********
        SUBROUTINE LABEL_X_W(X0,Y0,X1,X2,XD,IDIGIT)
C ------- LABEL AXE X, IDIGIT=DECIMAL FIELD WIDTH (0<=IDIGIT<=7) ------
        IMPLICIT INTEGER (P)
        CHARACTER*1 TERM(2)
        CHARACTER*18 PSFMF
        CHARACTER*1 PSFMF2(18)
        CHARACTER*16 PSFMI
        CHARACTER*1 PSFMI2(16)
        CHARACTER*1 CHARCH(9)
        INTEGER ITERM
        EQUIVALENCE (TERM,ITERM)
        EQUIVALENCE (PSFMF,PSFMF2)
        EQUIVALENCE (PSFMI,PSFMI2)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        DATA CHARCH/'1','2','3','4','5','6','7','8','9'/
C ------- PREPARATIONS INITIALES  ---------- 
C -------- DEFINITION OF TERMINATION CHARACTER ----
        ITERM=3
C -------- DEFINE FONTS ----------
         WRITE(29,9493)SCALEP
 9493    FORMAT('/Symbol findfont ',f10.3,' scalefont setfont')
        X1H=MAX(X1-1.E-5*(XMAX-XMIN),XMIN)
        X2H=MIN(X2+1.E-5*(XMAX-XMIN),XMAX)
        IF (X2H.LE.X1H) RETURN
        N1=(X1H-X0)/XD
        N2=(X2H-X0)/XD
        IF(N1.GT.N2)RETURN
        IF((N2-N1).GT.30)THEN
            WRITE(6,*)' label_x, too many labels,.. n1,n2=',n1,n2
            RETURN
        END IF
        DO 7 I=N1-2,N2+2
        XPOS=X0+I*XD
        IF(XPOS.LT.X1H)GOTO 7
        IF(XPOS.GT.X2H)GOTO 7
C -------- DETERMINER FORMAT --------------
        IDIGIS=MAX(0,MIN(7,IDIGIT))
        IF(IDIGIS.GT.0)THEN
            ITOT=IDIGIS+1
        ELSE
            IXPOS=XPOS+SIGN(.499,XPOS)
            ITOT=0
        END IF
        XABS=ABS(XPOS)
        IF(XABS.GE.1.)ITOT=ITOT+1
        IF(XABS.GE.10.)ITOT=ITOT+1
        IF(XABS.GE.100.)ITOT=ITOT+1
        IF(XABS.GE.1000.)ITOT=ITOT+1
        IF(XABS.GE.10000.)ITOT=ITOT+1
        IF(XABS.GE.100000.)ITOT=ITOT+1
        IF(XPOS.LT.0.)ITOT=ITOT+1
        ITOT=MAX(1,ITOT)
        TOT=ITOT
        DELX=-TOT/3.-(TOT-1)/6.
        DELY=-1.
        IF(ITOT.GT.9)THEN
            WRITE(6,*)' label_x, labels too long,.. itot=',itot
            RETURN
        END IF
C -------- DEPLACER PLUME -------------
        CALL MOVE_PEN(XPOS,Y0)
C -------- PLACER LABELS POUR POSTSCRIPT -------
        IF(IDIGIS.GT.0)THEN
            TOT=ITOT-0.5
         ELSE
            TOT=ITOT
         END IF
C -------- FAIRE UN CADRE BLANC ---------
        AMARG=0.2*SCALEP
        DELX=-SCALEP*0.5*0.5*TOT-AMARG/2.
        DELY=-1.*SCALEP-AMARG/2.
        WRITE(29,8765)DELX,DELY
 8765   FORMAT(F7.0,' ',F7.0,' rmoveto')
        DELX= SCALEP*0.5*TOT+AMARG
        DELY=0.
        WRITE(29,8766)DELX,DELY
 8766   FORMAT(F7.0,' ',F7.0,' rlineto')
        DELX= 0.
        DELY=0.7*SCALEP+AMARG
        WRITE(29,8766)DELX,DELY
        DELX=- SCALEP*0.5*TOT-AMARG
        DELY=0.
        WRITE(29,8766)DELX,DELY
            WRITE(29,*)'closepath'
            WRITE(29,*)'1. setgray'
            WRITE(29,*)'fill'
            WRITE(29,*)'0. setgray'
C ------ ICI ON DESSINE UN INTEGER ---------
        CALL MOVE_PEN(XPOS,Y0)
         DELX=-SCALEP*0.5*0.5*TOT
         DELY=-1.*SCALEP
        WRITE(29,8765)DELX,DELY
        IF(IDIGIS.EQ.0)THEN
            PSFMI='(''('',I0,'')show'')'
            PSFMI2(7)=CHARCH(ITOT)
            WRITE(29,PSFMI)IXPOS
        END IF
C --------- ICI ON DESSINE UN FLOATING --------
        IF(IDIGIS.GT.0)THEN
            PSFMF='(''('',F0.0,'')show'')'
            PSFMF2(7)=CHARCH(ITOT)
            PSFMF2(9)=CHARCH(IDIGIS)
            WRITE(29,PSFMF)XPOS
        END IF
    7   CONTINUE
        RETURN
        END
C ********* SUBROUTINE LABEL_Y_W ***********
        SUBROUTINE LABEL_Y_W(X0,Y0,Y1,Y2,YD,IDIGIT)
C ------- LABEL AXE Y, IDIGIT=DECIMAL FIELD WIDTH (0<=IDIGIT<=7) ------
        IMPLICIT INTEGER (P)
        CHARACTER*1 TERM(2)
        CHARACTER*18 PSFMF
        CHARACTER*1 PSFMF2(18)
        CHARACTER*16 PSFMI
        CHARACTER*1 PSFMI2(16)
        CHARACTER*1 CHARCH(9)
        INTEGER ITERM
        EQUIVALENCE (TERM,ITERM)
        EQUIVALENCE (PSFMF,PSFMF2)
        EQUIVALENCE (PSFMI,PSFMI2)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        DATA CHARCH/'1','2','3','4','5','6','7','8','9'/
C ------- PREPARATIONS INITIALES  ---------- 
C -------- DEFINITION OF TERMINATION CHARACTER ----
        ITERM=3
C -------- DEFINE FONTS ----------
         WRITE(29,9493)SCALEP
 9493    FORMAT('/Symbol findfont ',f10.3,' scalefont setfont')
        Y1H=MAX(Y1-1.E-5*(YMAX-YMIN),YMIN)
        Y2H=MIN(Y2+1.E-5*(YMAX-YMIN),YMAX)
        IF (Y2H.LE.Y1H) RETURN
        N1=(Y1H-Y0)/YD
        N2=(Y2H-Y0)/YD
        IF(N1.GT.N2)RETURN
        IF((N2-N1).GT.30)THEN
            WRITE(6,*)' label_Y, too many labels,.. n1,n2=',n1,n2
            RETURN
        END IF
        DO 7 I=N1-2,N2+2
        YPOS=Y0+I*YD
        IF(YPOS.LT.Y1H)GOTO 7
        IF(YPOS.GT.Y2H)GOTO 7
C -------- DETERMINER FORMAT --------------
        IDIGIS=MAX(0,MIN(7,IDIGIT))
        IF(IDIGIS.GT.0)THEN
            ITOT=IDIGIS+1
        ELSE
            IYPOS=YPOS+SIGN(.499,YPOS)
            ITOT=0
        END IF
        YABS=ABS(YPOS)
        IF(YABS.GE.1.)ITOT=ITOT+1
        IF(YABS.GE.10.)ITOT=ITOT+1
        IF(YABS.GE.100.)ITOT=ITOT+1
        IF(YABS.GE.1000.)ITOT=ITOT+1
        IF(YABS.GE.10000.)ITOT=ITOT+1
        IF(YABS.GE.100000.)ITOT=ITOT+1
        IF(YPOS.LT.0.)ITOT=ITOT+1
        ITOT=MAX(1,ITOT)
        TOT=ITOT
        DELX=-TOT-1.
        DELY=-0.25
        IF(ITOT.GT.9)THEN
            WRITE(6,*)' label_Y, labels too long,.. itot=',itot
            RETURN
        END IF
C -------- DEPLACER PLUME -------------
        CALL MOVE_PEN(X0,YPOS)
C -------- PLACER LABELS POUR POSTSCRIPT -------
        IF(IDIGIS.GT.0)THEN
            TOT=ITOT-0.5
         ELSE
            TOT=ITOT
         END IF
C -------- FAIRE UN CADRE BLANC ---------
        AMARG=0.2*SCALEP
         DELX=-SCALEP*0.5*(TOT+0.5)-AMARG/2.
         DELY=-0.35*SCALEP-AMARG/2.
        WRITE(29,8765)DELX,DELY
 8765   FORMAT(F7.0,' ',F7.0,' rmoveto')
        DELX= SCALEP*0.5*TOT+AMARG
        DELY=0.
        WRITE(29,8766)DELX,DELY
 8766   FORMAT(F7.0,' ',F7.0,' rlineto')
        DELX= 0.
        DELY=0.7*SCALEP+AMARG
        WRITE(29,8766)DELX,DELY
        DELX=- SCALEP*0.5*TOT-AMARG
        DELY=0.
        WRITE(29,8766)DELX,DELY
            WRITE(29,*)'closepath'
            WRITE(29,*)'1. setgray'
            WRITE(29,*)'fill'
            WRITE(29,*)'0. setgray'
C ------ ICI ON DESSINE UN INTEGER ---------
        CALL MOVE_PEN(X0,YPOS)
         DELX=-SCALEP*0.5*(TOT+0.5)
         DELY=-0.35*SCALEP
        WRITE(29,8765)DELX,DELY
        IF(IDIGIS.EQ.0)THEN
            PSFMI='(''('',I0,'')show'')'
            PSFMI2(7)=CHARCH(ITOT)
            WRITE(29,PSFMI)IYPOS
        END IF
C --------- ICI ON DESSINE UN FLOATING --------
        IF(IDIGIS.GT.0)THEN
            PSFMF='(''('',F0.0,'')show'')'
            PSFMF2(7)=CHARCH(ITOT)
            PSFMF2(9)=CHARCH(IDIGIS)
            WRITE(29,PSFMF)YPOS
        END IF
    7   CONTINUE
        RETURN
        END
c ************* SUBROUTINE LOGAX_X *****************
        SUBROUTINE LOGAX_X(X0,Y0,X1,X2,KDEL,KGRAD)
        IMPLICIT INTEGER (P)
        DIMENSION PLOTX(5),PLOTY(5)
        CHARACTER*1 TERM(2)
        INTEGER ITERM
        LOGICAL LTEXT,LTEXTEXT
        EQUIVALENCE (TERM,ITERM)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/LTEXT/LTEXT,LTEXTEXT
C -------- DEFINE FONTS ----------
         LTEXT=.TRUE.
         WRITE(29,9493)SCALEP
 9493    FORMAT('/Symbol findfont ',f10.3,' scalefont setfont')
C --------- LONGUEUR DES CRETES ---------
        P1=3*PFACY
        P2=6*PFACY
        PY0=PIXEL_Y(Y0)
C -------- LIMITES DU DESSIN --------
        X1LOC=MAX(X1-1.E-5*(XMAX-XMIN),XMIN)
        X2LOC=MIN(X2+1.E-5*(XMAX-XMIN),XMAX)
        IF (X2LOC.LE.X1LOC) RETURN
C ------- DETERMINER TYPE DE SUSGRADUATION --------------
        IF(KGRAD.LT.0)THEN
            KSIGN=-1
            ELSE
            IF(KGRAD.GT.0)THEN
                KSIGN=1
            ELSE
                KSIGN=0
            END IF
        END IF
C -------- POSITION INITIALE ---------
        XPLUM=X1LOC
        PLOTX(1)=PIXEL_X(XPLUM)
        PLOTY(1)=PY0
C ------ LA GRANDE BOUCLE POUR L'AXE --------
        NMIN=NINT(X1LOC)-1
        NMAX=NINT(X2LOC)+1
        DO 49 NN=NMIN,NMAX
        FNN=NN
C ------ DERNIER TRAIT -----
        IF(FNN.GT.X2LOC)THEN
            PLOTX(2)=PIXEL_X(X2LOC)
            PLOTY(2)=PY0
            CALL LINE_DRAW(PLOTX,PLOTY,2)
            GOTO 51
        END IF
C -------- DESSINER UN HOQUET ---------
        IF(FNN.GT.XPLUM)THEN
            PLOTX(2)=PIXEL_X(FNN)
            PLOTY(2)=PY0
            PLOTX(3)=PIXEL_X(FNN)
            PLOTY(3)=PY0+P2
            PLOTX(4)=PIXEL_X(FNN)
            PLOTY(4)=PY0
            CALL LINE_DRAW(PLOTX,PLOTY,4)
            PLOTX(1)=PLOTX(4)
            XPLUM=FNN
        END IF
        IF(KGRAD.EQ.0)GOTO 49
C --------- SOUSGRADUATION -----------
        DO 25 IGRAD=2,9
        IF(KSIGN.EQ.1)THEN
            FNNLOG=FNN+ALOG10(FLOAT(IGRAD))
        ELSE
            FNNLOG=FNN+1.-ALOG10(FLOAT(11-IGRAD))
        END IF
C ------ DERNIER TRAIT -----
        IF(FNNLOG.GT.X2LOC)THEN
            PLOTX(2)=PIXEL_X(X2LOC)
            PLOTY(2)=PY0
            CALL LINE_DRAW(PLOTX,PLOTY,2)
            GOTO 51
        END IF
C -------- DESSINER UN HOQUET ---------
        IF(FNNLOG.GT.XPLUM)THEN
            PLOTX(2)=PIXEL_X(FNNLOG)
            PLOTY(2)=PY0
            PLOTX(3)=PIXEL_X(FNNLOG)
            PLOTY(3)=PY0+P1
            PLOTX(4)=PIXEL_X(FNNLOG)
            PLOTY(4)=PY0
            CALL LINE_DRAW(PLOTX,PLOTY,4)
            PLOTX(1)=PLOTX(4)
            XPLUM=FNNLOG
        END IF
  25    CONTINUE
  49    CONTINUE
C ------- METTRE LES LABELS ----------
  51    CALL VIDANGE
        DO 69 NNLOOP=NMIN,NMAX
        IF(MOD(NNLOOP,KDEL).NE.0)GOTO 69
        IF(KSIGN.EQ.-1)THEN
            NN=-NNLOOP
        ELSE
            NN=NNLOOP
        END IF
C -------- DETERMINER ITOT ---------
        IF(NN.LE.-10)ITOT=3
        IF(NN.LE.-1.AND.NN.GE.-9)ITOT=2
        IF(NN.GE.0)ITOT=1
        IF(NN.GE.10)ITOT=2
C ------- DEPLACER PLUME -------
        FNN=NNLOOP
        IF(FNN.LT.X1LOC.OR.FNN.GT.X2LOC)GOTO 69
        TOT=ITOT
        CALL MOVE_PEN(FNN,Y0)
         DELX=-SCALEP*0.5*0.5*(2.+ITOT*0.7)
         DELY=-1.*SCALEP
        WRITE(29,8765)DELX,DELY
 8765   FORMAT(F7.0,' ',F7.0,' rmoveto')
         WRITE(29,*)'(10)show'
        IF(ITOT.EQ.1)WRITE(29,8991)NN
        IF(ITOT.EQ.2)WRITE(29,8992)NN
        IF(ITOT.EQ.3)WRITE(29,8993)NN
        IF(ITOT.EQ.4)WRITE(29,8994)NN
 8991   FORMAT('(',I1,')exposhow')
 8992   FORMAT('(',I2,')exposhow')
 8993   FORMAT('(',I3,')exposhow')
 8994   FORMAT('(',I4,')exposhow')
  69    CONTINUE
        RETURN
        END

c ************* SUBROUTINE LOGAX_Y *****************
        SUBROUTINE LOGAX_Y(X0,Y0,Y1,Y2,KDEL,KGRAD)
        IMPLICIT INTEGER (P)
        DIMENSION PLOTX(5),PLOTY(5)
        CHARACTER*1 TERM(2)
        INTEGER ITERM
        LOGICAL LTEXT,LTEXTEXT
        EQUIVALENCE (TERM,ITERM)
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
        COMMON/PICTURE_WINDOW/UMIN,UMAX,VMIN,VMAX,UDEL,VDEL
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/LTEXT/LTEXT,LTEXTEXT
C -------- DEFINE FONTS ----------
         LTEXT=.TRUE.
         WRITE(29,9493)SCALEP
 9493    FORMAT('/Symbol findfont ',f10.3,' scalefont setfont')
C --------- LONGUEUR DES CRETES ---------
        P1=3*PFACX
        P2=6*PFACX
        PX0=PIXEL_X(X0)
C -------- LIMITES DU DESSIN --------
        Y1LOC=MAX(Y1-1.E-5*(YMAX-YMIN),YMIN)
        Y2LOC=MIN(Y2+1.E-5*(YMAX-YMIN),YMAX)
        IF (Y2LOC.LE.Y1LOC) RETURN
C ------- DETERMINER TYPE DE SUSGRADUATION --------------
        IF(KGRAD.LT.0)THEN
            KSIGN=-1
            ELSE
            IF(KGRAD.GT.0)THEN
                KSIGN=1
            ELSE
                KSIGN=0
            END IF
        END IF
C -------- POSITION INITIALE ---------
        YPLUM=Y1LOC
        PLOTY(1)=PIXEL_Y(YPLUM)
        PLOTX(1)=PX0
C ------ LA GRANDE BOUCLE POUR L'AXE --------
        NMIN=NINT(Y1LOC)-1
        NMAX=NINT(Y2LOC)+1
        DO 49 NN=NMIN,NMAX
        FNN=NN
C ------ DERNIER TRAIT -----
        IF(FNN.GT.Y2LOC)THEN
            PLOTY(2)=PIXEL_Y(Y2LOC)
            PLOTX(2)=PX0
            CALL LINE_DRAW(PLOTX,PLOTY,2)
            GOTO 51
        END IF
C -------- DESSINER UN HOQUET ---------
        IF(FNN.GT.YPLUM)THEN
            PLOTY(2)=PIXEL_Y(FNN)
            PLOTX(2)=PX0
            PLOTY(3)=PIXEL_Y(FNN)
            PLOTX(3)=PX0+P2
            PLOTY(4)=PIXEL_Y(FNN)
            PLOTX(4)=PX0
            CALL LINE_DRAW(PLOTX,PLOTY,4)
            PLOTY(1)=PLOTY(4)
            YPLUM=FNN
        END IF
        IF(KGRAD.EQ.0)GOTO 49
C --------- SOUSGRADUATION -----------
        DO 25 IGRAD=2,9
        IF(KSIGN.EQ.1)THEN
            FNNLOG=FNN+ALOG10(FLOAT(IGRAD))
        ELSE
            FNNLOG=FNN+1.-ALOG10(FLOAT(11-IGRAD))
        END IF
C ------ DERNIER TRAIT -----
        IF(FNNLOG.GT.Y2LOC)THEN
            PLOTY(2)=PIXEL_Y(Y2LOC)
            PLOTX(2)=PX0
            CALL LINE_DRAW(PLOTX,PLOTY,2)
            GOTO 51
        END IF
C -------- DESSINER UN HOQUET ---------
        IF(FNNLOG.GT.YPLUM)THEN
            PLOTY(2)=PIXEL_Y(FNNLOG)
            PLOTX(2)=PX0
            PLOTY(3)=PIXEL_Y(FNNLOG)
            PLOTX(3)=PX0+P1
            PLOTY(4)=PIXEL_Y(FNNLOG)
            PLOTX(4)=PX0
            CALL LINE_DRAW(PLOTX,PLOTY,4)
            PLOTY(1)=PLOTY(4)
            YPLUM=FNNLOG
        END IF
  25    CONTINUE
  49    CONTINUE
C ------- METTRE LES LABELS ----------
  51    CALL VIDANGE
        DO 69 NNLOOP=NMIN,NMAX
        IF(MOD(NNLOOP,KDEL).NE.0)GOTO 69
        IF(KSIGN.EQ.-1)THEN
            NN=-NNLOOP
        ELSE
            NN=NNLOOP
        END IF
C -------- DETERMINER ITOT ---------
        IF(NN.LE.-10)ITOT=3
        IF(NN.LE.-1.AND.NN.GE.-9)ITOT=2
        IF(NN.GE.0)ITOT=1
        IF(NN.GE.10)ITOT=2
C ------- DEPLACER PLUME -------
        FNN=NNLOOP
        IF(FNN.LT.Y1LOC.OR.FNN.GT.Y2LOC)GOTO 69
        TOT=ITOT
        CALL MOVE_PEN(X0,FNN)
         DELX=-SCALEP*0.5*(2.+ITOT*0.7+0.5)
         DELY=-0.35*SCALEP
        WRITE(29,8765)DELX,DELY
 8765   FORMAT(F7.0,' ',F7.0,' rmoveto')
         WRITE(29,*)'(10)show'
        IF(ITOT.EQ.1)WRITE(29,8991)NN
        IF(ITOT.EQ.2)WRITE(29,8992)NN
        IF(ITOT.EQ.3)WRITE(29,8993)NN
        IF(ITOT.EQ.4)WRITE(29,8994)NN
 8991   FORMAT('(',I1,')exposhow')
 8992   FORMAT('(',I2,')exposhow')
 8993   FORMAT('(',I3,')exposhow')
 8994   FORMAT('(',I4,')exposhow')
  69    CONTINUE
        RETURN
        END
C
        SUBROUTINE THICK_PIXEL(ITHICK)
        INTEGER PFACX,PFACY
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        COMMON/THICK/JTHICK
            JTHICK=ITHICK
            WRITE(29,88)ITHICK
 88         FORMAT(I2,' setlinewidth')
        RETURN
        END
C
C
        SUBROUTINE LINE(XB,YB,XE,YE)
C -------- DRAWS LINE FROM XB,YB (BEGIN) TO XE,YE (END)
        DIMENSION XDES(5),YDES(5)
        XDES(1)=XB
        YDES(1)=YB
        XDES(2)=XE
        YDES(2)=YE
        CALL LING(XDES,YDES,2)
        RETURN
        END
C
        SUBROUTINE LINE_OPEN(XB,YB,XE,YE)
C -------- DRAWS LINE FROM XB,YB (BEGIN) TO XE,YE (END)
        DIMENSION XDES(5),YDES(5)
        XDES(1)=XB
        YDES(1)=YB
        XDES(2)=XE
        YDES(2)=YE
        CALL LING_OPEN(XDES,YDES,2)
        RETURN
        END
C
        SUBROUTINE ARROW(XB,YB,XE,YE,AMM)
C -------- DRAWS ARROW FROM XB,YB (BEGIN) TO XE,YE (END)
C --- AMM VARIES GRANDEUR DES FLECHES,APPROX EN MM  -------
        IMPLICIT LOGICAL (L)
        INTEGER PIXEL_X,PIXEL_Y
      COMMON/LSYM/Lsquare,Llosange,Lxstar,Lpstar,
     &Lutri,Ldtri,Lumtri,Ldmtri,Lhardy,Llaurel,Lmpent,Lmhex,Lmmhex,
     &Lpent,Lhex,Lcircle,Lrgbsquare,Lrgblosange,Lrgbxstar,Lrgbpstar,
     &Lrgbutri,Lrgbdtri,Lrgbumtri,Lrgbdmtri,Lrgbhardy,Lrgblaurel,
     &Lrgbmpent,Lrgbmhex,Lrgbmmhex,Lrgbpent,Lrgbhex,Lrgbcircle,Larrow 
C --------- GRANDEUR VARIABLE DES FLECHES --------
        Larrow=.TRUE.
        CALL MOVE_PEN(XB,YB)
        IPX=PIXEL_X(XE)        
        IPY=PIXEL_Y(YE)
        AMSCAL=AMM*100./3.
        WRITE(29,9933)IPX,IPY,AMSCAL
 9933   FORMAT(2I5,F8.2,' ato')
        write(29,*)'s'        
        RETURN
        END
C
c
C ----- SHY_ARROW -----
      SUBROUTINE SHY_ARROW(XB,YB,XE,YE,AMM,PERCENT)
      IF(ABS(PERCENT).LT.1.)THEN
        PERCENTL=100.*PERCENT
      ELSE
        PERCENTL=PERCENT
      END IF
      SHXB=XB+((100.-PERCENTL)/200.)*(XE-XB)
      SHXE=XE-((100.-PERCENTL)/200.)*(XE-XB)
      SHYB=YB+((100.-PERCENTL)/200.)*(YE-YB)
      SHYE=YE-((100.-PERCENTL)/200.)*(YE-YB)
      CALL ARROW(SHXB,SHYB,SHXE,SHYE,AMM)
      RETURN
      END
c
C ---- CONNECTICUT: CONNECTING ARROW BETWEEN BOXES ----
      SUBROUTINE CONNECTICUT(I1,J1,I2,J2,AMM,PERCENT)
      IL1=I1
      JL1=J1
      IL2=I2
      JL2=J2 
      IF(ABS(IL1).LT.500)IL1=IL1*1000
      IF(ABS(IL2).LT.500)IL2=IL2*1000
      IF(ABS(JL1).LT.500)JL1=JL1*1000
      IF(ABS(JL2).LT.500)JL2=JL2*1000
      IMED=(IL1+IL2)/2.
      JMED=(JL1+JL2)/2.
      XMIN=-1.
      XMAX=1.
      YMIN=-1.
      YMAX=1.
      CALL MICKEY_MOUSE(IMED,JMED,XMIN,XMAX,YMIN,YMAX)
      AY=-(IL2-IL1)
      AX=JL2-JL1
      PHI=ATAN2(AY,AX)
      XE=COS(PHI)
      YE=SIN(PHI)
      XB=-XE
      YB=-YE
      CALL SHY_ARROW(XB,YB,XE,YE,AMM,PERCENT)
      RETURN
      END






c
        SUBROUTINE LINGARROW(XDES,YDES,NDES,AMM)
        DIMENSION XDES(NDES),YDES(NDES)
C --------- COMBINES LING WITH ARROW PUT ON TOP
c ---- THE VALUE "AMM" INCREASES THE ARROWS TIP -----
      CALL LING(XDES,YDES,NDES)
      CALL ARROWRR(XDES(NDES-1),YDES(NDES-1),XDES(NDES),YDES(NDES),AMM)
      RETURN
      END

        SUBROUTINE LINGARROWS(XDES,YDES,NDES,AMM,INTER)
        DIMENSION XDES(NDES),YDES(NDES)
C --------- COMBINES LING WITH ARROW PUT ON TOP
C ---- AND ADDS MORE ARROWS AT DISTANCE "INTER"
c ---- THE VALUE "AMM" INCREASES THE ARROW TIPS -----
      CALL LING(XDES,YDES,NDES)
      NARROW=(NDES-1)/INTER
      DO IARROW=0,NARROW
       IDES=NDES-IARROW*INTER
       CALL ARROWRR(XDES(IDES-1),YDES(IDES-1),XDES(IDES),YDES(IDES),AMM)
      END DO
      RETURN
      END

C
        SUBROUTINE ARROWRR(XB,YB,XE,YE,AMM)
C -------- DRAWS ARROW FROM XB,YB (BEGIN) TO XE,YE (END)
C --- AMM VARIES GRANDEUR DES FLECHES,APPROX EN MM  -------
        IMPLICIT LOGICAL (L)
        INTEGER PIXEL_X,PIXEL_Y
      COMMON/LSYM/Lsquare,Llosange,Lxstar,Lpstar,
     &Lutri,Ldtri,Lumtri,Ldmtri,Lhardy,Llaurel,Lmpent,Lmhex,Lmmhex,
     &Lpent,Lhex,Lcircle,Lrgbsquare,Lrgblosange,Lrgbxstar,Lrgbpstar,
     &Lrgbutri,Lrgbdtri,Lrgbumtri,Lrgbdmtri,Lrgbhardy,Lrgblaurel,
     &Lrgbmpent,Lrgbmhex,Lrgbmmhex,Lrgbpent,Lrgbhex,Lrgbcircle,Larrow 
        COMMON/PICTURE_LIMITS/XMIN,XMAX,YMIN,YMAX,XDEL,YDEL
C --------- GRANDEUR VARIABLE DES FLECHES --------
      IF(XMIN.LE.XB.AND.XB.LE.XMAX)THEN  
      IF(XMIN.LE.XE.AND.XE.LE.XMAX)THEN  
      IF(YMIN.LE.YB.AND.YB.LE.YMAX)THEN  
      IF(YMIN.LE.YE.AND.YE.LE.YMAX)THEN  
        Larrow=.TRUE.
        CALL MOVE_PEN(XB,YB)
        IPX=PIXEL_X(XE)        
        IPY=PIXEL_Y(YE)
        AMSCAL=AMM*100./3.
        WRITE(29,9933)IPX,IPY,AMSCAL
 9933   FORMAT(2I5,F8.2,' ato')
        write(29,*)'s'
      END IF        
      END IF        
      END IF        
      END IF        
      RETURN
      END


c
      SUBROUTINE ACCOLADE_X(YOFF,YFERM,X1,X2)
        INTEGER PIXEL_X,PIXEL_Y,PFACX,PFACY,PPX,PPY
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        DIMENSION PPX(4),PPY(4)
      XMED=(X1+X2)/2.
c      EXAGG=0.8
      EXAGG=0.6
      PPX(1)=PIXEL_X(X1)
      PPY(1)=PIXEL_Y(YOFF)
      PPX(2)=PIXEL_X(X1)
      PPY(2)=PIXEL_Y(YFERM+EXAGG*(YFERM-YOFF))
      PPX(3)=PIXEL_X(XMED)
      PPY(3)=PIXEL_Y(YOFF+EXAGG*(YOFF-YFERM))
      PPX(4)=PIXEL_X(XMED)
      PPY(4)=PIXEL_Y(YFERM)
      WRITE(29,991)PPX(1),PPY(1)
 991  FORMAT(2I5,' m')
      WRITE(29,992)(PPX(I),PPY(I),I=2,4)
 992  FORMAT(6I5,' curveto')
      PPX(1)=PIXEL_X(X2)
      PPX(2)=PIXEL_X(X2)
      WRITE(29,992)(PPX(I),PPY(I),I=3,1,-1)
      WRITE(29,*)'s'
      RETURN
      END

      SUBROUTINE ACCOLADE_Y(XOFF,XFERM,Y1,Y2)
        INTEGER PIXEL_X,PIXEL_Y,PFACX,PFACY,PPX,PPY
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
        DIMENSION PPX(4),PPY(4)
      YMED=(Y1+Y2)/2.
c      EXAGG=0.8
      EXAGG=0.6
      PPY(1)=PIXEL_Y(Y1)
      PPX(1)=PIXEL_X(XOFF)
      PPY(2)=PIXEL_Y(Y1)
      PPX(2)=PIXEL_X(XFERM+EXAGG*(XFERM-XOFF))
      PPY(3)=PIXEL_Y(YMED)
      PPX(3)=PIXEL_X(XOFF+EXAGG*(XOFF-XFERM))
      PPY(4)=PIXEL_Y(YMED)
      PPX(4)=PIXEL_X(XFERM)
      WRITE(29,991)PPX(1),PPY(1)
 991  FORMAT(2I5,' m')
      WRITE(29,992)(PPX(I),PPY(I),I=2,4)
 992  FORMAT(6I5,' curveto')
      PPY(1)=PIXEL_Y(Y2)
      PPY(2)=PIXEL_Y(Y2)
      WRITE(29,992)(PPX(I),PPY(I),I=3,1,-1)
      WRITE(29,*)'s'
      RETURN
      END

C -------  BITMAP PACKAGE ------
      SUBROUTINE BITMAP_PREPARE
      INTEGER PFACX,PFACY
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
      COMMON/BITMAP_TAB/ITAB(128,5000),MASK(32)
C -------- METTRE A ZERO --------
      DO IPY=1,5000
         DO IBLOC=1,64
            ITAB(IBLOC,IPY)=0
         END DO
      END DO
C ------ PREPARER MASK -----
      MASK(32)=1
      DO I=31,1,-1
         MASK(I)=MASK(I+1)*2
      END DO
      RETURN
      END

      SUBROUTINE BITMAP_POINT(X,Y,ITHICK)
      INTEGER PFACX,PFACY
      INTEGER PIXEL_X,PIXEL_Y
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
      COMMON/BITMAP_TAB/ITAB(128,5000),MASK(32)
C -------- LE POINT -----
         IPX=PIXEL_X(X)
         IPY=PIXEL_Y(Y)
         IXMIN=IPX-(ITHICK-1)/2
         IXMAX=IPX+(ITHICK)/2
         IYMIN=IPY-(ITHICK-1)/2
         IYMAX=IPY+(ITHICK)/2
         DO I=IXMIN,IXMAX
            DO J=IYMIN,IYMAX
               II=MAX(1,MIN(4196,I))
               JJ=MAX(1,MIN(5000,J))
               IBLOC=(II-1)/32+1
               IBIT=II-(IBLOC-1)*32
               ITAB(IBLOC,JJ)=IOR(ITAB(IBLOC,JJ),MASK(IBIT))
            END DO
         END DO
      RETURN
      END

      SUBROUTINE BITMAP_POINT_CLR(X,Y,ITHICK)
      INTEGER PFACX,PFACY
      INTEGER PIXEL_X,PIXEL_Y
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
      COMMON/BITMAP_TAB/ITAB(128,5000),MASK(32)
C -------- LE POINT -----
         IPX=PIXEL_X(X)
         IPY=PIXEL_Y(Y)
         IXMIN=IPX-(ITHICK-1)/2
         IXMAX=IPX+(ITHICK)/2
         IYMIN=IPY-(ITHICK-1)/2
         IYMAX=IPY+(ITHICK)/2
         DO I=IXMIN,IXMAX
            DO J=IYMIN,IYMAX
               II=MAX(1,MIN(4196,I))
               JJ=MAX(1,MIN(5000,J))
               IBLOC=(II-1)/32+1
               IBIT=II-(IBLOC-1)*32
               ITAB(IBLOC,JJ)=IAND(ITAB(IBLOC,JJ),NOT(MASK(IBIT)))
            END DO
         END DO
      RETURN
      END
c
      SUBROUTINE BITMAP_PIX(IPX,IPY)
      INTEGER PFACX,PFACY
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
      COMMON/BITMAP_TAB/ITAB(128,5000),MASK(32)
C -------- LE POINT -----
          I=IPX
            J=IPY
               II=MAX(1,MIN(4196,I))
               JJ=MAX(1,MIN(5000,J))
               IBLOC=(II-1)/32+1
               IBIT=II-(IBLOC-1)*32
               ITAB(IBLOC,JJ)=IOR(ITAB(IBLOC,JJ),MASK(IBIT))
      RETURN
      END
c
      SUBROUTINE BITMAP_PIX_CLR(IPX,IPY)
      INTEGER PFACX,PFACY
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
      COMMON/BITMAP_TAB/ITAB(128,5000),MASK(32)
C -------- LE POINT -----
          I=IPX
            J=IPY
               II=MAX(1,MIN(4196,I))
               JJ=MAX(1,MIN(5000,J))
               IBLOC=(II-1)/32+1
               IBIT=II-(IBLOC-1)*32
               ITAB(IBLOC,JJ)=AND(ITAB(IBLOC,JJ),NOT(MASK(IBIT)))
      RETURN
      END

      SUBROUTINE BITMAP_SEND
      INTEGER PFACX,PFACY 
        COMMON/DEVICE/SCALEX,SCALEY,SCALEP,PFACX,PFACY
      COMMON/BITMAP_TAB/ITAB(128,5000),MASK(32)
C -------- BOUCLE SUR LES BLOCS -----
      iwidth2=32
      write(29,*)'0 setgray'
      DO IBLOC=1,128
         IPXACT=32*(IBLOC-1)
C -------- RECHERCHE DE BLOCS NON ZEROS -----
         DO JJ=1,5000
            IPY1=JJ
            IF(ITAB(IBLOC,JJ).NE.0)GOTO 2
         END DO
         GOTO 4
  2      CONTINUE
         DO JJ=5000,1,-1
            IPY2=JJ
            IF(ITAB(IBLOC,JJ).NE.0)GOTO 3
         END DO
         GOTO 4
C ------- ECRIRE SUR FICHIER ---
 3       write(29,*)' 5 gsave'
         WRITE(29,993)IPXACT,IPY1
993      FORMAT(2I5,' translate') 
         IHEIGHT=IPY2-IPY1+1
         write(29,*)iwidth2,iheight
         write(29,*)'true'
         write(29,*)'[1 0 0 1 0 0]'
         write(29,*)'{<'
         WRITE(29,994)(ITAB(IBLOC,IPY),IPY=IPY1,IPY2)
994      FORMAT(10Z8.8)
         write(29,*)'>}'
         write(29,*)'imagemask'
         write(29,*)'grestore'
  4      CONTINUE
      END DO
      RETURN
      END 
C
      SUBROUTINE COLOR(COL)
      CHARACTER*(*) COL
      IF (COL.EQ.'black') WRITE (29,*) '0. 0. 0. setrgbcolor'
      IF (COL.EQ.'blue') WRITE (29,*) '0. 0. 1. setrgbcolor'
      IF (COL.EQ.'green') WRITE (29,*) '0. 1. 0. setrgbcolor'
      IF (COL.EQ.'red') WRITE (29,*) '1. 0. 0. setrgbcolor'
      IF (COL.EQ.'pink') WRITE (29,*) '1. 0.25 1. setrgbcolor'
      IF (COL.EQ.'violet') WRITE (29,*) '0.65 0. 0.85 setrgbcolor'
      IF (COL.EQ.'yellow') WRITE (29,*) '1. 1. 0. setrgbcolor'
      IF (COL.EQ.'orange') WRITE (29,*) '1. 0.3 0. setrgbcolor'
      RETURN
      END 
C
      SUBROUTINE RGB_COLOR(RED,GREEN,BLUE)
      WRITE (29,88) RED,GREEN,BLUE
 88   FORMAT(3F5.2,' setrgbcolor')
      RETURN
      END 

