fcode.cn
唭杽匥儠
fcode.cn
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
