phylmd/Radlwsw/lwtt.f

SUBROUTINE lwtt(pga, pgb, puu, ptt)
  USE dimens_m
  USE dimphy
  USE raddim
  USE raddimlw
  IMPLICIT NONE

  ! -----------------------------------------------------------------------
  ! PURPOSE.
  ! --------
  ! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
  ! ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL
  ! INTERVALS.

  ! METHOD.
  ! -------

  ! 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
  ! COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
  ! 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
  ! 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
  ! A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.

  ! REFERENCE.
  ! ----------

  ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
  ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS

  ! AUTHOR.
  ! -------
  ! JEAN-JACQUES MORCRETTE  *ECMWF*

  ! MODIFICATIONS.
  ! --------------
  ! ORIGINAL : 88-12-15

  ! -----------------------------------------------------------------------
  DOUBLE PRECISION o1h, o2h
  PARAMETER (o1h=2230.)
  PARAMETER (o2h=100.)
  DOUBLE PRECISION rpialf0
  PARAMETER (rpialf0=2.0)

  ! * ARGUMENTS:

  DOUBLE PRECISION puu(kdlon, nua)
  DOUBLE PRECISION ptt(kdlon, ntra)
  DOUBLE PRECISION pga(kdlon, 8, 2)
  DOUBLE PRECISION pgb(kdlon, 8, 2)

  ! * LOCAL VARIABLES:

  DOUBLE PRECISION zz, zxd, zxn
  DOUBLE PRECISION zpu, zpu10, zpu11, zpu12, zpu13
  DOUBLE PRECISION zeu, zeu10, zeu11, zeu12, zeu13
  DOUBLE PRECISION zx, zy, zsq1, zsq2, zvxy, zuxy
  DOUBLE PRECISION zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o
  DOUBLE PRECISION zsqn21, zodn21, zsqh42, zodh42
  DOUBLE PRECISION zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12
  DOUBLE PRECISION zuu11, zuu12, za11, za12
  INTEGER jl, ja
  ! ------------------------------------------------------------------

  ! *         1.     HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
  ! -----------------------------------------------


  DO ja = 1, 8
    DO jl = 1, kdlon
      zz = sqrt(puu(jl,ja))
      ! ZXD(JL,1)=PGB( JL, 1,1) + ZZ(JL, 1)*(PGB( JL, 1,2) + ZZ(JL, 1))
      ! ZXN(JL,1)=PGA( JL, 1,1) + ZZ(JL, 1)*(PGA( JL, 1,2) )
      ! PTT(JL,1)=ZXN(JL,1)/ZXD(JL,1)
      zxd = pgb(jl, ja, 1) + zz*(pgb(jl,ja,2)+zz)
      zxn = pga(jl, ja, 1) + zz*(pga(jl,ja,2))
      ptt(jl, ja) = zxn/zxd
    END DO
  END DO

  ! ------------------------------------------------------------------

  ! *         2.     CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
  ! ---------------------------------------------------


  DO jl = 1, kdlon
    ptt(jl, 9) = ptt(jl, 8)

    ! -  CONTINUUM ABSORPTION: E- AND P-TYPE

    zpu = 0.002*puu(jl, 10)
    zpu10 = 112.*zpu
    zpu11 = 6.25*zpu
    zpu12 = 5.00*zpu
    zpu13 = 80.0*zpu
    zeu = puu(jl, 11)
    zeu10 = 12.*zeu
    zeu11 = 6.25*zeu
    zeu12 = 5.00*zeu
    zeu13 = 80.0*zeu

    ! -  OZONE ABSORPTION

    zx = puu(jl, 12)
    zy = puu(jl, 13)
    zuxy = 4.*zx*zx/(rpialf0*zy)
    zsq1 = sqrt(1.+o1h*zuxy) - 1.
    zsq2 = sqrt(1.+o2h*zuxy) - 1.
    zvxy = rpialf0*zy/(2.*zx)
    zaercn = puu(jl, 17) + zeu12 + zpu12
    zto1 = exp(-zvxy*zsq1-zaercn)
    zto2 = exp(-zvxy*zsq2-zaercn)

    ! -- TRACE GASES (CH4, N2O, CFC-11, CFC-12)

    ! * CH4 IN INTERVAL 800-970 + 1110-1250 CM-1

    ! NEXOTIC=1
    ! IF (NEXOTIC.EQ.1) THEN
    zxch4 = puu(jl, 19)
    zych4 = puu(jl, 20)
    zuxy = 4.*zxch4*zxch4/(0.103*zych4)
    zsqh41 = sqrt(1.+33.7*zuxy) - 1.
    zvxy = 0.103*zych4/(2.*zxch4)
    zodh41 = zvxy*zsqh41

    ! * N2O IN INTERVAL 800-970 + 1110-1250 CM-1

    zxn2o = puu(jl, 21)
    zyn2o = puu(jl, 22)
    zuxy = 4.*zxn2o*zxn2o/(0.416*zyn2o)
    zsqn21 = sqrt(1.+21.3*zuxy) - 1.
    zvxy = 0.416*zyn2o/(2.*zxn2o)
    zodn21 = zvxy*zsqn21

    ! * CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1

    zuxy = 4.*zxch4*zxch4/(0.113*zych4)
    zsqh42 = sqrt(1.+400.*zuxy) - 1.
    zvxy = 0.113*zych4/(2.*zxch4)
    zodh42 = zvxy*zsqh42

    ! * N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1

    zuxy = 4.*zxn2o*zxn2o/(0.197*zyn2o)
    zsqn22 = sqrt(1.+2000.*zuxy) - 1.
    zvxy = 0.197*zyn2o/(2.*zxn2o)
    zodn22 = zvxy*zsqn22

    ! * CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1

    za11 = 2.*puu(jl, 23)*4.404E+05
    zttf11 = 1. - za11*0.003225

    ! * CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1

    za12 = 2.*puu(jl, 24)*6.7435E+05
    zttf12 = 1. - za12*0.003225

    zuu11 = -puu(jl, 15) - zeu10 - zpu10
    zuu12 = -puu(jl, 16) - zeu11 - zpu11 - zodh41 - zodn21
    ptt(jl, 10) = exp(-puu(jl,14))
    ptt(jl, 11) = exp(zuu11)
    ptt(jl, 12) = exp(zuu12)*zttf11*zttf12
    ptt(jl, 13) = 0.7554*zto1 + 0.2446*zto2
    ptt(jl, 14) = ptt(jl, 10)*exp(-zeu13-zpu13)
    ptt(jl, 15) = exp(-puu(jl,14)-zodh42-zodn22)
  END DO

  RETURN
END SUBROUTINE lwtt
1	guez	81	SUBROUTINE lwtt(pga, pgb, puu, ptt)
2			USE dimens_m
3			USE dimphy
4			USE raddim
5			USE raddimlw
6			IMPLICIT NONE
7
8			! -----------------------------------------------------------------------
9			! PURPOSE.
10			! --------
11			! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
12			! ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL
13			! INTERVALS.
14
15			! METHOD.
16			! -------
17
18			! 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
19			! COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
20			! 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
21			! 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
22			! A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
23
24			! REFERENCE.
25			! ----------
26
27			! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
28			! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
29
30			! AUTHOR.
31			! -------
32			! JEAN-JACQUES MORCRETTE ECMWF
33
34			! MODIFICATIONS.
35			! --------------
36			! ORIGINAL : 88-12-15
37
38			! -----------------------------------------------------------------------
39			DOUBLE PRECISION o1h, o2h
40			PARAMETER (o1h=2230.)
41			PARAMETER (o2h=100.)
42			DOUBLE PRECISION rpialf0
43			PARAMETER (rpialf0=2.0)
44
45			! * ARGUMENTS:
46
47			DOUBLE PRECISION puu(kdlon, nua)
48			DOUBLE PRECISION ptt(kdlon, ntra)
49			DOUBLE PRECISION pga(kdlon, 8, 2)
50			DOUBLE PRECISION pgb(kdlon, 8, 2)
51
52			! * LOCAL VARIABLES:
53
54			DOUBLE PRECISION zz, zxd, zxn
55			DOUBLE PRECISION zpu, zpu10, zpu11, zpu12, zpu13
56			DOUBLE PRECISION zeu, zeu10, zeu11, zeu12, zeu13
57			DOUBLE PRECISION zx, zy, zsq1, zsq2, zvxy, zuxy
58			DOUBLE PRECISION zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o
59			DOUBLE PRECISION zsqn21, zodn21, zsqh42, zodh42
60			DOUBLE PRECISION zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12
61			DOUBLE PRECISION zuu11, zuu12, za11, za12
62			INTEGER jl, ja
63			! ------------------------------------------------------------------
64
65			! * 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
66			! -----------------------------------------------
67
68
69
70			DO ja = 1, 8
71			DO jl = 1, kdlon
72			zz = sqrt(puu(jl,ja))
73			! ZXD(JL,1)=PGB( JL, 1,1) + ZZ(JL, 1)*(PGB( JL, 1,2) + ZZ(JL, 1))
74			! ZXN(JL,1)=PGA( JL, 1,1) + ZZ(JL, 1)*(PGA( JL, 1,2) )
75			! PTT(JL,1)=ZXN(JL,1)/ZXD(JL,1)
76			zxd = pgb(jl, ja, 1) + zz*(pgb(jl,ja,2)+zz)
77			zxn = pga(jl, ja, 1) + zz*(pga(jl,ja,2))
78			ptt(jl, ja) = zxn/zxd
79			END DO
80			END DO
81
82			! ------------------------------------------------------------------
83
84			! * 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
85			! ---------------------------------------------------
86
87
88			DO jl = 1, kdlon
89			ptt(jl, 9) = ptt(jl, 8)
90
91			! - CONTINUUM ABSORPTION: E- AND P-TYPE
92
93			zpu = 0.002*puu(jl, 10)
94			zpu10 = 112.*zpu
95			zpu11 = 6.25*zpu
96			zpu12 = 5.00*zpu
97			zpu13 = 80.0*zpu
98			zeu = puu(jl, 11)
99			zeu10 = 12.*zeu
100			zeu11 = 6.25*zeu
101			zeu12 = 5.00*zeu
102			zeu13 = 80.0*zeu
103
104			! - OZONE ABSORPTION
105
106			zx = puu(jl, 12)
107			zy = puu(jl, 13)
108			zuxy = 4.zxzx/(rpialf0*zy)
109			zsq1 = sqrt(1.+o1h*zuxy) - 1.
110			zsq2 = sqrt(1.+o2h*zuxy) - 1.
111			zvxy = rpialf0zy/(2.zx)
112			zaercn = puu(jl, 17) + zeu12 + zpu12
113			zto1 = exp(-zvxy*zsq1-zaercn)
114			zto2 = exp(-zvxy*zsq2-zaercn)
115
116			! -- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
117
118			! * CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
119
120			! NEXOTIC=1
121			! IF (NEXOTIC.EQ.1) THEN
122			zxch4 = puu(jl, 19)
123			zych4 = puu(jl, 20)
124			zuxy = 4.zxch4zxch4/(0.103*zych4)
125			zsqh41 = sqrt(1.+33.7*zuxy) - 1.
126			zvxy = 0.103zych4/(2.zxch4)
127			zodh41 = zvxy*zsqh41
128
129			! * N2O IN INTERVAL 800-970 + 1110-1250 CM-1
130
131			zxn2o = puu(jl, 21)
132			zyn2o = puu(jl, 22)
133			zuxy = 4.zxn2ozxn2o/(0.416*zyn2o)
134			zsqn21 = sqrt(1.+21.3*zuxy) - 1.
135			zvxy = 0.416zyn2o/(2.zxn2o)
136			zodn21 = zvxy*zsqn21
137
138			! * CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
139
140			zuxy = 4.zxch4zxch4/(0.113*zych4)
141			zsqh42 = sqrt(1.+400.*zuxy) - 1.
142			zvxy = 0.113zych4/(2.zxch4)
143			zodh42 = zvxy*zsqh42
144
145			! * N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
146
147			zuxy = 4.zxn2ozxn2o/(0.197*zyn2o)
148			zsqn22 = sqrt(1.+2000.*zuxy) - 1.
149			zvxy = 0.197zyn2o/(2.zxn2o)
150			zodn22 = zvxy*zsqn22
151
152			! * CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
153
154			za11 = 2.puu(jl, 23)4.404E+05
155			zttf11 = 1. - za11*0.003225
156
157			! * CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
158
159			za12 = 2.puu(jl, 24)6.7435E+05
160			zttf12 = 1. - za12*0.003225
161
162			zuu11 = -puu(jl, 15) - zeu10 - zpu10
163			zuu12 = -puu(jl, 16) - zeu11 - zpu11 - zodh41 - zodn21
164			ptt(jl, 10) = exp(-puu(jl,14))
165			ptt(jl, 11) = exp(zuu11)
166			ptt(jl, 12) = exp(zuu12)zttf11zttf12
167			ptt(jl, 13) = 0.7554zto1 + 0.2446zto2
168			ptt(jl, 14) = ptt(jl, 10)*exp(-zeu13-zpu13)
169			ptt(jl, 15) = exp(-puu(jl,14)-zodh42-zodn22)
170			END DO
171
172			RETURN
173			END SUBROUTINE lwtt