source: LMDZ5/branches/IPSLCM6.0.11pre/libf/phymar/lwvb.F90 @ 5024

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

Inclusion de la physique de MAR


Integration of MAR physics

File size: 6.9 KB
Line 
1SUBROUTINE 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
68!-----------------------------------------------------------------------
69
70#include "tsmbkind.h"
71
72USE YOELW    , ONLY : NSIL     ,NIPD     ,NTRA     ,NUA      ,NG1P1
73
74
75IMPLICIT NONE
76
77
78!     DUMMY INTEGER SCALARS
79INTEGER_M :: KFDIA
80INTEGER_M :: KIDIA
81INTEGER_M :: KLEV
82INTEGER_M :: KLON
83INTEGER_M :: KUAER
84
85
86
87!-----------------------------------------------------------------------
88
89!*       0.1   ARGUMENTS
90!              ---------
91
92
93REAL_B :: PABCU(KLON,NUA,3*KLEV+1)&
94  &,  PADJD(KLON,KLEV+1) , PADJU(KLON,KLEV+1)&
95  &,  PB(KLON,NSIL,KLEV+1),PBINT(KLON,KLEV+1)&
96  &,  PBSUR(KLON,NSIL)   , PBTOP(KLON,NSIL)&
97  &,  PDISD(KLON,KLEV+1) , PDISU(KLON,KLEV+1)&
98  &,  PEMIS(KLON)        , PEMIW(KLON)&
99  &,  PGASUR(KLON,NIPD,2), PGBSUR(KLON,NIPD,2)&
100  &,  PGATOP(KLON,NIPD,2), PGBTOP(KLON,NIPD,2)
101
102REAL_B :: PDWFSU(KLON,NSIL)  , PFLUC(KLON,2,KLEV+1)
103
104!-----------------------------------------------------------------------
105
106!*       0.2   LOCAL ARRAYS
107!              ------------
108
109REAL_B :: ZBSUR(KLON,NSIL)&
110  &,  ZTT(KLON,NTRA), ZTT1(KLON,NTRA), ZTT2(KLON,NTRA)&
111  &,  ZUU(KLON,NUA) , ZCNSOL(KLON)   , ZCNTOP(KLON)
112
113!     LOCAL INTEGER SCALARS
114INTEGER_M :: IN, JA, JK, JL
115
116!     LOCAL REAL SCALARS
117REAL_B :: ZCNTOP1, ZCNTOP2, ZCNTOP3, ZCNTOP4, ZCNTOP5, ZCNTOP6
118
119
120!-----------------------------------------------------------------------
121
122!*         1.    INITIALIZATION
123!                --------------
124
125
126!*         1.2     INITIALIZE TRANSMISSION FUNCTIONS
127!                  ---------------------------------
128
129DO JA=1,NTRA
130  DO JL=KIDIA,KFDIA
131    ZTT (JL,JA)=_ONE_
132    ZTT1(JL,JA)=_ONE_
133    ZTT2(JL,JA)=_ONE_
134  ENDDO
135ENDDO
136
137DO JA=1,NUA
138  DO JL=KIDIA,KFDIA
139    ZUU(JL,JA)=_ONE_
140  ENDDO
141ENDDO
142
143!     ------------------------------------------------------------------
144
145!*         2.      VERTICAL INTEGRATION
146!                  --------------------
147
148
149!*         2.3     EXCHANGE WITH TOP OF THE ATMOSPHERE
150!                  -----------------------------------
151
152DO JK = 1 , KLEV
153  IN=(JK-1)*NG1P1+1
154
155  DO JA=1,KUAER
156    DO JL=KIDIA,KFDIA
157      ZUU(JL,JA)=PABCU(JL,JA,IN)
158    ENDDO
159  ENDDO
160
161
162  CALL LWTT &
163   &( KIDIA        , KFDIA        , KLON &
164   &, PGATOP(1,1,1), PGBTOP(1,1,1)&
165   &, ZUU          , ZTT &
166   &)
167
168  DO JL = KIDIA,KFDIA
169    ZCNTOP1=PBTOP(JL,1)*ZTT(JL,1)          *ZTT(JL,10)
170    ZCNTOP2=PBTOP(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)
171    ZCNTOP3=PBTOP(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)
172    ZCNTOP4=PBTOP(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)
173    ZCNTOP5=PBTOP(JL,5)*ZTT(JL,3)          *ZTT(JL,14)
174    ZCNTOP6=PBTOP(JL,6)*ZTT(JL,6)          *ZTT(JL,15)
175    ZCNTOP(JL)=ZCNTOP1+ZCNTOP2+ZCNTOP3+ZCNTOP4+ZCNTOP5+ZCNTOP6
176    PFLUC(JL,2,JK)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK)
177    IF (JK == 1) THEN
178      PDWFSU(JL,1)=ZCNTOP1-PB(JL,1,JK)-PDWFSU(JL,1)
179      PDWFSU(JL,2)=ZCNTOP2-PB(JL,2,JK)-PDWFSU(JL,2)
180      PDWFSU(JL,3)=ZCNTOP3-PB(JL,3,JK)-PDWFSU(JL,3)
181      PDWFSU(JL,4)=ZCNTOP4-PB(JL,4,JK)-PDWFSU(JL,4)
182      PDWFSU(JL,5)=ZCNTOP5-PB(JL,5,JK)-PDWFSU(JL,5)
183      PDWFSU(JL,6)=ZCNTOP6-PB(JL,6,JK)-PDWFSU(JL,6)
184    ENDIF
185  ENDDO
186
187ENDDO
188
189JK = KLEV+1
190IN=(JK-1)*NG1P1+1
191
192DO JL = KIDIA,KFDIA
193  ZCNTOP(JL)= PBTOP(JL,1)&
194   &+ PBTOP(JL,2)&
195   &+ PBTOP(JL,3)&
196   &+ PBTOP(JL,4)&
197   &+ PBTOP(JL,5)&
198   &+ PBTOP(JL,6)
199  PFLUC(JL,2,JK)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK)
200ENDDO
201
202
203!*         2.5     EXCHANGE WITH LOWER LIMIT
204!                  -------------------------
205
206JK = 1
207IN=(JK-1)*NG1P1+1
208
209DO JL = KIDIA,KFDIA
210  ZBSUR(JL,1)=PBSUR(JL,1)*PEMIS(JL) -(_ONE_-PEMIS(JL))*PDWFSU(JL,1)
211  ZBSUR(JL,2)=PBSUR(JL,2)*PEMIS(JL) -(_ONE_-PEMIS(JL))*PDWFSU(JL,2)
212  ZBSUR(JL,3)=PBSUR(JL,3)*PEMIW(JL) -(_ONE_-PEMIW(JL))*PDWFSU(JL,3)
213  ZBSUR(JL,4)=PBSUR(JL,4)*PEMIW(JL) -(_ONE_-PEMIW(JL))*PDWFSU(JL,4)
214  ZBSUR(JL,5)=PBSUR(JL,5)*PEMIS(JL) -(_ONE_-PEMIS(JL))*PDWFSU(JL,5)
215  ZBSUR(JL,6)=PBSUR(JL,6)*PEMIS(JL) -(_ONE_-PEMIS(JL))*PDWFSU(JL,6)
216
217  PFLUC(JL,1,JK) = ZBSUR(JL,1)&
218   &+ ZBSUR(JL,2)&
219   &+ ZBSUR(JL,3)&
220   &+ ZBSUR(JL,4)&
221   &+ ZBSUR(JL,5)&
222   &+ ZBSUR(JL,6)
223
224  ZBSUR(JL,1)=ZBSUR(JL,1)-PB(JL,1,1)
225  ZBSUR(JL,2)=ZBSUR(JL,2)-PB(JL,2,1)
226  ZBSUR(JL,3)=ZBSUR(JL,3)-PB(JL,3,1)
227  ZBSUR(JL,4)=ZBSUR(JL,4)-PB(JL,4,1)
228  ZBSUR(JL,5)=ZBSUR(JL,5)-PB(JL,5,1)
229  ZBSUR(JL,6)=ZBSUR(JL,6)-PB(JL,6,1)
230ENDDO
231
232DO JK = 2 , KLEV+1
233  IN=(JK-1)*NG1P1+1
234
235  DO JA=1,KUAER
236    DO JL=KIDIA,KFDIA
237      ZUU(JL,JA)=PABCU(JL,JA,1)-PABCU(JL,JA,IN)
238    ENDDO
239  ENDDO
240
241
242  CALL LWTT &
243   &( KIDIA        , KFDIA        , KLON &
244   &, PGASUR(1,1,1), PGBSUR(1,1,1)&
245   &, ZUU, ZTT &
246   &)
247
248  DO JL = KIDIA,KFDIA
249    ZCNSOL(JL)=ZBSUR(JL,1)*ZTT(JL,1)          *ZTT(JL,10)&
250     &+ZBSUR(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)&
251     &+ZBSUR(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)&
252     &+ZBSUR(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)&
253     &+ZBSUR(JL,5)*ZTT(JL,3)          *ZTT(JL,14)&
254     &+ZBSUR(JL,6)*ZTT(JL,6)          *ZTT(JL,15)
255    PFLUC(JL,1,JK)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK)
256  ENDDO
257
258ENDDO
259
260!     ------------------------------------------------------------------
261
262RETURN
263END SUBROUTINE LWVB
Note: See TracBrowser for help on using the repository browser.