istp/gray
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 1 Wiki Activity

added ak0 common

Browse Source
This commit is contained in:
Alberto Mariani 2013-05-21 16:48:25 +00:00
parent 185920b12d
commit 4faca7994e
1 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/gray.f
View File

@ -5751,6 +5751,8 @@ c
common/dnpar/dnpara
common/atjki/tauv,alphav
common/waist/w0csi,w0eta
common/parwv/ak0,akinv,fhz
common/dery0/dery0,dery0mod
common/iplane/iplane
@ -5894,7 +5896,7 @@ c
snps1=dirx/(dir*snth1)
end if
end if
xti= dx*csps1-dy*snps1
xti=dx*csps1-dy*snps1
yti=(dx*snps1+dy*csps1)*csth1-dz*snth1
zti=(dx*snps1+dy*csps1)*snth1+dz*csth1
rti=sqrt(xti**2+yti**2)
@ -6167,6 +6169,7 @@ c . (1-cos((2*pi*(j-1))/(nxgrid-1)))
nnp=5
nindex=0
adev=0
adev2=0
do j=1,nxgrid
do i=1,nxgrid
ij=nxgrid*(i-1)+j
@ -6192,15 +6195,19 @@ c . mod(j-1+3*(nxgrid-1)/2,2*nxgrid-1)+1))
if(abs(i-(nxgrid+1)/2).le.nnp.and.
. abs(j-(nxgrid+1)/2).le.nnp) then
nindex=nindex+1
adev=adev+(log(sqrt(areaetc**2+aimaetc**2)/acentral)
adev2=adev2+(log(sqrt(areaetc**2+aimaetc**2)/acentral)
. +(akw*akk(i)**2+bkw*akk(j)**2+ckw*akk(i)*akk(j)))**2
adev=adev+log(sqrt(areaetc**2+aimaetc**2)/acentral)
. +(akw*akk(i)**2+bkw*akk(j)**2+ckw*akk(i)*akk(j))
endif
end do
write(82,*) ''
end do
write(82,*) ''
adev=sqrt(adev/nindex)
write(83,*) istep,adev,akw,bkw,ckw,dk1,dk2
adev2=sqrt(adev2/nindex)
adev=adev/nindex
write(83,*) istep,adev2,adev,aar,bbr,ccr,aaw,bbw,ccw,akw,bkw,ckw,
. dk1,dk2
return
99 format(i5,22(1x,e16.8e3))
111 format(3i5,30(1x,e16.8e3))