source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/rrtm/suphec.F90 @ 5440

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

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM

Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence
  • 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
71USE 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
89
90IMPLICIT NONE
91
92include "clesphys.h"
93
94INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT
95INTERFACE
96#include "susurf.h"
97#include "surf_inq.h"
98END INTERFACE
99
100#include "gppre.intfb.h"
101#include "sucld.intfb.h"
102#include "sucldp.intfb.h"
103#include "suclop.intfb.h"
104#include "suclop15.intfb.h"
105#include "sucond.intfb.h"
106#include "sucumf.intfb.h"
107#include "sucumf2.intfb.h"
108#include "suecrad.intfb.h"
109#include "suecrad15.intfb.h"
110#include "sugwd.intfb.h"
111#include "sumethox.intfb.h"
112#include "suphli.intfb.h"
113#include "suvdf.intfb.h"
114#include "suvdfs.intfb.h"
115#include "suwcou.intfb.h"
116#include "dimensions.h"
117#include "comvert.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!!
170!! ATTENTION, il faut que ~dyn3d/comvert.h soit conforme au Fortran 90 !!
171!!
172ALLOCATE(VAH    (0:NFLEVG))  ! Ajout ALLOCATE MPL 200509
173ALLOCATE(VBH    (0:NFLEVG))
174ALLOCATE(VAF    (NFLEVG))
175ALLOCATE(VBF    (NFLEVG))
176! Commente par MPL 28.11.08, puis decommente le 19.05.09
177VP00=101325.     !!!!! A REVOIR (MPL)
178ZPRES(NFLEVG)=VP00
179! on recupere ap et bp de dyn3d (comvert.h) MPL 19.05.09
180! Attention, VAH et VBH sont inverses, comme les niveaux
181! plev(l)=PAPRS(klon,nlayer+1-l) de 1 a nlayer (apllmd.F)
182DO JLEV = 0, NFLEVG 
183!  VAH(JLEV)=ap(JLEV+1)ap(JLEV+1)
184!  VBH(JLEV)=bp(JLEV+1)
185!  print *,'SUPHEC: jlev ap bp',JLEV,ap(JLEV+1),bp(JLEV+1)
186   VAH(JLEV)=ap(NFLEVG+1-JLEV)
187   VBH(JLEV)=bp(NFLEVG+1-JLEV)
188ENDDO
189! Calcul de VAF et VBF, analogues de VAH et VBH mais aux niveaux pleins
190DO JLEV = 1, NFLEVG   
191   VAF(JLEV)=(VAH(JLEV)+VAH(JLEV-1))/2.
192   VBF(JLEV)=(VBH(JLEV)+VBH(JLEV-1))/2.
193ENDDO
194
195! Appel a GPPRE commente par MPL 28.11.08, puis decommente le 19.05.09
196CALL GPPRE ( 1 ,1, 1, NFLEVG, VAH, VBH, ZPRES, ZPRESF )
197
198DO JK=0,NFLEVG
199  ZETAH(JK)= ZPRES(JK)/ZPRES(NFLEVG)
200ENDDO
201DO JK=1,NFLEVG
202  ZETA(JK)= ZPRESF(JK)/ZPRES(NFLEVG)
203ENDDO
204
205!     ------------------------------------------------------------------
206!*         1.     SETTING CONSTANTS FOR DIAGNOSTIC CLOUD SCHEME
207!                 ---------------------------------------------
208
209!CALL SUCLD ( NFLEVG , ZETA ) ! MPL 28.11.08
210
211!     ------------------------------------------------------------------
212
213!*         2.     SETTING CONSTANTS FOR LARGE-SCALE CONDENSATION SCHEME
214!                 -----------------------------------------------------
215
216!CALL SUCOND ( KULOUT , NFLEVG , ZETA ) ! MPL 28.11.08
217
218!     ------------------------------------------------------------------
219
220!*         3.     SETTING CONSTANTS FOR CONVECTION SCHEME
221!                 ---------------------------------------
222
223!CALL SUCUMF(ISMAX)     ! MPL 28.11.08
224
225!     ------------------------------------------------------------------
226
227!*         3.     SETTING CONSTANTS FOR NEW LINEARIZED CONVECTION SCHEME
228!                 ------------------------------------------------------
229
230!CALL SUCUMF2(ISMAX)  ! MPL 28.11.08
231
232!     ------------------------------------------------------------------
233!*         4.     SETTING CONSTANTS FOR GRAVITY WAVE DRAG SCHEME
234!                 ----------------------------------------------
235
236!CALL SUGWD (KULOUT, NFLEVG, VAH, VBH )   ! MPL 28.11.08
237
238!     ------------------------------------------------------------------
239
240!*         5.     SETTING CONSTANTS FOR VERTICAL DIFFUSION
241!                 ----------------------------------------
242
243!CALL SUVDFS     ! MPL 28.11.08
244
245!CALL SUVDF      ! MPL 28.11.08
246
247!cccc CALL SUVDFD ( NABLPFR, ABLPLL ) cccccccccccccccccccccccccccccccccc
248
249!     ------------------------------------------------------------------
250
251!*         6.     SETTING CONSTANTS FOR RADIATION SCHEME
252!                 --------------------------------------
253
254IF (LRAYFM15) THEN
255  CALL SUECRAD15 (KULOUT, NFLEVG, ZETAH )
256ELSE
257  CALL SUECRAD (KULOUT, NFLEVG, ZETAH )
258ENDIF
259
260!     ------------------------------------------------------------------
261!*         7.     SETTING CONSTANTS FOR SURFACE SCHEME
262!                 ------------------------------------
263
264!IF (LRAYFM15) THEN
265!   CALL SUSURF(KSW=NSW,KCSS=YSP_SBD%NLEVS,KSIL=NSIL,KTILES=NTILES,KTSW=NTSW,&
266!    & LD_LLCCNL=LCCNL,LD_LLCCNO=LCCNO,&
267!    & LD_LEOCWA=LEOCWA,LD_LEOCCO=LEOCCO,LD_LEOCSA=LEOCSA,LD_LLE4ALB=LE4ALB,&
268!    & LD_LSCMEC=LSCMEC,LD_LROUGH=LROUGH,PEXTZ0M=REXTZ0M,PEXTZ0H=REXTZ0H,&
269!    & PTHRFRTI=RTHRFRTI,PTSTAND=TSTAND,PXP=XP,PRCCNSEA=RCCNSEA,PRCCNLND=RCCNLND,&
270!    & PRSUN=RSUN15)
271!ELSE
272!   CALL SUSURF(KSW=NSW,KCSS=YSP_SBD%NLEVS,KSIL=NSIL,KTILES=NTILES,KTSW=NTSW,&
273!    & LD_LLCCNL=LCCNL,LD_LLCCNO=LCCNO,&
274!    & LD_LEOCWA=LEOCWA,LD_LEOCCO=LEOCCO,LD_LEOCSA=LEOCSA,LD_LLE4ALB=LE4ALB,&
275!    & LD_LSCMEC=LSCMEC,LD_LROUGH=LROUGH,PEXTZ0M=REXTZ0M,PEXTZ0H=REXTZ0H,&
276!    & PTHRFRTI=RTHRFRTI,PTSTAND=TSTAND,PXP=XP,PRCCNSEA=RCCNSEA,PRCCNLND=RCCNLND,&
277!    & PRSUN=RSUN)
278!ENDIF
279
280
281!CALL SURF_INQ(KNVTYPES=NVTYPES)
282
283
284!          7.1    Allocate working arrays
285!ALLOCATE(RUSTRTI(NPROMA,NTILES,NGPBLKS))
286!ALLOCATE(RVSTRTI(NPROMA,NTILES,NGPBLKS))
287!ALLOCATE(RAHFSTI(NPROMA,NTILES,NGPBLKS))
288!ALLOCATE(REVAPTI(NPROMA,NTILES,NGPBLKS))
289!ALLOCATE(RTSKTI (NPROMA,NTILES,NGPBLKS))
290!RUSTRTI(:,:,:) = 0.0_JPRB
291!RVSTRTI(:,:,:) = 0.0_JPRB
292!RAHFSTI(:,:,:) = 0.0_JPRB
293!REVAPTI(:,:,:) = 0.0_JPRB
294!RTSKTI (:,:,:) = 0.0_JPRB
295!CALL GSTATS(1811,1)
296
297!     ------------------------------------------------------------------
298
299!*         8.     SETTING CONSTANTS FOR CLOUD OPTICAL PROPERTIES
300!                 ----------------------------------------------
301
302IF (LRAYFM15) THEN
303  CALL SUCLOP15
304ELSE
305  CALL SUCLOP
306ENDIF
307
308!     ------------------------------------------------------------------
309
310!*         9.     SETTING CONSTANTS FOR PROGNOSTIC CLOUD SCHEME
311!                 ----------------------------------------------
312
313!CALL SUCLDP
314
315!     ------------------------------------------------------------------
316
317!*        10.     SETTING CONSTANTS FOR WAVE COUPLING
318!                 -----------------------------------
319
320!CALL SUWCOU
321
322!     ------------------------------------------------------------------
323!*         11.   SETTING CONSTANTS FOR LINEARIZED PHYSICS
324!                ----------------------------------------
325
326!CALL SUPHLI
327
328!     ------------------------------------------------------------------
329!*         12.   SETTING CONSTANTS FOR METHANE OXIDATION
330!                ---------------------------------------
331
332!CALL SUMETHOX
333
334!     ------------------------------------------------------------------
335
336WRITE(UNIT=KULOUT,FMT='('' SUPHEC IS OVER '')')
337
338!     ------------------------------------------------------------------
339
340IF (LHOOK) CALL DR_HOOK('SUPHEC',1,ZHOOK_HANDLE)
341END SUBROUTINE SUPHEC
Note: See TracBrowser for help on using the repository browser.