45 lines
1.3 KiB
Fortran
45 lines
1.3 KiB
Fortran
SUBROUTINE DWNFR(MODE,N,FRE,A,ANE,Z,FR,DW)
|
|
C ==========================================
|
|
C
|
|
C Auxiliary routine to compute set of dissolved fractions
|
|
C for all frequencies
|
|
C MODE=0 -> DW=1
|
|
C MODE>0 -> DW=1-w
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
parameter (p1=0.1402,p2=0.1285,p3=un,p4=3.15,p5=4.)
|
|
parameter (tkn=3.01,ckn=5.33333333,cb0=8.59d14,f23=-2./3.)
|
|
PARAMETER (FRH=3.28805D15,SQFRH=5.734152D7)
|
|
DIMENSION FR(N),DW(N)
|
|
C
|
|
cb=cb0*berfc
|
|
IF(MODE.EQ.0) THEN
|
|
DO IJ=1,N
|
|
DW(IJ)=UN
|
|
END DO
|
|
ELSE
|
|
DO IJ=1,N
|
|
IF(FR(IJ).LT.FRE) THEN
|
|
XN=SQFRH*Z/SQRT(FRE-FR(IJ))
|
|
if(xn.le.tkn) then
|
|
xkn=un
|
|
else
|
|
xn1=un/(xn+un)
|
|
xkn=ckn*xn*xn1*xn1
|
|
end if
|
|
beta=cb*z*z*z*xkn/(xn*xn*xn*xn)*exp(f23*log(ane))
|
|
x=exp(p4*log(un+p3*a))
|
|
c1=p1*(x+p5*(z-un)*a*a*a)
|
|
c2=p2*x
|
|
f=(c1*beta*beta*beta)/(un+c2*beta*sqrt(beta))
|
|
DW(IJ)=UN-f/(un+f)
|
|
ELSE
|
|
DW(IJ)=UN
|
|
END IF
|
|
END DO
|
|
END IF
|
|
RETURN
|
|
END
|