source: LMDZ5/trunk/libf/phylmd/rrtm/suphec.F90 @ 2315

Last change on this file since 2315 was 2315, checked in by Ehouarn Millour, 9 years ago

More on physics/dynamics separation: make a vertical_layers_mod module to contain information on the vertical discretization. This module should be used from within the physics (instead of including comvert.h from dynamics).
EM
  • 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
Line 
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
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
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
89USE vertical_layers_mod, ONLY: ap,bp
90
91IMPLICIT NONE
92include "YOETHF.h"
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#include "dimensions.h"
118
119!     ------------------------------------------------------------------
120
121REAL(KIND=JPRB) :: ZPRES(0:NFLEVG),ZPRESF(NFLEVG), ZETA(NFLEVG),ZETAH(0:NFLEVG)
122
123INTEGER(KIND=JPIM) :: JK,ISMAX,JLEV
124REAL(KIND=JPRB) :: ZHOOK_HANDLE
125
126!     ------------------------------------------------------------------
127
128!*         0.2    DEFINING DERIVED CONSTANTS FROM UNIVERSAL CONSTANTS
129!                 ---------------------------------------------------
130
131IF (LHOOK) CALL DR_HOOK('SUPHEC',0,ZHOOK_HANDLE)
132!CALL GSTATS(1811,0) ! MPL 28.11.08
133!RVTMP2=RCPV/RCPD-1.0_JPRB   !use cp,moist
134RVTMP2=0.0_JPRB              !neglect cp,moist
135RHOH2O=RATM/100._JPRB
136R2ES=611.21_JPRB*RD/RV
137R3LES=17.502_JPRB
138R3IES=22.587_JPRB
139R4LES=32.19_JPRB
140R4IES=-0.7_JPRB
141R5LES=R3LES*(RTT-R4LES)
142R5IES=R3IES*(RTT-R4IES)
143R5ALVCP=R5LES*RLVTT/RCPD
144R5ALSCP=R5IES*RLSTT/RCPD
145RALVDCP=RLVTT/RCPD
146RALSDCP=RLSTT/RCPD
147RALFDCP=RLMLT/RCPD
148RTWAT=RTT
149RTBER=RTT-5._JPRB
150RTBERCU=RTT-5.0_JPRB
151RTICE=RTT-23._JPRB
152RTICECU=RTT-23._JPRB
153
154RTWAT_RTICE_R=1.0_JPRB/(RTWAT-RTICE)
155RTWAT_RTICECU_R=1.0_JPRB/(RTWAT-RTICECU)
156IF(NPHYINT == 0) THEN
157  ISMAX=NSMAX
158ELSE
159  ISMAX=PHYS_GRID%NSMAX
160ENDIF
161
162RKOOP1=2.583_JPRB
163RKOOP2=0.48116E-2_JPRB
164
165!     ------------------------------------------------------------------
166!*         0.5    DEFINE STANDARD ATMOSPHERE VERTICAL CONFIGURATION
167!                 -------------------------------------------------
168!ALLOCATE(VBH    (0:MAX(JPMXLE,NFLEVG)))  from suallo.F90
169!!
170ALLOCATE(VAH    (0:NFLEVG))  ! Ajout ALLOCATE MPL 200509
171ALLOCATE(VBH    (0:NFLEVG))
172ALLOCATE(VAF    (NFLEVG))
173ALLOCATE(VBF    (NFLEVG))
174! Commente par MPL 28.11.08, puis decommente le 19.05.09
175VP00=101325.     !!!!! A REVOIR (MPL)
176ZPRES(NFLEVG)=VP00
177! on recupere ap et bp de dyn3d (vertical_layers_mod) MPL 19.05.09
178! Attention, VAH et VBH sont inverses, comme les niveaux
179! plev(l)=PAPRS(klon,nlayer+1-l) de 1 a nlayer (apllmd.F)
180DO JLEV = 0, NFLEVG 
181!  VAH(JLEV)=ap(JLEV+1)ap(JLEV+1)
182!  VBH(JLEV)=bp(JLEV+1)
183!  print *,'SUPHEC: jlev ap bp',JLEV,ap(JLEV+1),bp(JLEV+1)
184   VAH(JLEV)=ap(NFLEVG+1-JLEV)
185   VBH(JLEV)=bp(NFLEVG+1-JLEV)
186ENDDO
187! Calcul de VAF et VBF, analogues de VAH et VBH mais aux niveaux pleins
188DO JLEV = 1, NFLEVG   
189   VAF(JLEV)=(VAH(JLEV)+VAH(JLEV-1))/2.
190   VBF(JLEV)=(VBH(JLEV)+VBH(JLEV-1))/2.
191ENDDO
192
193! Appel a GPPRE commente par MPL 28.11.08, puis decommente le 19.05.09
194CALL GPPRE ( 1 ,1, 1, NFLEVG, VAH, VBH, ZPRES, ZPRESF )
195
196DO JK=0,NFLEVG
197  ZETAH(JK)= ZPRES(JK)/ZPRES(NFLEVG)
198ENDDO
199DO JK=1,NFLEVG
200  ZETA(JK)= ZPRESF(JK)/ZPRES(NFLEVG)
201ENDDO
202
203!     ------------------------------------------------------------------
204!*         1.     SETTING CONSTANTS FOR DIAGNOSTIC CLOUD SCHEME
205!                 ---------------------------------------------
206
207!CALL SUCLD ( NFLEVG , ZETA ) ! MPL 28.11.08
208
209!     ------------------------------------------------------------------
210
211!*         2.     SETTING CONSTANTS FOR LARGE-SCALE CONDENSATION SCHEME
212!                 -----------------------------------------------------
213
214!CALL SUCOND ( KULOUT , NFLEVG , ZETA ) ! MPL 28.11.08
215
216!     ------------------------------------------------------------------
217
218!*         3.     SETTING CONSTANTS FOR CONVECTION SCHEME
219!                 ---------------------------------------
220
221!CALL SUCUMF(ISMAX)     ! MPL 28.11.08
222
223!     ------------------------------------------------------------------
224
225!*         3.     SETTING CONSTANTS FOR NEW LINEARIZED CONVECTION SCHEME
226!                 ------------------------------------------------------
227
228!CALL SUCUMF2(ISMAX)  ! MPL 28.11.08
229
230!     ------------------------------------------------------------------
231!*         4.     SETTING CONSTANTS FOR GRAVITY WAVE DRAG SCHEME
232!                 ----------------------------------------------
233
234!CALL SUGWD (KULOUT, NFLEVG, VAH, VBH )   ! MPL 28.11.08
235
236!     ------------------------------------------------------------------
237
238!*         5.     SETTING CONSTANTS FOR VERTICAL DIFFUSION
239!                 ----------------------------------------
240
241!CALL SUVDFS     ! MPL 28.11.08
242
243!CALL SUVDF      ! MPL 28.11.08
244
245!cccc CALL SUVDFD ( NABLPFR, ABLPLL ) cccccccccccccccccccccccccccccccccc
246
247!     ------------------------------------------------------------------
248
249!*         6.     SETTING CONSTANTS FOR RADIATION SCHEME
250!                 --------------------------------------
251
252IF (LRAYFM15) THEN
253  CALL SUECRAD15 (KULOUT, NFLEVG, ZETAH )
254ELSE
255  CALL SUECRAD (KULOUT, NFLEVG, ZETAH )
256ENDIF
257
258!     ------------------------------------------------------------------
259!*         7.     SETTING CONSTANTS FOR SURFACE SCHEME
260!                 ------------------------------------
261
262!IF (LRAYFM15) THEN
263!   CALL SUSURF(KSW=NSW,KCSS=YSP_SBD%NLEVS,KSIL=NSIL,KTILES=NTILES,KTSW=NTSW,&
264!    & LD_LLCCNL=LCCNL,LD_LLCCNO=LCCNO,&
265!    & LD_LEOCWA=LEOCWA,LD_LEOCCO=LEOCCO,LD_LEOCSA=LEOCSA,LD_LLE4ALB=LE4ALB,&
266!    & LD_LSCMEC=LSCMEC,LD_LROUGH=LROUGH,PEXTZ0M=REXTZ0M,PEXTZ0H=REXTZ0H,&
267!    & PTHRFRTI=RTHRFRTI,PTSTAND=TSTAND,PXP=XP,PRCCNSEA=RCCNSEA,PRCCNLND=RCCNLND,&
268!    & PRSUN=RSUN15)
269!ELSE
270!   CALL SUSURF(KSW=NSW,KCSS=YSP_SBD%NLEVS,KSIL=NSIL,KTILES=NTILES,KTSW=NTSW,&
271!    & LD_LLCCNL=LCCNL,LD_LLCCNO=LCCNO,&
272!    & LD_LEOCWA=LEOCWA,LD_LEOCCO=LEOCCO,LD_LEOCSA=LEOCSA,LD_LLE4ALB=LE4ALB,&
273!    & LD_LSCMEC=LSCMEC,LD_LROUGH=LROUGH,PEXTZ0M=REXTZ0M,PEXTZ0H=REXTZ0H,&
274!    & PTHRFRTI=RTHRFRTI,PTSTAND=TSTAND,PXP=XP,PRCCNSEA=RCCNSEA,PRCCNLND=RCCNLND,&
275!    & PRSUN=RSUN)
276!ENDIF
277
278
279!CALL SURF_INQ(KNVTYPES=NVTYPES)
280
281
282!          7.1    Allocate working arrays
283!ALLOCATE(RUSTRTI(NPROMA,NTILES,NGPBLKS))
284!ALLOCATE(RVSTRTI(NPROMA,NTILES,NGPBLKS))
285!ALLOCATE(RAHFSTI(NPROMA,NTILES,NGPBLKS))
286!ALLOCATE(REVAPTI(NPROMA,NTILES,NGPBLKS))
287!ALLOCATE(RTSKTI (NPROMA,NTILES,NGPBLKS))
288!RUSTRTI(:,:,:) = 0.0_JPRB
289!RVSTRTI(:,:,:) = 0.0_JPRB
290!RAHFSTI(:,:,:) = 0.0_JPRB
291!REVAPTI(:,:,:) = 0.0_JPRB
292!RTSKTI (:,:,:) = 0.0_JPRB
293!CALL GSTATS(1811,1)
294
295!     ------------------------------------------------------------------
296
297!*         8.     SETTING CONSTANTS FOR CLOUD OPTICAL PROPERTIES
298!                 ----------------------------------------------
299
300IF (LRAYFM15) THEN
301  CALL SUCLOP15
302ELSE
303  CALL SUCLOP
304ENDIF
305
306!     ------------------------------------------------------------------
307
308!*         9.     SETTING CONSTANTS FOR PROGNOSTIC CLOUD SCHEME
309!                 ----------------------------------------------
310
311!CALL SUCLDP
312
313!     ------------------------------------------------------------------
314
315!*        10.     SETTING CONSTANTS FOR WAVE COUPLING
316!                 -----------------------------------
317
318!CALL SUWCOU
319
320!     ------------------------------------------------------------------
321!*         11.   SETTING CONSTANTS FOR LINEARIZED PHYSICS
322!                ----------------------------------------
323
324!CALL SUPHLI
325
326!     ------------------------------------------------------------------
327!*         12.   SETTING CONSTANTS FOR METHANE OXIDATION
328!                ---------------------------------------
329
330!CALL SUMETHOX
331
332!     ------------------------------------------------------------------
333
334WRITE(UNIT=KULOUT,FMT='('' SUPHEC IS OVER '')')
335
336!     ------------------------------------------------------------------
337
338IF (LHOOK) CALL DR_HOOK('SUPHEC',1,ZHOOK_HANDLE)
339END SUBROUTINE SUPHEC
Note: See TracBrowser for help on using the repository browser.