C DAXES SOURCE SP204843 23/07/28 21:15:03 11712 SUBROUTINE DAXES (IPTR,ZAXES,IGRIL) * *============================================================= * 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. * * 05 sept. 2007 Maugis * Maintien du segment AXE actif en modification * *============================================================= * * Entrée : * * IPTR : POINTEUR SUR UN AXE (ACTIF) * ZAXES : LOGIQUE INDIQUANT DE TRACER LES AXES * *============================================================= * * 1. TOUTES LES VARIABLES COMMENCANT PAR T SONT EN SIMPLE PRECISION ! * 2. PM: bien qu'aucune de ses variables ne soient modifiées, le * segment AXE est tout de même ouvert en modification (?) * *============================================================= IMPLICIT LOGICAL(Z) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-S,U-Y) REAL HMIN -INC PPARAM -INC CCOPTIO -INC CCTRACE -INC TMAXE EXTERNAL LONG CHARACTER*30 BUFFER DIMENSION TX(5),TY(5),TZ(5),TX2(2),TY2(2),TZ2(2) LOGICAL ZTIRET,ZTRAC,ZDEC1,ZDEC2 *============================================================= * INITIALISATIONS *============================================================= do ii=1,5 tz(ii)=0.0 enddo do ii=1,2 tz2(ii)=0.0 enddo AXE=IPTR SEGACT AXE*MOD HMIN=.2 *============================================================= * TRACE DES AXES + GRADUATIONS *============================================================= * TRACE DES AXES ============================================ * (CADRE DEFINI PAR XINF XSUP YINF YSUP) * couleurs definies dans bdata : 0:defaut 7:blanc 8:noir 16:gris IF (ICOSC.EQ.2.OR.ICOSC.EQ.3) THEN icoul0=8 ELSE icoul0=0 ENDIF CALL CHCOUL(icoul0) TX(1)=REAL(XINF) TY(1)=REAL(YINF) TX(2)=REAL(XINF) TY(2)=REAL(YSUP) TX(3)=REAL(XSUP) TY(3)=REAL(YSUP) TX(4)=REAL(XSUP) TY(4)=REAL(YINF) TX(5)=REAL(XINF) TY(5)=REAL(YINF) CALL POLRL(5,TX,TY,tz) * * TRACE DES GRADUATIONS SUR L'AXE X ======================== * TRACE DES GRADUATIONS PRINCIPALES TDELTY=REAL(ABS(YSUP-YINF))/75. TX(1) =REAL(XINF) TY(1) =REAL(YINF) TY(2) =REAL(YINF)+TDELTY TY2(1)=REAL(YSUP) TY2(2)=REAL(YSUP)-TDELTY DO 1 I=2,INX+1 TX(1)=TX(1)+REAL(XINT) IF ((TX(1)+0.001*REAL(XINT)).GE.XSUP) GOTO 1 TX(2)=TX(1) CALL POLRL(2,TX,TY2,tz) CALL POLRL(2,TX,TY,tz) 1 CONTINUE * TRACE DES GRADUATIONS NON LINEAIRES SI AXE X EN LOG c IF (ZLOGX) THEN IF (ZLOGX .and. INX.le.20) THEN DO 2 J=2,8,2 TX(1) =REAL(XINF)+LOG10(REAL(J))*XINT TY(1) =REAL(YINF) TY(2) =REAL(YINF)+TDELTY TY2(1)=REAL(YSUP) TY2(2)=REAL(YSUP)-TDELTY DO 3 I=1,INX TX(2)=TX(1) CALL POLRL(2,TX,TY2,tz) CALL POLRL(2,TX,TY,tz) TX(1)=TX(1)+REAL(XINT) 3 CONTINUE 2 CONTINUE ENDIF * * TRACE DES GRADUATIONS SUR L'AXE Y ======================== * * TRACE DES GRADUATIONS PRINCIPALES TDELTX=REAL(ABS(XSUP-XINF))/70. TY(1) =REAL(YINF) TX(1) =REAL(XINF) TX(2) =REAL(XINF)+TDELTX TX2(1)=REAL(XSUP) TX2(2)=REAL(XSUP)-TDELTX DO 4 I=2,INY+1 TY(1)=TY(1)+REAL(YINT) IF ((TY(1)+0.001*REAL(YINT)).GE.YSUP) GOTO 4 TY(2)=TY(1) CALL POLRL(2,TX2,TY,tz) CALL POLRL(2,TX,TY,tz) 4 CONTINUE * * TRACE DES GRADUATIONS NON LINEAIRES SI AXE Y EN LOG c IF (ZLOGY) THEN IF (ZLOGY .and. INY.le.20) THEN DO 5 J=2,8,2 TY(1) =REAL(YINF)+LOG10(REAL(J))*YINT TX(1) =REAL(XINF) TX(2) =REAL(XINF)+TDELTX TX2(1)=REAL(XSUP) TX2(2)=REAL(XSUP)-TDELTX DO 6 I=1,INY TY(2)=TY(1) CALL POLRL(2,TX2,TY,tz) CALL POLRL(2,TX,TY,tz) TY(1)=TY(1)+YINT 6 CONTINUE 5 CONTINUE ENDIF *============================================================= * ECRITURE DES XLABEL ET YLABEL (TITX et TITY) *============================================================= * J'UTILISE DES COPIES DANS BUFFER CAR AVEC LES APPELS AVEC TITREX * TITREY SINON EN TATB SUR LE CRAY JE PAUME UNE LEGENDE EN Y * c TITX =============================== c ANGLE=0.d0 c IALIGN=IPOSX cbp : on utilise le tableau INFOTR de l include CCTRACE INFOTR(1)=0 INFOTR(2)=IPOSX cbp2015-10 IF(IPOSX.eq.2) THEN IF(IPOSX.ne.1) THEN TXX=REAL(.5*(XSUP+XINF)) ELSE cbp on va se mettre avant l eventuel x10^{} de l'axe X c + on recule du nombre de caractere (on ne tient pas compte de la c police utilisee !!!) IF(ZCARRE) THEN TXX=REAL(XSUP)-(.017*(XSUP-XINF)*REAL(LONG(TITREX)+3)) ELSE TXX=REAL(XSUP)-(.011*(XSUP-XINF)*REAL(LONG(TITREX)+3)) ENDIF ENDIF IF(ZLOGX) THEN TYY=REAL(YINF)-.12*(YSUP-YINF) ELSE TYY=REAL(YINF)-.10*(YSUP-YINF) ENDIF BUFFER(1:20)=TITREX(1:20) CALL TRLABL(TXX,TYY,0.,BUFFER(1:20),20,HMIN) c TITY =============================== c IALIGN=IPOSY INFOTR(1)=0 INFOTR(2)=IPOSY cbp2015-10 IF(IPOSY.eq.2) THEN IF(IPOSY.ne.1) THEN TXX=REAL(XINF)-(0.99*BG) TYY=REAL(0.5*(YSUP+YINF)) c ANGLE=90.d0 INFOTR(1)=90 ELSE TXX=REAL(XINF)-.01*(XSUP-XINF) TYY=REAL(YSUP)+.05*(YSUP-YINF) ENDIF BUFFER(1:20)=TITREY(1:20) CALL TRLABL(TXX,TYY,0.,BUFFER(1:20),20,HMIN) cbp : je n'ai pas compris le 0. ci-dessus; dans le doute je le laisse ... c on remet tout a 0 c ANGLE=0.d0 c IALIGN=0 INFOTR(1)=0 INFOTR(2)=0 *============================================================= * ECRITURE DES VALEURS DE GRADUATION SUR LES AXE *============================================================= *------------------------------------------------------------- * ECRITURE DES VALEURS DE GRADUATION SUR AXE X EN LINEAIRE *------------------------------------------------------------- IF (.NOT.ZLOGX) THEN * CALL LENCHA(MXFMT,LMX) IF (LMX.gt.2) THEN READ(MXFMT(3:3),FMT='(I1)',IOSTAT=IOS) LFIN IF (MXFMT(2:2).eq.'I') THEN IP=0 ELSE IP=ICALP(XINF,XSUP) ENDIF ELSE IP=ICALP(XINF,XSUP) ENDIF * * Combien de decimales utilise t'on (pour toutes les graduations)? GRAD=XINF ZDEC2=.true. ZDEC1=.true. DO I=1,INX+1 CH=GRAD/10.D0**FLOAT(IP) * on commence par arrondir CH = DBLE(NINT(100000.D0*CH))/100000.D0 * les 2 premieres decimales de CH sont elles nulles (<=>KCH2=0)? * on l'ecrit comme un INTEGER KCH2=INT(100.D0*(CH-DBLE(INT(CH)))) IF(KCH2.NE.0) ZDEC2=.false. * la 1 premieres decimales de CH est elle nulle (<=>KCH1=0)? KCH1=KCH2-10*INT(10.D0*(CH-DBLE(INT(CH)))) IF(KCH1.NE.0) ZDEC1=.false. GRAD=GRAD+XINT ENDDO * * INITIALISATION DES VALEURS POUR LE TRACE * GRAD=XINF c TXX=REAL(XINF)-(.35*BG) c TXX=REAL(XINF)-(0.55*BG) c on se met au centre et on l'indique a INFOTR(2) TXX=REAL(XINF) TYY=REAL(YINF)-(.3*BB) INFOTR(2)=2 * * BOUCLE POUR CHAQUE PAS * DO 7 I=1,INX+1 CH=GRAD/10.D0**FLOAT(IP) *bp, 2015/12/08: on commence par arrondir pour eviter pb avec des 9.9999 CH = DBLE(NINT(100000.D0*CH))/100000.D0 * FORMATTAGE DES VALEURS DE GRADUATION BUFFER(1:10)=' ' * -cas format impose IF((LMX.gt.2).and.(MXFMT(1:1).EQ.'(')) THEN IF(CH.GE.0.D0.AND.CH.LT.10.D0) THEN IDEB=2 ELSE IDEB=1 ENDIF IFIN = IDEB+LFIN-1 IF(MXFMT(2:2).eq.'I') THEN WRITE (BUFFER(IDEB:IFIN),FMT=MXFMT(1:LMX)) INT(CH) ELSE WRITE (BUFFER(IDEB:IFIN),FMT=MXFMT(1:LMX)) CH ENDIF * -cas format automatique * -cas format automatique et pas d'exposant * depuis modif de icalp, il peut y avoir jusqu'a 4 chiffres ELSE c write(*,*) 'X:',I,ZDEC2,ZDEC1,CH,(CH.LE.-10.D0) IF(ZDEC2) THEN IF (CH.LE.-1000.D0) THEN WRITE (BUFFER(1:9),FMT='(I5)') NINT(CH) ELSEIF (CH.GT.-1000.D0.AND.CH.LE.-100.D0) THEN WRITE (BUFFER(1:9),FMT='(I4)') NINT(CH) ELSEIF (CH.GT.-100.D0.AND.CH.LE.-10.D0) THEN WRITE (BUFFER(1:9),FMT='(I3)') NINT(CH) ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN WRITE (BUFFER(1:9),FMT='(I2)') NINT(CH) ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN WRITE (BUFFER(1:9),FMT='(I1)') NINT(CH) ELSEIF (CH.GE.10.D0.AND.CH.LT.100.D0) THEN WRITE (BUFFER(1:9),FMT='(I2)') NINT(CH) ELSEIF (CH.GE.100.D0.AND.CH.LT.1000.D0) THEN WRITE (BUFFER(1:9),FMT='(I3)') NINT(CH) ELSEIF (CH.GE.1000.D0) THEN WRITE (BUFFER(1:9),FMT='(I4)') NINT(CH) ENDIF ELSEIF(ZDEC1) THEN IF (CH.LE.-1000.D0) THEN WRITE (BUFFER(1:9),FMT='(F7.1)') CH ELSEIF (CH.GT.-1000.D0.AND.CH.LE.-100.D0) THEN WRITE (BUFFER(1:9),FMT='(F6.1)') CH ELSEIF (CH.GT.-100.D0.AND.CH.LE.-10.D0) THEN WRITE (BUFFER(1:9),FMT='(F5.1)') CH ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN WRITE (BUFFER(1:9),FMT='(F4.1)') CH ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN WRITE (BUFFER(1:9),FMT='(F3.1)') CH ELSEIF (CH.GE.10.D0.AND.CH.LT.100.D0) THEN WRITE (BUFFER(1:9),FMT='(F4.1)') CH ELSEIF (CH.GE.100.D0.AND.CH.LT.1000.D0) THEN WRITE (BUFFER(1:9),FMT='(F5.1)') CH ELSEIF (CH.GE.1000.D0) THEN WRITE (BUFFER(1:9),FMT='(F6.1)') CH ENDIF ELSE IF (CH.LE.-1000.D0) THEN WRITE (BUFFER(1:9),FMT='(F8.2)') CH ELSEIF (CH.GT.-1000.D0.AND.CH.LE.-100.D0) THEN WRITE (BUFFER(1:9),FMT='(F7.2)') CH ELSEIF (CH.GT.-100.D0.AND.CH.LE.-10.D0) THEN WRITE (BUFFER(1:9),FMT='(F6.2)') CH ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN WRITE (BUFFER(1:9),FMT='(F5.2)') CH ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN WRITE (BUFFER(1:9),FMT='(F4.2)') CH ELSEIF (CH.GE.10.D0.AND.CH.LT.100.D0) THEN WRITE (BUFFER(1:9),FMT='(F5.2)') CH ELSEIF (CH.GE.100.D0.AND.CH.LT.1000.D0) THEN WRITE (BUFFER(1:9),FMT='(F6.2)') CH ELSEIF (CH.GE.1000.D0) THEN WRITE (BUFFER(1:9),FMT='(F7.2)') CH ENDIF ENDIF ENDIF * ECRITURE DE LA GRADUATION CALL TRLABL (TXX,TYY,0.,BUFFER(1:9),9,HMIN) TXX=TXX+REAL(XINT) GRAD=GRAD+XINT 7 CONTINUE INFOTR(2)=0 * * ECRITURE DE P APRES FORMATTAGE * IF (IP.NE.0) THEN c BUFFER(1:10)='x1.E ' c ideb=4 BUFFER(1:10)='x10^{ ' ideb=6 IF (IP.LE.-10) THEN ideb2=ideb+3 WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN ideb2=ideb+2 WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN ideb2=ideb+1 WRITE (BUFFER(ideb:ideb),FMT='(I1)') IP ELSEIF (IP.GE.10) THEN ideb2=ideb+2 WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP ENDIF BUFFER(ideb2:ideb2)='}' TXX=REAL(XINF)-(.35*BG) TYY=REAL(YINF-.10*(YSUP-YINF)) if(ZCARRE) then TXX=REAL(XSUP)-(.015*(XSUP-XINF)) else TXX=REAL(XSUP)-(.010*(XSUP-XINF)) endif CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN) ENDIF *------------------------------------------------------------- * ECRITURE DES VALEURS DE GRADUATION SUR AXE X EN LOG *------------------------------------------------------------- ELSE GRAD=XINF c TXX=REAL(XINF)-(BG/4.) c TXX=REAL(XINF)-((BG+BD)/8.) c TXX=REAL(XINF)-(0.15*BG) TXX=REAL(XINF)-(0.10*BG) c TYY=REAL(YINF)-.06*(YSUP-YINF) TYY=REAL(YINF)-.07*(YSUP-YINF) DO 8 I=1,INX+1 IP=INT(GRAD) c BUFFER(1:6)='1.E ' c ideb=4 BUFFER(1:10)='10^{ ' ideb=5 IF (IP.LE.-100) THEN ideb2=ideb+4 WRITE (BUFFER(ideb:ideb+3),FMT='(I4)') IP ELSEIF (IP.GT.-100 .AND. IP.LE.-10) THEN ideb2=ideb+3 WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN ideb2=ideb+2 WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN ideb2=ideb+1 WRITE (BUFFER(ideb:ideb) ,FMT='(I1)') IP ELSEIF (IP.GE.10 .AND. IP.LT.100) THEN ideb2=ideb+2 WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP ELSEIF (IP.GE.100) THEN ideb2=ideb+3 WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP ENDIF BUFFER(ideb2:ideb2)='}' CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN) TXX=TXX+XINT GRAD=GRAD+XINT 8 CONTINUE * IF ((XSUP-XINF) .LE. 9.D0) THEN * ECRITURE DES VALEURS DE SOUS-GRADUATION SUR AXE X EN LOG * UNIQUEMENT SI LA GAMME EST SUR MOINS DE 9 DECADS DO 9 J=1,7,2 IF (J.EQ.1) THEN TXX=REAL(XINF) ELSE TXX=REAL(XINF)+LOG10(REAL(J)-1.0) ENDIF TXX=TXX - 0.07*REAL(BG) TYY=REAL(YINF)-(0.25*BB) DO 10 I=1,INX JJ=1 IF (J.GT.1) JJ=J-1 WRITE (BUFFER(1:1),FMT='(I1)') JJ CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN) TXX=TXX+REAL(XINT) IF ((I.EQ.INX).AND.(J.EQ.1)) THEN JJ=1 WRITE (BUFFER(1:1),FMT='(I1)') JJ CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN) ENDIF 10 CONTINUE 9 CONTINUE ENDIF ENDIF *------------------------------------------------------------- * ECRITURE DES VALEURS DE GRADUATION SUR AXE Y EN LINEAIRE *------------------------------------------------------------- IF (.NOT.ZLOGY) THEN * CALL LENCHA(MYFMT,LMY) IF (LMY.gt.2) THEN READ(MYFMT(3:3),FMT='(I1)',IOSTAT=IOS) LFIN IF (MYFMT(2:2).eq.'I') THEN IP=0 ELSE IP=ICALP(YINF,YSUP) ENDIF ELSE IP=ICALP(YINF,YSUP) ENDIF * * Combien de decimales utilise t'on (pour toutes les graduations)? GRAD=YINF ZDEC2=.true. ZDEC1=.true. DO I=1,INY+1 CH=GRAD/10.D0**FLOAT(IP) * on commence par arrondir CH = DBLE(NINT(100000.D0*CH))/100000.D0 * les 2 premieres decimales de CH sont elles nulles (<=>KCH2=0)? * on l'ecrit comme un INTEGER KCH2=INT(100.D0*(CH-DBLE(INT(CH)))) IF(KCH2.NE.0) ZDEC2=.false. * la 1 premieres decimales de CH est elle nulle (<=>KCH1=0)? KCH1=KCH2-10*INT(10.D0*(CH-DBLE(INT(CH)))) IF(KCH1.NE.0) ZDEC1=.false. GRAD=GRAD+YINT ENDDO * * INITIALISATION DES VALEURS POUR LE TRACE * GRAD=YINF TYY=REAL(YINF) c si postscript, on se decale de l'axe de maniere a arriver a ras c + on indique qu on veut etre aligne a droite IF (IOGRA.ge.7.and.IOGRA.le.9) then TXX=REAL(XINF)-(BG*0.10) INFOTR(2)=3 else c si pas postscript, on se decale de l'axe de maniere approximative TXX=REAL(XINF)-(BG*0.9) endif * * BOUCLE POUR CHAQUE PAS * DO 11 I=1,INY+1 CH=GRAD/10.D0**FLOAT(IP) *bp, 2015/12/08: on commence par arrondir pour eviter pb avec des 9.9999 CH = DBLE(NINT(100000.D0*CH))/100000.D0 * FORMATTAGE DES VALEURS DE GRADUATION BUFFER(1:10)=' ' * -cas format impose IF((LMY.gt.2).and.(MYFMT(1:1).EQ.'(')) THEN IF(CH.GE.0.D0.AND.CH.LT.10.D0) THEN IDEB=2 ELSE IDEB=1 ENDIF IFIN = IDEB+LFIN-1 IF(MYFMT(2:2).eq.'I') THEN WRITE (BUFFER(IDEB:IFIN),FMT=MYFMT(1:LMY)) INT(CH) ELSE WRITE (BUFFER(IDEB:IFIN),FMT=MYFMT(1:LMY)) CH ENDIF * -cas format automatique ELSE c write(*,*) 'Y:',I,ZDEC2,ZDEC1,CH,(CH.LE.-10.D0) IF(ZDEC2) THEN IF (CH.LE.-1000.D0) THEN WRITE (BUFFER(1:9),FMT='(I5)') NINT(CH) ELSEIF (CH.GT.-1000.D0.AND.CH.LE.-100.D0) THEN WRITE (BUFFER(1:9),FMT='(I4)') NINT(CH) ELSEIF (CH.GT.-100.D0.AND.CH.LE.-10.D0) THEN WRITE (BUFFER(1:9),FMT='(I3)') NINT(CH) ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN WRITE (BUFFER(1:9),FMT='(I2)') NINT(CH) ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN WRITE (BUFFER(1:9),FMT='(I1)') NINT(CH) ELSEIF (CH.GE.10.D0.AND.CH.LT.100.D0) THEN WRITE (BUFFER(1:9),FMT='(I2)') NINT(CH) ELSEIF (CH.GE.100.D0.AND.CH.LT.1000.D0) THEN WRITE (BUFFER(1:9),FMT='(I3)') NINT(CH) ELSEIF (CH.GE.1000.D0) THEN WRITE (BUFFER(1:9),FMT='(I4)') NINT(CH) ENDIF ELSEIF(ZDEC1) THEN IF (CH.LE.-1000.D0) THEN WRITE (BUFFER(1:9),FMT='(F7.1)') CH ELSEIF (CH.GT.-1000.D0.AND.CH.LE.-100.D0) THEN WRITE (BUFFER(1:9),FMT='(F6.1)') CH ELSEIF (CH.GT.-100.D0.AND.CH.LE.-10.D0) THEN WRITE (BUFFER(1:9),FMT='(F5.1)') CH ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN WRITE (BUFFER(1:9),FMT='(F4.1)') CH ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN WRITE (BUFFER(1:9),FMT='(F3.1)') CH ELSEIF (CH.GE.10.D0.AND.CH.LT.100.D0) THEN WRITE (BUFFER(1:9),FMT='(F4.1)') CH ELSEIF (CH.GE.100.D0.AND.CH.LT.1000.D0) THEN WRITE (BUFFER(1:9),FMT='(F5.1)') CH ELSEIF (CH.GE.1000.D0) THEN WRITE (BUFFER(1:9),FMT='(F6.1)') CH ENDIF ELSE IF (CH.LE.-1000.D0) THEN WRITE (BUFFER(1:9),FMT='(F8.2)') CH ELSEIF (CH.GT.-1000.D0.AND.CH.LE.-100.D0) THEN WRITE (BUFFER(1:9),FMT='(F7.2)') CH ELSEIF (CH.GT.-100.D0.AND.CH.LE.-10.D0) THEN WRITE (BUFFER(1:9),FMT='(F6.2)') CH ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN WRITE (BUFFER(1:9),FMT='(F5.2)') CH ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN WRITE (BUFFER(1:9),FMT='(F4.2)') CH ELSEIF (CH.GE.10.D0.AND.CH.LT.100.D0) THEN WRITE (BUFFER(1:9),FMT='(F5.2)') CH ELSEIF (CH.GE.100.D0.AND.CH.LT.1000.D0) THEN WRITE (BUFFER(1:9),FMT='(F6.2)') CH ELSEIF (CH.GE.1000.D0) THEN WRITE (BUFFER(1:9),FMT='(F7.2)') CH ENDIF ENDIF ENDIF * ECRITURE DE LA GRADUATION CALL TRLABL (TXX,TYY,0.,BUFFER(1:9),9,HMIN) TYY=TYY+REAL(YINT) GRAD=GRAD+YINT 11 CONTINUE INFOTR(2)=0 * * ECRITURE APRES FORMATTAGE DE P * IF (IP.NE.0) THEN c BUFFER(1:10)='x1.E ' c ideb=5 BUFFER(1:10)='x10^{ ' ideb=6 IF (IP.LE.-10) THEN ideb2=ideb+3 WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN ideb2=ideb+2 WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN ideb2=ideb+1 WRITE (BUFFER(ideb:ideb),FMT='(I1)') IP ELSEIF (IP.GE.10) THEN ideb2=ideb+2 WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP ENDIF BUFFER(ideb2:ideb2)='}' TXX=REAL(XINF)-(BG*0.9) TYY=REAL((YSUP)+.05*(YSUP-YINF)) CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN) ENDIF * *------------------------------------------------------------- * ECRITURE DES VALEURS DE GRADUATION SUR AXE Y EN LOG *------------------------------------------------------------- ELSE GRAD=YINF c TXX=REAL(XINF)-(BG*0.99) c TXX=REAL(XINF)-(BG*0.8) IF ((YSUP-YINF).LE.6.D0) THEN TXX=REAL(XINF)-(BG*0.82) ELSE TXX=REAL(XINF)-(BG*0.77) ENDIF TYY=REAL(YINF) DO 12 I=1,INY+1 cbpessai * on saute 1 sur 2 si plus de 20 cbpessai if(INY.LE.20.or.MOD(I,2).ne.0) then IP=INT(GRAD) c BUFFER(1:3)='1.E' c ideb=4 BUFFER(1:10)='10^{ ' ideb=5 IF (IP.LE.-100) THEN ideb2=ideb+4 WRITE (BUFFER(ideb:ideb+3),FMT='(I4)') IP ELSEIF (IP.GT.-100 .AND. IP.LE.-10) THEN ideb2=ideb+3 WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN ideb2=ideb+2 WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN ideb2=ideb+1 WRITE (BUFFER(ideb:ideb) ,FMT='(I1)') IP ELSEIF (IP.GE.10 .AND. IP.LT.100) THEN ideb2=ideb+2 WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP ELSEIF (IP.GE.100) THEN ideb2=ideb+3 WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP ENDIF BUFFER(ideb2:ideb2)='}' CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN) TYY=TYY+REAL(YINT) GRAD=GRAD+YINT 12 CONTINUE * IF ((YSUP-YINF) .LE. 6.D0) THEN * ECRITURE DES VALEURS DE SOUS-GRADUATION SUR AXE Y EN LOG * UNIQUEMENT SI LA GAMME EST SUR MOINS DE 6 DECADS DO 13 J=1,7,2 IF (J.EQ.1) THEN TYY=REAL(YINF) ELSE TYY=REAL(YINF)+LOG10(REAL(J)-1.0) ENDIF TYY=TYY - real(BB)/30.0 TXX=REAL(XINF)-REAL(0.2*BG) DO 14 I=1,INY JJ=1 IF (J.GT.1) JJ=J-1 WRITE(BUFFER(1:1),FMT='(I1)') JJ CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN) TYY=TYY+YINT IF ((I.EQ.INY).AND.(J.EQ.1)) THEN JJ=1 WRITE(BUFFER(1:1),FMT='(I1)') JJ CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN) ENDIF 14 CONTINUE 13 CONTINUE ENDIF ENDIF *============================================================= * TRACE DE GRILLE *============================================================= IF (ZGRILL) THEN c grille en gris ? icoul1=icoul0 if(IGRIL.lt.0) then icoul1=15 CALL CHCOUL(icoul1) endif c bp faut-il faire des pointillés? IGRILA= abs(IGRIL) ZTIRET=(IGRILA.gt.1) IGRIL1= IGRILA-1 DXEVL = XSUP-XINF DL = DXEVL/100.D0 ZTRAC =.TRUE. * trace grille secondaire (nonlineaire) si axe x en log * (en pointillés gris) IF (ZLOGX) THEN CALL CHCOUL(15) GRAD=XINF DO 151 I=1,INX TX1=REAL(GRAD+FLOAT(I-1)*XINT) * trace grille non lineaire si axe x en log (pointillés gris) DO 155 J=2,9,1 TX(1)=TX1+LOG10(REAL(J))*XINT TX(2)=TX(1) TY(1)=REAL(YINF) TY(2)=REAL(YSUP) CALL TRSEG (IPTR,TX,TY,.true.,5,DL,ZTRAC) 155 CONTINUE 151 CONTINUE CALL CHCOUL(icoul1) ENDIF c grille des x IF (INX.GT.1)THEN GRAD=XINF DO 15 I=1,INX TX(1)=REAL(GRAD+FLOAT(I)*XINT) IF ((TX(1)+0.001*XINT).GE.XSUP) GOTO 15 TX(2)=TX(1) TY(1)=REAL(YINF) TY(2)=REAL(YSUP) c CALL POLRL (2,TX,TY,tz) CALL TRSEG (IPTR,TX,TY,ZTIRET,IGRIL1,DL,ZTRAC) 15 CONTINUE ENDIF * trace grille secondaire (nonlineaire) si axe y en log * (en pointillés gris) IF (ZLOGY) THEN CALL CHCOUL(15) GRAD=YINF DO 161 I=1,INY TY1=REAL(GRAD+FLOAT(I-1)*YINT) * trace grille non lineaire si axe y en log (pointillés gris) DO 165 J=2,9,1 TX(1)=REAL(XINF) TX(2)=REAL(XSUP) TY(1)=TY1+LOG10(REAL(J))*YINT TY(2)=TY(1) CALL TRSEG(IPTR,TX,TY,.true.,5,DL,ZTRAC) 165 CONTINUE 161 CONTINUE CALL CHCOUL(icoul1) ENDIF c grille des y IF (INY.GT.1)THEN GRAD=YINF DO 16 I=1,INY TX(1)=REAL(XINF) TX(2)=REAL(XSUP) TY(1)=REAL(GRAD+FLOAT(I)*YINT) IF ((TY(1)+0.001*YINT).GE.YSUP) GOTO 16 TY(2)=TY(1) c CALL POLRL (2,TX,TY,tz) CALL TRSEG (IPTR,TX,TY,ZTIRET,IGRIL1,DL,ZTRAC) 16 CONTINUE ENDIF c on remet la couleur des axes CALL CHCOUL(icoul0) ENDIF *============================================================= * TRACE DES AXES Ox et Oy, UNIQUEMENT EN LINEAIRE *============================================================= * IF (ZAXES) THEN IF (.NOT.ZLOGX.AND.XINF*XSUP.LE.0.D0) THEN TX(1)=0. TX(2)=0. TY(1)=REAL(YINF) TY(2)=REAL(YSUP)+3.*TDELTY CALL POLRL (2,TX,TY,tz) TX(1)=-0.5*TDELTX TX(3)=0.5*TDELTX TY(1)=TY(2)-TDELTY TY(3)=TY(1) CALL POLRL (3,TX,TY,tz) * BUFFER(1:2)='Oy' * TXX=TDELTX * TYY=REAL(YSUP)+2.*TDELTY * CALL TRLABL(TXX,TYY,0.,BUFFER(1:2),2,HMIN) ENDIF IF (.NOT.ZLOGY.AND.YINF*YSUP.LE.0.D0) THEN TX(1)=REAL(XINF) TX(2)=REAL(XSUP)+3.*TDELTX TY(1)=0. TY(2)=0. CALL POLRL (2,TX,TY,tz) TY(1)=0.5*TDELTY TY(3)=-0.5*TDELTY TX(1)=TX(2)-TDELTX TX(3)=TX(1) CALL POLRL (3,TX,TY,tz) * BUFFER(1:2)='Ox' * TXX=REAL(XSUP)+3.*TDELTX * TYY=-2.*TDELTY * CALL TRLABL(TXX,TYY,0.,BUFFER(1:2),2,HMIN) ENDIF ENDIF * *PM SEGDES AXE * END