65 lines
2.2 KiB
Fortran
65 lines
2.2 KiB
Fortran
C $Id: MIESCT.f,v 1.1 2009/06/09 21:51:53 daven Exp $
|
|
SUBROUTINE MIESCT
|
|
C-----------------------------------------------------------------------
|
|
C This is an adaption of the Prather radiative transfer code, (mjp, 10/95)
|
|
C Prather, 1974, Astrophys. J. 192, 787-792.
|
|
C Sol'n of inhomogeneous Rayleigh scattering atmosphere.
|
|
C (original Rayleigh w/ polarization)
|
|
C Cochran and Trafton, 1978, Ap.J., 219, 756-762.
|
|
C Raman scattering in the atmospheres of the major planets.
|
|
C (first use of anisotropic code)
|
|
C Jacob, Gottlieb and Prather, 1989, J.Geophys.Res., 94, 12975-13002.
|
|
C Chemistry of a polluted cloudy boundary layer,
|
|
C (documentation of extension to anisotropic scattering)
|
|
C
|
|
C takes atmospheric structure and source terms from std J-code
|
|
C ALSO limited to 4 Gauss points, only calculates mean field!
|
|
C
|
|
C mean rad. field ONLY (M=1)
|
|
C initialize variables FIXED/UNUSED in this special version:
|
|
C FTOP = 1.0 = astrophysical flux (unit of pi) at SZA, -ZU0, use for scaling
|
|
C FBOT = 0.0 = external isotropic flux on lower boundary
|
|
C SISOTP = 0.0 = Specific Intensity of isotropic radiation incident from top
|
|
C
|
|
C SUBROUTINES: MIESCT needs 'jv_mie.cmn'
|
|
C BLKSLV needs 'jv_mie.cmn'
|
|
C GEN (ID) needs 'jv_mie.cmn'
|
|
C LEGND0 (X,PL,N)
|
|
C MATIN4 (A)
|
|
C GAUSSP (N,XPT,XWT)
|
|
C-----------------------------------------------------------------------
|
|
IMPLICIT NONE
|
|
|
|
# include "jv_mie.h"
|
|
|
|
integer i, id, im
|
|
real*8 cmeq1
|
|
C-----------------------------------------------------------------------
|
|
C---fix scattering to 4 Gauss pts = 8-stream
|
|
CALL GAUSSP (N,EMU,WT)
|
|
C---solve eqn of R.T. only for first-order M=1
|
|
C ZFLUX = (ZU0*FZ(ND)*ZREFL+FBOT)/(1.0d0+ZREFL)
|
|
ZFLUX = (ZU0*FZ(ND)*ZREFL)/(1.0d0+ZREFL)
|
|
M=1
|
|
DO I=1,N
|
|
CALL LEGND0 (EMU(I),PM0,MFIT)
|
|
DO IM=M,MFIT
|
|
PM(I,IM) = PM0(IM)
|
|
ENDDO
|
|
ENDDO
|
|
C
|
|
CMEQ1 = 0.25D0
|
|
CALL LEGND0 (-ZU0,PM0,MFIT)
|
|
DO IM=M,MFIT
|
|
PM0(IM) = CMEQ1*PM0(IM)
|
|
ENDDO
|
|
C
|
|
CALL BLKSLV
|
|
C
|
|
DO ID=1,ND,2
|
|
FJ(ID) = 4.0d0*FJ(ID) + FZ(ID)
|
|
ENDDO
|
|
|
|
RETURN
|
|
END
|