Subroutine Digit (reval,baseln,idig) c c subroutine to find each digit of the input real value c 'reval', and store in the array 'idig'. 'baseln' gives c the multipier of the first digit of the input. c the last element of 'idig' give the sign of 'reval', c where 1: negative and 0: positive c Dimension idig(10) Real reval,baseln c do 10,k=1,10 10 idig(k)=0 if (reval.ne.0.) go to 20 if (reval.eq.0.) baseln=1. return 20 idig(10)=0 if (reval.lt.0.) idig(10)=1 absval= abs (reval) valog =alog10(absval) ivalog=ifix (valog) baseln=10.**float(ivalog) c dumval=absval dumbas=baseln reconv=0. i=1 c 100 idigit=ifix (dumval/dumbas) c recopt=float(idigit*dumbas) c remain=dumval-recopt remain=amod(dumval,dumbas) idig(i)=idigit dumval=remain dumbas=dumbas/10. i=i+1 if (i.eq.9) go to 200 reconv=reconv+recopt if ( (absval-reconv) .eq. 0. ) go to 200 go to 100 c 200 continue c do 205 k=1,9 if (idig(k+1).eq.9.and.idig(k+2).eq.9) go to 203 go to 205 203 idig(k)=idig(k)+1 do 204 ih=k+1,9 204 idig(ih)=0 205 continue d type 210, reval,baseln,(idig(j),j=1,10) 210 format (' reval=',f10.3,' baseln=',f10.3,' idig(j)=',10i2) return end