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:"
	read(*,*) 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.

Delete this entry (admin only).