C DESSIN SOURCE GOUNAND 12/08/30 21:15:00 7489 SUBROUTINE DESSIN *============================================================= * * Dessine une evolution * *============================================================= * * Modifications * * 95/02/07, Loca : * pour passer les legendes x et y de 12 a 20 caracteres: * SEGMENT AXE disparait et est appele en include: -INC TMAXE. * * 03/03/14, maugis : * correction de la position du logo en cas de zoom. * * 07/09/04, maugis : * fourniture du choix des courbes via un LISTENTI * Maintien du segment AXE actif en modification * Resolution pb de zoom en logarithmique avec des valeurs * inferieures a 0. * Resolution erreur 497 quand 2 clics zoom hors cadre * *============================================================= * * LISTE DES FONCTIONS : * * MINMAX : RETOURNE MINI ET MAXI D'UNE LISTE DE REELS * BORAXE : CALCUL DES ARRONDIS DE BORNES D'AXES * INTAXE : CALCUL POUR EFFECTUER LA GRADUATION * DAXES : DESSIN DES AXES * ICALP : FONCTION POUR CALCUL DES BORNES D'AXES * TREVOL : DESSIN D'UNE EVOLUTION * TRSEG : TRACE DUN SEGMENT DE DROITE * EXTRAC : EXTRACTION D'UN MOT DANS UNE CHAINE * LINEAX : LINEARISATION EN X * LINEAY : LINEARISATION EN Y * DMARQ : DESSINE DES MARQUEURS * TRCUR : TRACER DES NOMS EN CAS D'ABSCISSE CURVILIGNE * TRINIT ET SES FONCTIONS (definies selon la sortie graphique) * *============================================================= * * LISTE DES VARIABLES : * * --- affichage interactif --- * BMIN,BMAX HAUTEUR DE CARACTERE POUR LES E/S GRAPHIQUES * BUFFER(X) CHAINE DE CARACTERE POUR LES E/S * TX,TY TABLES POUR DESSINER UN INDEX L'AIDE DE POLRL * TXX(X),TYY(X) POSITION POUR LES E/S DES BUFFERS * ZINDEX INDEX SUR COURBE * ZLIEN LIEN SUR UN COMMENTAIRE * * --- axe --- * AXE SEGMENT AXE DE TMAXE.INC * OLDAXE AXE DE SAUVEGARDE POUR RETOUR APRES UN ZOOM * IPOSX, IPOSY position predefinie du titre des axes X, Y * TITREX, TITREY TITRE DES AXES X, Y * XINT YINT GRADUATION ELEMENTAIRE DES AXES X, Y * ZLOGX, ZLOGY AXE X, Y EN LOG * ZXFORC, ZYFORC BORNES SUR L'AXE X, Y IMPOSEES * ZXGRA, ZYGRA graduation sur l'axe X, Y imposee * * --- calcul, divers --- * YMAXI MAXIMUM EN Y SUR L'ENSEMBLE DES EVOLUTIONS * YMINI MINIMUM EN Y SUR L'ENSEMBLE DES EVOLUTIONS * ZMIMA AFFICHAGE DU MINIMUM ET DU MAXIMUM * ZARR SYSTEME D'ARRONDI NON NORMALISE * ZDATE AFFICHAGE DE LA DATE * ZHEURE AFFICHAGE DE L'HEURE * ZLOGO DESSIN DU LOGO * * --- general --- * IPTR POINTEUR UTILISE POUR EVITER LES PBS ESOPE DUS A * L'ECHANGE D'ARGUMENTS INCLUS DANS DES SEGMENTS * NOL NUMERO D'ORDRE LOGIQUE DE LA FENETRE * XDIM,YDIM PARAMETRES POUR TABT (TAILLE PAPIER) * ZSEPAR TRACE SEPARE DES COURBES * * --- evolutions courbes --- * IEV POINTEUR D'EVOLUTION * INBEVO NOMBRE TOTAL D'EVOLUTIONS * NC NUMERO DE L'EVOLUTION QUE L'ON TRAITE (OPTION SEPA) * ZCUR TABLE INDIQUANT LES EVOLUTIONS CONTENANT DES NOMS * D'ABSCISSES * ZOPTIO EXISTENCE D'UNE TABLE D'OPTION SPECIFIQUE * ZTRACE TABLE INDIQUANT LES COURBES A TRACER * * --- legende --- * IPOSI position predefinie de la legende * NCT NUMERO DE COURBE A TRACER AVEC LEGENDE SUR UN MEME GRAPHE * NLG COMPTEUR DE LEGENDES AFFICHABLES (NON VIDES) * XPOSI, YPOSI position XY de la legende fourni par l utilisateur * ZLEGEN AJOUT DES LEGENDES EN FIN DE COURBE * * --- options graphiques --- * CHOPT MOT CONTENANT LES OPTIONS SPECIFIQUES * IOPTIO POINTEUR SUR LA TABLE DES OPTIONS SPECIFIQUES * LPARAM LISTE DES PARAMETRES GENERAUX NPARAM NOMBRE DE PARAMETRES * ZAXES TRACE DES AXES OX ET OY * ZCARRE FENETRE CARREE * ZGRILL AFFICHAGE D'UNE GRILLE SUR LES AXES EN LOG * * --- titre --- * HTITRE HAUTEUR DU TITRE * TITRE TITRE GLOBAL DE L'EVOLUTION * * * * TOUTES LES VARIABLES COMMENCANT PAR T SONT EN SIMPLE PRECISION ! * *============================================================= * * REMARQUES : * * - TOUTES LES VARIABLES EN T SONT DES REELS SIMPLE PRECISION * POUR COMMUNIQUER AVEC TRINIT * - JE JOUE SUR LA COULEUR 8 POUR EFFACER DU TEXTE * - CHAQUE TRBOX CHANGEANT LA TAILLE DES CARACTERES EST SUIVI PAR * UN TRBOX RAMENANT A L'ETAT INITIAL * - LE SYSTEME DE LECTURE DES VALEURS N'EST PAS SUPER * ARRONDI DE LA MACHINE * INTERACTIVITE PEU CONVIVIAL (SANS DEVLPT. DE DEPENDANT * MACHINE) * PAS IMPLEMENTE EN GKS * *============================================================= IMPLICIT LOGICAL (Z) IMPLICIT INTEGER (I-N) IMPLICIT REAL*8 (A-H,O-S,U-Y) * -INC CCOPTIO -INC SMEVOLL -INC SMLREEL POINTEUR MLREEX.MLREEL,MLREEY.MLREEL -INC SMLENTI -INC CCGEOME -INC TMAXE -INC CCTRACE * REAL*8 RA REAL LIEN(10,5) * REAL RXDIM,RYDIM,HMIN,TCENTX,TCENTY,HTLOG dimension TZ(10) * LOGICAL VALEUR CHARACTER*13 LEGEND(8),CARDX,CARDY CHARACTER*72 TMPCAR CHARACTER*8 CTYP POINTEUR OLDAXE.AXE * SEGMENT COM CHARACTER*30 COMMENT(10) REAL TXCOM(10),TYCOM(10) INTEGER ICOUCO(10) ENDSEGMENT * TABLEAU DE LOGIQUE GERE EN DYNAMIQUE SEGMENT DYN LOGICAL ZTRACE(NDIMT) ENDSEGMENT SEGMENT CUR LOGICAL ZCUR(NDIMT2) ENDSEGMENT * DIMENSION TX(2),TY(2) CHARACTER*72 TITRE,TXTIT,CHOPT,BUFFER CHARACTER*25 BUFFER1,BUFFER2,BUFFER0 CHARACTER*8 CTYPE,CHVIDE,ETYPE PARAMETER (NPARAM=22) CHARACTER*4 LPARAM(NPARAM) CHARACTER*20 TXAXE,TYAXE CHARACTER*4 MOPOSI(8),MOPOSX(2),MOGRIL(6),MOGRIS(1) * DATA LPARAM/'LOGX','LOGY','XBOR','YBOR','CARR','SEPA','GRIL', # 'MIMA','LEGE','DATE','CHOI','NARR','LOGO','TITR', # 'TITX','TITY','AXES','NCLK','XGRA','YGRA', # 'POSX','POSY'/ DATA MOPOSI/'NO ','NE ','SO ','SE ','EXT ','XY ', # 'NW ','SW '/ DATA MOPOSX/'EXCE','CENT'/ DATA MOGRIL/'LIGN','TIRR','TIRC','TIRL','TIRM','POIN'/ DATA MOGRIS/'GRIS'/ DO II=1,10 TZ(II) = 0 ENDDO KCLICK = 1 TXTIT = ' ' TXAXE = ' ' TYAXE = ' ' BUFFER = ' ' NCOMM = 10 ICOM = 0 IBON = 0 ICOLOG = IDCOUL HDPLOG = 1 HTLOG = 1. PASSE = 0. c options de CCTRACE par défaut ANGLE=0.d0 IALIGN=0 * * CREE L'AXE COURANT ET SA SAUVEGARDE * SEGINI AXE OLDAXE=0 c SEGINI OLDAXE cbp : on le fait + loin SEGINI COM DYN=0 CUR=0 * ETYPE(1:8)='ENTIER ' * CHVIDE(1:8)=' ' * * INITIALISATION DES LOGIQUES ASSOCIES AUX PARAMETRES * ZLOGX = .FALSE. ZLOGY = .FALSE. ZCARRE = .FALSE. ZLEGEN = .FALSE. ZSEPAR = .FALSE. ZDATE = .FALSE. ZGRILL = .FALSE. ZHEURE = .FALSE. ZMIMA = .FALSE. ZLOGO = .FALSE. ZOPTIO = .FALSE. ZXFORC = .FALSE. ZYFORC = .FALSE. ZARR = .FALSE. ZAXES = .FALSE. ZINDEX = .FALSE. ZLOGOO = .FALSE. ZVALEUR= .FALSE. ZLIEN = .FALSE. ZXGRA = .FALSE. ZYGRA = .FALSE. * * CHARGE L'EVOLUTION * CALL LIROBJ('EVOLUTIO',IEV,1,IOK) * * TEST SI EVOLUTION LUE * IF (IERR.NE.0) GOTO 1000 * * CALCUL DU NOMBRE TOTAL D'EVOLUTIONS (COPIE DES TITRES) * MEVOLL = IEV SEGACT MEVOLL TITRE = ' ' TITRE(1:72)=IEVTEX(1:72) INBEVO = IEVOLL(/1) SEGDES MEVOLL IF (INBEVO.EQ.0) GOTO 1000 * * CONSTRUCTION DES COURBES DE TYPE HISTOGRAMME * SEGACT,MEVOLL SEGINI,MEVOL1=MEVOLL NHIST=0 DO I0=1,INBEVO KEVOLL=IEVOLL(I0) SEGACT,KEVOLL SEGINI,KEVOL1=KEVOLL IF (NUMEVY.EQ.'HIST') THEN MLREEX=KEVOLL.IPROGX SEGACT,MLREEX JG=2*MLREEX.PROG(/1) SEGINI,MLREE1 DO J0=1,MLREEX.PROG(/1) MLREE1.PROG(2*J0-1)=MLREEX.PROG(J0) MLREE1.PROG(2*J0)=MLREEX.PROG(J0) ENDDO SEGDES,MLREEX,MLREE1 KEVOL1.IPROGX=MLREE1 MLREEY=KEVOLL.IPROGY SEGACT,MLREEY JG=2*MLREEY.PROG(/1) SEGINI,MLREE1 MLREE1.PROG(1)=0. DO J0=1,MLREEY.PROG(/1)-1 MLREE1.PROG(2*J0)=MLREEY.PROG(J0) MLREE1.PROG(2*J0+1)=MLREEY.PROG(J0) ENDDO MLREE1.PROG(JG)=0. SEGDES,MLREEY,MLREE1 KEVOL1.IPROGY=MLREE1 NHIST=NHIST+1 ENDIF SEGDES,KEVOLL,KEVOL1 MEVOL1.IEVOLL(I0)=KEVOL1 ENDDO IF (NHIST.EQ.0) THEN SEGSUP,MEVOL1 ELSE SEGDES,MEVOLL,MEVOL1 IEV=MEVOL1 ENDIF * * DEFINITION TAILLE CARACTERE * * HMIN=.2 * * DIMENSIONNE LA TABLE ZTRACE * NDIMT=INBEVO SEGINI DYN * * INITIALISATION TABLE ZTRACE * DO 1 I=1,INBEVO ZTRACE(I)=.TRUE. 1 CONTINUE * * CHARGEMENT DES PARAMETRES GENERAUX OPTIONNELS * 2 CONTINUE CALL LIRMOT(LPARAM,NPARAM,INDICE,0) IF (INDICE.NE.0) THEN GOTO (3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, $ 221,222,223,224),INDICE * * LOGX : SELECTION ECHELLE LOG EN X * 3 CONTINUE ZLOGX=.TRUE. GOTO 2 * * LOGY : SELECTION ECHELLE LOG EN Y * 4 CONTINUE ZLOGY=.TRUE. GOTO 2 * * XBOR : BORNES AXE X IMPOSEES * 5 CONTINUE ZXFORC=.TRUE. CALL LIRREE(XXX,1,IOK) IF (IERR.NE.0) GOTO 1000 XINF=XXX CALL LIRREE (XXX,1,IOK) IF (IERR.NE.0) GOTO 1000 XSUP=XXX GOTO 2 * * YBOR : BORNES AXE Y IMPOSEES * 6 CONTINUE ZYFORC=.TRUE. CALL LIRREE(XXX,1,IOK) IF (IERR.NE.0) GOTO 1000 YINF=XXX CALL LIRREE (XXX,1,IOK) IF (IERR.NE.0) GOTO 1000 YSUP=XXX GOTO 2 * * CARR : FENETRE CARRE * 7 CONTINUE ZCARRE=.TRUE. GOTO 2 * * SEPA : TRACES SEPARES * 8 CONTINUE ZSEPAR=.TRUE. GOTO 2 * * GRIL : UTILISATION D'UNE GRILLE SUR LES AXES EN LOG OU EN LINEAIRE * 9 CONTINUE ZGRILL=.TRUE. c type de tiret ou de pointillé CALL LIRMOT(MOGRIL,6,IGRIL,0) if(IGRIL.eq.0) IGRIL=1 c couleur noir ou grise? CALL LIRMOT(MOGRIS,1,IGRIS,0) if(IGRIS.ne.0) IGRIL=-1*IGRIL GOTO 2 * * MIMA : AFFICHAGE MINIMUM MAXIMUM * 10 CONTINUE ZMIMA=.TRUE. GOTO 2 * * LEGE : AFFICHAGE LEGENDE EN BOUT DE COURBE * 11 CONTINUE ZLEGEN=.TRUE. * POSITION DE LA LEGENDE CALL LIRMOT(MOPOSI,8,IPOSI,0) * PAR DEFAUT EXT <=> POSLEG=5 if(IPOSI.eq.0) IPOSI=5 * XY suivi de la position dans le graphique if(IPOSI.eq.6) then CALL LIRREE(XPOSI,1,IRETX) CALL LIRREE(YPOSI,1,IRETY) IF(IRETX.EQ.0.OR.IRETY.EQ.0) & write(ioimp,*) 'LEGE XY doit etre suivi de Xlege Ylege !' IF (IERR.NE.0) GOTO 1000 endif * NW et SW sont en fait NO et SO en anglais if(IPOSI.eq.7) IPOSI=1 if(IPOSI.eq.8) IPOSI=3 * FORCE CARRE POUR AVOIR LA PLACE D'AFFICHER LES LEGENDES if(IPOSI.eq.5) ZCARRE=.TRUE. GOTO 2 * * DATE : AFFICHAGE DATE * 12 CONTINUE ZDATE=.TRUE. GOTO 2 * * CHOI : SELECTION DE COURBE * 13 CONTINUE * * MET A FAUX TOUTES LES SELECTIONS DE TRACES * DO 85 I=1,INBEVO ZTRACE(I)=.FALSE. 85 CONTINUE *PM A-t-on un ENTIER, un LISTENTI ou rien en entree ? CALL QUETYP (CTYP,0,IRETOU) IF (IRETOU.EQ.0) GOTO 2 IF (CTYP.EQ.'ENTIER ') THEN IOK = 1 DO WHILE (IOK.EQ.1) CALL LIRENT (IXX,0,IOK) IF (IOK.EQ.1) ZTRACE(IXX) = .TRUE. ENDDO ENDIF IF (CTYP.EQ.'LISTENTI') THEN CALL LIROBJ('LISTENTI',ILENTI,1,IRET) IF (IRET.NE.1) RETURN MLENTI = ILENTI SEGACT, MLENTI DO I=1,LECT(/1) IXX = LECT(I) ZTRACE(IXX) = .TRUE. ENDDO ENDIF GOTO 2 * * NARR : GRADUATION NON NORMALISEE * 14 CONTINUE ZARR=.TRUE. GOTO 2 * * LOGO : DESSIN DU LOGO * 15 CONTINUE ZLOGO =.TRUE. ZLOGOO=.TRUE. GOTO 2 * * TITR : AFFICHAGE D'UN TITRE GENERAL * 16 CONTINUE CALL LIRCHA(TXTIT(1:72),0,IRETOU) IF (IRETOU.EQ.0) TXTIT=' ' GOTO 2 * * TITX : AFFICHAGE D'UN TITRE EN X * 17 CONTINUE CALL LIRCHA(TXAXE(1:20),0,IRETOU) IF (IRETOU.EQ.0) TXAXE=' ' GOTO 2 * * TITY : AFFICHAGE D'UN TITRE EN Y * 18 CONTINUE CALL LIRCHA(TYAXE(1:20),0,IRETOU) IF (IRETOU.EQ.0) TYAXE=' ' GOTO 2 * * AXES : TRACE DES AXES OX ET OY * 19 CONTINUE ZAXES=.TRUE. GOTO 2 * * NCLK : OPTION NOCLICK * 20 CONTINUE KCLICK=0 GOTO 2 * * XGRA et YGRA : GRADUATIONS IMPOSEES * 221 CONTINUE ZXGRA = .true. CALL LIRREE(XINT1,1,IOK) IF(IOK.EQ.0) write(ioimp,*)'XGRA doit etre suivi d un flottant' IF (IERR.NE.0) GOTO 1000 GOTO 2 * 222 CONTINUE ZYGRA = .true. CALL LIRREE(YINT1,1,IOK) IF(IOK.EQ.0) write(ioimp,*)'YGRA doit etre suivi d un flottant' IF (IERR.NE.0) GOTO 1000 GOTO 2 * * POSX et POSY : GRADUATIONS IMPOSEES * 223 CONTINUE CALL LIRMOT(MOPOSX,2,IIPOS,1) IF(IIPOS.EQ.0)write(ioimp,*)'POSX doit etre suivi d un mot-clé' IPOSX=IIPOS IF(IERR.NE.0) GOTO 1000 GOTO 2 * 224 CONTINUE CALL LIRMOT(MOPOSX,2,IIPOS,1) IF(IIPOS.EQ.0)write(ioimp,*)'POSY doit etre suivi d un mot-clé' IPOSY=IIPOS IF(IERR.NE.0) GOTO 1000 GOTO 2 * ENDIF * * LECTURE DE LA TABLE DES PARAMETRES SPECIFIQUES * CALL LIROBJ('TABLE',IOPTIO,0,IOK) IF (IOK.EQ.1) THEN ZOPTIO=.TRUE. ENDIF * * PREND COMME LEGENDE D'AXE LES LEGENDES DE LA PREMIERE COURBE A TRACER * MEVOLL=IEV SEGACT MEVOLL I=1 22 CONTINUE IF ((.NOT.ZTRACE(I)).AND.(I.LE.INBEVO)) THEN I=I+1 GOTO 22 ENDIF IF (I.GT.INBEVO) GOTO 1000 KEVOLL=IEVOLL(I) SEGACT KEVOLL TITREX(1:20)=NOMEVX TITREY(1:20)=NOMEVY SEGDES KEVOLL SEGDES MEVOLL NC=0 * * DANS LE CAS DE BORNES IMPOSEES ON VERIFIE QUE LA BORNE SUPERIEURE EST * EFFECTIVEMENT PLUS PETITE QUE LA BORNE INFERIEURE * IF (ZXFORC.AND.XSUP.LT.XINF) GOTO 950 IF (ZYFORC.AND.YSUP.LT.YINF) GOTO 950 * * DANS LE CAS DE BORNES IMPOSEES EN LOG, ON VERIFIE * QU'ELLES NE SONT PAS NEGATIVES * IF (ZXFORC.AND.ZLOGX.AND.XINF.LT.1.D-30) GOTO 900 IF (ZYFORC.AND.ZLOGY.AND.YINF.LT.1.D-30) GOTO 900 * * TRIE LES EVOLUTIONS REFERANT DES NOMS D'ABSCISSES * (CAS DES ABSCISSES CURVILIGNES) * NDIMT2=INBEVO SEGINI CUR MEVOLL=IEV SEGACT MEVOLL DO 23 I=1,INBEVO KEVOLL=IEVOLL(I) SEGACT KEVOLL IF (TYPX(1:8).EQ.'LISTMOTS') THEN ZTRACE(I)=.FALSE. ZCUR(I)=.TRUE. GOTO 23 ENDIF IF (TYPY(1:8).EQ.'LISTMOTS') THEN ZTRACE(I)=.FALSE. ZCUR(I)=.TRUE. GOTO 23 ENDIF ZCUR(I)=.FALSE. SEGDES KEVOLL 23 CONTINUE * * TRACES SIMULTANES * IF (.NOT.ZSEPAR) THEN * * CALCUL DES BORNES DES AXES SUR X ET SUR Y (TRACES SIMULTANES) * IOKX=0 IF (ZXFORC.AND.ZYFORC) IOKX=1 * BORNES IMPOSEES SUR Y * IF(ZYFORC.AND.(.NOT.ZXFORC)) THEN * IOKX=-1 * * BOUCLE SUR LES EVOLUTIONS A TRACER * DO 24 J=1,INBEVO IF (ZTRACE(J)) THEN KEVOLL=IEVOLL(J) SEGACT KEVOLL MLREEX=IPROGX MLREEY=IPROGY SEGACT MLREEX SEGACT MLREEY NG=MLREEX.PROG(/1) PGX1=MLREEX.PROG(1) PGY1=MLREEY.PROG(1) DO 25 IG=2,NG IOKMI=0 IOKMA=0 PGX=MLREEX.PROG(IG) PGY=MLREEY.PROG(IG) IF ((PGY1-YINF)*(PGY-YINF).LE.0.D0) THEN IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN IOKMI=1 VMIN=YINF CALL INTEXT(PGY1,PGY,PGX1,PGX,VMIN) ENDIF IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN IOKMA=1 VMAX=YINF CALL INTEXT(PGY1,PGY,PGX1,PGX,VMAX) ENDIF ENDIF IF ((PGY1-YSUP)*(PGY-YSUP).LE.0.D0) THEN IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN IOKMA=1 VMAX=YSUP CALL INTEXT(PGY1,PGY,PGX1,PGX,VMAX) ENDIF IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN IOKMI=1 VMIN=YSUP CALL INTEXT(PGY1,PGY,PGX1,PGX,VMIN) ENDIF ENDIF IF (.NOT. ((MIN(PGY1,PGY).GT.YSUP).OR. * (MAX(PGY1,PGY).LT.YINF))) THEN IF (IOKMI.EQ.0) VMIN=MIN(PGX1,PGX) IF (IOKMA.EQ.0) VMAX=MAX(PGX1,PGX) IF (IOKX.LE.0) THEN IOKX=1 XINF=VMIN XSUP=VMAX ELSE XINF=MIN(XINF,VMIN) XSUP=MAX(XSUP,VMAX) ENDIF ENDIF PGX1=PGX PGY1=PGY 25 CONTINUE IF (IOKX.LE.0) THEN IPTR=MLREEX CALL MINMAX(IPTR,AMINI,AMAXI) IF (IOKX.EQ.-1) THEN XINF=AMINI XSUP=AMAXI IOKX=0 ELSE XINF=MIN(XINF,AMINI) XSUP=MAX(XSUP,AMAXI) ENDIF ENDIF SEGDES MLREEX SEGDES MLREEY SEGDES KEVOLL ENDIF 24 CONTINUE * SEGDES MEVOLL ENDIF * * BORNES IMPOSEES SUR X * IF (ZXFORC.AND.(.NOT.ZYFORC)) THEN * IOKY=-1 * * BOUCLE SUR LES EVOLUTIONS A TRACER * DO 26 J=1,INBEVO IF (ZTRACE(J)) THEN KEVOLL=IEVOLL(J) SEGACT KEVOLL MLREEX=IPROGX MLREEY=IPROGY SEGACT MLREEX SEGACT MLREEY NG=MLREEX.PROG(/1) PGX1=MLREEX.PROG(1) PGY1=MLREEY.PROG(1) DO 27 IG=2,NG IOKMI=0 IOKMA=0 PGX=MLREEX.PROG(IG) PGY=MLREEY.PROG(IG) IF ((PGX1-XINF)*(PGX-XINF).LE.0.D0) THEN IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN IOKMI=1 VMIN=XINF CALL INTEXT(PGX1,PGX,PGY1,PGY,VMIN) ENDIF IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN IOKMA=1 VMAX=XINF CALL INTEXT(PGX1,PGX,PGY1,PGY,VMAX) ENDIF ENDIF IF ((PGX1-XSUP)*(PGX-XSUP).LE.0.D0) THEN IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN IOKMA=1 VMAX=XSUP CALL INTEXT(PGX1,PGX,PGY1,PGY,VMAX) ENDIF IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN IOKMI=1 VMIN=XSUP CALL INTEXT(PGX1,PGX,PGY1,PGY,VMIN) ENDIF ENDIF IF (.NOT. ((MIN(PGX1,PGX).GT.XSUP).OR. * (MAX(PGX1,PGX).LT.XINF))) THEN IF (IOKMI.EQ.0) VMIN=MIN(PGY1,PGY) IF (IOKMA.EQ.0) VMAX=MAX(PGY1,PGY) IF (IOKY.LE.0) THEN IOKY=1 YINF=VMIN YSUP=VMAX ELSE YINF=MIN(YINF,VMIN) YSUP=MAX(YSUP,VMAX) ENDIF ENDIF PGX1=PGX PGY1=PGY 27 CONTINUE IF (IOKY.LE.0) THEN IPTR=MLREEY CALL MINMAX(IPTR,AMINI,AMAXI) IF (IOKY.EQ.-1) THEN YINF=AMINI YSUP=AMAXI IOKY=0 ELSE YINF=MIN(YINF,AMINI) YSUP=MAX(YSUP,AMAXI) ENDIF ENDIF SEGDES MLREEX SEGDES MLREEY SEGDES KEVOLL ENDIF 26 CONTINUE * SEGDES MEVOLL ENDIF * * PAS DE BORNES IMPOSEES * IF ((.NOT.ZXFORC).AND.(.NOT.ZYFORC)) THEN I=0 28 CONTINUE I=I+1 IF (.NOT. ZTRACE(I)) GOTO 28 * * PREMIERE EVOLUTION : INITIALISATION DU MIN ET DU MAX * MEVOLL=IEV SEGACT MEVOLL KEVOLL=IEVOLL(I) SEGACT KEVOLL MLREEL=IPROGX IPTR=IPROGX CALL MINMAX(IPTR,AMINI,AMAXI) XINF=AMINI XSUP=AMAXI SEGDES KEVOLL * * BOUCLE SUR LES AUTRES EVOLUTIONS A TRACER * IF (I.LT.INBEVO) THEN DO 29 J=I+1,INBEVO IF (ZTRACE(J)) THEN KEVOLL=IEVOLL(J) SEGACT KEVOLL IPTR=IPROGX CALL MINMAX(IPTR,AMINI,AMAXI) SEGDES KEVOLL IF (AMINI.LT.XINF) XINF=AMINI IF (AMAXI.GT.XSUP) XSUP=AMAXI ENDIF 29 CONTINUE ENDIF SEGDES MEVOLL ENDIF * IF ((.NOT.ZYFORC).AND.(.NOT.ZXFORC)) THEN I=0 30 CONTINUE I=I+1 IF (.NOT. ZTRACE(I)) GOTO 30 * * PREMIERE EVOLUTION : INITIALISATION DU MIN ET DU MAX * MEVOLL=IEV SEGACT MEVOLL KEVOLL=IEVOLL(I) SEGACT KEVOLL IPTR=IPROGY CALL MINMAX(IPTR,AMINI,AMAXI) YINF=AMINI YSUP=AMAXI SEGDES KEVOLL * * BOUCLE SUR LES AUTRES EVOLUTIONS A TRACER * DO 31 J=I+1,INBEVO IF (ZTRACE(J)) THEN KEVOLL=IEVOLL(J) SEGACT KEVOLL IPTR=IPROGY CALL MINMAX(IPTR,AMINI,AMAXI) SEGDES KEVOLL IF (AMINI.LT.YINF) YINF=AMINI IF (AMAXI.GT.YSUP) YSUP=AMAXI ENDIF 31 CONTINUE SEGDES MEVOLL ENDIF c IF (ZMIMA) THEN * * SAUVEGARDE VALEUR AXE POUR CHERCHER MAXI * I=0 32 CONTINUE I=I+1 IF (.NOT. ZTRACE(I)) GOTO 32 * * PREMIERE EVOLUTION : INITIALISATION DU MIN ET DU MAX * MEVOLL=IEV SEGACT MEVOLL KEVOLL=IEVOLL(I) SEGACT KEVOLL IPTR=IPROGY CALL MINMAX(IPTR,AMINI,AMAXI) YMINI=AMINI YMAXI=AMAXI SEGDES KEVOLL * * BOUCLE SUR LES AUTRES EVOLUTIONS A TRACER * DO 33 J=I+1,INBEVO IF (ZTRACE(J)) THEN KEVOLL=IEVOLL(J) SEGACT KEVOLL IPTR=IPROGY CALL MINMAX(IPTR,AMINI,AMAXI) SEGDES KEVOLL IF (AMINI.LT.YMINI) YMINI=AMINI IF (AMAXI.GT.YMAXI) YMAXI=AMAXI ENDIF 33 CONTINUE SEGDES MEVOLL ENDIF * * DANS LE CAS D'AXES EN LOG, * ON VERIFIE QUE LES BORNES NE SONT PAS NEGATIVES * IF (ZLOGX.AND.XINF.LT.1.D-30) GOTO 900 IF (ZLOGY.AND.YINF.LT.1.D-30) GOTO 900 * * CALCUL DES ARRONDIS, * Les bornes passent eventuellement en log10 * CALL BORAXE(XINF,XSUP,ZLOGX) CALL BORAXE(YINF,YSUP,ZLOGY) * * CALCUL DU PAS DE GRADUATION * en X CALL INTAXE(XINF,XSUP,XINT,INX,ZLOGX,ZARR.OR.ZXFORC) if(ZXGRA) then if(ZLOGX) then write(ioimp,*) 'Option XGRA non compatible avec LOGX' else XINT=XINT1 INX=INT((XSUP-XINF)/XINT+5.D-3) endif endif * en Y CALL INTAXE(YINF,YSUP,YINT,INY,ZLOGY,ZARR.OR.ZYFORC) if(ZYGRA) then if(ZLOGY) then write(ioimp,*) 'Option YGRA non compatible avec LOGY' else YINT=YINT1 INY=INT((YSUP-YINF)/YINT+5.D-3) endif endif c write(6,*) 'XINF,XSUP,XINT,INX=',XINF,XSUP,XINT,INX c write(6,*) 'YINF,YSUP,YINT,INY=',YINF,YSUP,YINT,INY * ENDIF * IF (ZSEPAR.AND.ZLOGX.AND.ZXFORC) THEN X1=XINF X2=XSUP ENDIF IF (ZSEPAR.AND.ZLOGY.AND.ZYFORC) THEN Y1=YINF Y2=YSUP ENDIF 34 CONTINUE * IF (ZSEPAR) THEN * * CALCUL PAR COURBE (TRACES SEPARES) * 35 CONTINUE IF (ZLOGX.AND.ZXFORC) THEN XINF=X1 XSUP=X2 ENDIF IF (ZLOGY.AND.ZYFORC) THEN YINF=Y1 YSUP=Y2 ENDIF NC=NC+1 IF (NC.GT.INBEVO) GOTO 1000 IF (.NOT.ZTRACE(NC)) GOTO 35 MEVOLL=IEV SEGACT MEVOLL KEVOLL=IEVOLL(NC) SEGACT KEVOLL * * SURCHARGE DES TITRES * TITREX(1:20)=NOMEVX TITREY(1:20)=NOMEVY IOKX=0 IF (ZXFORC.AND.ZYFORC) IOKX=1 * * BORNES IMPOSEES SUR Y * IF(ZYFORC.AND.(.NOT.ZXFORC)) THEN * IOKX=-1 MLREEX=IPROGX MLREEY=IPROGY SEGACT MLREEX SEGACT MLREEY NG=MLREEX.PROG(/1) PGX1=MLREEX.PROG(1) PGY1=MLREEY.PROG(1) DO 36 IG=2,NG IOKMI=0 IOKMA=0 PGX=MLREEX.PROG(IG) PGY=MLREEY.PROG(IG) IF ((PGY1-YINF)*(PGY-YINF).LE.0.D0) THEN IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN IOKMI=1 VMIN=YINF CALL INTEXT(PGY1,PGY,PGX1,PGX,VMIN) ENDIF IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN IOKMA=1 VMAX=YINF CALL INTEXT(PGY1,PGY,PGX1,PGX,VMAX) ENDIF ENDIF IF ((PGY1-YSUP)*(PGY-YSUP).LE.0.D0) THEN IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN IOKMA=1 VMAX=YSUP CALL INTEXT(PGY1,PGY,PGX1,PGX,VMAX) ENDIF IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN IOKMI=1 VMIN=YSUP CALL INTEXT(PGY1,PGY,PGX1,PGX,VMIN) ENDIF ENDIF IF (.NOT. ((MIN(PGY1,PGY).GT.YSUP).OR. * (MAX(PGY1,PGY).LT.YINF))) THEN IF (IOKMI.EQ.0) VMIN=MIN(PGX1,PGX) IF (IOKMA.EQ.0) VMAX=MAX(PGX1,PGX) IF (IOKX.LE.0) THEN IOKX=1 XINF=VMIN XSUP=VMAX ELSE XINF=MIN(XINF,VMIN) XSUP=MAX(XSUP,VMAX) ENDIF ENDIF PGX1=PGX PGY1=PGY 36 CONTINUE IF (IOKX.LE.0) THEN IPTR=MLREEX CALL MINMAX(IPTR,AMINI,AMAXI) IF (IOKX.EQ.-1) THEN XINF=AMINI XSUP=AMAXI IOKX=0 ELSE XINF=MIN(XINF,AMINI) XSUP=MAX(XSUP,AMAXI) ENDIF ENDIF SEGDES MLREEX SEGDES MLREEY ENDIF * * BORNES IMPOSEES SUR X * IF (ZXFORC.AND.(.NOT.ZYFORC)) THEN * IOKY=-1 MLREEX=IPROGX MLREEY=IPROGY SEGACT MLREEX SEGACT MLREEY NG=MLREEX.PROG(/1) PGX1=MLREEX.PROG(1) PGY1=MLREEY.PROG(1) DO 37 IG=2,NG IOKMI=0 IOKMA=0 PGX=MLREEX.PROG(IG) PGY=MLREEY.PROG(IG) IF ((PGX1-XINF)*(PGX-XINF).LE.0.D0) THEN IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN IOKMI=1 VMIN=XINF CALL INTEXT(PGX1,PGX,PGY1,PGY,VMIN) ENDIF IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN IOKMA=1 VMAX=XINF CALL INTEXT(PGX1,PGX,PGY1,PGY,VMAX) ENDIF ENDIF IF ((PGX1-XSUP)*(PGX-XSUP).LE.0.D0) THEN IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN IOKMA=1 VMAX=XSUP CALL INTEXT(PGX1,PGX,PGY1,PGY,VMAX) ENDIF IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN IOKMI=1 VMIN=XSUP CALL INTEXT(PGX1,PGX,PGY1,PGY,VMIN) ENDIF ENDIF IF (.NOT. ((MIN(PGX1,PGX).GT.XSUP).OR. * (MAX(PGX1,PGX).LT.XINF))) THEN IF (IOKMI.EQ.0) VMIN=MIN(PGY1,PGY) IF (IOKMA.EQ.0) VMAX=MAX(PGY1,PGY) IF (IOKY.LE.0) THEN IOKY=1 YINF=VMIN YSUP=VMAX ELSE YINF=MIN(YINF,VMIN) YSUP=MAX(YSUP,VMAX) ENDIF ENDIF PGX1=PGX PGY1=PGY 37 CONTINUE IF (IOKY.LE.0) THEN IPTR=MLREEY CALL MINMAX(IPTR,AMINI,AMAXI) IF (IOKY.EQ.-1) THEN YINF=AMINI YSUP=AMAXI IOKY=0 ELSE YINF=MIN(YINF,AMINI) YSUP=MAX(YSUP,AMAXI) ENDIF ENDIF SEGDES MLREEX SEGDES MLREEY ENDIF * * PAS DE BORNES IMPOSEES * IF ((.NOT.ZXFORC).AND.(.NOT.ZYFORC)) THEN IPTR=IPROGX CALL MINMAX(IPTR,AMINI,AMAXI) XINF=AMINI XSUP=AMAXI IPTR=IPROGY CALL MINMAX(IPTR,AMINI,AMAXI) YINF=AMINI YSUP=AMAXI ENDIF IF (ZMIMA) THEN * * SAUVEGARDE VALEUR AXE POUR CHERCHER MAXI * IPTR=IPROGY CALL MINMAX(IPTR,YMINI,YMAXI) ENDIF SEGDES KEVOLL SEGDES MEVOLL * * DANS LE CAS D'AXES EN LOG, * ON VERIFIE QUE LES BORNES NE SONT PAS NEGATIVES * IF (ZLOGX.AND.XINF.LT.1.D-30) GOTO 900 IF (ZLOGY.AND.YINF.LT.1.D-30) GOTO 900 * * CALCUL DES ARRONDIS * Les bornes passent eventuellement en log10 * CALL BORAXE(XINF,XSUP,ZLOGX) CALL BORAXE(YINF,YSUP,ZLOGY) * * CALCUL DU PAS DE GRADUATION * CALL INTAXE (XINF,XSUP,XINT,INX,ZLOGX,ZARR.OR.ZXFORC) CALL INTAXE (YINF,YSUP,YINT,INY,ZLOGY,ZARR.OR.ZYFORC) * ENDIF * * SAUVEGARDE DE L'AXE POUR RETOUR GRAPHE INITIAL * c OLDAXE.XINF=XINF c OLDAXE.XSUP=XSUP c OLDAXE.YINF=YINF c OLDAXE.YSUP=YSUP c OLDAXE.XINT=XINT c OLDAXE.YINT=YINT c OLDAXE.INX =INX c OLDAXE.INY =INY cbp: on commente ci-dessus pour faire autrement SEGINI,OLDAXE=AXE * * TRAITEMENT TRACE * * INITIALISATION DU GRAPHIQUE * 38 CONTINUE CALL OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,TTXX,TTXXX, & TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,DYN,NDIMT,CUR,NDIMT2,NC & ,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,IPOSI,XPOSI,YPOSI,IGRIL) IF (IERR.NE.0) GOTO 1000 IF (PASSE.LT.0.5) THEN TDX = ((TTXXX-TTXX)/10.)*3./4. TDY = ((TTYYY-TTYY)/10.)*15./14. TCENTX = TTXXX-(TDX/2.) TCENTY = TTYYY-(TDY/2.) OLDLOGX= TCENTX OLDLOGY= TCENTY OLDTX1 = TTXX OLDTY1 = TTYY OLDTX2 = TTXXX OLDTY2 = TTYYY PASSE = 1. ENDIF * * MEMORISATION POUR IMPRESSION DU DESSIN * * CALL MAJSEG(1,0,0,0,0) *********************************************** * APPEL DE NLOGO IF (ZLOGO) THEN CALL LOGDES (TTXXX,TTYYY,TTXX,TTYY,AXE, & tcentx,tcenty,htlog,icolog) CALL CHCOUL(IDCOUL) ENDIF * * COMMENTAIRES SI IL Y EN A * SEGACT COM IF (ICOM.NE.0) THEN DO JK=1,ICOM CALL CHCOUL(ICOUCO(JK)) CALL TRLABL (TXCOM(JK),TYCOM(JK),0.,COMMENT(JK),30,HMIN) ENDDO CALL CHCOUL(IDCOUL) ENDIF * BERTIN: Redessiner le lien IF(ZLIEN) THEN DO JK=1, ICOM TX(1)=LIEN(JK,1) TY(1)=LIEN(JK,2) TX(2)=LIEN(JK,3) TY(2)=LIEN(JK,4) CALL POLRL(2,TX,TY,tz) ENDDO ENDIF * * INDEX * IF (ZINDEX) THEN TX(1)=XINF TY(1)=TLACY TX(2)=XSUP TY(2)=TLACY CALL POLRL(2,TX,TY,tz) TX(1)=tlacx TY(1)=YINF TX(2)=tlacx TY(2)=YSUP CALL POLRL(2,TX,TY,tz) TYINF=YINF CALL TRLABL (TXIND,TLACY+0.02,0.,CARDY,11,HMIN) CALL TRLABL (TLACX,TYINF+0.02,0.,CARDX,11,HMIN) ENDIF CALL TRCLIK(KCLICK) * * MEMORISATION POUR IMPRESSION DU DESSIN * * CALL MAJSEG(1,0,0,0,0) * * EN INTERACTIF CREATION MENU PRINCIPAL * EN BATCH LOCAL CREATION FICHIER PUN * EN BATCH AUCUN EFFET * 50 CONTINUE LEGEND(1)=' Fin dessin' LEGEND(2)=' Zoom ' LEGEND(3)=' Initial ' LEGEND(4)=' Valeur ' LEGEND(5)=' Presenter ' LEGEND(6)=' Options ' CALL MENU(LEGEND,6,13) * CALL TRAFF (ICLE) IF (ICLE.GT.5) GOTO 50 * * GESTION DU ZOOM * IF (ICLE.EQ.1) THEN 51 CONTINUE BUFFER0='cliquez 2 coins opposes ' CALL TRMESS(BUFFER0) * Premier clic CALL TRDIG (TXX1,TYY1,INOUSE) * Deuxieme clic CALL TRDIG (TXX2,TYY2,INOUSE) * * Test position des deux coins l'un par rapport a l'autre * Superieur gauche TXX=MIN(TXX1,TXX2) TYY=MAX(TYY1,TYY2) * Inferieur droit TXXX=MAX(TXX1,TXX2) TYYY=MIN(TYY1,TYY2) *PM IF ((ZLOGX).AND.(TXX .LT.1.E-30)) GOTO 51 ????????????? *PM IF ((ZLOGY).AND.(TYYY.LT.1.E-30)) GOTO 51 ????????????? * * Restriction de la fenetre aux nouvelles bornes * On n'intervient sur les bornes que s'il n'y a pas eu deux clics * en dehors du cadre du meme cote : on ignore alors le zoom * sur la coordonnee hors cadre. XINFN = XINF XSUPN = XSUP YINFN = YINF YSUPN = YSUP IF ((TXX.GT.REAL(XINF)).AND.(TXX.LT.REAL(XSUP))) THEN XINFN=DBLE(TXX) ENDIF IF ((TYY.LT.REAL(YSUP)).AND.(TYY.GT.REAL(YINF))) THEN YSUPN=DBLE(TYY) ENDIF IF ((TXXX.LT.REAL(XSUP)).AND.(TXXX.GT.REAL(XINF))) THEN XSUPN=DBLE(TXXX) ENDIF IF ((TYYY.GT.REAL(YINF)).AND.(TYYY.LT.REAL(YSUP))) THEN YINFN=DBLE(TYYY) ENDIF * XINF, XSUP, YINF, YSUP sont eventuellement log10 * on determine les nouvelles valeurs non transformees. IF (ZLOGX) THEN XINF = 10.D0**XINFN XSUP = 10.D0**XSUPN ELSE XINF = XINFN XSUP = XSUPN ENDIF IF (ZLOGY) THEN YINF = 10.D0**YINFN YSUP = 10.D0**YSUPN ELSE YINF = YINFN YSUP = YSUPN ENDIF * * CALCUL POUR LE NOUVEL AXE * Les bornes repassent eventuellement en log10 * CALL BORAXE(XINF,XSUP,ZLOGX) CALL BORAXE(YINF,YSUP,ZLOGY) CALL INTAXE(XINF,XSUP,XINT,INX,ZLOGX,ZARR.OR.ZXFORC) CALL INTAXE(YINF,YSUP,YINT,INY,ZLOGY,ZARR.OR.ZYFORC) * * Calcul nouvelles coordonnees logo * DELTX1 = OLDAXE.XSUP - OLDAXE.XINF DELTX2 = XSUP - XINF DELTY1 = OLDAXE.YSUP - OLDAXE.YINF DELTY2 = YSUP - YINF DELTX = DELTX1 / DELTX2 DELTY = DELTY1 / DELTY2 TCENTX = ((OLDLOGX - OLDAXE.XINF) / DELTX) + XINF TCENTY = ((OLDLOGY - OLDAXE.YINF) / DELTY) + YINF GOTO 38 ENDIF * * GESTION RETOUR AU GRAPHE ORIGINAL * IF (ICLE.NE.2) go to 7654 125 Continue tcexx= (TCENTX -XSUP )/ ( XSUP-XINF) tceyy= (TCENTY -YSUP )/ ( YSUP-YINF) XINF = OLDAXE.XINF XSUP = OLDAXE.XSUP YSUP = OLDAXE.YSUP YINF = OLDAXE.YINF XINT = OLDAXE.XINT YINT = OLDAXE.YINT INX = OLDAXE.INX INY = OLDAXE.INY TTXX = OLDTX1 TTYY = OLDTY1 TTXXX = OLDTX2 TTYYY = OLDTY2 TDX = ((TTXXX-TTXX)/10.)* 3./4. TDY = ((TTYYY-TTYY)/10.)*15./14. TCENTX=tcexx *(XSUP-XINF) +XSUP TCENTY=tceyy *(ySUP-yINF) +ySUP * TCENTX = TTXXX-(TDX/2.) * TCENTY = TTYYY-(TDY/2.) OLDLOGX= TCENTX OLDLOGY= TCENTY GOTO 38 7654 continue * ENDIF * * GESTION AFFICHAGE DE VALEUR * **TC IF (ICLE.EQ.3) THEN IF (ICLE.NE.3) GO TO 7657 ZVALEUR=.TRUE. TXXX=REAL(XINF+(XSUP-XINF)/2.D0) TYYY=REAL(YINF+(YSUP-YINF)/2.D0) 52 CALL TRDIG (TXXX,TYYY,INOUSE) TXXA=TXXX TYYA=TYYY * MEVOLL=IEV SEGACT MEVOLL KEVOLL=IEVOLL(1) SEGACT KEVOLL MLREEL=IPROGX SEGACT MLREEL DO JK=1,PROG(/1) IF(PROG(JK).GT.TXXA) THEN *C# MC 03/11/97 : ajout de ce test car PROG(JK-1) IF(JK.GT.1) THEN IF(ABS(PROG(JK)-TXXA).GT.ABS(PROG(JK-1)-TXXA)) THEN JKNUM=JK-1 ELSE JKNUM=JK ENDIF ELSE JKNUM=JK ENDIF GOTO 777 ENDIF ENDDO *777 SEGDES MLREEL,KEVOLL,MEVOLL 777 CONTINUE BUFFER0='Point : ' CALL CHCOUL (IDCOUL) TXXA=PROG(JKNUM) IF (ZLOGX) TXXA=10.**TXXA BUFFER1='X : ' TXXA=PROG(JKNUM) SEGDES MLREEL,KEVOLL,MEVOLL 7773 WRITE (BUFFER0(9:15),FMT='(I6)') JKNUM WRITE (BUFFER1(4:14),FMT='(G11.4)') TXXA BUFFER2='Y : ' * BERTIN: Recuperation de l'abscisse correspondant au curseur MEVOLL=IEV SEGACT MEVOLL KEVOLL=IEVOLL(1) SEGACT KEVOLL MLREEL=IPROGY SEGACT MLREEL TYYA=PROG(JKNUM) SEGDES MLREEL,KEVOLL,MEVOLL * BERTIN: Fin recuperation abscisse IF (ZLOGY) TYYA=10.**TYYA WRITE (BUFFER2(4:14),FMT='(G11.4)') TYYA *PP CALL TRMESS(BUFFER1//BUFFER2) * CALL TRMESS(BUFFER1//BUFFER2//BUFFER0) * BERTIN: Affichage d'une croix au point correspondant au curseur ZINDEX=.TRUE. TLACX=TXXA TLACY=TYYA IF (ZVALEUR) GOTO 7771 7772 CONTINUE ** BERTIN: FIN affichage croix ZVALEUR=.TRUE. CALL TRMESS(BUFFER1//BUFFER2//BUFFER0) LEGEND(1)=' ' LEGEND(2)=' Retour ' LEGEND(3)=' <-- ' LEGEND(4)=' --> ' CALL MENU(LEGEND,4,13) CALL TRAFF(ICLE9) * BERTIN: Gestion du deplacement curseur IF (ICLE9.EQ.0) THEN STOP **TC ELSEIF (ICLE9.EQ.2) ENDIF ENDIF IF (ICLE9.ne.2) GO TO 7655 JKNUM=JKNUM-1 SEGACT MEVOLL KEVOLL=IEVOLL(1) SEGACT KEVOLL MLREEL=IPROGX SEGACT MLREEL JKNUM=MAX(1,JKNUM) TXXA=PROG(JKNUM) SEGDES MLREEL,KEVOLL,MEVOLL GOTO 7773 7655 continue **TC ELSEIF (ICLE9.EQ.3) THEN IF(ICLE9.NE.3) go to 7656 JKNUM=JKNUM+1 SEGACT MEVOLL KEVOLL=IEVOLL(1) SEGACT KEVOLL MLREEL=IPROGX SEGACT MLREEL JKNUM=MIN(JKNUM,PROG(/1)) TXXA=PROG(JKNUM) SEGDES MLREEL,KEVOLL,MEVOLL GOTO 7773 7656 continue **TC ENDIF * BERTIN: Fin deplacement curseur IF (ICLE9.NE.1) GOTO 52 ZVALEUR=.FALSE. GOTO 50 **TC ENDIF 7657 continue * * IMPRESSION PAR CREATION D'UN FICHIER LGI * IF (ICLE .EQ. 11) THEN CALL FLGI GOTO 50 ENDIF * * GESTION DES OPTIONS * IF (ICLE.EQ.5) THEN 123 LEGEND(1)=' Retour ' LEGEND(2)=' Fonts>> ' IF (ICOSC.EQ.1) THEN LEGEND(3)='Ecran>> Blanc' ELSE IF (ICOSC.EQ.2) THEN LEGEND(3)='Ecran>> Noir' ENDIF IF (ZDATE) THEN LEGEND(4)=' (X) Date ' ELSE LEGEND(4)=' ( ) Date ' ENDIF IF (ZGRILL) THEN LEGEND(5)=' (X)Grille ' ELSE LEGEND(5)=' ( )Grille ' ENDIF CALL MENU(LEGEND,5,13) CALL TRAFF (ICLE2) IF (ICLE2.EQ.0) GOTO 38 IF (ICLE2.EQ.1) THEN 124 LEGEND(1)=' Retour ' LEGEND(2)=' 8_BY_13 ' LEGEND(3)=' 9_BY_15 ' LEGEND(4)=' TIMES_10 ' LEGEND(5)=' TIMES_24 ' LEGEND(6)=' HELV_10 ' LEGEND(7)=' HELV_12 ' LEGEND(8)=' HELV_18 ' CALL MENU(LEGEND,8,13) CALL TRAFF(ICLE3) IF (ICLE3.EQ.0) GOTO 38 IOPOLI=ICLE3 GOTO 38 ELSEIF (ICLE2.EQ.2) THEN IF (ICOSC.EQ.1) THEN ICOSC=2 ELSE IF (ICOSC.EQ.2) THEN ICOSC=1 ENDIF GOTO 38 ELSEIF (ICLE2.EQ.3) THEN IF (ZDATE) THEN ZDATE=.FALSE. ELSE ZDATE=.TRUE. ENDIF GOTO 38 ELSEIF (ICLE2.EQ.4) THEN IF (ZGRILL) THEN ZGRILL=.FALSE. ELSE ZGRILL=.TRUE. ENDIF GOTO 38 ENDIF ENDIF * * GESTION PRESENTATION * **TC IF (ICLE.EQ.4) THEN IF( ICLE.ne.4) go to 7659 5000 CONTINUE ************************************************************************ CALL OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,TTXX,TTXXX, & TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,DYN,NDIMT,CUR,NDIMT2,NC & ,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,IPOSI,XPOSI,YPOSI,IGRIL) IF (IERR.NE.0) GOTO 1000 * APPEL DE NLOGO IF (ZLOGO) THEN CALL LOGDES (TTXXX,TTYYY,TTXX,TTYY,AXE, & TCENTX,TCENTY,HTLOG,ICOLOG) CALL CHCOUL(IDCOUL) ENDIF * * COMMENTAIRES SI IL Y EN A * SEGACT COM IF (ICOM.NE.0) THEN DO JK=1,ICOM CALL CHCOUL(ICOUCO(JK)) CALL TRLABL (TXCOM(JK),TYCOM(JK),0.,COMMENT(JK),30,HMIN) ENDDO CALL CHCOUL(IDCOUL) ENDIF * BERTIN: Redessiner le lien IF(ZLIEN) THEN DO JK=1, ICOM TX(1)=LIEN(JK,1) TY(1)=LIEN(JK,2) TX(2)=LIEN(JK,3) TY(2)=LIEN(JK,4) CALL POLRL(2,TX,TY,tz) ENDDO ENDIF * * INDEX * IF (ZINDEX) THEN TX(1)=XINF TY(1)=TLACY TX(2)=XSUP TY(2)=TLACY CALL POLRL(2,TX,TY,tz) TX(1)=TLACX TY(1)=YINF TX(2)=TLACX TY(2)=YSUP CALL POLRL(2,TX,TY,tz) TYINF=YINF * BERTIN: Ajustement de la position du label sur le curseur CALL TRLABL (TXIND,TLACY+0.02,0.,CARDY,11,HMIN) CALL TRLABL (TLACX,TYINF+0.02,0.,CARDX,11,HMIN) ENDIF ************************************************************************ IF (ZVALEUR) THEN ZVALEUR=.FALSE. GOTO 7772 END IF LEGEND(1)='Retour' LEGEND(2)='Index' LEGEND(3)='Enleve index' LEGEND(4)='Comment>> ' LEGEND(5)='Logo>> ' LEGEND(6)='Titres>> ' CALL MENU(LEGEND,6,13) CALL TRAFF(ICLE3) * * RETOUR * IF (ICLE3.EQ.0) GOTO 38 * * GESTION INDEX * **TC IF (ICLE3.EQ.1) THEN IF(icle3.ne.1) go to 7658 ZINDEX=.TRUE. BUFFER0='Pointez index' CALL TRMESS(BUFFER0) CALL TRDIG (tlacx,TLACY,INOUSE) 7771 CONTINUE * TEST SUR LES BORNES IF (TLACY.GT.REAL(YSUP)) THEN TLACY=REAL(YSUP) ENDIF IF (TLACY.LT.REAL(YINF)) THEN TLACY=REAL(YINF) ENDIF IF (TLACX.GT.REAL(XSUP)) THEN TLACX=REAL(XSUP) ENDIF IF (TLACX.LT.REAL(XINF)) THEN TLACX=REAL(XINF) ENDIF * AFFICHAGE DE L'INDEX TXIND=(XINF-((ABS(0.5*XINF)))) * TYIND=(YINF-((ABS(0.5*YINF)))) TYIND=(YINF+((ABS(0.5*YINF)))) WRITE (CARDX(1:11),FMT='(G11.4)') TLACX WRITE (CARDY(1:11),FMT='(G11.4)') TLACY GOTO 5000 **TC ENDIF 7658 continue * * SUPRESSION INDEX * IF (ICLE3.EQ.2) THEN ZINDEX=.FALSE. GOTO 5000 ENDIF * * GESTION AFFICHAGE COMMENTAIRE * IF (ICLE3.EQ.3) GOTO 6800 * * GESTION AFFICHAGE LOGO * IF (ICLE3.EQ.4) GOTO 6000 * * GESTION AFFICHAGE TITRE * IF (ICLE3.EQ.5) GOTO 6500 6000 CONTINUE CALL OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,TTXX,TTXXX, & TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,DYN,NDIMT,CUR,NDIMT2,NC & ,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,IPOSI,XPOSI,YPOSI,IGRIL) IF (IERR.NE.0) GOTO 1000 * APPEL DE NLOGO IF (ZLOGO) THEN CALL LOGDES (TTXXX,TTYYY,TTXX,TTYY,AXE, & TCENTX,TCENTY,HTLOG,ICOLOG) CALL CHCOUL(IDCOUL) ENDIF * * COMMENTAIRES SI IL Y EN A * SEGACT COM IF (ICOM.NE.0) THEN DO JK=1,ICOM CALL CHCOUL(ICOUCO(JK)) CALL TRLABL (TXCOM(JK),TYCOM(JK),0.,COMMENT(JK),30,HMIN) ENDDO CALL CHCOUL(IDCOUL) ENDIF * BERTIN: Redessiner le lien IF(ZLIEN) THEN DO JK=1, ICOM TX(1)=LIEN(JK,1) TY(1)=LIEN(JK,2) TX(2)=LIEN(JK,3) TY(2)=LIEN(JK,4) CALL POLRL(2,TX,TY,tz) ENDDO ENDIF * * INDEX * IF (ZINDEX) THEN TX(1)=XINF TY(1)=TLACY TX(2)=XSUP TY(2)=TLACY CALL POLRL(2,TX,TY,tz) TX(1)=tlacx TY(1)=YINF TX(2)=tlacx TY(2)=YSUP CALL POLRL(2,TX,TY,tz) TYINF=YINF CALL TRLABL (TXIND,TLACY+0.02,0.,CARDY,11,HMIN) CALL TRLABL (TLACX,TYINF+0.02,0.,CARDX,11,HMIN) ENDIF LEGEND (1)=' << logo' LEGEND (2)='Position' LEGEND (3)='Couleur' LEGEND (4)='Taille' IF (ZLOGO) THEN LEGEND (5)=' (X) Logo' ELSE LEGEND (5)=' ( ) Logo' ENDIF CALL MENU (LEGEND,5,13) CALL TRAFF (ICLE4) * REVENIR IF (ICLE4.EQ.0) GOTO 5000 * POSITION IF (ICLE4.EQ.1) THEN CALL TRMESS ('Cliquer sur la nouvelle position') CALL TRDIG (TCENTX,TCENTY,inouse) OLDLOGX=TCENTX OLDLOGY=TCENTY ENDIF * COULEUR IF (ICLE4.EQ.2) THEN NUM=NBCOUL CALL TRGETC (NUM) ICOLOG = NUM ENDIF * TAILLE IF (ICLE4.EQ.3) THEN CALL TRGET ('Entrer la nouvelle taille du logo 1 a 9:',TMPCAR) READ(TMPCAR,'(I1)') IRA ra=IRA IF ( (RA.LT.1).OR. (RA.GT.10.0)) THEN CALL TRMESS ('Taille incorrecte') ELSE HTLOG = REAL (RA * HDPLOG) ENDIF ENDIF * ON/OFF IF (ICLE4.EQ.4) THEN IF (ZLOGO) THEN ZLOGO = .FALSE. ELSE ZLOGO = .TRUE. ENDIF ENDIF * RETOUR GOTO 6000 * ENDIF 6500 CONTINUE CALL OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,TTXX,TTXXX, & TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,DYN,NDIMT,CUR,NDIMT2,NC & ,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,IPOSI,XPOSI,YPOSI,IGRIL) IF (IERR.NE.0) GOTO 1000 * APPEL DE NLOGO IF (ZLOGO) THEN CALL LOGDES (TTXXX,TTYYY,TTXX,TTYY,AXE, & TCENTX,TCENTY,HTLOG,ICOLOG) CALL CHCOUL(IDCOUL) ENDIF * * COMMENTAIRES SI IL Y EN A * SEGACT COM IF (ICOM.NE.0) THEN DO JK=1,ICOM CALL CHCOUL(ICOUCO(JK)) CALL TRLABL (TXCOM(JK),TYCOM(JK),0.,COMMENT(JK),30,HMIN) ENDDO CALL CHCOUL(IDCOUL) ENDIF * BERTIN: Redessiner le lien IF(ZLIEN) THEN DO JK=1, ICOM TX(1)=LIEN(JK,1) TY(1)=LIEN(JK,2) TX(2)=LIEN(JK,3) TY(2)=LIEN(JK,4) CALL POLRL(2,TX,TY,tz) ENDDO ENDIF * * INDEX * IF (ZINDEX) THEN TX(1)=XINF TY(1)=TLACY TX(2)=XSUP TY(2)=TLACY CALL POLRL(2,TX,TY,tz) TX(1)=TLACX TY(1)=YINF TX(2)=TLACX TY(2)=YSUP CALL POLRL(2,TX,TY,tz) TYINF=YINF CALL TRLABL (TXIND,TLACY+0.02,0.,CARDY,11,HMIN) CALL TRLABL (TLACX,TYINF+0.02,0.,CARDX,11,HMIN) ENDIF LEGEND (1)=' << Titres' LEGEND (2)='Titre gene.' LEGEND (3)='Titre X' LEGEND (4)='Titre Y' CALL MENU (LEGEND,4,13) CALL TRAFF (ICLE5) * REVENIR IF (ICLE5.EQ.0) GOTO 5000 * TITRE GENERAL IF (ICLE5.EQ.1) THEN CALL TRGET ('Entrer le nouveau titre general',TMPCAR) TXTIT=TMPCAR ENDIF * TITRE EN X IF (ICLE5.EQ.2) THEN CALL TRGET ('Entrer le nouveau titre EN X',TMPCAR) TXAXE=TMPCAR ENDIF * TITRE EN Y IF (ICLE5.EQ.3) THEN CALL TRGET ('Entrer le nouveau titre EN Y',TMPCAR) TYAXE=TMPCAR ENDIF * RETOUR GOTO 6500 * ENDIF 6800 CONTINUE CALL OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,TTXX,TTXXX, & TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,DYN,NDIMT,CUR,NDIMT2,NC & ,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,IPOSI,XPOSI,YPOSI,IGRIL) IF (IERR.NE.0) GOTO 1000 * APPEL DE NLOGO IF (ZLOGO) THEN CALL LOGDES (TTXXX,TTYYY,TTXX,TTYY,AXE, & TCENTX,TCENTY,HTLOG,ICOLOG) CALL CHCOUL(IDCOUL) ENDIF * * COMMENTAIRES SI IL Y EN A * SEGACT COM IF (ICOM.NE.0) THEN DO JK=1,ICOM CALL CHCOUL(ICOUCO(JK)) CALL TRLABL (TXCOM(JK),TYCOM(JK),0.,COMMENT(JK),30,HMIN) ENDDO CALL CHCOUL(IDCOUL) ENDIF * * INDEX * IF (ZINDEX) THEN TX(1)=XINF TY(1)=TLACY TX(2)=XSUP TY(2)=TLACY CALL POLRL(2,TX,TY,tz) TX(1)=TLACX TY(1)=YINF TX(2)=TLACX TY(2)=YSUP CALL POLRL(2,TX,TY,tz) TYINF=YINF CALL TRLABL (TXIND,TLACY+0.02,0.,CARDY,11,HMIN) CALL TRLABL (TLACX,TYINF+0.02,0.,CARDX,11,HMIN) ENDIF * BERTIN: Redessiner le lien IF(ZLIEN) THEN DO JK=1, ICOM TX(1)=LIEN(JK,1) TY(1)=LIEN(JK,2) TX(2)=LIEN(JK,3) TY(2)=LIEN(JK,4) CALL POLRL(2,TX,TY,tz) ENDDO ENDIF LEGEND (1)='Comment <<' LEGEND (2)='Ajout' LEGEND (3)='Enleve/Modif' LEGEND (4)='Deplacement' LEGEND (5)='Couleur' LEGEND (6)='Lien' CALL MENU (LEGEND,6,13) CALL TRAFF (ICLE6) * REVENIR IF (ICLE6.EQ.0) GOTO 5000 * AJOUT IF (ICLE6.EQ.1) THEN IF (ICOM.EQ.10) THEN BUFFER0='10 commentaires maxi - Pointer' CALL TRMESS(BUFFER0) CALL TRDIG (TXXX,TYYY,INOUSE) GOTO 6800 ELSE ICOM=ICOM+1 TXXX=REAL(XINF+(XSUP-XINF)/2.D0) TYYY=REAL(YINF+(YSUP-YINF)/2.D0) BUFFER0='Pointez commentaire' CALL TRMESS(BUFFER0) CALL TRDIG (TXXX,TYYY,INOUSE) CALL TRGET ('Entrer le commentaire',TMPCAR) COMMENT(ICOM)=TMPCAR TXCOM(ICOM)=TXXX TYCOM(ICOM)=TYYY ICOUCO(ICOM)=IDCOUL GOTO 6800 ENDIF ENDIF * SUPRESSION IF (ICLE6.EQ.2) THEN IF (ICOM.NE.0) THEN BUFFER0='Pointez commentaire' CALL TRMESS(BUFFER0) CALL TRDIG (TXXX,TYYY,INOUSE) CALL CHERCO (TXXX,TYYY,ICOM,AXE,IBON,COM) IF (IBON.NE.0) THEN TMPCAR=' ' CALL TRGET ('Entrer le commentaire',TMPCAR) IF (TMPCAR.NE.' ') THEN COMMENT(IBON)=TMPCAR ELSE IF (IBON.EQ.ICOM) THEN ICOM=ICOM - 1 TXCOM(IBON)=0. TYCOM(IBON)=0. ICOUCO(IBON)=0 LIEN(IBON,1)=0. LIEN(IBON,2)=0. LIEN(IBON,3)=0. LIEN(IBON,4)=0. ELSE DO J=IBON+1,ICOM TXCOM(J-1)=TXCOM(J) TYCOM(J-1)=TYCOM(J) COMMENT(J-1)=COMMENT(J) ICOUCO(J-1)=ICOUCO(J) LIEN(J-1,1)=LIEN(J,1) LIEN(J-1,2)=LIEN(J,2) LIEN(J-1,3)=LIEN(J,3) LIEN(J-1,4)=LIEN(J,4) ENDDO TXCOM(ICOM)=0. TYCOM(ICOM)=0. ICOUCO(ICOM)=0 COMMENT(ICOM)=' ' ICOM=ICOM - 1 * LIEN(ICOM,1)=0. * LIEN(ICOM,2)=0. * LIEN(ICOM,3)=0. * LIEN(ICOM,4)=0. ENDIF GOTO 6800 ENDIF ELSE GOTO 6800 ENDIF ENDIF GOTO 6800 ENDIF * DEPLACEMENT IF (ICOM.NE.0) THEN IF (ICLE6.EQ.3) THEN BUFFER0='Pointez commentaire' CALL TRMESS(BUFFER0) CALL TRDIG (TXXX,TYYY,INOUSE) CALL CHERCO (TXXX,TYYY,ICOM,AXE,IBON,COM) IF (IBON.NE.0) THEN BUFFER0='Nouvelle position ?' CALL TRMESS(BUFFER0) CALL TRDIG (TXXX,TYYY,INOUSE) TXCOM(IBON)=TXXX TYCOM(IBON)=TYYY GOTO 38 ENDIF GOTO 6800 ENDIF ENDIF *COULEUR IF (ICOM.NE.0) THEN IF (ICLE6.EQ.4) THEN BUFFER0='Pointez commentaire' CALL TRMESS(BUFFER0) CALL TRDIG (TXXX,TYYY,INOUSE) CALL CHERCO (TXXX,TYYY,ICOM,AXE,IBON,COM) IF (IBON.NE.0) THEN NUM=NBCOUL CALL TRGETC (NUM) ICOUCO(IBON) = NUM ENDIF GOTO 6800 ENDIF ENDIF * BERTIN: Creation d'un trait entre un commentaire et une zone * LIEN IF (ICOM.NE.0) THEN IF (ICLE6.EQ.5) THEN ZLIEN=.TRUE. BUFFER0='Pointez commentaire' CALL TRMESS(BUFFER0) CALL TRDIG (TXXX,TYYY,INOUSE) CALL CHERCO (TXXX,TYYY,ICOM,AXE,IBON,COM) LIEN(IBON,1)=TXCOM(IBON) LIEN(IBON,2)=TYCOM(IBON) IF (IBON.NE.0) THEN BUFFER0='Zone a annoter?' CALL TRMESS(BUFFER0) CALL TRDIG (TXXX,TYYY,INOUSE) LIEN(IBON,3)=TXXX LIEN(IBON,4)=TYYY LIEN(IBON,5)=1. TX(1)=LIEN(IBON,1) TY(1)=LIEN(IBON,2) TX(2)=LIEN(IBON,3) TY(2)=LIEN(IBON,4) CALL POLRL(2,TX,TY,tz) ENDIF GOTO 6800 ENDIF ENDIF * BERTIN: Fin creation lien commentaire * RETOUR GOTO 6800 **TC ENDIF 7659 continue * * RETOUR EVOLUTION SUIVANTE EN MODE SEPARE * IF (ZSEPAR) THEN PASSE = 0. HTLOG = 1. ICOLOG = IDCOUL ZLOGO = ZLOGOO IF (ICOM.NE.0) THEN DO JK=1,ICOM TXCOM(JK)=0. TYCOM(JK)=0. COMMENT(JK)=' ' ENDDO ICOM=0 ENDIF ZINDEX= .FALSE. GOTO 34 ENDIF GOTO 1000 * On limite la precision a 1e-30 pour les logarithmes 900 CALL ERREUR(434) GOTO 1000 * L'intervalle entre les bornes est trop faible. 950 CALL ERREUR (497) GOTO 1000 * IF (NHIST.NE.0) SEGSUP,MEVOLL * 1000 CONTINUE * SEGSUP AXE IF (OLDAXE.NE.0) SEGSUP OLDAXE SEGSUP COM IF (DYN.NE.0) SEGSUP DYN IF (CUR.NE.0) SEGSUP CUR * END