Sources Esope | Cast3M

ktrini
C KTRINI    SOURCE    CB215821  20/08/04    21:15:05     10680          
      SUBROUTINE KTRINI(NOL,AXAX,AYAY,TITRE,HAUTT,VALEU,NCOUMA)
C
C   INITIALISATION D'UN TRACE
C          1 TATB               2 TEKTRO         3 GDDM (3179 G )
C          4  GKS               5  GDDM (FICHIER GDF)
C
C   ATTENTION AVEC LE GKS IBM IL PEUT Y AVOIR UN PROBLEME EN CAS
C   D'UNDERFLOW QUI NE SONT PAS ACTUELLEMENT MASQUES PAR GKS
C   ET PROVOQUE DES ARITHMETICS ERRORS
C
C INITIALISATION D'UN TRACE
C     NOL      : NON UTILISE
C     AX ,AYAX : DIMENSION POUR LA FEUILLE DE PAPIER
C     TITRE    : TITRE (CHAINE DE CARACTERES)
C     HAUT     : HAUTEUR DES CARACTERES
C     VALEUR   : ECRAN OU ECRAN PLUS MARGE
C     NCOUMA   : NOMBRE DE COULEUR DU TERMINAL
C     ICCOL    : INDICE COULEUR COURANTE
C     ICOISO   :
C
      IMPLICIT INTEGER(I-N)
      external long
      SAVE IWKIDLI,KMETA,WKTY,INWISS,INMETA,FENE
      SAVE ICCOL,ICOISI,WKID,X1,X2,Y1,Y2,WRATIO,INUSEG
      SAVE XINID,YINID,IDSG,SXMIN,SXXAX,SYMIN,SYYAX,RX,RY,AX,AY
      SAVE TEXTX,TEXTY,INCOOR,TEXTE,ICCLE,IACT,IDWISS,IWISS,VALEUR
      SAVE NHAUT,HAUT
      SAVE IPF
      DIMENSION IPF(24)
      CHARACTER*(*) TITRE
      DIMENSION XTR(*),YTR(*)
      DIMENSION RMAT(9)
      REAL SEGTM(2,3)
      CHARACTER*8 NAME
      CHARACTER*(*) CARACT
      LOGICAL VALEUR,FENET,VALEU,FENE
      CHARACTER*(500) LEGEND
C VALEURS POUR LES ENTRY
      CHARACTER*20 STRING
      DIMENSION SEGT(6),SEGMT(6),ROUT(6)
C MEMOIRES DES POINTS COINS DES PAVES DE COULEUR DES MENUS
      DIMENSION PXA(4),PYA(4)
C CORRESPONDING CERN COLOR INDICES - FOR CERN PURPOSE
      DIMENSION ICCC(10)
C
      DIMENSION TEXTX(50),TEXTY(50)
C VARIABLES CARACTERES POUR NOMMER LE FICHIER METAFILE
      CHARACTER*1 CARELE(10)
      CHARACTER*6 STR
      CHARACTER*4 STR1
C
      CHARACTER*15 TEXTE(50)
C
C
C ASF
      DIMENSION IASF(13)
C INITIALISATION GKS (IDENTIFICATEUR, CONNECTION, TYPE)
      INTEGER WKID,WKCON,WKTY
      INTEGER STAT
C
*
-INC PPARAM
-INC CCOPTIO
*-INC CCGEOME
      DATA ICCOUN/0/
C DATA POUR LE NOM DU FICHIER METAFILE
      DATA CARELE /'0','1','2','3','4','5','6','7','8','9'/
      DATA STR1 /'META'/
C DATA POUR LE TABLEAU DES COULEURS  ICCC(K)    POUR GKS
      DATA ICCC/4,2,6,3,7,5,1,8,9,10/
C
      DATA WKID/3/
      DATA ICCOL/7/
      DATA IASF/1,1,1,1,1,1,1,1,1,1,1,1,1/
      DATA IDSG/0/
      DATA IACT/0/
      DATA IDWISS/2/
      DATA IWISS/0/
C  NB DE COULEUR SI PAS AUTRE INDICATION
      NCOUMA=7
C  SAUVER HAUT
      HAUT=HAUTT
      NHAUT=31
C  SAUVER VALEUR
      VALEUR=VALEU
C  O SEGMENT POUR COMMENCER
      KSEGN=0
C   INITIALISATION DE L'UNITE PHYSIQUE
      AX=AXAX
      AY=AYAY
      DO 1 NBCR=72,2,-1
      IF (TITRE(NBCR:NBCR).NE.' ') GOTO 2
   1  CONTINUE
   2  CONTINUE
      X1=0.
      X2=0.
      Y1=0.
      Y2=0.
C     POUR LA GESTION DES TEXTES
      INCOOR=0
      INUSEG=50+(100*(WKID-1))
      IXSEG=0
      ICCLE=0
C
C INITIALISATION GKS
C CHANNEL 1  WORKSTATION 1          METAFILE
C CHANNEL 2  WORKSTATION 2          WISS
C CHANNEL 3  WORKSTATION 3,4,..     ECRAN
C ATTENTION IL FAUT FERMER LA WORKSTATION
C POUR REVENIR EN MODE ALPHA
      IF(IACT.EQ.1) THEN
       CALL GQOPS(ISTA)
       IF(ISTA.EQ.4) CALL GCLSG
C INQUIRE SET MEMBER OF OPEN WORKSTATION
       NWAC=0
5002   CALL GQOPWK(NWAC,IERR,NTWAC,NWID)
       IF(NWID.EQ.WKID)GOTO 5001
       IF(NWAC.EQ.NTWAC)GOTO 5003
       NWAC=NWAC+1
       GOTO 5002
5001   CALL GQOPS(ISTA)
       IF (ISTA.EQ.3)  CALL GDAWK(WKID)
       IF (ISTA.EQ.3.OR.ISTA.EQ.2) CALL GCLWK(WKID)
C
5003   CALL GDAWK(IDWISS)
       CALL GCLWK(IDWISS)
       CALL GOPWK(IDWISS,2,INWISS)
       CALL GACWK(IDWISS)
       GOTO 5000
      ENDIF
C
C OUVERTURE GKS
C FILE 22 ERROR FILE FOR GKS
      IF (WKID.EQ.3) CALL GOPKS(22,1)
C
C OUVERTURE WORKSTATIONS -> ECRAN, METAFILE
C ECRAN -> IDENTIFICATEUR:1
C          CONNECTION    :1
C          TYPE   :4(SUN)  5001 (GKS GRAL IBM 3279)
C  ON NE GARDE QUE TROIS WORKSTATIONS SIMULTANEES  (UNE SUR IBM)
C  ( CAS DU SUN)
5000  CONTINUE
      WKCON=3
C LECTURE DE DIVERS PARAMETRES EN FILE 97 CASTEM2 GRAFPARM
*     OPEN (UNIT=97,FILE='GKS.DATA',FORM='FORMATTED')
      REWIND 97
C LECTURE DU NOMBRE MAX DE WKID AUTORISE POUR LA VERSION DE GKS
      READ(97,*)IWKIDLI
C PV UNE SEULE WKID => 3 MAXIMUM
      IWKIDLI=3
C LECTURE DU COMPTEUR DE METAFILE
       READ (97,*)KMETA
C LECTURE DU WORKSTATION-TYPE POUR L'ECRAN
       READ (97,*) WKTY
C LECTURE DU WORKSTATION-TYPE POUR LA WISS
      READ(97,*) INWISS
C LECTURE DU WORKSTATION-TYPE POUR LES METAFILES
      READ(97,*) INMETA
C OUVERTURE ET ACTIVATION DE LA WISS
      IF(IWISS.EQ.0) THEN
       CALL GOPWK(IDWISS,2,INWISS)
       CALL GACWK(IDWISS)
       IWISS=1
      ENDIF
C
C OUVERTURE  DE L'ECRAN
      CALL GOPWK(WKID,WKCON,WKTY)
C
C CHARGEMENT DES PATTERN
C
C INITIALISATION DE LA TABLE DES COULEURS
C      IND RED GREEN BLUE
C     NOIR     0   0.0 0.0 0.0
C     BLEU     4   0.0 0.0 1.0
C     ROUGE    2   1.0 0.0 0.0
C     ROSE     6   1.0 0.0 1.0
C     VERT     3   0.0 1.0 0.0
C     TURQUOI  7   0.0 1.0 1.0
C     JAUNE    5   1.0 1.0 0.0
C     BLANC    8   1.0 1.0 1.0
C     NOIR     1   0.0 0.0 0.0
      CALL GSCR(WKID,0,0.0,0.0,0.0)
      CALL GSCR(WKID,4,0.0,0.0,1.0)
      CALL GSCR(WKID,2,1.0,0.0,0.0)
      CALL GSCR(WKID,6,1.0,0.0,1.0)
      CALL GSCR(WKID,3,0.0,1.0,0.0)
      CALL GSCR(WKID,7,0.0,1.0,1.0)
      CALL GSCR(WKID,5,1.0,1.0,0.0)
      CALL GSCR(WKID,1,1.0,1.0,1.0)
      CALL GSCR(WKID,8,0.0,0.0,0.0)
C ACTIVATION DE L'ECRAN
      CALL GACWK(WKID)
      IACT=1
C
C OUVERTURE SEGMENT 6
      ISEG=6+(100*(WKID-1))
      CALL GCRSG(ISEG)
      CALL GSVIS(ISEG,1)
      CALL GSDTEC(ISEG,0)
C
C DIMENSION DE L'ECRAN (RX,RY EN METRES, LX ET LY EN PIXELS)
      CALL GQDSP(WKTY,ERR,DC,RX,RY,LX,LY)
C
C METTRE LES ASF EN INDIVIDUAL
      CALL GSASF(IASF)
C
C MODE DE MISE A JOUR (MODE PAR DEFAUT)CD CEA.SUN
C
      CALL GSDS(WKID,1,0)
C
C DEFINITION DE LA FENETRE DE LA WORKSTATION (ECRAN)
      WRATIO=RY/RX
      R=RY
      IF(WRATIO.GT.1)THEN
      R=RX
      WRATIO=1./WRATIO
      END IF
      CALL GSWKWN(WKID,0.,1.,0.,RY/RX)
      CALL GSWKVP(WKID,0.,RX,0.,RY)
C EFFACEMENT DE LADITE
      CALL GSFAIS(1)
      CALL GSFACI(8)
      CALL GSWN(4,0.,1.,0.,1.)
      CALL GSVP(4,0.,1.,0.,(RY/RX))
      CALL GSELNT(4)
      PXA(1)=0
      PyA(1)=0
      PXA(2)=0
      PyA(2)=1
      PXA(3)=1
      PyA(3)=1
      PXA(4)=1
      PyA(4)=0
      CALL GFA(4,PXA,PYA)
C
C DEFINITION DE LA FENETRE ET CLOTURE DE LA DEUXIEME WORKSTATION (PLOTTE
C
C DEFINITION DE LA TRANSFORMATION DE NORMALISATION 1 POUR LE TITRE
      CALL GSWN(1,0.,80.,0.,2.)
      CALL GSVP(1,0.,1.,0.,(RY/RX)*0.1)
      CALL GSELNT(1)
C
C INITIALISATION DES ATTRIBUTS CARACTERES
      CALL GSCHH(1.0)
      CALL GSTXCI(ICCC(7))
      CALL GSTXFP(1,2)
      CALL GSCHXP(1.)
      CALL GSCHSP(0.1)
C ECRITURE TITRE
      CALL GTX(68.,1.,'CASTEM 2000')
      CALL GTX(0.,1.,TITRE)
C
C FERMETURE SEGMENT
      CALL GCLSG
C
      RETURN
*
      ENTRY KDFENE(XMIN,XXAX,YMIN,YYAX,XR1,XR2,YR1,YR2,FENET)
C
C DEFINITION DE LA FENETRE UTILISATEUR
C     XMIN,X,X,YMIN,YYAX : COORDONNEES DE LA FENETRE UTILISATEUR
C       XR1,XR2,YR1,YR2     : COORDONNEES RETOURNEES
C                             (EFFECTIVEMENT UTILISEES)
C     FENET             :  CALCUL DU RATIO (OUI OU NON) NON UTILISE
C
      EC1=AX-3.
      EC2=AY-3.
C  DEFINITION UNITE UTILISATEUR  FENETRE UTILISEE MARGES A RESPECTER
C  RETOUR X1 X2 Y1 Y2 FENETRE EFFECTIVEMENT UTILISEE  ????
C  OUVERTURE SEGMENT
C CALCUL DE LA FENETRE (XMIN,XXA,YMIN,YYA) -> DETERMINATION DE LA TRANSF
C DE NORMALISATION 2
C  ON COMPLETE LA FENETRE UTILISATEUR POUR RENTRER DANS LA FENETRE REELL
      SXMIN=XMIN
      SXXAX=XXAX
      SYMIN=YMIN
      SYYAX=YYAX
C MARGE POUR LES QUAL ET NUMERO DE NOEUDS OU ELEMENTS
      XDIFF=(XXAX-XMIN)/2.*1.10
      YDIFF=(YYAX-YMIN)/2.*1.10
      XMILL=(XXAX+XMIN)/2.
      YMILL=(YYAX+YMIN)/2.
C NECESSAIRE POUR OPERATEUR DESSIN
      FENE=FENET
      IF (FENE) THEN
      RAP=(XDIFF/YDIFF)/(RX/RY)
      ELSE
      RAP=1.
      ENDIF
      IF (RAP.GE.1) THEN
       X1=XMILL-XDIFF
       X2=XMILL+XDIFF
       Y1=YMILL-(YDIFF*RAP)
       Y2=YMILL+(YDIFF*RAP)
      ELSE
       X1=XMILL-(XDIFF/RAP)
       X2=XMILL+(XDIFF/RAP)
       Y1=YMILL-YDIFF
       Y2=YMILL+YDIFF
      ENDIF
      IF(VALEUR) THEN
C      LA FENETRE EST XMIN,XXAX,YMIN,YYAX
       CALL GSWN(2,X1,X2,Y1,Y2)
       CALL GSVP(2,0.,0.8,(RY/RX)*0.1,(RY/RX)*0.9)
      ELSE
C        LA FENETRE EST RECALCULEE POUR GARDER LES BONS RAPPORTS
       CALL GSWN(2,X1,X2,Y1,Y2)
       CALL GSVP(2,0.,0.9,(RY/RX)*0.1,(RY/RX))
      ENDIF
C
      CALL GSELNT(2)
C
C INITIALISATION DE LA POSITION DU LOCATOR
      XINID=(X1+X2)/2.
      YINID=(Y1+Y2)/2.
C
C INITIALISATION DES VALEURS RENDUES
      XR1=XMIN
      XR2=XXAX
      YR1=YMIN
      YR2=YYAX
C
C OUVERTURE SEGMENT 1
C DEMANDE DU NOM DU SEGMENT OUVERT (FERMETURE)
      CALL GQOPS(ISTA)
      IF (ISTA.EQ.4) THEN
      CALL GQOPSG(IIERRI,INUM)
       CALL GCLSG
       CALL GDSG(INUM)
      ENDIF
      INUM=8+(100*(WKID-1))
       CALL GQSGUS(0,IERGK,NBSEG,ISEGNA)
       DO 4461 ISEG=1,NBSEG
       CALL GQSGUS(ISEG,IERGK,NBSE,ISEGNA)
        IF (ISEGNA.EQ.INUM) THEN
         CALL GDSG(INUM)
         GOTO 4462
        ENDIF
 4461   CONTINUE
 4462   CONTINUE
      ISEG=1+(100*(WKID-1))
      CALL GCRSG(ISEG)
      IXSEG=1
C
C ATTRIBUT VISIBILITE
      CALL GSVIS(ISEG,1)
C DETECTABILITE
      CALL GSDTEC(ISEG,0)
C
C MODE VECTEUR (POUR LES CARACTERES)
      CALL GSTXFP(1,2)
C
C TAILLE DES CARACTERES PAR DEFAUT
C DETERMINATION DE LA HAUTEUR DES CARACTERES, DE L'ESPACE ENTRE CARACTER
      CHH=(Y2-Y1)/50.0
      CALL GSCHH(CHH)
      CALL GQCHXP(INDERR,CHXPO)
      CHXP=(X2-X1)/(Y2-Y1)/RX*RY*CHXPO
      CALL GSCHXP(CHXP)
      CALL GSCHSP(0.1)
C
C
C COULEUR COURANTE (ICCOL)
      CALL GSFACI(ICCC(ICCOL))
      CALL GSPLCI(ICCC(ICCOL))
      CALL GSPMCI(ICCC(ICCOL))
      CALL GSTXCI(ICCC(ICCOL))
C
C OVERPAINT
C
      ICOISI=-100
C
      RETURN
C
      ENTRY KTRLAB(X,Y,CARACT,NCAR,HAUTT)
C
C ECRITURE D'UN TEXTE EN (X,Y)
C     X,Y : COORDONNEES DE L'ORIGINE DU TEXTE
C     CARACT  : TEXTE
C       NCAR    : NOMBRE DE CARACTERES A ECRIRE
C     HAUT :
C
      HAUT=HAUTT
      DO 201 ICAR=NCAR,1,-1
      IF (CARACT(ICAR:ICAR).NE.' ') GOTO 202
 201  CONTINUE
C  CHAINE VIDE
      RETURN
 202  CONTINUE
C ECRITURE TEXTE EN (X,Y)
      CALL GTX(X,Y,CARACT)
      RETURN
C
      ENTRY KTRBOX (HAUTX,HAUTY)
C CARACTERES EN MODE VECTEUR (STROKE)
      CALL GSTXFP(1,2)
C INTERROGATION SUR LA TAILLE DE DEFAUT
      CALL GQCHH(ERR,CHH)
      CALL GQCHXP(INDERR,CHXP)
C MISE A JOUR DE LA TAILLE
*      CALL GSCHH(CHH*HAUTX)
*      CALL GSCHXP(CHXP*HAUTY)
*      CALL GSCHSP(0.1)
      RETURN
C
      ENTRY KCHCOU(JCOLO)
C
C     CHANGEMENT COULEUR (8 DOIT CORRESPONDRE A L'EFFACEMENT)
C     JCOLO : INDICE DE LA NOUVELLE COULEUR
C     CHANGEMENT DE COULEUR (VOIR LA TABLE DES COULEUR)
C
      CALL GSFACI(ICCC(JCOLO))
      CALL GSPLCI(ICCC(JCOLO))
      CALL GSPMCI(ICCC(JCOLO))
      CALL GSTXCI(ICCC(JCOLO))
      RETURN
C
      ENTRY KFVALI(IFENI,IRESU,NH)
C
      IF (IFENI.EQ.1) THEN
      WRATIO=1
      IRESU=0
      CALL GSWN(3,0.,1.,2.,33.)
      CALL GSVP(3,0.8,1.,(RY/RX)*0.1,(RY/RX)*0.9)
      CALL GSELNT(3)
      CALL GSCHH(1.0)
      CALL GSCHXP(0.06)
      CALL GSCHSP(0.1)
      ELSE
      CALL GCLSG
      CALL GSCHXP(1.)
      CALL GSELNT(2)
      ENDIF
      NH=31
      RETURN
C
      ENTRY KMENU(LEGEND,NCASE,LLONG)
C     AFFICHAGE DU MENU
C
      DO 805 II=1,24
      IPF(II)=0
 805  CONTINUE
C TEST SUR L'EXISTENCE DES SEGMENTS 10 A 22
C SELECTION TRANSFORMATION 1
      CALL GSELNT(1)
       CALL GQOPS(ISTA)
       IF (ISTA.EQ.4) CALL GCLSG
        DO 446 KBOIT=1,13
       CALL GQSGUS(0,IERGK,NBSEG,ISEGNA)
       DO 4460 ISEG=1,NBSEG
       CALL GQSGUS(ISEG,IERGK,NBSE,ISEGNA)
        IF (ISEGNA.EQ.9+KBOIT+(100*(WKID-1))) THEN
         CALL GDSG(9+KBOIT+(100*(WKID-1)))
         GOTO 446
        ENDIF
 4460   CONTINUE
 446    CONTINUE
C        CREATION DU MENU
       XB=1.
       CALL GQWKS(WKID,IERGK,ISTA)
       IF (ISTA.NE.1) CALL GACWK(WKID)
       DO 445 KBOIT=1,13
       KKIMP=0
       IF (KBOIT.LE.NCASE) THEN
           MLONG=LLONG
       ELSE
           MLONG=1
       ENDIF
       IF (KBOIT.EQ.12.AND.IPF(2).NE.0.AND.MLONG.EQ.1) KKIMP=1
       IF (KKIMP.EQ.1) MLONG=4
       IF (MLONG.EQ.1) GOTO 447
       ISEG=KBOIT+9+(100*(WKID-1))
       CALL GCRSG(ISEG)
       IF (KBOIT.NE.1) IPF(KBOIT-1)=1
       CALL GSVIS(ISEG,1)
       CALL GSDTEC(ISEG,1)
C PAVE DE COULEUR POUR LOCATOR INPUT
       CALL GSFAIS(1)
       CALL GSFACI(ICCC(2))
       PXA(1)=XB
       PXA(2)=PXA(1)+2.
       PXA(3)=PXA(2)
       PXA(4)=PXA(1)
       PYA(1)=0.6
       PYA(2)=PYA(1)
       PYA(3)=PYA(1)+0.4
       PYA(4)=PYA(3)
       CALL GFA(4,PXA,PYA)
C FIN DE CONSTRUCTION DU PAVE DE COULEUR
       CALL GSTXCI(ICCC(2))
       CALL GSTXFP(1,2)
       CALL GSCHH(0.7)
       CALL GSCHSP(0.1)
       CALL GSCHXP(1.0)
       IF (KKIMP.EQ.1) THEN
         CALL GTX(PXA(1),0.,'Meta')
       ELSE
C        CALL GTX(PXA(1),0.,LEGEND(KBOIT)(1:MLONG))
         CALL GTX(PXA(1),0.,LEGEND(1+(KBOIT-1)*MLONG:KBOIT*MLONG))
       ENDIF
       XB=XB+80./(NCASE+1)
       CALL GCLSG
 447   CONTINUE
 445   CONTINUE
       IDSG=1
      CALL GSCHH(1.0)
      CALL GSCHXP(1.0)
      CALL GSCHSP(0.1)
      CALL GSELNT(2)
      RETURN
C
      ENTRY KINSEG(NBSEGT,IRESS)
C
C INITIALISATION D'UN SEGMENT
C     NBSEGT : NUMERO DU SEGMENT
C     IRESS : SELON SA VALEUR, ON FERME LE SEGMENT PRECEDENT
C
      IF (IRESS.NE.2) THEN
         IF (IRESS.LT.2.OR.IRESS.GT.5) THEN
C         FERMETURE SEGMENT
        CALL GCLSG
       ENDIF
      ELSE
       IRESS=7
      ENDIF
      CALL GQOPS(IOP)
      IF (IOP.EQ.4) CALL GCLSG
 
C
C     CREATION SEGMENT NBSEGT
      ISEG=NBSEGT+(100*(WKID-1))
      CALL GCRSG(ISEG)
C
C     ATTRIBUT DE VISIBILITE
      CALL GSVIS(ISEG,1)
C     DETECTABILITE
      CALL GSDTEC(ISEG,0)
C
C     MODE VECTEUR POUR LES CARACTERES (STROKE)
C     CALL GSTXFP(1,2)
C
C     TAILLE DES CARACTERES
      IF (NBSEGT.NE.7) THEN
*  SAUF CAS DES LEGENDES ISOVALEURS
       CHH=(Y2-Y1)/50.0
       CALL GSCHH(CHH)
       CALL GQCHXP(INDERR,CHXPO)
       CHXP=(X2-X1)/(Y2-Y1)/RX*RY*CHXPO
       CALL GSCHXP(CHXP)
      CALL GSCHSP(0.1)
      ELSE
*  CAS DES LEGENDES ISOVALEURS
       CALL GSCHH(0.9)
       CALL GSCHXP(1./21.)
      CALL GSCHSP(0.1)
      ENDIF
      RETURN
C
      ENTRY KPOLRL(NTRSTU,XTR,YTR)
C
C TRACE D'UNE POLYLIGNE DANS LA VALEUR COURANTE
C     NTR : NOMBRE DE POINTS
C       XTR,YTR : COORDONNEES DES POINTS
C
      NTR=NTRSTU
      IF (NTR.LE.1) RETURN
C
      IF (NTR.LE.1) RETURN
C
C TRACE D'UNE POLYLIGNE
      CALL GSELNT(2)
      CALL GPL(NTR,XTR(1),YTR(1))
C
      RETURN
C
      ENTRY KTRDIG(X,Y,INCLE)
C
C DIGITALISATION D'UN POINT
C     X,Y : COORDONNEES DU POINT DESIGNE
C
      INCLE=0
C DEMANDE D'ENTREE DU LOCATOR
      CALL GSLCM(WKID,1,0,1)
       CALL GUWK(WKID,1)
      ITNR=2
      CALL GINLC(WKID,1,ITNR,XINID,YINID,1,0.,RX,0.,RY,0,0)
      CALL GRQLC(WKID,1,ISTAT,ITNR,X,Y)
C
C CALCUL DE CONVERSION NDC -> WC
      X=X2-((0.9-X)/0.9)*(X2-X1)
      Y=Y2-((WRATIO-Y)/0.9/WRATIO)*(Y2-Y1)
      IF((X.LT.X1).OR.(X.GT.X2))INCLE=3
      IF((Y.LT.Y1).OR.(Y.GT.Y2))INCLE=3
C
C MISE A JOUR DE LA NOUVELLE POSITION DU LOCATOR
      XINID=X
      YINID=Y
C
C REPASSER SUR LE SEGMENT ISGOLD
      ISGNEW=9+(100*(WKID-1))
      ISGOLD=8+(100*(WKID-1))
      CALL GQOPS(ISTA)
      IF (ISTA.EQ.4) THEN
       CALL GQOPSG(IIERRI,INUM)
       IF(INUM.NE.ISGOLD) CALL GCLSG
      ELSE
       IERGK=1
       CALL GQSGUS(0,IERGKK,NBSEG,ISEGNA)
       DO 4463 ISEG=1,NBSEG
       CALL GQSGUS(ISEG,IERGKK,NBSE,ISEGNA)
        IF (ISEGNA.EQ.ISGOLD) THEN
         IERGK=0
         GOTO 4464
        ENDIF
 4463   CONTINUE
 4464   CONTINUE
        IF (IERGK.EQ.0) THEN
         CALL GRENSG(ISGOLD,ISGNEW)
C        CREATION DU SEGMENT COURANT
         CALL GCRSG(ISGOLD)
         RMAT(1)=1.
         RMAT(2)=0.
         RMAT(3)=0.
         RMAT(4)=1.
         RMAT(5)=0.
         RMAT(6)=0.
         CALL GINSG(ISGNEW,RMAT)
         CALL GDSG(ISGNEW)
        ELSE
         CALL GCRSG(ISGOLD)
        ENDIF
C      ATTRIBUT VISIBILITE
       CALL GSVIS(ISGOLD,1)
C      DETECTABILITE
       CALL GSDTEC(ISGOLD,0)
C      MODE VECTEUR (POUR LES CARACTERES)
       CALL GSTXFP(1,2)
C      TAILLE DES CARACTERES PAR DEFAUT
C DETERMINATION DE LA HAUTEUR DES CARACTERES, DE L'ESPACE ENTRE CARACTER
       CHH=(Y2-Y1)/50.0
       CALL GSCHH(CHH)
       CALL GQCHXP(INDERR,CHXPO)
       CHXP=(X2-X1)/(Y2-Y1)/RX*RY*CHXPO
       CALL GSCHXP(CHXP)
      CALL GSCHSP(0.1)
C      COULEUR COURANTE (ICCOL)
       CALL GSFACI(ICCC(ICCOL))
       CALL GSPLCI(ICCC(ICCOL))
       CALL GSPMCI(ICCC(ICCOL))
       CALL GSTXCI(ICCC(ICCOL))
C
      ENDIF
C
      RETURN
C
      ENTRY KTRFAC(NP,XTR,YTR,ZN,ICOLE,IEFF)
C
C TRACE D'UNE FACE AVEC DEGRADE
C     NP      : NOMBRE DE POINTS
C     XTR,YTR : COORDONNEES DES POINTS
C     ICOLE   : COULEUR
C     KP      : ECLAIRAGE
C
      IEFF=0
      KP=INT(ZN*4./1.58)+1
C
      IEFF=0
      CALL GSELNT(2)
C
C EFFACEMENT DE LA ZONE (FAUT-IL LE FAIRE AVEC GKS?)
      IEFF=1
C     IF (KP.GE.3) IEFF=1
      IF (KP.NE.4) THEN
C COULEUR EFFACEMENT -> 8
C PATTERN PLEIN
C TRACE DE LA ZONE PLEINE
      ENDIF
C
C COULEUR (ICOLE)
      CALL GSFACI(ICCC(ICOLE))
C
      CALL GSFAIS(1)
C
C TRACE DE LA ZONE PLEINE
      CALL GFA(NP,XTR,YTR)
      RETURN
C
      ENTRY KTRAIS(NP,XTR,YTR,ICOLE)
C
C TRACE D'UNE FACE SANS CALCUL DE DEGRADE
C     NP : NOMBRE DE POINTS
C     XTR,YTR : COORDONNEES DES POINTS
C       ICOLE : COULEUR
C
C CHANGEMENT DE COULEUR SI CE N'EST PAS LA MEME
      IF (ICOLE.NE.ICOISI) THEN
      ICOISI=ICOLE
C     CALL GSELNT(2)
C COULEUR (ICOISI)
      CALL GSFACI(ICCC(ICOISI))
      ENDIF
C
C TRACE DU POLYGONE
      CALL GSFAIS(1)
      CALL GFA(NP,XTR,YTR)
C
      RETURN
C
C  EFFACEMENT ECRAN  ON UTILISE GDDM OU CE QU'ON PEUT
      ENTRY KTREFF
*  A VOIR SELON LES TERMINAUX
C IMPLANTATION CERN
C ROUTINE VMCMS DANS KERNLIB
*     CALL VMCMS('CLRSCRN',IRC)
      RETURN
C  REINITIALISATION CHAMP TEXT
C
C  AFFICHAGE RETOUR CLE TAPEE
      ENTRY KTRAFF(ICLE)
C
C AFFICHAGE RETOUR CLE TAPEE
C     ICLE : NUMERO DE CLE RENDUE
C
 1540 CONTINUE
      ICLE=0
C DEMANDE DU NOM DU SEGMENT OUVERT (FERMETURE)
      ISGNEW=9+(100*(WKID-1))
      ISGOLD=8+(100*(WKID-1))
      CALL GQOPS(ISTA)
      IF (ISTA.EQ.4) THEN
       CALL GQOPSG(IIERRI,INUM)
       IF(INUM.NE.ISGOLD) CALL GCLSG
      ELSE
       IERGK=1
       CALL GQSGUS(0,IERGKK,NBSEG,ISEGNA)
       DO 4466 ISEG=1,NBSEG
       CALL GQSGUS(ISEG,IERGKK,NBSE,ISEGNA)
        IF (ISEGNA.EQ.ISGOLD) THEN
         IERGK=0
         GOTO 4467
        ENDIF
 4466   CONTINUE
 4467   CONTINUE
        IF (IERGK.EQ.0) THEN
         CALL GRENSG(ISGOLD,ISGNEW)
C        CREATION DU SEGMENT COURANT
         CALL GCRSG(ISGOLD)
         RMAT(1)=1.
         RMAT(2)=0.
         RMAT(3)=0.
         RMAT(4)=1.
         RMAT(5)=0.
         RMAT(6)=0.
         CALL GINSG(ISGNEW,RMAT)
         CALL GDSG(ISGNEW)
        ELSE
         CALL GCRSG(ISGOLD)
        ENDIF
C      ATTRIBUT VISIBILITE
       CALL GSVIS(ISGOLD,1)
C      DETECTABILITE
       CALL GSDTEC(ISGOLD,0)
C      MODE VECTEUR (POUR LES CARACTERES)
       CALL GSTXFP(1,2)
C      TAILLE DES CARACTERES PAR DEFAUT
C DETERMINATION DE LA HAUTEUR DES CARACTERES, DE L'ESPACE ENTRE CARACTER
       CHH=(Y2-Y1)/50.0
       CALL GSCHH(CHH)
       CALL GQCHXP(INDERR,CHXPO)
       CHXP=(X2-X1)/(Y2-Y1)/RX*RY*CHXPO
       CALL GSCHXP(CHXP)
       CALL GSCHSP(0.1)
C      COULEUR COURANTE (ICCOL)
       CALL GSFACI(ICCC(ICCOL))
       CALL GSPLCI(ICCC(ICCOL))
       CALL GSPMCI(ICCC(ICCOL))
       CALL GSTXCI(ICCC(ICCOL))
C
      ENDIF
C
      ISEG=0
C      INITIALISATION PICK
       CALL GSPKM(WKID,1,0,1)
C      DEMANDE D'ENTREE
*      CALL GRSGWK(WKID)
       CALL GUWK(WKID,1)
       CALL GRQPK(WKID,1,ISTAT,ICHNR,PCID)
C      CONVERSION NUMERO DE SEGMENT SAISI
           ISEG=ICHNR-(100*(WKID-1))
       IF (ISTAT.NE.1) GOTO 1540
C
       IF(ISEG.GE.50) THEN
C       DEMANDE ENTREE STRING
        CALL GSSTM(WKID,1,0,1)
        CALL GRQST(WKID,1,ISTAT,IL,STRING)
C       DESTRUCTION DU SEGMENT DESIGNE
        CALL GDSG(ICHNR)
C       REECRITURE DU SEGMENT AVEC LA NOUVELLE CHAINE
        CALL GCRSG(ICHNR)
        XX=TEXTX(ISEG-50+1)
        YY=TEXTY(ISEG-50+1)
        CALL GTX(XX,YY,STRING)
        CALL GCLSG
        CALL GSDTEC(ICHNR,1)
C       MODIFICATION DANS LE TABLEAU
        TEXTE(ISEG-50+1)(1:15)=STRING(1:15)
       ENDIF
        ICLE=ISEG
       ICLE=ICLE-10
*       WRITE (6,*) ' ICLE ',ICLE
       IF (ICLE.NE.0.AND.IPF(ICLE).EQ.0) GOTO 1540
C
C CHANGEMENT MODE DE MISE A JOUR (BLOCAGE)
      CALL GSDS(WKID,1,0)
C
      RETURN
C
* ROUTINE POUR SORTIR CORRECTEMENT DE GKS AVEC MODIFIER
      ENTRY KTRMFI
      IACT=0
      IWISS=0
       CALL GQWKS(WKID,IERGK,ISTA)
       IF (IERGK.EQ.0) THEN
        IF(ISTA.EQ.1) CALL GDAWK(WKID)
        CALL GCLWK(WKID)
       ENDIF
      IDSG=0
      RETURN
C
*     ENTRY KZOOM(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
      ENTRY KZOOM(IZOOM,XMI,XMA,YMI,YMA)
C
C     XMI,XMA,YMI,YMA POINTS RENDUS APRES LE ZOOM
C
      IRESU=1
C   ENTREE DES DEUX POINTS POUR LE RECTANGLE DU ZOOM
      ITNR=2
      CALL GINLC(WKID,1,ITNR,XINID,YINID,1,0.,RX,0.,RY,0,0)
      CALL GSELNT(0)
      CALL GSLCM(WKID,1,0,1)
C   ACCUMULATION DE MATRICES
      CALL GRQLC(WKID,1,STAT,ITNR1,XRO,YRO)
      CALL GINLC(WKID,1,ITNR1,XRO,YRO,1,0.,RX,0.,RY,0,0)
      CALL GRQLC(WKID,1,STAT,ITNR1,XCOL,YCOL)
C   GESTION DU CADRE DU ZOOM : CARRE
      XMI=MIN(XRO,XCOL)
      XMA=MAX(XRO,XCOL)
      YMI=MIN(YRO,YCOL)
      YMA=MAX(YRO,YCOL)
      XMA=MAX(XMA,YMA-YMI+XMI)
      YMI=MIN(YMI,-XMA+XMI+YMA)
      IF (VALEUR) THEN
        PAS=MIN(0.8/(XMA-XMI),(RY/RX)*0.8/(YMA-YMI))
      ELSE
        PAS=MIN(0.9/(XMA-XMI),(RY/RX)*0.9/(YMA-YMI))
      ENDIF
C   INTERROGATION SUR LA MATRICE PRECEDENTE
      ISEG=1+(100*(WKID-1))
      CALL GQSGA(ISEG,ERR,SEGT,VIS,HIGH,GRPR,DET)
C   INITIALISATION DES MATRICES
      ISW=1
      SEGMT(1)=PAS
      SEGMT(2)=0.
      SEGMT(3)=0.
      SEGMT(4)=PAS
      IF (VALEUR) THEN
        XVALEU=0.8
        YVALEU=0.9*(RY/RX)
      ELSE
        XVALEU=0.9
        YVALEU=1.0*(RY/RX)
      ENDIF
      SEGMT(5)=XVALEU/2-(XMA+XMI)/2*PAS
      SEGMT(6)=(YVALEU+0.1*(RY/RX))/2-(YMA+YMI)/2*PAS
      ROUT(1)=SEGMT(1)*SEGT(1) + SEGMT(2)*SEGT(3)
      ROUT(2)=SEGMT(2)*SEGT(1) + SEGMT(4)*SEGT(2)
      ROUT(3)=SEGMT(1)*SEGT(3) + SEGMT(3)*SEGT(4)
      ROUT(4)=SEGMT(2)*SEGT(3) + SEGMT(4)*SEGT(4)
      ROUT(5)=SEGMT(1)*SEGT(5) + SEGMT(3)*SEGT(6) + SEGMT(5)
      ROUT(6)=SEGMT(2)*SEGT(5) + SEGMT(4)*SEGT(6) + SEGMT(6)
C  TRANSFORMATION PAR LA MATRICE
      CALL GSSGT(ISEG,ROUT)
C
*     IF (IDEFOR.NE.0) THEN
*1093     ISORT=0
*         RETURN
*     ENDIF
C  SUPPRESSION DE SEGMENTS
      IDEL1=0
      IDEL2=0
      IDEL3=0
*1093 IF (IQUALI.NE.0) IDEL1=3+(100*(WKID-1))
*1093 IF (INUMNO.NE.0) IDEL2=4+(100*(WKID-1))
*1093 IF (INUMEL.NE.0) IDEL3=5+(100*(WKID-1))
      IF (IDEL1.NE.0) CALL GDSG(IDEL1)
      IF (IDEL2.NE.0) CALL GDSG(IDEL2)
      IF (IDEL3.NE.0) CALL GDSG(IDEL3)
*1093 IF (IQUALI.EQ.10) IQUALI=0
*1093 IF (INUMNO.EQ.10) INUMNO=0
*1093 IF (INUMEL.EQ.10) INUMEL=0
*1093 ISORT=1
      IRESU=2
C
      IF (VALEUR) THEN
        ROUT(5)=ROUT(5)*(X2-X1)/0.8+X1
        ROUT(6)=ROUT(6)*(Y2-Y1)/(0.8*RY/RX)+(9*Y1-Y2)/8.
      ELSE
        ROUT(5)=ROUT(5)*(X2-X1)/0.9+X1
        ROUT(6)=ROUT(6)*(Y2-Y1)/(0.9*RY/RX)+(10*Y1-Y2)/9.
      ENDIF
C  CALCUL DES COORDONNEES APRES LE ZOOM
      XMI=(SXMIN-ROUT(5))/ROUT(1)+X1
      XMA=(SXXAX-ROUT(5))/ROUT(1)+X1
      IF (VALEUR) THEN
         YMI=(SYMIN-ROUT(6))/ROUT(4)+(9*Y1-Y2)/8.
         YMA=(SYYAX-ROUT(6))/ROUT(4)+(9*Y1-Y2)/8.
      ELSE
         YMI=(SYMIN-ROUT(6))/ROUT(4)+(10*Y1-Y2)/9.
         YMA=(SYYAX-ROUT(6))/ROUT(4)+(10*Y1-Y2)/9.
      ENDIF
      CALL GSELNT(2)
      RETURN
C
      ENTRY KCHANG(IRESU,ISORT,ICHANG,JSEG)
C
C   VISUALISATION OU NON DU SEGMENT JSEG
C   POUR LES CLES QUAL, NOEUD OU ELEM
C
      ISEG=JSEG+(100*(WKID-1))
      IF (ICHANG.EQ.1) THEN
         ICHANG=10
         CALL GSVIS(ISEG,0)
         ISORT=0
         RETURN
      ELSEIF (ICHANG.EQ.10) THEN
         ICHANG=1
         CALL GSVIS(ISEG,1)
         ISORT=0
         RETURN
      ENDIF
      ISORT=1
      IRESU=JSEG
      ICHANG=1
      RETURN
C
      ENTRY KINI(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
C
C    RETOUR AU DESSIN INITIAL - SUPPRESSION DES SEGMENTS
C    CONCERNANT QUAL, NOEUD ET ELEM
      CALL GSELNT(2)
      PAS=1
      RMAT(1)=1.
      RMAT(2)=0.
      RMAT(3)=0.
      RMAT(4)=1.
      RMAT(5)=0.
      RMAT(6)=0.
      ISEG=1+(100*(WKID-1))
C   APPLICATION DE LA MATRICE AU SEGMENT 1
      CALL GSSGT(ISEG,RMAT)
*     IF (IDEFOR.NE.0) THEN
*        ISORT=0
*        RETURN
*     ENDIF
      IDEL1=0
      IDEL2=0
      IDEL3=0
      IF (IQUALI.NE.0) IDEL1=3+(100*(WKID-1))
      IF (INUMNO.NE.0) IDEL2=4+(100*(WKID-1))
      IF (INUMEL.NE.0) IDEL3=5+(100*(WKID-1))
      IF (IDEL1.NE.0) CALL GDSG(IDEL1)
      IF (IDEL2.NE.0) CALL GDSG(IDEL2)
      IF (IDEL3.NE.0) CALL GDSG(IDEL3)
      IF (IQUALI.EQ.10) IQUALI=0
      IF (INUMNO.EQ.10) INUMNO=0
      IF (INUMEL.EQ.10) INUMEL=0
C   RESTITUTION DES COORDONNEES
      XMI=SXMIN
      XMA=SXXAX
      YMI=SYMIN
      YMA=SYYAX
      CALL GSWN(2,X1,X2,Y1,Y2)
      ISORT=1
      IRESU=2
C     CALL GSELNT(2)
      RETURN
C
      ENTRY KFLGI
C
C  en fait c'est l'impression que l'on demande
      ENTRY KIMPR
C
C  EN GKS : SAUVEGARDE DU DESSIN SUR METAFILE METAXX
C  AVEC XX = NUMERO DE 01 A 99
C   INCREMENTATION DU COMPTEUR METAFILE
      KMETA=KMETA+1
      IF (KMETA.GT.99) THEN
       CALL GTX(25.,6.,'COMPTEUR DE MATAFILE SUPERIEUR A 99')
       CALL GTX(25.,4.,'SAUVEGARDE IMPOSSIBLE')
       RETURN
      ENDIF
      I10=KMETA/10
      IREST=KMETA-10*I10
      I10=I10+1
      IREST=IREST+1
      STR=STR1//CARELE(I10)//CARELE(IREST)
*      OPEN(UNIT=1,FILE=STR,STATUS='NEW',IOSTAT=JERROR)
*      IF (JERROR.NE.0) THEN
*         CALL GTX(25.,4.,'SAUVEGARDE IMPOSSIBLE')
*         CALL GTX(25.,6.,'CANNOT OPEN METAFILE')
*         RETURN
*      ENDIF
      KCON=1
      METAID=1
      CALL GQOPS(ISTA)
      IF (ISTA.EQ.4) CALL GCLSG
      CALL GOPWK(METAID,KCON,INMETA)
      CALL GACWK(METAID)
      CALL GSWKWN(METAID,0.,1.,0.,1.)
      CALL GSWKVP(METAID,0.,0.20,0.,0.20)
      ISEG=6+(100*(WKID-1))
      CALL GASGWK(METAID,ISEG)
      ISEG=1+(100*(WKID-1))
      CALL GASGWK(METAID,ISEG)
      IF (FENE) THEN
      IF (VALEUR) THEN
       ISEG=7+(100*(WKID-1))
       CALL GASGWK(METAID,ISEG)
      ELSE
       ISEG=3+(100*(WKID-1))
       IF (IQUALI.EQ.1) CALL GASGWK(METAID,ISEG)
       ISEG=4+(100*(WKID-1))
       IF (INUMNO.EQ.1) CALL GASGWK(METAID,ISEG)
       ISEG=5+(100*(WKID-1))
       IF (INUMEL.EQ.1) CALL GASGWK(METAID,ISEG)
      ENDIF
      ENDIF
      CALL GQWKS(METAID,IERGK,ISTA)
       IF (IERGK.EQ.0) THEN
       IF (ISTA.EQ.1) CALL GDAWK(METAID)
       CALL GCLWK(METAID)
       ENDIF
      CLOSE(UNIT=1,STATUS='KEEP')
      RETURN
C
      ENTRY KVAL(IRESU,ISORT,NISO)
C
      RETURN
C
      ENTRY KMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL)
C
      IF (IMAJ.EQ.1) THEN
      IF (IRESU.NE.2.OR.IQUALI.NE.0.OR.INUMNO.NE.0.OR.INUMEL.NE.0)
     & CALL GCLSG
      ELSE
      IF (IQUALI.EQ.10) IQUALI=0
      IF (INUMNO.EQ.10) INUMNO=0
      IF (INUMEL.EQ.10) INUMEL=0
C
      IF (IRESU.LT.2.OR.IRESU.GT.5) THEN
C   EFFACEMENT DU DESSIN  (A VOIR)
      ENDIF
C   FERMETURE DE LA WORKSTATION WKID POUR POUVOIR PASSER EN MODE
C   ALPHANUMERIQUE A LA FIN DU DESSIN
       CALL GQOPS(ISTA)
       IF (ISTA.EQ.4)  CALL GCLSG
       IF (ISTA.EQ.4.OR.ISTA.EQ.3) CALL GDAWK(WKID)
       IF (ISTA.EQ.4.OR.ISTA.EQ.3.OR.ISTA.EQ.2) CALL GCLWK(WKID)
      ENDIF
      RETURN
C
      ENTRY KTRANI(IANIM,NDEF)
* INITIALISATION POUR ANIMATION
* IANIM 1 ALLER SIMPLE
* IANIM 2 ALLER RETOUR
* NDEF NOMBRE D'IMAGE
      RETURN
C
      ENTRY KTRIMA(IDEF)
* NOUVELLE IMAGE
* IDEF NUMERO DE L'IMAGE
C
      RETURN
C
C  MESSAGE EN BAS DE L'ECRAN
      ENTRY KTRMES(TITRE)
      CALL GMSG(WKID,TITRE(1:LEN(TITRE)))
      RETURN
C
C  INPUT AVEC PROMPT
      ENTRY KTRGET(TITRE,CARACT)
      RETURN
      END