Télécharger daxes.eso

Retour à la liste

Numérotation des lignes :

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

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