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