Demo entry 6642266

f90

Submitted by anonymous on Sep 22, 2017 at 17:18
Language: Fortran. Code size: 2.5 kB.

```program hw1
implicit none
integer :: n,i,j
Real , External :: comp_f ! comp_f 用来对比两个数，以决定升序和降序排列
real(kind=4),allocatable :: x(:),twin(:)	!x是原始数组,twin是x的备用数组，将
real(kind=8) :: S1=0                !方法a求和，双精度
real(kind=4) :: S2=0,S3=0,S4=0,S5=0 !方法b,c,d,e，单精度
real(kind=4) :: c,t,y,temp          !方法c中的中转变量

write(*,*) "input n:"
allocate(x(n))						!分配数组大小
allocate(twin(n))
call random_number(x)				!给数组分配随机数
twin=x 								!备用的twin
call HeapSort( twin , comp_f )		!调用heapsort给twin数组排序

S1=x(1)
S2=x(1)
S3=x(1)
S4=twin(1)
S5=twin(n)
c = 0
!**************************************************
! 						求和
!**************************************************

do i = 2,n
!*****方法c的求和部分****
y = x(i)- c
t = S3 + y
c = (t-S3)-y
S3 = t
!*********************
S1=S1+x(i)
S2=S2+x(i)
S4=S4+twin(i)		!1~n的顺序相加，也就是从大到小相加
S5=S5+twin(n+1-i)	!n~1的顺序相加，也就是从小到大相加
end do

write(*,*) "Way 1:"
write(*,*) S1
write(*,*) "Way 2:"
write(*,*) S2
write(*,*) "Way 3:"
write(*,*) S3
write(*,*) "Way 4:"
write(*,*) S4
write(*,*) "Way 5:"
write(*,*) S5

DEALLOCATE(x)

!**************************************************
! 						排序
!**************************************************

Contains !// HeapSort 函数Contains 在Program 下，可以避免传递数组大小参数。也可以包含在Module 中
Subroutine HeapSort( stD , comp_f )
Real , Intent( INOUT ) :: stD( : )
Real , External :: comp_f
Integer i,ir,j,l,n
Real :: 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

end program hw1

Real Function comp_f( st1 , st2 )
Real , Parameter :: ORDER = 1.0 !// 降序，-1.0为升序
Real , Intent( IN ) :: st1 , st2
comp_f = ORDER*(st1 - st2)
End Function comp_f
```

This snippet took 0.01 seconds to highlight.

Back to the Entry List or Home.