一个有关提高运算速度的问题
我正在尝试做这样的计算:有两种文件:
第一种文件数据为 a1,a2,a3....a100
第二种文件数据为 b1,b2,b3...b100
; 其中每种文件各有1000个,文件名分别是x1,x2,....x100(x对应第一种文件)和y1,y2,...y100(y对应第二种文件),分别放入名为x和y的两个文件夹内。
计算过程是:
以各自文件夹的第一个文件为例子,对应文件x1和y1,
b1-a(1,100)
b2-a(1,100)
...
b100-a(1,100)
分别用b1减去全部数据a, b2减去全部数据a,.....直到第a100; 这样得到共10000数据个差。
对它进行运算,对最后的运算结果求和,为输出的第一个数......循环操作全部1000个文件,最后得到共1000个输出结果。
我自己写程序是:PROGRAM test
IMPLICIT NONE
REAL, ALLOCATABLE :: a(:,:),b(:,:),hhs(:)
INTEGER :: clock_rate, clock_max, clock_1, clock_2
INTEGER :: i,ios,z, j, k, tn, num,numm, step,m,n
REAL :: summ,up,below ,cos2
real :: cos22,r1,q1,w1
character (160):: fn1, fn2, filename
Real *8 time
Integer *4 time0, time1, dtime
Real :: summc , avg , sc
fn1='x'
fn2='y'
num=100
numm=num*num
tn=1000
ALLOCATE(a(1,num),b(1,num),ss(num),rr(num),hh(num),hhs(numm))
Print*, 'Running...'
Call system_clock(time0)
OPEN(10, FILE='output.dat',status='unknown' )
Open(101,File='IDlist.dat', Status='old') ! contains 1000 filenames, eg: 1,2,3,..1000
Do i=1,tn
Read (101, *, Iostat=ios) filename
If (ios/=0) Exit
Open(200,File="D:\x\"//trim(adjustl(fn1))//trim(adjustl(filename))//'.dat',status='old')
READ(200,*,IOSTAT=ios) a
If (ios/=0) Exit
Open(300,File="D:\y\"//trim(adjustl(fn2))//trim(adjustl(filename))//'.dat',status='old')
READ(300,*,IOSTAT=ios) b
If (ios/=0) Exit
do z = 1, numm
doj = 1, num
do k = 1, num
r1 = 20
q1 = b(1,j)-a(1,k)
cos2 = (r1*q1+r1*r1+q1*q1)**2/3
w1=sqrt(q1*q1+r1*r1)
enddo
enddo
if (w1.GT.0.and.w1.LE.20) then
hhs(z)=cos22/w1/w1/w1
endif
summ=sum(hhs)
enddo
WRITE(10,'(1X,F12.6)') summ
enddo
DEALLOCATE(a,b,ss,rr,hh)
close(300)
close(200)
close(101)
close(10)
Call system_clock(time1, dtime)
time = 1D0*(time1-time0)/dtime
Write (*, '(a7,f16.7)') 'Time = ', time
END PROGRAM
我希望能显著提高一下运行速度,欢迎各位指教和改正,谢谢!!
PROGRAM test
IMPLICIT NONE
REAL, ALLOCATABLE :: a(:),b(:),hhs(:)
INTEGER :: i, z, j, k, tn, num, numm
REAL :: summ, cos2, r1, q1, w1
character(160):: filename
Real(8) time
Integer(4) time0, time1, dtime
num=100
numm=num*num
tn=1000
ALLOCATE(a(num),b(num),hhs(numm))
Print*, 'Running...'
Call system_clock(time0)
OPEN(10, FILE='output.dat',status='unknown' )
Do i=1,tn
write(filename,'(i6)') i
Open(200,File="D:\x\"//trim(adjustl(filename))//'.dat',status='old')
READ(200,*) a
close(200)
Open(300,File="D:\y\"//trim(adjustl(filename))//'.dat',status='old')
READ(300,*) b
close(300)
z=0
summ=0.0
r1 = 20
doj = 1, num
do k = 1, num
z=z+1
q1 = b(j)-a(k)
cos2 = (r1*q1+r1*r1+q1*q1)**2/3
w1=sqrt(q1*q1+r1*r1)
if (w1.GT.0.and.w1.LE.20) then
hhs(z)=cos2/(w1*w1*w1)
endif
enddo
enddo
summ=sum(hhs)
WRITE(10,'(1X,F12.6)') summ
enddo
DEALLOCATE(a,b)
close(10)
Call system_clock(time1, dtime)
time = 1D0*(time1-time0)/dtime
Write (*, '(a7,f16.7)') 'Time = ', time
END PROGRAM REAL :: summ, cos2, r1, q1, w1, W2, W3
....................
......................
W2 = R1 * R1 + Q1 * Q1
COS2 = R1 * Q1 + W2
COS2 = COS2 * COS2 / 3.0
W1 = SQRT(W2)
.....................
W3 = W1 * W2
...............................
HHS = COS2 / W3
li913 发表于 2015-5-20 20:59
PROGRAM test
IMPLICIT NONE
REAL, ALLOCATABLE :: a(:),b(:),hh ...
我想再请教一个问题:
如果将r1的数值换成变量,r1=(b1-a(1,100),b2-a(1,100)...b100-a(1,100)) (就是两种文件数据的第一个文件的差这组数),能否在不另外写新的循环的情况下实现?
我现在的写法是单独写一个循环,然后用open, read...这样,非常繁琐。
非常感谢!
页:
[1]