source: LMDZ5/branches/testing/libf/phylmd/rrtm/rrtm_ecrt_140gp.F90 @ 2056

Last change on this file since 2056 was 2056, checked in by Laurent Fairhead, 10 years ago

Merged trunk changes r1997:2055 into testing branch
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:keywords set to Author Date Id Revi
File size: 12.9 KB
Line 
1!
2! $Id: rrtm_ecrt_140gp.F90 2056 2014-06-11 13:46:46Z fairhead $
3!
4!****************** SUBROUTINE RRTM_ECRT_140GP **************************
5
6SUBROUTINE RRTM_ECRT_140GP &
7 & ( K_IPLON, klon , klev, kcld,&
8 & paer , paph , pap,&
9 & pts  , pth  , pt,&
10 & P_ZEMIS, P_ZEMIW,&
11 & pq   , pcco2, pozn, pcldf, ptaucld, ptclear,&
12 & P_CLDFRAC,P_TAUCLD,P_COLDRY,P_WKL,P_WX,&
13 & P_TAUAERL,PAVEL,P_TAVEL,PZ,P_TZ,P_TBOUND,K_NLAYERS,P_SEMISS,K_IREFLECT) 
14
15!     Reformatted for F90 by JJMorcrette, ECMWF, 980714
16
17!     Read in atmospheric profile from ECMWF radiation code, and prepare it
18!     for use in RRTM.  Set other RRTM input parameters.  Values are passed
19!     back through existing RRTM arrays and commons.
20
21!- Modifications
22
23!     2000-05-15 Deborah Salmond  Speed-up
24
25USE PARKIND1  ,ONLY : JPIM     ,JPRB
26USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
27
28USE PARRRTM  , ONLY : JPBAND   ,JPXSEC   ,JPLAY   ,&
29 & JPINPX 
30USE YOERAD   , ONLY : NOVLP
31!USE YOERDI   , ONLY :    RCH4     ,RN2O    ,RCFC11  ,RCFC12
32USE YOESW    , ONLY : RAER
33
34!------------------------------Arguments--------------------------------
35
36
37
38IMPLICIT NONE
39
40#include "clesphys.h"
41INTEGER(KIND=JPIM),INTENT(IN)    :: KLON! Number of atmospheres (longitudes)
42INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV! Number of atmospheric layers
43INTEGER(KIND=JPIM),INTENT(IN)    :: K_IPLON
44INTEGER(KIND=JPIM),INTENT(OUT)   :: KCLD
45REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV) ! Aerosol optical thickness
46REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH(KLON,KLEV+1) ! Interface pressures (Pa)
47REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV) ! Layer pressures (Pa)
48REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON) ! Surface temperature (K)
49REAL(KIND=JPRB)   ,INTENT(IN)    :: PTH(KLON,KLEV+1) ! Interface temperatures (K)
50REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV) ! Layer temperature (K)
51REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ZEMIS(KLON) ! Non-window surface emissivity
52REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ZEMIW(KLON) ! Window surface emissivity
53REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV) ! H2O specific humidity (mmr)
54REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO2 ! CO2 mass mixing ratio
55REAL(KIND=JPRB)   ,INTENT(IN)    :: POZN(KLON,KLEV) ! O3 mass mixing ratio
56REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLDF(KLON,KLEV) ! Cloud fraction
57REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUCLD(KLON,KLEV,JPBAND) ! Cloud optical depth
58REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTCLEAR
59REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_CLDFRAC(JPLAY) ! Cloud fraction
60REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUCLD(JPLAY,JPBAND) ! Spectral optical thickness
61REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_COLDRY(JPLAY)
62REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_WKL(JPINPX,JPLAY)
63REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_WX(JPXSEC,JPLAY) ! Amount of trace gases
64REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUAERL(JPLAY,JPBAND)
65REAL(KIND=JPRB)   ,INTENT(OUT)   :: PAVEL(JPLAY)
66REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAVEL(JPLAY)
67REAL(KIND=JPRB)   ,INTENT(OUT)   :: PZ(0:JPLAY)
68REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TZ(0:JPLAY)
69REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TBOUND
70INTEGER(KIND=JPIM),INTENT(OUT)   :: K_NLAYERS
71REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SEMISS(JPBAND)
72INTEGER(KIND=JPIM),INTENT(OUT)   :: K_IREFLECT
73!      real rch4                       ! CH4 mass mixing ratio
74!      real rn2o                       ! N2O mass mixing ratio
75!      real rcfc11                     ! CFC11 mass mixing ratio
76!      real rcfc12                     ! CFC12 mass mixing ratio
77!- from AER
78!- from PROFILE             
79!- from SURFACE             
80REAL(KIND=JPRB) :: ztauaer(5)
81REAL(KIND=JPRB) :: zc1j(0:klev)               ! total cloud from top and level k
82REAL(KIND=JPRB) :: Z_AMD                  ! Effective molecular weight of dry air (g/mol)
83REAL(KIND=JPRB) :: Z_AMW                  ! Molecular weight of water vapor (g/mol)
84REAL(KIND=JPRB) :: Z_AMCO2                ! Molecular weight of carbon dioxide (g/mol)
85REAL(KIND=JPRB) :: Z_AMO                  ! Molecular weight of ozone (g/mol)
86REAL(KIND=JPRB) :: Z_AMCH4                ! Molecular weight of methane (g/mol)
87REAL(KIND=JPRB) :: Z_AMN2O                ! Molecular weight of nitrous oxide (g/mol)
88REAL(KIND=JPRB) :: Z_AMC11                ! Molecular weight of CFC11 (g/mol) - CFCL3
89REAL(KIND=JPRB) :: Z_AMC12                ! Molecular weight of CFC12 (g/mol) - CF2CL2
90REAL(KIND=JPRB) :: Z_AVGDRO               ! Avogadro's number (molecules/mole)
91REAL(KIND=JPRB) :: Z_GRAVIT               ! Gravitational acceleration (cm/sec2)
92
93! Atomic weights for conversion from mass to volume mixing ratios; these
94!  are the same values used in ECRT to assure accurate conversion to vmr
95data Z_AMD   /  28.970_JPRB    /
96data Z_AMW   /  18.0154_JPRB   /
97data Z_AMCO2 /  44.011_JPRB    /
98data Z_AMO   /  47.9982_JPRB   /
99data Z_AMCH4 /  16.043_JPRB    /
100data Z_AMN2O /  44.013_JPRB    /
101data Z_AMC11 / 137.3686_JPRB   /
102data Z_AMC12 / 120.9140_JPRB   /
103data Z_AVGDRO/ 6.02214E23_JPRB /
104data Z_GRAVIT/ 9.80665E02_JPRB /
105
106INTEGER(KIND=JPIM) :: IATM, IMOL, IXMAX, J1, J2, JAE, JB, JK, JL, I_L
107INTEGER(KIND=JPIM) :: I_NMOL, I_NXMOL
108
109REAL(KIND=JPRB) :: Z_AMM, ZCLDLY, ZCLEAR, ZCLOUD, ZEPSEC
110REAL(KIND=JPRB) :: ZHOOK_HANDLE
111
112! ***
113
114! *** mji
115! Initialize all molecular amounts and aerosol optical depths to zero here,
116! then pass ECRT amounts into RRTM arrays below.
117
118!      DATA ZWKL /MAXPRDW*0.0/
119!      DATA ZWX  /MAXPROD*0.0/
120!      DATA KREFLECT /0/
121
122! Activate cross section molecules:
123!     NXMOL     - number of cross-sections input by user
124!     IXINDX(I) - index of cross-section molecule corresponding to Ith
125!                 cross-section specified by user
126!                 = 0 -- not allowed in RRTM
127!                 = 1 -- CCL4
128!                 = 2 -- CFC11
129!                 = 3 -- CFC12
130!                 = 4 -- CFC22
131!      DATA KXMOL  /2/
132!      DATA KXINDX /0,2,3,0,31*0/
133
134!      IREFLECT=KREFLECT
135!      NXMOL=KXMOL
136
137IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP',0,ZHOOK_HANDLE)
138K_IREFLECT=0
139I_NXMOL=2
140
141DO J1=1,35
142! IXINDX(J1)=0
143  DO J2=1,KLEV
144    P_WKL(J1,J2)=0.0_JPRB
145  ENDDO
146ENDDO
147!IXINDX(2)=2
148!IXINDX(3)=3
149
150!     Set parameters needed for RRTM execution:
151IATM    = 0
152!      IXSECT  = 1
153!      NUMANGS = 0
154!      IOUT    = -1
155IXMAX   = 4
156
157!     Bands 6,7,8 are considered the 'window' and allowed to have a
158!     different surface emissivity (as in ECMWF).  Eli wrote this part....
159P_SEMISS(1)  = P_ZEMIS(K_IPLON)
160P_SEMISS(2)  = P_ZEMIS(K_IPLON)
161P_SEMISS(3)  = P_ZEMIS(K_IPLON)
162P_SEMISS(4)  = P_ZEMIS(K_IPLON)
163P_SEMISS(5)  = P_ZEMIS(K_IPLON)
164P_SEMISS(6)  = P_ZEMIW(K_IPLON)
165P_SEMISS(7)  = P_ZEMIW(K_IPLON)
166P_SEMISS(8)  = P_ZEMIW(K_IPLON)
167P_SEMISS(9)  = P_ZEMIS(K_IPLON)
168P_SEMISS(10) = P_ZEMIS(K_IPLON)
169P_SEMISS(11) = P_ZEMIS(K_IPLON)
170P_SEMISS(12) = P_ZEMIS(K_IPLON)
171P_SEMISS(13) = P_ZEMIS(K_IPLON)
172P_SEMISS(14) = P_ZEMIS(K_IPLON)
173P_SEMISS(15) = P_ZEMIS(K_IPLON)
174P_SEMISS(16) = P_ZEMIS(K_IPLON)
175
176!     Set surface temperature. 
177
178P_TBOUND = pts(K_IPLON)
179
180!     Install ECRT arrays into RRTM arrays for pressure, temperature,
181!     and molecular amounts.  Pressures are converted from Pascals
182!     (ECRT) to mb (RRTM).  H2O, CO2, O3 and trace gas amounts are
183!     converted from mass mixing ratio to volume mixing ratio.  CO2
184!     converted with same dry air and CO2 molecular weights used in
185!     ECRT to assure correct conversion back to the proper CO2 vmr.
186!     The dry air column COLDRY (in molec/cm2) is calculated from
187!     the level pressures PZ (in mb) based on the hydrostatic equation
188!     and includes a correction to account for H2O in the layer.  The
189!     molecular weight of moist air (amm) is calculated for each layer.
190!     Note: RRTM levels count from bottom to top, while the ECRT input
191!     variables count from the top down and must be reversed here.
192
193K_NLAYERS = klev
194I_NMOL = 6
195PZ(0) = paph(K_IPLON,klev+1)/100._JPRB
196P_TZ(0) = pth(K_IPLON,klev+1)
197DO I_L = 1, KLEV
198  PAVEL(I_L) = pap(K_IPLON,KLEV-I_L+1)/100._JPRB
199  P_TAVEL(I_L) = pt(K_IPLON,KLEV-I_L+1)
200  PZ(I_L) = paph(K_IPLON,KLEV-I_L+1)/100._JPRB
201  P_TZ(I_L) = pth(K_IPLON,KLEV-I_L+1)
202  P_WKL(1,I_L) = pq(K_IPLON,KLEV-I_L+1)*Z_AMD/Z_AMW
203  P_WKL(2,I_L) = pcco2*Z_AMD/Z_AMCO2
204  P_WKL(3,I_L) = pozn(K_IPLON,KLEV-I_L+1)*Z_AMD/Z_AMO
205  P_WKL(4,I_L) = rn2o*Z_AMD/Z_AMN2O
206  P_WKL(6,I_L) = rch4*Z_AMD/Z_AMCH4
207  Z_AMM = (1-P_WKL(1,I_L))*Z_AMD + P_WKL(1,I_L)*Z_AMW
208  P_COLDRY(I_L) = (PZ(I_L-1)-PZ(I_L))*1.E3_JPRB*Z_AVGDRO/(Z_GRAVIT*Z_AMM*(1+P_WKL(1,I_L)))
209ENDDO
210
211!- Fill RRTM aerosol arrays with operational ECMWF aerosols,
212!  do the mixing and distribute over the 16 spectral intervals
213
214DO I_L=1,KLEV
215  JK=KLEV-I_L+1
216!       DO JAE=1,5
217  JAE=1
218  ZTAUAER(JAE) =&
219   & RAER(JAE,1)*PAER(K_IPLON,1,JK)+RAER(JAE,2)*PAER(K_IPLON,2,JK)&
220   & +RAER(JAE,3)*PAER(K_IPLON,3,JK)+RAER(JAE,4)*PAER(K_IPLON,4,JK)&
221   & +RAER(JAE,5)*PAER(K_IPLON,5,JK)+RAER(JAE,6)*PAER(K_IPLON,6,JK) 
222  P_TAUAERL(I_L, 1)=ZTAUAER(1)
223  P_TAUAERL(I_L, 2)=ZTAUAER(1)
224  JAE=2
225  ZTAUAER(JAE) =&
226   & RAER(JAE,1)*PAER(K_IPLON,1,JK)+RAER(JAE,2)*PAER(K_IPLON,2,JK)&
227   & +RAER(JAE,3)*PAER(K_IPLON,3,JK)+RAER(JAE,4)*PAER(K_IPLON,4,JK)&
228   & +RAER(JAE,5)*PAER(K_IPLON,5,JK)+RAER(JAE,6)*PAER(K_IPLON,6,JK) 
229  P_TAUAERL(I_L, 3)=ZTAUAER(2)
230  P_TAUAERL(I_L, 4)=ZTAUAER(2)
231  P_TAUAERL(I_L, 5)=ZTAUAER(2)
232  JAE=3
233  ZTAUAER(JAE) =&
234   & RAER(JAE,1)*PAER(K_IPLON,1,JK)+RAER(JAE,2)*PAER(K_IPLON,2,JK)&
235   & +RAER(JAE,3)*PAER(K_IPLON,3,JK)+RAER(JAE,4)*PAER(K_IPLON,4,JK)&
236   & +RAER(JAE,5)*PAER(K_IPLON,5,JK)+RAER(JAE,6)*PAER(K_IPLON,6,JK) 
237  P_TAUAERL(I_L, 6)=ZTAUAER(3)
238  P_TAUAERL(I_L, 8)=ZTAUAER(3)
239  P_TAUAERL(I_L, 9)=ZTAUAER(3)
240  JAE=4
241  ZTAUAER(JAE) =&
242   & RAER(JAE,1)*PAER(K_IPLON,1,JK)+RAER(JAE,2)*PAER(K_IPLON,2,JK)&
243   & +RAER(JAE,3)*PAER(K_IPLON,3,JK)+RAER(JAE,4)*PAER(K_IPLON,4,JK)&
244   & +RAER(JAE,5)*PAER(K_IPLON,5,JK)+RAER(JAE,6)*PAER(K_IPLON,6,JK) 
245  P_TAUAERL(I_L, 7)=ZTAUAER(4)
246  JAE=5
247  ZTAUAER(JAE) =&
248   & RAER(JAE,1)*PAER(K_IPLON,1,JK)+RAER(JAE,2)*PAER(K_IPLON,2,JK)&
249   & +RAER(JAE,3)*PAER(K_IPLON,3,JK)+RAER(JAE,4)*PAER(K_IPLON,4,JK)&
250   & +RAER(JAE,5)*PAER(K_IPLON,5,JK)+RAER(JAE,6)*PAER(K_IPLON,6,JK) 
251!       END DO
252  P_TAUAERL(I_L,10)=ZTAUAER(5)
253  P_TAUAERL(I_L,11)=ZTAUAER(5)
254  P_TAUAERL(I_L,12)=ZTAUAER(5)
255  P_TAUAERL(I_L,13)=ZTAUAER(5)
256  P_TAUAERL(I_L,14)=ZTAUAER(5)
257  P_TAUAERL(I_L,15)=ZTAUAER(5)
258  P_TAUAERL(I_L,16)=ZTAUAER(5)
259ENDDO
260
261DO J2=1,KLEV
262  DO J1=1,JPXSEC
263    P_WX(J1,J2)=0.0_JPRB
264  ENDDO
265ENDDO
266
267DO I_L = 1, KLEV
268!- Set cross section molecule amounts from ECRT; convert to vmr
269  P_WX(2,I_L) = rcfc11*Z_AMD/Z_AMC11
270  P_WX(3,I_L) = rcfc12*Z_AMD/Z_AMC12
271  P_WX(2,I_L) = P_COLDRY(I_L) * P_WX(2,I_L) * 1.E-20_JPRB
272  P_WX(3,I_L) = P_COLDRY(I_L) * P_WX(3,I_L) * 1.E-20_JPRB
273
274!- Here, all molecules in WKL and WX are in volume mixing ratio; convert to
275!  molec/cm2 based on COLDRY for use in RRTM
276
277  DO IMOL = 1, I_NMOL
278    P_WKL(IMOL,I_L) = P_COLDRY(I_L) * P_WKL(IMOL,I_L)
279  ENDDO 
280 
281! DO IX = 1,JPXSEC
282! IF (IXINDX(IX)  /=  0) THEN
283!     WX(IXINDX(IX),L) = COLDRY(L) * WX(IX,L) * 1.E-20_JPRB
284! ENDIF
285! END DO 
286
287ENDDO
288
289!- Approximate treatment for various cloud overlaps
290ZCLEAR=1.0_JPRB
291ZCLOUD=0.0_JPRB
292ZC1J(0)=0.0_JPRB
293ZEPSEC=1.E-03_JPRB
294JL=K_IPLON
295
296!++MODIFCODE
297IF ((NOVLP == 1).OR.(NOVLP ==6).OR.(NOVLP ==8)) THEN
298!--MODIFCODE
299
300  DO JK=1,KLEV
301    IF (pcldf(JL,JK) > ZEPSEC) THEN
302      ZCLDLY=pcldf(JL,JK)
303      ZCLEAR=ZCLEAR &
304       & *(1.0_JPRB-MAX( ZCLDLY , ZCLOUD ))&
305       & /(1.0_JPRB-MIN( ZCLOUD , 1.0_JPRB-ZEPSEC )) 
306      ZCLOUD = ZCLDLY
307      ZC1J(JK)= 1.0_JPRB - ZCLEAR
308    ELSE
309      ZCLDLY=0.0_JPRB
310      ZCLEAR=ZCLEAR &
311       & *(1.0_JPRB-MAX( ZCLDLY , ZCLOUD ))&
312       & /(1.0_JPRB-MIN( ZCLOUD , 1.0_JPRB-ZEPSEC )) 
313      ZCLOUD = ZCLDLY
314      ZC1J(JK)= 1.0_JPRB - ZCLEAR
315    ENDIF
316  ENDDO
317
318!++MODIFCODE
319ELSEIF ((NOVLP == 2).OR.(NOVLP ==7)) THEN
320!--MODIFCODE
321
322  DO JK=1,KLEV
323    IF (pcldf(JL,JK) > ZEPSEC) THEN
324      ZCLDLY=pcldf(JL,JK)
325      ZCLOUD = MAX( ZCLDLY , ZCLOUD )
326      ZC1J(JK) = ZCLOUD
327    ELSE
328      ZCLDLY=0.0_JPRB
329      ZCLOUD = MAX( ZCLDLY , ZCLOUD )
330      ZC1J(JK) = ZCLOUD
331    ENDIF
332  ENDDO
333
334!++MODIFCODE
335ELSEIF ((NOVLP == 3).OR.(NOVLP ==5)) THEN
336!--MODIFCODE
337
338  DO JK=1,KLEV
339    IF (pcldf(JL,JK) > ZEPSEC) THEN
340      ZCLDLY=pcldf(JL,JK)
341      ZCLEAR = ZCLEAR * (1.0_JPRB-ZCLDLY)
342      ZCLOUD = 1.0_JPRB - ZCLEAR
343      ZC1J(JK) = ZCLOUD
344    ELSE
345      ZCLDLY=0.0_JPRB
346      ZCLEAR = ZCLEAR * (1.0_JPRB-ZCLDLY)
347      ZCLOUD = 1.0_JPRB - ZCLEAR
348      ZC1J(JK) = ZCLOUD
349    ENDIF
350  ENDDO
351
352ELSEIF (NOVLP == 4) THEN
353
354ENDIF
355PTCLEAR=1.0_JPRB-ZC1J(KLEV)
356
357! Transfer cloud fraction and cloud optical depth to RRTM arrays;
358! invert array index for pcldf to go from bottom to top for RRTM
359
360!- clear-sky column
361IF (PTCLEAR  >  1.0_JPRB-ZEPSEC) THEN
362  KCLD=0
363  DO I_L = 1, KLEV
364    P_CLDFRAC(I_L) = 0.0_JPRB
365  ENDDO
366  DO JB=1,JPBAND
367    DO I_L=1,KLEV
368      P_TAUCLD(I_L,JB) = 0.0_JPRB
369    ENDDO
370  ENDDO
371
372ELSE
373
374!- cloudy column
375!   The diffusivity factor (Savijarvi, 1997) on the cloud optical
376!   thickness TAUCLD has already been applied in RADLSW
377
378  KCLD=1
379  DO I_L=1,KLEV
380    P_CLDFRAC(I_L) = pcldf(K_IPLON,I_L)
381  ENDDO
382  DO JB=1,JPBAND
383    DO I_L=1,KLEV
384      P_TAUCLD(I_L,JB) = ptaucld(K_IPLON,I_L,JB)
385    ENDDO
386  ENDDO
387
388ENDIF
389
390!     ------------------------------------------------------------------
391
392
393
394IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP',1,ZHOOK_HANDLE)
395END SUBROUTINE RRTM_ECRT_140GP
Note: See TracBrowser for help on using the repository browser.