/[lmdze]/trunk/phylmd/Radlwsw/lwtt.f
ViewVC logotype

Diff of /trunk/phylmd/Radlwsw/lwtt.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/phylmd/Radlwsw/lwtt.f revision 24 by guez, Wed Mar 3 13:23:49 2010 UTC trunk/phylmd/Radlwsw/lwtt.f revision 265 by guez, Tue Mar 20 09:35:59 2018 UTC
# Line 1  Line 1 
1        SUBROUTINE LWTT(PGA,PGB,PUU, PTT)  SUBROUTINE lwtt(pga, pgb, puu, ptt)
2        use dimens_m    USE dimensions
3        use dimphy    USE dimphy
4        use raddim    USE raddim
5              use raddimlw    USE raddimlw
6        IMPLICIT none    IMPLICIT NONE
7  C  
8  C-----------------------------------------------------------------------    ! -----------------------------------------------------------------------
9  C     PURPOSE.    ! PURPOSE.
10  C     --------    ! --------
11  C           THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE    ! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
12  C     ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL    ! ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL
13  C     INTERVALS.    ! INTERVALS.
14  C  
15  C     METHOD.    ! METHOD.
16  C     -------    ! -------
17  C  
18  C          1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE    ! 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
19  C     COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.    ! COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
20  C          2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.    ! 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
21  C          3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN    ! 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
22  C     A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.    ! A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
23  C  
24  C     REFERENCE.    ! REFERENCE.
25  C     ----------    ! ----------
26  C  
27  C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND    ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
28  C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS    ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
29  C  
30  C     AUTHOR.    ! AUTHOR.
31  C     -------    ! -------
32  C        JEAN-JACQUES MORCRETTE  *ECMWF*    ! JEAN-JACQUES MORCRETTE  *ECMWF*
33  C  
34  C     MODIFICATIONS.    ! MODIFICATIONS.
35  C     --------------    ! --------------
36  C        ORIGINAL : 88-12-15    ! ORIGINAL : 88-12-15
37  C  
38  C-----------------------------------------------------------------------    ! -----------------------------------------------------------------------
39        REAL*8 O1H, O2H    DOUBLE PRECISION o1h, o2h
40        PARAMETER (O1H=2230.)    PARAMETER (o1h=2230.)
41        PARAMETER (O2H=100.)    PARAMETER (o2h=100.)
42        REAL*8 RPIALF0    DOUBLE PRECISION rpialf0
43        PARAMETER (RPIALF0=2.0)    PARAMETER (rpialf0=2.0)
44  C  
45  C* ARGUMENTS:    ! * ARGUMENTS:
46  C  
47        REAL*8 PUU(KDLON,NUA)    DOUBLE PRECISION puu(kdlon, nua)
48        REAL*8 PTT(KDLON,NTRA)    DOUBLE PRECISION ptt(kdlon, ntra)
49        REAL*8 PGA(KDLON,8,2)    DOUBLE PRECISION pga(kdlon, 8, 2)
50        REAL*8 PGB(KDLON,8,2)    DOUBLE PRECISION pgb(kdlon, 8, 2)
51  C  
52  C* LOCAL VARIABLES:    ! * LOCAL VARIABLES:
53  C  
54        REAL*8 zz, zxd, zxn    DOUBLE PRECISION zz, zxd, zxn
55        REAL*8 zpu, zpu10, zpu11, zpu12, zpu13    DOUBLE PRECISION zpu, zpu10, zpu11, zpu12, zpu13
56        REAL*8 zeu, zeu10, zeu11, zeu12, zeu13    DOUBLE PRECISION zeu, zeu10, zeu11, zeu12, zeu13
57        REAL*8 zx, zy, zsq1, zsq2, zvxy, zuxy    DOUBLE PRECISION zx, zy, zsq1, zsq2, zvxy, zuxy
58        REAL*8 zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o    DOUBLE PRECISION zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o
59        REAL*8 zsqn21, zodn21, zsqh42, zodh42    DOUBLE PRECISION zsqn21, zodn21, zsqh42, zodh42
60        REAL*8 zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12    DOUBLE PRECISION zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12
61        REAL*8 zuu11, zuu12, za11, za12    DOUBLE PRECISION zuu11, zuu12, za11, za12
62        INTEGER jl, ja    INTEGER jl, ja
63  C     ------------------------------------------------------------------    ! ------------------------------------------------------------------
64  C  
65  C*         1.     HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION    ! *         1.     HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
66  C                 -----------------------------------------------    ! -----------------------------------------------
67  C  
68   100  CONTINUE  
69  C  
70  C    DO ja = 1, 8
71        DO 130 JA = 1 , 8      DO jl = 1, kdlon
72        DO 120 JL = 1, KDLON        zz = sqrt(puu(jl,ja))
73        ZZ      =SQRT(PUU(JL,JA))        ! ZXD(JL,1)=PGB( JL, 1,1) + ZZ(JL, 1)*(PGB( JL, 1,2) + ZZ(JL, 1))
74  c     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) )
75  c     ZXN(JL,1)=PGA( JL, 1,1) + ZZ(JL, 1)*(PGA( JL, 1,2) )        ! PTT(JL,1)=ZXN(JL,1)/ZXD(JL,1)
76  c     PTT(JL,1)=ZXN(JL,1)/ZXD(JL,1)        zxd = pgb(jl, ja, 1) + zz*(pgb(jl,ja,2)+zz)
77        ZXD      =PGB( JL,JA,1) + ZZ       *(PGB( JL,JA,2) + ZZ       )        zxn = pga(jl, ja, 1) + zz*(pga(jl,ja,2))
78        ZXN      =PGA( JL,JA,1) + ZZ       *(PGA( JL,JA,2) )        ptt(jl, ja) = zxn/zxd
79        PTT(JL,JA)=ZXN      /ZXD      END DO
80    120 CONTINUE    END DO
81    130 CONTINUE  
82  C    ! ------------------------------------------------------------------
83  C     ------------------------------------------------------------------  
84  C    ! *         2.     CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
85  C*         2.     CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS    ! ---------------------------------------------------
86  C                 ---------------------------------------------------  
87  C  
88   200  CONTINUE    DO jl = 1, kdlon
89  C      ptt(jl, 9) = ptt(jl, 8)
90        DO 201 JL = 1, KDLON  
91        PTT(JL, 9) = PTT(JL, 8)      ! -  CONTINUUM ABSORPTION: E- AND P-TYPE
92  C  
93  C-  CONTINUUM ABSORPTION: E- AND P-TYPE      zpu = 0.002*puu(jl, 10)
94  C      zpu10 = 112.*zpu
95        ZPU   = 0.002 * PUU(JL,10)      zpu11 = 6.25*zpu
96        ZPU10 = 112. * ZPU      zpu12 = 5.00*zpu
97        ZPU11 = 6.25 * ZPU      zpu13 = 80.0*zpu
98        ZPU12 = 5.00 * ZPU      zeu = puu(jl, 11)
99        ZPU13 = 80.0 * ZPU      zeu10 = 12.*zeu
100        ZEU   =  PUU(JL,11)      zeu11 = 6.25*zeu
101        ZEU10 =  12. * ZEU      zeu12 = 5.00*zeu
102        ZEU11 = 6.25 * ZEU      zeu13 = 80.0*zeu
103        ZEU12 = 5.00 * ZEU  
104        ZEU13 = 80.0 * ZEU      ! -  OZONE ABSORPTION
105  C  
106  C-  OZONE ABSORPTION      zx = puu(jl, 12)
107  C      zy = puu(jl, 13)
108        ZX = PUU(JL,12)      zuxy = 4.*zx*zx/(rpialf0*zy)
109        ZY = PUU(JL,13)      zsq1 = sqrt(1.+o1h*zuxy) - 1.
110        ZUXY = 4. * ZX * ZX / (RPIALF0 * ZY)      zsq2 = sqrt(1.+o2h*zuxy) - 1.
111        ZSQ1 = SQRT(1. + O1H * ZUXY ) - 1.      zvxy = rpialf0*zy/(2.*zx)
112        ZSQ2 = SQRT(1. + O2H * ZUXY ) - 1.      zaercn = puu(jl, 17) + zeu12 + zpu12
113        ZVXY = RPIALF0 * ZY / (2. * ZX)      zto1 = exp(-zvxy*zsq1-zaercn)
114        ZAERCN = PUU(JL,17) + ZEU12 + ZPU12      zto2 = exp(-zvxy*zsq2-zaercn)
115        ZTO1 = EXP( - ZVXY * ZSQ1 - ZAERCN )  
116        ZTO2 = EXP( - ZVXY * ZSQ2 - ZAERCN )      ! -- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
117  C  
118  C-- TRACE GASES (CH4, N2O, CFC-11, CFC-12)      ! * CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
119  C  
120  C* CH4 IN INTERVAL 800-970 + 1110-1250 CM-1      ! NEXOTIC=1
121  C      ! IF (NEXOTIC.EQ.1) THEN
122  c     NEXOTIC=1      zxch4 = puu(jl, 19)
123  c     IF (NEXOTIC.EQ.1) THEN      zych4 = puu(jl, 20)
124        ZXCH4 = PUU(JL,19)      zuxy = 4.*zxch4*zxch4/(0.103*zych4)
125        ZYCH4 = PUU(JL,20)      zsqh41 = sqrt(1.+33.7*zuxy) - 1.
126        ZUXY = 4. * ZXCH4*ZXCH4/(0.103*ZYCH4)      zvxy = 0.103*zych4/(2.*zxch4)
127        ZSQH41 = SQRT(1. + 33.7 * ZUXY) - 1.      zodh41 = zvxy*zsqh41
128        ZVXY = 0.103 * ZYCH4 / (2. * ZXCH4)  
129        ZODH41 = ZVXY * ZSQH41      ! * N2O IN INTERVAL 800-970 + 1110-1250 CM-1
130  C  
131  C* N2O IN INTERVAL 800-970 + 1110-1250 CM-1      zxn2o = puu(jl, 21)
132  C      zyn2o = puu(jl, 22)
133        ZXN2O = PUU(JL,21)      zuxy = 4.*zxn2o*zxn2o/(0.416*zyn2o)
134        ZYN2O = PUU(JL,22)      zsqn21 = sqrt(1.+21.3*zuxy) - 1.
135        ZUXY = 4. * ZXN2O*ZXN2O/(0.416*ZYN2O)      zvxy = 0.416*zyn2o/(2.*zxn2o)
136        ZSQN21 = SQRT(1. + 21.3 * ZUXY) - 1.      zodn21 = zvxy*zsqn21
137        ZVXY = 0.416 * ZYN2O / (2. * ZXN2O)  
138        ZODN21 = ZVXY * ZSQN21      ! * CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
139  C  
140  C* CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1      zuxy = 4.*zxch4*zxch4/(0.113*zych4)
141  C      zsqh42 = sqrt(1.+400.*zuxy) - 1.
142        ZUXY = 4. * ZXCH4*ZXCH4/(0.113*ZYCH4)      zvxy = 0.113*zych4/(2.*zxch4)
143        ZSQH42 = SQRT(1. + 400. * ZUXY) - 1.      zodh42 = zvxy*zsqh42
144        ZVXY = 0.113 * ZYCH4 / (2. * ZXCH4)  
145        ZODH42 = ZVXY * ZSQH42      ! * N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
146  C  
147  C* N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1      zuxy = 4.*zxn2o*zxn2o/(0.197*zyn2o)
148  C      zsqn22 = sqrt(1.+2000.*zuxy) - 1.
149        ZUXY = 4. * ZXN2O*ZXN2O/(0.197*ZYN2O)      zvxy = 0.197*zyn2o/(2.*zxn2o)
150        ZSQN22 = SQRT(1. + 2000. * ZUXY) - 1.      zodn22 = zvxy*zsqn22
151        ZVXY = 0.197 * ZYN2O / (2. * ZXN2O)  
152        ZODN22 = ZVXY * ZSQN22      ! * CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
153  C  
154  C* CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1      za11 = 2.*puu(jl, 23)*4.404E+05
155  C      zttf11 = 1. - za11*0.003225
156        ZA11 = 2. * PUU(JL,23) * 4.404E+05  
157        ZTTF11 = 1. - ZA11 * 0.003225      ! * CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
158  C  
159  C* CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1      za12 = 2.*puu(jl, 24)*6.7435E+05
160  C      zttf12 = 1. - za12*0.003225
161        ZA12 = 2. * PUU(JL,24) * 6.7435E+05  
162        ZTTF12 = 1. - ZA12 * 0.003225      zuu11 = -puu(jl, 15) - zeu10 - zpu10
163  C      zuu12 = -puu(jl, 16) - zeu11 - zpu11 - zodh41 - zodn21
164        ZUU11 = - PUU(JL,15) - ZEU10 - ZPU10      ptt(jl, 10) = exp(-puu(jl,14))
165        ZUU12 = - PUU(JL,16) - ZEU11 - ZPU11 - ZODH41 - ZODN21      ptt(jl, 11) = exp(zuu11)
166        PTT(JL,10) = EXP( - PUU(JL,14) )      ptt(jl, 12) = exp(zuu12)*zttf11*zttf12
167        PTT(JL,11) = EXP( ZUU11 )      ptt(jl, 13) = 0.7554*zto1 + 0.2446*zto2
168        PTT(JL,12) = EXP( ZUU12 ) * ZTTF11 * ZTTF12      ptt(jl, 14) = ptt(jl, 10)*exp(-zeu13-zpu13)
169        PTT(JL,13) = 0.7554 * ZTO1 + 0.2446 * ZTO2      ptt(jl, 15) = exp(-puu(jl,14)-zodh42-zodn22)
170        PTT(JL,14) = PTT(JL,10) * EXP( - ZEU13 - ZPU13 )    END DO
171        PTT(JL,15) = EXP ( - PUU(JL,14) - ZODH42 - ZODN22 )  
172   201  CONTINUE    RETURN
173  C  END SUBROUTINE lwtt
       RETURN  
       END  
Legend:
Removed from v.24  
changed lines
  Added in v.265
  ViewVC Help
Powered by ViewVC 1.1.21