[Fortran] 纯文本查看 复制代码
Program main
Implicit None
Integer, Parameter :: file_number = 1
Character (100) :: tmp
Character (160) :: filen
Character (100) :: filename(file_number)
Integer :: i, j, k, m, n, num, step, ios, ntotal
Integer :: p, q, GetFileN
Real, Pointer :: a(:, :), b(:, :), c(:)
Real, Pointer :: x1(:)
Real, Pointer :: y1(:)
Real, Pointer :: z1(:)
Real, Pointer :: x2(:)
Real, Pointer :: y2(:)
Real, Pointer :: z2(:)
!Real, Pointer :: up(:)
!Real, Pointer :: below(:)
!Real, Pointer :: cos2(:)
!Real, Pointer :: s(:)
!Real, Pointer :: summ(:)
Real :: summ , avg , s , up , below , cos2
!Real, Pointer :: avg(:)
Real *8 time
Integer *4 time0, time1, dtime
Call system_clock(time0)
Open (10, File='testdata.dat', Status='old')
Open (20, File='testresult.dat', Status='unknown')
num = GetFileN(10)
Allocate (a(num,3))
Allocate (b(num,3))
Allocate (c(num))
Allocate (x1(num))
Allocate (y1(num))
Allocate (z1(num))
Allocate (x2(num))
Allocate (y2(num))
Allocate (z2(num))
!Allocate (up(num))
!Allocate (below(num))
!Allocate (cos2(num))
!Allocate (s(num))
!Allocate (summ(num))
!Allocate (avg(num))
Do n = 1, num
Read (10, *, Iostat=ios)(a(n,m), m=1, 3)
If (ios/=0) Exit
End Do
Print *, 'Running...'
x1(:) = a(:,1)
y1(:) = a(:,2)
z1(:) = a(:,3)
Do step = 1, num/2
summ = 0.0
avg = 0.0
!write(*,*) step
Do j = 1, num - step
b(j, :) = a(step+j, :)
x2(j) = b(j, 1)
y2(j) = b(j, 2)
z2(j) = b(j, 3)
up = (x1(j)*x2(j)+y1(j)*y2(j)+z1(j)*z2(j))**2
below = (x1(j)*x1(j)+y1(j)*y1(j)+z1(j)*z1(j))*(x2(j)*x2(j)+y2(j)*y2(j)+z2(j)*z2(j))
cos2 = up/below
s = (3*cos2-1)/2
summ = s + summ
End Do
avg = summ/(num-step)
Write (20, 222) avg
End Do
Close (10)
Close (12)
Deallocate (a, b, c)
Deallocate (x1, y1, z1, x2, y2, z2 ) !, up, below, cos2 , s , summ, avg)
Call system_clock(time1, dtime)
time = 1D0*(time1-time0)/dtime
Write (*, '(a7,f16.7)') 'Time = ', time
111 Format (3F8.3)
222 Format (F12.6)
End Program main
Integer function GetFileN(iFileUnit)
implicit none
logical , parameter :: b = .True.
integer , intent( IN ) :: iFileUnit
character(len=1) :: c
GetFileN = 0
Rewind( iFileUnit )
Do while (b)
Read( iFileUnit , * ,end =999 ,Err = 999 )c
GetFileN = GetFileN + 1
End Do
999 Rewind( iFileUnit )
End function GetFileN