Télécharger intaxe.eso

Retour à la liste

Numérotation des lignes :

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

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