C TREVOL SOURCE BP208322 13/03/18 21:15:00 7722 SUBROUTINE TREVOL (IPTR1,IPTR2,CHAINE,TITOPT,ZLEGE,NCT,NLG,INBEVO & ,IPOSI,XPOSI,YPOSI) *============================================================= * Modifications : * * 95/02/07 Loca * passer les legendes x et y de 12 à 20 caractères: * SEGMENT AXE disparait et est appelé en include: -INC TMAXE. * * 2004 Maugis * Légendes à partir du haut, avec un espacement dépendant de leur nombre * Possibilité de ne pas écrire de légende pour une courbe donnée * * 05 sept. 2007 Maugis * Affichage de marqueurs aussi lorsqu'ils sont sur un bord * Maintien du segment AXE actif en modification * Mise du point en premier type de marqueur * Ajout de formes de marqueurs, dont 2 autres triangles TRIL et TRIR * pointant horizontalement, on garde pour compatibilité TRIA et TRIB, * qui peuvent maintenant être invoqués avec TRID et TRIU * respectivement. * Correction de tracé (ou absence de tracé) illicite avec REGU * avec marqueurs aux extrémités * *============================================================= * * Entrée : * * IPTR1 : POINTEUR SUR UN AXE (ACTIF) * IPTR2 : POINTEUR SUR UN KEVOLL * CHAINE : MOT CONTENANT LES OPTIONS SPECIFIQUES * ZLEGE : INDIQUE QUE L'ON EST EN MODE LEGENDE DES COURBES * NCT : NUMERO A AFFICHER SUR LA COURBE * NLG : NOMBRE DE LÉGENDES À AFFICHER AU TOTAL * INBEVO : NOMBRE TOTAL D'EVOLUTIONS * IPOSI position predefinie de la legende * XPOSI, YPOSI = position XY de la legende fourni par l utilisateur * *============================================================= * * TOUTES LES VARIABLES COMMENCANT PAR T SONT EN SIMPLE PRECISION ! * * MMT : MOT EXTRAIT DE CHAINE * ZREGU : REPERE ESPACE REGULIEREMENT * ZTIRET : TIRET ENTRE POINTS * ZNOLI : ABSENCE DE LIGNE ENTRE POINT * ZLABEL : ECRITURE D'EN LABEL * ZPLEIN : Le marqueur doit être rempli * LTAIL : TABLE des tailles * XTAIL : facteur multiplicatif de taille du marqueur * IEPAI : facteur multiplicatif (entier) de l'épaisseur des traits du marqueur * IMARQ : NUMERO DE LA FORME DU MARQUEUR (=0 <=> PAS DE MARQUEUR) * NMARQ : NOMBRE DE FORMES POSSIBLES DE MARQUEURS * LMARQ : TABLE DES MARQUEURS * NREGU : NOMBRE DE MARQUEURS PAR COURBE EN DISPOSITION REGULIERE * NLGMIN : NOMBRE MINIMAL DE LEGENDES * NLGMAX : NOMBRE MAXIMAL DE LEGENDES * INB : NOMBRE DE POINTS A TRAITER * *============================================================= IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-S,U-Y) C*? IMPLICIT REAL*4 (T) IMPLICIT LOGICAL (Z) * -INC SMEVOLL -INC SMLREEL -INC TMAXE -INC CCREEL -INC CCOPTIO -INC CCTRACE * EXTERNAL LONG PARAMETER (NREGU=8,NLGMIN=19,NLGMAX=30,NMARQ=15,NCLEF=9,NTAIL=7) REAL HMIN,TYYM REAL*8 IEPAI CHARACTER*72 CHAINE,CHVIDE CHARACTER*20 TITOPT CHARACTER*72 MLABEL CHARACTER*12 MMT,FMMT CHARACTER*4 LMARQ(NMARQ),LCLEF(NCLEF),LTAIL(NTAIL) CHARACTER CC DIMENSION TX(2),TY(2) DIMENSION TRX(6),TRY(6),TRZ(6) * on garde TRIA et TRIB pour compatibilité DATA LMARQ /'POIN','CROI','PLUS','ETOI','CARR','LOSA', & 'TRIA','TRIB','TRIL','TRIR','TRID','TRIU', & 'MOIN','BARR','ROND'/ DATA LCLEF /'REGU','NOLI','TIRR','TIRC','TIRL','TIRM','MARQ', & 'REMP','POIN'/ DATA LTAIL /'SS ','S ','M ','L ','XL ','XXL ','TAIL'/ * Valeurs par défaut ZREGU = .FALSE. ZNOLI = .FALSE. ZTIRET = .FALSE. KTIR = 0 ZLABEL = .FALSE. IMARQ = 0 ZPLEIN = .FALSE. XTAIL = 1.D0 IEPAI = 1.D0 CHVIDE(1:72)=' ' ZREMP = .FALSE. DO I=1,5 TRZ(I)=0. ENDDO IF (ICOSC.EQ.1) THEN ICOMBR=7 ELSE ICOMBR=8 ENDIF * * ==================================================================== * TRAITEMENT DES OPTIONS * ==================================================================== * IF (CHAINE(1:72).NE.CHVIDE(1:72)) THEN I=1 1 CONTINUE CALL EXTRAC (CHAINE,I,MMT) IF (MMT.NE.CHVIDE) THEN CALL PLACE(LCLEF,NCLEF,ICLEF,MMT(1:4)) * 'REGU' IF (ICLEF.EQ.1) ZREGU=.TRUE. * 'NOLI' IF (ICLEF.EQ.2) ZNOLI=.TRUE. * 'TIRR'/'TIRC'/'TIRL'/'TIRM' / 'POIN' IF (ICLEF.EQ.3) THEN ZTIRET=.TRUE. KTIR=1 ENDIF IF (ICLEF.EQ.4) THEN ZTIRET=.TRUE. KTIR=2 ENDIF IF (ICLEF.EQ.5) THEN ZTIRET=.TRUE. KTIR=3 ENDIF IF (ICLEF.EQ.6) THEN ZTIRET=.TRUE. KTIR=4 ENDIF IF (ICLEF.EQ.9) THEN ZTIRET=.TRUE. KTIR=5 ENDIF * 'MARQ' IF (ICLEF.EQ.7) THEN * La présence de ce mot-clef réinitialise les options de * marqueur, pour le cas de spécifications successives ZPLEIN = .FALSE. XTAIL = 1.D0 IEPAI = 1.D0 IMARQ = 0 20 CALL EXTRAC(CHAINE,I,MMT) * remplir le marqueur ? IF (MMT(1:4).EQ.'PLEI') THEN ZPLEIN = .TRUE. GOTO 20 ENDIF * taille du marqueur CALL PLACE(LTAIL,NTAIL,ITAIL,MMT(1:4)) * write(6,*) ' taille du marqueur ' , itail IF (ITAIL.NE.0) THEN IF (ITAIL.EQ.1) XTAIL = 0.25D0 IF (ITAIL.EQ.2) XTAIL = 0.50D0 IF (ITAIL.EQ.3) XTAIL = 1.00D0 IF (ITAIL.EQ.4) XTAIL = 1.25D0 IF (ITAIL.EQ.5) XTAIL = 1.75D0 IF (ITAIL.EQ.6) XTAIL = 2.50D0 IF (ITAIL.EQ.7) THEN ** spécification d'une taille arbitraire ** (la croix et la banière pour convertir en flottant!) * CALL EXTRAC(CHAINE,I,MMT) * LMMT = LONG(MMT) * WRITE(cc,FMT='(I1)') LMMT * FMMT = '(I'//cc//')' * READ(MMT,FMT=FMMT(1:4)) I1 * XTAIL = I1 ENDIF GOTO 20 ENDIF * épaisseur de ligne (entre 0 et 9) IF (MMT(1:4).EQ.'EPAI') THEN CALL EXTRAC(CHAINE,I,MMT) READ(MMT,FMT='(I1)') IEPAI GOTO 20 ENDIF * type de marqueur (en dernier) CALL PLACE(LMARQ,NMARQ,IMARQ,MMT(1:4)) * write(6,*) ' type du marqueur ' , imarq IF (IMARQ.EQ.0) THEN * On ne comprend pas le mot %m1:4 moterr(1:4) = MMT(1:4) CALL ERREUR(7) ENDIF ENDIF * 'REMP' IF (ICLEF.EQ.8) ZREMP=.TRUE. * 'LABEL' IF (MMT(1:4).EQ.'LABE') THEN ZLABEL=.TRUE. CALL EXTRAC(CHAINE,I,MLABEL) ENDIF IF (I.LE.72) GOTO 1 ENDIF ENDIF * AXE=IPTR1 KEVOLL=IPTR2 SEGACT KEVOLL MLREEL=IPROGX SEGACT MLREEL MLREE1=IPROGY SEGACT MLREE1 INB = PROG(/1) c Cas TRES particulier : IF (INB.LE.0) ZREGU = .FALSE. HMIN = .2 DXEVL = XSUP-XINF DYEVL = YSUP-YINF DL = DXEVL/100.D0 ZTRAC =.TRUE. YZERO = MIN(MAX(0.D0,YINF),YSUP) c IF (NUMEVY.EQ.'HIST') ZREMP=.TRUE. * * ==================================================================== * TRACE DE BASE * ==================================================================== * nlocab=numevx CALL CHCOUL(Nlocab) * * On rajoute cette étiquette pour gérer le fait que dans certains * cas (histogrammes par exemple), il faut tracer la totalité des * remplissages avant de tracer les segments, sinon ils seront * recouverts ZNOLI1=ZNOLI ZREMP1=ZREMP IF (.NOT.ZNOLI.AND.ZREMP) ZNOLI1=.TRUE. 30 CONTINUE cbp : on va faire le travail pour espacement REGU des marqueurs ici IF (ZREGU) THEN xlonx=(xsup-xinf)**2 xlony=(ysup-yinf)**2 xlong=0.d0 jg=inb-1 segini,MLREE2 ENDIF *==== BOUCLE SUR LES SEGMENTS ========================================= DO 4 i = 1,inb-1 * *-------CALCUL COORDONNEES (CORRIGEES SI LOG)------- c -recup X1=PROG(I) X2=PROG(I+1) Y1=MLREE1.PROG(I) Y2=MLREE1.PROG(I+1) c -coordonnee X IF (ZLOGX) THEN c on verifie qu'on n'a pas des infinis (si YBOR précisé par ex.) if(X1.le.0.D0.and.X2.le.0.d0) goto 4 if(X1.gt.0.D0) then TX(1) = LOG10(X1) else c cas segment horizontal avec 1er point infini TX(1) = XINF TY(1) = TY(2) endif if(X2.gt.0.D0) then TX(2) = LOG10(X2) else c cas segment horizontal avec 2eme point infini TX(2) = XINF TY(2) = TY(1) endif ELSE TX(1) = X1 TX(2) = X2 ENDIF c -coordonnee Y IF (ZLOGY) THEN c on verifie qu'on n'a pas des infinis (si YBOR précisé par ex.) c cas points 1 et 2 infinis => on saute car segment non défini if(Y1.le.0.D0.and.Y2.le.0.d0) goto 4 if(Y1.gt.0.D0) then TY(1) = LOG10(Y1) else c cas segment vertical avec 1er point infini TX(1) = TX(2) TY(1) = YINF endif if(Y2.gt.0.D0) then TY(2) = LOG10(Y2) else c cas segment vertical avec 2eme point infini TX(2) = TX(1) TY(2) = YINF endif ELSE TY(1) = Y1 TY(2) = Y2 ENDIF c write(6,*) 'i=',i,X1,Y1,' - ',X2,Y2 c write(6,*) '->',i,TX(1),TY(1),' - ',TX(2),TY(2) *-------CALCUL DES EXTREMA DE LA COURBE------- IF (I.EQ.1) THEN XMINT = TX(1) XMAXT = TX(1) YMINT = TY(1) YMAXT = TY(1) ENDIF xtx2=TX(2) yty2=ty(2) XMINT = MIN (XMINT,xtx2) XMAXT = MAX (XMAXT,xtx2) YMINT = MIN (YMINT,yTY2) YMAXT = MAX (YMAXT,yTY2) * *-------POUR CHAQUE SEGMENT : ON VERIFIE S'IL APPARAIT DANS LA FENETRE-- * * -SEGMENT HORS FENETRE ? * attention : il faut éventuellement le "remplir" quand même -> goto 41 * XMAX trop a gauche XMAX=MAX(TX(1),TX(2)) IF (XMAX.LT.XINF) GOTO 4 * XMIN trop a droite XMIN=MIN(TX(1),TX(2)) IF (XMIN.GT.XSUP) GOTO 4 * YMAX trop bas YMAX=MAX(TY(1),TY(2)) IF (YMAX.LT.YINF) GOTO 41 * YMIN trop haut YMIN=MIN(TY(1),TY(2)) IF (YMIN.GT.YSUP) GOTO 41 * * -EXTREMITE 1 DANS LA FENETRE ? IF((TX(1).GE.XINF).AND.(TX(1).LE.XSUP).AND. $ (TY(1).GE.YINF).AND.(TY(1).LE.YSUP)) GOTO 5 * * -EXTREMITE 2 DANS LA FENETRE ? IF((TX(2).GE.XINF).AND.(TX(2).LE.XSUP).AND. $ (TY(2).GE.YINF).AND.(TY(2).LE.YSUP)) GOTO 5 * * si on est là (et pas en 5), c'est qu' * -AUCUNE EXTREMITE DANS LA FENETRE MAIS SEGMENT SECANT * Cas segment vertical IF (TX(1).EQ.TX(2)) THEN IF ((TX(1).GT.XINF).AND.(TX(1).LT.XSUP)) THEN GOTO 5 ELSE GOTO 4 ENDIF ENDIF * Cas segment non vertical A = (TY(2)-TY(1)) / (TX(2)-TX(1)) IF (DABS(A).LT.1D-10) A=0.D0 Y = A * (XINF-TX(1))+TY(1) * Cas segment horizontal IF (A.EQ.0.D0) THEN IF ((Y.LT.YSUP) .AND. (Y.GT.YINF)) THEN GOTO 5 ELSE GOTO 41 ENDIF ENDIF IF ((Y.LT.YSUP) .AND. (Y.GT.YINF)) GOTO 5 Y=A*(XSUP-TX(1))+TY(1) IF ((Y.LT.YSUP) .AND. (Y.GT.YINF)) GOTO 5 X=TX(1)+(YINF-TY(1))/A IF ((X.LT.XSUP) .AND. (X.GT.XINF)) GOTO 5 X=TX(1)+(YSUP-TY(1))/A IF ((X.LT.XSUP) .AND. (X.GT.XINF)) GOTO 5 GOTO 41 *-------AU MOINS UN POINT DANS LA FENETRE------- 5 CONTINUE * Cas segment vertical IF (TX(1).EQ.TX(2)) THEN IF (TY(1).LT.YINF) TY(1)=YINF IF (TY(2).GT.YSUP) TY(2)=YSUP * Pas besoin de tracer le remplissage éventuel ! GOTO 51 ENDIF * (DBLE pour empecher une erreur de compilation sur certaines machines...) IF (ZREMP1) THEN TRX(1)=MIN(MAX(DBLE(TX(1)),XINF),XSUP) TRY(1)=MIN(MAX(DBLE(TY(1)),YINF),YSUP) TRX(2)=MIN(MAX(DBLE(TX(2)),XINF),XSUP) TRY(2)=MIN(MAX(DBLE(TY(2)),YINF),YSUP) ENDIF * * LINEARISE LE PREMIER POINT EN X IF (TX(1).LT.XINF) CALL LINEAX (TX,TY,XINF,1) IF (TX(1).GT.XSUP) CALL LINEAX (TX,TY,XSUP,1) * * LINEARISE LE PREMIER POINT EN Y IF (TY(1).LT.YINF) CALL LINEAX (TY,TX,YINF,1) IF (TY(1).GT.YSUP) CALL LINEAX (TY,TX,YSUP,1) * * LINEARISE LE SECOND POINT EN X IF (TX(2).LT.XINF) CALL LINEAX (TX,TY,XINF,2) IF (TX(2).GT.XSUP) CALL LINEAX (TX,TY,XSUP,2) * * LINEARISE LE SECOND POINT EN Y IF (TY(2).LT.YINF) CALL LINEAX (TY,TX,YINF,2) IF (TY(2).GT.YSUP) CALL LINEAX (TY,TX,YSUP,2) c write(6,*) 'lineax:',TX(1),TX(2),TY(1),TY(2) IF (ZREMP1) THEN NP=4 DO II=1,2 JJ=II+NP-4 IF (TX(II).NE.TRX(JJ).OR.TY(II).NE.TRY(JJ)) THEN NP=NP+1 TRX(NP-2)=TRX(NP-3) TRY(NP-2)=TRY(NP-3) TRX(NP-3)=TX(II) TRY(NP-3)=TY(II) ENDIF ENDDO TRX(NP-1)=TRX(NP-2) TRY(NP-1)=YZERO TRX(NP) =TRX(1) TRY(NP) =YZERO * tracé du remplissage CALL TRFACE(NP,TRX,TRY,TRZ,1.,NLOCAB,IEFF) ENDIF 51 CONTINUE IF (.NOT.ZNOLI1) THEN * tracé du segment IF (ZREMP) CALL CHCOUL(ICOMBR) CALL TRSEG (IPTR1,TX,TY,ZTIRET,KTIR,DL,ZTRAC) IF (ZREMP) CALL CHCOUL(NLOCAB) * Ni ligne, ni remplissage, ni marqueur => marqueur par défaut cbp : bizarre car non compatible avec REGU... => pour eviter de passer cbp ici, l utilisateur doit preciser ce qu'il veut (LIGN ou MARQ ...) ELSEIF (IMARQ.EQ.0.AND..NOT.ZREMP1) THEN * tracé du point + le 2e si dernier segment CALL DMARQ(IPTR1,TX(1),TY(1),1,1D0,.FALSE.,0) IF (I.EQ.(INB-1)) & CALL DMARQ(IPTR1,TX(2),TY(2),1,1D0,.FALSE.,0) ENDIF cbp : on calcule la longueur de la courbe xlong ici IF (ZREGU) THEN X2=(TX(2)-TX(1))**2 Y2=(TY(2)-TY(1))**2 xll=sqrt(X2/xlonx+Y2/xlony) xlong=xlong+sqrt(X2/xlonx+Y2/xlony) MLREE2.PROG(I)=xlong ENDIF GOTO 4 * LABEL 41 : *-----LE SEGMENT N'EST PAS DANS LA FENETRE, MAIS SON REMPLISSAGE PEUT Y ETRE 41 CONTINUE IF (ZREMP1) THEN TRX(1)=MIN(MAX(DBLE(TX(1)),XINF),XSUP) TRY(1)=MIN(MAX(DBLE(TY(1)),YINF),YSUP) TRX(2)=MIN(MAX(DBLE(TX(2)),XINF),XSUP) TRY(2)=MIN(MAX(DBLE(TY(2)),YINF),YSUP) * Finalement, le segment projete son remplissage hors de la fenetre... IF (TX(1).EQ.TX(2).AND.TY(1).EQ.TY(2)) GOTO 4 * ... ou alors le remplissage est d'epaisseur nulle IF (TRY(1).EQ.YZERO) GOTO 4 TRX(3)=TRX(2) TRY(3)=YZERO TRX(4)=TRX(1) TRY(4)=YZERO * tracé du remplissage CALL TRFACE(4,TRX,TRY,TRZ,1.,NLOCAB,IEFF) ENDIF 4 CONTINUE *==== FIN DE LA BOUCLE SUR LES SEGMENTS DE LA COURBE ================== IF (.NOT.ZNOLI.AND.ZREMP) THEN ZNOLI1=.NOT.ZNOLI1 ZREMP1=.NOT.ZREMP1 IF (.NOT.ZREMP1) GOTO 30 ENDIF * * ==================================================================== * TRACE DU NOM DE LA COURBE * ==================================================================== CALL LENCHA(NOMEVY,LC) IF (NUMEVY.EQ.'HIST'.AND.LC.GT.0) THEN TDELTX=ABS(XSUP-XINF)/45 TDELTY=ABS(YSUP-YINF)/45 BORX1=MAX(XINF,XMINT) BORX2=MIN(XSUP,XMAXT) BORY2=MIN(YSUP,YMAXT) TXX=0.5*(BORX1+BORX2) TYY=BORY2+TDELTY TXX2=TXX-0.125*TDELTX*LC TYY2=TYY+TDELTY CALL DMARQ (IPTR1,TXX,TYY,7,1D0,.FALSE.,NLOCAB) HMIN=0.2 CALL TRLABL(TXX2,TYY2,0.,NOMEVY,LC,HMIN) ENDIF * * ==================================================================== * TRACE DE MARQUEURS OU DE LABEL * ==================================================================== * * write(6,*)'iepai xtail zplein,nlocab',iepai,xtail,zplein,nlocab IF ((IMARQ.NE.0).OR.ZLABEL) THEN * * EN CHAQUE POINT * IF (.NOT. ZREGU) THEN DO 6 I=1,INB IF (ZLOGX) THEN TXX=LOG10(PROG(I)) ELSE TXX=PROG(I) ENDIF IF (ZLOGY) THEN TYY=LOG10(MLREE1.PROG(I)) ELSE TYY=MLREE1.PROG(I) ENDIF * tracé si à peu près dans fenêtre IF ((TXX-XINF.GE.-XZPREC*DXEVL) .AND. & (TXX-XSUP.LE. XZPREC*DXEVL) .AND. & (TYY-YINF.GE.-XZPREC*DYEVL) .AND. & (TYY-YSUP.LE. XZPREC*DYEVL)) THEN IF (ZLABEL) & CALL TRLABL(TXX,TYY,0.,MLABEL,72,HMIN) IF (IMARQ.NE.0) THEN CALL DMARQ(IPTR1,TXX,TYY,IMARQ,XTAIL, & ZPLEIN,NLOCAB) ENDIF ENDIF 6 CONTINUE ENDIF * * RÉGULIÈREMENT * * write(6,*) ' nregu' , nregu IF (ZREGU) THEN * * calcul de la longueur de la courbe xlong * cbp : fait + haut c xlonx=(xsup-xinf)**2 c xlony=(ysup-yinf)**2 c xlong=0.d0 c IF(ZLOGX) THEN c XX=LOG10(PROG(1)) c ELSE c XX=PROG(1) c ENDIF c IF(ZLOGY) THEN c YY=LOG10(MLREE1.PROG(1)) c ELSE c YY=MLREE1.PROG(1) c ENDIF c c on restreint les points de la courbe a l'intervalle borné c XX=MIN(xsup,MAX(xinf,XX)) c YY=MIN(ysup,MAX(yinf,YY)) c do iy=2,prog(/1) c IF(ZLOGX) THEN c X1=LOG10(PROG(iy)) c ELSE c X1=PROG(iy) c ENDIF c IF(ZLOGY) THEN c Y1=LOG10(MLREE1.PROG(iy)) c ELSE c Y1=MLREE1.PROG(iy) c ENDIF c c on restreint les points de la courbe a l'intervalle borné c X1=MIN(xsup,MAX(xinf,X1)) c Y1=MIN(ysup,MAX(yinf,Y1)) c X2=(X1-XX)**2 c XX=X1 c Y2=(Y1-YY)**2 c YY=Y1 c xll=sqrt(X2/xlonx+Y2/xlony) c c write(6,*) 'segment',iy,' ->',xll c xlong=xlong+sqrt(X2/xlonx+Y2/xlony) c enddo npart=nregu xlongp= xlong / npart c write(6,*) 'xinf,xsup,yinf,ysup=',xinf,xsup,yinf,ysup c write(6,*) 'xlong,nregu,xlongp=',xlong,nregu,xlongp * * tracé des marqueurs régulièrement espacés * xmar=xlongp/2.d0 xdes=xlongp/10. xloo= 0.D0 c IF (ZLOGX) THEN c XX = LOG10(PROG(1)) c ELSE c XX = PROG(1) c ENDIF c IF (ZLOGY) THEN c YY = LOG10(MLREE1.PROG(1)) c ELSE c YY = MLREE1.PROG(1) c ENDIF c c on restreint les points de la courbe a l'intervalle borné c XX=MIN(xsup,MAX(xinf,XX)) c YY=MIN(ysup,MAX(yinf,YY)) do iy=2,prog(/1) IF(ZLOGX) THEN X1=LOG10(PROG(iy)) ELSE X1=PROG(iy) ENDIF IF(ZLOGY) THEN Y1=LOG10(MLREE1.PROG(iy)) ELSE Y1=MLREE1.PROG(iy) ENDIF TXX=X1 TYY=Y1 c c on restreint les points de la courbe a l'intervalle borné c c pour le calcul de la longueur xloo c X1=MIN(xsup,MAX(xinf,X1)) c Y1=MIN(ysup,MAX(yinf,Y1)) c X2=(X1-XX)**2 c XX=X1 c Y2=(Y1-YY)**2 c YY=Y1 c xloo=xloo+sqrt ( x2/xlonx+y2/xlony) xloo=MLREE2.PROG(iy-1) * tracé si on a cumulé une longueur xmar if(xloo.gt.xmar)then * et si à peu près dans fenêtre IF ((TXX-XINF.GE.-XZPREC*DXEVL) .AND. & (TXX-XSUP.LE. XZPREC*DXEVL) .AND. & (TYY-YINF.GE.-XZPREC*DYEVL) .AND. & (TYY-YSUP.LE. XZPREC*DYEVL)) THEN IF (ZLABEL) & CALL TRLABL(TXX,TYY,0.,MLABEL,72,HMIN) IF (IMARQ.NE.0) THEN CALL DMARQ(IPTR1,TXX,TYY,IMARQ,XTAIL, & ZPLEIN,NLOCAB) ENDIF ENDIF 999 continue xmar=xmar+xlongp c si on a deja depassé xmar+xdes il faut aller chercher + loin if(xloo.gt.xmar+xdes) then c write(ioimp,*) ' on saute un point' go to 999 endif endif enddo segsup,MLREE2 ENDIF * fin du cas RÉGULIÈREMENT * * 9 CONTINUE ENDIF * * ==================================================================== * TRACÉ DE LA LÉGENDE AUPRÈS D'UN ÉCHANTILLON DE LIGNE * ==================================================================== * IF (ZLEGE.AND.(TITOPT(1:20).NE.'PAS DE LEGENDE')) THEN * on positionne la legende par rapport XPOS1 YPOS1 * definis en fonction de IPOSI * position X pour les cas NO et SO if(IPOSI.eq.1.or.IPOSI.eq.3) then XPOS1 = XINF + (.06*BG) BREF = 4.*BG endif * position X pour les cas NE et SE if(IPOSI.eq.2.or.IPOSI.eq.4) then c rem BP: On positionne pour etre OK avec la police de la sortie PS c et tant pis pour l ecran (par defaut opti poli '8_BY_13';) if(ZCARRE) then BREF = 0.72*BD else BREF = 4.*BD endif if(IOPOTR.le.3) then XPOS1 = XSUP - (0.95*BREF) elseif(IOPOTR.le.6) then XPOS1 = XSUP - (1.05*BREF) elseif(IOPOTR.le.9) then XPOS1 = XSUP - (1.15*BREF) else XPOS1 = XSUP - (1.25*BREF) endif endif * position X pour le cas EXT if(IPOSI.eq.5) then XPOS1 = XSUP BREF = BD endif * position XPOSI fourni par l utilisateur if(IPOSI.eq.6) then IF(ZLOGX) THEN XPOS1 = LOG10(XPOSI) ELSE XPOS1 = XPOSI ENDIF BREF = 4.*BG endif * Le nb total de légendes à afficher, ici majoré par le nb de courbes, * est compris entre NLGMIN et NLGMAX * Première légende en haut NNLG = MAX(NLGMIN,MIN(INBEVO,NLGMAX)) c write(6,*) 'NLGMIN,MAX,INBEVO,NNLG=',NLGMIN,NLGMAX,INBEVO,NNLG HAUT = 1. IF (NLG.LT.NLGMAX) THEN * on incrémente les compteurs de courbes avec legende NCT = NCT + 1 NLG = NLG + 1 * position Y pour les cas NO et NE if(IPOSI.le.2) then TYY = YSUP + ((1.D0-NLG)*(DYEVL/NNLG)) & - (.05*DYEVL) * position Y pour les cas SO, SE elseif(IPOSI.le.4) then TYY = YINF + ((NLG-1.D0)*(DYEVL/NNLG)) & + (.05*DYEVL) * position YPOSI fourni par l utilisateur elseif(IPOSI.eq.6) then IF(ZLOGY) THEN YPOS1 = LOG10(YPOSI) ELSE YPOS1 = YPOSI ENDIF TYY = YPOS1 + ((1.D0-NLG)*(DYEVL/NNLG)) & - (.03*DYEVL) * position Y pour le cas t EXT else TYY = YINF + ((NLG-1.D0)*(DYEVL/NNLG)) & + (.03*DYEVL) cbp : contrairement a ce qui est ecrit la 1ere legende est en bas ! c TYY = YINF + ((NNLG-NLG)*(DYEVL/NNLG)) c & + (.03*DYEVL) endif * un petit bout de remplissage éventuellement TDY=0. IF (ZREMP) THEN TDY=.01*DYEVL TRX(1)= XPOS1 + (.06*BREF) TRY(1)= TYY - TDY TRX(2)= XPOS1 + (.30*BREF) TRY(2)= TYY - TDY TRX(3)= XPOS1 + (.30*BREF) TRY(3)= TYY + TDY TRX(4)= XPOS1 + (.06*BREF) TRY(4)= TYY + TDY CALL TRFACE(4,TRX,TRY,TRZ,1.,NLOCAB,IEFF) ENDIF * un petit bout de ligne éventuellement IF (.NOT. ZNOLI) THEN TX(1)= XPOS1 + (.06*BREF) TX(2)= XPOS1 + (.30*BREF) TY(1)= TYY + TDY TY(2)= TYY + TDY IF (ZREMP) CALL CHCOUL(ICOMBR) CALL TRSEG (IPTR1,TX,TY,ZTIRET,KTIR,DL,ZTRAC) IF (ZREMP) CALL CHCOUL(NLOCAB) ENDIF * le marqueur/label éventuel IF ((IMARQ.NE.0).OR.ZLABEL.OR.(ZNOLI.AND..NOT.ZREMP)) THEN TXX = XPOS1 + (.18*BREF) TYY2 = TYY + TDY IF (IMARQ.EQ.0) THEN IMARQ=1 IEPAI=1 XTAIL=1D0 ZPLEIN=.FALSE. ENDIF IF (ZLABEL) CALL TRLABL(TXX,TYY2,0.,MLABEL,72,HMIN) CALL DMARQ(IPTR1,TXX,TYY2,IMARQ,XTAIL,ZPLEIN,NLOCAB) ENDIF * et le texte, un poil plus bas TXX2 = XPOS1 + (.33*BREF) TYY2 = TYY - (.01*DYEVL) CALL TRLABL (TXX2,TYY2,0.,TITOPT(1:20),20,HMIN) ENDIF ENDIF * SEGDES MLREE1,MLREEL,KEVOLL * END