EBCDIC 与 ASCII 编码相互转换
2015-10-15 16:12:04   来源：Fcode研讨团队   评论：0 点击：

如下代码，将字符串 “fcode.cn” 转换成 EBCDIC 编码，然后再转换回来。执行后输出为：

Program www_fcode_cn
  Implicit None
  Character(len=8) :: str = "fcode.cn"
  write(*,*) str
  call ASCII2EBCDIC( str )
  write(*,*) str
  call EBCDIC2ASCII( str )
  write(*,*) str
End Program www_fcode_cn
  
Subroutine EBCDIC2ASCII( buffer )
  ! Map a block of EBCDIC characters to ASCII
  ! modify from : eamap @ L. Weissman   Mar. 1980
  Implicit None
  Integer , parameter :: ebcdic(256) = [               & 
    32,1,2,3,32,9,32,127,32,32,32,11,12,13,14,15,      &
    16,17,18,19,32,32,8,32,24,25,32,32,28,29,30,31,    &
    32,32,32,32,32,10,23,27,32,32,32,32,32,5,6,7,32,   &
    32,22,32,32,32,32,4,32,32,32,32,20,21,32,26,32,    &
    32,32,32,32,32,32,32,32,32,32,46,60,40,43,124,38,  &
    32,32,32,32,32,32,32,32,32,33,36,42,41,59,94,45,   &
    47,32,32,32,32,32,32,32,32,124,44,37,95,62,63,32,  &
    32,32,32,32,32,32,32,32,96,58,35,64,39,61,34,32,   &
    97,98,99,100,101,102,103,104,105,32,123,32,40,43,  &
    32,32,106,107,108,109,110,111,112,113,114,32,125,  &
    32,41,32,32,32,126,115,116,117,118,119,120,121,122,&
    32,32,32,91,32,32,32,32,32,32,32,32,32,32,32,32,   &
    32,32,32,93,32,45,123,65,66,67,68,69,70,71,72,73,  &
    32,32,32,32,32,32,125,74,75,76,77,78,79,80,81,82,  &
    32,32,32,32,32,32,92,32,83,84,85,86,87,88,89,90,   &
    32,32,32,32,32,32,48,49,50,51,52,53,54,55,56,57,   &
    124,32,32,32,32,32]
  Character(Len=*) buffer
  integer :: i , l
  If (len(buffer)<=0) Return
  Do i = 1, len(buffer)
    l = ichar(buffer(i:i))
    If (l<0) l = l + 256
    l = ebcdic(l+1)
    If (l>127) l = l - 256
    buffer(i:i) = char(l)
  End Do
End Subroutine EBCDIC2ASCII

Subroutine ASCII2EBCDIC( buffer )
  ! Map a block of ASCII characters to EBCDIC
  ! modify from : aemap @ L. Weissman   Mar 1981
  Integer , parameter :: ebcdic(128) = [               & 
    0,1,2,3,55,45,46,47,22,5,37,11,12,13,14,15,16,17,  &
    18,19,60,61,50,38,24,25,63,39,34,29,53,31,64,90,   &
    127,123,91,108,80,125,77,93,92,78,107,96,75,97,240,&
    241,242,243,244,245,246,247,248,249,122,94,76,126, &
    110,111,124,193,194,195,196,197,198,199,200,201,   &
    209,210,211,212,213,214,215,216,217,226,227,228,   &
    229,230,231,232,233,74,224,79,95,109,121,129,130,  &
    131,132,133,134,135,136,137,145,146,147,148,149,   &
    150,151,152,153,162,163,164,165,166,167,168,169,   &
    192,106,208,161,255]
  Character(len=*) buffer
  If (len(buffer)<=0) Return
  Do i = 1, len(buffer)
    l = ichar(buffer(i:i))
    If (l<0) l = l + 256
    l = ebcdic(l+1)
    If (l>127) l = l - 256
    buffer(i:i) = char(l)
  End Do
End Subroutine ASCII2EBCDIC