/[lmdze]/trunk/libf/phylmd/Radlwsw/lwu.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/Radlwsw/lwu.f90

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

trunk/libf/phylmd/Radlwsw/lwu.f revision 24 by guez, Wed Mar 3 13:23:49 2010 UTC trunk/libf/phylmd/Radlwsw/lwu.f90 revision 71 by guez, Mon Jul 8 18:12:18 2013 UTC
# Line 1  Line 1 
1  cIM ctes ds clesphys.h   SUBROUTINE LWU(RCO2, RCH4, RN2O, RCFC11, RCFC12,  module LWU_m
2        SUBROUTINE LWU(  
3       S               PAER,PDP,PPMB,PPSOL,POZ,PTAVE,PVIEW,PWV,    IMPLICIT none
4       S               PABCU)  
5        use dimens_m  contains
6        use dimphy  
7        use clesphys    SUBROUTINE LWU(PAER, PDP, PPMB, PPSOL, POZ, PTAVE, PVIEW, PWV, PABCU)
8        use YOMCST  
9        use raddim      ! Purpose. Computes absorber amounts including pressure and
10        use radepsi      ! temperature effects.
11        use radopt  
12              use raddimlw      ! Method. Computes the pressure and temperature weighted amounts
13        IMPLICIT none      ! of absorbers.
14  C  
15  C     PURPOSE.      ! Reference. See radiation's part of the model's documentation and
16  C     --------      ! ECMWF research department documentation of the IFS.
17  C           COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND  
18  C           TEMPERATURE EFFECTS      ! Author. Jean-Jacques Morcrette, ECMWF.
19  C  
20  C     METHOD.      ! Modifications.
21  C     -------      ! Original : 89-07-14
22  C      ! Voigt lines (loop 404 modified) - JJM & PhD - 01/96
23  C          1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF  
24  C     ABSORBERS.      USE clesphys, ONLY: rcfc11, rcfc12, rch4, rco2, rn2o
25  C      USE suphec_m, ONLY: rg
26  C      USE raddim, ONLY: kdlon, kflev
27  C     REFERENCE.      USE radepsi, ONLY: zepsco, zepscq
28  C     ----------      USE radopt, ONLY: levoigt
29  C      USE raddimlw, ONLY: ng1, ng1p1, ninter, nua
30  C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND  
31  C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS      ! ARGUMENTS:
32  C  
33  C     AUTHOR.      DOUBLE PRECISION PAER(KDLON, KFLEV, 5)
34  C     -------      DOUBLE PRECISION PDP(KDLON, KFLEV)
35  C        JEAN-JACQUES MORCRETTE  *ECMWF*      DOUBLE PRECISION PPMB(KDLON, KFLEV + 1)
36  C      DOUBLE PRECISION PPSOL(KDLON)
37  C     MODIFICATIONS.      DOUBLE PRECISION POZ(KDLON, KFLEV)
38  C     --------------      DOUBLE PRECISION PTAVE(KDLON, KFLEV)
39  C        ORIGINAL : 89-07-14      DOUBLE PRECISION PVIEW(KDLON)
40  C        Voigt lines (loop 404 modified) - JJM & PhD - 01/96      DOUBLE PRECISION PWV(KDLON, KFLEV)
41  C-----------------------------------------------------------------------  
42  C* ARGUMENTS:      DOUBLE PRECISION PABCU(KDLON, NUA, 3 * KFLEV + 1)
43  cIM ctes ds clesphys.h      ! effective absorber amounts
44  c     REAL*8 RCO2  
45  c     REAL*8 RCH4, RN2O, RCFC11, RCFC12      ! LOCAL VARIABLES:
46        REAL*8 PAER(KDLON,KFLEV,5)  
47        REAL*8 PDP(KDLON,KFLEV)      DOUBLE PRECISION ZABLY(KDLON, NUA, 3 * KFLEV + 1)
48        REAL*8 PPMB(KDLON,KFLEV+1)      DOUBLE PRECISION ZDUC(KDLON, 3 * KFLEV + 1)
49        REAL*8 PPSOL(KDLON)      DOUBLE PRECISION ZPHIO(KDLON)
50        REAL*8 POZ(KDLON,KFLEV)      DOUBLE PRECISION ZPSC2(KDLON)
51        REAL*8 PTAVE(KDLON,KFLEV)      DOUBLE PRECISION ZPSC3(KDLON)
52        REAL*8 PVIEW(KDLON)      DOUBLE PRECISION ZPSH1(KDLON)
53        REAL*8 PWV(KDLON,KFLEV)      DOUBLE PRECISION ZPSH2(KDLON)
54  C      DOUBLE PRECISION ZPSH3(KDLON)
55        REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS      DOUBLE PRECISION ZPSH4(KDLON)
56  C      DOUBLE PRECISION ZPSH5(KDLON)
57  C-----------------------------------------------------------------------      DOUBLE PRECISION ZPSH6(KDLON)
58  C* LOCAL VARIABLES:      DOUBLE PRECISION ZPSIO(KDLON)
59        REAL*8 ZABLY(KDLON,NUA,3*KFLEV+1)      DOUBLE PRECISION ZTCON(KDLON)
60        REAL*8 ZDUC(KDLON,3*KFLEV+1)      DOUBLE PRECISION ZPHM6(KDLON)
61        REAL*8 ZPHIO(KDLON)      DOUBLE PRECISION ZPSM6(KDLON)
62        REAL*8 ZPSC2(KDLON)      DOUBLE PRECISION ZPHN6(KDLON)
63        REAL*8 ZPSC3(KDLON)      DOUBLE PRECISION ZPSN6(KDLON)
64        REAL*8 ZPSH1(KDLON)      DOUBLE PRECISION ZSSIG(KDLON, 3 * KFLEV + 1)
65        REAL*8 ZPSH2(KDLON)      DOUBLE PRECISION ZTAVI(KDLON)
66        REAL*8 ZPSH3(KDLON)      DOUBLE PRECISION ZUAER(KDLON, Ninter)
67        REAL*8 ZPSH4(KDLON)      DOUBLE PRECISION ZXOZ(KDLON)
68        REAL*8 ZPSH5(KDLON)      DOUBLE PRECISION ZXWV(KDLON)
69        REAL*8 ZPSH6(KDLON)  
70        REAL*8 ZPSIO(KDLON)      INTEGER jl, jk, jkj, jkjr, jkjp, ig1
71        REAL*8 ZTCON(KDLON)      INTEGER jki, jkip1, ja, jj
72        REAL*8 ZPHM6(KDLON)      INTEGER jkl, jkp1, jkk, jkjpn
73        REAL*8 ZPSM6(KDLON)      INTEGER jae1, jae2, jae3, jae, jjpn
74        REAL*8 ZPHN6(KDLON)      INTEGER ir, jc, jcp1
75        REAL*8 ZPSN6(KDLON)      DOUBLE PRECISION zdpm, zupm, zupmh2o, zupmco2, zupmo3, zu6, zup
76        REAL*8 ZSSIG(KDLON,3*KFLEV+1)      DOUBLE PRECISION zfppw, ztx, ztx2, zzably
77        REAL*8 ZTAVI(KDLON)      DOUBLE PRECISION zcah1, zcbh1, zcah2, zcbh2, zcah3, zcbh3
78        REAL*8 ZUAER(KDLON,Ninter)      DOUBLE PRECISION zcah4, zcbh4, zcah5, zcbh5, zcah6, zcbh6
79        REAL*8 ZXOZ(KDLON)      DOUBLE PRECISION zcac8, zcbc8
80        REAL*8 ZXWV(KDLON)      DOUBLE PRECISION zalup, zdiff
81  C  
82        INTEGER jl, jk, jkj, jkjr, jkjp, ig1      DOUBLE PRECISION PVGCO2, PVGH2O, PVGO3
83        INTEGER jki, jkip1, ja, jj  
84        INTEGER jkl, jkp1, jkk, jkjpn      DOUBLE PRECISION, PARAMETER:: R10E = 0.4342945
85        INTEGER jae1, jae2, jae3, jae, jjpn      ! decimal / natural logarithm factor
86        INTEGER ir, jc, jcp1  
87        REAL*8 zdpm, zupm, zupmh2o, zupmco2, zupmo3, zu6, zup      ! Used Data Block:
88        REAL*8 zfppw, ztx, ztx2, zzably  
89        REAL*8 zcah1, zcbh1, zcah2, zcbh2, zcah3, zcbh3      DOUBLE PRECISION:: TREF = 250d0
90        REAL*8 zcah4, zcbh4, zcah5, zcbh5, zcah6, zcbh6      DOUBLE PRECISION:: RT1(2) = (/ - 0.577350269d0, 0.577350269d0/)
91        REAL*8 zcac8, zcbc8      DOUBLE PRECISION RAER(5, 5)
92        REAL*8 zalup, zdiff      DOUBLE PRECISION AT(8, 3), BT(8, 3)
93  c      DOUBLE PRECISION:: OCT(4) = (/- 0.326D-3, - 0.102D-5, 0.137D-2, - 0.535D-5/)
94        REAL*8 PVGCO2, PVGH2O, PVGO3  
95  C      DATA RAER / .038520, .037196, .040532, .054934, .038520, &
96        REAL*8 R10E  ! DECIMAL/NATURAL LOG.FACTOR           .12613, .18313, .10357, .064106, .126130, &
97        PARAMETER (R10E=0.4342945)           .012579, .013649, .018652, .025181, .012579, &
98  c           .011890, .016142, .021105, .028908, .011890, &
99  c Used Data Block:           .013792, .026810, .052203, .066338, .013792 /
100  c  
101        REAL*8 TREF      DATA (AT(1, IR), IR = 1, 3) / 0.298199E-02, - .394023E-03, 0.319566E-04 /
102        SAVE TREF      DATA (BT(1, IR), IR = 1, 3) / - 0.106432E-04, 0.660324E-06, 0.174356E-06 /
103        REAL*8 RT1(2)      DATA (AT(2, IR), IR = 1, 3) / 0.143676E-01, 0.366501E-02, -.160822E-02 /
104        SAVE RT1      DATA (BT(2, IR), IR = 1, 3) / -0.553979E-04, - .101701E-04, 0.920868E-05 /
105        REAL*8 RAER(5,5)      DATA (AT(3, IR), IR = 1, 3) / 0.197861E-01, 0.315541E-02, - .174547E-02 /
106        SAVE RAER      DATA (BT(3, IR), IR = 1, 3) / - 0.877012E-04, 0.513302E-04, 0.523138E-06 /
107        REAL*8 AT(8,3), BT(8,3)      DATA (AT(4, IR), IR = 1, 3) / 0.289560E-01, - .208807E-02, - .121943E-02 /
108        SAVE AT, BT      DATA (BT(4, IR), IR = 1, 3) / - 0.165960E-03, 0.157704E-03, - .146427E-04 /
109        REAL*8 OCT(4)      DATA (AT(5, IR), IR = 1, 3) / 0.103800E-01, 0.436296E-02, - .161431E-02 /
110        SAVE OCT      DATA (BT(5, IR), IR = 1, 3) / - .276744E-04, - .327381E-04, 0.127646E-04 /
111        DATA TREF /250.0/      DATA (AT(6, IR), IR = 1, 3) / 0.868859E-02, - .972752E-03, 0.000000E-00 /
112        DATA (RT1(IG1),IG1=1,2) / -0.577350269, +0.577350269 /      DATA (BT(6, IR), IR = 1, 3) / - .278412E-04, - .713940E-06, 0.117469E-05 /
113        DATA RAER / .038520, .037196, .040532, .054934, .038520      DATA (AT(7, IR), IR = 1, 3) / 0.250073E-03, 0.455875E-03, 0.109242E-03 /
114       1          , .12613 , .18313 , .10357 , .064106, .126130      DATA (BT(7, IR), IR = 1, 3) / 0.199846E-05, - .216313E-05, 0.175991E-06 /
115       2          , .012579, .013649, .018652, .025181, .012579      DATA (AT(8, IR), IR = 1, 3) / 0.307423E-01, 0.110879E-02, - .322172E-03 /
116       3          , .011890, .016142, .021105, .028908, .011890      DATA (BT(8, IR), IR = 1, 3) / - 0.108482E-03, 0.258096E-05, - .814575E-06 /
117       4          , .013792, .026810, .052203, .066338, .013792 /  
118        DATA (AT(1,IR),IR=1,3) /      !-----------------------------------------------------------------------
119       S 0.298199E-02,-.394023E-03,0.319566E-04 /  
120        DATA (BT(1,IR),IR=1,3) /      IF (LEVOIGT) THEN
121       S-0.106432E-04,0.660324E-06,0.174356E-06 /         PVGCO2 = 60.
122        DATA (AT(2,IR),IR=1,3) /         PVGH2O = 30.
123       S 0.143676E-01,0.366501E-02,-.160822E-02 /         PVGO3 = 400.
124        DATA (BT(2,IR),IR=1,3) /      ELSE
125       S-0.553979E-04,-.101701E-04,0.920868E-05 /         PVGCO2 = 0.
126        DATA (AT(3,IR),IR=1,3) /         PVGH2O = 0.
127       S 0.197861E-01,0.315541E-02,-.174547E-02 /         PVGO3 = 0.
128        DATA (BT(3,IR),IR=1,3) /      ENDIF
129       S-0.877012E-04,0.513302E-04,0.523138E-06 /  
130        DATA (AT(4,IR),IR=1,3) /      ! 2. PRESSURE OVER GAUSS SUB-LEVELS
131       S 0.289560E-01,-.208807E-02,-.121943E-02 /  
132        DATA (BT(4,IR),IR=1,3) /      DO JL = 1, KDLON
133       S-0.165960E-03,0.157704E-03,-.146427E-04 /         ZSSIG(JL, 1) = PPMB(JL, 1) * 100.
134        DATA (AT(5,IR),IR=1,3) /      end DO
135       S 0.103800E-01,0.436296E-02,-.161431E-02 /  
136        DATA (BT(5,IR),IR=1,3) /      DO JK = 1, KFLEV
137       S -.276744E-04,-.327381E-04,0.127646E-04 /         JKJ = (JK - 1) * NG1P1 + 1
138        DATA (AT(6,IR),IR=1,3) /         JKJR = JKJ
139       S 0.868859E-02,-.972752E-03,0.000000E-00 /         JKJP = JKJ + NG1P1
140        DATA (BT(6,IR),IR=1,3) /         DO JL = 1, KDLON
141       S -.278412E-04,-.713940E-06,0.117469E-05 /            ZSSIG(JL, JKJP) = PPMB(JL, JK + 1) * 100.
142        DATA (AT(7,IR),IR=1,3) /         end DO
143       S 0.250073E-03,0.455875E-03,0.109242E-03 /         DO IG1 = 1, NG1
144        DATA (BT(7,IR),IR=1,3) /            JKJ = JKJ + 1
145       S 0.199846E-05,-.216313E-05,0.175991E-06 /            DO JL = 1, KDLON
146        DATA (AT(8,IR),IR=1,3) /               ZSSIG(JL, JKJ) = (ZSSIG(JL, JKJR) + ZSSIG(JL, JKJP)) * 0.5 &
147       S 0.307423E-01,0.110879E-02,-.322172E-03 /                    + RT1(IG1) * (ZSSIG(JL, JKJP) - ZSSIG(JL, JKJR)) * 0.5
148        DATA (BT(8,IR),IR=1,3) /            end DO
149       S-0.108482E-03,0.258096E-05,-.814575E-06 /         end DO
150  c      end DO
151        DATA OCT /-.326E-03, -.102E-05, .137E-02, -.535E-05/  
152  C-----------------------------------------------------------------------      ! 4. PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS
153  c  
154        IF (LEVOIGT) THEN      DO JKI = 1, 3 * KFLEV
155           PVGCO2= 60.         JKIP1 = JKI + 1
156           PVGH2O= 30.         DO JL = 1, KDLON
157           PVGO3 =400.            ZABLY(JL, 5, JKI) = (ZSSIG(JL, JKI) + ZSSIG(JL, JKIP1)) * 0.5
158        ELSE            ZABLY(JL, 3, JKI) = (ZSSIG(JL, JKI) - ZSSIG(JL, JKIP1)) / (10. * RG)
159           PVGCO2= 0.         end DO
160           PVGH2O= 0.      end DO
161           PVGO3 = 0.  
162        ENDIF      DO JK = 1, KFLEV
163  C         JKP1 = JK + 1
164  C         JKL = KFLEV + 1 - JK
165  C*         2.    PRESSURE OVER GAUSS SUB-LEVELS         DO JL = 1, KDLON
166  C                ------------------------------            ZXWV(JL) = MAX(PWV(JL, JK), ZEPSCQ)
167  C            ZXOZ(JL) = MAX(POZ(JL, JK) / PDP(JL, JK), ZEPSCO)
168   200  CONTINUE         end DO
169  C         JKJ = (JK - 1) * NG1P1 + 1
170        DO 201 JL = 1, KDLON         JKJPN = JKJ + NG1
171        ZSSIG(JL, 1 ) = PPMB(JL,1) * 100.         DO JKK = JKJ, JKJPN
172   201  CONTINUE            DO JL = 1, KDLON
173  C               ZDPM = ZABLY(JL, 3, JKK)
174        DO 206 JK = 1 , KFLEV               ZUPM = ZABLY(JL, 5, JKK) * ZDPM / 101325.
175        JKJ=(JK-1)*NG1P1+1               ZUPMCO2 = (ZABLY(JL, 5, JKK) + PVGCO2) * ZDPM / 101325.
176        JKJR = JKJ               ZUPMH2O = (ZABLY(JL, 5, JKK) + PVGH2O) * ZDPM / 101325.
177        JKJP = JKJ + NG1P1               ZUPMO3 = (ZABLY(JL, 5, JKK) + PVGO3) * ZDPM / 101325.
178        DO 203 JL = 1, KDLON               ZDUC(JL, JKK) = ZDPM
179        ZSSIG(JL,JKJP)=PPMB(JL,JK+1)* 100.               ZABLY(JL, 12, JKK) = ZXOZ(JL) * ZDPM
180   203  CONTINUE               ZABLY(JL, 13, JKK) = ZXOZ(JL) * ZUPMO3
181        DO 205 IG1=1,NG1               ZU6 = ZXWV(JL) * ZUPM
182        JKJ=JKJ+1               ZFPPW = 1.6078 * ZXWV(JL) / (1. + 0.608 * ZXWV(JL))
183        DO 204 JL = 1, KDLON               ZABLY(JL, 6, JKK) = ZXWV(JL) * ZUPMH2O
184        ZSSIG(JL,JKJ)= (ZSSIG(JL,JKJR)+ZSSIG(JL,JKJP))*0.5               ZABLY(JL, 11, JKK) = ZU6 * ZFPPW
185       S  + RT1(IG1) * (ZSSIG(JL,JKJP) - ZSSIG(JL,JKJR)) * 0.5               ZABLY(JL, 10, JKK) = ZU6 * (1. - ZFPPW)
186   204  CONTINUE               ZABLY(JL, 9, JKK) = RCO2 * ZUPMCO2
187   205  CONTINUE               ZABLY(JL, 8, JKK) = RCO2 * ZDPM
188   206  CONTINUE            end DO
189  C         end DO
190  C-----------------------------------------------------------------------      end DO
191  C  
192  C      ! 5. CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE
193  C*         4.    PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS  
194  C                --------------------------------------------------      DO JA = 1, NUA
195  C         DO JL = 1, KDLON
196   400  CONTINUE            PABCU(JL, JA, 3 * KFLEV + 1) = 0.
197  C         end DO
198        DO 402 JKI=1,3*KFLEV      end DO
199        JKIP1=JKI+1  
200        DO 401 JL = 1, KDLON      DO JK = 1, KFLEV
201        ZABLY(JL,5,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,JKIP1))*0.5         JJ = (JK - 1) * NG1P1 + 1
202        ZABLY(JL,3,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,JKIP1))         JJPN = JJ + NG1
203       S                                 /(10.*RG)         JKL = KFLEV + 1 - JK
204   401  CONTINUE  
205   402  CONTINUE         ! 5.1 CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE
206  C  
207        DO 406 JK = 1 , KFLEV         JAE1 = 3 * KFLEV + 1 - JJ
208        JKP1=JK+1         JAE2 = 3 * KFLEV + 1 - (JJ + 1)
209        JKL = KFLEV+1 - JK         JAE3 = 3 * KFLEV + 1 - JJPN
210        DO 403 JL = 1, KDLON         DO JAE = 1, 5
211        ZXWV(JL) = MAX (PWV(JL,JK) , ZEPSCQ )            DO JL = 1, KDLON
212        ZXOZ(JL) = MAX (POZ(JL,JK) / PDP(JL,JK) , ZEPSCO )               ZUAER(JL, JAE) = (RAER(JAE, 1) * PAER(JL, JKL, 1) &
213   403  CONTINUE                    + RAER(JAE, 2) * PAER(JL, JKL, 2) &
214        JKJ=(JK-1)*NG1P1+1                    + RAER(JAE, 3) * PAER(JL, JKL, 3) &
215        JKJPN=JKJ+NG1                    + RAER(JAE, 4) * PAER(JL, JKL, 4) &
216        DO 405 JKK=JKJ,JKJPN                    + RAER(JAE, 5) * PAER(JL, JKL, 5)) &
217        DO 404 JL = 1, KDLON                    / (ZDUC(JL, JAE1) + ZDUC(JL, JAE2) + ZDUC(JL, JAE3))
218        ZDPM = ZABLY(JL,3,JKK)            end DO
219        ZUPM = ZABLY(JL,5,JKK)             * ZDPM / 101325.         end DO
220        ZUPMCO2 = ( ZABLY(JL,5,JKK) + PVGCO2 ) * ZDPM / 101325.  
221        ZUPMH2O = ( ZABLY(JL,5,JKK) + PVGH2O ) * ZDPM / 101325.         ! 5.2 INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS
222        ZUPMO3  = ( ZABLY(JL,5,JKK) + PVGO3  ) * ZDPM / 101325.  
223        ZDUC(JL,JKK) = ZDPM         DO JL = 1, KDLON
224        ZABLY(JL,12,JKK) = ZXOZ(JL) * ZDPM            ZTAVI(JL) = PTAVE(JL, JKL)
225        ZABLY(JL,13,JKK) = ZXOZ(JL) * ZUPMO3            ZTCON(JL) = EXP(6.08 * (296. / ZTAVI(JL) - 1.))
226        ZU6 = ZXWV(JL) * ZUPM            ZTX = ZTAVI(JL) - TREF
227        ZFPPW = 1.6078 * ZXWV(JL) / (1.+0.608*ZXWV(JL))            ZTX2 = ZTX * ZTX
228        ZABLY(JL,6,JKK) = ZXWV(JL) * ZUPMH2O            ZZABLY = ZABLY(JL, 6, JAE1) + ZABLY(JL, 6, JAE2) + ZABLY(JL, 6, JAE3)
229        ZABLY(JL,11,JKK) = ZU6 * ZFPPW            ZUP = MIN(MAX(0.5 * R10E * LOG(ZZABLY) + 5., 0d0), 6d0)
230        ZABLY(JL,10,JKK) = ZU6 * (1.-ZFPPW)            ZCAH1 = AT(1, 1) + ZUP * (AT(1, 2) + ZUP * (AT(1, 3)))
231        ZABLY(JL,9,JKK) = RCO2 * ZUPMCO2            ZCBH1 = BT(1, 1) + ZUP * (BT(1, 2) + ZUP * (BT(1, 3)))
232        ZABLY(JL,8,JKK) = RCO2 * ZDPM            ZPSH1(JL) = EXP(ZCAH1 * ZTX + ZCBH1 * ZTX2)
233   404  CONTINUE            ZCAH2 = AT(2, 1) + ZUP * (AT(2, 2) + ZUP * (AT(2, 3)))
234   405  CONTINUE            ZCBH2 = BT(2, 1) + ZUP * (BT(2, 2) + ZUP * (BT(2, 3)))
235   406  CONTINUE            ZPSH2(JL) = EXP(ZCAH2 * ZTX + ZCBH2 * ZTX2)
236  C            ZCAH3 = AT(3, 1) + ZUP * (AT(3, 2) + ZUP * (AT(3, 3)))
237  C-----------------------------------------------------------------------            ZCBH3 = BT(3, 1) + ZUP * (BT(3, 2) + ZUP * (BT(3, 3)))
238  C            ZPSH3(JL) = EXP(ZCAH3 * ZTX + ZCBH3 * ZTX2)
239  C            ZCAH4 = AT(4, 1) + ZUP * (AT(4, 2) + ZUP * (AT(4, 3)))
240  C*         5.    CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE            ZCBH4 = BT(4, 1) + ZUP * (BT(4, 2) + ZUP * (BT(4, 3)))
241  C                --------------------------------------------------            ZPSH4(JL) = EXP(ZCAH4 * ZTX + ZCBH4 * ZTX2)
242  C            ZCAH5 = AT(5, 1) + ZUP * (AT(5, 2) + ZUP * (AT(5, 3)))
243   500  CONTINUE            ZCBH5 = BT(5, 1) + ZUP * (BT(5, 2) + ZUP * (BT(5, 3)))
244  C            ZPSH5(JL) = EXP(ZCAH5 * ZTX + ZCBH5 * ZTX2)
245        DO 502 JA = 1, NUA            ZCAH6 = AT(6, 1) + ZUP * (AT(6, 2) + ZUP * (AT(6, 3)))
246        DO 501 JL = 1, KDLON            ZCBH6 = BT(6, 1) + ZUP * (BT(6, 2) + ZUP * (BT(6, 3)))
247        PABCU(JL,JA,3*KFLEV+1) = 0.            ZPSH6(JL) = EXP(ZCAH6 * ZTX + ZCBH6 * ZTX2)
248    501 CONTINUE            ZPHM6(JL) = EXP(- 5.81E-4 * ZTX - 1.13E-6 * ZTX2)
249    502 CONTINUE            ZPSM6(JL) = EXP(- 5.57E-4 * ZTX - 3.30E-6 * ZTX2)
250  C            ZPHN6(JL) = EXP(- 3.46E-5 * ZTX + 2.05E-7 * ZTX2)
251        DO 529 JK = 1 , KFLEV            ZPSN6(JL) = EXP(3.70E-3 * ZTX - 2.30E-6 * ZTX2)
252        JJ=(JK-1)*NG1P1+1         end DO
253        JJPN=JJ+NG1  
254        JKL=KFLEV+1-JK         DO JL = 1, KDLON
255  C            ZTAVI(JL) = PTAVE(JL, JKL)
256  C            ZTX = ZTAVI(JL) - TREF
257  C*         5.1  CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE            ZTX2 = ZTX * ZTX
258  C               --------------------------------------------------            ZZABLY = ZABLY(JL, 9, JAE1) + ZABLY(JL, 9, JAE2) + ZABLY(JL, 9, JAE3)
259  C            ZALUP = R10E * LOG(ZZABLY)
260   510  CONTINUE            ZUP = MAX(0d0, 5.0 + 0.5 * ZALUP)
261  C            ZPSC2(JL) = (ZTAVI(JL) / TREF) ** ZUP
262        JAE1=3*KFLEV+1-JJ            ZCAC8 = AT(8, 1) + ZUP * (AT(8, 2) + ZUP * (AT(8, 3)))
263        JAE2=3*KFLEV+1-(JJ+1)            ZCBC8 = BT(8, 1) + ZUP * (BT(8, 2) + ZUP * (BT(8, 3)))
264        JAE3=3*KFLEV+1-JJPN            ZPSC3(JL) = EXP(ZCAC8 * ZTX + ZCBC8 * ZTX2)
265        DO 512 JAE=1,5            ZPHIO(JL) = EXP(OCT(1) * ZTX + OCT(2) * ZTX2)
266        DO 511 JL = 1, KDLON            ZPSIO(JL) = EXP(2. * (OCT(3) * ZTX + OCT(4) * ZTX2))
267        ZUAER(JL,JAE) = (RAER(JAE,1)*PAER(JL,JKL,1)         end DO
268       S      +RAER(JAE,2)*PAER(JL,JKL,2)+RAER(JAE,3)*PAER(JL,JKL,3)  
269       S      +RAER(JAE,4)*PAER(JL,JKL,4)+RAER(JAE,5)*PAER(JL,JKL,5))         DO JKK = JJ, JJPN
270       S      /(ZDUC(JL,JAE1)+ZDUC(JL,JAE2)+ZDUC(JL,JAE3))            JC = 3 * KFLEV + 1 - JKK
271   511  CONTINUE            JCP1 = JC + 1
272   512  CONTINUE            DO JL = 1, KDLON
273  C               ZDIFF = PVIEW(JL)
274  C               PABCU(JL, 10, JC) = PABCU(JL, 10, JCP1) &
275  C                    + ZABLY(JL, 10, JC) * ZDIFF
276  C*         5.2  INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS               PABCU(JL, 11, JC) = PABCU(JL, 11, JCP1) &
277  C               --------------------------------------------------                    + ZABLY(JL, 11, JC) * ZTCON(JL) * ZDIFF
278  C  
279   520  CONTINUE               PABCU(JL, 12, JC) = PABCU(JL, 12, JCP1) &
280  C                    + ZABLY(JL, 12, JC) * ZPHIO(JL) * ZDIFF
281        DO 521 JL = 1, KDLON               PABCU(JL, 13, JC) = PABCU(JL, 13, JCP1) &
282        ZTAVI(JL)=PTAVE(JL,JKL)                    + ZABLY(JL, 13, JC) * ZPSIO(JL) * ZDIFF
283        ZTCON(JL)=EXP(6.08*(296./ZTAVI(JL)-1.))  
284        ZTX=ZTAVI(JL)-TREF               PABCU(JL, 7, JC) = PABCU(JL, 7, JCP1) &
285        ZTX2=ZTX*ZTX                    + ZABLY(JL, 9, JC) * ZPSC2(JL) * ZDIFF
286        ZZABLY = ZABLY(JL,6,JAE1)+ZABLY(JL,6,JAE2)+ZABLY(JL,6,JAE3)               PABCU(JL, 8, JC) = PABCU(JL, 8, JCP1) &
287  CMAF      ZUP=MIN( MAX( 0.5*R10E*LOG( ZZABLY ) + 5., 0.), 6.0)                    + ZABLY(JL, 9, JC) * ZPSC3(JL) * ZDIFF
288        ZUP=MIN( MAX( 0.5*R10E*LOG( ZZABLY ) + 5., 0.d+0), 6.d+0)               PABCU(JL, 9, JC) = PABCU(JL, 9, JCP1) &
289        ZCAH1=AT(1,1)+ZUP*(AT(1,2)+ZUP*(AT(1,3)))                    + ZABLY(JL, 9, JC) * ZPSC3(JL) * ZDIFF
290        ZCBH1=BT(1,1)+ZUP*(BT(1,2)+ZUP*(BT(1,3)))  
291        ZPSH1(JL)=EXP( ZCAH1 * ZTX + ZCBH1 * ZTX2 )               PABCU(JL, 1, JC) = PABCU(JL, 1, JCP1) &
292        ZCAH2=AT(2,1)+ZUP*(AT(2,2)+ZUP*(AT(2,3)))                    + ZABLY(JL, 6, JC) * ZPSH1(JL) * ZDIFF
293        ZCBH2=BT(2,1)+ZUP*(BT(2,2)+ZUP*(BT(2,3)))               PABCU(JL, 2, JC) = PABCU(JL, 2, JCP1) &
294        ZPSH2(JL)=EXP( ZCAH2 * ZTX + ZCBH2 * ZTX2 )                    + ZABLY(JL, 6, JC) * ZPSH2(JL) * ZDIFF
295        ZCAH3=AT(3,1)+ZUP*(AT(3,2)+ZUP*(AT(3,3)))               PABCU(JL, 3, JC) = PABCU(JL, 3, JCP1) &
296        ZCBH3=BT(3,1)+ZUP*(BT(3,2)+ZUP*(BT(3,3)))                    + ZABLY(JL, 6, JC) * ZPSH5(JL) * ZDIFF
297        ZPSH3(JL)=EXP( ZCAH3 * ZTX + ZCBH3 * ZTX2 )               PABCU(JL, 4, JC) = PABCU(JL, 4, JCP1) &
298        ZCAH4=AT(4,1)+ZUP*(AT(4,2)+ZUP*(AT(4,3)))                    + ZABLY(JL, 6, JC) * ZPSH3(JL) * ZDIFF
299        ZCBH4=BT(4,1)+ZUP*(BT(4,2)+ZUP*(BT(4,3)))               PABCU(JL, 5, JC) = PABCU(JL, 5, JCP1) &
300        ZPSH4(JL)=EXP( ZCAH4 * ZTX + ZCBH4 * ZTX2 )                    + ZABLY(JL, 6, JC) * ZPSH4(JL) * ZDIFF
301        ZCAH5=AT(5,1)+ZUP*(AT(5,2)+ZUP*(AT(5,3)))               PABCU(JL, 6, JC) = PABCU(JL, 6, JCP1) &
302        ZCBH5=BT(5,1)+ZUP*(BT(5,2)+ZUP*(BT(5,3)))                    + ZABLY(JL, 6, JC) * ZPSH6(JL) * ZDIFF
303        ZPSH5(JL)=EXP( ZCAH5 * ZTX + ZCBH5 * ZTX2 )  
304        ZCAH6=AT(6,1)+ZUP*(AT(6,2)+ZUP*(AT(6,3)))               PABCU(JL, 14, JC) = PABCU(JL, 14, JCP1) &
305        ZCBH6=BT(6,1)+ZUP*(BT(6,2)+ZUP*(BT(6,3)))                    + ZUAER(JL, 1) * ZDUC(JL, JC) * ZDIFF
306        ZPSH6(JL)=EXP( ZCAH6 * ZTX + ZCBH6 * ZTX2 )               PABCU(JL, 15, JC) = PABCU(JL, 15, JCP1) &
307        ZPHM6(JL)=EXP(-5.81E-4 * ZTX - 1.13E-6 * ZTX2 )                    + ZUAER(JL, 2) * ZDUC(JL, JC) * ZDIFF
308        ZPSM6(JL)=EXP(-5.57E-4 * ZTX - 3.30E-6 * ZTX2 )               PABCU(JL, 16, JC) = PABCU(JL, 16, JCP1) &
309        ZPHN6(JL)=EXP(-3.46E-5 * ZTX + 2.05E-7 * ZTX2 )                    + ZUAER(JL, 3) * ZDUC(JL, JC) * ZDIFF
310        ZPSN6(JL)=EXP( 3.70E-3 * ZTX - 2.30E-6 * ZTX2 )               PABCU(JL, 17, JC) = PABCU(JL, 17, JCP1) &
311   521  CONTINUE                    + ZUAER(JL, 4) * ZDUC(JL, JC) * ZDIFF
312  C               PABCU(JL, 18, JC) = PABCU(JL, 18, JCP1) &
313        DO 522 JL = 1, KDLON                    + ZUAER(JL, 5) * ZDUC(JL, JC) * ZDIFF
314        ZTAVI(JL)=PTAVE(JL,JKL)  
315        ZTX=ZTAVI(JL)-TREF               PABCU(JL, 19, JC) = PABCU(JL, 19, JCP1) &
316        ZTX2=ZTX*ZTX                    + ZABLY(JL, 8, JC) * RCH4 / RCO2 * ZPHM6(JL) * ZDIFF
317        ZZABLY = ZABLY(JL,9,JAE1)+ZABLY(JL,9,JAE2)+ZABLY(JL,9,JAE3)               PABCU(JL, 20, JC) = PABCU(JL, 20, JCP1) &
318        ZALUP = R10E * LOG ( ZZABLY )                    + ZABLY(JL, 9, JC) * RCH4 / RCO2 * ZPSM6(JL) * ZDIFF
319  CMAF      ZUP   = MAX( 0.0 , 5.0 + 0.5 * ZALUP )               PABCU(JL, 21, JC) = PABCU(JL, 21, JCP1) &
320        ZUP   = MAX( 0.d+0 , 5.0 + 0.5 * ZALUP )                    + ZABLY(JL, 8, JC) * RN2O / RCO2 * ZPHN6(JL) * ZDIFF
321        ZPSC2(JL) = (ZTAVI(JL)/TREF) ** ZUP               PABCU(JL, 22, JC) = PABCU(JL, 22, JCP1) &
322        ZCAC8=AT(8,1)+ZUP*(AT(8,2)+ZUP*(AT(8,3)))                    + ZABLY(JL, 9, JC) * RN2O / RCO2 * ZPSN6(JL) * ZDIFF
323        ZCBC8=BT(8,1)+ZUP*(BT(8,2)+ZUP*(BT(8,3)))  
324        ZPSC3(JL)=EXP( ZCAC8 * ZTX + ZCBC8 * ZTX2 )               PABCU(JL, 23, JC) = PABCU(JL, 23, JCP1) &
325        ZPHIO(JL) = EXP( OCT(1) * ZTX + OCT(2) * ZTX2)                    + ZABLY(JL, 8, JC) * RCFC11 / RCO2 * ZDIFF
326        ZPSIO(JL) = EXP( 2.* (OCT(3)*ZTX+OCT(4)*ZTX2))               PABCU(JL, 24, JC) = PABCU(JL, 24, JCP1) &
327   522  CONTINUE                    + ZABLY(JL, 8, JC) * RCFC12 / RCO2 * ZDIFF
328  C            end DO
329        DO 524 JKK=JJ,JJPN         end DO
330        JC=3*KFLEV+1-JKK      end DO
331        JCP1=JC+1  
332        DO 523 JL = 1, KDLON    END SUBROUTINE LWU
333        ZDIFF = PVIEW(JL)  
334        PABCU(JL,10,JC)=PABCU(JL,10,JCP1)  end module LWU_m
      S                +ZABLY(JL,10,JC)           *ZDIFF  
       PABCU(JL,11,JC)=PABCU(JL,11,JCP1)  
      S                +ZABLY(JL,11,JC)*ZTCON(JL)*ZDIFF  
 C  
       PABCU(JL,12,JC)=PABCU(JL,12,JCP1)  
      S                +ZABLY(JL,12,JC)*ZPHIO(JL)*ZDIFF  
       PABCU(JL,13,JC)=PABCU(JL,13,JCP1)  
      S                +ZABLY(JL,13,JC)*ZPSIO(JL)*ZDIFF  
 C  
       PABCU(JL,7,JC)=PABCU(JL,7,JCP1)  
      S               +ZABLY(JL,9,JC)*ZPSC2(JL)*ZDIFF  
       PABCU(JL,8,JC)=PABCU(JL,8,JCP1)  
      S               +ZABLY(JL,9,JC)*ZPSC3(JL)*ZDIFF  
       PABCU(JL,9,JC)=PABCU(JL,9,JCP1)  
      S               +ZABLY(JL,9,JC)*ZPSC3(JL)*ZDIFF  
 C  
       PABCU(JL,1,JC)=PABCU(JL,1,JCP1)  
      S               +ZABLY(JL,6,JC)*ZPSH1(JL)*ZDIFF  
       PABCU(JL,2,JC)=PABCU(JL,2,JCP1)  
      S               +ZABLY(JL,6,JC)*ZPSH2(JL)*ZDIFF  
       PABCU(JL,3,JC)=PABCU(JL,3,JCP1)  
      S               +ZABLY(JL,6,JC)*ZPSH5(JL)*ZDIFF  
       PABCU(JL,4,JC)=PABCU(JL,4,JCP1)  
      S               +ZABLY(JL,6,JC)*ZPSH3(JL)*ZDIFF  
       PABCU(JL,5,JC)=PABCU(JL,5,JCP1)  
      S               +ZABLY(JL,6,JC)*ZPSH4(JL)*ZDIFF  
       PABCU(JL,6,JC)=PABCU(JL,6,JCP1)  
      S               +ZABLY(JL,6,JC)*ZPSH6(JL)*ZDIFF  
 C  
       PABCU(JL,14,JC)=PABCU(JL,14,JCP1)  
      S                +ZUAER(JL,1)    *ZDUC(JL,JC)*ZDIFF  
       PABCU(JL,15,JC)=PABCU(JL,15,JCP1)  
      S                +ZUAER(JL,2)    *ZDUC(JL,JC)*ZDIFF  
       PABCU(JL,16,JC)=PABCU(JL,16,JCP1)  
      S                +ZUAER(JL,3)    *ZDUC(JL,JC)*ZDIFF  
       PABCU(JL,17,JC)=PABCU(JL,17,JCP1)  
      S                +ZUAER(JL,4)    *ZDUC(JL,JC)*ZDIFF  
       PABCU(JL,18,JC)=PABCU(JL,18,JCP1)  
      S                +ZUAER(JL,5)    *ZDUC(JL,JC)*ZDIFF  
 C  
       PABCU(JL,19,JC)=PABCU(JL,19,JCP1)  
      S               +ZABLY(JL,8,JC)*RCH4/RCO2*ZPHM6(JL)*ZDIFF  
       PABCU(JL,20,JC)=PABCU(JL,20,JCP1)  
      S               +ZABLY(JL,9,JC)*RCH4/RCO2*ZPSM6(JL)*ZDIFF  
       PABCU(JL,21,JC)=PABCU(JL,21,JCP1)  
      S               +ZABLY(JL,8,JC)*RN2O/RCO2*ZPHN6(JL)*ZDIFF  
       PABCU(JL,22,JC)=PABCU(JL,22,JCP1)  
      S               +ZABLY(JL,9,JC)*RN2O/RCO2*ZPSN6(JL)*ZDIFF  
 C  
       PABCU(JL,23,JC)=PABCU(JL,23,JCP1)  
      S               +ZABLY(JL,8,JC)*RCFC11/RCO2         *ZDIFF  
       PABCU(JL,24,JC)=PABCU(JL,24,JCP1)  
      S               +ZABLY(JL,8,JC)*RCFC12/RCO2         *ZDIFF  
  523  CONTINUE  
  524  CONTINUE  
 C  
  529  CONTINUE  
 C  
 C  
       RETURN  
       END  
Legend:
Removed from v.24  
changed lines
  Added in v.71
  ViewVC Help
Powered by ViewVC 1.1.21