Download daxes.eso

Back to the list

   1 : C DAXES     SOURCE    BP208322  12/08/02    21:15:11     7468           
   2 : 
   3 :       SUBROUTINE DAXES (IPTR,ZAXES,IGRIL)
   4 : *
   5 : *=============================================================
   6 : * Modifications :
   7 : *
   8 : *   95/02/07 Loca
   9 : *     passer les legendes x et y de 12 à 20 caractères:
  10 : *     SEGMENT AXE disparait et est appelé en include: -INC TMAXE.
  11 : *
  12 : *   05 sept. 2007 Maugis
  13 : *     Maintien du segment AXE actif en modification
  14 : *
  15 : *=============================================================
  16 : *
  17 : * Entrée :
  18 : *
  19 : *  IPTR  : POINTEUR SUR UN AXE                         (ACTIF)
  20 : *  ZAXES : LOGIQUE INDIQUANT DE TRACER LES AXES
  21 : *
  22 : *=============================================================
  23 : *
  24 : *  1. TOUTES LES VARIABLES COMMENCANT PAR T SONT EN SIMPLE PRECISION !
  25 : *  2. PM: bien qu'aucune de ses variables ne soient modifiées, le
  26 : *     segment AXE est tout de même ouvert en modification (?)
  27 : *
  28 : *=============================================================
  29 :       IMPLICIT LOGICAL (Z)
  30 : *
  31 : *
  32 :       IMPLICIT INTEGER(I-N)
  33 :       IMPLICIT REAL*8 (A-H,O-S,U-Y)
  34 : *
  35 :       REAL HMIN
  36 : *
  37 : -INC CCOPTIO
  38 : -INC CCTRACE
  39 : -INC TMAXE
  40 : 
  41 :       EXTERNAL LONG
  42 :       
  43 :       CHARACTER*30 BUFFER
  44 :       DIMENSION  TX(5),TY(5),TZ(5),TX2(2),TY2(2),TZ2(2)
  45 :       LOGICAL ZTIRET,ZTRAC
  46 : 
  47 : *=============================================================
  48 : *  INITIALISATIONS
  49 : *=============================================================
  50 : 
  51 :       do ii=1,5
  52 :        tz(ii)=0
  53 :       enddo
  54 :       do ii=1,2
  55 :        tz2(ii)=0
  56 :       enddo
  57 :       AXE=IPTR
  58 :       SEGACT AXE*MOD
  59 :       HMIN=.2
  60 : 
  61 : 
  62 : *=============================================================
  63 : *  TRACE DES AXES + GRADUATIONS 
  64 : *=============================================================
  65 : 
  66 : *  TRACE DES AXES ============================================
  67 : *  (CADRE DEFINI PAR XINF XSUP YINF YSUP)
  68 : *     couleurs definies dans bdata : 0:defaut 7:blanc 8:noir 16:gris
  69 :       IF (ICOSC.EQ.2.OR.ICOSC.EQ.3) THEN
  70 :          icoul0=8
  71 :       ELSE
  72 :          icoul0=0
  73 :       ENDIF
  73 :       CALL CHCOUL(icoul0)
  74 :       TX(1)=REAL(XINF)
  75 :       TY(1)=REAL(YINF)
  76 :       TX(2)=REAL(XINF)
  77 :       TY(2)=REAL(YSUP)
  78 :       TX(3)=REAL(XSUP)
  79 :       TY(3)=REAL(YSUP)
  80 :       TX(4)=REAL(XSUP)
  81 :       TY(4)=REAL(YINF)
  82 :       TX(5)=REAL(XINF)
  83 :       TY(5)=REAL(YINF)
  83 :       CALL POLRL (5,TX,TY,tz)
  84 : *
  85 : *  TRACE DES GRADUATIONS SUR L'AXE X  ========================
  86 : 
  87 : *  TRACE DES GRADUATIONS PRINCIPALES
  88 :       TDELTY=REAL(DABS(YSUP-YINF))/75.
  89 :       TX(1)=REAL(XINF)
  90 :       TY(1)=REAL(YINF)
  91 :       TY(2)=REAL(YINF)+TDELTY
  92 :       TY2(1)=REAL(YSUP)
  93 :       TY2(2)=REAL(YSUP)-TDELTY
  94 :       DO 1 I=2,INX
  95 :         TX(1)=TX(1)+REAL(XINT)
  96 :         TX(2)=TX(1)
  96 :         CALL POLRL(2,TX,TY2,tz)
  96 :         CALL POLRL(2,TX,TY,tz)
  97 :   1   CONTINUE
  98 : *
  99 : *  TRACE DES GRADUATIONS NON LINEAIRES SI AXE X EN LOG 
 100 :       IF (ZLOGX) THEN
 101 :         DO 2 J=2,6,2
 102 :           TX(1)=REAL(XINF)+LOG10(REAL(J))
 103 :           TY(1)=REAL(YINF)
 104 :           TY(2)=REAL(YINF)+TDELTY
 105 :           TY2(1)=REAL(YSUP)
 106 :           TY2(2)=REAL(YSUP)-TDELTY
 107 :           DO 3 I=1,INX
 108 :             TX(2)=TX(1)
 108 :             CALL POLRL(2,TX,TY2,tz)
 108 :             CALL POLRL(2,TX,TY,tz)
 109 :             TX(1)=TX(1)+REAL(XINT)
 110 :   3       CONTINUE
 111 :   2     CONTINUE
 112 :       ENDIF
 113 : *
 114 : *  TRACE DES GRADUATIONS SUR L'AXE Y ========================
 115 : *
 116 : *  TRACE DES GRADUATIONS PRINCIPALES
 117 :       TDELTX=REAL(DABS(XSUP-XINF))/70.
 118 :       TY(1)=REAL(YINF)
 119 :       TX(1)=REAL(XINF)
 120 :       TX(2)=REAL(XINF)+TDELTX
 121 :       TX2(1)=REAL(XSUP)
 122 :       TX2(2)=REAL(XSUP)-TDELTX
 123 :       DO 4 I=2,INY
 124 :         TY(1)=TY(1)+REAL(YINT)
 125 :         TY(2)=TY(1)
 125 :         CALL POLRL (2,TX2,TY,tz)
 125 :         CALL POLRL (2,TX,TY,tz)
 126 :   4   CONTINUE
 127 : *
 128 : *  TRACE DES GRADUATIONS NON LINEAIRES SI AXE Y EN LOG
 129 :       IF (ZLOGY) THEN
 130 :         DO 5 J=2,6,2
 131 :           TY(1)=REAL(YINF)+LOG10(REAL(J))
 132 :           TX(1)=REAL(XINF)
 133 :           TX(2)=REAL(XINF)+TDELTX
 134 :           TX2(1)=REAL(XSUP)
 135 :           TX2(2)=REAL(XSUP)-TDELTX
 136 :           DO 6 I=1,INY
 137 :             TY(2)=TY(1)
 137 :             CALL POLRL (2,TX2,TY,tz)
 137 :             CALL POLRL (2,TX,TY,tz)
 138 :             TY(1)=TY(1)+YINT
 139 :   6       CONTINUE
 140 :   5     CONTINUE
 141 :       ENDIF
 142 : 
 143 : 
 144 : *=============================================================
 145 : *  ECRITURE DES XLABEL ET YLABEL (TITX et TITY)
 146 : *=============================================================
 147 : 
 148 : *    J'UTILISE DES COPIES DANS BUFFER CAR AVEC LES APPELS AVEC TITREX
 149 : *  TITREY SINON EN TATB SUR LE CRAY JE PAUME UNE LEGENDE EN Y
 150 : *
 151 : c     TITX ===============================
 152 : c       ANGLE=0.d0
 153 : c       IALIGN=IPOSX
 154 : cbp : on utilise le tableau INFOTR de l include CCTRACE
 155 :       INFOTR(1)=0
 156 :       INFOTR(2)=IPOSX
 157 :       IF(IPOSX.eq.2) THEN
 158 :         TXX=REAL(.5*(XSUP+XINF))
 159 :       ELSE
 160 : cbp     on va se mettre avant l eventuel x10^{} de l'axe X
 161 : c       + on recule du nombre de caractere (on ne tient pas compte de la
 162 : c         police utilisee !!!)
 163 :         IF(ZCARRE) THEN
 164 :           TXX=REAL(XSUP)-(.017*(XSUP-XINF)*REAL(LONG(TITREX)+3))
 165 :         ELSE
 166 :           TXX=REAL(XSUP)-(.011*(XSUP-XINF)*REAL(LONG(TITREX)+3))
 167 :         ENDIF
 168 :       ENDIF
 169 :       IF(ZLOGX) THEN
 170 :         TYY=REAL(YINF)-.12*(YSUP-YINF)
 171 :       ELSE
 172 :         TYY=REAL(YINF)-.10*(YSUP-YINF)
 173 :       ENDIF
 174 :       BUFFER(1:20)=TITREX(1:20)
 174 :       CALL TRLABL(TXX,TYY,0.,BUFFER(1:20),20,HMIN)
 175 : 
 176 : c     TITY ===============================
 177 : c       IALIGN=IPOSY
 178 :       INFOTR(1)=0
 179 :       INFOTR(2)=IPOSY
 180 :       IF(IPOSY.eq.2) THEN
 181 :         TXX=REAL(XINF)-(0.99*BG)
 182 :         TYY=REAL(0.5*(YSUP+YINF))
 183 : c         ANGLE=90.d0
 184 :         INFOTR(1)=90
 185 :       ELSE
 186 :         TXX=REAL(XINF)-.01*(XSUP-XINF)
 187 :         TYY=REAL(YSUP)+.05*(YSUP-YINF)
 188 :       ENDIF
 189 :       BUFFER(1:20)=TITREY(1:20)
 189 :       CALL TRLABL(TXX,TYY,0.,BUFFER(1:20),20,HMIN)
 190 : cbp : je n'ai pas compris le 0. ci-dessus; dans le doute je le laisse ...  
 191 : c     on remet tout a 0      
 192 : c       ANGLE=0.d0
 193 : c       IALIGN=0
 194 :       INFOTR(1)=0
 195 :       INFOTR(2)=0
 196 : 
 197 : 
 198 : *=============================================================
 199 : *  ECRITURE DES VALEURS DE GRADUATION SUR LES AXE
 200 : *=============================================================
 201 : 
 202 : *-------------------------------------------------------------
 203 : *  ECRITURE DES VALEURS DE GRADUATION SUR AXE X EN LINEAIRE 
 204 : *-------------------------------------------------------------
 205 :       IF (.NOT.ZLOGX) THEN
 206 : *
 207 :         IP=ICALP(XINF,XSUP)
 208 : *
 209 : *  INITIALISATION DES VALEURS POUR LE TRACE
 210 : *
 211 :         GRAD=XINF
 212 :         TXX=REAL(XINF)-(.35*BG)
 213 :         TYY=REAL(YINF)-(.3*BB)
 214 : *
 215 : *  BOUCLE POUR CHAQUE PAS
 216 : *
 217 :         DO 7 I=1,INX+1
 218 :           CH=GRAD/10.D0**FLOAT(IP)
 219 : *
 220 : *  FORMATTAGE DES VALEURS DE GRADUATION
 221 : *
 222 :           BUFFER(1:8)='        '
 223 :           IF (CH.LE.-10.D0) THEN
 224 :             WRITE (BUFFER(1:7),FMT='(F7.2)') CH
 225 :           ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN
 226 :             WRITE (BUFFER(1:6),FMT='(F6.2)') CH
 227 :           ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN
 228 :             WRITE (BUFFER(2:6),FMT='(F5.2)') CH
 229 :           ELSEIF (CH.GE.10.D0)THEN
 230 :             WRITE (BUFFER(1:6),FMT='(F6.2)') CH
 231 :           ENDIF
 231 :           CALL TRLABL (TXX,TYY,0.,BUFFER(1:8),8,HMIN)
 232 :           TXX=TXX+REAL(XINT)
 233 :           GRAD=GRAD+XINT
 234 :   7     CONTINUE
 235 : *
 236 : *  ECRITURE DE P APRES FORMATTAGE
 237 : *
 238 :         IF (IP.NE.0) THEN
 239 : c           BUFFER(1:10)='x1.E        '
 240 : c           ideb=4          
 241 :           BUFFER(1:10)='x10^{     '
 242 :           ideb=6          
 243 :           IF (IP.LE.-10) THEN
 244 :             ideb2=ideb+3
 245 :             WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP
 246 :           ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN
 247 :             ideb2=ideb+2
 248 :             WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
 249 :           ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN
 250 :             ideb2=ideb+1
 251 :             WRITE (BUFFER(ideb:ideb),FMT='(I1)') IP
 252 :           ELSEIF (IP.GE.10) THEN
 253 :             ideb2=ideb+2
 254 :             WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
 255 :           ENDIF
 256 :           BUFFER(ideb2:ideb2)='}'          
 257 :           TYY=REAL(YINF-.10*(YSUP-YINF))
 258 :           if(ZCARRE) then
 259 :             TXX=REAL(XSUP)-(.015*(XSUP-XINF))
 260 :           else
 261 :             TXX=REAL(XSUP)-(.010*(XSUP-XINF))
 262 :           endif
 262 :           CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN)
 263 :         ENDIF
 264 : 
 265 : *-------------------------------------------------------------
 266 : *  ECRITURE DES VALEURS DE GRADUATION SUR AXE X EN LOG
 267 : *-------------------------------------------------------------
 268 :       ELSE
 269 :         GRAD=XINF
 270 : c         TXX=REAL(XINF)-(BG/4.)
 271 : c         TXX=REAL(XINF)-((BG+BD)/8.)
 272 : c         TXX=REAL(XINF)-(0.15*BG)
 273 :         TXX=REAL(XINF)-(0.10*BG)
 274 : c         TYY=REAL(YINF)-.06*(YSUP-YINF)
 275 :         TYY=REAL(YINF)-.07*(YSUP-YINF)
 276 :         DO 8 I=1,INX+1
 277 :           IP=INT(GRAD)
 278 : c           BUFFER(1:6)='1.E   '
 279 : c           ideb=4          
 280 :           BUFFER(1:10)='10^{     '
 281 :           ideb=5          
 282 :           IF (IP.LE.-10) THEN
 283 :             ideb2=ideb+3
 284 :             WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP
 285 :           ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN
 286 :             ideb2=ideb+2
 287 :             WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
 288 :           ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN
 289 :             ideb2=ideb+1
 290 :             WRITE (BUFFER(ideb:ideb),FMT='(I1)') IP
 291 :           ELSEIF (IP.GE.10) THEN
 292 :             ideb2=ideb+2
 293 :             WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
 294 :           ENDIF
 295 :           BUFFER(ideb2:ideb2)='}'          
 295 :           CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN)
 296 :           TXX=TXX+XINT
 297 :           GRAD=GRAD+XINT
 298 :   8     CONTINUE
 299 : *
 300 :         IF ((XSUP-XINF).LE.9.D0) THEN
 301 : *
 302 : *  ECRITURE DES VALEURS DE SOUS-GRADUATION SUR AXE X EN LOG
 303 : *   UNIQUEMENT SI LEUR NOMBRE N'EST PAS TROP IMPORTANT
 304 : *
 305 :           DO 9 J=1,7,2
 306 :             IF (J.EQ.1) THEN
 307 :               TXX=REAL(XINF)
 308 :             ELSE
 309 :               TXX=REAL(XINF)+LOG10(REAL(J)-REAL(1.))
 310 :             ENDIF
 311 :             TXX=TXX-(0.07*BG)
 312 :             TYY=REAL(YINF)-(0.25*BB)
 313 :             DO 10 I=1,INX
 314 :               JJ=1
 315 :               IF (J.GT.1) JJ=J-1
 316 :               WRITE (BUFFER(1:1),FMT='(I1)') JJ
 316 :               CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN)
 317 :               TXX=TXX+REAL(XINT)
 318 :               IF ((I.EQ.INX).AND.(J.EQ.1)) THEN
 319 :                 JJ=1
 320 :                 WRITE (BUFFER(1:1),FMT='(I1)') JJ
 320 :                 CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN)
 321 :               ENDIF
 322 : 10          CONTINUE
 323 :  9        CONTINUE
 324 :         ENDIF
 325 :       ENDIF
 326 : 
 327 : 
 328 : *-------------------------------------------------------------
 329 : *  ECRITURE DES VALEURS DE GRADUATION SUR AXE Y EN LINEAIRE
 330 : *-------------------------------------------------------------
 331 :       IF (.NOT.ZLOGY) THEN
 332 : *
 333 :         IP=ICALP(YINF,YSUP)
 334 : *
 335 : *  INITIALISATION DES VALEURS POUR LE TRACE
 336 : *
 337 :         GRAD=YINF
 338 :         TXX=REAL(XINF)-(BG*0.9)
 339 :         TYY=REAL(YINF)
 340 : *
 341 : *  BOUCLE POUR CHAQUE PAS
 342 : *
 343 :         DO 11 I=1,INY+1
 344 :           CH=GRAD/10.D0**FLOAT(IP)
 345 : *
 346 : *  FORMATTAGE DES VALEURS DE GRADUATION
 347 : *
 348 :           BUFFER(1:8)=' '
 349 :           IF (CH.LE.-10.D0) THEN
 350 :             WRITE (BUFFER(1:7),FMT='(F7.2)') CH
 351 :           ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN
 352 :             WRITE (BUFFER(1:6),FMT='(F6.2)') CH
 353 :           ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN
 354 :             WRITE (BUFFER(2:6),FMT='(F5.2)') CH
 355 :           ELSEIF (CH.GE.10.D0)THEN
 356 :             WRITE (BUFFER(1:6),FMT='(F6.2)') CH
 357 :           ENDIF
 357 :           CALL TRLABL (TXX,TYY,0.,BUFFER(1:8),8,HMIN)
 358 :           TYY=TYY+REAL(YINT)
 359 :           GRAD=GRAD+YINT
 360 :  11     CONTINUE
 361 : *
 362 : *  ECRITURE APRES FORMATTAGE DE P
 363 : *
 364 :         IF (IP.NE.0) THEN
 365 : c           BUFFER(1:10)='x1.E        '
 366 : c           ideb=5
 367 :           BUFFER(1:10)='x10^{     '
 368 :           ideb=6          
 369 :           IF (IP.LE.-10) THEN
 370 :             ideb2=ideb+3
 371 :             WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP
 372 :           ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN
 373 :             ideb2=ideb+2
 374 :             WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
 375 :           ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN
 376 :             ideb2=ideb+1
 377 :             WRITE (BUFFER(ideb:ideb),FMT='(I1)') IP
 378 :           ELSEIF (IP.GE.10) THEN
 379 :             ideb2=ideb+2
 380 :             WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
 381 :           ENDIF
 382 :           BUFFER(ideb2:ideb2)='}'          
 383 :           TYY=(YSUP)+.05*(YSUP-YINF)
 383 :           CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN)
 384 :         ENDIF
 385 : *
 386 : *-------------------------------------------------------------
 387 : *  ECRITURE DES VALEURS DE GRADUATION SUR AXE Y EN LOG
 388 : *-------------------------------------------------------------
 389 : *
 390 :       ELSE
 391 :         GRAD=YINF
 392 : c         TXX=REAL(XINF)-(BG*0.99)
 393 :         TXX=REAL(XINF)-(BG*0.8)
 394 :         TYY=REAL(YINF)
 395 :         DO 12 I=1,INY+1
 396 :           IP=INT(GRAD)
 397 : c           BUFFER(1:3)='1.E'
 398 : c           ideb=4          
 399 :           BUFFER(1:10)='10^{     '
 400 :           ideb=5          
 401 :           IF (IP.LE.-10) THEN
 402 :             ideb2=ideb+3
 403 :             WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP
 404 :           ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN
 405 :             ideb2=ideb+2
 406 :             WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
 407 :           ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN
 408 :             ideb2=ideb+1
 409 :             WRITE (BUFFER(ideb:ideb),FMT='(I1)') IP
 410 :           ELSEIF (IP.GE.10) THEN
 411 :             ideb2=ideb+2
 412 :             WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
 413 :           ENDIF
 414 :           BUFFER(ideb2:ideb2)='}'          
 414 :           CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN)
 415 :           TYY=TYY+REAL(YINT)
 416 :           GRAD=GRAD+YINT
 417 :  12     CONTINUE
 418 : *
 419 :         IF ((YSUP-YINF).LE.7.D0) THEN
 420 : *
 421 : *  ECRITURE DES VALEURS DE SOUS-GRADUATION SUR AXE Y EN LOG
 422 : *   UNIQUEMENT SI LEUR NOMBRE N'EST PAS TROP IMPORTANT
 423 : *
 424 :           DO 13 J=1,7,2
 425 :             IF (J.EQ.1) THEN
 426 :               TYY=REAL(YINF)-real(BB/30.)
 427 :             ELSE
 428 :               TYY=REAL(YINF)+LOG10(REAL(J)-REAL(1.))-real(BB/30.)
 429 :             ENDIF
 430 :             TXX=REAL(XINF)-REAL(0.2*BG)
 431 :             DO 14 I=1,INY
 432 :               JJ=1
 433 :               IF (J.GT.1) JJ=J-1
 434 :               WRITE (BUFFER(1:1),FMT='(I1)') JJ
 434 :               CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN)
 435 :               TYY=TYY+YINT
 436 :               IF ((I.EQ.INY).AND.(J.EQ.1)) THEN
 437 :                 JJ=1
 438 :                 WRITE (BUFFER(1:1),FMT='(I1)') JJ
 438 :                 CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN)
 439 :               ENDIF
 440 :  14         CONTINUE
 441 :  13       CONTINUE
 442 :         ENDIF
 443 :       ENDIF
 444 : 
 445 : 
 446 : *=============================================================
 447 : *  TRACE DE GRILLE
 448 : *=============================================================
 449 : *
 450 :       IF (ZGRILL) THEN
 451 :       
 452 : c       grille en gris ?
 453 :         icoul1=icoul0
 454 :         if(IGRIL.lt.0) then
 455 :           icoul1=15
 455 :           CALL CHCOUL(icoul1)
 456 :         endif
 457 :         
 458 : c       bp faut-il faire des pointillés?
 459 :         IGRILA = abs(IGRIL)
 460 :         ZTIRET=(IGRILA.gt.1)
 461 :         IGRIL1= IGRILA-1
 462 :         DXEVL = XSUP-XINF
 463 :         DL    = DXEVL/100.D0
 464 :         ZTRAC =.TRUE.
 465 :         
 466 : *       trace grille secondaire (nonlineaire) si axe x en log 
 467 : *       (en pointillés gris)
 468 :         IF (ZLOGX) THEN
 468 :           CALL CHCOUL(15)
 469 :           GRAD=XINF
 470 :           DO 151 I=1,INX
 471 :             TX1=REAL(GRAD+FLOAT(I-1)*XINT)
 472 : *           trace grille non lineaire si axe x en log (pointillés gris)
 473 :             DO 155 J=2,9,1
 474 :                 TX(1)=TX1+LOG10(REAL(J))
 475 :                 TX(2)=TX(1)
 476 :                 TY(1)=REAL(YINF)
 477 :                 TY(2)=REAL(YSUP)
 477 :                 CALL TRSEG (IPTR,TX,TY,.true.,5,DL,ZTRAC)
 478 :  155        CONTINUE
 479 :  151      CONTINUE
 479 :           CALL CHCOUL(icoul1)
 480 :         ENDIF
 481 :         
 482 : c       grille des x
 483 :         IF (INX.GT.1)THEN
 484 :           GRAD=XINF
 485 :           DO 15 I=1,INX-1
 486 :             TX(1)=REAL(GRAD+FLOAT(I)*XINT)
 487 :             TX(2)=TX(1)
 488 :             TY(1)=REAL(YINF)
 489 :             TY(2)=REAL(YSUP)
 489 : c             CALL POLRL (2,TX,TY,tz)
 489 :             CALL TRSEG (IPTR,TX,TY,ZTIRET,IGRIL1,DL,ZTRAC)
 490 :  15       CONTINUE
 491 :         ENDIF
 492 :         
 493 : *       trace grille secondaire (nonlineaire) si axe y en log 
 494 : *       (en pointillés gris)
 495 :         IF (ZLOGY) THEN
 495 :           CALL CHCOUL(15)
 496 :           GRAD=YINF
 497 :           DO 161 I=1,INY
 498 :             TY1=REAL(GRAD+FLOAT(I-1)*YINT)
 499 : *           trace grille non lineaire si axe y en log (pointillés gris)
 500 : c             DO 165 J=2,8,2
 501 :             DO 165 J=2,9,1
 502 :                 TX(1)=REAL(XINF)
 503 :                 TX(2)=REAL(XSUP)
 504 :                 TY(1)=TY1+LOG10(REAL(J))
 505 :                 TY(2)=TY(1)
 505 :                 CALL TRSEG (IPTR,TX,TY,.true.,5,DL,ZTRAC)
 506 :  165        CONTINUE
 507 :  161      CONTINUE
 507 :           CALL CHCOUL(icoul1)
 508 :         ENDIF
 509 :         
 510 : c       grille des y
 511 :         IF (INY.GT.1)THEN
 512 :           GRAD=YINF
 513 :           DO 16 I=1,INY-1
 514 :             TX(1)=REAL(XINF)
 515 :             TX(2)=REAL(XSUP)
 516 :             TY(1)=REAL(GRAD+FLOAT(I)*YINT)
 517 :             TY(2)=TY(1)
 517 : c             CALL POLRL (2,TX,TY,tz)
 517 :             CALL TRSEG (IPTR,TX,TY,ZTIRET,IGRIL1,DL,ZTRAC)
 518 :  16       CONTINUE
 519 :         ENDIF
 520 :         
 521 : c       on remet la couleur des axes
 521 :         CALL CHCOUL(icoul0)
 522 :         
 523 :       ENDIF
 524 :       
 525 : 
 526 : *=============================================================
 527 : *  TRACE DES AXES Ox et Oy, UNIQUEMENT EN LINEAIRE
 528 : *=============================================================
 529 : *
 530 :       IF (ZAXES) THEN
 531 :         IF (.NOT.ZLOGX.AND.XINF*XSUP.LE.0.D0) THEN
 532 :           TX(1)=0.
 533 :           TX(2)=0.
 534 :           TY(1)=REAL(YINF)
 535 :           TY(2)=REAL(YSUP)+3.*TDELTY
 535 :           CALL POLRL (2,TX,TY,tz)
 536 :           TX(1)=-0.5*TDELTX
 537 :           TX(3)=0.5*TDELTX
 538 :           TY(1)=TY(2)-TDELTY
 539 :           TY(3)=TY(1)
 539 :           CALL POLRL (3,TX,TY,tz)
 540 : *          BUFFER(1:2)='Oy'
 541 : *          TXX=TDELTX
 542 : *          TYY=REAL(YSUP)+2.*TDELTY
 542 : *          CALL TRLABL(TXX,TYY,0.,BUFFER(1:2),2,HMIN)
 543 :         ENDIF
 544 :         IF (.NOT.ZLOGY.AND.YINF*YSUP.LE.0.D0) THEN
 545 :           TX(1)=REAL(XINF)
 546 :           TX(2)=REAL(XSUP)+3.*TDELTX
 547 :           TY(1)=0.
 548 :           TY(2)=0.
 548 :           CALL POLRL (2,TX,TY,tz)
 549 :           TY(1)=0.5*TDELTY
 550 :           TY(3)=-0.5*TDELTY
 551 :           TX(1)=TX(2)-TDELTX
 552 :           TX(3)=TX(1)
 552 :           CALL POLRL (3,TX,TY,tz)
 553 : *          BUFFER(1:2)='Ox'
 554 : *          TXX=REAL(XSUP)+3.*TDELTX
 555 : *          TYY=-2.*TDELTY
 555 : *          CALL TRLABL(TXX,TYY,0.,BUFFER(1:2),2,HMIN)
 556 :         ENDIF
 557 :       ENDIF
 558 : *
 559 : *PM   SEGDES AXE
 560 : *
 561 :       END
 562 :  
 563 :  
 564 :  
 565 :  
 566 :  
 567 :  
 568 :  

© Cast3M 2003 - All rights reserved.
Disclaimer