Esope source files

   1 : C XTRINI    SOURCE    BP208322  12/08/02    21:15:51     7468           
   2 : C     INTERFACE POUR XWINDOW
   3 : C     
   4 : C     
   5 : C     
   6 : C  1995 option FACE P.PEGON JRC-ISPRA
   7 :       SUBROUTINE XTRINI(NOL,AXAX,AYAY,TITR,HAUTT,VALEU,NCOUMA)
   8 :       IMPLICIT INTEGER(I-N)
   9 :       EXTERNAL LONG
  10 : -INC CCOPTIO
  11 : -INC CCTRACE      
  12 :       CHARACTER*(18) HEGEND(4)
  13 :       CHARACTER*(*) LEGEND(*)
  14 :       CHARACTER*(500) KEGEND
  15 :       EQUIVALENCE(KEGEND,IEGEND)
  16 :       EQUIVALENCE(HEGEND,JEGEND)
  17 :       CHARACTER*(*) TITR,CARAC,PROMPT,REPLY
  18 :       CHARACTER*80 CHAINE,CHMESS
  19 :       CHARACTER*80 TITRS
  20 :       LOGICAL VALEU,FENE,valeus
  21 :       DIMENSION XTR(1),YTR(1)
  22 :       DIMENSION XMAT(3,3)
  23 :       EQUIVALENCE (CHAINE,ICHAIN)
  24 :       EQUIVALENCE (CHmess,ICHmes)
  25 :       save chmess,ichmes,titrs,valeus
  26 :       SAVE KEGEND,KCASE,KLONG
  27 :       SAVE mcouma,miso
  28 :       SAVE iret
  29 :       SAVE IDEFO
  30 :       SAVE DESSIN,DESSIC
  31 :       SAVE NBOPD,NBPD,NBCHRD,LTITRE
  32 :       SAVE IBOPD,IBPD,IBCHRD
  33 :       SEGMENT DESSIN
  34 :       CHARACTER*(LTITRE) TITRE
  35 :       LOGICAL VALEUR,FENET
  36 :       REAL XMIN,XXAX,YMIN,YYAX
  37 :       REAL OXMIN,OXXAX,OYMIN,OYYAX
  38 :       INTEGER NBOP,NBP,NBCHR
  39 :       INTEGER IOPER(NBOPD),IXINFO(2,NBPD)
  40 :       REAL X(NBPD),Y(NBPD),Z(NBPD)
  41 :       ENDSEGMENT
  42 : *     
  43 :       SEGMENT DESSIC
  44 :       CHARACTER*(NBCHRD) CARACT
  45 :       ENDSEGMENT
  46 :       POINTEUR CESSIN.DESSIN
  47 :       POINTEUR CESSIC.DESSIC
  48 : *     
  49 : *     DECLARATION POUR LGI
  50 :       DIMENSION Q(20),ICOLT(9)
  51 : -INC CCREEL
  52 : C+PPf (FACE)
  53 :       DIMENSION ITCODP(6),ITCODM(6)
  54 :       DATA ITCODP/3,1,5,4,6,2/
  55 :       DATA ITCODM/2,6,1,4,3,5/
  56 : C+PPf 
  57 :       DATA DESSIN/0/
  58 :       DATA ICOLT/0,1,2,5,3,6,4,7,8/
  59 :       DATA HEGEND/'                  ',
  60 :      >     '    Framemaker    ',
  61 :      >     'PostScript couleur',
  62 :      >     '  PostScript NB   '/
  63 :       DATA MISO/0/
  64 : * Pour le lgi verification des bornes
  65 : C  INITIALISATION
  66 :       incr=0
  67 :       chmess=' '
  68 : *  OUVERTURE XWINDOW
  68 :       CALL XOPEN(NCOUMA,ICOSC,IOPOLI)
  69 : *  si ncouma = 0 pas de display on tente le lgi
  70 :       mcouma=ncouma
  71 :       TITRS=TITR
  72 :       LTITRE=LONG(TITRS)
  73 :       ltitre=72
  74 :       IF (DESSIN.EQ.0) THEN
  75 :          NBPD=5000
  76 :          NBOPD=5000
  77 :          NBCHRD=5000
  78 :          SEGINI DESSIN,DESSIC
  78 :          CALL SAVSEG(DESSIN)
  78 :          CALL SAVSEG(DESSIC)
  79 :       ENDIF
  80 :       TITRS=TITR
  81 :       valeus=valeu
  82 :       RETURN
  83 : **    
  84 : C======================================================================
  85 :       ENTRY XDFENE(XMI,XXA,YMI,YYA,XR1,XR2,YR1,YR2,FENE)
  86 : *  DEFINITION FENETRE
  87 :       segact dessin*mod,dessic*mod
  88 : *  reinitialisation du dessin
  89 :       if (mcouma.eq.0) return
  90 :       IBOPD=0
  91 :       IBPD=0
  92 :       IBCHRD=0
  93 :       LTITRE=LONG(TITRS)
  94 :       NBPD=5000
  95 :       NBOPD=5000
  96 :       NBCHRD=5000
  97 :       SEGADJ DESSIN,DESSIC
  98 :       NBOP=0
  99 :       NBCHR=0
 100 :       NBP=0
 101 :       TITRE=TITRS
 102 :       VALEUR=valeus
 103 : *  DEBUT DE DESSIN
 104 :       XR1=XMI
 105 :       XR2=XXA
 106 :       YR1=YMI
 107 :       YR2=YYA
 108 :       FENET=FENE
 109 :       XMIN=XMI
 110 :       XXAX=XXA
 111 :       YMIN=YMI
 112 :       YYAX=YYA
 113 :       OXMIN=XMI
 114 :       OXXAX=XXA
 115 :       OYMIN=YMI
 116 :       OYYAX=YYA
 117 :       RETURN
 118 : **    
 119 : C======================================================================
 120 : cbp       ENTRY XTRLAB(XT,YT,CARAC,NCARR,HAUT,ipoli)
 121 : cbp : ipoli est le 3 eme argument de xopen 
 122 : c    (les 2 premiers étant ncouma et iscreen)
 123 :        ENTRY XTRLAB(XT,YT,CARAC,NCARR,HAUT,IANGLE)
 124 : *  ECRITURE TEXT CODE OPERATION 1  1 POINT DES CARACTERES
 125 :       ncar=long(carac(1:ncarr))
 126 :       NBOP=NBOP+2
 127 :       IF (NBOP.GT.NBOPD) THEN
 128 :          NBOPD=NBOPD+5000
 129 :          SEGADJ DESSIN
 130 :       ENDIF
 131 :       IOPER(NBOP-1)=1
 132 :       IOPER(NBOP)=NCAR
 133 :       NBP=NBP+1
 134 :       IF (NBP.GT.NBPD) THEN
 135 :          NBPD=NBPD+5000
 136 :          SEGADJ DESSIN
 137 :       ENDIF
 138 :       X(NBP)=XT
 139 :       Y(NBP)=YT
 140 :       Z(NBP)=0
 141 : cbp:  on stocke ANGLE + IALIGN de INFOTR(1 et 2) dans IXINFO
 142 : c     et on n utilisera pour l instant qu en cas de sortie PS...
 143 :       IXINFO(1,NBP)=INFOTR(1)
 144 :       IXINFO(2,NBP)=INFOTR(2)
 145 : c       if(INFOTR(1).ne.0.or.INFOTR(1).ne.0.) write(6,*)
 146 : c      &'CARAC=',CARAC(1:NCAR),' IXINFO=',IXINFO(1,NBP),IXINFO(2,NBP)
 147 :       NBCHR=NBCHR+NCAR
 148 :       IF (NBCHR.GT.NBCHRD) THEN
 149 :          NBCHRD=NBCHRD+5000
 150 :          SEGADJ DESSIC
 151 :       ENDIF
 152 :       CARACT(NBCHR-NCAR+1:NBCHR)=CARAC(1:NCAR)
 153 :       RETURN
 154 : **    
 155 : C======================================================================
 156 :       ENTRY XCHCOU(JCOLO)
 157 : *  CHANGEMENT DE COULEUR CODE OPERATION 2 1 ENTIER
 158 :       NBOP=NBOP+2
 159 :       IF (NBOP.GT.NBOPD) THEN
 160 :          NBOPD=NBOPD+5000
 161 :          SEGADJ DESSIN
 162 :       ENDIF
 163 :       IOPER(NBOP-1)=2
 164 :       IOPER(NBOP)=JCOLO
 165 :       RETURN
 166 : **    
 167 : C======================================================================
 168 :       ENTRY XINSEG(JSEG,IRESS)
 169 : *  CHANGEMENT SEGMENT CODE OPERATION 3 1 ENTIER
 170 :       segact dessin*mod,dessic*mod
 171 :       NBOP=NBOP+2
 172 :       IF (NBOP.GT.NBOPD) THEN
 173 :          NBOPD=NBOPD+5000
 174 :          SEGADJ DESSIN
 175 :       ENDIF
 176 :       IOPER(NBOP-1)=3
 177 :       IOPER(NBOP)=JSEG
 178 :       RETURN
 179 : **    
 180 : C======================================================================
 181 :       ENTRY XPOLRL(NTRSTU,XTR,YTR)
 182 : *  POLYLINE CODE OPERATION 4 NBDE POINTS POINTS
 183 :       NBOP=NBOP+2
 184 :       IF (NBOP.GT.NBOPD) THEN
 185 :          NBOPD=NBOPD+5000
 186 :          SEGADJ DESSIN
 187 :       ENDIF
 188 :       IOPER(NBOP-1)=4
 189 :       IOPER(NBOP)=NTRSTU
 190 :       NBP=NBP+NTRSTU
 191 :       IF (NBP.GT.NBPD) THEN
 192 :          NBPD=NBPD+5000
 193 :          SEGADJ DESSIN
 194 :       ENDIF
 195 :       DO 10 I=1,NTRSTU
 196 :          X(NBP-NTRSTU+I)=XTR(I)
 197 :          Y(NBP-NTRSTU+I)=YTR(I)
 198 :  10   CONTINUE
 199 :       RETURN
 200 : **    
 201 : C======================================================================
 202 :       ENTRY XTRFAC(NTRSTU,XTR,YTR,ZN,ICOLE,IEFF)
 203 : *  FACETTE CODE OPERATION 5 NBDE POINTS COULEUR POINTS
 204 : C PPf NBOP=NBOP+3
 205 :       NBOP=NBOP+4
 206 :       IF (NBOP.GT.NBOPD) THEN
 207 :          NBOPD=NBOPD+5000
 208 :          SEGADJ DESSIN
 209 :       ENDIF
 210 : C PPf IOPER(NBOP-2)=5
 211 :       IOPER(NBOP-3)=5
 212 : C PPf IOPER(NBOP-1)=NTRSTU
 213 :       IOPER(NBOP-2)=NTRSTU
 214 : C PPf IOPER(NBOP)=ICOLE
 215 :       IOPER(NBOP-1)=ICOLE
 216 : C+PPf 
 217 :       ZZN=ABS(ZN/REAL(XPI)*2)
 218 :       IF (ZZN.GT.0.99999)ZZN=0.99999
 219 :       IZN=INT(6*ZZN)+1
 220 :       IOPER(NBOP)=ITCODP(IZN)
 221 : C     write (6,*)'ZN, ZZN, IZN, IOPER(NBOP)', ZN, ZZN, IZN, IOPER(NBOP)
 222 : C+PPf 
 223 :       NBP=NBP+NTRSTU
 224 :       IF (NBP.GT.NBPD) THEN
 225 :          NBPD=NBPD+5000
 226 :          SEGADJ DESSIN
 227 :       ENDIF
 228 :       DO 20 I=1,NTRSTU
 229 :          X(NBP-NTRSTU+I)=XTR(I)
 230 :          Y(NBP-NTRSTU+I)=YTR(I)
 231 :          Z(NBP-NTRSTU+I)=0
 232 :  20   CONTINUE
 233 :       IEFF=1
 234 : *     IEFF=0     signifie qu'on ne met pas en noir les traits (cas des iso
 235 :       RETURN
 236 : **    
 237 : C======================================================================
 238 :       ENTRY XTRAIS(NP,XTR,YTR,ICOLE)
 239 : *  FACETTE CODE OPERATION 6 NBDE POINTS POINTS
 240 :       NBOP=NBOP+3
 241 :       IF (NBOP.GT.NBOPD) THEN
 242 :          NBOPD=NBOPD+5000
 243 :          SEGADJ DESSIN
 244 :       ENDIF
 245 :       IOPER(NBOP-2)=6
 246 :       IOPER(NBOP-1)=NP
 247 :       IOPER(NBOP)=ICOLE
 248 :       NBP=NBP+NP
 249 :       IF (NBP.GT.NBPD) THEN
 250 :          NBPD=NBPD+5000
 251 :          SEGADJ DESSIN
 252 :       ENDIF
 253 :       DO 30 I=1,NP
 254 :          X(NBP-NP+I)=XTR(I)
 255 :          Y(NBP-NP+I)=YTR(I)
 256 :          Z(NBP-NP+I)=0
 257 :  30   CONTINUE
 258 :       RETURN
 259 : **    
 260 : C======================================================================
 261 : *  AFFICHAGE DU DESSIN ATTENTE D'EVENEMENT
 262 : C======================================================================
 263 :       ENTRY XTRDIG(XRO,XCOL,ICLE)
 264 :       segact dessin*mod,dessic*mod
 265 :       ICLE=0
 266 :       IRDIG=1
 267 :       GOTO 35
 268 :       ENTRY XTRAFF(ICLE)
 269 :       SEGACT DESSIN,DESSIC
 270 :       ICLE=0
 271 :       IRDIG=0
 272 :  35   CONTINUE
 273 : *  AFFICHAGE DU DESSIN ATTENTE D'EVENEMENT
 274 :       IDAFF=0
 275 :       ITYP=0
 276 :  250  CONTINUE
 277 :       IBOP=IBOPD
 278 :       IBP=IBPD
 279 :       IBCHR=IBCHRD
 280 :       IF (IBOPD.EQ.0) THEN
 281 :          CHAINE(1:LTITRE)=TITRE(1:LTITRE)
 281 :          CALL XRINIT(ICHAIN,VALEUR,LTITRE,MISO)
 282 :       ENDIF
 282 :       CALL XFENET(XMIN,XXAX,YMIN,YYAX,FENET)
 283 :  99   CONTINUE
 284 :  100  CONTINUE
 285 :       IBOP=IBOP+1
 286 :       IF (IBOP.GT.NBOP) GOTO 200
 287 :       ICOD=IOPER(IBOP)
 288 :       IF (ICOD.EQ.1) THEN
 289 :          IBOP=IBOP+1
 290 :          NBCAR=IOPER(IBOP)
 291 :          IBP=IBP+1
 292 :          CHAINE(1:NBCAR)=CARACT(IBCHR+1:IBCHR+NBCAR)
 292 :          CALL XRLABL(X(IBP),Y(IBP),ICHAIN,NBCAR)
 293 :          IBCHR=IBCHR+NBCAR
 294 :       ELSEIF (ICOD.EQ.2) THEN
 295 :          IBOP=IBOP+1
 296 :          ICOUL=IOPER(IBOP)
 296 :          CALL XHCOUL(ICOUL)
 297 :       ELSEIF (ICOD.EQ.3) THEN
 298 : *  OUVERTURE SEGMENT
 299 :          IBOP=IBOP+1
 300 :       ELSEIF (ICOD.EQ.4) THEN
 301 :          IBOP=IBOP+1
 302 :          N=IOPER(IBOP)
 302 :          CALL XOLRL(N,X(IBP+1),Y(IBP+1))
 303 :          IBP=IBP+N
 304 :       ELSEIF (ICOD.EQ.5) THEN
 305 :          IBOP=IBOP+1
 306 :          N=IOPER(IBOP)
 307 :          IBOP=IBOP+1
 308 :          ICOL=IOPER(IBOP)
 308 :          CALL XHCOUL(ICOL)
 309 : C+PPf 
 310 :          IBOP=IBOP+1
 311 :          IZN=IOPER(IBOP)
 312 : C+PPf 
 312 : C PPf  CALL XRFACE(N,X(IBP+1),Y(IBP+1))
 312 :          CALL XRFACE(N,X(IBP+1),Y(IBP+1),IZN)
 313 :          IBP=IBP+N
 314 :       ELSEIF (ICOD.EQ.6) THEN
 315 :          IBOP=IBOP+1
 316 :          N=IOPER(IBOP)
 317 :          IBOP=IBOP+1
 318 :          ICO=IOPER(IBOP)
 319 :          if (ico.gt.1000.or.ico.lt.0) then
 320 : *           write (6,*) '1 - ico incorrect ',ico
 321 :            ico=0
 322 :          endif 
 323 : C palette des iso
 324 :          if (mcouma.ge.16) ico=ico+100
 324 :          CALL XHCOUL(ICO)
 324 :          if (N.GT.2) CALL XRAISO(N,X(IBP+1),Y(IBP+1))
 324 :          if (N.EQ.2) CALL XOLRL(N,X(IBP+1),Y(IBP+1))
 325 :          IBP=IBP+N
 326 :       ELSEIF (ICOD.EQ.7) THEN
 327 :          IBOP=IBOP+1
 328 :          IFENJ=IOPER(IBOP)
 328 :          CALL XVALIS(IFENJ,IRESV,NHH)
 329 :       ELSEIF (ICOD.EQ.8) THEN
 330 : *  menu en blanc
 330 :          CALL XHCOUL(7)
 330 :          CALL XENU(IEGEND,KCASE,KLONG)
 331 :       ELSEIF (ICOD.EQ.9) THEN
 332 :          IBOP=IBOP+1
 333 :          IMAG=IOPER(IBOP)
 333 :          CALL XRIMAG(IMAG)
 334 :       ELSEIF (ICOD.EQ.10) THEN
 335 :          IBOP=IBOP+1
 336 :          ITYP=IOPER(IBOP)
 337 :          IBOP=IBOP+1
 338 :          NBIMAG=IOPER(IBOP)
 338 :          CALL XRANIM(ITYP,NBIMAG)
 338 : ***    CALL XRSWAP(IRET)
 339 :       ELSEIF (ICOD.EQ.11) THEN
 340 : *  menu en blanc
 341 :          If(icosc.eq.1) then
 341 :            CALL XHCOUL(7)
 342 :          else
 342 :            CALL XHCOUL(0)
 343 :          endif
 344 :       ENDIF
 345 :       GOTO 100
 346 :  200  CONTINUE
 347 :       IBPD=IBP
 348 :       IBOPD=IBOP-1
 349 :       IBCHRD=IBCHR
 350 : *  cas animation et affichage initial. on swappe pour voir qqchose
 350 : **    IF (ITYP.GT.0.and.iret.eq.0) CALL XRSWAP(IRET)
 351 :       iret=0
 352 :       ICLE=-2
 353 : *  on affiche un message eventuel
 354 :       if (chmess.ne.' ') then
 355 :          nbcar=long(chmess)
 355 :          CALL XVALIS(3,IRESV,NHH)
 355 :          CALL XHCOUL(7)
 355 :          CALL XRLABL(0.,0.,ICHmes,NBCAR)
 356 :       endif
 356 :       CALL XRAFF(YRO,YCOL,IRDIG,ICLE)
 357 :       IF (IRDIG.EQ.1) THEN
 358 :          XRO=YRO
 359 :          XCOL=YCOL
 360 :       ENDIF
 361 : *  reaffichage
 362 :       IF (ICLE.EQ.-1) THEN
 363 :          IBPD=0
 364 :          IBOPD=0
 365 :          IBCHRD=0
 366 :          GOTO 250
 367 :       ENDIF
 368 : *  on invalide le message eventuel
 369 :       chmess=' '
 370 : *  CLE INACTIVE
 371 :       IF (ICLE.GE.0) THEN
 372 :          IF (KEGEND(ICLE*KLONG+1:(ICLE+1)*KLONG).EQ.' ') ICLE=-2
 373 :          IF(KEGEND(1+ICLE*KLONG+(klong-8)/2:
 374 :      #        (ICLE+1)*KLONG).EQ.'Softcopy') GOTO 700
 375 :       ENDIF
 376 : **      IF (ICLE.EQ.7.AND.KCASE.EQ.9) THEN
 377 :       iou=9
 378 :       ipuo=1+klong*(iou-1)
 379 : *      write(6,*) Kegend(IPUO:IPUO+10)
 380 : *       write(6,*)' icle ' , icle
 381 :        ipuo=1+klong*(iou-1)
 382 :       IF(ICLE.EQ.8.AND.Kegend(ipuo:ipuo+10).eq.'  Animation')
 383 :      $        THEN
 384 : *      write(6,*) ' on tente lanimation '
 385 : *  ANIMATION
 386 :          IDES=0
 387 :          INCR=1
 388 :  310     CONTINUE
 389 :          IDES=IDES+INCR
 390 :          IF (IDES.EQ.NBIMAG) INCR=-1
 391 :          IF (IDES.EQ.1)      INCR= 1
 392 :          IBOP=0
 393 :          IBP=0
 394 :          IBCHR=0
 395 :          ITRAC=0
 395 :          CALL XFENET(XMIN,XXAX,YMIN,YYAX,FENET)
 396 :  301     CONTINUE
 397 :          IBOP=IBOP+1
 398 :          IF (IBOP.GT.NBOP) GOTO 302
 399 :          ICOD=IOPER(IBOP)
 400 :          IF (ICOD.EQ.1) THEN
 401 :             IBOP=IBOP+1
 402 :             NBCAR=IOPER(IBOP)
 403 :             IBP=IBP+1
 404 :             CHAINE(1:NBCAR)=CARACT(IBCHR+1:IBCHR+NBCAR)
 404 :             IF (ITRAC.NE.0) CALL XRLABL(X(IBP),Y(IBP),ICHAIN,NBCAR)
 405 :             IBCHR=IBCHR+NBCAR
 406 :          ELSEIF (ICOD.EQ.2) THEN
 407 :             IBOP=IBOP+1
 408 :             ICOUL=IOPER(IBOP)
 408 :             IF (ITRAC.NE.0) CALL XHCOUL(ICOUL)
 409 :          ELSEIF (ICOD.EQ.3) THEN
 410 : *  OUVERTURE SEGMENT
 411 :             IBOP=IBOP+1
 412 :          ELSEIF (ICOD.EQ.4) THEN
 413 :             IBOP=IBOP+1
 414 :             N=IOPER(IBOP)
 414 :             IF (ITRAC.NE.0) CALL XOLRL(N,X(IBP+1),Y(IBP+1))
 415 :             IBP=IBP+N
 416 :          ELSEIF (ICOD.EQ.5) THEN
 417 :             IBOP=IBOP+1
 418 :             N=IOPER(IBOP)
 419 :             IBOP=IBOP+1
 420 :             ICOL=IOPER(IBOP)
 421 : C+PPf 
 422 :             IBOP=IBOP+1
 423 : C+PPf 
 424 :             IF (ITRAC.NE.0) THEN
 424 :                CALL XHCOUL(ICOL)
 425 : C+PPf 
 426 :                IZN=IOPER(IBOP)
 427 : C+PPf 
 427 : C PPf      CALL XRFACE(N,X(IBP+1),Y(IBP+1))
 427 :                CALL XRFACE(N,X(IBP+1),Y(IBP+1),IZN)
 428 :             ENDIF
 429 :             IBP=IBP+N
 430 :          ELSEIF (ICOD.EQ.6) THEN
 431 :             IBOP=IBOP+1
 432 :             N=IOPER(IBOP)
 433 :             IBOP=IBOP+1
 434 :             ICO=IOPER(IBOP)
 435 :          if (ico.gt.1000.or.ico.lt.0) then
 436 : *           write (6,*) '2 - ico incorrect ',ico
 437 :            ico=0
 438 :          endif
 439 :             if (mcouma.ge.16) ico=ico+100
 440 :             IF (ITRAC.NE.0) THEN
 440 :                CALL XHCOUL(ICO)
 440 :                if (N.GT.2) CALL XRAISO(N,X(IBP+1),Y(IBP+1))
 440 :                if (N.EQ.2) CALL XOLRL(N,X(IBP+1),Y(IBP+1))
 441 :             ENDIF
 442 :             IBP=IBP+N
 443 :          ELSEIF (ICOD.EQ.7) THEN
 444 :             IBOP=IBOP+1
 445 :             IFENJ=IOPER(IBOP)
 445 :             IF (ITRAC.NE.0) CALL XVALIS(IFENJ,IRESV,NHH)
 446 :          ELSEIF (ICOD.EQ.8) THEN
 447 :          ELSEIF (ICOD.EQ.9) THEN
 448 :             IBOP=IBOP+1
 449 :             IMAG=IOPER(IBOP)
 450 :             IF (IDES.EQ.IMAG) ITRAC=1
 451 :             IF (IDES.NE.IMAG) ITRAC=0
 452 :          ELSEIF (ICOD.EQ.10) THEN
 453 :             IBOP=IBOP+1
 454 :             ITYP=IOPER(IBOP)
 455 :             IBOP=IBOP+1
 456 :             NBIMAG=IOPER(IBOP)
 457 :          ELSEIF (ICOD.EQ.11) THEN
 458 :          ENDIF
 459 :          GOTO 301
 460 :  302     CONTINUE
 460 :          CALL XRSWAP(IRET)
 461 :          IF (IRET.EQ.0.AND.(ITYP.NE.1.OR.INCR.EQ.1)) GOTO 310
 461 :          CALL XENU(IEGEND,KCASE,KLONG)
 462 :          GOTO 250
 463 :       ENDIF
 464 :       if (irdig.eq.0) SEGDES DESSIN,DESSIC
 465 :       RETURN
 466 :  700  CONTINUE
 467 : *  on propose le choix de la softcopie
 467 :       CALL XHCOUL(7)
 467 :       CALL XENU(JEGEND,4,18)
 467 :       CALL XRAFF(YRO,YCOL,IRDIG,ICLE)
 468 :       if (icle.le.0) goto 700
 469 :       icle=icle+1
 470 : *  on signale qu'on a compris l'instruction
 470 :       CALL XVALIS(3,IRESV,NHH)
 470 :       CALL XHCOUL(0)
 471 :       chaine='Softcopie '//hegend(icle)
 472 :      >     (1:long(hegend(icle)))//' effectuee'
 472 :       CALL XRLABL(0.,0.,ICHAIN,80)
 473 : *  on repositionne le menu
 473 :       CALL XENU(IEGEND,KCASE,KLONG)
 474 : C---------------------------------------------------
 475 : *  impression du dessin (Softcopy)
 476 : *  on reboucle sur la structure du trace
 477 :       IDAFF=0
 478 :       ITYP=0
 479 :  750  CONTINUE
 480 :       IBOP=0
 481 :       IBP=0
 482 :       IBCHR=0
 483 :       CHAINE=TITRE(1:LTITRE)
 484 :       if (icle.eq.4) then
 484 :          CALL strini(24,axax,ayay,chaine(1:ltitre),1.5,.true.,ncoumb)
 484 :          CALL sdfene(XMIN,XXAX,YMIN,YYAX,XXR1,XXR2,YYR1,YYR2,FENET)
 484 :          CALL sfvali(0,iresv,nhh,MISO)
 485 :       elseif (icle.eq.3) then
 485 :          CALL ctrini(24,axax,ayay,chaine(1:ltitre),1.5,.true.,ncoumb)
 485 :          CALL cdfene(XMIN,XXAX,YMIN,YYAX,XXR1,XXR2,YYR1,YYR2,FENET)
 485 :          CALL cfvali(0,iresv,nhh,MISO)
 486 :       elseif (icle.eq.2) then
 486 :          CALL mtrini(24,axax,ayay,chaine,1.5,.true.,ncoumb)
 486 :          CALL mdfene(XMIN,XXAX,YMIN,YYAX,XXR1,XXR2,YYR1,YYR2,FENET)
 487 :       endif
 488 : c     boucle sur le objets IBOP
 489 :  760  CONTINUE
 490 :       IBOP=IBOP+1
 491 :       IF (IBOP.GT.NBOP) then
 492 :          if (icle.eq.4) then
 492 :             call straff(ibid)
 493 :          elseif (icle.eq.3) then
 493 :             call ctraff(ibid)
 494 :          elseif (icle.eq.2) then
 494 :             call mtraff(ibid)
 495 :          endif
 496 :          GOTO 200
 497 :       endif
 498 :       ICOD=IOPER(IBOP)
 499 : c     il s'agit d un label      
 500 :       IF (ICOD.EQ.1) THEN
 501 :          IBOP=IBOP+1
 502 :          NBCAR=IOPER(IBOP)
 503 :          IBP=IBP+1
 504 :          CHAINE(1:NBCAR)=CARACT(IBCHR+1:IBCHR+NBCAR)
 505 :          INFOTR(1)=IXINFO(1,IBP)
 506 :          INFOTR(2)=IXINFO(2,IBP)
 507 :          if (icle.eq.4) then
 507 :             CALL strlab(X(IBP),Y(IBP),CHAINE,NBCAR,0.15)
 508 :          elseif (icle.eq.3) then
 508 :             CALL ctrlab(X(IBP),Y(IBP),CHAINE,NBCAR,0.15)
 509 :          elseif (icle.eq.2) then
 509 :             CALL mtrlab(X(IBP),Y(IBP),CHAINE,NBCAR,0.15)
 510 :          endif
 511 :          INFOTR(1)=0
 512 :          INFOTR(2)=0
 513 :          IBCHR=IBCHR+NBCAR
 514 : c     il s'agit d une couleur
 515 :       ELSEIF (ICOD.EQ.2) THEN
 516 :          IBOP=IBOP+1
 517 :          ICOUL=IOPER(IBOP)
 518 :          if (icle.eq.4) then
 518 :             CALL schcou(ICOUL)
 519 :          elseif (icle.eq.3) then
 519 :             CALL cchcou(ICOUL)
 520 :          elseif (icle.eq.2) then
 520 :             CALL mchcou(ICOUL)
 521 :          endif
 522 :       ELSEIF (ICOD.EQ.3) THEN
 523 : *  OUVERTURE SEGMENT
 524 :          IBOP=IBOP+1
 525 :       ELSEIF (ICOD.EQ.4) THEN
 526 :          IBOP=IBOP+1
 527 :          N=IOPER(IBOP)
 528 :          if (icle.eq.4) then
 528 :             CALL spolrl(N,X(IBP+1),Y(IBP+1))
 529 :          elseif (icle.eq.3) then
 529 :             CALL cpolrl(N,X(IBP+1),Y(IBP+1))
 530 :          elseif (icle.eq.2) then
 530 :             CALL mpolrl(N,X(IBP+1),Y(IBP+1))
 531 :          endif
 532 :          IBP=IBP+N
 533 :       ELSEIF (ICOD.EQ.5) THEN
 534 :          IBOP=IBOP+1
 535 :          N=IOPER(IBOP)
 536 :          IBOP=IBOP+1
 537 :          ICOL=IOPER(IBOP)
 538 :          if (icle.eq.4) then
 538 :             CALL strfac(N,X(IBP+1),Y(IBP+1),Z(IBP+1),icol,ibid)
 539 :          elseif (icle.eq.3) then
 539 :             CALL ctrfac(N,X(IBP+1),Y(IBP+1),Z(IBP+1),icol,ibid)
 540 :          elseif (icle.eq.2) then
 541 : C+PPf 
 542 :             IZN=IOPER(IBOP+1)
 543 :             IZN=ITCODM(IZN)
 544 :             ZZN=(IZN-0.99999)*REAL(XPI)/12
 545 : C+PPf 
 545 : C PPf   CALL mtrfac(N,X(IBP+1),Y(IBP+1),Z(IBP+1),icol,ibid)
 545 :             CALL mtrfac(N,X(IBP+1),Y(IBP+1),ZZN,icol,ibid)
 546 :          endif
 547 : C+PPf 
 548 :          IBOP=IBOP+1
 549 : C+PPf 
 550 :          IBP=IBP+N
 551 :       ELSEIF (ICOD.EQ.6) THEN
 552 :          IBOP=IBOP+1
 553 :          N=IOPER(IBOP)
 554 :          IBOP=IBOP+1
 555 :          ICO=IOPER(IBOP)
 556 :          if (icle.eq.4) then
 556 :             CALL strais(N,X(IBP+1),Y(IBP+1),ico)
 557 :          elseif (icle.eq.3) then
 557 :             CALL ctrais(N,X(IBP+1),Y(IBP+1),ico)
 558 :          elseif (icle.eq.2) then
 558 :             CALL mtrais(N,X(IBP+1),Y(IBP+1),ico)
 559 :          endif
 560 :          IBP=IBP+N
 561 :       ELSEIF (ICOD.EQ.7) THEN
 562 :          IBOP=IBOP+1
 563 :          IFENJ=IOPER(IBOP)
 564 :          if (icle.eq.4) then
 564 :             CALL sfvali(IFENJ,IRESV,NHH,miso)
 565 :          elseif (icle.eq.3) then
 565 :             CALL cfvali(IFENJ,IRESV,NHH,miso)
 566 :          elseif (icle.eq.2) then
 566 :             CALL mfvali(IFENJ,IRESV,NHH)
 567 :          endif
 568 :       ELSEIF (ICOD.EQ.8) THEN
 569 : *  pas de menu
 570 :       ELSEIF (ICOD.EQ.9) THEN
 571 : *  pas de nouvelle image
 572 :          IBOP=IBOP+1
 573 :       ELSEIF (ICOD.EQ.10) THEN
 574 :          IBOP=IBOP+1
 575 :          ITYP=IOPER(IBOP)
 576 :          IBOP=IBOP+1
 577 :          NBIMAG=IOPER(IBOP)
 578 :       ELSEIF (ICOD.EQ.11) THEN
 579 : *  menu en blanc
 580 :       ENDIF
 581 :       goto 760
 582 : 
 583 : 
 584 : **    
 585 : C======================================================================
 586 :       ENTRY XMENU(LEGEND,NCASE,LLONG)
 587 : *     
 588 : *  MENU  on sauve le contenu
 589 : *     
 590 :       segact dessin*mod,dessic*mod
 591 :       KLEN=LEN(LEGEND(1))
 592 :       KCASE=NCASE
 593 :       KLONG=LLONG
 594 :       DO 800 II=1,KCASE
 595 :          KEGEND(1+KLONG*(II-1):KLONG*II)=LEGEND(II)
 596 :  800  CONTINUE
 597 : *  on rajoute une touche PS (certains cas seront a exclure)
 598 :       kcase=kcase+1
 599 :       KEGEND(1+KLONG*(kcase-1):KLONG*kcase)=' '
 600 :       KEGEND(1+KLONG*(kcase-1)+(klong-8)/2:KLONG*kcase)='Softcopy'
 601 : C#MC 05/01/99 utilite ? IDEFOR inconuu...
 602 : C      IDEFO=IDEFOR
 603 : *  ON SE MET DANS LE SEGMENT 0
 604 : *  CHANGEMENT SEGMENT CODE OPERATION 3 1 ENTIER
 605 :       NBOP=NBOP+2
 606 :       IF (NBOP.GT.NBOPD) THEN
 607 :          NBOPD=NBOPD+5000
 608 :          SEGADJ DESSIN
 609 :       ENDIF
 610 :       IOPER(NBOP-1)=3
 611 :       IOPER(NBOP)=0
 612 :       NBOP=NBOP+1
 613 :       IF (NBOP.GT.NBOPD) THEN
 614 :          NBOPD=NBOPD+5000
 615 :          SEGADJ DESSIN
 616 :       ENDIF
 617 :       IOPER(NBOP)=8
 618 :       RETURN
 619 : **    
 620 :       ENTRY XTRANI(ITYPI,NBIMAH)
 621 :       NBOP=NBOP+3
 622 :       IF (NBOP.GT.NBOPD) THEN
 623 :          NBOPD=NBOPD+5000
 624 :          SEGADJ DESSIN
 625 :       ENDIF
 626 :       IOPER(NBOP-2)=10
 627 :       IOPER(NBOP-1)=ITYPI
 628 :       IOPER(NBOP)=NBIMAH
 629 :       RETURN
 630 : **    
 631 :       ENTRY XTRIMA(IMAGI)
 632 :       NBOP=NBOP+2
 633 :       IF (NBOP.GT.NBOPD) THEN
 634 :          NBOPD=NBOPD+5000
 635 :          SEGADJ DESSIN
 636 :       ENDIF
 637 :       IOPER(NBOP-1)=9
 638 :       IOPER(NBOP)=IMAGI
 639 :       RETURN
 640 : **    
 641 :       ENTRY XFVALI(IFENI,IRESU,NH,NISO)
 642 :       segact dessin*mod,dessic*mod
 643 : *  sauver le nb d'iso
 644 :       MISO=NISO
 645 : *  CHANGEMENT DE VIEW PORT
 646 :       IF (IFENI.EQ.1) THEN
 647 :          NBOP=NBOP+2
 648 :          IF (NBOP.GT.NBOPD) THEN
 649 :             NBOPD=NBOPD+5000
 650 :             SEGADJ DESSIN
 651 :          ENDIF
 652 :          IOPER(NBOP-1)=7
 653 :          IOPER(NBOP)=IFENI
 654 :       ENDIF
 655 :       NH=31
 656 :       RETURN
 657 : **    
 658 : C======================================================================
 659 :       ENTRY XZOOM(IZOOM,XMI,XMA,YMI,YMA)
 660 : *  mise à jour du cadre
 661 : *  IZOOM=1    zoom
 662 : *  IZOOM=-1   zoom inverse
 663 : *  IZOOM=0    pan
 664 :       segact dessin*mod,dessic*mod
 665 :       if (izoom.eq.1) then
 666 :          XMIN=XMI
 667 :          XXAX=XMA
 668 :          YMIN=YMI
 669 :          YYAX=YMA
 670 :       endif
 671 :       if (izoom.eq.-1) then
 672 :          AXMIN=XMIN-(XMI-XMIN)*(XXAX-XMIN)/(XMA-XMI)
 673 :          AXXAX=AXMIN+(XXAX-XMIN)*(XXAX-XMIN)/(XMA-XMI)
 674 :          XMIN=AXMIN
 675 :          XXAX=AXXAX
 676 :          AYMIN=YMIN-(YMI-YMIN)*(YYAX-YMIN)/(YMA-YMI)
 677 :          AYYAX=AYMIN+(YYAX-YMIN)*(YYAX-YMIN)/(YMA-YMI)
 678 :          YMIN=AYMIN
 679 :          YYAX=AYYAX
 680 :       endif
 681 :       if (izoom.eq.0) then
 682 :          XMIN=XMIN-(XMA-XMI)
 683 :          XXAX=XXAX-(XMA-XMI)
 684 :          YMIN=YMIN-(YMA-YMI)
 685 :          YYAX=YYAX-(YMA-YMI)
 686 :       endif
 687 :       XMI=OXMIN
 688 :       XMA=OXXAX
 689 :       YMI=OYMIN
 690 :       YMA=OYYAX
 691 :       IBPD=0
 692 :       IBOPD=0
 693 :       IBCHRD=0
 694 :       RETURN
 695 : **    
 696 : C======================================================================
 697 :       ENTRY XINI(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
 698 : *  RETOUR AU DESSIN INITIAL
 699 :       segact dessin*mod,dessic*mod
 700 :       XMIN=OXMIN
 701 :       XXAX=OXXAX
 702 :       YMIN=OYMIN
 703 :       YYAX=OYYAX
 704 :       ISORT=0
 705 :       IRESU=2
 706 :       IBPD=0
 707 :       IBOPD=0
 708 :       IBCHRD=0
 709 :       RETURN
 710 : **    
 711 : C======================================================================
 712 :       ENTRY XCHANG(IRESU,ISORT,ICHANG,JSEG)
 713 :       segact dessin*mod,dessic*mod
 714 :       IDSGT=0
 715 : *  affichage desaffichage num noeuds elements qual
 716 :       IF (ICHANG.EQ.1) THEN
 717 :          IBON=1
 718 :          IBOP=0
 719 :          IBCHR=0
 720 :          IBP=0
 721 :          JBOP=0
 722 :          JBCHR=0
 723 :          JBP=0
 724 :  300     CONTINUE
 725 :          IBOP=IBOP+1
 726 :          IF (IBOP.GT.NBOP) GOTO 350
 727 :          ICOD=IOPER(IBOP)
 728 :          IF (IBON.EQ.1) THEN
 729 :             JBOP=JBOP+1
 730 :             IOPER(JBOP)=IOPER(IBOP)
 731 :             IF (ICOD.EQ.1) THEN
 732 : *  xrlabl
 733 :                IBOP=IBOP+1
 734 :                JBOP=JBOP+1
 735 :                IOPER(JBOP)=IOPER(IBOP)
 736 :                NBCAR=IOPER(IBOP)
 737 :                CARACT(JBCHR+1:JBCHR+NBCAR)=CARACT(IBCHR+1:IBCHR+NBCAR)
 738 :                IBCHR=IBCHR+NBCAR
 739 :                JBCHR=JBCHR+NBCAR
 740 :                IBP=IBP+1
 741 :                JBP=JBP+1
 742 :                X(JBP)=X(IBP)
 743 :                Y(JBP)=Y(IBP)
 744 :                Z(JBP)=Z(IBP)
 745 :             ELSEIF (ICOD.EQ.2) THEN
 746 : *  chcoul
 747 :                IBOP=IBOP+1
 748 :                JBOP=JBOP+1
 749 :                IOPER(JBOP)=IOPER(IBOP)
 750 :             ELSEIF (ICOD.EQ.3) THEN
 751 : *  OUVERTURE SEGMENT
 752 :                IBOP=IBOP+1
 753 :                IF (IOPER(IBOP).EQ.JSEG) THEN
 754 :                   IBON=0
 755 : *   IL FAUDRA REPRENDRE LE DESSIN AU DEBUT
 756 :                   IBOPD=0
 757 :                   IBPD=0
 758 :                   IBCHRD=0
 759 : *  ON NE STOCKE PAS CE CHANGEMENT DE SEGMENT
 760 :                   JBOP=JBOP-1
 761 :                   GOTO 300
 762 :                ELSE
 763 :                   JBOP=JBOP+1
 764 :                   IOPER(JBOP)=IOPER(IBOP)
 765 :                ENDIF
 766 :             ELSEIF (ICOD.EQ.4) THEN
 767 : * polyline
 768 :                IBOP=IBOP+1
 769 :                JBOP=JBOP+1
 770 :                IOPER(JBOP)=IOPER(IBOP)
 771 :                N=IOPER(IBOP)
 772 :                DO 305 IIP=1,N
 773 :                   IBP=IBP+1
 774 :                   JBP=JBP+1
 775 :                   X(JBP)=X(IBP)
 776 :                   Y(JBP)=Y(IBP)
 777 :                   Z(JBP)=Z(IBP)
 778 :  305           CONTINUE
 779 :             ELSEIF (ICOD.EQ.5) THEN
 780 : * face
 781 :                IBOP=IBOP+1
 782 :                JBOP=JBOP+1
 783 :                IOPER(JBOP)=IOPER(IBOP)
 784 :                N=IOPER(IBOP)
 785 :                IBOP=IBOP+1
 786 :                JBOP=JBOP+1
 787 :                IOPER(JBOP)=IOPER(IBOP)
 788 :                DO 307 IIP=1,N
 789 :                   IBP=IBP+1
 790 :                   JBP=JBP+1
 791 :                   X(JBP)=X(IBP)
 792 :                   Y(JBP)=Y(IBP)
 793 :                   Z(JBP)=Z(IBP)
 794 :  307           CONTINUE
 795 : C+PPf 
 796 :                IBOP=IBOP+1
 797 :                JBOP=JBOP+1
 798 :                IOPER(JBOP)=IOPER(IBOP)
 799 : C+PPf 
 800 :             ELSEIF (ICOD.EQ.6) THEN
 801 : *  iso
 802 :                IBOP=IBOP+1
 803 :                JBOP=JBOP+1
 804 :                IOPER(JBOP)=IOPER(IBOP)
 805 :                N=IOPER(IBOP)
 806 :                IBOP=IBOP+1
 807 :                JBOP=JBOP+1
 808 :                IOPER(JBOP)=IOPER(IBOP)
 809 :                DO 309 IIP=1,N
 810 :                   IBP=IBP+1
 811 :                   JBP=JBP+1
 812 :                   X(JBP)=X(IBP)
 813 :                   Y(JBP)=Y(IBP)
 814 :                   Z(JBP)=Z(IBP)
 815 :                   IOPER(JBOP)=IOPER(IBOP)
 816 :  309           CONTINUE
 817 :             ELSEIF (ICOD.EQ.7) THEN
 818 : *  fvalis
 819 :                IBOP=IBOP+1
 820 :                JBOP=JBOP+1
 821 :                IOPER(JBOP)=IOPER(IBOP)
 822 :             ELSEIF (ICOD.EQ.8) THEN
 823 : *  menu
 824 :             ELSEIF (ICOD.EQ.9) THEN
 825 : *  changement image
 826 :                IBOP=IBOP+1
 827 :                JBOP=JBOP+1
 828 :                IOPER(JBOP)=IOPER(IBOP)
 829 :             ELSEIF (ICOD.EQ.10) THEN
 830 : *  initialisation animation
 831 :                IBOP=IBOP+2
 832 :                JBOP=JBOP+2
 833 :                IOPER(JBOP)=IOPER(IBOP)
 834 :             ELSEIF (ICOD.EQ.11) THEN
 835 :             ENDIF
 836 :          ELSE
 837 :             IF (ICOD.EQ.1) THEN
 838 : *  xrlabl
 839 :                IBOP=IBOP+1
 840 :                NBCAR=IOPER(IBOP)
 841 :                IBCHR=IBCHR+NBCAR
 842 :                IBP=IBP+1
 843 :             ELSEIF (ICOD.EQ.2) THEN
 844 : *  chcoul
 845 :                IBOP=IBOP+1
 846 :             ELSEIF (ICOD.EQ.3) THEN
 847 : *  OUVERTURE SEGMENT ON REVIENT EN TETE
 848 :                IBOP=IBOP-1
 849 :                IBON=1
 850 :                GOTO 300
 851 :             ELSEIF (ICOD.EQ.4) THEN
 852 : * polyline
 853 :                IBOP=IBOP+1
 854 :                N=IOPER(IBOP)
 855 :                IBP=IBP+N
 856 :             ELSEIF (ICOD.EQ.5) THEN
 857 : * face
 858 :                IBOP=IBOP+1
 859 :                N=IOPER(IBOP)
 860 :                IBOP=IBOP+1
 861 : C+PPf 
 862 :                IBOP=IBOP+1
 863 : C+PPf 
 864 :                IBP=IBP+N
 865 :             ELSEIF (ICOD.EQ.6) THEN
 866 : *  iso
 867 :                IBOP=IBOP+1
 868 :                N=IOPER(IBOP)
 869 :                IBOP=IBOP+1
 870 :                IBP=IBP+N
 871 :             ELSEIF (ICOD.EQ.7) THEN
 872 : *  fvalis
 873 :                IBOP=IBOP+1
 874 :             ELSEIF (ICOD.EQ.8) THEN
 875 : *  menu
 876 :             ELSEIF (ICOD.EQ.9) THEN
 877 : *  changement image
 878 :                IBOP=IBOP+1
 879 :             ELSEIF (ICOD.EQ.10) THEN
 880 : *  initialisation animation
 881 :                IBOP=IBOP+2
 882 :             ELSEIF (ICOD.EQ.11) THEN
 883 :             ENDIF
 884 :          ENDIF
 885 :          GOTO 300
 886 :  350     CONTINUE
 887 :          NBOP=JBOP
 888 :          NBP=JBP
 889 :          NBCHR=JBCHR
 890 :          ICHANG=0
 891 :          ISORT=0
 892 :          RETURN
 893 :       ELSE
 894 :          ISORT=1
 895 :          IRESU=JSEG
 896 :          ICHANG=1
 897 :          RETURN
 898 :       ENDIF
 899 : **    
 900 : C======================================================================
 901 :       ENTRY XTRBOX(HAUTX,HAUTY)
 902 : *  INUTILISE
 903 :       RETURN
 904 : **    
 905 : C======================================================================
 906 :       ENTRY XTREFF
 907 : *  INUTILISE
 908 :       RETURN
 909 : **    
 910 : C======================================================================
 911 :       ENTRY XVAL(IRESU,ISORT,ISO)
 912 : C#MC      IF (ISO.NE.0.AND.IDEFO.EQ.0) THEN
 913 :       IF (ISO.NE.0) THEN
 914 :          IRESU=10
 915 :          ISORT=1
 916 :       ENDIF
 917 :       RETURN
 918 : **    
 919 : C======================================================================
 920 :       ENTRY XMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL)
 921 : *  INUTILISE
 922 :       RETURN
 923 : **    
 924 : **    
 925 : C======================================================================
 926 :       ENTRY XIMPR
 927 : *  INUTILISE
 928 :       RETURN
 929 : **    
 930 : C======================================================================
 931 :       ENTRY XTRTIN
 932 : *  INUTILISE
 933 :       RETURN
 934 : **    
 935 : C======================================================================
 936 :       ENTRY XFLGI
 937 : *  INUTILISE
 938 :       RETURN
 939 : **    
 940 : C======================================================================
 941 :       ENTRY XTRMFI
 942 : *  INUTILISE
 943 :       RETURN
 944 : **    
 945 : C======================================================================
 946 :       ENTRY XTRMES(CARAC)
 947 :       CHMESS=CARAC
 948 :       RETURN
 949 : **    
 950 : C======================================================================
 951 :       ENTRY XTRGET(PROMPT,REPLY)
 952 :       segact dessin*mod,dessic*mod
 953 :       LPROMP=LONG(PROMPT)
 954 :       LREPLY=LONG(REPLY)
 955 :       CHAINE=PROMPT
 955 :       CALL XVALIS(3,IRESV,NHH)
 956 :       IF(icosc.eq.1) then
 957 :        ico1=7
 958 :       else      
 959 :        ico1=8
 960 :       endif
 960 :       CALL XHCOUL(ico1)
 960 :       CALL XRGET(ICHAIN,LPROMP,ICHAIN,LREPLY)
 961 :       REPLY=' '
 962 :       IF (LREPLY.NE.0) REPLY=CHAINE(1:LREPLY)
 963 :       RETURN
 964 : **    
 965 : C======================================================================
 966 :       ENTRY XRCLIK(KCLICK)
 966 :       CALL XCLIK(KCLICK)
 967 :       END
 968 :  
 969 :  
 970 :  
 971 :  
 972 :  
 973 :  
 974 :  
 975 :  
 976 :  
 977 :  
 978 :  
 979 :  
 980 :  
 981 :  
 982 :