Télécharger intaxe.eso

Retour à la liste

Numérotation des lignes :

  1. C INTAXE SOURCE CB215821 19/06/17 21:15:15 10229
  2.  
  3. SUBROUTINE INTAXE(BMIN,BMAX,BINT,IN,ZLOG,ZARR)
  4.  
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Y)
  7.  
  8. IMPLICIT LOGICAL (Z)
  9. *
  10. * BMIN (E) BORNE MINI
  11. * BMAX (E) BORNE MAXI
  12. * BINT (S) PAS DE GRADUATION
  13. * IN (S) NOMBRE DE SEGMENTS
  14. * ZLOG (E) INDIQUATION SI AXE EN LOGARITHMIQUE
  15. * ZARR (E) VRAI => AXE NON NORMALISE
  16. *
  17. * PAS DE GRADUATION POSSIBLE
  18. DIMENSION PAS(11)
  19. DATA PAS/0.01D0,0.02d0,0.05D0,0.1D0,0.2D0,0.5D0,1.D0,
  20. $ 2.D0,5.D0,10.D0,20.D0/
  21. *
  22. DIST =ABS(BMAX-BMIN)
  23. binima=bmax
  24. binimi=bmin
  25.  
  26. * ------
  27. * LOG : LES BORNES SONT DES ENTIERS
  28. * ------
  29. IF (ZLOG) THEN
  30. C Taille des intervalles
  31. IN =MIN(CEILING(DIST),12)
  32. BINT=REAL(MAX(NINT(DIST / REAL(IN)),1))
  33.  
  34. C Recallage pour tomber sur des entiers en puissance de 10
  35. IN =NINT(DIST/BINT)
  36. BMAX=BMIN + REAL(IN*BINT)
  37. ELSE
  38.  
  39. * ----------
  40. * DECIMAL :
  41. * ----------
  42. * INITIALISATION IP
  43. *
  44. IP = ICALP(BMIN,BMAX)
  45. P10IP = 10.D0**REAL(IP)
  46.  
  47. * DETERMINATION DU COEFF. CORRECTEUR POUR LES BORNES
  48.  
  49. IF (BMIN .LT. 0.D0) THEN
  50. CORR1=-1.D0
  51. ELSE
  52. CORR1=0.D0
  53. ENDIF
  54. IF (BMAX .LT. 0.D0) THEN
  55. CORR2=0.D0
  56. ELSE
  57. CORR2=1.D0
  58. ENDIF
  59. *
  60. * bminin = bmin
  61. * bmaxin = bmax
  62. *
  63. * Pour affichage et deverminage :
  64. * binima=bmax
  65. * binimi=bmin
  66. *
  67. * AXE NON NORMALISE
  68. *
  69. IF (ZARR) THEN
  70. * RAMENE LES BORNES A UNE FORME XX.XX EXX
  71. * ARRONDI EN 10-2 PUISQUE LES ECHELLES SONT GRADUEES EN 10-2
  72. BMIN=BMIN/P10IP
  73. BMAX=BMAX/P10IP
  74. IF(ABS(AINT(BMIN*100.D0)-(BMIN*100.d0)).GT.ABS(BMIN*0.001D0))
  75. * BMIN=AINT(BMIN*100.D0+CORR1)/100.D0
  76. IF(ABS(AINT(BMAX*100.D0)-(BMAX*100.D0)).GT.ABS(BMAX*0.001D0))
  77. * BMAX=AINT(BMAX*100.D0+CORR2)/100.D0
  78. DIST=ABS(BMAX-BMIN)
  79. * RECHERCHE UN PAS EN 10-2 PERMETTANT D'AVOIR DE 5 A 10 DIVISIONS
  80. I=11
  81. 1 I=I-1
  82. DIST2=DIST/I
  83. ZNE=ABS((DIST2*100.D0)-(AINT(DIST2*100.D0))).GT.
  84. $ (ABS(DIST2*0.001D0))
  85. cbp IF ((I.NE.4).AND.ZNE) GOTO 1
  86. cbp : incoherence avec la notice --> si NARR ou YBOR on impose YSUP et YINF
  87. cbp : on cherche de 10 a 1 divisions
  88. IF ((I.NE.1).AND.ZNE) GOTO 1
  89. * SORTIE QUAND LE PAS EST EN 10-2
  90. IF (.NOT.ZNE) THEN
  91. IN=I
  92. BINT=DIST2* P10IP
  93. BMIN=BMIN * P10IP
  94. BMAX=BMAX * P10IP
  95. ELSE
  96. c * RECALCUL DES BORNES DE FACON A AVOIR UN PAS EN 10-2
  97. c IN=10
  98. c DIST2=ABS(BMAX-BMIN)/10.D0
  99. c DIST2=AINT(DIST2*100.D0+1.D0)/100.D0
  100. c BINT=DIST2* P10IP
  101. c BMIN=BMIN * P10IP
  102. c BMAX=BMIN+10.D0*BINT
  103. cbp : incoherence avec la notice --> si NARR ou YBOR on impose YSUP et YINF
  104. IN=I
  105. BINT=DIST2* P10IP
  106. BMIN=BMIN * P10IP
  107. BMAX=BMAX * P10IP
  108. ENDIF
  109.  
  110.  
  111. ELSE
  112. *
  113. * AXE NORMALISE
  114. *
  115. D=DIST/P10IP
  116. *
  117. * SELECTION DU PREMIER PAS
  118. DO 2 I=1,11
  119. IF (((PAS(I)*10.D0)-D).GT.1.D-2) GOTO 3
  120. 2 CONTINUE
  121.  
  122. * RAMENE LES BORNES A UNE EXPRESSION EN XX.XX E XX
  123. 3 CONTINUE
  124. BI=BMIN/P10IP
  125. BS=BMAX/P10IP
  126. IF(AINT(BI*100.D0).NE.BI*100.D0)BI=AINT(BI*100.D0+CORR1)/100.D0
  127. IF(AINT(BS*100.D0).NE.BS*100.D0)BS=AINT(BS*100.D0+CORR2)/100.D0
  128. * DEMANDE A AVOIR DES BORNES MULTIPLES DU PAS
  129. IM=mod(i-1,3)+1
  130. PASM=PAS(IM) * (10.D0**((i-im)/3))
  131. BI=ARROND(BI,PASM,0)
  132. BS=ARROND(BS,PASM,1)
  133. D1=BS-BI
  134. R=D1/PASM
  135. * COMPTE TENU DES CORRECTIONS DE ARROND , LE PAS PEUT NE PLUS ETRE
  136. * VALIDE => ON ESSAIE LE PAS SUIVANT
  137. IF (R.GT.10.D0) THEN
  138. I=I+1
  139. GOTO 3
  140. ENDIF
  141. * ON REDRESSE TOUT ET ON SORT
  142. *
  143. * TC je ne comprends pas comment ne pas faire d'erreur donc je m'assure
  144. * que le resultat a un sens
  145. *
  146. BMIN=BI * P10IP
  147. BMAX=BS * P10IP
  148. pasm10=pasm * P10IP
  149. 100 continue
  150. imodi=0
  151. * write(6,*) ' avant correction '
  152. * write(6,*) ' bmin binimi bmax binima'
  153. * write(6,*) bmin ,binimi ,bmax, binima
  154. if( bmin+pasm10.lt.binimi ) then
  155. bmin=bmin+pasm10
  156. imodi=imodi+8
  157. endif
  158. if( binimi.lt.bmin) then
  159. bmin=bmin-pasm10
  160. imodi = imodi+1
  161. endif
  162.  
  163. if( bmax.lt. binima) then
  164. bmax=bmax + pasm10
  165. imodi=imodi+2
  166. endif
  167. if( bmax - pasm10.gt.binima ) then
  168. bmax=bmax- pasm10
  169. imodi=imodi +4
  170. endif
  171. if( imodi.ne.0) then
  172. * write(6,*) ' imodi ' , imodi
  173. go to 100
  174. endif
  175.  
  176. * write(6,*) ' apres correction '
  177. * write(6,*) ' bmin binimi bmax binima'
  178. * write(6,*) bmin ,binimi ,bmax, binima
  179. in= int( (Bmax-bmin)/pasm10 + 0.5)
  180. BINT=PASM * P10IP
  181. ENDIF
  182.  
  183. ENDIF
  184.  
  185. END
  186.  
  187.  

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