subroutine rounf (rmax,rmin,iaxdig,iindig,raxbas,rinbas, & rup,rlo,ntic,tico,ticp,ticlen,ialg) c c rounds off the given maximum and minimum number, the digits c of which are supplied in arrays 'iaxdig' & 'iindig', c and the multipliers in 'raxbas' & 'rinbas'. c Returned arguments are: upper and lower extremes c 'rup' & 'rlo', number of tics 'ntic', upper and c lower values of the tics 'ticp' & 'tico', and c the length between tics 'ticlen'. c 'ialg' is the input value (1 or 2) to indicate c which algorithm will be used to calculate the c number of tics, default value is 2. c dimension iaxdig(10),iindig(10),dene(15) c data dene /210.,105.,70.,35.,30.,25.,15.,10.,9., & 7.,6.,5.,4.,3.,2./ c d type *,'************......rounf......************' if (ialg.eq.0) ialg=2 c---------------------------------------------------------- 100 i=1 recmax=0. recmin=0. dumbax=raxbas dumbin=rinbas 110 iax=iaxdig(i) iin=iindig(i) if (dumbax.gt.dumbin) go to 120 ider=iax-iin if (ider.ne.0) go to 120 i=i+1 recmax=recmax+float(iax)*dumbax recmin=recmin+float(iin)*dumbin dumbax=dumbax/10. dumbin=dumbin/10. if (i.eq.9) go to 115 go to 110 115 type *,' All digit for max. and min. are equal--ERROR! ' call exit c-------------------------------------------------------------- 120 iax1=iaxdig(i+1) iax2=iaxdig(i+2) iin1=iindig(i+1) iin2=iindig(i+2) c-----upper extremes iduax1=iax1+1 if (dumbax.eq.dumbin) go to 140 c------------------------------------------------------------- c define upper extreme for different multipiers of max. c and min. idupx=iaxdig(2)+1 go to (122,122,122,123,123,123,123,123,124,124) idupx 122 axm2=0. rup=rmax go to 125 123 axm2=5. rup=rmax if ( iaxdig(2).lt.5 ) rup=ticp go to 125 124 axm2=10. rup=ticp 125 ticp=float(iaxdig(1))*raxbas + axm2*raxbas/10. if (rmin.ne.0.) go to 126 rup=rmax if (rmax.lt.ticp) rup=ticp 126 if ( ((rmax-rmin)/rinbas).gt.20. ) go to 180 ticp=float(iaxdig(1))*raxbas + (float(iaxdig(2))+1.)* & raxbas/10. rup=ticp d type *, ' <126>..... ' d type *, ' iaxdig(1)=',iaxdig(1),' iaxdig(2)=', d & iaxdig(2),' raxbas=',raxbas d type *, ' mx.ne.mn: ticp=',ticp,' rup=',rup go to 180 c------------------------------------------------------------- c-----equal multiplier 140 go to (150,150,150,160,160,160,160,160,170,170) iduax1 150 ticp=recmax+float(iax)*dumbax rup=rmax go to 180 160 ticp=recmax+( float(iax)+.5 )*dumbax if (iax1.lt.5) rup=ticp if (iax1.ge.5) rup=rmax go to 180 170 ticp=recmax+( float(iax)+1. )*dumbax rup=ticp 180 continue d type *,' <180>...recmax=',recmax d type *,' iax=',iax,' ticp=',ticp c------------------------------------------------------------- c-----lower extremes iduin1=iin1+1 go to (190,190,190,200,200,200,200,200,210,210) iduin1 190 tico=recmin+float(iin)*dumbin rlo=tico go to 220 200 tico=recmin+( float(iin)+.5 )*dumbin if (iin1.lt.5) rlo=rmin if (iin1.ge.5) rlo=tico go to 220 210 tico=recmin+( float(iin)+1. )*dumbin rlo=rmin 220 continue d type *,' <220>.. recmin=',recmin d type *,' iin=',iin,' tico=',tico c--------------------------------------------------------------- c two algorithms to find no. of tics range=ticp-tico if ( range.gt.0.01 ) go to 221 ticp=( float(iax) + float(iax1)/10. + (float(iax2)+1)/100. ) & *dumbax + recmax tico=( float(iin) + float(iin1)/10. + float(iin2)/100. ) & *dumbin + recmin range=ticp-tico range=range+0.001 dumlen=range/2. dumtic=2. d type *,' before <221> iax1=',iax1,' iin1=',iin1 d type *,' iax2=',iax2,' iin2=',iin2 d type *,' ticp=',ticp,' tico=',tico d type *,' dumlen=',dumlen,' dumtic=',dumtic go to 250 c--------------------------------------------------------------- 221 continue d type *,' <220>.... ' d type *,'tico,ticp,rlo,rup,range',tico,ticp,rlo,rup,range if (dumbax.ne.dumbin) go to 222 if (ialg.eq.2) go to 240 go to 225 222 continue c-----define variables for different multipiers of max. & min. d type *,' <222>.... ' d type *,' dumbax.ne.dumbin! dumbax=',dumbax,' dumbin=',dumbin if ( ((ticp-tico)/dumbin).le.20. ) go to 224 tico=0. range=ticp go to 240 224 ticp=float(iax)*dumbax+( float(iax1)+1. )*dumbax/10. rup=ticp d type *,' <224>.. iax=',iax,' iax1=',iax1,' ticp=',ticp 225 ialg=1 c-----algorithm 1---divided by selected constants d type *,' <225>.....Algorithm 1: ' do 230 in=1,15 dumlen=dene(in) tesval=amod(range,dumlen) d type *,' <230>: tesval=',tesval,' dene(in)=',dene(in), d & ' range=',range if (tesval.ne.0.) go to 230 229 dumtic=range/dumlen ticp=tico+range d type *,' <229>.....dumtic=',dumtic,' ticp=',ticp d type *,' dumlen=',dumlen,' range=',range if (dumtic.gt.10.) go to 240 go to 250 230 continue c-----algorithm 2---increment of dumbax/2. 240 dumlen=dumbax/2. 245 dumtic=range/dumlen d type *,' <245>....Algorithm 2: ' d type *,' dumtic=',dumtic,' dumlen=',dumlen if (dumtic.le.10.) go to 250 dumlen=dumbax d type *,' Algorithm 2:(loop) ' go to 245 c-----limit the no. of tics to less than 8 250 dumtic=dumtic+0.0001 !round-off error correction idutic=irnd(dumtic) d type *,' <250>....idutic=',idutic,' dumtic=',dumtic go to (270,300,300,260,300,260,280,260,255,260) idutic 255 dumlen=dumlen*3 dumtic=dumtic/3. go to 300 260 dumlen=dumlen*2. dumtic=dumtic/2. go to 300 270 dumlen=dumlen/2. dumtic=dumtic*2. go to 300 280 dumtic=3. dumlen=dumlen*2. rup=rmax if ( (rup-ticp) .lt. dumlen ) go to 285 dumtic=4. 285 ticp=tico+dumlen*dumtic 300 ntic=irnd(dumtic) ticlen=dumlen recrup=ticlen*ntic dfr=recrup-range d type *,' <300>... range=',range,' recrup=',recrup d type *,' ticp=',ticp,' tico=',tico d type *,' ntic=',ntic,' ticlen=',ticlen if (dfr.gt.0.01) go to 400 if (recrup.lt.range) go to 450 if (recrup.eq.range) rup=rmax go to 500 400 ticp=recrup+tico rup =ticp d type *,' <400>...' go to 500 450 rup=rmax ticp=recrup+tico c 500 continue iron=1 501 tickn=float (ntic) ranged=ticp-tico if ( ranged.lt.50. ) go to 505 remd=amod (ranged,tickn) !adjustment only for large d type *,' <501>... ' !amplitude. d type *,' ranged=',ranged,' ticp=',ticp,' tico=',tico if (remd.lt.0.01) go to 505 addon=tickn-remd ranew=ranged+addon ticlen=ranew/tickn ticp=tico+ranew d type *,' ... ranew=',ranew d type *,' addon=',addon,' remd=',remd,' tickn=',tickn 505 if (rup.lt.ticp) rup=ticp if (rlo.gt.tico) rlo=tico d type *,'------------------ROUNF------------------' d type *,' rup=',rup,' rlo=',rlo d type *,' ticp=',ticp,' tico=',tico d type *,' ntic=',ntic,' ticlen=',ticlen d type *,' recrup=',recrup,' range=',range, d type *,'-----------------------------------------' return end