Télécharger gtrini.eso

Retour à la liste

gtrini
C GTRINI    SOURCE    CB215821  20/08/04    21:15:00     10680          
      SUBROUTINE GTRINI(NOL,AXAX,AYAY,TITRE,HAUTT,VALEU,NCOUMA)
C
C   DRIVER GRAPHIQUE GDDM (IBM)
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 ICCOL,KSEGN
      SAVE XINID,YINID,RX,RY,AX,AY
      SAVE VALEUR
      SAVE NHAUT,HAUT,NLIG
      SAVE IPF,ILIG2
      SAVE ICOISO,WIDTH,NLARG,NCOL,HEIGHT
      DIMENSION IPF(24)
      CHARACTER*(*) TITRE
      CHARACTER*21 CHACHA
      DIMENSION XTR(*),YTR(*)
      DIMENSION IPPAT(4),RMAT(9),LPROC(3)
      DIMENSION IARR1(1),IARR2(1),IARR3(1)
      DIMENSION KSEGT(20)
      CHARACTER*8 NAME
      CHARACTER*(*) CARACT
      LOGICAL IGDDEJ
      LOGICAL VALEUR,FENET,VALEU
      CHARACTER*(500) LEGEND
      CHARACTER*(500) KEGEND
-INC CCREEL
*
-INC PPARAM
-INC CCOPTIO
*-INC CCGEOME
      DATA IGDDEJ/.FALSE./
      DATA ICCOUN/0/
C DATA POUR LE NOM DU FICHIER METAFILE
C
      DATA IPPAT/65,66,67,68/
      DATA ICCOL/7/
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
  30  CONTINUE
      ILIG2=0
      IXSEG=0
      IF (IGDDEJ) THEN
      CALL FSRNIT
      ELSE
      CALL FSINN
      IGDDEJ=.TRUE.
      ENDIF
*  AUTORISER MODIFICATIONS LOCALES
      LPROC(1)=21
      LPROC(2)=1
      CALL DSOPEN(0,1,'*       ',2,LPROC,0,'GIBI    ')
      CALL DSUSE(1,0)
*  COMBIEN DE COULEURS UTILISABLES ??? (SANS LE FOND)
      CALL FSQURY(2,9,1,LPROC)
      NCOUMA=LPROC(1)-1
* PATTERN POUR DEGRADES
      CALL GSLSS(3,'ADMNOBLA',0)
C  RECUPERATION TAILLE DE CARACTERE PAR DEFAUT
C     ADAPTATION A LA DIMENSION DE L'ECRAN
      CALL FSQURY(0,3,2,LPROC)
      NLIG=LPROC(1)
      NCOL=LPROC(2)
      NHAUT=NLIG-1
      NLARG=NCOL
      CALL FSPCRT(1,NLIG,NCOL,0)
      CALL GSFLD(2,1,NHAUT,NLARG)
      CALL GSQPS(WIDTH,HEIGHT)
C  ECRITURE DU TITRE
      CALL GSWIN(0.,80.,0.,2.)
      CALL GSSATI(4,2)
      CALL GSSEG(6)
      IF (KSEGN.LE.20) KSEGN=KSEGN+1
      KSEGT(KSEGN)=6
      CALL GSTAG(1)
      CALL GSCM(3)
      CALL GSCOL(7)
      CALL GSCHAR(69.,0.,10,'CASTEM2000')
      CALL GSQCB(CWID,CHEI)
      HA=HAUT*5.
      CALL GSCB(CWID*HA,CHEI*HA)
      CALL GSCHAR(0.,0.,NBCR,TITRE)
      CALL GSSCLS
      IF (VALEUR) THEN
       NLARG=NLARG-10
      ELSE
       NLARG=NLARG-5
       HEIGHT=(HEIGHT*(NHAUT-1))/REAL(NHAUT)
      ENDIF
      CALL GSVIEW(0.,WIDTH*NLARG/NCOL,HEIGHT/NHAUT,HEIGHT)
C  CLIPPING DISABLE POUR AVOIR CORRECTEMENT LES NUMEROS ET NOMS
      CALL GSCLP(0)
      RETURN
*
      ENTRY GDFENE(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  OUVERTURE SEGMENT
      IF (FENET) THEN
      CALL GSUWIN(XMIN,XXAX,YMIN,YYAX)
      ELSE
      CALL GSWIN(XMIN,XXAX,YMIN,YYAX)
      ENDIF
      XINID=(XMIN+XXAX)/2.
      YINID=(YMIN+YYAX)/2.
      XR1=XMIN
      XR2=XXAX
      YR1=YMIN
      YR2=YYAX
      CALL GSSATI(4,2)
      CALL GSSEG(1)
         IXSEG=1
      IF (KSEGN.LE.20) KSEGN=KSEGN+1
      KSEGT(KSEGN)=1
      CALL GSTAG(1)
      CALL GSCM(3)
      CALL GSQCB(CWID,CHEI)
      CALL GSCB(CWID,CHEI)
      CALL GSCOL(ICCOL)
      CALL GSMIX(0)
      ICOISO=-100
      RETURN
C
      ENTRY GTRLAB(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
      CALL GSCHAR(X,Y,ICAR,CARACT)
      RETURN
C
      ENTRY GTRBOX (HAUTX,HAUTY)
      CALL GSCM(3)
      CALL GSQCB(CWID,CHEI)
      CALL GSCB(CWID*HAUTX,CHEI*HAUTY)
      RETURN
C
      ENTRY GCHCOU(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 GSCOL(JCOLO)
      RETURN
C
      ENTRY GFVALI(IFENI,IRESU,NH)
C
C        ACTIVATION DE LA FENETRE DE TRAVAIL
      IF (IFENI.EQ.1) THEN
      CALL GSVIEW(WIDTH*NLARG/NCOL,WIDTH,HEIGHT/NHAUT,HEIGHT)
      CALL GSWIN(0.,1.,2.,REAL(NHAUT+2))
      IRESU=0
      ELSE
C         DESACTIVATION DE LA FENETRE
      CALL GSSCLS
      CALL GSVIEW(0.,WIDTH*NLARG/NCOL,HEIGHT/NHAUT,HEIGHT)
      CALL GSUWIN(XMIN,XXAX,YMIN,YYAX)
      ENDIF
      NH=NHAUT
      RETURN
C
      ENTRY GMENU(LEGEND,NCASE,LLONG)
C     AFFICHAGE DU MENU
C
      DO 805 II=1,24
      IPF(II)=0
 805  CONTINUE
*  INIT CHAMP  ALPHANUMERIQUE   LISTE DES CLES
*  REINITIALISATION DES CHAMPS
      CALL ASDFLD(1,1,1,1,79,2)
      CALL ASFCOL(1,7)
      KCASE=NCASE
      KLONG=LLONG
*  ON N'AFFICHE PAS 1 (= CONTINUER TOUJOURS PF0)
      IDEB1=0
      IDEB=1
      KEGEND=' '
      DO 800 II=2,KCASE
        MLONG=LLONG
        IF (MLONG.EQ.1) GOTO 800
        IPF(II-1)=1
        IF (II.LE.10) THEN
         KEGEND(IDEB:IDEB+3)='FP?:'
         WRITE (KEGEND(IDEB+2:IDEB+2),FMT='(I1)') II-1
        IDEB=IDEB+4
        ELSE
         KEGEND(IDEB:IDEB+4)='FP??:'
         WRITE (KEGEND(IDEB+2:IDEB+3),FMT='(I2)') II-1
        IDEB=IDEB+5
        ENDIF
        DO 801 III=1,MLONG
C        IF (LEGEND(II)(III:III).NE.' ') GOTO 802
         IF (LEGEND(III+(II-1)*MLONG:
     &              III+(II-1)*MLONG).NE.' ') GOTO 802
 801    CONTINUE
         III=MLONG
 802    CONTINUE
C       KEGEND(IDEB:IDEB+MLONG-III+1)=LEGEND(II)(III:MLONG)
        KEGEND(IDEB:IDEB+MLONG-III+1)=LEGEND(III+(II-1)*MLONG:
     &                                       II*MLONG)
        IDEB=IDEB+MLONG-III+2
        IF (IDEB.GT.63.AND.IDEB1.EQ.0) IDEB1=IDEB
 800  CONTINUE
      IF (IPF(11).EQ.0.AND.IPF(1).NE.0) THEN
        IPF(11)=1
        KEGEND(IDEB:IDEB+7)='FP11:LGI'
        IDEB=IDEB+8
      ENDIF
      IF (IDEB.LT.79.AND.IDEB1.NE.0) IDEB1=0
      IF (IDEB1.EQ.0.OR.IDEB.EQ.IDEB1) THEN
        CALL ASCPUT(1,IDEB-1,KEGEND(1:IDEB-1))
        IF (ILIG2.EQ.1) CALL ASDFLD(4,2,1,1,1,2)
        ILIG2=0
      ELSE
        CALL ASCPUT(1,IDEB1-1,KEGEND(1:IDEB1-1))
        ILIG2=1
        CALL ASDFLD(4,2,1,1,79,2)
        CALL ASFCOL(4,7)
        CALL ASCPUT(4,IDEB-IDEB1,KEGEND(IDEB1:IDEB-1))
      ENDIF
      RETURN
C
      ENTRY GINSEG(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) CALL GSSCLS
      ELSE
       IRESS=7
      ENDIF
      CALL GSSATI(2,1)
      CALL GSSATI(4,2)
      CALL GSSEG(NBSEGT)
      IF (KSEGN.LE.20) KSEGN=KSEGN+1
      KSEGT(KSEGN)=NBSEGT
      CALL GSTAG(1)
      CALL GSCM(3)
      CALL GSQCB(CWID,CHEI)
      CALL GSCB(CWID,CHEI)
      RETURN
C
      ENTRY GPOLRL(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
      CALL GSMOVE(XTR(1),YTR(1))
      CALL GSPLNE(NTR-1,XTR(2),YTR(2))
      RETURN
C
      ENTRY GTRDIG(X,Y,INCLE)
C
C DIGITALISATION D'UN POINT
C     X,Y : COORDONNEES DU POINT DESIGNE
C
      INCLE=0
      CALL GSENAB(2,1,0)
      CALL GSILOC(1,0,XINID,YINID)
      CALL GSENAB(2,1,1)
      CALL GSENAB(1,1,1)
      CALL GSENAB(1,0,1)
       CALL GSREAD(1,ITTVAL,ICOUNT)
       IF (ITTVAL.EQ.1) THEN
        CALL GSQCHO(INCLE)
        CALL GSREAD(1,ITTVAL,IPLOC)
       ENDIF
       IF (INCLE.GT.12) INCLE=INCLE-12
       CALL GSQLOC(INW,X,Y)
      CALL GSENAB(2,1,0)
      CALL GSENAB(1,1,0)
      CALL GSENAB(1,0,0)
       XINID=X
       YINID=Y
      RETURN
C
      ENTRY GTRFAC(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
C      KP=INT(ZN*4./1.58)+1
C     IF (IOMBRE.EQ.0) KP=4
      KP=4
      CALL GSMOVE(XTR(NP),YTR(NP))
C  ON APPLIQUE UNE PATTERN D'EFFACEMENT PUIS UNE DE REMPLISSAGE
      IEFF=0
      IF (KP.GE.3) IEFF=1
C      IF (KP.NE.4) THEN
C       CALL GSCOL(8)
C       CALL GSPAT(0)
C       CALL GSAREA(0)
C       CALL GSPLNE(NP-1,XTR,YTR)
C       CALL GSENDA
C      ENDIF
*   POUR AVOIR LA BONNE COULEUR SUR IMAGEN
*     IF (KP.NE.1) THEN
       CALL GSCOL(ICOLE)
       CALL GSPAT(IPPAT(KP))
       CALL GSAREA(0)
       CALL GSPLNE(NP-1,XTR,YTR)
       CALL GSENDA
*     ENDIF
      RETURN
C
      ENTRY GTRAIS(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
      IF (ICOLE.NE.ICOISO) THEN
      ICOISO=ICOLE
      CALL GSCOL(ICOISO)
      ENDIF
      CALL GSMOVE(XTR(NP),YTR(NP))
      CALL GSAREA(0)
      CALL GSPLNE(NP-1,XTR(1),YTR(1))
      CALL GSENDA
      RETURN
C
C  EFFACEMENT ECRAN  ON UTILISE GDDM OU CE QU'ON PEUT
      ENTRY GTREFF
      WRITE (CHACHA(1:4),FMT='(A4)') 17
      CHACHA(5:21)='VMFCLEAR         '
      CALL CMS(CHACHA(3:21))
      RETURN
C
C  AFFICHAGE RETOUR CLE TAPEE
      ENTRY GTRAFF(ICLE)
C
C AFFICHAGE RETOUR CLE TAPEE
C     ICLE : NUMERO DE CLE RENDUE
C
      ICLE=0
 1530 CONTINUE
      CALL ASREAD(ITTYP,ICLE,ICOUNT)
      IF (ITTYP.EQ.0) ICLE=0
       IF (ICLE.GT.12) ICLE=ICLE-12
       IF (ICLE.NE.0.AND.IPF(ICLE).EQ.0) GOTO 1530
      RETURN
C
* ROUTINE POUR SORTIR CORRECTEMENT DE GKS AVEC MODIFIER
      ENTRY GTRMFI
      RETURN
C
*     ENTRY GZOOM(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
      ENTRY GZOOM(IZOOM,XMI,XMA,YMI,YMA)
C
C     XMI,XMA,YMI,YMA POINTS RENDUS APRES LE ZOOM
C
      IRESU=1
C     INITIALISATION DU ZOOM
      CALL GSQWIN(XL1,XL2,YL1,YL2)
      CALL GSENAB(2,1,0)
      CALL GSILOC(1,0,(XL1+XL2)/2,(YL1+YL2)/2)
      CALL GSENAB(2,1,1)
      CALL GSREAD(1,ITTVAL,ICOUNT)
      CALL GSQLOC(INW,XRO,XCOL)
      CALL GSQLID(2,1,3,LPROC)
      IF (LPROC(3).GE.5) THEN
C  ECHO TYPE BOITE
         CALL GSENAB(2,1,0)
         CALL GSIDVF(2,1,1,XRO)
         CALL GSIDVF(2,1,2,XCOL)
         CALL GSILOC(1,5,XRO+(XL2-XL1)/100,XCOL+(YL2-YL1)/100)
         CALL GSENAB(2,1,1)
      ENDIF
      CALL GSREAD(1,ITTVAL,ICOUNT)
      CALL GSQLOC(INW,YRO,YCOL)
      CALL GSENAB(2,1,0)
C     GESTION DU CADRE DEFINI PAR LES CURSEURS
      XMI=MIN(XRO,YRO)
      XMA=MAX(XRO,YRO)
      YMI=MIN(XCOL,YCOL)
      YMA=MAX(XCOL,YCOL)
      XMA=MAX(XMA,YMA-YMI+XMI)
      YMI=MIN(YMI,-XMA+XMI+YMA)
*      IF (XMI.EQ.XMA) XMA=XMA*1.01+1E-30
      IF (XMI.EQ.XMA) XMA=XMA*1.01+xpetit
*      IF (YMI.EQ.YMA) YMA=YMA*1.01+1E-30
      IF (YMI.EQ.YMA) YMA=YMA*1.01+xpetit
      XM1=XMI
      XM2=XMA
      YM1=YMI
      YM2=YMA
      PAS=MIN((XL2-XL1)/(XMA-XMI),(YL2-YL1)/(YMA-YMI))
C     INITIALISATION DE LA MATRICE DE TRANSFORMATION
      RMAT(1)=1
      RMAT(2)=0
      RMAT(3)=-XMI
      RMAT(4)=0
      RMAT(5)=1
      RMAT(6)=-YMI
      RMAT(7)=0
      RMAT(8)=0
      RMAT(9)=1
      CALL GSSTFM(1,9,RMAT,1)
      RMAT(1)=PAS
      RMAT(2)=0
      RMAT(3)=XL1
      RMAT(4)=0
      RMAT(5)=PAS
      RMAT(6)=YL1
      RMAT(7)=0
      RMAT(8)=0
      RMAT(9)=1
      CALL GSSTFM(1,9,RMAT,1)
C      IF (IDEFOR.NE.0) THEN
C*1093   ISORT=0
C        RETURN
C      ENDIF
      IDEL1=0
      IDEL2=0
      IDEL3=0
*1093 IF (IQUALI.NE.0) IDEL1=3
*1093 IF (INUMNO.NE.0) IDEL2=4
*1093 IF (INUMEL.NE.0) IDEL3=5
      IF (IDEL1.NE.0) CALL GSSDEL(IDEL1)
      IF (IDEL2.NE.0) CALL GSSDEL(IDEL2)
      IF (IDEL3.NE.0) CALL GSSDEL(IDEL3)
      KSEG0=KSEGN
      KSEGN=0
      DO 2020 KSEG=1,KSEG0
      IF (KSEGT(KSEG).EQ.IDEL1) GOTO 2020
      IF (KSEGT(KSEG).EQ.IDEL2) GOTO 2020
      IF (KSEGT(KSEG).EQ.IDEL3) GOTO 2020
      KSEGN=KSEGN+1
      KSEGT(KSEGN)=KSEGT(KSEG)
2020  CONTINUE
*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
      CALL GSQAGA(1,SX,SY,HX,HY,RX,RY,DX,DY)
C    CALCUL DES COORDONNEES APRES LE ZOOM
      XMI=(XMIN-DX)/SX
      XMA=(XXAX-DX)/SX
      YMI=(YMIN-DY)/SY
      YMA=(YYAX-DY)/SY
      RETURN
C
      ENTRY GCHANG(IRESU,ISORT,ICHANG,JSEG)
C
C   VISUALISATION OU NON DU SEGMENT JSEG
C   POUR LES CLES QUAL, NOEUD OU ELEM
C
      IF (ICHANG.EQ.1) THEN
        ICHANG=10
        CALL GSSATS(JSEG,2,0)
        ISORT=0
        RETURN
      ELSEIF (ICHANG.EQ.10) THEN
        ICHANG=1
        CALL GSSATS(JSEG,2,1)
        ISORT=0
        RETURN
      ENDIF
      ISORT=1
      IRESU=JSEG
      ICHANG=1
      RETURN
C
      ENTRY GINI(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
C
C    RETOUR AU DESSIN INITIAL - SUPPRESSION DES SEGMENTS
C    CONCERNANT QUAL, NOEUD ET ELEM
C  INITIALISATION DE LA MATRICE IDENTITE
      PAS=1
      RMAT(1)=1
      RMAT(2)=0
      RMAT(3)=0
      RMAT(4)=0
      RMAT(5)=1
      RMAT(6)=0
      RMAT(7)=0
      RMAT(8)=0
      RMAT(9)=1
C  APPLICATION DE LA MATRICE AU SEGMENT
      CALL GSSTFM(1,9,RMAT,0)
C      IF (IDEFOR.NE.0) THEN
C         ISORT=0
C         RETURN
C      ENDIF
      IDEL1=0
      IDEL2=0
      IDEL3=0
      IF (IQUALI.NE.0) IDEL1=3
      IF (INUMNO.NE.0) IDEL2=4
      IF (INUMEL.NE.0) IDEL3=5
      IF (IDEL1.NE.0) CALL GSSDEL(IDEL1)
      IF (IDEL2.NE.0) CALL GSSDEL(IDEL2)
      IF (IDEL3.NE.0) CALL GSSDEL(IDEL3)
      KSEG0=KSEGN
      KSEGN=0
      DO 2420 KSEG=1,KSEG0
      IF (KSEGT(KSEG).EQ.IDEL1) GOTO 2420
      IF (KSEGT(KSEG).EQ.IDEL2) GOTO 2420
      IF (KSEGT(KSEG).EQ.IDEL3) GOTO 2420
      KSEGN=KSEGN+1
      KSEGT(KSEGN)=KSEGT(KSEG)
2420  CONTINUE
      IF (IQUALI.EQ.10) IQUALI=0
      IF (INUMNO.EQ.10) INUMNO=0
      IF (INUMEL.EQ.10) INUMEL=0
C   RESTITUTION DES COORDONNEES
      XMI=XMIN
      XMA=XXAX
      YMI=YMIN
      YMA=YYAX
      ISORT=1
      IRESU=2
      RETURN
C
      ENTRY GFLGI
C
C   SORTIE GDF POUR CONVERSION EN EN LGI
      ICCOUN=ICCOUN+1
      IF (ICCOUN.LE.9) WRITE(NAME,FMT='(''GIBI'',I1)') ICCOUN
      IF (ICCOUN.GE.10) WRITE(NAME,FMT='(''GIBI'',I2)') ICCOUN
      IF (ICCOUN.GE.100) WRITE(NAME,FMT='(''GIBI'',I3)') ICCOUN
C   BOUCLE POUR RENDRE TRANSFORMABLES TOUS LES SEGMENTS SAUVES
      DO 2920 KSEG=1,KSEGN
      CALL GSSATS(KSEGT(KSEG),1,1)
2920  CONTINUE
      CALL GSSAVE(0,IARR1,NAME,0,IARR2,0,IARR3)
      DO 2930 KSEG=1,KSEGN
      CALL GSSATS(KSEGT(KSEG),1,0)
2930  CONTINUE
      RETURN
C
      ENTRY GIMPR
C
C  IMPRESSION POUR 3268
C  EN GKS : SAUVEGARDE DU DESSIN SUR METAFILE METAXX
C  AVEC XX = NUMERO DE 01 A 99
      CALL DSOPEN(1,2,'*       ',0,LPROC,1,'GIBI    ')
      CALL DSUSE(2,1)
      CALL GSCOPY(66,83)
      CALL FSCOPY
      CALL FSCLS(1)
      RETURN
C
      ENTRY GVAL(IRESU,ISORT,NISO)
C
C      IF (NISO.NE.0.AND.IDEFOR.EQ.0) THEN
      IF (NISO.NE.0) THEN
        IXSEG=0
        IRESU=10
        ISORT=1
      ENDIF
      RETURN
C
      ENTRY GMAJSE(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 GSSCLS
      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.AND.IRESU.LT.10)) CALL GSCLR
      ENDIF
      RETURN
C
      ENTRY GTRANI(IANIM,NDEF)
* INITIALISATION POUR ANIMATION
* IANIM 1 ALLER SIMPLE
* IANIM 2 ALLER RETOUR
* NDEF NOMBRE D'IMAGE
      RETURN
C
      ENTRY GTRIMA(IDEF)
* NOUVELLE IMAGE
* IDEF NUMERO DE L'IMAGE
C
      CALL FSFRCE
      RETURN
C
C  MESSAGE EN BAS DE L'ECRAN
      ENTRY GTRMES(TITRE)
      CALL ASDFLD(2,NLIG,1,1,LEN(TITRE),2)
      CALL ASFCOL(2,7)
      CALL ASCPUT (2,LEN(TITRE),TITRE)
      RETURN
C
C  INPUT AVEC PROMPT
      ENTRY GTRGET(TITRE,CARACT)
      CALL ASDFLD(2,NLIG,1,1,LEN(TITRE),2)
      CALL ASFCOL(2,7)
      CALL ASCPUT (2,LEN(TITRE),TITRE)
      CALL ASDFLD(3,NLIG,LEN(TITRE)+1,1,LEN(CARACT),0)
      CALL ASFCOL(3,7)
      KEGEND=' '
      CALL ASCPUT (3,LEN(CARACT),KEGEND)
      CALL ASFCUR(0,NLIG,LEN(TITRE)+1)
      CALL ASREAD(ITTYP,ICLE,ICOUNT)
      CALL ASCGET(3,LEN(CARACT),CARACT)
      CALL ASDFLD(2,NLIG,1,1,0,2)
      CALL ASDFLD(3,NLIG,79,1,0,2)
      RETURN
      END
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales