/[lmdze]/trunk/Sources/phylmd/Radlwsw/lwu.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/Radlwsw/lwu.f

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

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