本算法可快速实现给定范围,刻度个数,自适应地获得应该显示的刻度值上下限,刻度值间距,及刻度值应该有多少位小数。
如下代码,运行后结果:
请输入坐标轴下限,上限:
3.13 5.67
3.0
3.5
4.0
4.5
5.0
5.5
6.0
请输入坐标轴下限,上限:
1123 5678
1000.
2000.
3000.
4000.
5000.
6000.
请输入坐标轴下限,上限:
103.130 103.156
103.125
103.130
103.135
103.140
103.145
103.150
103.155
103.160
请输入坐标轴下限,上限:
Module Fcode_Axes Implicit None contains Subroutine Get_Axes_Tick( rMinVal , rMaxVal , nTick , graphmin , graphmax , d , nfrac ) Real , Intent(IN) :: rMinVal , rMaxVal Integer , Intent(IN) :: nTick Integer , Intent(OUT) :: nfrac Real , Intent(OUT) :: d , graphmin , graphmax Real :: range , t , rmax , rmin rmax = rMaxVal rmin = rMinVal t = rmax - rmin if ( t < 10*tiny(t) ) then t = 1.0 rmax = rmax + 0.5 rmin = rmin - 0.5 end if range = nicenum( t , 0 ) d = nicenum( range / (nTick-1) , 1 ) graphmin = floor( rmin / d ) * d graphmax = ceiling( rmax / d ) * d nfrac = Max( -floor(log10(d)) , 0 ) End Subroutine Get_Axes_Tick Real Function NiceNum( x , round ) Real , target ,save :: rNC(4) = [1.5,3.,7.,1e37] , rNV(4) = [1.,2.,5.,1e37] Real , target ,save :: rNS(4) = [1.,2.,5.,10.] Real :: x , f , nf(1) integer :: expv , round Real , pointer :: pN(:) expv = floor(log10(x)) f = x / 10.0**expv If ( round /= 0 ) then pN => rNC Else pN => rNV End If nf = minloc( pN , mask=( f < pN ) ) NiceNum = rNS(nf(1)) * (10.**expv) End Function NiceNum End Module Fcode_Axes Program www_fcode_cn Use Fcode_Axes Implicit None Real :: r1 , r2 , rmin , rmax , d , r integer :: nf Do write( * , '("请输入坐标轴下限,上限:")') read( * , * ) r1 , r2 if ( r1 > r2 .or. abs(r1-r2)<1e-6 ) exit call Get_Axes_Tick( r1 , r2 , 5 , rmin , rmax , d , nf ) r = rmin do write(*,'(f16.<nf>)') r !//此处 <nf> 用法不标准 r = r + d if ( r > rmax ) exit end do End Do End Program www_fcode_cn