subroutine num2str1(num,str1) implicit none include 'max.inc' include 'formats.inc' c c Purpose: to convert an integer to a character string of size 1 c c Input: c + num: integer c c Output: c + str2: character string c c I/O integer num character*1 str1 c temp character*1 kch1 c label integer strlen character*(Nchar_mx) label label='subroutine num2str1' if ((num.ge.0).and.(num.lt.10)) then write(kch1,11) num str1=kch1(1:strlen(kch1)) else call error(label) write(*,*) 'num=',num,' >= 10' stop endif return end subroutine num2str2(num,str2) implicit none include 'max.inc' include 'formats.inc' c c Purpose: to convert an integer to a character string of size 2 c c Input: c + num: integer c c Output: c + str2: character string c c I/O integer num character*2 str2 c temp character*1 zeroch,kch1 character*2 kch2 c label integer strlen character*(Nchar_mx) label label='subroutine num2str2' write(zeroch,11) 0 if ((num.ge.0).and.(num.lt.10)) then write(kch1,11) num str2=zeroch(1:strlen(zeroch)) & //kch1(1:strlen(kch1)) else if ((num.ge.10).and.(num.lt.100)) then write(kch2,12) num str2=kch2(1:strlen(kch2)) else call error(label) write(*,*) 'num=',num,' >= 100' stop endif return end subroutine num2str3(num,str3) implicit none include 'max.inc' include 'formats.inc' c c Purpose: to convert an integer to a character string of size 3 c c Input: c + num: integer value (must be positive and less than 1000) c c Output: c + str3: character string of size 3 c c I/O integer num character*3 str3 c temp character*1 zeroch,kch1 character*2 kch2 c label integer strlen character*(Nchar_mx) label label='subroutine num2str3' write(zeroch,11) 0 if ((num.ge.0).and.(num.lt.10)) then write(kch1,11) num str3=zeroch(1:strlen(zeroch)) & //zeroch(1:strlen(zeroch)) & //kch1(1:strlen(kch1)) else if ((num.ge.10).and.(num.lt.100)) then write(kch2,12) num str3=zeroch(1:strlen(zeroch)) & //kch2(1:strlen(kch2)) else if ((num.ge.100).and.(num.lt.1000)) then write(str3,13) num else call error(label) write(*,*) 'num=',num,' >= 1000' stop endif return end subroutine num2str(num,str) implicit none include 'max.inc' include 'formats.inc' c c Purpose: to convert a positive integer to a character string c Warning: maximum string size is 10 characters, and maximum c value for "num" is 2147483647 c c Input: c + num: integer value c c Output: c + str: character string of size 10 c c I/O integer num character*10 str c temp character*1 s1 character*2 s2 character*3 s3 character*4 s4 character*5 s5 character*6 s6 character*7 s7 character*8 s8 character*9 s9 character*10 s10 c label integer strlen character*(Nchar_mx) label label='subroutine num2str' if ((num.ge.0).and.(num.lt.10)) then write(s1,11) num str=s1 else if ((num.ge.10).and.(num.lt.100)) then write(s2,12) num str=s2 else if ((num.ge.100).and.(num.lt.1000)) then write(s3,13) num str=s3 else if ((num.ge.1000).and.(num.lt.10000)) then write(s4,14) num str=s4 else if ((num.ge.10000).and.(num.lt.100000)) then write(s5,15) num str=s5 else if ((num.ge.100000).and.(num.lt.1000000)) then write(s6,16) num str=s6 else if ((num.ge.1000000).and.(num.lt.10000000)) then write(s7,17) num str=s7 else if ((num.ge.10000000).and.(num.lt.100000000)) then write(s8,18) num str=s8 else if ((num.ge.100000000).and.(num.lt.1000000000)) then write(s9,19) num str=s9 else if ((num.ge.1000000000).and.(num.le.2147483647)) then write(s10,110) num str=s10 else call error(label) write(*,*) 'Bad input argument:' write(*,*) 'num=',num stop endif return end subroutine dble2str(num,nap,str,err) implicit none include 'max.inc' include 'formats.inc' c c Purpose: to convert a double precision to a character string; c the output character string uses a "+/-0.XXXXE+/-N" convention c c Input: c + num: double precision c + nap: number of digits after the "." that are converted to character c c Output: c + str: character string c + err: a value of zero means conversion is OK; a value of 1 means "num" c was not recognized. c c I/O double precision num integer nap character*(Nchar_mx) str integer err c temp integer sign integer i,j,idx,t character*1 str1 character*3 str3 integer n double precision absnum,tmp,a character*(Nchar_mx) nstr integer strlen character*(Nchar_mx) label label='subroutine dble2str' if (num.eq.0.0D+0) then str='0.00' err=0 goto 666 endif if (num.lt.0.0D+0) then sign=-1 else sign=1 endif absnum=dabs(num) err=0 n=0 tmp=absnum if (absnum.gt.1.0D+0) then do while (tmp.gt.1.0D+0) n=n+1 tmp=tmp/1.0D+1 c Debug c write(*,*) tmp,n c Debug enddo else if (absnum.lt.1.0D+0) then do while (tmp.lt.1.0D+0) n=n-1 tmp=tmp*1.0D+1 enddo else if (absnum.eq.1.0D+0) then else call error(label) write(*,*) 'absnum=',absnum stop endif a=tmp c at this point, absnum=a*10^n c Debug c write(*,*) 'a=',a c write(*,*) 'n=',n c Debug str='' idx=int(a) write(str1,11) idx t=idx*10 str=str(1:strlen(str)) & //str1(1:strlen(str1)) str=str(1:strlen(str)) & //'.' do i=1,nap idx=int(a*10**i-t) c Debug c write(*,*) 'i=',i,' idx=',idx c Debug t=10*(t+idx) write(str1,11) idx str=str(1:strlen(str)) & //str1(1:strlen(str1)) enddo ! i c Debug c write(*,*) 'str=',str(1:strlen(str)) c Debug if (n.ne.0) then call num2str3(abs(n),str3) if (n.lt.0) then nstr='-'//str3(1:strlen(str3)) else nstr=str3(1:strlen(str3)) endif str=str(1:strlen(str)) & //'E' & //nstr(1:strlen(nstr)) c & //'}' endif if (sign.eq.-1) then str="-"//str(1:strlen(str)) endif 666 continue return end subroutine dble2str_noexp(num,nap,str,err) implicit none include 'max.inc' include 'formats.inc' c c Purpose: to convert a double precision to a character string c using a natural "+/-XXXX.XXXXX" convention c c Input: c + num: double precision c + nap: number of digits after the "." that are converted to character c c Output: c + str: character string c + err: a value of zero means conversion is OK; a value of 1 means "num" c was not recognized. c c I/O double precision num integer nap character*(Nchar_mx) str integer err c temp integer sign integer i,j,idx,t character*1 str1,zero_ch character*3 str3 integer n double precision absnum,tmp,a character*(Nchar_mx) nstr integer strlen character*(Nchar_mx) label label='subroutine dble2str_noexp' if (num.eq.0.0D+0) then str='0.00' err=0 goto 666 endif if (num.lt.0.0D+0) then sign=-1 else sign=1 endif absnum=dabs(num) err=0 n=0 tmp=absnum write(zero_ch,11) 0 if (absnum.gt.1.0D+0) then do while (tmp.ge.1.0D+0) n=n+1 tmp=tmp/1.0D+1 c Debug c write(*,*) tmp,n c Debug enddo n=n-1 else if (absnum.lt.1.0D+0) then do while (tmp.lt.1.0D+0) n=n-1 tmp=tmp*1.0D+1 enddo else if (absnum.eq.1.0D+0) then else call error(label) write(*,*) 'absnum=',absnum stop endif a=tmp c at this point, absnum=a*10^n c Debug c write(*,*) 'a=',a c write(*,*) 'n=',n c Debug str='' if (n.ge.0) then tmp=absnum do i=n,0,-1 idx=tmp/(10**i) tmp=tmp-idx*10**i write(str1,11) idx str=str(1:strlen(str)) & //str1(1:strlen(str1)) enddo ! i str=str(1:strlen(str)) & //'.' do i=1,nap tmp=tmp*10 idx=int(tmp) tmp=tmp-dble(idx) write(str1,11) idx str=str(1:strlen(str)) & //str1(1:strlen(str1)) enddo ! i else str=zero_ch(1:strlen(zero_ch))//'.' do i=1,abs(n+1) str=str(1:strlen(str)) & //zero_ch(1:strlen(zero_ch)) enddo ! i tmp=absnum*10**abs(n+1) do i=1,nap tmp=tmp*10 idx=int(tmp) tmp=tmp-dble(idx) write(str1,11) idx str=str(1:strlen(str)) & //str1(1:strlen(str1)) enddo ! i endif if (sign.eq.-1) then str="-"//str(1:strlen(str)) endif 666 continue return end