source: LMDZ5/branches/testing/libf/phylmd/rrtm/suphec.F90 @ 2542

Last change on this file since 2542 was 2408, checked in by Laurent Fairhead, 9 years ago

Merged trunk changes r2298:2396 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: 10.7 KB
RevLine 
[1989]1SUBROUTINE SUPHEC(KULOUT)
2
3!**** *SUPHEC - INITIALISES PHYSICAL CONSTANTS OF UNCERTAIN VALUE.
4!               WITHIN THE E.C.M.W.F. PHYSICS PACKAGE
5
6!     PURPOSE.
7!     --------
8
9!          THIS ROUTINE SETS THE VALUES FOR THE PHYSICAL CONSTANTS USED
10!     IN THE PARAMETERIZATION ROUTINES WHENEVER THESE VALUES ARE NOT
11!     KNOWN WELL ENOUGH TO FORBID ANY TUNING OR WHENEVER THEY ARE
12!     SUBJECT TO AN ARBITRARY CHOICE OF THE MODELLER. THESE CONSTANTS
13!     ARE DISTRIBUTED IN COMMON DECKS *YOEXXXX* WHERE XXXX CORRESPONDS
14!     TO THE INDIVIDUAL PHYSICAL PARAMETRIZATION
15
16!**   INTERFACE.
17!     ----------
18
19!          *SUPHEC* IS CALLED FROM *SUPHY*
20
21!     METHOD.
22!     -------
23
24!          NONE.
25
26!     EXTERNALS.
27!     ----------
28
29!          *SUECRAD*, *SUCUMF*, *SUCUMF2*,*SUVDFS*, *SUSURF*
30!          *SUECRAD15*, *SUCLOP15*
31!          *SUGWD*, *SUCLD*, *SUCOND*, *SUPHLI*, *SUMETHOX*
32
33!     REFERENCE.
34!     ----------
35
36!          SEE PHYSICAL ROUTINES FOR AN EXACT DEFINITION OF THE
37!     CONSTANTS.
38
39!     AUTHOR.
40!     -------
41!          J.-J. MORCRETTE  E.C.M.W.F.    91/06/15  ADAPTATION TO I.F.S.
42
43!     MODIFICATIONS
44!     -------------
45!          MAY 1997 : M. Deque  - Frozen FMR
46!          APRIL 1998: C. JAKOB - ADD METHANE OXIDATION
47!        M.Hamrud      01-Oct-2003 CY28 Cleaning
48!        P.Viterbo     24-May-2004 surf library
49!        P.Viterbo     03-Dec-2004 Include user-defined RTHRFRTI
50!        M.Ko"hler     03-Dec-2004 cp,moist=cp,dry
51!        P.Viterbo     10-Jun-2005 Externalise surf
52!        R. El Khatib & J-F Estrade  20-Jan-2005 Default PRSUN for FMR15
53!        D.Salmond     22-Nov-2005 Mods for coarser/finer physics
54!        P. Lopez      21-Aug-2006 Added call to SUCUMF2
55!                                 (new linearized convec)
56!        JJMorcrette   20060525    MODIS albedo
57!     ------------------------------------------------------------------
58
59USE PARKIND1  ,ONLY : JPIM     ,JPRB
60USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
61
62USE YOMDPHY  , ONLY : NTILES
63USE SURFACE_FIELDS, ONLY : YSP_SBD
64USE YOELW    , ONLY : NSIL     ,TSTAND   ,XP
65USE YOESW    , ONLY : RSUN
66USE YOMSW15  , ONLY : RSUN15
67USE YOMDIM   , ONLY : NFLEVG   ,NSMAX, NGPBLKS, NPROMA
68USE YOMGEM   , ONLY : VBH      ,VAH      ,VP00, VAF   , VBF
69USE YOMCST   , ONLY : RD       ,RV       ,RCPD     ,&
70 & RLVTT    ,RLSTT    ,RLMLT    ,RTT      ,RATM
[2056]71!USE YOETHF   , ONLY : R2ES     ,R3LES    ,R3IES    ,R4LES    ,&
72! & R4IES    ,R5LES    ,R5IES    ,RVTMP2   ,RHOH2O   ,&
73! & R5ALVCP  ,R5ALSCP  ,RALVDCP  ,RALSDCP  ,RALFDCP  ,&
74! & RTWAT    ,RTBER    ,RTBERCU  ,RTICE    ,RTICECU  ,&
75! & RTWAT_RTICE_R      ,RTWAT_RTICECU_R    ,&
76! & RKOOP1   ,RKOOP2
[1989]77USE YOMPHY   , ONLY : LRAYFM15
78!USE YOERAD   , ONLY : NSW      ,NTSW     ,&
79! NSW mis dans .def MPL 20140211
80USE YOERAD   , ONLY : NTSW     ,&
81 & LCCNL    ,LCCNO    ,&
82 & RCCNSEA  ,RCCNLND
83USE YOE_TILE_PROP, ONLY : RUSTRTI, RVSTRTI, RAHFSTI, REVAPTI, RTSKTI
84USE YOEPHY   , ONLY : RTHRFRTI ,LEOCWA   ,LEOCCO   ,LEOCSA, LE4ALB
85USE YOEVDF   , ONLY : NVTYPES
86USE YOMCOAPHY   , ONLY : NPHYINT
87USE YOM_PHYS_GRID ,ONLY : PHYS_GRID
88USE YOMCT0  , ONLY  : LSCMEC   ,LROUGH   ,REXTZ0M  ,REXTZ0H
[2408]89USE vertical_layers_mod, ONLY: ap,bp
[1989]90
91IMPLICIT NONE
[2056]92include "YOETHF.h"
[1989]93include "clesphys.h"
94
95INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT
96INTERFACE
97#include "susurf.h"
98#include "surf_inq.h"
99END INTERFACE
100
101#include "gppre.intfb.h"
102#include "sucld.intfb.h"
103#include "sucldp.intfb.h"
104#include "suclop.intfb.h"
105#include "suclop15.intfb.h"
106#include "sucond.intfb.h"
107#include "sucumf.intfb.h"
108#include "sucumf2.intfb.h"
109#include "suecrad.intfb.h"
110#include "suecrad15.intfb.h"
111#include "sugwd.intfb.h"
112#include "sumethox.intfb.h"
113#include "suphli.intfb.h"
114#include "suvdf.intfb.h"
115#include "suvdfs.intfb.h"
116#include "suwcou.intfb.h"
117
118!     ------------------------------------------------------------------
119
120REAL(KIND=JPRB) :: ZPRES(0:NFLEVG),ZPRESF(NFLEVG), ZETA(NFLEVG),ZETAH(0:NFLEVG)
121
122INTEGER(KIND=JPIM) :: JK,ISMAX,JLEV
123REAL(KIND=JPRB) :: ZHOOK_HANDLE
124
125!     ------------------------------------------------------------------
126
127!*         0.2    DEFINING DERIVED CONSTANTS FROM UNIVERSAL CONSTANTS
128!                 ---------------------------------------------------
129
130IF (LHOOK) CALL DR_HOOK('SUPHEC',0,ZHOOK_HANDLE)
131!CALL GSTATS(1811,0) ! MPL 28.11.08
132!RVTMP2=RCPV/RCPD-1.0_JPRB   !use cp,moist
133RVTMP2=0.0_JPRB              !neglect cp,moist
134RHOH2O=RATM/100._JPRB
135R2ES=611.21_JPRB*RD/RV
136R3LES=17.502_JPRB
137R3IES=22.587_JPRB
138R4LES=32.19_JPRB
139R4IES=-0.7_JPRB
140R5LES=R3LES*(RTT-R4LES)
141R5IES=R3IES*(RTT-R4IES)
142R5ALVCP=R5LES*RLVTT/RCPD
143R5ALSCP=R5IES*RLSTT/RCPD
144RALVDCP=RLVTT/RCPD
145RALSDCP=RLSTT/RCPD
146RALFDCP=RLMLT/RCPD
147RTWAT=RTT
148RTBER=RTT-5._JPRB
149RTBERCU=RTT-5.0_JPRB
150RTICE=RTT-23._JPRB
151RTICECU=RTT-23._JPRB
152
153RTWAT_RTICE_R=1.0_JPRB/(RTWAT-RTICE)
154RTWAT_RTICECU_R=1.0_JPRB/(RTWAT-RTICECU)
155IF(NPHYINT == 0) THEN
156  ISMAX=NSMAX
157ELSE
158  ISMAX=PHYS_GRID%NSMAX
159ENDIF
160
161RKOOP1=2.583_JPRB
162RKOOP2=0.48116E-2_JPRB
163
164!     ------------------------------------------------------------------
165!*         0.5    DEFINE STANDARD ATMOSPHERE VERTICAL CONFIGURATION
166!                 -------------------------------------------------
167!ALLOCATE(VBH    (0:MAX(JPMXLE,NFLEVG)))  from suallo.F90
168!!
169ALLOCATE(VAH    (0:NFLEVG))  ! Ajout ALLOCATE MPL 200509
170ALLOCATE(VBH    (0:NFLEVG))
171ALLOCATE(VAF    (NFLEVG))
172ALLOCATE(VBF    (NFLEVG))
173! Commente par MPL 28.11.08, puis decommente le 19.05.09
174VP00=101325.     !!!!! A REVOIR (MPL)
175ZPRES(NFLEVG)=VP00
[2408]176! on recupere ap et bp de dyn3d (vertical_layers_mod) MPL 19.05.09
[1989]177! Attention, VAH et VBH sont inverses, comme les niveaux
178! plev(l)=PAPRS(klon,nlayer+1-l) de 1 a nlayer (apllmd.F)
179DO JLEV = 0, NFLEVG 
180!  VAH(JLEV)=ap(JLEV+1)ap(JLEV+1)
181!  VBH(JLEV)=bp(JLEV+1)
182!  print *,'SUPHEC: jlev ap bp',JLEV,ap(JLEV+1),bp(JLEV+1)
183   VAH(JLEV)=ap(NFLEVG+1-JLEV)
184   VBH(JLEV)=bp(NFLEVG+1-JLEV)
185ENDDO
186! Calcul de VAF et VBF, analogues de VAH et VBH mais aux niveaux pleins
187DO JLEV = 1, NFLEVG   
188   VAF(JLEV)=(VAH(JLEV)+VAH(JLEV-1))/2.
189   VBF(JLEV)=(VBH(JLEV)+VBH(JLEV-1))/2.
190ENDDO
191
192! Appel a GPPRE commente par MPL 28.11.08, puis decommente le 19.05.09
193CALL GPPRE ( 1 ,1, 1, NFLEVG, VAH, VBH, ZPRES, ZPRESF )
194
195DO JK=0,NFLEVG
196  ZETAH(JK)= ZPRES(JK)/ZPRES(NFLEVG)
197ENDDO
198DO JK=1,NFLEVG
199  ZETA(JK)= ZPRESF(JK)/ZPRES(NFLEVG)
200ENDDO
201
202!     ------------------------------------------------------------------
203!*         1.     SETTING CONSTANTS FOR DIAGNOSTIC CLOUD SCHEME
204!                 ---------------------------------------------
205
206!CALL SUCLD ( NFLEVG , ZETA ) ! MPL 28.11.08
207
208!     ------------------------------------------------------------------
209
210!*         2.     SETTING CONSTANTS FOR LARGE-SCALE CONDENSATION SCHEME
211!                 -----------------------------------------------------
212
213!CALL SUCOND ( KULOUT , NFLEVG , ZETA ) ! MPL 28.11.08
214
215!     ------------------------------------------------------------------
216
217!*         3.     SETTING CONSTANTS FOR CONVECTION SCHEME
218!                 ---------------------------------------
219
220!CALL SUCUMF(ISMAX)     ! MPL 28.11.08
221
222!     ------------------------------------------------------------------
223
224!*         3.     SETTING CONSTANTS FOR NEW LINEARIZED CONVECTION SCHEME
225!                 ------------------------------------------------------
226
227!CALL SUCUMF2(ISMAX)  ! MPL 28.11.08
228
229!     ------------------------------------------------------------------
230!*         4.     SETTING CONSTANTS FOR GRAVITY WAVE DRAG SCHEME
231!                 ----------------------------------------------
232
233!CALL SUGWD (KULOUT, NFLEVG, VAH, VBH )   ! MPL 28.11.08
234
235!     ------------------------------------------------------------------
236
237!*         5.     SETTING CONSTANTS FOR VERTICAL DIFFUSION
238!                 ----------------------------------------
239
240!CALL SUVDFS     ! MPL 28.11.08
241
242!CALL SUVDF      ! MPL 28.11.08
243
244!cccc CALL SUVDFD ( NABLPFR, ABLPLL ) cccccccccccccccccccccccccccccccccc
245
246!     ------------------------------------------------------------------
247
248!*         6.     SETTING CONSTANTS FOR RADIATION SCHEME
249!                 --------------------------------------
250
251IF (LRAYFM15) THEN
252  CALL SUECRAD15 (KULOUT, NFLEVG, ZETAH )
253ELSE
254  CALL SUECRAD (KULOUT, NFLEVG, ZETAH )
255ENDIF
256
257!     ------------------------------------------------------------------
258!*         7.     SETTING CONSTANTS FOR SURFACE SCHEME
259!                 ------------------------------------
260
261!IF (LRAYFM15) THEN
262!   CALL SUSURF(KSW=NSW,KCSS=YSP_SBD%NLEVS,KSIL=NSIL,KTILES=NTILES,KTSW=NTSW,&
263!    & LD_LLCCNL=LCCNL,LD_LLCCNO=LCCNO,&
264!    & LD_LEOCWA=LEOCWA,LD_LEOCCO=LEOCCO,LD_LEOCSA=LEOCSA,LD_LLE4ALB=LE4ALB,&
265!    & LD_LSCMEC=LSCMEC,LD_LROUGH=LROUGH,PEXTZ0M=REXTZ0M,PEXTZ0H=REXTZ0H,&
266!    & PTHRFRTI=RTHRFRTI,PTSTAND=TSTAND,PXP=XP,PRCCNSEA=RCCNSEA,PRCCNLND=RCCNLND,&
267!    & PRSUN=RSUN15)
268!ELSE
269!   CALL SUSURF(KSW=NSW,KCSS=YSP_SBD%NLEVS,KSIL=NSIL,KTILES=NTILES,KTSW=NTSW,&
270!    & LD_LLCCNL=LCCNL,LD_LLCCNO=LCCNO,&
271!    & LD_LEOCWA=LEOCWA,LD_LEOCCO=LEOCCO,LD_LEOCSA=LEOCSA,LD_LLE4ALB=LE4ALB,&
272!    & LD_LSCMEC=LSCMEC,LD_LROUGH=LROUGH,PEXTZ0M=REXTZ0M,PEXTZ0H=REXTZ0H,&
273!    & PTHRFRTI=RTHRFRTI,PTSTAND=TSTAND,PXP=XP,PRCCNSEA=RCCNSEA,PRCCNLND=RCCNLND,&
274!    & PRSUN=RSUN)
275!ENDIF
276
277
278!CALL SURF_INQ(KNVTYPES=NVTYPES)
279
280
281!          7.1    Allocate working arrays
282!ALLOCATE(RUSTRTI(NPROMA,NTILES,NGPBLKS))
283!ALLOCATE(RVSTRTI(NPROMA,NTILES,NGPBLKS))
284!ALLOCATE(RAHFSTI(NPROMA,NTILES,NGPBLKS))
285!ALLOCATE(REVAPTI(NPROMA,NTILES,NGPBLKS))
286!ALLOCATE(RTSKTI (NPROMA,NTILES,NGPBLKS))
287!RUSTRTI(:,:,:) = 0.0_JPRB
288!RVSTRTI(:,:,:) = 0.0_JPRB
289!RAHFSTI(:,:,:) = 0.0_JPRB
290!REVAPTI(:,:,:) = 0.0_JPRB
291!RTSKTI (:,:,:) = 0.0_JPRB
292!CALL GSTATS(1811,1)
293
294!     ------------------------------------------------------------------
295
296!*         8.     SETTING CONSTANTS FOR CLOUD OPTICAL PROPERTIES
297!                 ----------------------------------------------
298
299IF (LRAYFM15) THEN
300  CALL SUCLOP15
301ELSE
302  CALL SUCLOP
303ENDIF
304
305!     ------------------------------------------------------------------
306
307!*         9.     SETTING CONSTANTS FOR PROGNOSTIC CLOUD SCHEME
308!                 ----------------------------------------------
309
310!CALL SUCLDP
311
312!     ------------------------------------------------------------------
313
314!*        10.     SETTING CONSTANTS FOR WAVE COUPLING
315!                 -----------------------------------
316
317!CALL SUWCOU
318
319!     ------------------------------------------------------------------
320!*         11.   SETTING CONSTANTS FOR LINEARIZED PHYSICS
321!                ----------------------------------------
322
323!CALL SUPHLI
324
325!     ------------------------------------------------------------------
326!*         12.   SETTING CONSTANTS FOR METHANE OXIDATION
327!                ---------------------------------------
328
329!CALL SUMETHOX
330
331!     ------------------------------------------------------------------
332
333WRITE(UNIT=KULOUT,FMT='('' SUPHEC IS OVER '')')
334
335!     ------------------------------------------------------------------
336
337IF (LHOOK) CALL DR_HOOK('SUPHEC',1,ZHOOK_HANDLE)
338END SUBROUTINE SUPHEC
Note: See TracBrowser for help on using the repository browser.