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

Last change on this file since 5049 was 2839, checked in by Laurent Fairhead, 8 years ago

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