LMDZ
lwvb.F90
Go to the documentation of this file.
1 SUBROUTINE lwvb &
2  & ( kidia , kfdia , klon , klev , kuaer,&
3  & pabcu , padjd , padju,&
4  & pb , pbint , pbsur , pbtop,&
5  & pdisd , pdisu , pemis , pemiw,&
6  & pgasur, pgbsur, pgatop, pgbtop,&
7  & pdwfsu,pfluc &
8  & )
9 
10 !**** *LWVB* - L.W., VERTICAL INTEGRATION, EXCHANGE WITH BOUNDARIES
11 
12 ! PURPOSE.
13 ! --------
14 ! INTRODUCES THE EFFECTS OF THE BOUNDARIES IN THE VERTICAL
15 ! INTEGRATION
16 
17 !** INTERFACE.
18 ! ----------
19 
20 ! EXPLICIT ARGUMENTS :
21 ! --------------------
22 ! ==== INPUTS ===
23 ! PABCU : (KLON,NUA,3*KLEV+1); ABSORBER AMOUNTS
24 ! PADJ.. : (KLON,KLEV+1) ; CONTRIBUTION BY ADJACENT LAYERS
25 ! PB : (KLON,NSIL,KLEV+1); SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
26 ! PBINT : (KLON,KLEV+1) ; HALF-LEVEL PLANCK FUNCTIONS
27 ! PBSUR : (KLON,NSIL) ; SPECTRAL SURFACE PLANCK FUNCTION
28 ! PBTOP : (KLON,NSIL) ; SPECTRAL T.O.A. PLANCK FUNCTION
29 ! PDIS.. : (KLON,KLEV+1) ; CONTRIBUTION BY DISTANT LAYERS
30 ! PEMIS : (KLON) ; SURFACE LW EMISSIVITY
31 ! PEMIW : (KLON) ; SURFACE LW WINDOW EMISSIVITY
32 ! PGASUR, PGBSUR ; SURFACE PADE APPROXIMANTS
33 ! PGATOP, PGBTOP ; T.O.A. PADE APPROXIMANTS
34 ! ==== OUTPUTS ===
35 ! PDWFSU : (KLON,NSIL) ; SPECTRAL DOWNWARD FLUX AT SURFACE
36 ! PFLUC(KLON,2,KLEV) ; RADIATIVE FLUXES CLEAR-SKY:
37 ! 1 ==> UPWARD FLUX TOTAL
38 
39 ! IMPLICIT ARGUMENTS : NONE
40 ! --------------------
41 
42 ! METHOD.
43 ! -------
44 
45 ! COMPUTES THE ENERGY EXCHANGE WITH TOP AND SURFACE OF THE
46 ! ATMOSPHERE AND ADDS UP ALL CONTRIBUTIONS TO GET THE CLEAR-SKY
47 ! FLUXES
48 
49 ! EXTERNALS.
50 ! ----------
51 
52 ! *LWTT*
53 
54 ! REFERENCE.
55 ! ----------
56 
57 ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
58 ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
59 
60 ! AUTHOR.
61 ! -------
62 ! JEAN-JACQUES MORCRETTE *ECMWF*
63 ! MODIFICATIONS.
64 ! --------------
65 ! ORIGINAL : 89-07-14
66 ! JJ Morcrette 96-06-07 Surface LW Window Emissivity
67 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
68 
69 !-----------------------------------------------------------------------
70 
71 USE parkind1 ,ONLY : jpim ,jprb
72 USE yomhook ,ONLY : lhook, dr_hook
73 
74 USE yoelw , ONLY : nsil ,nipd ,ntra ,nua ,ng1p1
75 
76 IMPLICIT NONE
77 
78 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
79 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
80 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
81 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
82 INTEGER(KIND=JPIM),INTENT(IN) :: KUAER
83 REAL(KIND=JPRB) ,INTENT(IN) :: PABCU(klon,nua,3*klev+1)
84 REAL(KIND=JPRB) ,INTENT(IN) :: PADJD(klon,klev+1)
85 REAL(KIND=JPRB) ,INTENT(IN) :: PADJU(klon,klev+1)
86 REAL(KIND=JPRB) ,INTENT(IN) :: PB(klon,nsil,klev+1)
87 REAL(KIND=JPRB) ,INTENT(IN) :: PBINT(klon,klev+1)
88 REAL(KIND=JPRB) ,INTENT(IN) :: PBSUR(klon,nsil)
89 REAL(KIND=JPRB) ,INTENT(IN) :: PBTOP(klon,nsil)
90 REAL(KIND=JPRB) ,INTENT(IN) :: PDISD(klon,klev+1)
91 REAL(KIND=JPRB) ,INTENT(IN) :: PDISU(klon,klev+1)
92 REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(klon)
93 REAL(KIND=JPRB) ,INTENT(IN) :: PEMIW(klon)
94 REAL(KIND=JPRB) ,INTENT(IN) :: PGASUR(klon,nipd,2)
95 REAL(KIND=JPRB) ,INTENT(IN) :: PGBSUR(klon,nipd,2)
96 REAL(KIND=JPRB) ,INTENT(IN) :: PGATOP(klon,nipd,2)
97 REAL(KIND=JPRB) ,INTENT(IN) :: PGBTOP(klon,nipd,2)
98 REAL(KIND=JPRB) ,INTENT(INOUT) :: PDWFSU(klon,nsil)
99 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUC(klon,2,klev+1)
100 !-----------------------------------------------------------------------
101 
102 !* 0.1 ARGUMENTS
103 ! ---------
104 
105 !-----------------------------------------------------------------------
106 
107 ! ------------
108 
109 REAL(KIND=JPRB) :: ZBSUR(klon,nsil)&
110  & , ZTT(KLON,NTRA), ZTT1(KLON,NTRA), ZTT2(KLON,NTRA)&
111  & , ZUU(KLON,NUA) , ZCNSOL(KLON) , ZCNTOP(KLON)
112 
113 INTEGER(KIND=JPIM) :: IN, JA, JK, JL
114 
115 REAL(KIND=JPRB) :: ZCNTOP1, ZCNTOP2, ZCNTOP3, ZCNTOP4, ZCNTOP5, ZCNTOP6
116 REAL(KIND=JPRB) :: ZHOOK_HANDLE
117 
118 #include "lwtt.intfb.h"
119 
120 !-----------------------------------------------------------------------
121 
122 !* 1. INITIALIZATION
123 ! --------------
124 
125 !* 1.2 INITIALIZE TRANSMISSION FUNCTIONS
126 ! ---------------------------------
127 
128 IF (lhook) CALL dr_hook('LWVB',0,zhook_handle)
129 DO ja=1,ntra
130  DO jl=kidia,kfdia
131  ztt(jl,ja)=1.0_jprb
132  ztt1(jl,ja)=1.0_jprb
133  ztt2(jl,ja)=1.0_jprb
134  ENDDO
135 ENDDO
136 
137 DO ja=1,nua
138  DO jl=kidia,kfdia
139  zuu(jl,ja)=1.0_jprb
140  ENDDO
141 ENDDO
142 
143 ! ------------------------------------------------------------------
144 
145 !* 2. VERTICAL INTEGRATION
146 ! --------------------
147 
148 !* 2.3 EXCHANGE WITH TOP OF THE ATMOSPHERE
149 ! -----------------------------------
150 
151 DO jk = 1 , klev
152  in=(jk-1)*ng1p1+1
153 
154  DO ja=1,kuaer
155  DO jl=kidia,kfdia
156  zuu(jl,ja)=pabcu(jl,ja,in)
157  ENDDO
158  ENDDO
159 
160  CALL lwtt &
161  & ( kidia , kfdia , klon,&
162  & pgatop(1,1,1), pgbtop(1,1,1),&
163  & zuu , ztt &
164  & )
165 
166  DO jl = kidia,kfdia
167  zcntop1=pbtop(jl,1)*ztt(jl,1) *ztt(jl,10)
168  zcntop2=pbtop(jl,2)*ztt(jl,2)*ztt(jl,7)*ztt(jl,11)
169  zcntop3=pbtop(jl,3)*ztt(jl,4)*ztt(jl,8)*ztt(jl,12)
170  zcntop4=pbtop(jl,4)*ztt(jl,5)*ztt(jl,9)*ztt(jl,13)
171  zcntop5=pbtop(jl,5)*ztt(jl,3) *ztt(jl,14)
172  zcntop6=pbtop(jl,6)*ztt(jl,6) *ztt(jl,15)
173  zcntop(jl)=zcntop1+zcntop2+zcntop3+zcntop4+zcntop5+zcntop6
174  pfluc(jl,2,jk)=zcntop(jl)-pbint(jl,jk)-pdisd(jl,jk)-padjd(jl,jk)
175  IF (jk == 1) THEN
176  pdwfsu(jl,1)=zcntop1-pb(jl,1,jk)-pdwfsu(jl,1)
177  pdwfsu(jl,2)=zcntop2-pb(jl,2,jk)-pdwfsu(jl,2)
178  pdwfsu(jl,3)=zcntop3-pb(jl,3,jk)-pdwfsu(jl,3)
179  pdwfsu(jl,4)=zcntop4-pb(jl,4,jk)-pdwfsu(jl,4)
180  pdwfsu(jl,5)=zcntop5-pb(jl,5,jk)-pdwfsu(jl,5)
181  pdwfsu(jl,6)=zcntop6-pb(jl,6,jk)-pdwfsu(jl,6)
182  ENDIF
183  ENDDO
184 
185 ENDDO
186 
187 jk = klev+1
188 in=(jk-1)*ng1p1+1
189 
190 DO jl = kidia,kfdia
191  zcntop(jl)= pbtop(jl,1)&
192  & + pbtop(jl,2)&
193  & + pbtop(jl,3)&
194  & + pbtop(jl,4)&
195  & + pbtop(jl,5)&
196  & + pbtop(jl,6)
197  pfluc(jl,2,jk)=zcntop(jl)-pbint(jl,jk)-pdisd(jl,jk)-padjd(jl,jk)
198 ENDDO
199 
200 !* 2.5 EXCHANGE WITH LOWER LIMIT
201 ! -------------------------
202 
203 jk = 1
204 in=(jk-1)*ng1p1+1
205 
206 DO jl = kidia,kfdia
207  zbsur(jl,1)=pbsur(jl,1)*pemis(jl) -(1.0_jprb-pemis(jl))*pdwfsu(jl,1)
208  zbsur(jl,2)=pbsur(jl,2)*pemis(jl) -(1.0_jprb-pemis(jl))*pdwfsu(jl,2)
209  zbsur(jl,3)=pbsur(jl,3)*pemiw(jl) -(1.0_jprb-pemiw(jl))*pdwfsu(jl,3)
210  zbsur(jl,4)=pbsur(jl,4)*pemiw(jl) -(1.0_jprb-pemiw(jl))*pdwfsu(jl,4)
211  zbsur(jl,5)=pbsur(jl,5)*pemis(jl) -(1.0_jprb-pemis(jl))*pdwfsu(jl,5)
212  zbsur(jl,6)=pbsur(jl,6)*pemis(jl) -(1.0_jprb-pemis(jl))*pdwfsu(jl,6)
213 
214  pfluc(jl,1,jk) = zbsur(jl,1)&
215  & + zbsur(jl,2)&
216  & + zbsur(jl,3)&
217  & + zbsur(jl,4)&
218  & + zbsur(jl,5)&
219  & + zbsur(jl,6)
220 
221  zbsur(jl,1)=zbsur(jl,1)-pb(jl,1,1)
222  zbsur(jl,2)=zbsur(jl,2)-pb(jl,2,1)
223  zbsur(jl,3)=zbsur(jl,3)-pb(jl,3,1)
224  zbsur(jl,4)=zbsur(jl,4)-pb(jl,4,1)
225  zbsur(jl,5)=zbsur(jl,5)-pb(jl,5,1)
226  zbsur(jl,6)=zbsur(jl,6)-pb(jl,6,1)
227 ENDDO
228 
229 DO jk = 2 , klev+1
230  in=(jk-1)*ng1p1+1
231 
232  DO ja=1,kuaer
233  DO jl=kidia,kfdia
234  zuu(jl,ja)=pabcu(jl,ja,1)-pabcu(jl,ja,in)
235  ENDDO
236  ENDDO
237 
238  CALL lwtt &
239  & ( kidia , kfdia , klon,&
240  & pgasur(1,1,1), pgbsur(1,1,1),&
241  & zuu, ztt &
242  & )
243 
244  DO jl = kidia,kfdia
245  zcnsol(jl)=zbsur(jl,1)*ztt(jl,1) *ztt(jl,10)&
246  & +zbsur(jl,2)*ztt(jl,2)*ztt(jl,7)*ztt(jl,11)&
247  & +zbsur(jl,3)*ztt(jl,4)*ztt(jl,8)*ztt(jl,12)&
248  & +zbsur(jl,4)*ztt(jl,5)*ztt(jl,9)*ztt(jl,13)&
249  & +zbsur(jl,5)*ztt(jl,3) *ztt(jl,14)&
250  & +zbsur(jl,6)*ztt(jl,6) *ztt(jl,15)
251  pfluc(jl,1,jk)=zcnsol(jl)+pbint(jl,jk)-pdisu(jl,jk)-padju(jl,jk)
252  ENDDO
253 
254 ENDDO
255 
256 ! ------------------------------------------------------------------
257 
258 IF (lhook) CALL dr_hook('LWVB',1,zhook_handle)
259 END SUBROUTINE lwvb
yoelw::nipd
integer(kind=jpim) nipd
Definition: yoelw.F90:15
yoelw
Definition: yoelw.F90:1
yoelw::nsil
integer(kind=jpim) nsil
Definition: yoelw.F90:14
dimphy::kidia
integer, save kidia
Definition: dimphy.F90:6
dimphy::klon
integer, save klon
Definition: dimphy.F90:3
yoelw::nua
integer(kind=jpim) nua
Definition: yoelw.F90:19
dimphy::klev
integer, save klev
Definition: dimphy.F90:7
lwvb
subroutine lwvb(KIDIA, KFDIA, KLON, KLEV, KUAER, PABCU, PADJD, PADJU, PB, PBINT, PBSUR, PBTOP, PDISD, PDISU, PEMIS, PEMIW, PGASUR, PGBSUR, PGATOP, PGBTOP, PDWFSU, PFLUC)
Definition: lwvb.F90:9
dimphy::kfdia
integer, save kfdia
Definition: dimphy.F90:5
parkind1::jprb
integer, parameter jprb
Definition: parkind1.F90:31
yomhook::lhook
logical lhook
Definition: yomhook.F90:12
lwtt
subroutine lwtt(KIDIA, KFDIA, KLON, PGA, PGB, PUU, PTT)
Definition: lwtt.F90:3
yomhook::dr_hook
subroutine dr_hook(CDNAME, KSWITCH, PKEY)
Definition: yomhook.F90:17
yoelw::ng1p1
integer(kind=jpim) ng1p1
Definition: yoelw.F90:21
parkind1::jpim
integer, parameter jpim
Definition: parkind1.F90:13
yoelw::ntra
integer(kind=jpim) ntra
Definition: yoelw.F90:18