金额数字转换为会计用金额大写
2015-05-14 16:19:36   来源：szw_sh@163.com   评论：0 点击：

Program www_fcode_cn
  Implicit None
  Character(len=56) :: cDigit
  write(*,*) cDigit( 314223243431.34d0 )
End Program www_fcode_cn

character(Len=56) Function cDigit(x)
!函数：将金额数字转换为汉字大写形式
!用法：str = cDigit(x)
!参数：x 双精度的浮点数，输入
!返回：cDigit  输出的会计用金额大写字符串
!注意：返回空格表示输入数值越界，定义域：0<x<=999999999999.99
!作者：szw_sh@163.com  
  Implicit None
  Real(Kind=8) x ! 输入数值定义为双精度型
  Character(len=15) :: h ! x的临时字符变量
  Integer :: np ! cDigit位置标记
  Character(len=*) , parameter :: number='零壹贰叁肆伍陆柒捌玖'
  Character(len=2) , parameter :: cnp_list(8) = ['仟','百','拾','亿','万','圆','角','分']
  Integer , parameter :: np_list(14) = [1,2,3,4,1,2,3,5,1,2,3,6,7,8]
  !//千亿，百亿，十亿，亿，千万，百万，十万，万，千，百，十，圆，角，分
  integer :: i , k
  cDigit = ' '
  If ( x>999999999999.99D0 .Or. x<=0.0d0 ) Return ! 定义域检查
  Write (h, '(f15.0)') x*100.0d0 ! 将小数2位一并归入整数，x转为字符形式，千分位自动舍入
  If (h(14:14)=='0') h(14:14) = ' ' ! 自右向左检查为0的位(从第14位起，第15位为小数点)：
  Do i = 13, 1, -1 ! 尾部为0的以空格标记，大写中忽略
    If (h(i:i)/='0') Cycle ! 连续的0只保留一个，其余标记为空格
    If (index('$0 ',h(i+1:i+1))/=0) h(i:i) = ' ' ! 亿、万、千亿、千万位及个位的0必须在大写时表示，标记为$
    If (mod(i,4)==0) h(i:i) = '$' ! 即位置i=4,8,12时
  End Do
  np = 1
  Do i = 1, 14 ! 转换为汉字大写形式
    If (h(i:i)==' ') Cycle ! 空格位忽略
    If (h(i:i)/='$') Then ! 数字位转换为汉字大写
      k = ichar(h(i:i)) - ichar('0')
      cDigit(np:np+1) = number(2*k+1:2*k+2)
      np = np + 2
    End If
    If (h(i:i)=='0') Cycle ! 遇0时略去数字单位标注
    If ( i == 8 .and. cDigit(np-2:np-1)=='亿') cycle ! 万位，若亿位与万位之间均为0，则该位不标注
    cDigit(np:np+1) = cnp_list(np_list(i))    
    np = np + 2
  End Do
End Function cDigit