-
-
45.36 KB, 下载次数: 2
45.36 KB, 下载次数: 2
program www_fcode_cn
implicit none
Integer , parameter :: LEN_ALL = 50000 !// 总长度
Integer , parameter :: LEN_ONE = 16 !// 单个长度
Character( Len = LEN_ALL ) :: cStrAll
Character( Len = LEN_ONE ) , allocatable :: cStrSplit( : )
integer :: n , sum , score !// 单词个数，总分，单个分
integer :: i
Open( 12 , File = "names.txt" )
Read( 12 , '(a50000)' ) cStrAll
Close( 12 )
n = GetDataN( cStrAll ) !// 获得单词数
write(*,'(a,i0,a)') '共',n,'个单词'
Allocate( cStrSplit(n) )
read( cStrAll , * ) cStrSplit
call HeapSort( cStrSplit , comp_f ) !// 排序
sum = 0
Do i = 1 , n
sum = sum + i * GetStringScore( Trim(cStrSplit(i)) )
End Do
write( * , * ) '总分' , sum
Deallocate( cStrSplit )
contains
Integer Function GetStringScore( c )
Character( Len = * ) :: c
integer :: i
GetStringScore = 0
Do i = 1 , Len_Trim( c )
GetStringScore = GetStringScore + ( ichar(c(i:i)) - ichar('A') + 1 )
End Do
End Function GetStringScore
Integer Function GetDataN( cStr )
Character( Len = * ) , Intent( IN ) :: cStr
Integer :: i
Logical :: bIsSeparator , bIsQuote
GetDataN = 0
bIsSeparator = .TRUE.
bIsQuote = .FALSE.
Do i = 1 , Len_Trim( cStr )
Select Case( cStr(i:i) )
Case( '"' , "'" ) !// 如果遇到引号
If ( .Not.bIsQuote ) GetDataN = GetDataN + 1 !//如果不在引号中，则增加一个数据
bIsQuote = .Not.bIsQuote !// 引号结束或开始
bIsSeparator = .FALSE.
Case( " " , "," , char(9) ) !// 如果遇到分隔符
If ( .Not.bIsQuote ) then !// 分隔符如果不在引号中
bIsSeparator = .TRUE.
End If
Case Default
If ( bIsSeparator ) then
GetDataN = GetDataN + 1
End If
bIsSeparator = .FALSE.
End Select
End Do
End Function GetDataN
Subroutine HeapSort( stD , comp_f )
Character( Len = * ) , Intent( INOUT ) :: stD( : )
Real , External :: comp_f
Integer i,ir,j,l,n
Character( Len = LEN_ONE ) :: stTemp
n = size( stD )
If ( n < 2 ) Return
l = n / 2 + 1
ir = n
Do while( .TRUE. )
If( l > 1 ) then
l = l - 1
stTemp = stD( l )
Else
stTemp = stD( ir )
stD( ir ) = stD( 1 )
ir = ir - 1
If( ir == 1 ) then
stD( 1 ) = stTemp
return
End If
End If
i = l
j = l + l
Do while( j<=ir )
If( ( j < ir ) ) then
If ( comp_f( stD(j) , std(j+1) ) > 0.0 ) then
j = j+1
End If
EndIf
If( comp_f( stTemp , stD(j) ) > 0.0 )then
stD(i) = stD( j )
i = j
j = j + j
Else
j = ir + 1
End If
EndDo
stD( i ) = stTemp
End Do
End Subroutine HeapSort
Real Function comp_f( st1 , st2 )
Character( Len = * ) , Intent( IN ) :: st1 , st2
if ( Trim(st1) > Trim(st2) ) then
comp_f = -1.0
else
comp_f = 1.0
end if
End Function comp_f
end program www_fcode_cn
| 欢迎光临 Fortran Coder (http://bbs.fcode.cn/) | Powered by Discuz! X3.2 |