1 : C GTRINI SOURCE CHAT 07/10/29 21:20:27 5940 2 : SUBROUTINE GTRINI(NOL,AXAX,AYAY,TITRE,HAUTT,VALEU,NCOUMA) 3 : C 4 : C DRIVER GRAPHIQUE GDDM (IBM) 5 : C 6 : C INITIALISATION D'UN TRACE 7 : C NOL : NON UTILISE 8 : C AX ,AYAX : DIMENSION POUR LA FEUILLE DE PAPIER 9 : C TITRE : TITRE (CHAINE DE CARACTERES) 10 : C HAUT : HAUTEUR DES CARACTERES 11 : C VALEUR : ECRAN OU ECRAN PLUS MARGE 12 : C NCOUMA : NOMBRE DE COULEUR DU TERMINAL 13 : C ICCOL : INDICE COULEUR COURANTE 14 : C ICOISO : 15 : C 16 : IMPLICIT INTEGER(I-N) 17 : external long 18 : SAVE ICCOL,KSEGN 19 : SAVE XINID,YINID,RX,RY,AX,AY 20 : SAVE VALEUR 21 : SAVE NHAUT,HAUT,NLIG 22 : SAVE IPF,ILIG2 23 : SAVE ICOISO,WIDTH,NLARG,NCOL,HEIGHT 24 : DIMENSION IPF(24) 25 : CHARACTER*(*) TITRE 26 : CHARACTER*21 CHACHA 27 : DIMENSION XTR(*),YTR(*) 28 : DIMENSION IPPAT(4),RMAT(9),LPROC(3) 29 : DIMENSION IARR1(1),IARR2(1),IARR3(1) 30 : DIMENSION KSEGT(20) 31 : CHARACTER*8 NAME 32 : CHARACTER*(*) CARACT 33 : LOGICAL IGDDEJ 34 : LOGICAL VALEUR,FENET,VALEU 35 : CHARACTER*(*) LEGEND(*) 36 : CHARACTER*(500) KEGEND 37 : -INC CCREEL 38 : *-INC CCOPTIO 39 : *-INC CCGEOME 40 : DATA IGDDEJ/.FALSE./ 41 : DATA ICCOUN/0/ 42 : C DATA POUR LE NOM DU FICHIER METAFILE 43 : C 44 : DATA IPPAT/65,66,67,68/ 45 : DATA ICCOL/7/ 46 : C NB DE COULEUR SI PAS AUTRE INDICATION 47 : NCOUMA=7 48 : C SAUVER HAUT 49 : HAUT=HAUTT 50 : NHAUT=31 51 : C SAUVER VALEUR 52 : VALEUR=VALEU 53 : C O SEGMENT POUR COMMENCER 54 : KSEGN=0 55 : C INITIALISATION DE L'UNITE PHYSIQUE 56 : AX=AXAX 57 : AY=AYAY 58 : DO 1 NBCR=72,2,-1 59 : IF (TITRE(NBCR:NBCR).NE.' ') GOTO 2 60 : 1 CONTINUE 61 : 2 CONTINUE 62 : 30 CONTINUE 63 : ILIG2=0 64 : IXSEG=0 65 : IF (IGDDEJ) THEN 65 : CALL FSRNIT 66 : ELSE 66 : CALL FSINN 67 : IGDDEJ=.TRUE. 68 : ENDIF 69 : * AUTORISER MODIFICATIONS LOCALES 70 : LPROC(1)=21 71 : LPROC(2)=1 71 : CALL DSOPEN(0,1,'* ',2,LPROC,0,'GIBI ') 71 : CALL DSUSE(1,0) 72 : * COMBIEN DE COULEURS UTILISABLES ??? (SANS LE FOND) 72 : CALL FSQURY(2,9,1,LPROC) 73 : NCOUMA=LPROC(1)-1 74 : * PATTERN POUR DEGRADES 74 : CALL GSLSS(3,'ADMNOBLA',0) 75 : C RECUPERATION TAILLE DE CARACTERE PAR DEFAUT 76 : C ADAPTATION A LA DIMENSION DE L'ECRAN 76 : CALL FSQURY(0,3,2,LPROC) 77 : NLIG=LPROC(1) 78 : NCOL=LPROC(2) 79 : NHAUT=NLIG-1 80 : NLARG=NCOL 80 : CALL FSPCRT(1,NLIG,NCOL,0) 80 : CALL GSFLD(2,1,NHAUT,NLARG) 80 : CALL GSQPS(WIDTH,HEIGHT) 81 : C ECRITURE DU TITRE 81 : CALL GSWIN(0.,80.,0.,2.) 81 : CALL GSSATI(4,2) 81 : CALL GSSEG(6) 82 : IF (KSEGN.LE.20) KSEGN=KSEGN+1 83 : KSEGT(KSEGN)=6 83 : CALL GSTAG(1) 83 : CALL GSCM(3) 83 : CALL GSCOL(7) 83 : CALL GSCHAR(69.,0.,10,'CASTEM2000') 83 : CALL GSQCB(CWID,CHEI) 84 : HA=HAUT*5. 84 : CALL GSCB(CWID*HA,CHEI*HA) 84 : CALL GSCHAR(0.,0.,NBCR,TITRE) 84 : CALL GSSCLS 85 : IF (VALEUR) THEN 86 : NLARG=NLARG-10 87 : ELSE 88 : NLARG=NLARG-5 89 : HEIGHT=(HEIGHT*(NHAUT-1))/REAL(NHAUT) 90 : ENDIF 90 : CALL GSVIEW(0.,WIDTH*NLARG/NCOL,HEIGHT/NHAUT,HEIGHT) 91 : C CLIPPING DISABLE POUR AVOIR CORRECTEMENT LES NUMEROS ET NOMS 91 : CALL GSCLP(0) 92 : RETURN 93 : * 94 : ENTRY GDFENE(XMIN,XXAX,YMIN,YYAX,XR1,XR2,YR1,YR2,FENET) 95 : C 96 : C DEFINITION DE LA FENETRE UTILISATEUR 97 : C XMIN,X,X,YMIN,YYAX : COORDONNEES DE LA FENETRE UTILISATEUR 98 : C XR1,XR2,YR1,YR2 : COORDONNEES RETOURNEES 99 : C (EFFECTIVEMENT UTILISEES) 100 : C FENET : CALCUL DU RATIO (OUI OU NON) NON UTILISE 101 : C 102 : EC1=AX-3. 103 : EC2=AY-3. 104 : C DEFINITION UNITE UTILISATEUR FENETRE UTILISEE MARGES A RESPECTER 105 : C OUVERTURE SEGMENT 106 : IF (FENET) THEN 106 : CALL GSUWIN(XMIN,XXAX,YMIN,YYAX) 107 : ELSE 107 : CALL GSWIN(XMIN,XXAX,YMIN,YYAX) 108 : ENDIF 109 : XINID=(XMIN+XXAX)/2. 110 : YINID=(YMIN+YYAX)/2. 111 : XR1=XMIN 112 : XR2=XXAX 113 : YR1=YMIN 114 : YR2=YYAX 114 : CALL GSSATI(4,2) 114 : CALL GSSEG(1) 115 : IXSEG=1 116 : IF (KSEGN.LE.20) KSEGN=KSEGN+1 117 : KSEGT(KSEGN)=1 117 : CALL GSTAG(1) 117 : CALL GSCM(3) 117 : CALL GSQCB(CWID,CHEI) 117 : CALL GSCB(CWID,CHEI) 117 : CALL GSCOL(ICCOL) 117 : CALL GSMIX(0) 118 : ICOISO=-100 119 : RETURN 120 : C 121 : ENTRY GTRLAB(X,Y,CARACT,NCAR,HAUTT) 122 : C 123 : C ECRITURE D'UN TEXTE EN (X,Y) 124 : C X,Y : COORDONNEES DE L'ORIGINE DU TEXTE 125 : C CARACT : TEXTE 126 : C NCAR : NOMBRE DE CARACTERES A ECRIRE 127 : C HAUT : 128 : C 129 : HAUT=HAUTT 130 : DO 201 ICAR=NCAR,1,-1 131 : IF (CARACT(ICAR:ICAR).NE.' ') GOTO 202 132 : 201 CONTINUE 133 : C CHAINE VIDE 134 : RETURN 135 : 202 CONTINUE 135 : CALL GSCHAR(X,Y,ICAR,CARACT) 136 : RETURN 137 : C 138 : ENTRY GTRBOX (HAUTX,HAUTY) 138 : CALL GSCM(3) 138 : CALL GSQCB(CWID,CHEI) 138 : CALL GSCB(CWID*HAUTX,CHEI*HAUTY) 139 : RETURN 140 : C 141 : ENTRY GCHCOU(JCOLO) 142 : C 143 : C CHANGEMENT COULEUR (8 DOIT CORRESPONDRE A L'EFFACEMENT) 144 : C JCOLO : INDICE DE LA NOUVELLE COULEUR 145 : C CHANGEMENT DE COULEUR (VOIR LA TABLE DES COULEUR) 146 : C 146 : CALL GSCOL(JCOLO) 147 : RETURN 148 : C 149 : ENTRY GFVALI(IFENI,IRESU,NH) 150 : C 151 : C ACTIVATION DE LA FENETRE DE TRAVAIL 152 : IF (IFENI.EQ.1) THEN 152 : CALL GSVIEW(WIDTH*NLARG/NCOL,WIDTH,HEIGHT/NHAUT,HEIGHT) 152 : CALL GSWIN(0.,1.,2.,REAL(NHAUT+2)) 153 : IRESU=0 154 : ELSE 155 : C DESACTIVATION DE LA FENETRE 155 : CALL GSSCLS 155 : CALL GSVIEW(0.,WIDTH*NLARG/NCOL,HEIGHT/NHAUT,HEIGHT) 155 : CALL GSUWIN(XMIN,XXAX,YMIN,YYAX) 156 : ENDIF 157 : NH=NHAUT 158 : RETURN 159 : C 160 : ENTRY GMENU(LEGEND,NCASE,LLONG) 161 : C AFFICHAGE DU MENU 162 : C 163 : DO 805 II=1,24 164 : IPF(II)=0 165 : 805 CONTINUE 166 : * INIT CHAMP ALPHANUMERIQUE LISTE DES CLES 167 : * REINITIALISATION DES CHAMPS 167 : CALL ASDFLD(1,1,1,1,79,2) 167 : CALL ASFCOL(1,7) 168 : KLEN=LEN(LEGEND(1)) 169 : KCASE=NCASE 170 : KLONG=LLONG 171 : * ON N'AFFICHE PAS 1 (= CONTINUER TOUJOURS PF0) 172 : IDEB1=0 173 : IDEB=1 174 : KEGEND=' ' 175 : DO 800 II=2,KCASE 176 : MLONG=LONG(LEGEND(II)) 177 : IF (MLONG.EQ.1) GOTO 800 178 : IPF(II-1)=1 179 : IF (II.LE.10) THEN 180 : KEGEND(IDEB:IDEB+3)='FP?:' 181 : WRITE (KEGEND(IDEB+2:IDEB+2),FMT='(I1)') II-1 182 : IDEB=IDEB+4 183 : ELSE 184 : KEGEND(IDEB:IDEB+4)='FP??:' 185 : WRITE (KEGEND(IDEB+2:IDEB+3),FMT='(I2)') II-1 186 : IDEB=IDEB+5 187 : ENDIF 188 : DO 801 III=1,MLONG 189 : IF (LEGEND(II)(III:III).NE.' ') GOTO 802 190 : 801 CONTINUE 191 : III=MLONG 192 : 802 CONTINUE 193 : KEGEND(IDEB:IDEB+MLONG-III+1)=LEGEND(II)(III:MLONG) 194 : IDEB=IDEB+MLONG-III+2 195 : IF (IDEB.GT.63.AND.IDEB1.EQ.0) IDEB1=IDEB 196 : 800 CONTINUE 197 : IF (IPF(11).EQ.0.AND.IPF(1).NE.0) THEN 198 : IPF(11)=1 199 : KEGEND(IDEB:IDEB+7)='FP11:LGI' 200 : IDEB=IDEB+8 201 : ENDIF 202 : IF (IDEB.LT.79.AND.IDEB1.NE.0) IDEB1=0 203 : IF (IDEB1.EQ.0.OR.IDEB.EQ.IDEB1) THEN 203 : CALL ASCPUT(1,IDEB-1,KEGEND(1:IDEB-1)) 203 : IF (ILIG2.EQ.1) CALL ASDFLD(4,2,1,1,1,2) 204 : ILIG2=0 205 : ELSE 205 : CALL ASCPUT(1,IDEB1-1,KEGEND(1:IDEB1-1)) 206 : ILIG2=1 206 : CALL ASDFLD(4,2,1,1,79,2) 206 : CALL ASFCOL(4,7) 206 : CALL ASCPUT(4,IDEB-IDEB1,KEGEND(IDEB1:IDEB-1)) 207 : ENDIF 208 : RETURN 209 : C 210 : ENTRY GINSEG(NBSEGT,IRESS) 211 : C 212 : C INITIALISATION D'UN SEGMENT 213 : C NBSEGT : NUMERO DU SEGMENT 214 : C IRESS : SELON SA VALEUR, ON FERME LE SEGMENT PRECEDENT 215 : C 216 : IF (IRESS.NE.2) THEN 216 : IF (IRESS.LT.2.OR.IRESS.GT.5) CALL GSSCLS 217 : ELSE 218 : IRESS=7 219 : ENDIF 219 : CALL GSSATI(2,1) 219 : CALL GSSATI(4,2) 219 : CALL GSSEG(NBSEGT) 220 : IF (KSEGN.LE.20) KSEGN=KSEGN+1 221 : KSEGT(KSEGN)=NBSEGT 221 : CALL GSTAG(1) 221 : CALL GSCM(3) 221 : CALL GSQCB(CWID,CHEI) 221 : CALL GSCB(CWID,CHEI) 222 : RETURN 223 : C 224 : ENTRY GPOLRL(NTRSTU,XTR,YTR) 225 : C 226 : C TRACE D'UNE POLYLIGNE DANS LA VALEUR COURANTE 227 : C NTR : NOMBRE DE POINTS 228 : C XTR,YTR : COORDONNEES DES POINTS 229 : C 230 : NTR=NTRSTU 231 : IF (NTR.LE.1) RETURN 231 : CALL GSMOVE(XTR(1),YTR(1)) 231 : CALL GSPLNE(NTR-1,XTR(2),YTR(2)) 232 : RETURN 233 : C 234 : ENTRY GTRDIG(X,Y,INCLE) 235 : C 236 : C DIGITALISATION D'UN POINT 237 : C X,Y : COORDONNEES DU POINT DESIGNE 238 : C 239 : INCLE=0 239 : CALL GSENAB(2,1,0) 239 : CALL GSILOC(1,0,XINID,YINID) 239 : CALL GSENAB(2,1,1) 239 : CALL GSENAB(1,1,1) 239 : CALL GSENAB(1,0,1) 239 : CALL GSREAD(1,ITTVAL,ICOUNT) 240 : IF (ITTVAL.EQ.1) THEN 240 : CALL GSQCHO(INCLE) 240 : CALL GSREAD(1,ITTVAL,IPLOC) 241 : ENDIF 242 : IF (INCLE.GT.12) INCLE=INCLE-12 242 : CALL GSQLOC(INW,X,Y) 242 : CALL GSENAB(2,1,0) 242 : CALL GSENAB(1,1,0) 242 : CALL GSENAB(1,0,0) 243 : XINID=X 244 : YINID=Y 245 : RETURN 246 : C 247 : ENTRY GTRFAC(NP,XTR,YTR,ZN,ICOLE,IEFF) 248 : C 249 : C TRACE D'UNE FACE AVEC DEGRADE 250 : C NP : NOMBRE DE POINTS 251 : C XTR,YTR : COORDONNEES DES POINTS 252 : C ICOLE : COULEUR 253 : C KP : ECLAIRAGE 254 : C 255 : IEFF=0 256 : C KP=INT(ZN*4./1.58)+1 257 : C IF (IOMBRE.EQ.0) KP=4 258 : KP=4 258 : CALL GSMOVE(XTR(NP),YTR(NP)) 259 : C ON APPLIQUE UNE PATTERN D'EFFACEMENT PUIS UNE DE REMPLISSAGE 260 : IEFF=0 261 : IF (KP.GE.3) IEFF=1 262 : C IF (KP.NE.4) THEN 262 : C CALL GSCOL(8) 262 : C CALL GSPAT(0) 262 : C CALL GSAREA(0) 262 : C CALL GSPLNE(NP-1,XTR,YTR) 262 : C CALL GSENDA 263 : C ENDIF 264 : * POUR AVOIR LA BONNE COULEUR SUR IMAGEN 265 : * IF (KP.NE.1) THEN 265 : CALL GSCOL(ICOLE) 265 : CALL GSPAT(IPPAT(KP)) 265 : CALL GSAREA(0) 265 : CALL GSPLNE(NP-1,XTR,YTR) 265 : CALL GSENDA 266 : * ENDIF 267 : RETURN 268 : C 269 : ENTRY GTRAIS(NP,XTR,YTR,ICOLE) 270 : C 271 : C TRACE D'UNE FACE SANS CALCUL DE DEGRADE 272 : C NP : NOMBRE DE POINTS 273 : C XTR,YTR : COORDONNEES DES POINTS 274 : C ICOLE : COULEUR 275 : C 276 : IF (ICOLE.NE.ICOISO) THEN 277 : ICOISO=ICOLE 277 : CALL GSCOL(ICOISO) 278 : ENDIF 278 : CALL GSMOVE(XTR(NP),YTR(NP)) 278 : CALL GSAREA(0) 278 : CALL GSPLNE(NP-1,XTR(1),YTR(1)) 278 : CALL GSENDA 279 : RETURN 280 : C 281 : C EFFACEMENT ECRAN ON UTILISE GDDM OU CE QU'ON PEUT 282 : ENTRY GTREFF 283 : WRITE (CHACHA(1:4),FMT='(A4)') 17 284 : CHACHA(5:21)='VMFCLEAR ' 284 : CALL CMS(CHACHA(3:21)) 285 : RETURN 286 : C 287 : C AFFICHAGE RETOUR CLE TAPEE 288 : ENTRY GTRAFF(ICLE) 289 : C 290 : C AFFICHAGE RETOUR CLE TAPEE 291 : C ICLE : NUMERO DE CLE RENDUE 292 : C 293 : ICLE=0 294 : 1530 CONTINUE 294 : CALL ASREAD(ITTYP,ICLE,ICOUNT) 295 : IF (ITTYP.EQ.0) ICLE=0 296 : IF (ICLE.GT.12) ICLE=ICLE-12 297 : IF (ICLE.NE.0.AND.IPF(ICLE).EQ.0) GOTO 1530 298 : RETURN 299 : C 300 : * ROUTINE POUR SORTIR CORRECTEMENT DE GKS AVEC MODIFIER 301 : ENTRY GTRMFI 302 : RETURN 303 : C 304 : * ENTRY GZOOM(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA) 305 : ENTRY GZOOM(IZOOM,XMI,XMA,YMI,YMA) 306 : C 307 : C XMI,XMA,YMI,YMA POINTS RENDUS APRES LE ZOOM 308 : C 309 : IRESU=1 310 : C INITIALISATION DU ZOOM 310 : CALL GSQWIN(XL1,XL2,YL1,YL2) 310 : CALL GSENAB(2,1,0) 310 : CALL GSILOC(1,0,(XL1+XL2)/2,(YL1+YL2)/2) 310 : CALL GSENAB(2,1,1) 310 : CALL GSREAD(1,ITTVAL,ICOUNT) 310 : CALL GSQLOC(INW,XRO,XCOL) 310 : CALL GSQLID(2,1,3,LPROC) 311 : IF (LPROC(3).GE.5) THEN 312 : C ECHO TYPE BOITE 312 : CALL GSENAB(2,1,0) 312 : CALL GSIDVF(2,1,1,XRO) 312 : CALL GSIDVF(2,1,2,XCOL) 312 : CALL GSILOC(1,5,XRO+(XL2-XL1)/100,XCOL+(YL2-YL1)/100) 312 : CALL GSENAB(2,1,1) 313 : ENDIF 313 : CALL GSREAD(1,ITTVAL,ICOUNT) 313 : CALL GSQLOC(INW,YRO,YCOL) 313 : CALL GSENAB(2,1,0) 314 : C GESTION DU CADRE DEFINI PAR LES CURSEURS 315 : XMI=MIN(XRO,YRO) 316 : XMA=MAX(XRO,YRO) 317 : YMI=MIN(XCOL,YCOL) 318 : YMA=MAX(XCOL,YCOL) 319 : XMA=MAX(XMA,YMA-YMI+XMI) 320 : YMI=MIN(YMI,-XMA+XMI+YMA) 321 : * IF (XMI.EQ.XMA) XMA=XMA*1.01+1E-30 322 : IF (XMI.EQ.XMA) XMA=XMA*1.01+xpetit 323 : * IF (YMI.EQ.YMA) YMA=YMA*1.01+1E-30 324 : IF (YMI.EQ.YMA) YMA=YMA*1.01+xpetit 325 : XM1=XMI 326 : XM2=XMA 327 : YM1=YMI 328 : YM2=YMA 329 : PAS=MIN((XL2-XL1)/(XMA-XMI),(YL2-YL1)/(YMA-YMI)) 330 : C INITIALISATION DE LA MATRICE DE TRANSFORMATION 331 : RMAT(1)=1 332 : RMAT(2)=0 333 : RMAT(3)=-XMI 334 : RMAT(4)=0 335 : RMAT(5)=1 336 : RMAT(6)=-YMI 337 : RMAT(7)=0 338 : RMAT(8)=0 339 : RMAT(9)=1 339 : CALL GSSTFM(1,9,RMAT,1) 340 : RMAT(1)=PAS 341 : RMAT(2)=0 342 : RMAT(3)=XL1 343 : RMAT(4)=0 344 : RMAT(5)=PAS 345 : RMAT(6)=YL1 346 : RMAT(7)=0 347 : RMAT(8)=0 348 : RMAT(9)=1 348 : CALL GSSTFM(1,9,RMAT,1) 349 : C IF (IDEFOR.NE.0) THEN 350 : C*1093 ISORT=0 351 : C RETURN 352 : C ENDIF 353 : IDEL1=0 354 : IDEL2=0 355 : IDEL3=0 356 : *1093 IF (IQUALI.NE.0) IDEL1=3 357 : *1093 IF (INUMNO.NE.0) IDEL2=4 358 : *1093 IF (INUMEL.NE.0) IDEL3=5 358 : IF (IDEL1.NE.0) CALL GSSDEL(IDEL1) 358 : IF (IDEL2.NE.0) CALL GSSDEL(IDEL2) 358 : IF (IDEL3.NE.0) CALL GSSDEL(IDEL3) 359 : KSEG0=KSEGN 360 : KSEGN=0 361 : DO 2020 KSEG=1,KSEG0 362 : IF (KSEGT(KSEG).EQ.IDEL1) GOTO 2020 363 : IF (KSEGT(KSEG).EQ.IDEL2) GOTO 2020 364 : IF (KSEGT(KSEG).EQ.IDEL3) GOTO 2020 365 : KSEGN=KSEGN+1 366 : KSEGT(KSEGN)=KSEGT(KSEG) 367 : 2020 CONTINUE 368 : *1093 IF (IQUALI.EQ.10) IQUALI=0 369 : *1093 IF (INUMNO.EQ.10) INUMNO=0 370 : *1093 IF (INUMEL.EQ.10) INUMEL=0 371 : *1093 ISORT=1 372 : IRESU=2 372 : CALL GSQAGA(1,SX,SY,HX,HY,RX,RY,DX,DY) 373 : C CALCUL DES COORDONNEES APRES LE ZOOM 374 : XMI=(XMIN-DX)/SX 375 : XMA=(XXAX-DX)/SX 376 : YMI=(YMIN-DY)/SY 377 : YMA=(YYAX-DY)/SY 378 : RETURN 379 : C 380 : ENTRY GCHANG(IRESU,ISORT,ICHANG,JSEG) 381 : C 382 : C VISUALISATION OU NON DU SEGMENT JSEG 383 : C POUR LES CLES QUAL, NOEUD OU ELEM 384 : C 385 : IF (ICHANG.EQ.1) THEN 386 : ICHANG=10 386 : CALL GSSATS(JSEG,2,0) 387 : ISORT=0 388 : RETURN 389 : ELSEIF (ICHANG.EQ.10) THEN 390 : ICHANG=1 390 : CALL GSSATS(JSEG,2,1) 391 : ISORT=0 392 : RETURN 393 : ENDIF 394 : ISORT=1 395 : IRESU=JSEG 396 : ICHANG=1 397 : RETURN 398 : C 399 : ENTRY GINI(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA) 400 : C 401 : C RETOUR AU DESSIN INITIAL - SUPPRESSION DES SEGMENTS 402 : C CONCERNANT QUAL, NOEUD ET ELEM 403 : C INITIALISATION DE LA MATRICE IDENTITE 404 : PAS=1 405 : RMAT(1)=1 406 : RMAT(2)=0 407 : RMAT(3)=0 408 : RMAT(4)=0 409 : RMAT(5)=1 410 : RMAT(6)=0 411 : RMAT(7)=0 412 : RMAT(8)=0 413 : RMAT(9)=1 414 : C APPLICATION DE LA MATRICE AU SEGMENT 414 : CALL GSSTFM(1,9,RMAT,0) 415 : C IF (IDEFOR.NE.0) THEN 416 : C ISORT=0 417 : C RETURN 418 : C ENDIF 419 : IDEL1=0 420 : IDEL2=0 421 : IDEL3=0 422 : IF (IQUALI.NE.0) IDEL1=3 423 : IF (INUMNO.NE.0) IDEL2=4 424 : IF (INUMEL.NE.0) IDEL3=5 424 : IF (IDEL1.NE.0) CALL GSSDEL(IDEL1) 424 : IF (IDEL2.NE.0) CALL GSSDEL(IDEL2) 424 : IF (IDEL3.NE.0) CALL GSSDEL(IDEL3) 425 : KSEG0=KSEGN 426 : KSEGN=0 427 : DO 2420 KSEG=1,KSEG0 428 : IF (KSEGT(KSEG).EQ.IDEL1) GOTO 2420 429 : IF (KSEGT(KSEG).EQ.IDEL2) GOTO 2420 430 : IF (KSEGT(KSEG).EQ.IDEL3) GOTO 2420 431 : KSEGN=KSEGN+1 432 : KSEGT(KSEGN)=KSEGT(KSEG) 433 : 2420 CONTINUE 434 : IF (IQUALI.EQ.10) IQUALI=0 435 : IF (INUMNO.EQ.10) INUMNO=0 436 : IF (INUMEL.EQ.10) INUMEL=0 437 : C RESTITUTION DES COORDONNEES 438 : XMI=XMIN 439 : XMA=XXAX 440 : YMI=YMIN 441 : YMA=YYAX 442 : ISORT=1 443 : IRESU=2 444 : RETURN 445 : C 446 : ENTRY GFLGI 447 : C 448 : C SORTIE GDF POUR CONVERSION EN EN LGI 449 : ICCOUN=ICCOUN+1 450 : IF (ICCOUN.LE.9) WRITE(NAME,FMT='(''GIBI'',I1)') ICCOUN 451 : IF (ICCOUN.GE.10) WRITE(NAME,FMT='(''GIBI'',I2)') ICCOUN 452 : IF (ICCOUN.GE.100) WRITE(NAME,FMT='(''GIBI'',I3)') ICCOUN 453 : C BOUCLE POUR RENDRE TRANSFORMABLES TOUS LES SEGMENTS SAUVES 454 : DO 2920 KSEG=1,KSEGN 454 : CALL GSSATS(KSEGT(KSEG),1,1) 455 : 2920 CONTINUE 455 : CALL GSSAVE(0,IARR1,NAME,0,IARR2,0,IARR3) 456 : DO 2930 KSEG=1,KSEGN 456 : CALL GSSATS(KSEGT(KSEG),1,0) 457 : 2930 CONTINUE 458 : RETURN 459 : C 460 : ENTRY GIMPR 461 : C 462 : C IMPRESSION POUR 3268 463 : C EN GKS : SAUVEGARDE DU DESSIN SUR METAFILE METAXX 464 : C AVEC XX = NUMERO DE 01 A 99 464 : CALL DSOPEN(1,2,'* ',0,LPROC,1,'GIBI ') 464 : CALL DSUSE(2,1) 464 : CALL GSCOPY(66,83) 464 : CALL FSCOPY 464 : CALL FSCLS(1) 465 : RETURN 466 : C 467 : ENTRY GVAL(IRESU,ISORT,NISO) 468 : C 469 : C IF (NISO.NE.0.AND.IDEFOR.EQ.0) THEN 470 : IF (NISO.NE.0) THEN 471 : IXSEG=0 472 : IRESU=10 473 : ISORT=1 474 : ENDIF 475 : RETURN 476 : C 477 : ENTRY GMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL) 478 : C 479 : IF (IMAJ.EQ.1) THEN 480 : IF (IRESU.NE.2.OR.IQUALI.NE.0.OR.INUMNO.NE.0.OR.INUMEL.NE.0) 480 : & CALL GSSCLS 481 : ELSE 482 : IF (IQUALI.EQ.10) IQUALI=0 483 : IF (INUMNO.EQ.10) INUMNO=0 484 : IF (INUMEL.EQ.10) INUMEL=0 485 : C 485 : IF (IRESU.LT.2.OR.(IRESU.GT.5.AND.IRESU.LT.10)) CALL GSCLR 486 : ENDIF 487 : RETURN 488 : C 489 : ENTRY GTRANI(IANIM,NDEF) 490 : * INITIALISATION POUR ANIMATION 491 : * IANIM 1 ALLER SIMPLE 492 : * IANIM 2 ALLER RETOUR 493 : * NDEF NOMBRE D'IMAGE 494 : RETURN 495 : C 496 : ENTRY GTRIMA(IDEF) 497 : * NOUVELLE IMAGE 498 : * IDEF NUMERO DE L'IMAGE 499 : C 499 : CALL FSFRCE 500 : RETURN 501 : C 502 : C MESSAGE EN BAS DE L'ECRAN 503 : ENTRY GTRMES(TITRE) 503 : CALL ASDFLD(2,NLIG,1,1,LEN(TITRE),2) 503 : CALL ASFCOL(2,7) 503 : CALL ASCPUT (2,LEN(TITRE),TITRE) 504 : RETURN 505 : C 506 : C INPUT AVEC PROMPT 507 : ENTRY GTRGET(TITRE,CARACT) 507 : CALL ASDFLD(2,NLIG,1,1,LEN(TITRE),2) 507 : CALL ASFCOL(2,7) 507 : CALL ASCPUT (2,LEN(TITRE),TITRE) 507 : CALL ASDFLD(3,NLIG,LEN(TITRE)+1,1,LEN(CARACT),0) 507 : CALL ASFCOL(3,7) 508 : KEGEND=' ' 508 : CALL ASCPUT (3,LEN(CARACT),KEGEND) 508 : CALL ASFCUR(0,NLIG,LEN(TITRE)+1) 508 : CALL ASREAD(ITTYP,ICLE,ICOUNT) 508 : CALL ASCGET(3,LEN(CARACT),CARACT) 508 : CALL ASDFLD(2,NLIG,1,1,0,2) 508 : CALL ASDFLD(3,NLIG,79,1,0,2) 509 : RETURN 510 : END 511 : 512 : 513 : 514 : 515 : 516 : 517 : 518 : 519 : 520 : 521 : 522 :
© Cast3M 2003 - All rights reserved.
Disclaimer