source: LMDZ5/branches/testing/libf/phylmd/rrtm/lwbv.F90 @ 1999

Last change on this file since 1999 was 1999, checked in by Laurent Fairhead, 11 years ago

Merged trunk changes r1920:1997 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
File size: 4.7 KB
Line 
1SUBROUTINE LWBV &
2 & ( KIDIA, KFDIA, KLON , KLEV  , KMODE,&
3 & PDT0 , PEMIS, PEMIW,&
4 & PTL  , PTAVE,&
5 & PEMIT, PFLUC,&
6 & PABCU, PBINT, PBSUI, PCNTRB &
7 & ) 
8
9!**** *LWBV*   - COMPUTE PLANCK FUNC., PERF. VERT. INTEGRATION
10
11!     PURPOSE.
12!     --------
13!           TO COMPUTE THE PLANCK FUNCTION AND PERFORM THE
14!           VERTICAL INTEGRATION. SPLIT OUT FROM LW FOR MEMORY
15!           SAVING
16
17!**   INTERFACE.
18!     ----------
19
20!        *LWVB* IS CALLED FROM *LW*
21
22!        EXPLICIT ARGUMENTS :
23!        --------------------
24! PDT0   : (KLON)            ; SURFACE TEMPERATURE DISCONTINUITY
25! PEMIS  : (KLON)            ; SURFACE LW EMISSIVITY
26! PEMIW  : (KLON)            ; SURFACE LW WINDOW EMISSIVITY
27! PTAVE  : (KLON,KLEV)       ; TEMPERATURE
28! PTL    : (KLON,KLEV+1)     ; HALF LEVEL TEMPERATURE
29!     ==== OUTPUTS ===
30! PABCU  :
31! PBINT  :
32! PBSUI  :
33! PCNTRB :
34! PCOLC  :
35! PEMIT  :
36! PFLUC  :
37
38!        IMPLICIT ARGUMENTS :   NONE
39!        --------------------
40
41!     METHOD.
42!     -------
43
44!          1. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE
45!     GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.
46!          2. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-
47!     TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE
48!     BOUNDARIES.
49!          3. COMPUTES THE CLEAR-SKY COOLING RATES.
50
51!     EXTERNALS.
52!     ----------
53
54!          *LWB*, *LWV*
55
56!     REFERENCE.
57!     ----------
58
59!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
60!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
61
62!     AUTHOR.
63!     -------
64!        JEAN-JACQUES MORCRETTE  *ECMWF*
65
66!     MODIFICATIONS.
67!     --------------
68!        ORIGINAL : 89-07-14
69!        MODIFICATION : 93-10-15 M.HAMRUD (SPLIT OUT FROM LW TO SAVE
70!                                          MEMORY)
71!        M.Hamrud      01-Oct-2003 CY28 Cleaning
72!-----------------------------------------------------------------------
73
74USE PARKIND1  ,ONLY : JPIM     ,JPRB
75USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
76
77USE YOELW    , ONLY : NSIL     ,NIPD     ,NUA
78USE YOERDU   , ONLY : NUAER    ,NTRAER
79
80IMPLICIT NONE
81
82INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
83INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
84INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
85INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
86INTEGER(KIND=JPIM),INTENT(IN)    :: KMODE
87REAL(KIND=JPRB)   ,INTENT(IN)    :: PDT0(KLON)
88REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON)
89REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIW(KLON)
90REAL(KIND=JPRB)   ,INTENT(IN)    :: PTL(KLON,KLEV+1)
91REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAVE(KLON,KLEV)
92REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMIT(KLON)
93REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUC(KLON,2,KLEV+1)
94REAL(KIND=JPRB)   ,INTENT(IN)    :: PABCU(KLON,NUA,3*KLEV+1)
95REAL(KIND=JPRB)   ,INTENT(INOUT) :: PBINT(KLON,KLEV+1)
96REAL(KIND=JPRB)   ,INTENT(OUT)   :: PBSUI(KLON)
97REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCNTRB(KLON,KLEV+1,KLEV+1)
98!-----------------------------------------------------------------------
99
100!*       0.1   ARGUMENTS
101!              ---------
102
103!-------------------------------------------------------------------------
104
105!              ------------
106REAL(KIND=JPRB) ::&
107 & ZB(KLON,NSIL,KLEV+1), ZBSUR(KLON,NSIL)   , ZBTOP(KLON,NSIL)&
108 & ,  ZDBSL(KLON,NSIL,KLEV*2)&
109 & ,  ZGA(KLON,NIPD,2,KLEV)  , ZGB(KLON,NIPD,2,KLEV)&
110 & ,  ZGASUR(KLON,NIPD,2)    , ZGBSUR(KLON,NIPD,2)&
111 & ,  ZGATOP(KLON,NIPD,2)    , ZGBTOP(KLON,NIPD,2) 
112
113INTEGER(KIND=JPIM) :: JL, JLW
114REAL(KIND=JPRB) :: ZHOOK_HANDLE
115
116#include "lwb.intfb.h"
117#include "lwv.intfb.h"
118
119!     ------------------------------------------------------------------
120
121!*         2.    COMPUTES PLANCK FUNCTIONS
122!                -------------------------
123
124IF (LHOOK) CALL DR_HOOK('LWBV',0,ZHOOK_HANDLE)
125print *,'LWBV: avant LWB'
126CALL LWB &
127 & ( KIDIA, KFDIA, KLON  , KLEV  , KMODE,&
128 & PDT0 , PTAVE, PTL,&
129 & ZB   , PBINT, ZBSUR , ZBTOP , ZDBSL,&
130 & ZGA  , ZGB  , ZGASUR, ZGBSUR, ZGATOP, ZGBTOP    &
131 & ) 
132
133!     ------------------------------------------------------------------
134
135!*         3.    PERFORMS THE VERTICAL INTEGRATION
136!                ---------------------------------
137
138CALL LWV &
139 & ( KIDIA , KFDIA, KLON  , KLEV,&
140 & NUAER , NTRAER,&
141 & PABCU , ZB   , PBINT , ZBSUR , ZBTOP , ZDBSL,&
142 & PEMIS , PEMIW,&
143 & ZGA   , ZGB  , ZGASUR, ZGBSUR, ZGATOP, ZGBTOP,&
144 & PCNTRB, PFLUC &
145 & ) 
146
147DO JL=KIDIA,KFDIA
148  PEMIT(JL)=0.0_JPRB
149  PBSUI(JL)=0.0_JPRB
150ENDDO
151DO JLW=1,NSIL
152  DO JL=KIDIA,KFDIA
153    PBSUI(JL)=PBSUI(JL)+ZBSUR(JL,JLW)
154    IF (JLW >= 3.AND. JLW <= 4) THEN
155      PEMIT(JL)=PEMIT(JL)+ZBSUR(JL,JLW)*PEMIW(JL)
156    ELSE
157      PEMIT(JL)=PEMIT(JL)+ZBSUR(JL,JLW)*PEMIS(JL)
158    ENDIF
159  ENDDO
160ENDDO
161DO JL=KIDIA,KFDIA
162  PEMIT(JL)=PEMIT(JL)/PBSUI(JL)
163ENDDO
164
165!     ------------------------------------------------------------------
166
167IF (LHOOK) CALL DR_HOOK('LWBV',1,ZHOOK_HANDLE)
168END SUBROUTINE LWBV
Note: See TracBrowser for help on using the repository browser.