Télécharger daxes.eso

Retour à la liste

Numérotation des lignes :

  1. C DAXES SOURCE CB215821 19/06/17 21:15:11 10229
  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. IMPLICIT INTEGER(I-N)
  31. IMPLICIT REAL*8 (A-H,O-S,U-Y)
  32.  
  33. REAL HMIN
  34.  
  35. -INC CCOPTIO
  36. -INC CCTRACE
  37. -INC TMAXE
  38.  
  39. EXTERNAL LONG
  40.  
  41. CHARACTER*30 BUFFER
  42. DIMENSION TX(5),TY(5),TZ(5),TX2(2),TY2(2),TZ2(2)
  43. LOGICAL ZTIRET,ZTRAC,ZDEC1,ZDEC2
  44.  
  45. *=============================================================
  46. * INITIALISATIONS
  47. *=============================================================
  48.  
  49. do ii=1,5
  50. tz(ii)=0.0
  51. enddo
  52. do ii=1,2
  53. tz2(ii)=0.0
  54. enddo
  55. AXE=IPTR
  56. SEGACT AXE*MOD
  57. HMIN=.2
  58.  
  59.  
  60. *=============================================================
  61. * TRACE DES AXES + GRADUATIONS
  62. *=============================================================
  63.  
  64. * TRACE DES AXES ============================================
  65. * (CADRE DEFINI PAR XINF XSUP YINF YSUP)
  66. * couleurs definies dans bdata : 0:defaut 7:blanc 8:noir 16:gris
  67. IF (ICOSC.EQ.2.OR.ICOSC.EQ.3) THEN
  68. icoul0=8
  69. ELSE
  70. icoul0=0
  71. ENDIF
  72. CALL CHCOUL(icoul0)
  73. TX(1)=REAL(XINF)
  74. TY(1)=REAL(YINF)
  75. TX(2)=REAL(XINF)
  76. TY(2)=REAL(YSUP)
  77. TX(3)=REAL(XSUP)
  78. TY(3)=REAL(YSUP)
  79. TX(4)=REAL(XSUP)
  80. TY(4)=REAL(YINF)
  81. TX(5)=REAL(XINF)
  82. 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(ABS(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)
  97. CALL POLRL(2,TX,TY2,tz)
  98. CALL POLRL(2,TX,TY,tz)
  99. 1 CONTINUE
  100.  
  101. * TRACE DES GRADUATIONS NON LINEAIRES SI AXE X EN LOG
  102. c IF (ZLOGX) THEN
  103. IF (ZLOGX .and. INX.le.20) THEN
  104. DO 2 J=2,8,2
  105. TX(1) =REAL(XINF)+LOG10(REAL(J))*XINT
  106. TY(1) =REAL(YINF)
  107. TY(2) =REAL(YINF)+TDELTY
  108. TY2(1)=REAL(YSUP)
  109. TY2(2)=REAL(YSUP)-TDELTY
  110. DO 3 I=1,INX
  111. TX(2)=TX(1)
  112. CALL POLRL(2,TX,TY2,tz)
  113. CALL POLRL(2,TX,TY,tz)
  114. TX(1)=TX(1)+REAL(XINT)
  115. 3 CONTINUE
  116. 2 CONTINUE
  117. ENDIF
  118. *
  119. * TRACE DES GRADUATIONS SUR L'AXE Y ========================
  120. *
  121. * TRACE DES GRADUATIONS PRINCIPALES
  122. TDELTX=REAL(ABS(XSUP-XINF))/70.
  123. TY(1) =REAL(YINF)
  124. TX(1) =REAL(XINF)
  125. TX(2) =REAL(XINF)+TDELTX
  126. TX2(1)=REAL(XSUP)
  127. TX2(2)=REAL(XSUP)-TDELTX
  128. DO 4 I=2,INY
  129. TY(1)=TY(1)+REAL(YINT)
  130. TY(2)=TY(1)
  131. CALL POLRL(2,TX2,TY,tz)
  132. CALL POLRL(2,TX,TY,tz)
  133. 4 CONTINUE
  134. *
  135. * TRACE DES GRADUATIONS NON LINEAIRES SI AXE Y EN LOG
  136. c IF (ZLOGY) THEN
  137. IF (ZLOGY .and. INY.le.20) THEN
  138. DO 5 J=2,8,2
  139. TY(1) =REAL(YINF)+LOG10(REAL(J))*YINT
  140. TX(1) =REAL(XINF)
  141. TX(2) =REAL(XINF)+TDELTX
  142. TX2(1)=REAL(XSUP)
  143. TX2(2)=REAL(XSUP)-TDELTX
  144. DO 6 I=1,INY
  145. TY(2)=TY(1)
  146. CALL POLRL(2,TX2,TY,tz)
  147. CALL POLRL(2,TX,TY,tz)
  148. TY(1)=TY(1)+YINT
  149. 6 CONTINUE
  150. 5 CONTINUE
  151. ENDIF
  152.  
  153. *=============================================================
  154. * ECRITURE DES XLABEL ET YLABEL (TITX et TITY)
  155. *=============================================================
  156.  
  157. * J'UTILISE DES COPIES DANS BUFFER CAR AVEC LES APPELS AVEC TITREX
  158. * TITREY SINON EN TATB SUR LE CRAY JE PAUME UNE LEGENDE EN Y
  159. *
  160. c TITX ===============================
  161. c ANGLE=0.d0
  162. c IALIGN=IPOSX
  163. cbp : on utilise le tableau INFOTR de l include CCTRACE
  164. INFOTR(1)=0
  165. INFOTR(2)=IPOSX
  166. cbp2015-10 IF(IPOSX.eq.2) THEN
  167. IF(IPOSX.ne.1) THEN
  168. TXX=REAL(.5*(XSUP+XINF))
  169. ELSE
  170. cbp on va se mettre avant l eventuel x10^{} de l'axe X
  171. c + on recule du nombre de caractere (on ne tient pas compte de la
  172. c police utilisee !!!)
  173. IF(ZCARRE) THEN
  174. TXX=REAL(XSUP)-(.017*(XSUP-XINF)*REAL(LONG(TITREX)+3))
  175. ELSE
  176. TXX=REAL(XSUP)-(.011*(XSUP-XINF)*REAL(LONG(TITREX)+3))
  177. ENDIF
  178. ENDIF
  179. IF(ZLOGX) THEN
  180. TYY=REAL(YINF)-.12*(YSUP-YINF)
  181. ELSE
  182. TYY=REAL(YINF)-.10*(YSUP-YINF)
  183. ENDIF
  184. BUFFER(1:20)=TITREX(1:20)
  185. CALL TRLABL(TXX,TYY,0.,BUFFER(1:20),20,HMIN)
  186.  
  187. c TITY ===============================
  188. c IALIGN=IPOSY
  189. INFOTR(1)=0
  190. INFOTR(2)=IPOSY
  191. cbp2015-10 IF(IPOSY.eq.2) THEN
  192. IF(IPOSY.ne.1) THEN
  193. TXX=REAL(XINF)-(0.99*BG)
  194. TYY=REAL(0.5*(YSUP+YINF))
  195. c ANGLE=90.d0
  196. INFOTR(1)=90
  197. ELSE
  198. TXX=REAL(XINF)-.01*(XSUP-XINF)
  199. TYY=REAL(YSUP)+.05*(YSUP-YINF)
  200. ENDIF
  201. BUFFER(1:20)=TITREY(1:20)
  202. CALL TRLABL(TXX,TYY,0.,BUFFER(1:20),20,HMIN)
  203. cbp : je n'ai pas compris le 0. ci-dessus; dans le doute je le laisse ...
  204. c on remet tout a 0
  205. c ANGLE=0.d0
  206. c IALIGN=0
  207. INFOTR(1)=0
  208. INFOTR(2)=0
  209.  
  210.  
  211. *=============================================================
  212. * ECRITURE DES VALEURS DE GRADUATION SUR LES AXE
  213. *=============================================================
  214.  
  215. *-------------------------------------------------------------
  216. * ECRITURE DES VALEURS DE GRADUATION SUR AXE X EN LINEAIRE
  217. *-------------------------------------------------------------
  218. IF (.NOT.ZLOGX) THEN
  219. *
  220. CALL LENCHA(MXFMT,LMX)
  221. IF (LMX.gt.2) THEN
  222. READ(MXFMT(3:3),FMT='(I1)',IOSTAT=IOS) LFIN
  223. IF (MXFMT(2:2).eq.'I') THEN
  224. IP=0
  225. ELSE
  226. IP=ICALP(XINF,XSUP)
  227. ENDIF
  228. ELSE
  229. IP=ICALP(XINF,XSUP)
  230. ENDIF
  231. *
  232. * Combien de decimales utilise t'on (pour toutes les graduations)?
  233. GRAD=XINF
  234. ZDEC2=.true.
  235. ZDEC1=.true.
  236. DO I=1,INX+1
  237. CH=GRAD/10.D0**FLOAT(IP)
  238. * on commence par arrondir
  239. CH = DBLE(NINT(100000.D0*CH))/100000.D0
  240. * les 2 premieres decimales de CH sont elles nulles (<=>KCH2=0)?
  241. * on l'ecrit comme un INTEGER
  242. KCH2=INT(100.D0*(CH-DBLE(INT(CH))))
  243. IF(KCH2.NE.0) ZDEC2=.false.
  244. * la 1 premieres decimales de CH est elle nulle (<=>KCH1=0)?
  245. KCH1=KCH2-10*INT(10.D0*(CH-DBLE(INT(CH))))
  246. IF(KCH1.NE.0) ZDEC1=.false.
  247. GRAD=GRAD+XINT
  248. ENDDO
  249. *
  250. * INITIALISATION DES VALEURS POUR LE TRACE
  251. *
  252. GRAD=XINF
  253. c TXX=REAL(XINF)-(.35*BG)
  254. c TXX=REAL(XINF)-(0.55*BG)
  255. c on se met au centre et on l'indique a INFOTR(2)
  256. TXX=REAL(XINF)
  257. TYY=REAL(YINF)-(.3*BB)
  258. INFOTR(2)=2
  259.  
  260. *
  261. * BOUCLE POUR CHAQUE PAS
  262. *
  263. DO 7 I=1,INX+1
  264. CH=GRAD/10.D0**FLOAT(IP)
  265. *bp, 2015/12/08: on commence par arrondir pour eviter pb avec des 9.9999
  266. CH = DBLE(NINT(100000.D0*CH))/100000.D0
  267. * FORMATTAGE DES VALEURS DE GRADUATION
  268. BUFFER(1:10)=' '
  269. * -cas format impose
  270. IF((LMX.gt.2).and.(MXFMT(1:1).EQ.'(')) THEN
  271. IF(CH.GE.0.D0.AND.CH.LT.10.D0) THEN
  272. IDEB=2
  273. ELSE
  274. IDEB=1
  275. ENDIF
  276. IFIN = IDEB+LFIN-1
  277. IF(MXFMT(2:2).eq.'I') THEN
  278. WRITE (BUFFER(IDEB:IFIN),FMT=MXFMT(1:LMX)) INT(CH)
  279. ELSE
  280. WRITE (BUFFER(IDEB:IFIN),FMT=MXFMT(1:LMX)) CH
  281. ENDIF
  282. * -cas format automatique
  283. * -cas format automatique et pas d'exposant
  284. * depuis modif de icalp, il peut y avoir jusqu'a 4 chiffres
  285. ELSE
  286. c write(*,*) 'X:',I,ZDEC2,ZDEC1,CH,(CH.LE.-10.D0)
  287. IF(ZDEC2) THEN
  288. IF (CH.LE.-1000.D0) THEN
  289. WRITE (BUFFER(1:9),FMT='(I5)') NINT(CH)
  290. ELSEIF (CH.GT.-1000.D0.AND.CH.LE.-100.D0) THEN
  291. WRITE (BUFFER(1:9),FMT='(I4)') NINT(CH)
  292. ELSEIF (CH.GT.-100.D0.AND.CH.LE.-10.D0) THEN
  293. WRITE (BUFFER(1:9),FMT='(I3)') NINT(CH)
  294. ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN
  295. WRITE (BUFFER(1:9),FMT='(I2)') NINT(CH)
  296. ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN
  297. WRITE (BUFFER(1:9),FMT='(I1)') NINT(CH)
  298. ELSEIF (CH.GE.10.D0.AND.CH.LT.100.D0) THEN
  299. WRITE (BUFFER(1:9),FMT='(I2)') NINT(CH)
  300. ELSEIF (CH.GE.100.D0.AND.CH.LT.1000.D0) THEN
  301. WRITE (BUFFER(1:9),FMT='(I3)') NINT(CH)
  302. ELSEIF (CH.GE.1000.D0) THEN
  303. WRITE (BUFFER(1:9),FMT='(I4)') NINT(CH)
  304. ENDIF
  305. ELSEIF(ZDEC1) THEN
  306. IF (CH.LE.-1000.D0) THEN
  307. WRITE (BUFFER(1:9),FMT='(F7.1)') CH
  308. ELSEIF (CH.GT.-1000.D0.AND.CH.LE.-100.D0) THEN
  309. WRITE (BUFFER(1:9),FMT='(F6.1)') CH
  310. ELSEIF (CH.GT.-100.D0.AND.CH.LE.-10.D0) THEN
  311. WRITE (BUFFER(1:9),FMT='(F5.1)') CH
  312. ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN
  313. WRITE (BUFFER(1:9),FMT='(F4.1)') CH
  314. ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN
  315. WRITE (BUFFER(1:9),FMT='(F3.1)') CH
  316. ELSEIF (CH.GE.10.D0.AND.CH.LT.100.D0) THEN
  317. WRITE (BUFFER(1:9),FMT='(F4.1)') CH
  318. ELSEIF (CH.GE.100.D0.AND.CH.LT.1000.D0) THEN
  319. WRITE (BUFFER(1:9),FMT='(F5.1)') CH
  320. ELSEIF (CH.GE.1000.D0) THEN
  321. WRITE (BUFFER(1:9),FMT='(F6.1)') CH
  322. ENDIF
  323. ELSE
  324. IF (CH.LE.-1000.D0) THEN
  325. WRITE (BUFFER(1:9),FMT='(F8.2)') CH
  326. ELSEIF (CH.GT.-1000.D0.AND.CH.LE.-100.D0) THEN
  327. WRITE (BUFFER(1:9),FMT='(F7.2)') CH
  328. ELSEIF (CH.GT.-100.D0.AND.CH.LE.-10.D0) THEN
  329. WRITE (BUFFER(1:9),FMT='(F6.2)') CH
  330. ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN
  331. WRITE (BUFFER(1:9),FMT='(F5.2)') CH
  332. ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN
  333. WRITE (BUFFER(1:9),FMT='(F4.2)') CH
  334. ELSEIF (CH.GE.10.D0.AND.CH.LT.100.D0) THEN
  335. WRITE (BUFFER(1:9),FMT='(F5.2)') CH
  336. ELSEIF (CH.GE.100.D0.AND.CH.LT.1000.D0) THEN
  337. WRITE (BUFFER(1:9),FMT='(F6.2)') CH
  338. ELSEIF (CH.GE.1000.D0) THEN
  339. WRITE (BUFFER(1:9),FMT='(F7.2)') CH
  340. ENDIF
  341. ENDIF
  342. ENDIF
  343. * ECRITURE DE LA GRADUATION
  344. CALL TRLABL (TXX,TYY,0.,BUFFER(1:9),9,HMIN)
  345. TXX=TXX+REAL(XINT)
  346. GRAD=GRAD+XINT
  347.  
  348. 7 CONTINUE
  349.  
  350. INFOTR(2)=0
  351. *
  352. * ECRITURE DE P APRES FORMATTAGE
  353. *
  354. IF (IP.NE.0) THEN
  355. c BUFFER(1:10)='x1.E '
  356. c ideb=4
  357. BUFFER(1:10)='x10^{ '
  358. ideb=6
  359. IF (IP.LE.-10) THEN
  360. ideb2=ideb+3
  361. WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP
  362. ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN
  363. ideb2=ideb+2
  364. WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
  365. ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN
  366. ideb2=ideb+1
  367. WRITE (BUFFER(ideb:ideb),FMT='(I1)') IP
  368. ELSEIF (IP.GE.10) THEN
  369. ideb2=ideb+2
  370. WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
  371. ENDIF
  372. BUFFER(ideb2:ideb2)='}'
  373. TXX=REAL(XINF)-(.35*BG)
  374. TYY=REAL(YINF-.10*(YSUP-YINF))
  375. if(ZCARRE) then
  376. TXX=REAL(XSUP)-(.015*(XSUP-XINF))
  377. else
  378. TXX=REAL(XSUP)-(.010*(XSUP-XINF))
  379. endif
  380. CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN)
  381. ENDIF
  382.  
  383. *-------------------------------------------------------------
  384. * ECRITURE DES VALEURS DE GRADUATION SUR AXE X EN LOG
  385. *-------------------------------------------------------------
  386. ELSE
  387. GRAD=XINF
  388. c TXX=REAL(XINF)-(BG/4.)
  389. c TXX=REAL(XINF)-((BG+BD)/8.)
  390. c TXX=REAL(XINF)-(0.15*BG)
  391. TXX=REAL(XINF)-(0.10*BG)
  392. c TYY=REAL(YINF)-.06*(YSUP-YINF)
  393. TYY=REAL(YINF)-.07*(YSUP-YINF)
  394. DO 8 I=1,INX+1
  395. IP=INT(GRAD)
  396. c BUFFER(1:6)='1.E '
  397. c ideb=4
  398. BUFFER(1:10)='10^{ '
  399. ideb=5
  400. IF (IP.LE.-100) THEN
  401. ideb2=ideb+4
  402. WRITE (BUFFER(ideb:ideb+3),FMT='(I4)') IP
  403. ELSEIF (IP.GT.-100 .AND. IP.LE.-10) THEN
  404. ideb2=ideb+3
  405. WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP
  406. ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN
  407. ideb2=ideb+2
  408. WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
  409. ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN
  410. ideb2=ideb+1
  411. WRITE (BUFFER(ideb:ideb) ,FMT='(I1)') IP
  412. ELSEIF (IP.GE.10 .AND. IP.LT.100) THEN
  413. ideb2=ideb+2
  414. WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
  415. ELSEIF (IP.GE.100) THEN
  416. ideb2=ideb+3
  417. WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP
  418. ENDIF
  419. BUFFER(ideb2:ideb2)='}'
  420. CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN)
  421. TXX=TXX+XINT
  422. GRAD=GRAD+XINT
  423. 8 CONTINUE
  424. *
  425. IF ((XSUP-XINF) .LE. 9.D0) THEN
  426. * ECRITURE DES VALEURS DE SOUS-GRADUATION SUR AXE X EN LOG
  427. * UNIQUEMENT SI LA GAMME EST SUR MOINS DE 9 DECADS
  428. DO 9 J=1,7,2
  429. IF (J.EQ.1) THEN
  430. TXX=REAL(XINF)
  431. ELSE
  432. TXX=REAL(XINF)+LOG10(REAL(J)-1.0)
  433. ENDIF
  434. TXX=TXX - 0.07*REAL(BG)
  435. TYY=REAL(YINF)-(0.25*BB)
  436. DO 10 I=1,INX
  437. JJ=1
  438. IF (J.GT.1) JJ=J-1
  439. WRITE (BUFFER(1:1),FMT='(I1)') JJ
  440. CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN)
  441. TXX=TXX+REAL(XINT)
  442. IF ((I.EQ.INX).AND.(J.EQ.1)) THEN
  443. JJ=1
  444. WRITE (BUFFER(1:1),FMT='(I1)') JJ
  445. CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN)
  446. ENDIF
  447. 10 CONTINUE
  448. 9 CONTINUE
  449. ENDIF
  450. ENDIF
  451.  
  452.  
  453. *-------------------------------------------------------------
  454. * ECRITURE DES VALEURS DE GRADUATION SUR AXE Y EN LINEAIRE
  455. *-------------------------------------------------------------
  456. IF (.NOT.ZLOGY) THEN
  457. *
  458. CALL LENCHA(MYFMT,LMY)
  459. IF (LMY.gt.2) THEN
  460. READ(MYFMT(3:3),FMT='(I1)',IOSTAT=IOS) LFIN
  461. IF (MYFMT(2:2).eq.'I') THEN
  462. IP=0
  463. ELSE
  464. IP=ICALP(YINF,YSUP)
  465. ENDIF
  466. ELSE
  467. IP=ICALP(YINF,YSUP)
  468. ENDIF
  469. *
  470. * Combien de decimales utilise t'on (pour toutes les graduations)?
  471. GRAD=YINF
  472. ZDEC2=.true.
  473. ZDEC1=.true.
  474. DO I=1,INY+1
  475. CH=GRAD/10.D0**FLOAT(IP)
  476. * on commence par arrondir
  477. CH = DBLE(NINT(100000.D0*CH))/100000.D0
  478. * les 2 premieres decimales de CH sont elles nulles (<=>KCH2=0)?
  479. * on l'ecrit comme un INTEGER
  480. KCH2=INT(100.D0*(CH-DBLE(INT(CH))))
  481. IF(KCH2.NE.0) ZDEC2=.false.
  482. * la 1 premieres decimales de CH est elle nulle (<=>KCH1=0)?
  483. KCH1=KCH2-10*INT(10.D0*(CH-DBLE(INT(CH))))
  484. IF(KCH1.NE.0) ZDEC1=.false.
  485. GRAD=GRAD+YINT
  486. ENDDO
  487. *
  488. * INITIALISATION DES VALEURS POUR LE TRACE
  489. *
  490. GRAD=YINF
  491. TYY=REAL(YINF)
  492. c si postscript, on se decale de l'axe de maniere a arriver a ras
  493. c + on indique qu on veut etre aligne a droite
  494. IF (IOGRA.ge.7.and.IOGRA.le.9) then
  495. TXX=REAL(XINF)-(BG*0.10)
  496. INFOTR(2)=3
  497. else
  498. c si pas postscript, on se decale de l'axe de maniere approximative
  499. TXX=REAL(XINF)-(BG*0.9)
  500. endif
  501. *
  502. * BOUCLE POUR CHAQUE PAS
  503. *
  504. DO 11 I=1,INY+1
  505. CH=GRAD/10.D0**FLOAT(IP)
  506. *bp, 2015/12/08: on commence par arrondir pour eviter pb avec des 9.9999
  507. CH = DBLE(NINT(100000.D0*CH))/100000.D0
  508. * FORMATTAGE DES VALEURS DE GRADUATION
  509. BUFFER(1:10)=' '
  510. * -cas format impose
  511. IF((LMY.gt.2).and.(MYFMT(1:1).EQ.'(')) THEN
  512. IF(CH.GE.0.D0.AND.CH.LT.10.D0) THEN
  513. IDEB=2
  514. ELSE
  515. IDEB=1
  516. ENDIF
  517. IFIN = IDEB+LFIN-1
  518. IF(MYFMT(2:2).eq.'I') THEN
  519. WRITE (BUFFER(IDEB:IFIN),FMT=MYFMT(1:LMY)) INT(CH)
  520. ELSE
  521. WRITE (BUFFER(IDEB:IFIN),FMT=MYFMT(1:LMY)) CH
  522. ENDIF
  523. * -cas format automatique
  524. ELSE
  525. c write(*,*) 'Y:',I,ZDEC2,ZDEC1,CH,(CH.LE.-10.D0)
  526. IF(ZDEC2) THEN
  527. IF (CH.LE.-1000.D0) THEN
  528. WRITE (BUFFER(1:9),FMT='(I5)') NINT(CH)
  529. ELSEIF (CH.GT.-1000.D0.AND.CH.LE.-100.D0) THEN
  530. WRITE (BUFFER(1:9),FMT='(I4)') NINT(CH)
  531. ELSEIF (CH.GT.-100.D0.AND.CH.LE.-10.D0) THEN
  532. WRITE (BUFFER(1:9),FMT='(I3)') NINT(CH)
  533. ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN
  534. WRITE (BUFFER(1:9),FMT='(I2)') NINT(CH)
  535. ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN
  536. WRITE (BUFFER(1:9),FMT='(I1)') NINT(CH)
  537. ELSEIF (CH.GE.10.D0.AND.CH.LT.100.D0) THEN
  538. WRITE (BUFFER(1:9),FMT='(I2)') NINT(CH)
  539. ELSEIF (CH.GE.100.D0.AND.CH.LT.1000.D0) THEN
  540. WRITE (BUFFER(1:9),FMT='(I3)') NINT(CH)
  541. ELSEIF (CH.GE.1000.D0) THEN
  542. WRITE (BUFFER(1:9),FMT='(I4)') NINT(CH)
  543. ENDIF
  544. ELSEIF(ZDEC1) THEN
  545. IF (CH.LE.-1000.D0) THEN
  546. WRITE (BUFFER(1:9),FMT='(F7.1)') CH
  547. ELSEIF (CH.GT.-1000.D0.AND.CH.LE.-100.D0) THEN
  548. WRITE (BUFFER(1:9),FMT='(F6.1)') CH
  549. ELSEIF (CH.GT.-100.D0.AND.CH.LE.-10.D0) THEN
  550. WRITE (BUFFER(1:9),FMT='(F5.1)') CH
  551. ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN
  552. WRITE (BUFFER(1:9),FMT='(F4.1)') CH
  553. ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN
  554. WRITE (BUFFER(1:9),FMT='(F3.1)') CH
  555. ELSEIF (CH.GE.10.D0.AND.CH.LT.100.D0) THEN
  556. WRITE (BUFFER(1:9),FMT='(F4.1)') CH
  557. ELSEIF (CH.GE.100.D0.AND.CH.LT.1000.D0) THEN
  558. WRITE (BUFFER(1:9),FMT='(F5.1)') CH
  559. ELSEIF (CH.GE.1000.D0) THEN
  560. WRITE (BUFFER(1:9),FMT='(F6.1)') CH
  561. ENDIF
  562. ELSE
  563. IF (CH.LE.-1000.D0) THEN
  564. WRITE (BUFFER(1:9),FMT='(F8.2)') CH
  565. ELSEIF (CH.GT.-1000.D0.AND.CH.LE.-100.D0) THEN
  566. WRITE (BUFFER(1:9),FMT='(F7.2)') CH
  567. ELSEIF (CH.GT.-100.D0.AND.CH.LE.-10.D0) THEN
  568. WRITE (BUFFER(1:9),FMT='(F6.2)') CH
  569. ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN
  570. WRITE (BUFFER(1:9),FMT='(F5.2)') CH
  571. ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN
  572. WRITE (BUFFER(1:9),FMT='(F4.2)') CH
  573. ELSEIF (CH.GE.10.D0.AND.CH.LT.100.D0) THEN
  574. WRITE (BUFFER(1:9),FMT='(F5.2)') CH
  575. ELSEIF (CH.GE.100.D0.AND.CH.LT.1000.D0) THEN
  576. WRITE (BUFFER(1:9),FMT='(F6.2)') CH
  577. ELSEIF (CH.GE.1000.D0) THEN
  578. WRITE (BUFFER(1:9),FMT='(F7.2)') CH
  579. ENDIF
  580. ENDIF
  581. ENDIF
  582. * ECRITURE DE LA GRADUATION
  583. CALL TRLABL (TXX,TYY,0.,BUFFER(1:9),9,HMIN)
  584. TYY=TYY+REAL(YINT)
  585. GRAD=GRAD+YINT
  586. 11 CONTINUE
  587.  
  588. INFOTR(2)=0
  589. *
  590. * ECRITURE APRES FORMATTAGE DE P
  591. *
  592. IF (IP.NE.0) THEN
  593. c BUFFER(1:10)='x1.E '
  594. c ideb=5
  595. BUFFER(1:10)='x10^{ '
  596. ideb=6
  597. IF (IP.LE.-10) THEN
  598. ideb2=ideb+3
  599. WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP
  600. ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN
  601. ideb2=ideb+2
  602. WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
  603. ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN
  604. ideb2=ideb+1
  605. WRITE (BUFFER(ideb:ideb),FMT='(I1)') IP
  606. ELSEIF (IP.GE.10) THEN
  607. ideb2=ideb+2
  608. WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
  609. ENDIF
  610. BUFFER(ideb2:ideb2)='}'
  611. TXX=REAL(XINF)-(BG*0.9)
  612. TYY=REAL((YSUP)+.05*(YSUP-YINF))
  613. CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN)
  614. ENDIF
  615. *
  616. *-------------------------------------------------------------
  617. * ECRITURE DES VALEURS DE GRADUATION SUR AXE Y EN LOG
  618. *-------------------------------------------------------------
  619. ELSE
  620. GRAD=YINF
  621. c TXX=REAL(XINF)-(BG*0.99)
  622. c TXX=REAL(XINF)-(BG*0.8)
  623. IF ((YSUP-YINF).LE.6.D0) THEN
  624. TXX=REAL(XINF)-(BG*0.82)
  625. ELSE
  626. TXX=REAL(XINF)-(BG*0.77)
  627. ENDIF
  628. TYY=REAL(YINF)
  629. DO 12 I=1,INY+1
  630. cbpessai * on saute 1 sur 2 si plus de 20
  631. cbpessai if(INY.LE.20.or.MOD(I,2).ne.0) then
  632. IP=INT(GRAD)
  633. c BUFFER(1:3)='1.E'
  634. c ideb=4
  635. BUFFER(1:10)='10^{ '
  636. ideb=5
  637. IF (IP.LE.-100) THEN
  638. ideb2=ideb+4
  639. WRITE (BUFFER(ideb:ideb+3),FMT='(I4)') IP
  640. ELSEIF (IP.GT.-100 .AND. IP.LE.-10) THEN
  641. ideb2=ideb+3
  642. WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP
  643. ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN
  644. ideb2=ideb+2
  645. WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
  646. ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN
  647. ideb2=ideb+1
  648. WRITE (BUFFER(ideb:ideb) ,FMT='(I1)') IP
  649. ELSEIF (IP.GE.10 .AND. IP.LT.100) THEN
  650. ideb2=ideb+2
  651. WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
  652. ELSEIF (IP.GE.100) THEN
  653. ideb2=ideb+3
  654. WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP
  655. ENDIF
  656. BUFFER(ideb2:ideb2)='}'
  657. CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN)
  658. TYY=TYY+REAL(YINT)
  659. GRAD=GRAD+YINT
  660. 12 CONTINUE
  661. *
  662. IF ((YSUP-YINF) .LE. 6.D0) THEN
  663. * ECRITURE DES VALEURS DE SOUS-GRADUATION SUR AXE Y EN LOG
  664. * UNIQUEMENT SI LA GAMME EST SUR MOINS DE 6 DECADS
  665. DO 13 J=1,7,2
  666. IF (J.EQ.1) THEN
  667. TYY=REAL(YINF)
  668. ELSE
  669. TYY=REAL(YINF)+LOG10(REAL(J)-1.0)
  670. ENDIF
  671. TYY=TYY - real(BB)/30.0
  672. TXX=REAL(XINF)-REAL(0.2*BG)
  673. DO 14 I=1,INY
  674. JJ=1
  675. IF (J.GT.1) JJ=J-1
  676. WRITE(BUFFER(1:1),FMT='(I1)') JJ
  677. CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN)
  678. TYY=TYY+YINT
  679. IF ((I.EQ.INY).AND.(J.EQ.1)) THEN
  680. JJ=1
  681. WRITE(BUFFER(1:1),FMT='(I1)') JJ
  682. CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN)
  683. ENDIF
  684. 14 CONTINUE
  685. 13 CONTINUE
  686. ENDIF
  687. ENDIF
  688.  
  689.  
  690. *=============================================================
  691. * TRACE DE GRILLE
  692. *=============================================================
  693. IF (ZGRILL) THEN
  694. c grille en gris ?
  695. icoul1=icoul0
  696. if(IGRIL.lt.0) then
  697. icoul1=15
  698. CALL CHCOUL(icoul1)
  699. endif
  700.  
  701. c bp faut-il faire des pointillés?
  702. IGRILA= abs(IGRIL)
  703. ZTIRET=(IGRILA.gt.1)
  704. IGRIL1= IGRILA-1
  705. DXEVL = XSUP-XINF
  706. DL = DXEVL/100.D0
  707. ZTRAC =.TRUE.
  708.  
  709. * trace grille secondaire (nonlineaire) si axe x en log
  710. * (en pointillés gris)
  711. IF (ZLOGX) THEN
  712. CALL CHCOUL(15)
  713. GRAD=XINF
  714. DO 151 I=1,INX
  715. TX1=REAL(GRAD+FLOAT(I-1)*XINT)
  716. * trace grille non lineaire si axe x en log (pointillés gris)
  717. DO 155 J=2,9,1
  718. TX(1)=TX1+LOG10(REAL(J))*XINT
  719. TX(2)=TX(1)
  720. TY(1)=REAL(YINF)
  721. TY(2)=REAL(YSUP)
  722. CALL TRSEG (IPTR,TX,TY,.true.,5,DL,ZTRAC)
  723. 155 CONTINUE
  724. 151 CONTINUE
  725. CALL CHCOUL(icoul1)
  726. ENDIF
  727.  
  728. c grille des x
  729. IF (INX.GT.1)THEN
  730. GRAD=XINF
  731. DO 15 I=1,INX-1
  732. TX(1)=REAL(GRAD+FLOAT(I)*XINT)
  733. TX(2)=TX(1)
  734. TY(1)=REAL(YINF)
  735. TY(2)=REAL(YSUP)
  736. c CALL POLRL (2,TX,TY,tz)
  737. CALL TRSEG (IPTR,TX,TY,ZTIRET,IGRIL1,DL,ZTRAC)
  738. 15 CONTINUE
  739. ENDIF
  740.  
  741. * trace grille secondaire (nonlineaire) si axe y en log
  742. * (en pointillés gris)
  743. IF (ZLOGY) THEN
  744. CALL CHCOUL(15)
  745. GRAD=YINF
  746. DO 161 I=1,INY
  747. TY1=REAL(GRAD+FLOAT(I-1)*YINT)
  748. * trace grille non lineaire si axe y en log (pointillés gris)
  749. DO 165 J=2,9,1
  750. TX(1)=REAL(XINF)
  751. TX(2)=REAL(XSUP)
  752. TY(1)=TY1+LOG10(REAL(J))*YINT
  753. TY(2)=TY(1)
  754. CALL TRSEG(IPTR,TX,TY,.true.,5,DL,ZTRAC)
  755. 165 CONTINUE
  756. 161 CONTINUE
  757. CALL CHCOUL(icoul1)
  758. ENDIF
  759.  
  760. c grille des y
  761. IF (INY.GT.1)THEN
  762. GRAD=YINF
  763. DO 16 I=1,INY-1
  764. TX(1)=REAL(XINF)
  765. TX(2)=REAL(XSUP)
  766. TY(1)=REAL(GRAD+FLOAT(I)*YINT)
  767. TY(2)=TY(1)
  768. c CALL POLRL (2,TX,TY,tz)
  769. CALL TRSEG (IPTR,TX,TY,ZTIRET,IGRIL1,DL,ZTRAC)
  770. 16 CONTINUE
  771. ENDIF
  772.  
  773. c on remet la couleur des axes
  774. CALL CHCOUL(icoul0)
  775.  
  776. ENDIF
  777.  
  778.  
  779. *=============================================================
  780. * TRACE DES AXES Ox et Oy, UNIQUEMENT EN LINEAIRE
  781. *=============================================================
  782. *
  783. IF (ZAXES) THEN
  784. IF (.NOT.ZLOGX.AND.XINF*XSUP.LE.0.D0) THEN
  785. TX(1)=0.
  786. TX(2)=0.
  787. TY(1)=REAL(YINF)
  788. TY(2)=REAL(YSUP)+3.*TDELTY
  789. CALL POLRL (2,TX,TY,tz)
  790. TX(1)=-0.5*TDELTX
  791. TX(3)=0.5*TDELTX
  792. TY(1)=TY(2)-TDELTY
  793. TY(3)=TY(1)
  794. CALL POLRL (3,TX,TY,tz)
  795. * BUFFER(1:2)='Oy'
  796. * TXX=TDELTX
  797. * TYY=REAL(YSUP)+2.*TDELTY
  798. * CALL TRLABL(TXX,TYY,0.,BUFFER(1:2),2,HMIN)
  799. ENDIF
  800. IF (.NOT.ZLOGY.AND.YINF*YSUP.LE.0.D0) THEN
  801. TX(1)=REAL(XINF)
  802. TX(2)=REAL(XSUP)+3.*TDELTX
  803. TY(1)=0.
  804. TY(2)=0.
  805. CALL POLRL (2,TX,TY,tz)
  806. TY(1)=0.5*TDELTY
  807. TY(3)=-0.5*TDELTY
  808. TX(1)=TX(2)-TDELTX
  809. TX(3)=TX(1)
  810. CALL POLRL (3,TX,TY,tz)
  811. * BUFFER(1:2)='Ox'
  812. * TXX=REAL(XSUP)+3.*TDELTX
  813. * TYY=-2.*TDELTY
  814. * CALL TRLABL(TXX,TYY,0.,BUFFER(1:2),2,HMIN)
  815. ENDIF
  816. ENDIF
  817. *
  818. *PM SEGDES AXE
  819. *
  820. END
  821.  
  822.  
  823.  
  824.  
  825.  
  826.  
  827.  
  828.  
  829.  
  830.  
  831.  
  832.  
  833.  
  834.  
  835.  
  836.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales