Newer
Older
!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
!-----------------------------------------------------------------
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source$ $Revision$
!-----------------------------------------------------------------
! #######################
PROGRAM PREP_IDEAL_CASE
! #######################
!
!!**** *PREP_IDEAL_CASE* - program to write an initial FM-file
!!
!! PURPOSE
!! -------
! The purpose of this program is to prepare an initial meso-NH file
! (LFIFM and DESFM files) filled with some idealized fields.
!
! ---- The present version can provide two types of fields:
!
! 1) CIDEAL = 'CSTN' : 3D fields derived from a vertical profile with
! --------------- n levels of constant moist Brunt Vaisala frequency
! The vertical profile is read in EXPRE file.
! These fields can be used for model runs
!
! 2) CIDEAL = 'RSOU' : 3D fields derived from a radiosounding.
! ---------------
! The radiosounding is read in EXPRE file.
! The following kind of data is permitted :
! YKIND = 'STANDARD' : Zsol, Psol, Tsol, TDsol
! (Pressure, dd, ff) ,
! (Pressure, T, Td)
! YKIND = 'PUVTHVMR' : zsol, Psol, Thvsol, Rsol
! (Pressure, U, V) ,
! (Pressure, THv, R)
! YKIND = 'PUVTHVHU' : zsol, Psol, Thvsol, Husol
! (Pressure, U, V) ,
! (Pressure, THv, Hu)
! YKIND = 'ZUVTHVHU' : zsol, Psol, Thvsol, Husol
! (height, U, V) ,
! (height, THv, Hu)
! YKIND = 'ZUVTHVMR' : zsol, Psol, Thvsol, Rsol
! (height, U, V) ,
! (height, THv, R)
! YKIND = 'PUVTHDMR' : zsol, Psol, Thdsol, Rsol
! (Pressure, U, V) ,
! (Pressure, THd, R)
! YKIND = 'PUVTHDHU' : zsol, Psol, Thdsol, Husol
! (Pressure, U, V) ,
! (Pressure, THd, Hu)
! YKIND = 'ZUVTHDMR' : zsol, Psol, Thdsol, Rsol
! (height, U, V) ,
! (height, THd, R)
! YKIND = 'ZUVTHLMR' : zsol, Psol, Thdsol, Rsol
! (height, U, V) ,
! (height, THl, Rt)
!
! These fields can be used for model runs
!
! Cases (1) and (2) can be balanced
! (geostrophic, hydrostatic and anelastic balances) if desired.
!
! ---- The orography can be flat (YZS='FLAT'), but also
! sine-shaped (YZS='SINE') or bell-shaped (YZS='BELL')
!
! ---- The U(z) profile given in the RSOU and CSTN cases can
! be multiplied (CUFUN="Y*Z") by a function of y (function FUNUY)
! The V(z) profile given in the RSOU and CSTN cases can
! be multiplied (CVFUN="X*Z") by a function of x (function FUNVX).
! If it is not the case, i.e. U(y,z)=U(z) then CUFUN="ZZZ" and
! CVFUN="ZZZ" for V(y,z)=V(z). Instead of these separable forms,
! non-separables functions FUNUYZ (CUFUN="Y,Z") and FUNVXZ (CVFUN="X,Z")
! can be used to specify the wind components.
!
!!** METHOD
!! ------
!! The directives and data to perform the preparation of the initial FM
!! file are stored in EXPRE file. This file is composed of two parts :
!! - a namelists-format part which is present in all cases
!! - a free-format part which contains data in cases
!! of discretised orography (CZS='DATA')
!! of radiosounding (CIDEAL='RSOU') or Nv=cste profile (CIDEAL='CSTN')
!! of forced version (LFORCING=.TRUE.)
!!
!!
!! The following PREP_IDEAL_CASE program :
!!
!! - initializes physical constants by calling INI_CST
!!
!! - sets default values for global variables which will be
!! written in DESFM file and for variables in EXPRE file (namelists part)
!! which will be written in LFIFM file.
!!
!! - reads the namelists part of EXPRE file which gives
!! informations about the preinitialization to perform,
!!
!! - allocates memory for arrays,
!!
!! - initializes fields depending on the
!! directives (CIDEAL in namelist NAM_CONF_PRE) :
!!
!! * grid variables :
!! The gridpoints are regularly spaced by XDELTAX, XDELTAY.
!! The grid is stretched along the z direction, the mesh varies
!! from XDZGRD near the ground to XDZTOP near the top and the
!! weigthing function is a TANH function characterized by its
!! center and width above and under this center
!! The orography is initialized following the kind of orography
!! (YZS in namelist NAM_CONF_PRE) and the degrees of freedom :
!! sine-shape ---> ZHMAX, IEXPX,IEXPY
!! bell-shape ---> ZHMAX, ZAX,ZAY,IIZS,IJZS
!! The horizontal grid variables are initialized following
!! the kind of geometry (LCARTESIAN in namelist NAM_CONF_PRE)
!! and the grid parameters XLAT0,XLON0,XBETA in both geometries
!! and XRPK,XLONORI,XLATORI in conformal projection.
!! In the case of initialization from a radiosounding, the
!! date and time is read in free-part of the EXPRE file. In other
!! cases year, month and day are set to NUNDEF and time to 0.
!!
!! * prognostic fields :
!!
!! U,V,W, Theta and r. are first determined. They are
!! multiplied by rhoj after the anelastic reference state
!! computation.
!! For the CSTN and RSOU cases, the determination of
!! Theta and rv is performed respectively by SET_RSOU
!! and by SET_CSTN which call the common routine SET_MASS.
!! These three routines have the following actions :
!! --- The input vertical profile is converted in
!! variables (U,V,thetav,r) and interpolated
!! on a mixed grid (with VERT_COORD) as in PREP_REAL_CASE
!! --- A variation of the u-wind component( x-model axis component)
!! is possible in y direction, a variation of the v-wind component
!! (y-model axis component) is possible in x direction.
!! --- Thetav could be computed with thermal wind balance
!! (LGEOSBAL=.TRUE. with call of SET_GEOSBAL)
!! --- The mass fields (theta and r ) and the wind components are
!! then interpolated on the model grid with orography as in
!! PREP_REAL_CASE with the option LSHIFT
!! --- An anelastic correction is applied in PRESSURE_IN_PREP in
!! the case of non-vanishing orography.
!!
!! * anelastic reference state variables :
!!
!! 1D reference state :
!! RSOU and CSTN cases : rhorefz and thvrefz are computed
!! by SET_REFZ (called by SET_MASS).
!! They are deduced from thetav and r on the model grid
!! without orography.
!! The 3D reference state is computed by SET_REF
!!
!! * The total mass of dry air is computed by TOTAL_DMASS
!!
!! - writes the DESFM file,
!!
!! - writes the LFIFM file .
!!
!! EXTERNAL
!! --------
!! DEFAULT_DESFM : to set default values for variables which can be
!! contained in DESFM file
!! DEFAULT_EXPRE : to set default values for other global variables
!! which can be contained in namelist-part of EXPRE file
!! Module MODE_GRIDPROJ : contains conformal projection routines
!! SM_GRIDPROJ : to compute some grid variables, in
!! case of conformal projection.
!! Module MODE_GRIDCART : contains cartesian geometry routines
!! SM_GRIDCART : to compute some grid variables, in
!! case of cartesian geometry.
!! SET_RSOU : to initialize mass fields from a radiosounding
!! SET_CSTN : to initialize mass fields from a vertical profile of
!! n layers of Nv=cste
!! SET_REF : to compute rhoJ
!! RESSURE_IN_PREP : to apply an anelastic correction in the case of
!! non-vanishing orography
!! FMOPEN : to open a FM-file (DESFM + LFIFM)
!! WRITE_DESFM : to write the DESFM file
!! WRI_LFIFM : to write the LFIFM file
!! FMCLOS : to close a FM-file (DESFM + LFIFM)
!!
!! MXM,MYM,MZM : Shuman operators
!! WGUESS : to compute W with the continuity equation from
!! the U,V values
!!
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_PARAMETERS : contains parameters
!! Module MODD_DIM1 : contains dimensions
!! Module MODD_CONF : contains configuration variables for
!! all models
!! Module MODD_CST : contains physical constants
!! Module MODD_GRID : contains grid variables for all models
!! Module MODD_GRID1 : contains grid variables
!! Module MODD_TIME : contains time variables for all models
!! Module MODD_TIME1 : contains time variables
!! Module MODD_REF : contains reference state variables for
Loading
Loading full blame...