source: LMDZ5/trunk/libf/phymar/olwbv.F90 @ 3709

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

Inclusion de la physique de MAR


Integration of MAR physics

File size: 4.3 KB
RevLine 
[2089]1SUBROUTINE OLWBV &
2     &  ( KIDIA, KFDIA, KLON , KLEV &
3     &  , PDP  , PDT0 , PEMIS, PTH &
4     &  , PT   &
5     &  , PCOLC, PFLUC &
6     &  , PABCU, PBINT, PBSUI, PCNTRB, PFDN, PFUP )
7!
8!**** *LWBV*   - COMPUTE PLANCK FUNC., PERF. VERT. INTEGRATION
9!
10!     PURPOSE.
11!     --------
12!           TO COMPUTE THE PLANCK FUNCTION AND PERFORM THE
13!           VERTICAL INTEGRATION. SPLIT OUT FROM LW FOR MEMORY
14!           SAVING
15!
16!**   INTERFACE.
17!     ----------
18!
19!        *LWVB* IS CALLED FROM *LW*
20!
21!        EXPLICIT ARGUMENTS :
22!        --------------------
23! PDP    : (KLON,KLEV)       ; LAYER PRESSURE THICKNESS
24! PDT0   : (KLON)            ; SURFACE TEMPERATURE DISCONTINUITY
25! PEMIS  : (KLON)            ; SURFACE EMISSIVITY
26! PT     : (KLON,KLEV)       ; TEMPERATURE
27! PTH    : (KLON,KLEV+1)     ; HALF LEVEL TEMPERATURE
28!     ==== OUTPUTS ===
29!
30!        IMPLICIT ARGUMENTS :   NONE
31!        --------------------
32!
33!     METHOD.
34!     -------
35!
36!          1. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE
37!     GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.
38!          2. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-
39!     TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE
40!     BOUNDARIES.
41!          3. COMPUTES THE CLEAR-SKY COOLING RATES.
42!
43!     EXTERNALS.
44!     ----------
45!
46!          *LWB*, *LWV*
47!
48!     REFERENCE.
49!     ----------
50!
51!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
52!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
53!
54!     AUTHOR.
55!     -------
56!        JEAN-JACQUES MORCRETTE  *ECMWF*
57!
58!     MODIFICATIONS.
59!     --------------
60!        ORIGINAL : 89-07-14
61!        MODIFICATION : 93-10-15 M.HAMRUD (SPLIT OUT FROM LW TO SAVE
62!                                          MEMORY)
63!-----------------------------------------------------------------------
64
65#include "tsmbkind.h"
66
67USE YOEOLW   , ONLY : NISP     ,NIPD     ,NUA
68USE YOERDU   , ONLY : NUAER    ,NTRAER   ,RCDAY
69USE YOEDBUG  , ONLY : LDEBUG
70
71IMPLICIT NONE
72
73
74!     DUMMY INTEGER SCALARS
75INTEGER_M :: KFDIA
76INTEGER_M :: KIDIA
77INTEGER_M :: KLEV
78INTEGER_M :: KLON
79
80!-----------------------------------------------------------------------
81!
82!*       0.1   ARGUMENTS
83!              ---------
84!
85REAL_B :: PDP(KLON,KLEV) &
86     &  ,  PDT0(KLON)        ,PEMIS(KLON) &
87     &  ,  PTH(KLON,KLEV+1) &
88     &  ,  PT(KLON,KLEV)
89!
90REAL_B :: PCOLC(KLON,KLEV), PFLUC(KLON,2,KLEV+1)
91!     
92REAL_B :: PABCU(KLON,NUA,3*KLEV+1) &
93     &  ,  PBINT(KLON,KLEV+1) &
94     &  ,  PBSUI(KLON) &
95     &  ,  PCNTRB(KLON,KLEV+1,KLEV+1) &
96     &  ,  PFDN(KLON,KLEV+1) &
97     &  ,  PFUP(KLON,KLEV+1)
98!
99!-------------------------------------------------------------------------
100!
101!*       0.2   LOCAL ARRAYS
102!              ------------
103REAL_B :: ZB(KLON,NISP,KLEV+1) &
104     &  ,  ZBSUR(KLON,NISP), ZBTOP(KLON,NISP) &
105     &  ,  ZDBSL(KLON,NISP,KLEV*2) &
106     &  ,  ZGA(KLON,8,2,KLEV), ZGB(KLON,8,2,KLEV) &
107     &  ,  ZGASUR(KLON,8,2)   , ZGBSUR(KLON,8,2) &
108     &  ,  ZGATOP(KLON,8,2)   , ZGBTOP(KLON,8,2)
109     
110REAL_B :: ZDFNET     
111!
112!     LOCAL INTEGER SCALARS
113INTEGER_M :: JK, JKL, JL, JLW
114
115!     ------------------------------------------------------------------
116!
117!*         2.    COMPUTES PLANCK FUNCTIONS
118!                -------------------------
119!
120if (LDEBUG) print *, 'CALL OLWB'
121CALL OLWB ( KIDIA, KFDIA, KLON  , KLEV  &
122     &    , PDT0 , PT   , PTH &
123     &    , ZB   , PBINT, PBSUI , ZBSUR , ZBTOP , ZDBSL &
124     &    , ZGA  , ZGB  , ZGASUR, ZGBSUR, ZGATOP, ZGBTOP     )
125!
126!     ------------------------------------------------------------------
127!
128!*         3.    PERFORMS THE VERTICAL INTEGRATION
129!                ---------------------------------
130!
131if (LDEBUG) print *, 'CALL OLWV'
132CALL OLWV ( KIDIA, KFDIA, KLON , KLEV , NUAER, NTRAER &
133     &    , PABCU, ZB   , PBINT, PBSUI, ZBSUR, ZBTOP, ZDBSL &
134     &    , PEMIS &
135     &    , ZGA  , ZGB  , ZGASUR,ZGBSUR,ZGATOP,ZGBTOP &
136     &    , PCNTRB,PCOLC, PFLUC )
137!
138DO JK = 1 , KLEV+1
139  DO JL = KIDIA,KFDIA
140    PFDN(JL,JK) = PFLUC(JL,2,JK)
141    PFUP(JL,JK) = PFLUC(JL,1,JK)
142  END DO
143END DO
144!
145!
146DO JKL = 1 , KLEV
147  JK = KLEV+1 - JKL
148  DO JL = KIDIA,KFDIA
149    ZDFNET = PFLUC(JL,1,JK+1) + PFLUC(JL,2,JK+1) &
150    &        -PFLUC(JL,1,JK  ) - PFLUC(JL,2,JK  )
151    PCOLC(JL,JK) = RCDAY * ZDFNET / PDP(JL,JKL)
152  END DO
153END DO
154!
155!     ------------------------------------------------------------------
156!
157RETURN
158END SUBROUTINE OLWBV
Note: See TracBrowser for help on using the repository browser.