您所在位置：主题：请教一个子程序中几行代码，如何理解。谢谢！
freekiller
[专家分：20] 发布于 2012-02-24 22:25:00
请各位帮忙解释一下如下子程序中绿色部分的语句，在程序开始执行的前面有类似函数的定义，然后在执行过程中调用。请问这是什么用法？谢谢！
subroutine slope_wdm6(qrs,ncr,den,denfac,t,rslope,rslopeb,rslope2,rslope3, &
vt,vtn,its,ite,kts,kte)
IMPLICIT NONE
INTEGER :: its,ite, jts,jte, kts,kte
REAL, DIMENSION( its:ite , kts:kte,3) :: &
qrs, &
rslope, &
rslopeb, &
rslope2, &
rslope3, &
vt
REAL, DIMENSION( its:ite , kts:kte) :: &
ncr, &
vtn, &
den, &
denfac, &
t
REAL, PARAMETER :: t0c = 273.15
REAL, DIMENSION( its:ite , kts:kte ) :: &
n0sfac
REAL :: lamdar, lamdas, lamdag, x, y, z, supcol
integer :: i, j, k
!----------------------------------------------------------------
! size distributions: (x=mixing ratio, y=air density):
! valid for mixing ratio > 1.e-9 kg/kg.
!
! Optimizatin : A**B => exp(log(A)*(B))
[color=008000]lamdar(x,y,z)= exp(log(((pidnr*z)/(x*y)))*((.33333333[/color])))
[color=008000] lamdas(x,y,z)= sqrt(sqrt(pidn0s*z/(x*y))) ! (pidn0s*z/(x*y))**.25[/color] [color=808000]
lamdag(x,y)= sqrt(sqrt(pidn0g/(x*y))) ! (pidn0g/(x*y))**.[/color]25
!
do k = kts, kte
do i = its, ite
supcol = t0c-t(i,k)
!---------------------------------------------------------------
! n0s: Intercept parameter for snow [m-4] [HDC 6]
!---------------------------------------------------------------
n0sfac(i,k) = max(min(exp(alpha*supcol),n0smax/n0s),1.)
if(qrs(i,k,1).le.qcrmin .or. ncr(i,k).le.nrmin ) then
rslope(i,k,1) = rslopermax
rslopeb(i,k,1) = rsloperbmax
rslope2(i,k,1) = rsloper2max
rslope3(i,k,1) = rsloper3max
else
rslope(i,k,1) = min(1./lamdar(qrs(i,k,1),den(i,k),ncr(i,k)),1.e-3)
rslopeb(i,k,1) = rslope(i,k,1)**bvtr
rslope2(i,k,1) = rslope(i,k,1)*rslope(i,k,1)
rslope3(i,k,1) = rslope2(i,k,1)*rslope(i,k,1)
endif
if(qrs(i,k,2).le.qcrmin) then
rslope(i,k,2) = rslopesmax
rslopeb(i,k,2) = rslopesbmax
rslope2(i,k,2) = rslopes2max
rslope3(i,k,2) = rslopes3max
else
[color=008000] rslope(i,k,2) = 1./lamdas(qrs(i,k,2),den(i,k),n0sfac[/color](i,k)
rslopeb(i,k,2) = rslope(i,k,2)**bvts
rslope2(i,k,2) = rslope(i,k,2)*rslope(i,k,2)
rslope3(i,k,2) = rslope2(i,k,2)*rslope(i,k,2)
endif
if(qrs(i,k,3).le.qcrmin) then
rslope(i,k,3) = rslopegmax
rslopeb(i,k,3) = rslopegbmax
rslope2(i,k,3) = rslopeg2max
rslope3(i,k,3) = rslopeg3max
else
rslope(i,k,3) = 1./lamdag(qrs(i,k,3),den(i,k))
rslopeb(i,k,3) = rslope(i,k,3)**bvtg
rslope2(i,k,3) = rslope(i,k,3)*rslope(i,k,3)
rslope3(i,k,3) = rslope2(i,k,3)*rslope(i,k,3)
endif
vt(i,k,1) = pvtr*rslopeb(i,k,1)*denfac(i,k)
vt(i,k,2) = pvts*rslopeb(i,k,2)*denfac(i,k)
vt(i,k,3) = pvtg*rslopeb(i,k,3)*denfac(i,k)
vtn(i,k) = pvtrn*rslopeb(i,k,1)*denfac(i,k)
if(qrs(i,k,1).le.0.0) vt(i,k,1) = 0.0
if(qrs(i,k,2).le.0.0) vt(i,k,2) = 0.0
if(qrs(i,k,3).le.0.0) vt(i,k,3) = 0.0
if(ncr(i,k).le.0.0) vtn(i,k) = 0.0
enddo
enddo
END subroutine slope_wdm6
subroutine slope_wdm6(qrs,ncr,den,denfac,t,rslope,rslopeb,rslope2,rslope3, &
vt,vtn,its,ite,kts,kte)
IMPLICIT NONE
INTEGER :: its,ite, jts,jte, kts,kte
REAL, DIMENSION( its:ite , kts:kte,3) :: &
qrs, &
rslope, &
rslopeb, &
rslope2, &
rslope3, &
vt
REAL, DIMENSION( its:ite , kts:kte) :: &
ncr, &
vtn, &
den, &
denfac, &
t
REAL, PARAMETER :: t0c = 273.15
REAL, DIMENSION( its:ite , kts:kte ) :: &
n0sfac
REAL :: lamdar, lamdas, lamdag, x, y, z, supcol
integer :: i, j, k
!----------------------------------------------------------------
! size distributions: (x=mixing ratio, y=air density):
! valid for mixing ratio > 1.e-9 kg/kg.
!
! Optimizatin : A**B => exp(log(A)*(B))
[color=008000]lamdar(x,y,z)= exp(log(((pidnr*z)/(x*y)))*((.33333333[/color])))
[color=008000] lamdas(x,y,z)= sqrt(sqrt(pidn0s*z/(x*y))) ! (pidn0s*z/(x*y))**.25[/color] [color=808000]
lamdag(x,y)= sqrt(sqrt(pidn0g/(x*y))) ! (pidn0g/(x*y))**.[/color]25
!
do k = kts, kte
do i = its, ite
supcol = t0c-t(i,k)
!---------------------------------------------------------------
! n0s: Intercept parameter for snow [m-4] [HDC 6]
!---------------------------------------------------------------
n0sfac(i,k) = max(min(exp(alpha*supcol),n0smax/n0s),1.)
if(qrs(i,k,1).le.qcrmin .or. ncr(i,k).le.nrmin ) then
rslope(i,k,1) = rslopermax
rslopeb(i,k,1) = rsloperbmax
rslope2(i,k,1) = rsloper2max
rslope3(i,k,1) = rsloper3max
else
rslope(i,k,1) = min(1./lamdar(qrs(i,k,1),den(i,k),ncr(i,k)),1.e-3)
rslopeb(i,k,1) = rslope(i,k,1)**bvtr
rslope2(i,k,1) = rslope(i,k,1)*rslope(i,k,1)
rslope3(i,k,1) = rslope2(i,k,1)*rslope(i,k,1)
endif
if(qrs(i,k,2).le.qcrmin) then
rslope(i,k,2) = rslopesmax
rslopeb(i,k,2) = rslopesbmax
rslope2(i,k,2) = rslopes2max
rslope3(i,k,2) = rslopes3max
else
[color=008000] rslope(i,k,2) = 1./lamdas(qrs(i,k,2),den(i,k),n0sfac[/color](i,k)
rslopeb(i,k,2) = rslope(i,k,2)**bvts
rslope2(i,k,2) = rslope(i,k,2)*rslope(i,k,2)
rslope3(i,k,2) = rslope2(i,k,2)*rslope(i,k,2)
endif
if(qrs(i,k,3).le.qcrmin) then
rslope(i,k,3) = rslopegmax
rslopeb(i,k,3) = rslopegbmax
rslope2(i,k,3) = rslopeg2max
rslope3(i,k,3) = rslopeg3max
else
rslope(i,k,3) = 1./lamdag(qrs(i,k,3),den(i,k))
rslopeb(i,k,3) = rslope(i,k,3)**bvtg
rslope2(i,k,3) = rslope(i,k,3)*rslope(i,k,3)
rslope3(i,k,3) = rslope2(i,k,3)*rslope(i,k,3)
endif
vt(i,k,1) = pvtr*rslopeb(i,k,1)*denfac(i,k)
vt(i,k,2) = pvts*rslopeb(i,k,2)*denfac(i,k)
vt(i,k,3) = pvtg*rslopeb(i,k,3)*denfac(i,k)
vtn(i,k) = pvtrn*rslopeb(i,k,1)*denfac(i,k)
if(qrs(i,k,1).le.0.0) vt(i,k,1) = 0.0
if(qrs(i,k,2).le.0.0) vt(i,k,2) = 0.0
if(qrs(i,k,3).le.0.0) vt(i,k,3) = 0.0
if(ncr(i,k).le.0.0) vtn(i,k) = 0.0
enddo
enddo
END subroutine slope_wdm6