C STRINI    SOURCE    BP208322  12/08/02    21:15:42     7468           
C     INTERFACE POUR GENERATION DE POSTSCRIPT
C     LES POINTS D'ENTREE EN C SONT POUR LA COULEUR
C
      SUBROUTINE STRINI(NOL,AXAX,AYAY,TITR,HAUTT,VALEU,NCOUMA)
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO
-INC CCTRACE
      EXTERNAL LONG
      DIMENSION XTR(*),YTR(*)
      CHARACTER*(*) TITR,CARAC,PROMPT,REPLY
      CHARACTER*(*) LEGEND
      CHARACTER*80 TITRE
      CHARACTER*128 CHAINE
      LOGICAL VALEU,FENE,VALEUR,FENET
      SAVE XIOCAD,YIOCAD,VALEUR,FENET,TITRE,LTITRE
      SAVE XMIN,YMIN,XXAX,YYAX,CLX,XRAP,YRAP,XDEP,YDEP
      save icoul,kcoul,initia,ipag,miso
      PARAMETER(IUPS=24)
      DIMENSION ITB(17)
      CHARACTER*17 ctb
      CHARACTER*64 ctc
      CHARACTER*6 cha
      data  initia/0/
      data ipag/1/
      data itb/1,5,13,3,9,7,11,15,16,4,12,2,8,6,10,14,1/
      data ctb/'0123456789ABCDEFG'/
      data ctc/'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123
     >456789&@'/
      data miso/0/
      
* verification des bornes
      bornex(xxx)=min(max(xiocad*0.01,xxx),xiocad*0.99)
      borney(yyy)=min(max(yiocad*0.01,yyy),yiocad*0.99)
C JYYY Debut
      Iorncx(xxx)=(min(max(xiocad*0.01,xxx),xiocad*0.99))/0.004
      Iorncy(yyy)=(min(max(yiocad*0.01,yyy),yiocad*0.99))/0.004
C JYYY Fin
*
      ENTRY CTRINI(NOL,AXAX,AYAY,TITR,HAUTT,VALEU,NCOUMA)

C======================================================================
C     INITIALISATION : STRINI ou CTRINI
C======================================================================

*  on part pour 64 couleurs
      NCOUMA=64
      icoul=0
      lo=len(titr)
      TITRE=TITR(1:72)
      LTITRE=long(titre)
      VALEUR=VALEU
*  INITIALISATION DE POSTSCRIPT
      CLX=0.3
        if (ZHORIZ) then
      xiocad=diocad
      yiocad=xiocad*21/29.7
        else
      yiocad=diocad
      xiocad=yiocad*21/27.7
        endif
        
*  ECRITURE DU PROLOGUE DU POSTSCRIPT 
      if (ZINIPS) then
        ZINIPS = .false.
c  ... on met IPAG à 1 pour recommencer à numéroter correctement ...
       ipag = 1
       initia=1
       icoul=0
       write (IUPS,897)
       write (IUPS,898)
       write (IUPS,899)
        if (ZHORIZ) then
       write (IUPS,900)
        else
       write (IUPS,1900)
        endif
       write (IUPS,901)
       write (IUPS,902)
       write (IUPS,903)
       write (IUPS,904)
       write (IUPS,905) IEPTR
       write (IUPS,906)
       write (IUPS,907)
       write (IUPS,908)
       write (IUPS,909)
       write (IUPS,910)
       write (IUPS,911)
       write (IUPS,912)
       write (IUPS,913)
C JYYY Debut
       write (IUPS,'(A)') '/DL{NP MV {LN}repeat SK } def'
       write (IUPS,'(A)') '/DS{NP MV {LN}repeat FI } def'
       write (IUPS,'(A)') '/H0{.1 .1 scale}def'
       write (IUPS,'(A)') '/H1{10 10 scale}def'
       write (IUPS,'(A)') '/CX{0.004 div} def'
       write (IUPS,'(A)') '/MX{moveto H1} def'
       write (IUPS,'(A)') '/SX {show H0} def'
       write (IUPS,'(A)') 
     + '/center {stringwidth pop 2 div neg 0 rmoveto} def'
c      + '/center {dup stringwidth pop 2 div neg 0 rmoveto} def'
C JYYY Fin
       write (IUPS,914)
       write (IUPS,915)
       write (IUPS,916)
       write (IUPS,917)
       write (IUPS,918)
       write (IUPS,919)
       write (IUPS,920)
       write (IUPS,921)
       write (IUPS,922)
       write (IUPS,923)
       write (IUPS,924)
       write (IUPS,925)
       write (IUPS,926)
       write (IUPS,927)
       write (IUPS,928)
       write (IUPS,929)
       write (IUPS,930)
       write (IUPS,931)
       write (IUPS,932)
       write (IUPS,933)
       write (IUPS,934)
       write (IUPS,935)
       write (IUPS,936)
       write (IUPS,937)
       write (IUPS,938)
       write (IUPS,939)
       write (IUPS,940)
       write (IUPS,941)
       write (IUPS,942)
       write (IUPS,943)
       write (IUPS,944)
       write (IUPS,945)
       write (IUPS,946)
       write (IUPS,813)
       write (IUPS,814)
       write (IUPS,815)
       write (IUPS,816)
       write (IUPS,817)
       write (IUPS,818)
       write (IUPS,819)
       write (IUPS,820)
       write (IUPS,821)
       write (IUPS,822)
       write (IUPS,823)
       write (IUPS,824)
       write (IUPS,825)
       write (IUPS,826)
       write (IUPS,827)
       write (IUPS,828)
       write (IUPS,829)
       write (IUPS,830)
       write (IUPS,831)
       write (IUPS,832)
       write (IUPS,833)
       write (IUPS,834)
       write (IUPS,835)
       write (IUPS,836)
       write (IUPS,837)
       write (IUPS,838)
       write (IUPS,839)
       write (IUPS,840)
       write (IUPS,841)
       write (IUPS,842)
       write (IUPS,843)
       write (IUPS,844)
       write (IUPS,845)
       write (IUPS,846)
c        write (IUPS,947)
*bp : choix de la police tq definie dans option.eso
       if(IOPOTR.eq.1)  write (IUPS,847)
       if(IOPOTR.eq.2)  write (IUPS,848)       
       if(IOPOTR.eq.3)  write (IUPS,849)       
       if(IOPOTR.eq.4)  write (IUPS,850)       
       if(IOPOTR.eq.5)  write (IUPS,851)       
       if(IOPOTR.eq.6)  write (IUPS,852)
       if(IOPOTR.eq.7)  write (IUPS,853)       
       if(IOPOTR.eq.8)  write (IUPS,854)       
       if(IOPOTR.eq.9)  write (IUPS,855)       
       if(IOPOTR.eq.10) write (IUPS,856)       
       if(IOPOTR.eq.11) write (IUPS,857)
       if(IOPOTR.eq.12) write (IUPS,858)       
c        IOPOPO = 846+IOPOTR
c        write (IUPS,IOPOPO)
       if (ZHORIZ) then
         write (IUPS,948)
       else
         write (IUPS,1948)
       endif
       write (IUPS,949)
  897  format ('%!PS-Adobe-1.0')
  898  format ('%%Creator: Cast3m - CEA/DEN/DM2S/SEMT')
  899  format ('%%BoundingBox: 0 0 593 841')
  900  format ('%%Orientation: Landscape')
 1900  format ('%%Orientation: Portrait')
  901  format('200 dict begin')
  902  format ('/StartPage{/sv save def}def')
  903  format ('/EndPage{showpage sv restore}def')
  904  format ('1 setlinecap 0 setlinejoin')
  905  format (I2,' setlinewidth')
  906  format ('/CM { 0.04 div } def')
  907  format ('/NP { newpath } def')
  908  format ('/MV { moveto } def')
  909  format ('/LN { lineto } def')
  910  format ('/SK { stroke } def')
  911  format ('/FI { fill   } def')
  912  format ('/S  { show   } def')
  913  format ('/CN { 0.    setgray } def')
  914  format ('/C0 { 0.    setgray } def')
  915  Format ('/C1 { 0.98  setgray } def')
  916  format ('/C3 { 0.95  setgray } def')
  917  format ('/C5 { 0.91  setgray } def')
  918  format ('/C7 { 0.86  setgray } def')
  919  format ('/C9 { 0.80  setgray } def')
  920  format ('/CB { 0.73  setgray } def')
  921  format ('/CD { 0.65  setgray } def')
  922  format ('/CF { 0.56  setgray } def')
  923  format ('/C2 { 0.965 setgray } def')
  924  format ('/C4 { 0.93  setgray } def')
  925  format ('/C6 { 0.885 setgray } def')
  926  format ('/C8 { 0.83  setgray } def')
  927  format ('/CA { 0.765 setgray } def')
  928  format ('/CC { 0.69  setgray } def')
  929  format ('/CE { 0.605 setgray } def')
  930  format ('/CG { 0.52  setgray } def')
  931  Format ('/c1 { 0.98  setgray } def')
  932  format ('/c3 { 0.95  setgray } def')
  933  format ('/c5 { 0.91  setgray } def')
  934  format ('/c7 { 0.86  setgray } def')
  935  format ('/c9 { 0.80  setgray } def')
  936  format ('/cB { 0.73  setgray } def')
  937  format ('/cD { 0.65  setgray } def')
  938  format ('/cF { 0.56  setgray } def')
  939  format ('/c2 { 0.965 setgray } def')
  940  format ('/c4 { 0.93  setgray } def')
  941  format ('/c6 { 0.885 setgray } def')
  942  format ('/c8 { 0.83  setgray } def')
  943  format ('/cA { 0.765 setgray } def')
  944  format ('/cC { 0.69  setgray } def')
  945  format ('/cE { 0.605 setgray } def')
  946  format ('/cG { 0.52  setgray } def')
  813  format ('/DN { 0.0000 0.0000 0.0000 setrgbcolor } def % black')
  814  format ('/D0 { 0.0000 0.0000 0.0000 setrgbcolor } def % black')
  815  format ('/D1 { 0.8157 0.1255 0.5647 setrgbcolor } def % VioletR')
  816  format ('/D3 { 0.2824 0.2392 0.5451 setrgbcolor } def % DarkSla')
  817  format ('/D5 { 0.2824 0.8196 0.8000 setrgbcolor } def % MediumT')
  818  format ('/D7 { 0.2353 0.7020 0.4431 setrgbcolor } def % MediumS')
  819  format ('/D9 { 0.6039 0.8039 0.1961 setrgbcolor } def % YellowG')
  820  format ('/DB { 1.0000 0.6471 0.0000 setrgbcolor } def % orange')
  821  format ('/DD { 0.8275 0.8275 0.8275 setrgbcolor } def % LightGr')
  822  format ('/DF { 0.0000 0.0000 0.0000 setrgbcolor } def % pas uti')
  823  format ('/D2 { 1.0000 0.0000 1.0000 setrgbcolor } def % magenta')
  824  format ('/D4 { 0.0000 0.0000 1.0000 setrgbcolor } def % blue')
  825  format ('/D6 { 0.0000 0.8078 0.8196 setrgbcolor } def % DarkTur')
  826  format ('/D8 { 0.0000 1.0000 0.0000 setrgbcolor } def % green')
  827  format ('/DA { 1.0000 1.0000 0.0000 setrgbcolor } def % yellow')
  828  format ('/DC { 1.0000 0.0000 0.0000 setrgbcolor } def % red')
  829  format ('/DE { 1.0000 1.0000 1.0000 setrgbcolor } def % white')
  830  format ('/DG { 0.0000 0.0000 0.0000 setrgbcolor } def % pas uti')
  831  format ('/d1 { 0.0000 0.0000 1.0000 setrgbcolor } def %')
  832  format ('/d3 { 0.0000 0.6078 1.0000 setrgbcolor } def %')
  833  format ('/d5 { 0.0000 0.9333 1.0000 setrgbcolor } def %')
  834  format ('/d7 { 0.0000 1.0000 0.6078 setrgbcolor } def %')
  835  format ('/d9 { 0.7058 1.0000 0.0000 setrgbcolor } def %')
  836  format ('/dB { 1.0000 0.9333 0.0000 setrgbcolor } def %')
  837  format ('/dD { 1.0000 0.6078 0.0000 setrgbcolor } def %')
  838  format ('/dF { 1.0000 0.0000 0.0000 setrgbcolor } def %')
  839  format ('/d2 { 0.0000 0.3490 1.0000 setrgbcolor } def %')
  840  format ('/d4 { 0.0000 0.7882 1.0000 setrgbcolor } def %')
  841  format ('/d6 { 0.0000 1.0000 0.7882 setrgbcolor } def %')
  842  format ('/d8 { 0.6078 1.0000 0.0000 setrgbcolor } def %')
  843  format ('/dA { 1.0000 1.0000 0.0000 setrgbcolor } def %')
  844  format ('/dC { 1.0000 0.7882 0.0000 setrgbcolor } def %')
  845  format ('/dE { 1.0000 0.3490 0.0000 setrgbcolor } def %')
  846  format ('/dG { 0.0000 0.0000 0.0000 setrgbcolor } def %')
c 947  format ('/Courier findfont 9 scalefont setfont')
c   947  format ('/Courier findfont',/,
c      +        'dup length dict begin',/,
c      +        '   {1 index /FID ne {def} {pop pop} ifelse} forall',/,
c      +        '   /Encoding ISOLatin1Encoding def',/,
c      +        '   currentdict',/,
c      +        'end',/,
c      +        '/Courier-ISOLatin1 exch definefont 14 scalefont setfont')
c bp : choix de la police tq definie dans option.eso
c taille 12
  847  format ('/Courier findfont',/,
     +        'dup length dict begin',/,
     +        '   {1 index /FID ne {def} {pop pop} ifelse} forall',/,
     +        '   /Encoding ISOLatin1Encoding def',/,
     +        '   currentdict',/,
     +        'end',/,
     +        '/Courier-ISOLatin1 exch definefont 12 scalefont setfont')
  848  format ('/Helvetica findfont',/,
     +        'dup length dict begin',/,
     +        '   {1 index /FID ne {def} {pop pop} ifelse} forall',/,
     +        '   /Encoding ISOLatin1Encoding def',/,
     +        '   currentdict',/,
     +        'end',/,
     +      '/Helvetica-ISOLatin1 exch definefont 12 scalefont setfont')
  849  format ('/Times findfont',/,
     +        'dup length dict begin',/,
     +        '   {1 index /FID ne {def} {pop pop} ifelse} forall',/,
     +        '   /Encoding ISOLatin1Encoding def',/,
     +        '   currentdict',/,
     +        'end',/,
     +      '/Times-ISOLatin1 exch definefont 12 scalefont setfont')
c taille 14
  850  format ('/Courier findfont',/,
     +        'dup length dict begin',/,
     +        '   {1 index /FID ne {def} {pop pop} ifelse} forall',/,
     +        '   /Encoding ISOLatin1Encoding def',/,
     +        '   currentdict',/,
     +        'end',/,
     +        '/Courier-ISOLatin1 exch definefont 14 scalefont setfont')
  851  format ('/Helvetica findfont',/,
     +        'dup length dict begin',/,
     +        '   {1 index /FID ne {def} {pop pop} ifelse} forall',/,
     +        '   /Encoding ISOLatin1Encoding def',/,
     +        '   currentdict',/,
     +        'end',/,
     +      '/Helvetica-ISOLatin1 exch definefont 14 scalefont setfont')
  852  format ('/Times findfont',/,
     +        'dup length dict begin',/,
     +        '   {1 index /FID ne {def} {pop pop} ifelse} forall',/,
     +        '   /Encoding ISOLatin1Encoding def',/,
     +        '   currentdict',/,
     +        'end',/,
     +      '/Times-ISOLatin1 exch definefont 14 scalefont setfont')
c taille 16
  853  format ('/Courier findfont',/,
     +        'dup length dict begin',/,
     +        '   {1 index /FID ne {def} {pop pop} ifelse} forall',/,
     +        '   /Encoding ISOLatin1Encoding def',/,
     +        '   currentdict',/,
     +        'end',/,
     +        '/Courier-ISOLatin1 exch definefont 16 scalefont setfont')
  854  format ('/Helvetica findfont',/,
     +        'dup length dict begin',/,
     +        '   {1 index /FID ne {def} {pop pop} ifelse} forall',/,
     +        '   /Encoding ISOLatin1Encoding def',/,
     +        '   currentdict',/,
     +        'end',/,
     +      '/Helvetica-ISOLatin1 exch definefont 16 scalefont setfont')
  855  format ('/Times findfont',/,
     +        'dup length dict begin',/,
     +        '   {1 index /FID ne {def} {pop pop} ifelse} forall',/,
     +        '   /Encoding ISOLatin1Encoding def',/,
     +        '   currentdict',/,
     +        'end',/,
     +      '/Times-ISOLatin1 exch definefont 16 scalefont setfont')
c taille 18
  856  format ('/Courier findfont',/,
     +        'dup length dict begin',/,
     +        '   {1 index /FID ne {def} {pop pop} ifelse} forall',/,
     +        '   /Encoding ISOLatin1Encoding def',/,
     +        '   currentdict',/,
     +        'end',/,
     +        '/Courier-ISOLatin1 exch definefont 18 scalefont setfont')
  857  format ('/Helvetica findfont',/,
     +        'dup length dict begin',/,
     +        '   {1 index /FID ne {def} {pop pop} ifelse} forall',/,
     +        '   /Encoding ISOLatin1Encoding def',/,
     +        '   currentdict',/,
     +        'end',/,
     +      '/Helvetica-ISOLatin1 exch definefont 18 scalefont setfont')
  858  format ('/Times findfont',/,
     +        'dup length dict begin',/,
     +        '   {1 index /FID ne {def} {pop pop} ifelse} forall',/,
     +        '   /Encoding ISOLatin1Encoding def',/,
     +        '   currentdict',/,
     +        'end',/,
     +      '/Times-ISOLatin1 exch definefont 18 scalefont setfont')
c bp : fin du choix de la police
  948  format ('23 CM  1 CM translate 90 rotate')
 1948  format ('2 CM  2 CM translate')
  949  format ('%%EndProlog')
      else
C        backspace  IUPS
      endif
      write (IUPS,957) ipag,ipag
      write (IUPS,958)
      write (IUPS,959)
 957  format ('%%Page: ',i5,1x,i5)
 958  format ('StartPage')
 959  format ('H0')
      RETURN         
**

C======================================================================
C     DEFINITION FENETRE + TITRE : sDFENE ou cDFENE
C======================================================================

      ENTRY sDFENE(XMI,XXA,YMI,YYA,XR1,XR2,YR1,YR2,FENE)
      ENTRY cDFENE(XMI,XXA,YMI,YYA,XR1,XR2,YR1,YR2,FENE)
*  DEFINITION FENETRE
      XR1=XMI
      XR2=XXA
      YR1=YMI
      YR2=YYA
      FENET=FENE
      XMIN=XMI
      XXAX=XXA
      YMIN=YMI
      YYAX=YYA
      IF (FENET) THEN
       if (.not.valeur) xiocad=xiocad-5*clx
       if (valeur) xiocad=xiocad-10*clx
      endif
      yiocad=yiocad-2*clx
      XRAP=xIOCAD/(XXAX-XMIN)*0.95
      YRAP=yIOCAD/(YYAX-YMIN)*0.95
      rap=min(xrap,yrap)
      if (fenet) then
       xrap=rap
       yrap=rap
      endif
      IF (FENET) THEN
       if (.not.valeur) xiocad=xiocad+5*clx
       if (valeur) xiocad=xiocad+10*clx
      endif
      yiocad=yiocad+2*clx
      XDEP=-XMIN + (xxax-xmin)*0.02
      YDEP=-YMIN + (YYAX-YMIN)*0.02+CLX/YRAP
      
c     on commence par se positionner 
      write (iups,fmt='(''0. CX 0. CX MX'')')
      NBC=LTITRE
      XCO=NBC*CLX/XRAP
      YCO=0
c     options de CCTRACE
      ANGLE=0.d0
      IALIGN=0
       
c     on traite ensuite le titre (traitement caractere par caractere)
      CALL CHAIPS(TITRE,LTITRE)

      RETURN
**

C======================================================================
C     ECRITURE TEXTE (ENTETE & VALEURS LEGENDE ...) : sTRLAB ou CTRLAB
C======================================================================

      ENTRY sTRLAB(XT,YT,CARAC,NCARR,HAUT)
*  ECRITURE TEXT
*  ECRIT ENTETE & VALEURS LEGENDE ISOVALEURS
      if (icoul.ne.0) then
          write (IUPS,fmt='(''CN'')')
          icoul=0
      endif
      ENTRY cTRLAB(XT,YT,CARAC,NCARR,HAUT)
      NBC=LONG(CARAC(1:NCARR))
C JYYYY Debut
c     on commence par se positionner 
      write (IUPS,fmt='(F6.3,'' CX '',F6.3,'' CX MX '')')
     # BORNEX((XDEP+XT)*XRAP),BORNEY((YDEP+YT)*YRAP)
c c     on remplit CHAINE
c       CHAINE(1:1)='('
c       CHAINE(2:NBC+1)=CARAC(1:NBC)
c       CHAINE(nbc+2:nbc+5)=') SX'
c c     on ecrit CHAINE
c       write (iups,970) chaine(1:nbc+5)
c  970  format (a)
C JYYYY Fin
c     on traite ensuite le texte (traitement caractere par caractere)
      CALL CHAIPS(CARAC,NBC)    
      RETURN
**

C======================================================================
C     CHANGEMENT DE COULEUR : sCHCOU ou cCHCOU
C======================================================================

      ENTRY sCHCOU(JCOLO)
*  CHANGEMENT DE COULEUR

      kcoul=itb(mod(jcolo,16)+1)
      RETURN
      ENTRY cCHCOU(JCOLO)
      kcoul=itb(mod(jcolo,16)+1)
      if (icoul.ne.-kcoul) then
          cha='(''D'//ctb(kcoul:kcoul)//''')'
          write (IUPS,fmt=cha)
          icoul=kcoul
      endif
      RETURN
**

C======================================================================
C     CHANGEMENT SEGMENT : sINSEG ou cINSEG  -->  IGNORE
C======================================================================

      ENTRY sINSEG(JSEG,IRESS)
      ENTRY cINSEG(JSEG,IRESS)
*  CHANGEMENT SEGMENT       IGNORE
      RETURN
**

C======================================================================
C     tracé de POLYLINE (LIGNES) : sPOLRL ou cPOLRL
C======================================================================

      ENTRY sPOLRL(NTRSTU,XTR,YTR)
*  POLYLINE
      if (icoul.ne.0) then
          write (IUPS,fmt='(''CN'')')
          icoul=0
      endif
      ENTRY cPOLRL(NTRSTU,XTR,YTR)
C JYYY Debut
      IF ( NTRSTU .LE. 1 ) RETURN
      write (IUPS,fmt='(40(I4,1X))')
     # (IORNCX((XTR(I)+XDEP)*XRAP),IORNCY((YTR(I)+YDEP)*YRAP),
     #  I=1,NTRSTU-1)
      write (IUPS,fmt='(I2,1X,I4,1X,I4,'' DL'')') (NTRSTU-1),
     # IORNCX((XTR(NTRSTU)+XDEP)*XRAP),IORNCY((YTR(NTRSTU)+YDEP)*YRAP)
C JYYY Fin
      RETURN
**

C======================================================================
C     tracé de FACETTE : sTRFAC ou cTRFAC
C======================================================================

      ENTRY sTRFAC(NTRSTU,XTR,YTR,ZN,ICOLE,IEFF)
*  FACETTE
C JYYY Debut
      IF ( NTRSTU .LE. 1 ) RETURN
C JYYY Fin
      kcoul=itb(icole+1)
      if (icoul.ne.kcoul) then
          cha='(''C'//ctb(kcoul:kcoul)//''')'
          write (IUPS,fmt=cha)
          icoul=kcoul
      endif
      goto 100
      ENTRY cTRFAC(NTRSTU,XTR,YTR,ZN,ICOLE,IEFF)
C JYYY Debut
      IF ( NTRSTU .LE. 1 ) RETURN
C JYYY Fin
      kcoul=itb(icole+1)
      if (icoul.ne.kcoul) then
          cha='(''D'//ctb(kcoul:kcoul)//''')'
          write (IUPS,fmt=cha)
          icoul=kcoul
      endif
 100  continue
C JYYY Debut
      write (IUPS,fmt='(40(I4,1X))')
     # (IORNCX((XTR(I)+XDEP)*XRAP),IORNCY((YTR(I)+YDEP)*YRAP),
     #  I=1,NTRSTU-1)
      write (IUPS,fmt='(I2,1X,I4,1X,I4,'' DS'')') (NTRSTU-1),
     # IORNCX((XTR(NTRSTU)+XDEP)*XRAP),IORNCY((YTR(NTRSTU)+YDEP)*YRAP)
C JYYY Fin
      IEFF=1
      RETURN
**

C======================================================================
C     tracé de ??? : sTRAIS ou sTRAIS
C======================================================================

      ENTRY sTRAIS(NP,XTR,YTR,ICOLE)
*  FACETTE
C JYYY Debut
      IF ( NP .LE. 1 ) RETURN
C JYYY Fin
      if (miso.lt.16) then
       kcoul=itb(icole+1)
       if (icoul.ne.kcoul) then
          cha='(''c'//ctb(kcoul:kcoul)//''')'
          write (IUPS,fmt=cha)
          icoul=-kcoul
       endif
      else
       kcoul=icole
          cha='(''e'//ctc(kcoul:kcoul)//''')'
          write (IUPS,fmt=cha)
          icoul=-kcoul
      endif
      goto 101
      ENTRY cTRAIS(NP,XTR,YTR,ICOLE)
C JYYY Debut
      IF ( NP .LE. 1 ) RETURN
C JYYY Fin
      if (miso.lt.16) then
       kcoul=itb(icole+1)
       if (icoul.ne.kcoul) then
          cha='(''d'//ctb(kcoul:kcoul)//''')'
          write (IUPS,fmt=cha)
          icoul=-32000
       endif
      else
       kcoul=icole
          cha='(''f'//ctc(kcoul:kcoul)//''')'
          write (IUPS,fmt=cha)
          icoul=-32000
      endif
 101  continue
C JYYY Debut
      write (IUPS,fmt='(40(I4,1X))')
     # (IORNCX((XTR(I)+XDEP)*XRAP),IORNCY((YTR(I)+YDEP)*YRAP),
     #  I=1,NP-1)
      if (np.gt.2)
     # write (IUPS,fmt='(I2,1X,I4,1X,I4,'' DS'')') (NP-1),
     # IORNCX((XTR(NP)+XDEP)*XRAP),IORNCY((YTR(NP)+YDEP)*YRAP)
       if (np.eq.2)
     # write (IUPS,fmt='(I2,1X,I4,1X,I4,'' DL'')') (NP-1),
     # IORNCX((XTR(NP)+XDEP)*XRAP),IORNCY((YTR(NP)+YDEP)*YRAP)
C JYYY Fin
      RETURN
**

C======================================================================
C     DIGITALISATION DE POINT : sTRDIG ou cTRDIG --> IGNORE
C======================================================================

      ENTRY sTRDIG(XRO,XCOL,ICLE)
      ENTRY cTRDIG(XRO,XCOL,ICLE)
*  DIGITALISATION DE POINT  IGNORE
      ICLE=0
      RETURN
**
      ENTRY sTRAFF(ICLE)
      ENTRY cTRAFF(ICLE)
*  FIN DE DESSIN
      ipag=ipag+1
      write (IUPS,956)
 956  format ('EndPage')
C      write (IUPS,960)
C 960  format ('end')
      icoul=0
      ICLE=0
      RETURN
**

C======================================================================
C     MENU : sMENU ou cMENU --> IGNORE
C======================================================================

      ENTRY sMENU(LEGEND,NCASE,LLONG)
      ENTRY cMENU(LEGEND,NCASE,LLONG)
*  MENU       IGNORE
      RETURN
**
      ENTRY sTRANI(ITYPI,NBIMAH)
      ENTRY cTRANI(ITYPI,NBIMAH)
*  ANIMATION  IGNOREE
      RETURN
**
      ENTRY sTRIMA(IMAGI)
      ENTRY cTRIMA(IMAGI)
*  IMAGE      IGNOREE
      RETURN
**

C======================================================================
C     CHANGEMENT DE VIEW
C======================================================================

      ENTRY sFVALI(IFENI,IRESU,NH,NISO)
      ENTRY cFVALI(IFENI,IRESU,NH,NISO)
*  CHANGEMENT DE VIEW PORT
*  TRACE COULEURS LEGENDE ISOVALEURS
*  XDEP,YDEP : coin bas gauche de la legende
      IF (IFENI.EQ.1) THEN
       XRAP=CLX*10/0.95
       YRAP=clx*2/0.95
       XDEP=(xiocad-10*clx)/xrap
       YDEP=-1.323
      ENDIF
       NH=31
       MISO=NISO
       if (ifeni.eq.1) return
*  definition dynamique des couleurs
      if (niso.gt.15) then
      do 10 i=1,niso
      bw=0.9-i/(2.*niso)
      write (iups,700) ctc(i:i),bw
 700  format('/e',A1,' {',f6.3,' setgray } def')
  10  continue
      do 20 i=1,niso/3
      rouge=0
      vert=3.*i/niso
      bleu=1
      write (iups,710) ctc(i:i),rouge,vert,bleu
 710  format('/f',A1,' {',3f7.4,' setrgbcolor } def')
  20  continue
      do 21 i=niso/3+1,niso/2
      rouge=0
      vert=1
      bleu=(3.*niso-6.*i)/niso
      write (iups,710) ctc(i:i),rouge,vert,bleu
  21  continue
      do 22 i=niso/2+1,(2*niso)/3
      rouge=(6.*i-3.*niso)/niso
      vert=1
      bleu=0
      write (iups,710) ctc(i:i),rouge,vert,bleu
  22  continue
      do 23 i=(2*niso)/3+1,niso
      rouge=1
      vert=(3.*niso-3.*i)/niso
      bleu=0
      write (iups,710) ctc(i:i),rouge,vert,bleu
  23  continue
      endif
      RETURN
**
      ENTRY sZOOM(IZOOM,XMI,XMA,YMI,YMA)
      ENTRY cZOOM(IZOOM,XMI,XMA,YMI,YMA)
*  IGNOREE
      RETURN
**
      ENTRY sINIt(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
      ENTRY cINIt(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
*  RETOUR AU DESSIN INITIAL   IGNORE
      RETURN
**
      ENTRY sCHANG(IRESU,ISORT,ICHANG,JSEG)
      ENTRY cCHANG(IRESU,ISORT,ICHANG,JSEG)
*  AFFICHAGE DESAFFICHAGE NUM NOEUDS ELEMENTS QUAL  IGNORE
       RETURN
**
      ENTRY sTRBOX(HAUTX,HAUTY)
      ENTRY cTRBOX(HAUTX,HAUTY)
*  INUTILISE
      RETURN
**
      ENTRY sTREFF
      ENTRY cTREFF
*  INUTILISE
      RETURN
**
      ENTRY sVAL(IRESU,ISORT,NISO)
      ENTRY cVAL(IRESU,ISORT,NISO)
*  INUTILISE
      RETURN
**
      ENTRY sMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL)
      ENTRY cMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL)
*  INUTILISE
      RETURN
**
**
      ENTRY sIMPR
      ENTRY cIMPR
*  INUTILISE
      RETURN
**
      ENTRY sTRTIN
      ENTRY cTRTIN
*  INUTILISE
      RETURN
**
      ENTRY sFLGI
      ENTRY cFLGI
*  INUTILISE
      RETURN
**
      ENTRY sTRMES(CARAC)
      ENTRY cTRMES(CARAC)
*  INUTILISE
      RETURN
**
      ENTRY sTRGET(PROMPT,REPLY)
      ENTRY cTRGET(PROMPT,REPLY)
*  INUTILISE
      RETURN
      ENTRY sTRMFI
      ENTRY cTRMFI
*  INUTILISE
      RETURN
      END