1 : C DESSIN SOURCE GOUNAND 12/08/30 21:15:00 7489 2 : SUBROUTINE DESSIN 3 : *============================================================= 4 : * 5 : * Dessine une evolution 6 : * 7 : *============================================================= 8 : * 9 : * Modifications 10 : * 11 : * 95/02/07, Loca : 12 : * pour passer les legendes x et y de 12 a 20 caracteres: 13 : * SEGMENT AXE disparait et est appele en include: -INC TMAXE. 14 : * 15 : * 03/03/14, maugis : 16 : * correction de la position du logo en cas de zoom. 17 : * 18 : * 07/09/04, maugis : 19 : * fourniture du choix des courbes via un LISTENTI 20 : * Maintien du segment AXE actif en modification 21 : * Resolution pb de zoom en logarithmique avec des valeurs 22 : * inferieures a 0. 23 : * Resolution erreur 497 quand 2 clics zoom hors cadre 24 : * 25 : *============================================================= 26 : * 27 : * LISTE DES FONCTIONS : 28 : * 29 : * MINMAX : RETOURNE MINI ET MAXI D'UNE LISTE DE REELS 30 : * BORAXE : CALCUL DES ARRONDIS DE BORNES D'AXES 31 : * INTAXE : CALCUL POUR EFFECTUER LA GRADUATION 32 : * DAXES : DESSIN DES AXES 33 : * ICALP : FONCTION POUR CALCUL DES BORNES D'AXES 34 : * TREVOL : DESSIN D'UNE EVOLUTION 35 : * TRSEG : TRACE DUN SEGMENT DE DROITE 36 : * EXTRAC : EXTRACTION D'UN MOT DANS UNE CHAINE 37 : * LINEAX : LINEARISATION EN X 38 : * LINEAY : LINEARISATION EN Y 39 : * DMARQ : DESSINE DES MARQUEURS 40 : * TRCUR : TRACER DES NOMS EN CAS D'ABSCISSE CURVILIGNE 41 : * TRINIT ET SES FONCTIONS (definies selon la sortie graphique) 42 : * 43 : *============================================================= 44 : * 45 : * LISTE DES VARIABLES : 46 : * 47 : * --- affichage interactif --- 48 : * BMIN,BMAX HAUTEUR DE CARACTERE POUR LES E/S GRAPHIQUES 49 : * BUFFER(X) CHAINE DE CARACTERE POUR LES E/S 50 : * TX,TY TABLES POUR DESSINER UN INDEX L'AIDE DE POLRL 51 : * TXX(X),TYY(X) POSITION POUR LES E/S DES BUFFERS 52 : * ZINDEX INDEX SUR COURBE 53 : * ZLIEN LIEN SUR UN COMMENTAIRE 54 : * 55 : * --- axe --- 56 : * AXE SEGMENT AXE DE TMAXE.INC 57 : * OLDAXE AXE DE SAUVEGARDE POUR RETOUR APRES UN ZOOM 58 : * IPOSX, IPOSY position predefinie du titre des axes X, Y 59 : * TITREX, TITREY TITRE DES AXES X, Y 60 : * XINT YINT GRADUATION ELEMENTAIRE DES AXES X, Y 61 : * ZLOGX, ZLOGY AXE X, Y EN LOG 62 : * ZXFORC, ZYFORC BORNES SUR L'AXE X, Y IMPOSEES 63 : * ZXGRA, ZYGRA graduation sur l'axe X, Y imposee 64 : * 65 : * --- calcul, divers --- 66 : * YMAXI MAXIMUM EN Y SUR L'ENSEMBLE DES EVOLUTIONS 67 : * YMINI MINIMUM EN Y SUR L'ENSEMBLE DES EVOLUTIONS 68 : * ZMIMA AFFICHAGE DU MINIMUM ET DU MAXIMUM 69 : * ZARR SYSTEME D'ARRONDI NON NORMALISE 70 : * ZDATE AFFICHAGE DE LA DATE 71 : * ZHEURE AFFICHAGE DE L'HEURE 72 : * ZLOGO DESSIN DU LOGO 73 : * 74 : * --- general --- 75 : * IPTR POINTEUR UTILISE POUR EVITER LES PBS ESOPE DUS A 76 : * L'ECHANGE D'ARGUMENTS INCLUS DANS DES SEGMENTS 77 : * NOL NUMERO D'ORDRE LOGIQUE DE LA FENETRE 78 : * XDIM,YDIM PARAMETRES POUR TABT (TAILLE PAPIER) 79 : * ZSEPAR TRACE SEPARE DES COURBES 80 : * 81 : * --- evolutions courbes --- 82 : * IEV POINTEUR D'EVOLUTION 83 : * INBEVO NOMBRE TOTAL D'EVOLUTIONS 84 : * NC NUMERO DE L'EVOLUTION QUE L'ON TRAITE (OPTION SEPA) 85 : * ZCUR TABLE INDIQUANT LES EVOLUTIONS CONTENANT DES NOMS 86 : * D'ABSCISSES 87 : * ZOPTIO EXISTENCE D'UNE TABLE D'OPTION SPECIFIQUE 88 : * ZTRACE TABLE INDIQUANT LES COURBES A TRACER 89 : * 90 : * --- legende --- 91 : * IPOSI position predefinie de la legende 92 : * NCT NUMERO DE COURBE A TRACER AVEC LEGENDE SUR UN MEME GRAPHE 93 : * NLG COMPTEUR DE LEGENDES AFFICHABLES (NON VIDES) 94 : * XPOSI, YPOSI position XY de la legende fourni par l utilisateur 95 : * ZLEGEN AJOUT DES LEGENDES EN FIN DE COURBE 96 : * 97 : * --- options graphiques --- 98 : * CHOPT MOT CONTENANT LES OPTIONS SPECIFIQUES 99 : * IOPTIO POINTEUR SUR LA TABLE DES OPTIONS SPECIFIQUES 100 : * LPARAM LISTE DES PARAMETRES GENERAUX NPARAM NOMBRE DE PARAMETRES 101 : * ZAXES TRACE DES AXES OX ET OY 102 : * ZCARRE FENETRE CARREE 103 : * ZGRILL AFFICHAGE D'UNE GRILLE SUR LES AXES EN LOG 104 : * 105 : * --- titre --- 106 : * HTITRE HAUTEUR DU TITRE 107 : * TITRE TITRE GLOBAL DE L'EVOLUTION 108 : * 109 : * 110 : * 111 : * TOUTES LES VARIABLES COMMENCANT PAR T SONT EN SIMPLE PRECISION ! 112 : * 113 : *============================================================= 114 : * 115 : * REMARQUES : 116 : * 117 : * - TOUTES LES VARIABLES EN T SONT DES REELS SIMPLE PRECISION 118 : * POUR COMMUNIQUER AVEC TRINIT 119 : * - JE JOUE SUR LA COULEUR 8 POUR EFFACER DU TEXTE 120 : * - CHAQUE TRBOX CHANGEANT LA TAILLE DES CARACTERES EST SUIVI PAR 121 : * UN TRBOX RAMENANT A L'ETAT INITIAL 122 : * - LE SYSTEME DE LECTURE DES VALEURS N'EST PAS SUPER 123 : * ARRONDI DE LA MACHINE 124 : * INTERACTIVITE PEU CONVIVIAL (SANS DEVLPT. DE DEPENDANT 125 : * MACHINE) 126 : * PAS IMPLEMENTE EN GKS 127 : * 128 : *============================================================= 129 : IMPLICIT LOGICAL (Z) 130 : IMPLICIT INTEGER (I-N) 131 : IMPLICIT REAL*8 (A-H,O-S,U-Y) 132 : * 133 : -INC CCOPTIO 134 : -INC SMEVOLL 135 : -INC SMLREEL 136 : POINTEUR MLREEX.MLREEL,MLREEY.MLREEL 137 : -INC SMLENTI 138 : -INC CCGEOME 139 : -INC TMAXE 140 : -INC CCTRACE 141 : * 142 : REAL*8 RA 143 : REAL LIEN(10,5) 144 : 145 : * 146 : REAL RXDIM,RYDIM,HMIN,TCENTX,TCENTY,HTLOG 147 : dimension TZ(10) 148 : * 149 : LOGICAL VALEUR 150 : CHARACTER*13 LEGEND(8),CARDX,CARDY 151 : CHARACTER*72 TMPCAR 152 : CHARACTER*8 CTYP 153 : 154 : POINTEUR OLDAXE.AXE 155 : * 156 : SEGMENT COM 157 : CHARACTER*30 COMMENT(10) 158 : REAL TXCOM(10),TYCOM(10) 159 : INTEGER ICOUCO(10) 160 : ENDSEGMENT 161 : 162 : * TABLEAU DE LOGIQUE GERE EN DYNAMIQUE 163 : SEGMENT DYN 164 : LOGICAL ZTRACE(NDIMT) 165 : ENDSEGMENT 166 : 167 : SEGMENT CUR 168 : LOGICAL ZCUR(NDIMT2) 169 : ENDSEGMENT 170 : * 171 : DIMENSION TX(2),TY(2) 172 : CHARACTER*72 TITRE,TXTIT,CHOPT,BUFFER 173 : CHARACTER*25 BUFFER1,BUFFER2,BUFFER0 174 : CHARACTER*8 CTYPE,CHVIDE,ETYPE 175 : PARAMETER (NPARAM=22) 176 : CHARACTER*4 LPARAM(NPARAM) 177 : CHARACTER*20 TXAXE,TYAXE 178 : CHARACTER*4 MOPOSI(8),MOPOSX(2),MOGRIL(6),MOGRIS(1) 179 : 180 : * 181 : DATA LPARAM/'LOGX','LOGY','XBOR','YBOR','CARR','SEPA','GRIL', 182 : # 'MIMA','LEGE','DATE','CHOI','NARR','LOGO','TITR', 183 : # 'TITX','TITY','AXES','NCLK','XGRA','YGRA', 184 : # 'POSX','POSY'/ 185 : DATA MOPOSI/'NO ','NE ','SO ','SE ','EXT ','XY ', 186 : # 'NW ','SW '/ 187 : DATA MOPOSX/'EXCE','CENT'/ 188 : DATA MOGRIL/'LIGN','TIRR','TIRC','TIRL','TIRM','POIN'/ 189 : DATA MOGRIS/'GRIS'/ 190 : 191 : 192 : DO II=1,10 193 : TZ(II) = 0 194 : ENDDO 195 : KCLICK = 1 196 : TXTIT = ' ' 197 : TXAXE = ' ' 198 : TYAXE = ' ' 199 : BUFFER = ' ' 200 : NCOMM = 10 201 : ICOM = 0 202 : IBON = 0 203 : ICOLOG = IDCOUL 204 : HDPLOG = 1 205 : HTLOG = 1. 206 : PASSE = 0. 207 : 208 : c options de CCTRACE par défaut 209 : ANGLE=0.d0 210 : IALIGN=0 211 : 212 : * 213 : * CREE L'AXE COURANT ET SA SAUVEGARDE 214 : * 215 : SEGINI AXE 216 : OLDAXE=0 217 : c SEGINI OLDAXE 218 : cbp : on le fait + loin 219 : SEGINI COM 220 : DYN=0 221 : CUR=0 222 : * ETYPE(1:8)='ENTIER ' 223 : * CHVIDE(1:8)=' ' 224 : * 225 : * INITIALISATION DES LOGIQUES ASSOCIES AUX PARAMETRES 226 : * 227 : ZLOGX = .FALSE. 228 : ZLOGY = .FALSE. 229 : ZCARRE = .FALSE. 230 : ZLEGEN = .FALSE. 231 : ZSEPAR = .FALSE. 232 : ZDATE = .FALSE. 233 : ZGRILL = .FALSE. 234 : ZHEURE = .FALSE. 235 : ZMIMA = .FALSE. 236 : ZLOGO = .FALSE. 237 : ZOPTIO = .FALSE. 238 : ZXFORC = .FALSE. 239 : ZYFORC = .FALSE. 240 : ZARR = .FALSE. 241 : ZAXES = .FALSE. 242 : ZINDEX = .FALSE. 243 : ZLOGOO = .FALSE. 244 : ZVALEUR= .FALSE. 245 : ZLIEN = .FALSE. 246 : ZXGRA = .FALSE. 247 : ZYGRA = .FALSE. 248 : 249 : * 250 : * CHARGE L'EVOLUTION 251 : * 251 : CALL LIROBJ('EVOLUTIO',IEV,1,IOK) 252 : * 253 : * TEST SI EVOLUTION LUE 254 : * 255 : IF (IERR.NE.0) GOTO 1000 256 : * 257 : * CALCUL DU NOMBRE TOTAL D'EVOLUTIONS (COPIE DES TITRES) 258 : * 259 : MEVOLL = IEV 260 : SEGACT MEVOLL 261 : TITRE = ' ' 262 : TITRE(1:72)=IEVTEX(1:72) 263 : INBEVO = IEVOLL(/1) 264 : SEGDES MEVOLL 265 : 266 : IF (INBEVO.EQ.0) GOTO 1000 267 : * 268 : * CONSTRUCTION DES COURBES DE TYPE HISTOGRAMME 269 : * 270 : SEGACT,MEVOLL 271 : SEGINI,MEVOL1=MEVOLL 272 : NHIST=0 273 : DO I0=1,INBEVO 274 : KEVOLL=IEVOLL(I0) 275 : SEGACT,KEVOLL 276 : SEGINI,KEVOL1=KEVOLL 277 : IF (NUMEVY.EQ.'HIST') THEN 278 : MLREEX=KEVOLL.IPROGX 279 : SEGACT,MLREEX 280 : JG=2*MLREEX.PROG(/1) 281 : SEGINI,MLREE1 282 : DO J0=1,MLREEX.PROG(/1) 283 : MLREE1.PROG(2*J0-1)=MLREEX.PROG(J0) 284 : MLREE1.PROG(2*J0)=MLREEX.PROG(J0) 285 : ENDDO 286 : SEGDES,MLREEX,MLREE1 287 : KEVOL1.IPROGX=MLREE1 288 : MLREEY=KEVOLL.IPROGY 289 : SEGACT,MLREEY 290 : JG=2*MLREEY.PROG(/1) 291 : SEGINI,MLREE1 292 : MLREE1.PROG(1)=0. 293 : DO J0=1,MLREEY.PROG(/1)-1 294 : MLREE1.PROG(2*J0)=MLREEY.PROG(J0) 295 : MLREE1.PROG(2*J0+1)=MLREEY.PROG(J0) 296 : ENDDO 297 : MLREE1.PROG(JG)=0. 298 : SEGDES,MLREEY,MLREE1 299 : KEVOL1.IPROGY=MLREE1 300 : NHIST=NHIST+1 301 : ENDIF 302 : SEGDES,KEVOLL,KEVOL1 303 : MEVOL1.IEVOLL(I0)=KEVOL1 304 : ENDDO 305 : IF (NHIST.EQ.0) THEN 306 : SEGSUP,MEVOL1 307 : ELSE 308 : SEGDES,MEVOLL,MEVOL1 309 : IEV=MEVOL1 310 : ENDIF 311 : * 312 : * DEFINITION TAILLE CARACTERE 313 : * 314 : * HMIN=.2 315 : 316 : * 317 : * DIMENSIONNE LA TABLE ZTRACE 318 : * 319 : NDIMT=INBEVO 320 : SEGINI DYN 321 : * 322 : * INITIALISATION TABLE ZTRACE 323 : * 324 : DO 1 I=1,INBEVO 325 : ZTRACE(I)=.TRUE. 326 : 1 CONTINUE 327 : * 328 : * CHARGEMENT DES PARAMETRES GENERAUX OPTIONNELS 329 : * 330 : 2 CONTINUE 330 : CALL LIRMOT(LPARAM,NPARAM,INDICE,0) 331 : IF (INDICE.NE.0) THEN 332 : GOTO (3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, 333 : $ 221,222,223,224),INDICE 334 : * 335 : * LOGX : SELECTION ECHELLE LOG EN X 336 : * 337 : 3 CONTINUE 338 : ZLOGX=.TRUE. 339 : GOTO 2 340 : * 341 : * LOGY : SELECTION ECHELLE LOG EN Y 342 : * 343 : 4 CONTINUE 344 : ZLOGY=.TRUE. 345 : GOTO 2 346 : * 347 : * XBOR : BORNES AXE X IMPOSEES 348 : * 349 : 5 CONTINUE 350 : ZXFORC=.TRUE. 350 : CALL LIRREE(XXX,1,IOK) 351 : IF (IERR.NE.0) GOTO 1000 352 : XINF=XXX 352 : CALL LIRREE (XXX,1,IOK) 353 : IF (IERR.NE.0) GOTO 1000 354 : XSUP=XXX 355 : GOTO 2 356 : * 357 : * YBOR : BORNES AXE Y IMPOSEES 358 : * 359 : 6 CONTINUE 360 : ZYFORC=.TRUE. 360 : CALL LIRREE(XXX,1,IOK) 361 : IF (IERR.NE.0) GOTO 1000 362 : YINF=XXX 362 : CALL LIRREE (XXX,1,IOK) 363 : IF (IERR.NE.0) GOTO 1000 364 : YSUP=XXX 365 : GOTO 2 366 : * 367 : * CARR : FENETRE CARRE 368 : * 369 : 7 CONTINUE 370 : ZCARRE=.TRUE. 371 : GOTO 2 372 : * 373 : * SEPA : TRACES SEPARES 374 : * 375 : 8 CONTINUE 376 : ZSEPAR=.TRUE. 377 : GOTO 2 378 : * 379 : * GRIL : UTILISATION D'UNE GRILLE SUR LES AXES EN LOG OU EN LINEAIRE 380 : * 381 : 9 CONTINUE 382 : ZGRILL=.TRUE. 383 : c type de tiret ou de pointillé 383 : CALL LIRMOT(MOGRIL,6,IGRIL,0) 384 : if(IGRIL.eq.0) IGRIL=1 385 : c couleur noir ou grise? 385 : CALL LIRMOT(MOGRIS,1,IGRIS,0) 386 : if(IGRIS.ne.0) IGRIL=-1*IGRIL 387 : GOTO 2 388 : * 389 : * MIMA : AFFICHAGE MINIMUM MAXIMUM 390 : * 391 : 10 CONTINUE 392 : ZMIMA=.TRUE. 393 : GOTO 2 394 : * 395 : * LEGE : AFFICHAGE LEGENDE EN BOUT DE COURBE 396 : * 397 : 11 CONTINUE 398 : ZLEGEN=.TRUE. 399 : * POSITION DE LA LEGENDE 399 : CALL LIRMOT(MOPOSI,8,IPOSI,0) 400 : * PAR DEFAUT EXT <=> POSLEG=5 401 : if(IPOSI.eq.0) IPOSI=5 402 : * XY suivi de la position dans le graphique 403 : if(IPOSI.eq.6) then 403 : CALL LIRREE(XPOSI,1,IRETX) 403 : CALL LIRREE(YPOSI,1,IRETY) 404 : IF(IRETX.EQ.0.OR.IRETY.EQ.0) 405 : & write(ioimp,*) 'LEGE XY doit etre suivi de Xlege Ylege !' 406 : IF (IERR.NE.0) GOTO 1000 407 : endif 408 : * NW et SW sont en fait NO et SO en anglais 409 : if(IPOSI.eq.7) IPOSI=1 410 : if(IPOSI.eq.8) IPOSI=3 411 : * FORCE CARRE POUR AVOIR LA PLACE D'AFFICHER LES LEGENDES 412 : if(IPOSI.eq.5) ZCARRE=.TRUE. 413 : GOTO 2 414 : * 415 : * DATE : AFFICHAGE DATE 416 : * 417 : 12 CONTINUE 418 : ZDATE=.TRUE. 419 : GOTO 2 420 : * 421 : * CHOI : SELECTION DE COURBE 422 : * 423 : 13 CONTINUE 424 : * 425 : * MET A FAUX TOUTES LES SELECTIONS DE TRACES 426 : * 427 : DO 85 I=1,INBEVO 428 : ZTRACE(I)=.FALSE. 429 : 85 CONTINUE 430 : *PM A-t-on un ENTIER, un LISTENTI ou rien en entree ? 430 : CALL QUETYP (CTYP,0,IRETOU) 431 : IF (IRETOU.EQ.0) GOTO 2 432 : IF (CTYP.EQ.'ENTIER ') THEN 433 : IOK = 1 434 : DO WHILE (IOK.EQ.1) 434 : CALL LIRENT (IXX,0,IOK) 435 : IF (IOK.EQ.1) ZTRACE(IXX) = .TRUE. 436 : ENDDO 437 : ENDIF 438 : IF (CTYP.EQ.'LISTENTI') THEN 438 : CALL LIROBJ('LISTENTI',ILENTI,1,IRET) 439 : IF (IRET.NE.1) RETURN 440 : MLENTI = ILENTI 441 : SEGACT, MLENTI 442 : DO I=1,LECT(/1) 443 : IXX = LECT(I) 444 : ZTRACE(IXX) = .TRUE. 445 : ENDDO 446 : ENDIF 447 : GOTO 2 448 : 449 : * 450 : * NARR : GRADUATION NON NORMALISEE 451 : * 452 : 14 CONTINUE 453 : ZARR=.TRUE. 454 : GOTO 2 455 : * 456 : * LOGO : DESSIN DU LOGO 457 : * 458 : 15 CONTINUE 459 : ZLOGO =.TRUE. 460 : ZLOGOO=.TRUE. 461 : GOTO 2 462 : * 463 : * TITR : AFFICHAGE D'UN TITRE GENERAL 464 : * 465 : 16 CONTINUE 465 : CALL LIRCHA(TXTIT(1:72),0,IRETOU) 466 : IF (IRETOU.EQ.0) TXTIT=' ' 467 : GOTO 2 468 : * 469 : * TITX : AFFICHAGE D'UN TITRE EN X 470 : * 471 : 17 CONTINUE 471 : CALL LIRCHA(TXAXE(1:20),0,IRETOU) 472 : IF (IRETOU.EQ.0) TXAXE=' ' 473 : GOTO 2 474 : * 475 : * TITY : AFFICHAGE D'UN TITRE EN Y 476 : * 477 : 18 CONTINUE 477 : CALL LIRCHA(TYAXE(1:20),0,IRETOU) 478 : IF (IRETOU.EQ.0) TYAXE=' ' 479 : GOTO 2 480 : * 481 : * AXES : TRACE DES AXES OX ET OY 482 : * 483 : 19 CONTINUE 484 : ZAXES=.TRUE. 485 : GOTO 2 486 : * 487 : * NCLK : OPTION NOCLICK 488 : * 489 : 20 CONTINUE 490 : KCLICK=0 491 : GOTO 2 492 : * 493 : * XGRA et YGRA : GRADUATIONS IMPOSEES 494 : * 495 : 221 CONTINUE 496 : ZXGRA = .true. 496 : CALL LIRREE(XINT1,1,IOK) 497 : IF(IOK.EQ.0) write(ioimp,*)'XGRA doit etre suivi d un flottant' 498 : IF (IERR.NE.0) GOTO 1000 499 : GOTO 2 500 : * 501 : 222 CONTINUE 502 : ZYGRA = .true. 502 : CALL LIRREE(YINT1,1,IOK) 503 : IF(IOK.EQ.0) write(ioimp,*)'YGRA doit etre suivi d un flottant' 504 : IF (IERR.NE.0) GOTO 1000 505 : GOTO 2 506 : * 507 : * POSX et POSY : GRADUATIONS IMPOSEES 508 : * 509 : 223 CONTINUE 509 : CALL LIRMOT(MOPOSX,2,IIPOS,1) 510 : IF(IIPOS.EQ.0)write(ioimp,*)'POSX doit etre suivi d un mot-clé' 511 : IPOSX=IIPOS 512 : IF(IERR.NE.0) GOTO 1000 513 : GOTO 2 514 : * 515 : 224 CONTINUE 515 : CALL LIRMOT(MOPOSX,2,IIPOS,1) 516 : IF(IIPOS.EQ.0)write(ioimp,*)'POSY doit etre suivi d un mot-clé' 517 : IPOSY=IIPOS 518 : IF(IERR.NE.0) GOTO 1000 519 : GOTO 2 520 : * 521 : ENDIF 522 : * 523 : * LECTURE DE LA TABLE DES PARAMETRES SPECIFIQUES 524 : * 524 : CALL LIROBJ('TABLE',IOPTIO,0,IOK) 525 : IF (IOK.EQ.1) THEN 526 : ZOPTIO=.TRUE. 527 : ENDIF 528 : * 529 : * PREND COMME LEGENDE D'AXE LES LEGENDES DE LA PREMIERE COURBE A TRACER 530 : * 531 : MEVOLL=IEV 532 : SEGACT MEVOLL 533 : I=1 534 : 22 CONTINUE 535 : IF ((.NOT.ZTRACE(I)).AND.(I.LE.INBEVO)) THEN 536 : I=I+1 537 : GOTO 22 538 : ENDIF 539 : IF (I.GT.INBEVO) GOTO 1000 540 : KEVOLL=IEVOLL(I) 541 : SEGACT KEVOLL 542 : TITREX(1:20)=NOMEVX 543 : TITREY(1:20)=NOMEVY 544 : 545 : SEGDES KEVOLL 546 : SEGDES MEVOLL 547 : NC=0 548 : * 549 : * DANS LE CAS DE BORNES IMPOSEES ON VERIFIE QUE LA BORNE SUPERIEURE EST 550 : * EFFECTIVEMENT PLUS PETITE QUE LA BORNE INFERIEURE 551 : * 552 : IF (ZXFORC.AND.XSUP.LT.XINF) GOTO 950 553 : IF (ZYFORC.AND.YSUP.LT.YINF) GOTO 950 554 : * 555 : * DANS LE CAS DE BORNES IMPOSEES EN LOG, ON VERIFIE 556 : * QU'ELLES NE SONT PAS NEGATIVES 557 : * 558 : IF (ZXFORC.AND.ZLOGX.AND.XINF.LT.1.D-30) GOTO 900 559 : IF (ZYFORC.AND.ZLOGY.AND.YINF.LT.1.D-30) GOTO 900 560 : * 561 : * TRIE LES EVOLUTIONS REFERANT DES NOMS D'ABSCISSES 562 : * (CAS DES ABSCISSES CURVILIGNES) 563 : * 564 : NDIMT2=INBEVO 565 : SEGINI CUR 566 : MEVOLL=IEV 567 : SEGACT MEVOLL 568 : DO 23 I=1,INBEVO 569 : KEVOLL=IEVOLL(I) 570 : SEGACT KEVOLL 571 : IF (TYPX(1:8).EQ.'LISTMOTS') THEN 572 : ZTRACE(I)=.FALSE. 573 : ZCUR(I)=.TRUE. 574 : GOTO 23 575 : ENDIF 576 : IF (TYPY(1:8).EQ.'LISTMOTS') THEN 577 : ZTRACE(I)=.FALSE. 578 : ZCUR(I)=.TRUE. 579 : GOTO 23 580 : ENDIF 581 : ZCUR(I)=.FALSE. 582 : SEGDES KEVOLL 583 : 23 CONTINUE 584 : * 585 : * TRACES SIMULTANES 586 : * 587 : IF (.NOT.ZSEPAR) THEN 588 : * 589 : * CALCUL DES BORNES DES AXES SUR X ET SUR Y (TRACES SIMULTANES) 590 : * 591 : IOKX=0 592 : IF (ZXFORC.AND.ZYFORC) IOKX=1 593 : 594 : * BORNES IMPOSEES SUR Y 595 : * 596 : IF(ZYFORC.AND.(.NOT.ZXFORC)) THEN 597 : * 598 : IOKX=-1 599 : * 600 : * BOUCLE SUR LES EVOLUTIONS A TRACER 601 : * 602 : DO 24 J=1,INBEVO 603 : IF (ZTRACE(J)) THEN 604 : KEVOLL=IEVOLL(J) 605 : SEGACT KEVOLL 606 : MLREEX=IPROGX 607 : MLREEY=IPROGY 608 : SEGACT MLREEX 609 : SEGACT MLREEY 610 : NG=MLREEX.PROG(/1) 611 : PGX1=MLREEX.PROG(1) 612 : PGY1=MLREEY.PROG(1) 613 : DO 25 IG=2,NG 614 : IOKMI=0 615 : IOKMA=0 616 : PGX=MLREEX.PROG(IG) 617 : PGY=MLREEY.PROG(IG) 618 : IF ((PGY1-YINF)*(PGY-YINF).LE.0.D0) THEN 619 : IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN 620 : IOKMI=1 621 : VMIN=YINF 621 : CALL INTEXT(PGY1,PGY,PGX1,PGX,VMIN) 622 : ENDIF 623 : IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN 624 : IOKMA=1 625 : VMAX=YINF 625 : CALL INTEXT(PGY1,PGY,PGX1,PGX,VMAX) 626 : ENDIF 627 : ENDIF 628 : IF ((PGY1-YSUP)*(PGY-YSUP).LE.0.D0) THEN 629 : IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN 630 : IOKMA=1 631 : VMAX=YSUP 631 : CALL INTEXT(PGY1,PGY,PGX1,PGX,VMAX) 632 : ENDIF 633 : IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN 634 : IOKMI=1 635 : VMIN=YSUP 635 : CALL INTEXT(PGY1,PGY,PGX1,PGX,VMIN) 636 : ENDIF 637 : ENDIF 638 : IF (.NOT. ((MIN(PGY1,PGY).GT.YSUP).OR. 639 : * (MAX(PGY1,PGY).LT.YINF))) THEN 640 : IF (IOKMI.EQ.0) VMIN=MIN(PGX1,PGX) 641 : IF (IOKMA.EQ.0) VMAX=MAX(PGX1,PGX) 642 : IF (IOKX.LE.0) THEN 643 : IOKX=1 644 : XINF=VMIN 645 : XSUP=VMAX 646 : ELSE 647 : XINF=MIN(XINF,VMIN) 648 : XSUP=MAX(XSUP,VMAX) 649 : ENDIF 650 : ENDIF 651 : PGX1=PGX 652 : PGY1=PGY 653 : 25 CONTINUE 654 : IF (IOKX.LE.0) THEN 655 : IPTR=MLREEX 655 : CALL MINMAX(IPTR,AMINI,AMAXI) 656 : IF (IOKX.EQ.-1) THEN 657 : XINF=AMINI 658 : XSUP=AMAXI 659 : IOKX=0 660 : ELSE 661 : XINF=MIN(XINF,AMINI) 662 : XSUP=MAX(XSUP,AMAXI) 663 : ENDIF 664 : ENDIF 665 : SEGDES MLREEX 666 : SEGDES MLREEY 667 : SEGDES KEVOLL 668 : ENDIF 669 : 24 CONTINUE 670 : * 671 : SEGDES MEVOLL 672 : ENDIF 673 : * 674 : * BORNES IMPOSEES SUR X 675 : * 676 : IF (ZXFORC.AND.(.NOT.ZYFORC)) THEN 677 : * 678 : IOKY=-1 679 : * 680 : * BOUCLE SUR LES EVOLUTIONS A TRACER 681 : * 682 : DO 26 J=1,INBEVO 683 : IF (ZTRACE(J)) THEN 684 : KEVOLL=IEVOLL(J) 685 : SEGACT KEVOLL 686 : MLREEX=IPROGX 687 : MLREEY=IPROGY 688 : SEGACT MLREEX 689 : SEGACT MLREEY 690 : NG=MLREEX.PROG(/1) 691 : PGX1=MLREEX.PROG(1) 692 : PGY1=MLREEY.PROG(1) 693 : DO 27 IG=2,NG 694 : IOKMI=0 695 : IOKMA=0 696 : PGX=MLREEX.PROG(IG) 697 : PGY=MLREEY.PROG(IG) 698 : IF ((PGX1-XINF)*(PGX-XINF).LE.0.D0) THEN 699 : IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN 700 : IOKMI=1 701 : VMIN=XINF 701 : CALL INTEXT(PGX1,PGX,PGY1,PGY,VMIN) 702 : ENDIF 703 : IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN 704 : IOKMA=1 705 : VMAX=XINF 705 : CALL INTEXT(PGX1,PGX,PGY1,PGY,VMAX) 706 : ENDIF 707 : ENDIF 708 : IF ((PGX1-XSUP)*(PGX-XSUP).LE.0.D0) THEN 709 : IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN 710 : IOKMA=1 711 : VMAX=XSUP 711 : CALL INTEXT(PGX1,PGX,PGY1,PGY,VMAX) 712 : ENDIF 713 : IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN 714 : IOKMI=1 715 : VMIN=XSUP 715 : CALL INTEXT(PGX1,PGX,PGY1,PGY,VMIN) 716 : ENDIF 717 : ENDIF 718 : IF (.NOT. ((MIN(PGX1,PGX).GT.XSUP).OR. 719 : * (MAX(PGX1,PGX).LT.XINF))) THEN 720 : IF (IOKMI.EQ.0) VMIN=MIN(PGY1,PGY) 721 : IF (IOKMA.EQ.0) VMAX=MAX(PGY1,PGY) 722 : IF (IOKY.LE.0) THEN 723 : IOKY=1 724 : YINF=VMIN 725 : YSUP=VMAX 726 : ELSE 727 : YINF=MIN(YINF,VMIN) 728 : YSUP=MAX(YSUP,VMAX) 729 : ENDIF 730 : ENDIF 731 : PGX1=PGX 732 : PGY1=PGY 733 : 27 CONTINUE 734 : IF (IOKY.LE.0) THEN 735 : IPTR=MLREEY 735 : CALL MINMAX(IPTR,AMINI,AMAXI) 736 : IF (IOKY.EQ.-1) THEN 737 : YINF=AMINI 738 : YSUP=AMAXI 739 : IOKY=0 740 : ELSE 741 : YINF=MIN(YINF,AMINI) 742 : YSUP=MAX(YSUP,AMAXI) 743 : ENDIF 744 : ENDIF 745 : SEGDES MLREEX 746 : SEGDES MLREEY 747 : SEGDES KEVOLL 748 : ENDIF 749 : 26 CONTINUE 750 : * 751 : SEGDES MEVOLL 752 : ENDIF 753 : * 754 : * PAS DE BORNES IMPOSEES 755 : * 756 : IF ((.NOT.ZXFORC).AND.(.NOT.ZYFORC)) THEN 757 : I=0 758 : 28 CONTINUE 759 : I=I+1 760 : IF (.NOT. ZTRACE(I)) GOTO 28 761 : * 762 : * PREMIERE EVOLUTION : INITIALISATION DU MIN ET DU MAX 763 : * 764 : MEVOLL=IEV 765 : SEGACT MEVOLL 766 : KEVOLL=IEVOLL(I) 767 : SEGACT KEVOLL 768 : MLREEL=IPROGX 769 : IPTR=IPROGX 769 : CALL MINMAX(IPTR,AMINI,AMAXI) 770 : XINF=AMINI 771 : XSUP=AMAXI 772 : SEGDES KEVOLL 773 : 774 : 775 : * 776 : * BOUCLE SUR LES AUTRES EVOLUTIONS A TRACER 777 : * 778 : IF (I.LT.INBEVO) THEN 779 : DO 29 J=I+1,INBEVO 780 : IF (ZTRACE(J)) THEN 781 : KEVOLL=IEVOLL(J) 782 : SEGACT KEVOLL 783 : IPTR=IPROGX 783 : CALL MINMAX(IPTR,AMINI,AMAXI) 784 : SEGDES KEVOLL 785 : IF (AMINI.LT.XINF) XINF=AMINI 786 : IF (AMAXI.GT.XSUP) XSUP=AMAXI 787 : ENDIF 788 : 29 CONTINUE 789 : ENDIF 790 : SEGDES MEVOLL 791 : ENDIF 792 : * 793 : IF ((.NOT.ZYFORC).AND.(.NOT.ZXFORC)) THEN 794 : I=0 795 : 30 CONTINUE 796 : I=I+1 797 : IF (.NOT. ZTRACE(I)) GOTO 30 798 : * 799 : * PREMIERE EVOLUTION : INITIALISATION DU MIN ET DU MAX 800 : * 801 : MEVOLL=IEV 802 : SEGACT MEVOLL 803 : KEVOLL=IEVOLL(I) 804 : SEGACT KEVOLL 805 : IPTR=IPROGY 805 : CALL MINMAX(IPTR,AMINI,AMAXI) 806 : YINF=AMINI 807 : YSUP=AMAXI 808 : SEGDES KEVOLL 809 : * 810 : * BOUCLE SUR LES AUTRES EVOLUTIONS A TRACER 811 : * 812 : DO 31 J=I+1,INBEVO 813 : IF (ZTRACE(J)) THEN 814 : KEVOLL=IEVOLL(J) 815 : SEGACT KEVOLL 816 : IPTR=IPROGY 816 : CALL MINMAX(IPTR,AMINI,AMAXI) 817 : SEGDES KEVOLL 818 : IF (AMINI.LT.YINF) YINF=AMINI 819 : IF (AMAXI.GT.YSUP) YSUP=AMAXI 820 : ENDIF 821 : 31 CONTINUE 822 : SEGDES MEVOLL 823 : ENDIF 824 : c 825 : IF (ZMIMA) THEN 826 : * 827 : * SAUVEGARDE VALEUR AXE POUR CHERCHER MAXI 828 : * 829 : I=0 830 : 32 CONTINUE 831 : I=I+1 832 : IF (.NOT. ZTRACE(I)) GOTO 32 833 : * 834 : * PREMIERE EVOLUTION : INITIALISATION DU MIN ET DU MAX 835 : * 836 : MEVOLL=IEV 837 : SEGACT MEVOLL 838 : KEVOLL=IEVOLL(I) 839 : SEGACT KEVOLL 840 : IPTR=IPROGY 840 : CALL MINMAX(IPTR,AMINI,AMAXI) 841 : YMINI=AMINI 842 : YMAXI=AMAXI 843 : SEGDES KEVOLL 844 : * 845 : * BOUCLE SUR LES AUTRES EVOLUTIONS A TRACER 846 : * 847 : DO 33 J=I+1,INBEVO 848 : IF (ZTRACE(J)) THEN 849 : KEVOLL=IEVOLL(J) 850 : SEGACT KEVOLL 851 : IPTR=IPROGY 851 : CALL MINMAX(IPTR,AMINI,AMAXI) 852 : SEGDES KEVOLL 853 : IF (AMINI.LT.YMINI) YMINI=AMINI 854 : IF (AMAXI.GT.YMAXI) YMAXI=AMAXI 855 : ENDIF 856 : 33 CONTINUE 857 : SEGDES MEVOLL 858 : ENDIF 859 : * 860 : * DANS LE CAS D'AXES EN LOG, 861 : * ON VERIFIE QUE LES BORNES NE SONT PAS NEGATIVES 862 : * 863 : IF (ZLOGX.AND.XINF.LT.1.D-30) GOTO 900 864 : IF (ZLOGY.AND.YINF.LT.1.D-30) GOTO 900 865 : * 866 : * CALCUL DES ARRONDIS, 867 : * Les bornes passent eventuellement en log10 868 : * 868 : CALL BORAXE(XINF,XSUP,ZLOGX) 868 : CALL BORAXE(YINF,YSUP,ZLOGY) 869 : * 870 : * CALCUL DU PAS DE GRADUATION 871 : * en X 871 : CALL INTAXE(XINF,XSUP,XINT,INX,ZLOGX,ZARR.OR.ZXFORC) 872 : if(ZXGRA) then 873 : if(ZLOGX) then 874 : write(ioimp,*) 'Option XGRA non compatible avec LOGX' 875 : else 876 : XINT=XINT1 877 : INX=INT((XSUP-XINF)/XINT+5.D-3) 878 : endif 879 : endif 880 : * en Y 880 : CALL INTAXE(YINF,YSUP,YINT,INY,ZLOGY,ZARR.OR.ZYFORC) 881 : if(ZYGRA) then 882 : if(ZLOGY) then 883 : write(ioimp,*) 'Option YGRA non compatible avec LOGY' 884 : else 885 : YINT=YINT1 886 : INY=INT((YSUP-YINF)/YINT+5.D-3) 887 : endif 888 : endif 889 : c write(6,*) 'XINF,XSUP,XINT,INX=',XINF,XSUP,XINT,INX 890 : c write(6,*) 'YINF,YSUP,YINT,INY=',YINF,YSUP,YINT,INY 891 : * 892 : ENDIF 893 : * 894 : IF (ZSEPAR.AND.ZLOGX.AND.ZXFORC) THEN 895 : X1=XINF 896 : X2=XSUP 897 : ENDIF 898 : IF (ZSEPAR.AND.ZLOGY.AND.ZYFORC) THEN 899 : Y1=YINF 900 : Y2=YSUP 901 : ENDIF 902 : 34 CONTINUE 903 : * 904 : IF (ZSEPAR) THEN 905 : * 906 : * CALCUL PAR COURBE (TRACES SEPARES) 907 : * 908 : 35 CONTINUE 909 : IF (ZLOGX.AND.ZXFORC) THEN 910 : XINF=X1 911 : XSUP=X2 912 : ENDIF 913 : IF (ZLOGY.AND.ZYFORC) THEN 914 : YINF=Y1 915 : YSUP=Y2 916 : ENDIF 917 : NC=NC+1 918 : IF (NC.GT.INBEVO) GOTO 1000 919 : IF (.NOT.ZTRACE(NC)) GOTO 35 920 : MEVOLL=IEV 921 : SEGACT MEVOLL 922 : KEVOLL=IEVOLL(NC) 923 : SEGACT KEVOLL 924 : * 925 : * SURCHARGE DES TITRES 926 : * 927 : TITREX(1:20)=NOMEVX 928 : TITREY(1:20)=NOMEVY 929 : 930 : IOKX=0 931 : IF (ZXFORC.AND.ZYFORC) IOKX=1 932 : * 933 : * BORNES IMPOSEES SUR Y 934 : * 935 : IF(ZYFORC.AND.(.NOT.ZXFORC)) THEN 936 : * 937 : IOKX=-1 938 : MLREEX=IPROGX 939 : MLREEY=IPROGY 940 : SEGACT MLREEX 941 : SEGACT MLREEY 942 : NG=MLREEX.PROG(/1) 943 : PGX1=MLREEX.PROG(1) 944 : PGY1=MLREEY.PROG(1) 945 : DO 36 IG=2,NG 946 : IOKMI=0 947 : IOKMA=0 948 : PGX=MLREEX.PROG(IG) 949 : PGY=MLREEY.PROG(IG) 950 : IF ((PGY1-YINF)*(PGY-YINF).LE.0.D0) THEN 951 : IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN 952 : IOKMI=1 953 : VMIN=YINF 953 : CALL INTEXT(PGY1,PGY,PGX1,PGX,VMIN) 954 : ENDIF 955 : IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN 956 : IOKMA=1 957 : VMAX=YINF 957 : CALL INTEXT(PGY1,PGY,PGX1,PGX,VMAX) 958 : ENDIF 959 : ENDIF 960 : IF ((PGY1-YSUP)*(PGY-YSUP).LE.0.D0) THEN 961 : IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN 962 : IOKMA=1 963 : VMAX=YSUP 963 : CALL INTEXT(PGY1,PGY,PGX1,PGX,VMAX) 964 : ENDIF 965 : IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN 966 : IOKMI=1 967 : VMIN=YSUP 967 : CALL INTEXT(PGY1,PGY,PGX1,PGX,VMIN) 968 : ENDIF 969 : ENDIF 970 : IF (.NOT. ((MIN(PGY1,PGY).GT.YSUP).OR. 971 : * (MAX(PGY1,PGY).LT.YINF))) THEN 972 : IF (IOKMI.EQ.0) VMIN=MIN(PGX1,PGX) 973 : IF (IOKMA.EQ.0) VMAX=MAX(PGX1,PGX) 974 : IF (IOKX.LE.0) THEN 975 : IOKX=1 976 : XINF=VMIN 977 : XSUP=VMAX 978 : ELSE 979 : XINF=MIN(XINF,VMIN) 980 : XSUP=MAX(XSUP,VMAX) 981 : ENDIF 982 : ENDIF 983 : PGX1=PGX 984 : PGY1=PGY 985 : 36 CONTINUE 986 : IF (IOKX.LE.0) THEN 987 : IPTR=MLREEX 987 : CALL MINMAX(IPTR,AMINI,AMAXI) 988 : IF (IOKX.EQ.-1) THEN 989 : XINF=AMINI 990 : XSUP=AMAXI 991 : IOKX=0 992 : ELSE 993 : XINF=MIN(XINF,AMINI) 994 : XSUP=MAX(XSUP,AMAXI) 995 : ENDIF 996 : ENDIF 997 : SEGDES MLREEX 998 : SEGDES MLREEY 999 : ENDIF 1000 : * 1001 : * BORNES IMPOSEES SUR X 1002 : * 1003 : IF (ZXFORC.AND.(.NOT.ZYFORC)) THEN 1004 : * 1005 : IOKY=-1 1006 : MLREEX=IPROGX 1007 : MLREEY=IPROGY 1008 : SEGACT MLREEX 1009 : SEGACT MLREEY 1010 : NG=MLREEX.PROG(/1) 1011 : PGX1=MLREEX.PROG(1) 1012 : PGY1=MLREEY.PROG(1) 1013 : DO 37 IG=2,NG 1014 : IOKMI=0 1015 : IOKMA=0 1016 : PGX=MLREEX.PROG(IG) 1017 : PGY=MLREEY.PROG(IG) 1018 : IF ((PGX1-XINF)*(PGX-XINF).LE.0.D0) THEN 1019 : IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN 1020 : IOKMI=1 1021 : VMIN=XINF 1021 : CALL INTEXT(PGX1,PGX,PGY1,PGY,VMIN) 1022 : ENDIF 1023 : IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN 1024 : IOKMA=1 1025 : VMAX=XINF 1025 : CALL INTEXT(PGX1,PGX,PGY1,PGY,VMAX) 1026 : ENDIF 1027 : ENDIF 1028 : IF ((PGX1-XSUP)*(PGX-XSUP).LE.0.D0) THEN 1029 : IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN 1030 : IOKMA=1 1031 : VMAX=XSUP 1031 : CALL INTEXT(PGX1,PGX,PGY1,PGY,VMAX) 1032 : ENDIF 1033 : IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN 1034 : IOKMI=1 1035 : VMIN=XSUP 1035 : CALL INTEXT(PGX1,PGX,PGY1,PGY,VMIN) 1036 : ENDIF 1037 : ENDIF 1038 : IF (.NOT. ((MIN(PGX1,PGX).GT.XSUP).OR. 1039 : * (MAX(PGX1,PGX).LT.XINF))) THEN 1040 : IF (IOKMI.EQ.0) VMIN=MIN(PGY1,PGY) 1041 : IF (IOKMA.EQ.0) VMAX=MAX(PGY1,PGY) 1042 : IF (IOKY.LE.0) THEN 1043 : IOKY=1 1044 : YINF=VMIN 1045 : YSUP=VMAX 1046 : ELSE 1047 : YINF=MIN(YINF,VMIN) 1048 : YSUP=MAX(YSUP,VMAX) 1049 : ENDIF 1050 : ENDIF 1051 : PGX1=PGX 1052 : PGY1=PGY 1053 : 37 CONTINUE 1054 : IF (IOKY.LE.0) THEN 1055 : IPTR=MLREEY 1055 : CALL MINMAX(IPTR,AMINI,AMAXI) 1056 : IF (IOKY.EQ.-1) THEN 1057 : YINF=AMINI 1058 : YSUP=AMAXI 1059 : IOKY=0 1060 : ELSE 1061 : YINF=MIN(YINF,AMINI) 1062 : YSUP=MAX(YSUP,AMAXI) 1063 : ENDIF 1064 : ENDIF 1065 : SEGDES MLREEX 1066 : SEGDES MLREEY 1067 : ENDIF 1068 : * 1069 : * PAS DE BORNES IMPOSEES 1070 : * 1071 : IF ((.NOT.ZXFORC).AND.(.NOT.ZYFORC)) THEN 1072 : IPTR=IPROGX 1072 : CALL MINMAX(IPTR,AMINI,AMAXI) 1073 : XINF=AMINI 1074 : XSUP=AMAXI 1075 : IPTR=IPROGY 1075 : CALL MINMAX(IPTR,AMINI,AMAXI) 1076 : YINF=AMINI 1077 : YSUP=AMAXI 1078 : ENDIF 1079 : IF (ZMIMA) THEN 1080 : * 1081 : * SAUVEGARDE VALEUR AXE POUR CHERCHER MAXI 1082 : * 1083 : IPTR=IPROGY 1083 : CALL MINMAX(IPTR,YMINI,YMAXI) 1084 : ENDIF 1085 : SEGDES KEVOLL 1086 : SEGDES MEVOLL 1087 : * 1088 : * DANS LE CAS D'AXES EN LOG, 1089 : * ON VERIFIE QUE LES BORNES NE SONT PAS NEGATIVES 1090 : * 1091 : IF (ZLOGX.AND.XINF.LT.1.D-30) GOTO 900 1092 : IF (ZLOGY.AND.YINF.LT.1.D-30) GOTO 900 1093 : * 1094 : * CALCUL DES ARRONDIS 1095 : * Les bornes passent eventuellement en log10 1096 : * 1096 : CALL BORAXE(XINF,XSUP,ZLOGX) 1096 : CALL BORAXE(YINF,YSUP,ZLOGY) 1097 : * 1098 : * CALCUL DU PAS DE GRADUATION 1099 : * 1099 : CALL INTAXE (XINF,XSUP,XINT,INX,ZLOGX,ZARR.OR.ZXFORC) 1099 : CALL INTAXE (YINF,YSUP,YINT,INY,ZLOGY,ZARR.OR.ZYFORC) 1100 : * 1101 : ENDIF 1102 : * 1103 : * SAUVEGARDE DE L'AXE POUR RETOUR GRAPHE INITIAL 1104 : * 1105 : c OLDAXE.XINF=XINF 1106 : c OLDAXE.XSUP=XSUP 1107 : c OLDAXE.YINF=YINF 1108 : c OLDAXE.YSUP=YSUP 1109 : c OLDAXE.XINT=XINT 1110 : c OLDAXE.YINT=YINT 1111 : c OLDAXE.INX =INX 1112 : c OLDAXE.INY =INY 1113 : cbp: on commente ci-dessus pour faire autrement 1114 : SEGINI,OLDAXE=AXE 1115 : * 1116 : * TRAITEMENT TRACE 1117 : * 1118 : * INITIALISATION DU GRAPHIQUE 1119 : * 1120 : 38 CONTINUE 1120 : CALL OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,TTXX,TTXXX, 1121 : & TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,DYN,NDIMT,CUR,NDIMT2,NC 1122 : & ,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,IPOSI,XPOSI,YPOSI,IGRIL) 1123 : IF (IERR.NE.0) GOTO 1000 1124 : IF (PASSE.LT.0.5) THEN 1125 : TDX = ((TTXXX-TTXX)/10.)*3./4. 1126 : TDY = ((TTYYY-TTYY)/10.)*15./14. 1127 : TCENTX = TTXXX-(TDX/2.) 1128 : TCENTY = TTYYY-(TDY/2.) 1129 : OLDLOGX= TCENTX 1130 : OLDLOGY= TCENTY 1131 : OLDTX1 = TTXX 1132 : OLDTY1 = TTYY 1133 : OLDTX2 = TTXXX 1134 : OLDTY2 = TTYYY 1135 : PASSE = 1. 1136 : ENDIF 1137 : 1138 : 1139 : * 1140 : * MEMORISATION POUR IMPRESSION DU DESSIN 1141 : * 1141 : * CALL MAJSEG(1,0,0,0,0) 1142 : 1143 : *********************************************** 1144 : * APPEL DE NLOGO 1145 : IF (ZLOGO) THEN 1145 : CALL LOGDES (TTXXX,TTYYY,TTXX,TTYY,AXE, 1146 : & tcentx,tcenty,htlog,icolog) 1146 : CALL CHCOUL(IDCOUL) 1147 : ENDIF 1148 : * 1149 : * COMMENTAIRES SI IL Y EN A 1150 : * SEGACT COM 1151 : IF (ICOM.NE.0) THEN 1152 : DO JK=1,ICOM 1152 : CALL CHCOUL(ICOUCO(JK)) 1152 : CALL TRLABL (TXCOM(JK),TYCOM(JK),0.,COMMENT(JK),30,HMIN) 1153 : ENDDO 1153 : CALL CHCOUL(IDCOUL) 1154 : ENDIF 1155 : * BERTIN: Redessiner le lien 1156 : IF(ZLIEN) THEN 1157 : DO JK=1, ICOM 1158 : TX(1)=LIEN(JK,1) 1159 : TY(1)=LIEN(JK,2) 1160 : TX(2)=LIEN(JK,3) 1161 : TY(2)=LIEN(JK,4) 1161 : CALL POLRL(2,TX,TY,tz) 1162 : ENDDO 1163 : ENDIF 1164 : 1165 : * 1166 : * INDEX 1167 : * 1168 : IF (ZINDEX) THEN 1169 : TX(1)=XINF 1170 : TY(1)=TLACY 1171 : TX(2)=XSUP 1172 : TY(2)=TLACY 1173 : 1173 : CALL POLRL(2,TX,TY,tz) 1174 : TX(1)=tlacx 1175 : TY(1)=YINF 1176 : TX(2)=tlacx 1177 : TY(2)=YSUP 1177 : CALL POLRL(2,TX,TY,tz) 1178 : TYINF=YINF 1178 : CALL TRLABL (TXIND,TLACY+0.02,0.,CARDY,11,HMIN) 1178 : CALL TRLABL (TLACX,TYINF+0.02,0.,CARDX,11,HMIN) 1179 : ENDIF 1180 : 1180 : CALL TRCLIK(KCLICK) 1181 : * 1182 : * MEMORISATION POUR IMPRESSION DU DESSIN 1183 : * 1183 : * CALL MAJSEG(1,0,0,0,0) 1184 : * 1185 : * EN INTERACTIF CREATION MENU PRINCIPAL 1186 : * EN BATCH LOCAL CREATION FICHIER PUN 1187 : * EN BATCH AUCUN EFFET 1188 : * 1189 : 50 CONTINUE 1190 : LEGEND(1)=' Fin dessin' 1191 : LEGEND(2)=' Zoom ' 1192 : LEGEND(3)=' Initial ' 1193 : LEGEND(4)=' Valeur ' 1194 : LEGEND(5)=' Presenter ' 1195 : LEGEND(6)=' Options ' 1195 : CALL MENU(LEGEND,6,13) 1196 : * 1196 : CALL TRAFF (ICLE) 1197 : IF (ICLE.GT.5) GOTO 50 1198 : * 1199 : * GESTION DU ZOOM 1200 : * 1201 : IF (ICLE.EQ.1) THEN 1202 : 1203 : 51 CONTINUE 1204 : BUFFER0='cliquez 2 coins opposes ' 1204 : CALL TRMESS(BUFFER0) 1205 : * Premier clic 1205 : CALL TRDIG (TXX1,TYY1,INOUSE) 1206 : * Deuxieme clic 1206 : CALL TRDIG (TXX2,TYY2,INOUSE) 1207 : * 1208 : * Test position des deux coins l'un par rapport a l'autre 1209 : * Superieur gauche 1210 : TXX=MIN(TXX1,TXX2) 1211 : TYY=MAX(TYY1,TYY2) 1212 : * Inferieur droit 1213 : TXXX=MAX(TXX1,TXX2) 1214 : TYYY=MIN(TYY1,TYY2) 1215 : *PM IF ((ZLOGX).AND.(TXX .LT.1.E-30)) GOTO 51 ????????????? 1216 : *PM IF ((ZLOGY).AND.(TYYY.LT.1.E-30)) GOTO 51 ????????????? 1217 : * 1218 : * Restriction de la fenetre aux nouvelles bornes 1219 : * On n'intervient sur les bornes que s'il n'y a pas eu deux clics 1220 : * en dehors du cadre du meme cote : on ignore alors le zoom 1221 : * sur la coordonnee hors cadre. 1222 : XINFN = XINF 1223 : XSUPN = XSUP 1224 : YINFN = YINF 1225 : YSUPN = YSUP 1226 : IF ((TXX.GT.REAL(XINF)).AND.(TXX.LT.REAL(XSUP))) THEN 1227 : XINFN=DBLE(TXX) 1228 : ENDIF 1229 : IF ((TYY.LT.REAL(YSUP)).AND.(TYY.GT.REAL(YINF))) THEN 1230 : YSUPN=DBLE(TYY) 1231 : ENDIF 1232 : IF ((TXXX.LT.REAL(XSUP)).AND.(TXXX.GT.REAL(XINF))) THEN 1233 : XSUPN=DBLE(TXXX) 1234 : ENDIF 1235 : IF ((TYYY.GT.REAL(YINF)).AND.(TYYY.LT.REAL(YSUP))) THEN 1236 : YINFN=DBLE(TYYY) 1237 : ENDIF 1238 : 1239 : 1240 : * XINF, XSUP, YINF, YSUP sont eventuellement log10 1241 : * on determine les nouvelles valeurs non transformees. 1242 : IF (ZLOGX) THEN 1243 : XINF = 10.D0**XINFN 1244 : XSUP = 10.D0**XSUPN 1245 : ELSE 1246 : XINF = XINFN 1247 : XSUP = XSUPN 1248 : ENDIF 1249 : IF (ZLOGY) THEN 1250 : YINF = 10.D0**YINFN 1251 : YSUP = 10.D0**YSUPN 1252 : ELSE 1253 : YINF = YINFN 1254 : YSUP = YSUPN 1255 : ENDIF 1256 : * 1257 : * CALCUL POUR LE NOUVEL AXE 1258 : * Les bornes repassent eventuellement en log10 1259 : * 1259 : CALL BORAXE(XINF,XSUP,ZLOGX) 1259 : CALL BORAXE(YINF,YSUP,ZLOGY) 1259 : CALL INTAXE(XINF,XSUP,XINT,INX,ZLOGX,ZARR.OR.ZXFORC) 1259 : CALL INTAXE(YINF,YSUP,YINT,INY,ZLOGY,ZARR.OR.ZYFORC) 1260 : * 1261 : * Calcul nouvelles coordonnees logo 1262 : * 1263 : DELTX1 = OLDAXE.XSUP - OLDAXE.XINF 1264 : DELTX2 = XSUP - XINF 1265 : 1266 : DELTY1 = OLDAXE.YSUP - OLDAXE.YINF 1267 : DELTY2 = YSUP - YINF 1268 : 1269 : DELTX = DELTX1 / DELTX2 1270 : DELTY = DELTY1 / DELTY2 1271 : TCENTX = ((OLDLOGX - OLDAXE.XINF) / DELTX) + XINF 1272 : TCENTY = ((OLDLOGY - OLDAXE.YINF) / DELTY) + YINF 1273 : GOTO 38 1274 : ENDIF 1275 : * 1276 : * GESTION RETOUR AU GRAPHE ORIGINAL 1277 : * 1278 : IF (ICLE.NE.2) go to 7654 1279 : 125 Continue 1280 : tcexx= (TCENTX -XSUP )/ ( XSUP-XINF) 1281 : tceyy= (TCENTY -YSUP )/ ( YSUP-YINF) 1282 : 1283 : XINF = OLDAXE.XINF 1284 : XSUP = OLDAXE.XSUP 1285 : YSUP = OLDAXE.YSUP 1286 : YINF = OLDAXE.YINF 1287 : XINT = OLDAXE.XINT 1288 : YINT = OLDAXE.YINT 1289 : INX = OLDAXE.INX 1290 : INY = OLDAXE.INY 1291 : TTXX = OLDTX1 1292 : TTYY = OLDTY1 1293 : TTXXX = OLDTX2 1294 : TTYYY = OLDTY2 1295 : TDX = ((TTXXX-TTXX)/10.)* 3./4. 1296 : TDY = ((TTYYY-TTYY)/10.)*15./14. 1297 : TCENTX=tcexx *(XSUP-XINF) +XSUP 1298 : TCENTY=tceyy *(ySUP-yINF) +ySUP 1299 : * TCENTX = TTXXX-(TDX/2.) 1300 : * TCENTY = TTYYY-(TDY/2.) 1301 : OLDLOGX= TCENTX 1302 : OLDLOGY= TCENTY 1303 : GOTO 38 1304 : 7654 continue 1305 : * ENDIF 1306 : * 1307 : * GESTION AFFICHAGE DE VALEUR 1308 : * 1309 : **TC IF (ICLE.EQ.3) THEN 1310 : IF (ICLE.NE.3) GO TO 7657 1311 : ZVALEUR=.TRUE. 1312 : TXXX=REAL(XINF+(XSUP-XINF)/2.D0) 1313 : TYYY=REAL(YINF+(YSUP-YINF)/2.D0) 1313 : 52 CALL TRDIG (TXXX,TYYY,INOUSE) 1314 : TXXA=TXXX 1315 : TYYA=TYYY 1316 : * 1317 : MEVOLL=IEV 1318 : SEGACT MEVOLL 1319 : KEVOLL=IEVOLL(1) 1320 : SEGACT KEVOLL 1321 : MLREEL=IPROGX 1322 : SEGACT MLREEL 1323 : DO JK=1,PROG(/1) 1324 : IF(PROG(JK).GT.TXXA) THEN 1325 : *C# MC 03/11/97 : ajout de ce test car PROG(JK-1) 1326 : IF(JK.GT.1) THEN 1327 : IF(ABS(PROG(JK)-TXXA).GT.ABS(PROG(JK-1)-TXXA)) THEN 1328 : JKNUM=JK-1 1329 : ELSE 1330 : JKNUM=JK 1331 : ENDIF 1332 : ELSE 1333 : JKNUM=JK 1334 : ENDIF 1335 : GOTO 777 1336 : ENDIF 1337 : ENDDO 1338 : 1339 : *777 SEGDES MLREEL,KEVOLL,MEVOLL 1340 : 777 CONTINUE 1341 : BUFFER0='Point : ' 1342 : 1342 : CALL CHCOUL (IDCOUL) 1343 : TXXA=PROG(JKNUM) 1344 : IF (ZLOGX) TXXA=10.**TXXA 1345 : BUFFER1='X : ' 1346 : TXXA=PROG(JKNUM) 1347 : SEGDES MLREEL,KEVOLL,MEVOLL 1348 : 7773 WRITE (BUFFER0(9:15),FMT='(I6)') JKNUM 1349 : WRITE (BUFFER1(4:14),FMT='(G11.4)') TXXA 1350 : BUFFER2='Y : ' 1351 : * BERTIN: Recuperation de l'abscisse correspondant au curseur 1352 : MEVOLL=IEV 1353 : SEGACT MEVOLL 1354 : KEVOLL=IEVOLL(1) 1355 : SEGACT KEVOLL 1356 : MLREEL=IPROGY 1357 : SEGACT MLREEL 1358 : TYYA=PROG(JKNUM) 1359 : SEGDES MLREEL,KEVOLL,MEVOLL 1360 : * BERTIN: Fin recuperation abscisse 1361 : IF (ZLOGY) TYYA=10.**TYYA 1362 : WRITE (BUFFER2(4:14),FMT='(G11.4)') TYYA 1362 : *PP CALL TRMESS(BUFFER1//BUFFER2) 1362 : * CALL TRMESS(BUFFER1//BUFFER2//BUFFER0) 1363 : 1364 : * BERTIN: Affichage d'une croix au point correspondant au curseur 1365 : ZINDEX=.TRUE. 1366 : TLACX=TXXA 1367 : TLACY=TYYA 1368 : IF (ZVALEUR) GOTO 7771 1369 : 7772 CONTINUE 1370 : ** BERTIN: FIN affichage croix 1371 : ZVALEUR=.TRUE. 1371 : CALL TRMESS(BUFFER1//BUFFER2//BUFFER0) 1372 : LEGEND(1)=' ' 1373 : LEGEND(2)=' Retour ' 1374 : LEGEND(3)=' <-- ' 1375 : LEGEND(4)=' --> ' 1375 : CALL MENU(LEGEND,4,13) 1375 : CALL TRAFF(ICLE9) 1376 : * BERTIN: Gestion du deplacement curseur 1377 : IF (ICLE9.EQ.0) THEN 1378 : STOP 1379 : **TC ELSEIF (ICLE9.EQ.2) ENDIF 1380 : ENDIF 1381 : IF (ICLE9.ne.2) GO TO 7655 1382 : JKNUM=JKNUM-1 1383 : SEGACT MEVOLL 1384 : KEVOLL=IEVOLL(1) 1385 : SEGACT KEVOLL 1386 : MLREEL=IPROGX 1387 : SEGACT MLREEL 1388 : JKNUM=MAX(1,JKNUM) 1389 : TXXA=PROG(JKNUM) 1390 : SEGDES MLREEL,KEVOLL,MEVOLL 1391 : GOTO 7773 1392 : 7655 continue 1393 : **TC ELSEIF (ICLE9.EQ.3) THEN 1394 : IF(ICLE9.NE.3) go to 7656 1395 : JKNUM=JKNUM+1 1396 : SEGACT MEVOLL 1397 : KEVOLL=IEVOLL(1) 1398 : SEGACT KEVOLL 1399 : MLREEL=IPROGX 1400 : SEGACT MLREEL 1401 : JKNUM=MIN(JKNUM,PROG(/1)) 1402 : TXXA=PROG(JKNUM) 1403 : SEGDES MLREEL,KEVOLL,MEVOLL 1404 : GOTO 7773 1405 : 7656 continue 1406 : **TC ENDIF 1407 : * BERTIN: Fin deplacement curseur 1408 : IF (ICLE9.NE.1) GOTO 52 1409 : ZVALEUR=.FALSE. 1410 : GOTO 50 1411 : **TC ENDIF 1412 : 7657 continue 1413 : * 1414 : * IMPRESSION PAR CREATION D'UN FICHIER LGI 1415 : * 1416 : IF (ICLE .EQ. 11) THEN 1416 : CALL FLGI 1417 : GOTO 50 1418 : ENDIF 1419 : 1420 : * 1421 : * GESTION DES OPTIONS 1422 : * 1423 : IF (ICLE.EQ.5) THEN 1424 : 123 LEGEND(1)=' Retour ' 1425 : LEGEND(2)=' Fonts>> ' 1426 : IF (ICOSC.EQ.1) THEN 1427 : LEGEND(3)='Ecran>> Blanc' 1428 : ELSE IF (ICOSC.EQ.2) THEN 1429 : LEGEND(3)='Ecran>> Noir' 1430 : ENDIF 1431 : IF (ZDATE) THEN 1432 : LEGEND(4)=' (X) Date ' 1433 : ELSE 1434 : LEGEND(4)=' ( ) Date ' 1435 : ENDIF 1436 : IF (ZGRILL) THEN 1437 : LEGEND(5)=' (X)Grille ' 1438 : ELSE 1439 : LEGEND(5)=' ( )Grille ' 1440 : ENDIF 1440 : CALL MENU(LEGEND,5,13) 1440 : CALL TRAFF (ICLE2) 1441 : IF (ICLE2.EQ.0) GOTO 38 1442 : IF (ICLE2.EQ.1) THEN 1443 : 124 LEGEND(1)=' Retour ' 1444 : LEGEND(2)=' 8_BY_13 ' 1445 : LEGEND(3)=' 9_BY_15 ' 1446 : LEGEND(4)=' TIMES_10 ' 1447 : LEGEND(5)=' TIMES_24 ' 1448 : LEGEND(6)=' HELV_10 ' 1449 : LEGEND(7)=' HELV_12 ' 1450 : LEGEND(8)=' HELV_18 ' 1450 : CALL MENU(LEGEND,8,13) 1450 : CALL TRAFF(ICLE3) 1451 : IF (ICLE3.EQ.0) GOTO 38 1452 : IOPOLI=ICLE3 1453 : GOTO 38 1454 : ELSEIF (ICLE2.EQ.2) THEN 1455 : IF (ICOSC.EQ.1) THEN 1456 : ICOSC=2 1457 : ELSE IF (ICOSC.EQ.2) THEN 1458 : ICOSC=1 1459 : ENDIF 1460 : GOTO 38 1461 : ELSEIF (ICLE2.EQ.3) THEN 1462 : IF (ZDATE) THEN 1463 : ZDATE=.FALSE. 1464 : ELSE 1465 : ZDATE=.TRUE. 1466 : ENDIF 1467 : GOTO 38 1468 : ELSEIF (ICLE2.EQ.4) THEN 1469 : IF (ZGRILL) THEN 1470 : ZGRILL=.FALSE. 1471 : ELSE 1472 : ZGRILL=.TRUE. 1473 : ENDIF 1474 : GOTO 38 1475 : ENDIF 1476 : ENDIF 1477 : 1478 : * 1479 : * GESTION PRESENTATION 1480 : * 1481 : **TC IF (ICLE.EQ.4) THEN 1482 : IF( ICLE.ne.4) go to 7659 1483 : 5000 CONTINUE 1484 : ************************************************************************ 1484 : CALL OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,TTXX,TTXXX, 1485 : & TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,DYN,NDIMT,CUR,NDIMT2,NC 1486 : & ,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,IPOSI,XPOSI,YPOSI,IGRIL) 1487 : IF (IERR.NE.0) GOTO 1000 1488 : 1489 : * APPEL DE NLOGO 1490 : IF (ZLOGO) THEN 1490 : CALL LOGDES (TTXXX,TTYYY,TTXX,TTYY,AXE, 1491 : & TCENTX,TCENTY,HTLOG,ICOLOG) 1491 : CALL CHCOUL(IDCOUL) 1492 : ENDIF 1493 : * 1494 : * COMMENTAIRES SI IL Y EN A 1495 : * SEGACT COM 1496 : IF (ICOM.NE.0) THEN 1497 : DO JK=1,ICOM 1497 : CALL CHCOUL(ICOUCO(JK)) 1497 : CALL TRLABL (TXCOM(JK),TYCOM(JK),0.,COMMENT(JK),30,HMIN) 1498 : ENDDO 1498 : CALL CHCOUL(IDCOUL) 1499 : ENDIF 1500 : 1501 : * BERTIN: Redessiner le lien 1502 : IF(ZLIEN) THEN 1503 : DO JK=1, ICOM 1504 : TX(1)=LIEN(JK,1) 1505 : TY(1)=LIEN(JK,2) 1506 : TX(2)=LIEN(JK,3) 1507 : TY(2)=LIEN(JK,4) 1507 : CALL POLRL(2,TX,TY,tz) 1508 : ENDDO 1509 : ENDIF 1510 : * 1511 : * INDEX 1512 : * 1513 : IF (ZINDEX) THEN 1514 : TX(1)=XINF 1515 : TY(1)=TLACY 1516 : TX(2)=XSUP 1517 : TY(2)=TLACY 1518 : 1518 : CALL POLRL(2,TX,TY,tz) 1519 : TX(1)=TLACX 1520 : TY(1)=YINF 1521 : TX(2)=TLACX 1522 : TY(2)=YSUP 1522 : CALL POLRL(2,TX,TY,tz) 1523 : TYINF=YINF 1524 : * BERTIN: Ajustement de la position du label sur le curseur 1524 : CALL TRLABL (TXIND,TLACY+0.02,0.,CARDY,11,HMIN) 1524 : CALL TRLABL (TLACX,TYINF+0.02,0.,CARDX,11,HMIN) 1525 : ENDIF 1526 : ************************************************************************ 1527 : IF (ZVALEUR) THEN 1528 : ZVALEUR=.FALSE. 1529 : GOTO 7772 1530 : END IF 1531 : LEGEND(1)='Retour' 1532 : LEGEND(2)='Index' 1533 : LEGEND(3)='Enleve index' 1534 : LEGEND(4)='Comment>> ' 1535 : LEGEND(5)='Logo>> ' 1536 : LEGEND(6)='Titres>> ' 1536 : CALL MENU(LEGEND,6,13) 1536 : CALL TRAFF(ICLE3) 1537 : * 1538 : * RETOUR 1539 : * 1540 : IF (ICLE3.EQ.0) GOTO 38 1541 : * 1542 : * GESTION INDEX 1543 : * 1544 : **TC IF (ICLE3.EQ.1) THEN 1545 : IF(icle3.ne.1) go to 7658 1546 : ZINDEX=.TRUE. 1547 : BUFFER0='Pointez index' 1547 : CALL TRMESS(BUFFER0) 1547 : CALL TRDIG (tlacx,TLACY,INOUSE) 1548 : 7771 CONTINUE 1549 : * TEST SUR LES BORNES 1550 : IF (TLACY.GT.REAL(YSUP)) THEN 1551 : TLACY=REAL(YSUP) 1552 : ENDIF 1553 : IF (TLACY.LT.REAL(YINF)) THEN 1554 : TLACY=REAL(YINF) 1555 : ENDIF 1556 : 1557 : IF (TLACX.GT.REAL(XSUP)) THEN 1558 : TLACX=REAL(XSUP) 1559 : ENDIF 1560 : IF (TLACX.LT.REAL(XINF)) THEN 1561 : TLACX=REAL(XINF) 1562 : ENDIF 1563 : 1564 : * AFFICHAGE DE L'INDEX 1565 : TXIND=(XINF-((ABS(0.5*XINF)))) 1566 : * TYIND=(YINF-((ABS(0.5*YINF)))) 1567 : TYIND=(YINF+((ABS(0.5*YINF)))) 1568 : WRITE (CARDX(1:11),FMT='(G11.4)') TLACX 1569 : WRITE (CARDY(1:11),FMT='(G11.4)') TLACY 1570 : GOTO 5000 1571 : **TC ENDIF 1572 : 7658 continue 1573 : * 1574 : * SUPRESSION INDEX 1575 : * 1576 : IF (ICLE3.EQ.2) THEN 1577 : ZINDEX=.FALSE. 1578 : GOTO 5000 1579 : ENDIF 1580 : * 1581 : * GESTION AFFICHAGE COMMENTAIRE 1582 : * 1583 : IF (ICLE3.EQ.3) GOTO 6800 1584 : * 1585 : * GESTION AFFICHAGE LOGO 1586 : * 1587 : IF (ICLE3.EQ.4) GOTO 6000 1588 : * 1589 : * GESTION AFFICHAGE TITRE 1590 : * 1591 : IF (ICLE3.EQ.5) GOTO 6500 1592 : 1593 : 6000 CONTINUE 1593 : CALL OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,TTXX,TTXXX, 1594 : & TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,DYN,NDIMT,CUR,NDIMT2,NC 1595 : & ,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,IPOSI,XPOSI,YPOSI,IGRIL) 1596 : IF (IERR.NE.0) GOTO 1000 1597 : 1598 : * APPEL DE NLOGO 1599 : IF (ZLOGO) THEN 1599 : CALL LOGDES (TTXXX,TTYYY,TTXX,TTYY,AXE, 1600 : & TCENTX,TCENTY,HTLOG,ICOLOG) 1600 : CALL CHCOUL(IDCOUL) 1601 : ENDIF 1602 : * 1603 : * COMMENTAIRES SI IL Y EN A 1604 : * SEGACT COM 1605 : IF (ICOM.NE.0) THEN 1606 : DO JK=1,ICOM 1606 : CALL CHCOUL(ICOUCO(JK)) 1606 : CALL TRLABL (TXCOM(JK),TYCOM(JK),0.,COMMENT(JK),30,HMIN) 1607 : ENDDO 1607 : CALL CHCOUL(IDCOUL) 1608 : ENDIF 1609 : 1610 : * BERTIN: Redessiner le lien 1611 : IF(ZLIEN) THEN 1612 : DO JK=1, ICOM 1613 : TX(1)=LIEN(JK,1) 1614 : TY(1)=LIEN(JK,2) 1615 : TX(2)=LIEN(JK,3) 1616 : TY(2)=LIEN(JK,4) 1616 : CALL POLRL(2,TX,TY,tz) 1617 : ENDDO 1618 : ENDIF 1619 : * 1620 : * INDEX 1621 : * 1622 : IF (ZINDEX) THEN 1623 : TX(1)=XINF 1624 : TY(1)=TLACY 1625 : TX(2)=XSUP 1626 : TY(2)=TLACY 1627 : 1627 : CALL POLRL(2,TX,TY,tz) 1628 : TX(1)=tlacx 1629 : TY(1)=YINF 1630 : TX(2)=tlacx 1631 : TY(2)=YSUP 1631 : CALL POLRL(2,TX,TY,tz) 1632 : TYINF=YINF 1632 : CALL TRLABL (TXIND,TLACY+0.02,0.,CARDY,11,HMIN) 1632 : CALL TRLABL (TLACX,TYINF+0.02,0.,CARDX,11,HMIN) 1633 : ENDIF 1634 : 1635 : LEGEND (1)=' << logo' 1636 : LEGEND (2)='Position' 1637 : LEGEND (3)='Couleur' 1638 : LEGEND (4)='Taille' 1639 : IF (ZLOGO) THEN 1640 : LEGEND (5)=' (X) Logo' 1641 : ELSE 1642 : LEGEND (5)=' ( ) Logo' 1643 : ENDIF 1644 : 1644 : CALL MENU (LEGEND,5,13) 1644 : CALL TRAFF (ICLE4) 1645 : * REVENIR 1646 : IF (ICLE4.EQ.0) GOTO 5000 1647 : * POSITION 1648 : IF (ICLE4.EQ.1) THEN 1648 : CALL TRMESS ('Cliquer sur la nouvelle position') 1648 : CALL TRDIG (TCENTX,TCENTY,inouse) 1649 : OLDLOGX=TCENTX 1650 : OLDLOGY=TCENTY 1651 : ENDIF 1652 : * COULEUR 1653 : IF (ICLE4.EQ.2) THEN 1654 : NUM=NBCOUL 1654 : CALL TRGETC (NUM) 1655 : ICOLOG = NUM 1656 : ENDIF 1657 : * TAILLE 1658 : IF (ICLE4.EQ.3) THEN 1658 : CALL TRGET ('Entrer la nouvelle taille du logo 1 a 9:',TMPCAR) 1659 : READ(TMPCAR,'(I1)') IRA 1660 : ra=IRA 1661 : IF ( (RA.LT.1).OR. (RA.GT.10.0)) THEN 1661 : CALL TRMESS ('Taille incorrecte') 1662 : ELSE 1663 : HTLOG = REAL (RA * HDPLOG) 1664 : ENDIF 1665 : ENDIF 1666 : * ON/OFF 1667 : IF (ICLE4.EQ.4) THEN 1668 : IF (ZLOGO) THEN 1669 : ZLOGO = .FALSE. 1670 : ELSE 1671 : ZLOGO = .TRUE. 1672 : ENDIF 1673 : ENDIF 1674 : * RETOUR 1675 : GOTO 6000 1676 : * ENDIF 1677 : 1678 : 6500 CONTINUE 1679 : 1679 : CALL OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,TTXX,TTXXX, 1680 : & TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,DYN,NDIMT,CUR,NDIMT2,NC 1681 : & ,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,IPOSI,XPOSI,YPOSI,IGRIL) 1682 : IF (IERR.NE.0) GOTO 1000 1683 : 1684 : * APPEL DE NLOGO 1685 : IF (ZLOGO) THEN 1685 : CALL LOGDES (TTXXX,TTYYY,TTXX,TTYY,AXE, 1686 : & TCENTX,TCENTY,HTLOG,ICOLOG) 1686 : CALL CHCOUL(IDCOUL) 1687 : ENDIF 1688 : * 1689 : * COMMENTAIRES SI IL Y EN A 1690 : * SEGACT COM 1691 : IF (ICOM.NE.0) THEN 1692 : DO JK=1,ICOM 1692 : CALL CHCOUL(ICOUCO(JK)) 1692 : CALL TRLABL (TXCOM(JK),TYCOM(JK),0.,COMMENT(JK),30,HMIN) 1693 : ENDDO 1693 : CALL CHCOUL(IDCOUL) 1694 : ENDIF 1695 : 1696 : * BERTIN: Redessiner le lien 1697 : IF(ZLIEN) THEN 1698 : DO JK=1, ICOM 1699 : TX(1)=LIEN(JK,1) 1700 : TY(1)=LIEN(JK,2) 1701 : TX(2)=LIEN(JK,3) 1702 : TY(2)=LIEN(JK,4) 1702 : CALL POLRL(2,TX,TY,tz) 1703 : ENDDO 1704 : ENDIF 1705 : * 1706 : * INDEX 1707 : * 1708 : IF (ZINDEX) THEN 1709 : TX(1)=XINF 1710 : TY(1)=TLACY 1711 : TX(2)=XSUP 1712 : TY(2)=TLACY 1713 : 1713 : CALL POLRL(2,TX,TY,tz) 1714 : TX(1)=TLACX 1715 : TY(1)=YINF 1716 : TX(2)=TLACX 1717 : TY(2)=YSUP 1717 : CALL POLRL(2,TX,TY,tz) 1718 : TYINF=YINF 1718 : CALL TRLABL (TXIND,TLACY+0.02,0.,CARDY,11,HMIN) 1718 : CALL TRLABL (TLACX,TYINF+0.02,0.,CARDX,11,HMIN) 1719 : ENDIF 1720 : 1721 : LEGEND (1)=' << Titres' 1722 : LEGEND (2)='Titre gene.' 1723 : LEGEND (3)='Titre X' 1724 : LEGEND (4)='Titre Y' 1725 : 1725 : CALL MENU (LEGEND,4,13) 1725 : CALL TRAFF (ICLE5) 1726 : * REVENIR 1727 : IF (ICLE5.EQ.0) GOTO 5000 1728 : * TITRE GENERAL 1729 : IF (ICLE5.EQ.1) THEN 1729 : CALL TRGET ('Entrer le nouveau titre general',TMPCAR) 1730 : TXTIT=TMPCAR 1731 : ENDIF 1732 : * TITRE EN X 1733 : IF (ICLE5.EQ.2) THEN 1733 : CALL TRGET ('Entrer le nouveau titre EN X',TMPCAR) 1734 : TXAXE=TMPCAR 1735 : ENDIF 1736 : * TITRE EN Y 1737 : IF (ICLE5.EQ.3) THEN 1737 : CALL TRGET ('Entrer le nouveau titre EN Y',TMPCAR) 1738 : TYAXE=TMPCAR 1739 : ENDIF 1740 : * RETOUR 1741 : GOTO 6500 1742 : * ENDIF 1743 : 1744 : 6800 CONTINUE 1745 : 1745 : CALL OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,TTXX,TTXXX, 1746 : & TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,DYN,NDIMT,CUR,NDIMT2,NC 1747 : & ,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,IPOSI,XPOSI,YPOSI,IGRIL) 1748 : IF (IERR.NE.0) GOTO 1000 1749 : 1750 : * APPEL DE NLOGO 1751 : IF (ZLOGO) THEN 1751 : CALL LOGDES (TTXXX,TTYYY,TTXX,TTYY,AXE, 1752 : & TCENTX,TCENTY,HTLOG,ICOLOG) 1752 : CALL CHCOUL(IDCOUL) 1753 : ENDIF 1754 : * 1755 : * COMMENTAIRES SI IL Y EN A 1756 : * SEGACT COM 1757 : IF (ICOM.NE.0) THEN 1758 : DO JK=1,ICOM 1758 : CALL CHCOUL(ICOUCO(JK)) 1758 : CALL TRLABL (TXCOM(JK),TYCOM(JK),0.,COMMENT(JK),30,HMIN) 1759 : ENDDO 1759 : CALL CHCOUL(IDCOUL) 1760 : ENDIF 1761 : * 1762 : * INDEX 1763 : * 1764 : IF (ZINDEX) THEN 1765 : TX(1)=XINF 1766 : TY(1)=TLACY 1767 : TX(2)=XSUP 1768 : TY(2)=TLACY 1769 : 1769 : CALL POLRL(2,TX,TY,tz) 1770 : TX(1)=TLACX 1771 : TY(1)=YINF 1772 : TX(2)=TLACX 1773 : TY(2)=YSUP 1773 : CALL POLRL(2,TX,TY,tz) 1774 : TYINF=YINF 1775 : 1775 : CALL TRLABL (TXIND,TLACY+0.02,0.,CARDY,11,HMIN) 1775 : CALL TRLABL (TLACX,TYINF+0.02,0.,CARDX,11,HMIN) 1776 : ENDIF 1777 : 1778 : * BERTIN: Redessiner le lien 1779 : IF(ZLIEN) THEN 1780 : DO JK=1, ICOM 1781 : TX(1)=LIEN(JK,1) 1782 : TY(1)=LIEN(JK,2) 1783 : TX(2)=LIEN(JK,3) 1784 : TY(2)=LIEN(JK,4) 1784 : CALL POLRL(2,TX,TY,tz) 1785 : ENDDO 1786 : ENDIF 1787 : 1788 : LEGEND (1)='Comment <<' 1789 : LEGEND (2)='Ajout' 1790 : LEGEND (3)='Enleve/Modif' 1791 : LEGEND (4)='Deplacement' 1792 : LEGEND (5)='Couleur' 1793 : LEGEND (6)='Lien' 1794 : 1794 : CALL MENU (LEGEND,6,13) 1794 : CALL TRAFF (ICLE6) 1795 : * REVENIR 1796 : IF (ICLE6.EQ.0) GOTO 5000 1797 : 1798 : * AJOUT 1799 : IF (ICLE6.EQ.1) THEN 1800 : IF (ICOM.EQ.10) THEN 1801 : BUFFER0='10 commentaires maxi - Pointer' 1801 : CALL TRMESS(BUFFER0) 1801 : CALL TRDIG (TXXX,TYYY,INOUSE) 1802 : GOTO 6800 1803 : ELSE 1804 : ICOM=ICOM+1 1805 : TXXX=REAL(XINF+(XSUP-XINF)/2.D0) 1806 : TYYY=REAL(YINF+(YSUP-YINF)/2.D0) 1807 : BUFFER0='Pointez commentaire' 1807 : CALL TRMESS(BUFFER0) 1807 : CALL TRDIG (TXXX,TYYY,INOUSE) 1807 : CALL TRGET ('Entrer le commentaire',TMPCAR) 1808 : COMMENT(ICOM)=TMPCAR 1809 : TXCOM(ICOM)=TXXX 1810 : TYCOM(ICOM)=TYYY 1811 : ICOUCO(ICOM)=IDCOUL 1812 : GOTO 6800 1813 : ENDIF 1814 : ENDIF 1815 : 1816 : * SUPRESSION 1817 : IF (ICLE6.EQ.2) THEN 1818 : IF (ICOM.NE.0) THEN 1819 : BUFFER0='Pointez commentaire' 1819 : CALL TRMESS(BUFFER0) 1819 : CALL TRDIG (TXXX,TYYY,INOUSE) 1819 : CALL CHERCO (TXXX,TYYY,ICOM,AXE,IBON,COM) 1820 : IF (IBON.NE.0) THEN 1821 : TMPCAR=' ' 1821 : CALL TRGET ('Entrer le commentaire',TMPCAR) 1822 : IF (TMPCAR.NE.' ') THEN 1823 : COMMENT(IBON)=TMPCAR 1824 : ELSE 1825 : IF (IBON.EQ.ICOM) THEN 1826 : ICOM=ICOM - 1 1827 : TXCOM(IBON)=0. 1828 : TYCOM(IBON)=0. 1829 : ICOUCO(IBON)=0 1830 : LIEN(IBON,1)=0. 1831 : LIEN(IBON,2)=0. 1832 : LIEN(IBON,3)=0. 1833 : LIEN(IBON,4)=0. 1834 : ELSE 1835 : DO J=IBON+1,ICOM 1836 : TXCOM(J-1)=TXCOM(J) 1837 : TYCOM(J-1)=TYCOM(J) 1838 : COMMENT(J-1)=COMMENT(J) 1839 : ICOUCO(J-1)=ICOUCO(J) 1840 : LIEN(J-1,1)=LIEN(J,1) 1841 : LIEN(J-1,2)=LIEN(J,2) 1842 : LIEN(J-1,3)=LIEN(J,3) 1843 : LIEN(J-1,4)=LIEN(J,4) 1844 : ENDDO 1845 : TXCOM(ICOM)=0. 1846 : TYCOM(ICOM)=0. 1847 : ICOUCO(ICOM)=0 1848 : COMMENT(ICOM)=' ' 1849 : ICOM=ICOM - 1 1850 : * LIEN(ICOM,1)=0. 1851 : * LIEN(ICOM,2)=0. 1852 : * LIEN(ICOM,3)=0. 1853 : * LIEN(ICOM,4)=0. 1854 : ENDIF 1855 : GOTO 6800 1856 : ENDIF 1857 : ELSE 1858 : GOTO 6800 1859 : ENDIF 1860 : ENDIF 1861 : GOTO 6800 1862 : ENDIF 1863 : * DEPLACEMENT 1864 : IF (ICOM.NE.0) THEN 1865 : IF (ICLE6.EQ.3) THEN 1866 : BUFFER0='Pointez commentaire' 1866 : CALL TRMESS(BUFFER0) 1866 : CALL TRDIG (TXXX,TYYY,INOUSE) 1866 : CALL CHERCO (TXXX,TYYY,ICOM,AXE,IBON,COM) 1867 : IF (IBON.NE.0) THEN 1868 : BUFFER0='Nouvelle position ?' 1868 : CALL TRMESS(BUFFER0) 1868 : CALL TRDIG (TXXX,TYYY,INOUSE) 1869 : TXCOM(IBON)=TXXX 1870 : TYCOM(IBON)=TYYY 1871 : GOTO 38 1872 : ENDIF 1873 : GOTO 6800 1874 : ENDIF 1875 : ENDIF 1876 : 1877 : *COULEUR 1878 : IF (ICOM.NE.0) THEN 1879 : IF (ICLE6.EQ.4) THEN 1880 : BUFFER0='Pointez commentaire' 1880 : CALL TRMESS(BUFFER0) 1880 : CALL TRDIG (TXXX,TYYY,INOUSE) 1880 : CALL CHERCO (TXXX,TYYY,ICOM,AXE,IBON,COM) 1881 : IF (IBON.NE.0) THEN 1882 : NUM=NBCOUL 1882 : CALL TRGETC (NUM) 1883 : ICOUCO(IBON) = NUM 1884 : ENDIF 1885 : GOTO 6800 1886 : ENDIF 1887 : ENDIF 1888 : 1889 : * BERTIN: Creation d'un trait entre un commentaire et une zone 1890 : * LIEN 1891 : 1892 : IF (ICOM.NE.0) THEN 1893 : IF (ICLE6.EQ.5) THEN 1894 : ZLIEN=.TRUE. 1895 : BUFFER0='Pointez commentaire' 1895 : CALL TRMESS(BUFFER0) 1895 : CALL TRDIG (TXXX,TYYY,INOUSE) 1895 : CALL CHERCO (TXXX,TYYY,ICOM,AXE,IBON,COM) 1896 : LIEN(IBON,1)=TXCOM(IBON) 1897 : LIEN(IBON,2)=TYCOM(IBON) 1898 : 1899 : IF (IBON.NE.0) THEN 1900 : BUFFER0='Zone a annoter?' 1900 : CALL TRMESS(BUFFER0) 1900 : CALL TRDIG (TXXX,TYYY,INOUSE) 1901 : LIEN(IBON,3)=TXXX 1902 : LIEN(IBON,4)=TYYY 1903 : LIEN(IBON,5)=1. 1904 : TX(1)=LIEN(IBON,1) 1905 : TY(1)=LIEN(IBON,2) 1906 : TX(2)=LIEN(IBON,3) 1907 : TY(2)=LIEN(IBON,4) 1907 : CALL POLRL(2,TX,TY,tz) 1908 : ENDIF 1909 : GOTO 6800 1910 : ENDIF 1911 : ENDIF 1912 : * BERTIN: Fin creation lien commentaire 1913 : 1914 : * RETOUR 1915 : GOTO 6800 1916 : **TC ENDIF 1917 : 7659 continue 1918 : * 1919 : * RETOUR EVOLUTION SUIVANTE EN MODE SEPARE 1920 : * 1921 : IF (ZSEPAR) THEN 1922 : PASSE = 0. 1923 : HTLOG = 1. 1924 : ICOLOG = IDCOUL 1925 : ZLOGO = ZLOGOO 1926 : IF (ICOM.NE.0) THEN 1927 : DO JK=1,ICOM 1928 : TXCOM(JK)=0. 1929 : TYCOM(JK)=0. 1930 : COMMENT(JK)=' ' 1931 : ENDDO 1932 : ICOM=0 1933 : ENDIF 1934 : ZINDEX= .FALSE. 1935 : GOTO 34 1936 : ENDIF 1937 : GOTO 1000 1938 : 1939 : * On limite la precision a 1e-30 pour les logarithmes 1939 : 900 CALL ERREUR(434) 1940 : GOTO 1000 1941 : 1942 : * L'intervalle entre les bornes est trop faible. 1942 : 950 CALL ERREUR (497) 1943 : GOTO 1000 1944 : * 1945 : IF (NHIST.NE.0) SEGSUP,MEVOLL 1946 : * 1947 : 1000 CONTINUE 1948 : * 1949 : SEGSUP AXE 1950 : IF (OLDAXE.NE.0) SEGSUP OLDAXE 1951 : SEGSUP COM 1952 : IF (DYN.NE.0) SEGSUP DYN 1953 : IF (CUR.NE.0) SEGSUP CUR 1954 : * 1955 : END 1956 : 1957 : 1958 : 1959 : 1960 : 1961 : 1962 : 1963 : 1964 : 1965 : 1966 : 1967 :
© Cast3M 2003 - All rights reserved.
Disclaimer