module_configure.F

References to this file elsewhere.
1 !WRF:DRIVER_LAYER:CONFIGURATION
2 !
3 MODULE module_configure
4 
5    USE module_driver_constants
6    USE module_state_description
7    USE module_wrf_error
8 
9    TYPE model_config_rec_type
10       SEQUENCE
11 ! Statements that declare namelist variables are in this file
12 ! Note that the namelist is SEQUENCE and generated such that the first item is an
13 ! integer, first_item_in_struct and the last is an integer last_item_in_struct
14 ! this provides a way of converting this to a buffer for passing to and from
15 ! the driver.
16 #include <namelist_defines.inc>
17    END TYPE model_config_rec_type
18 
19    TYPE grid_config_rec_type
20 #include <namelist_defines2.inc>
21    END TYPE grid_config_rec_type
22 
23    TYPE(model_config_rec_type) :: model_config_rec
24 
25 #include <scalar_tables.inc>
26 
27 ! special entries (put here but not enshrined in Registry for one reason or other)
28 
29    CHARACTER (LEN=4) :: mminlu = '    '         ! character string for landuse table
30 
31 CONTAINS
32 
33 
34 ! Model layer, even though it does I/O -- special case of namelist I/O.
35 
36    SUBROUTINE initial_config
37 !<DESCRIPTION>
38 ! This routine reads in the namelist.input file and sets
39 ! module_config_rec, a structure of TYPE(model_config_rec_type), which is is seen via USE association by any
40 ! subprogram that uses module_configure.  The module_config_rec structure
41 ! contains all namelist settings for all domains.  Variables that apply
42 ! to the entire run and have only one value regardless of domain are
43 ! scalars.  Variables that allow different settings for each domain are
44 ! defined as arrays of dimension max_domains (defined in
45 ! frame/module_driver_constants.F, from a setting passed in from
46 ! configure.wrf). There is another type in WRF, TYPE(grid_config_rec_type), in which
47 ! all fields pertain only to a single domain (and are all scalars). The subroutine
48 ! model_to_grid_config_rec(), also in frame/module_configure.F, is used to retrieve
49 ! the settings for a given domain from a TYPE(module_config_rec_type) and put them into
50 ! a TYPE(grid_config_rec_type), variables of which type are often called <em>config_flags</em>
51 ! in the WRF code.
52 ! 
53 ! Most of the code in this routine is generated from the Registry file
54 ! rconfig entries and included from the following files (found in the inc directory):
55 ! 
56 ! <pre>
57 ! namelist_defines.inc	declarations of namelist variables (local to this routine)
58 ! namelist_statements.inc	NAMELIST statements for each variable
59 ! namelist_defaults.inc	assignment to default values if specified in Registry
60 ! config_reads.inc		read statements for each namelist record
61 ! config_assigns.inc	assign each variable to field in module_config_rec
62 ! </pre>
63 !
64 !NOTE: generated subroutines from Registry file rconfig entries are renamed nl_
65 ! instead of rconfig_ due to length limits for subroutine names.
66 !
67 ! Note for version WRF 2.0: there is code here to force all domains to
68 ! have the same mp_physics setting. This is because different mp_physics
69 ! packages have different numbers of tracers but the nest forcing and
70 ! feedback code relies on the parent and nest having the same number and
71 ! kind of tracers. This means that the microphysics option
72 ! specified on the highest numbered domain is the microphysics
73 ! option for <em>all</em> domains in the run. This will be revisited.
74 ! 
75 !</DESCRIPTION>
76       IMPLICIT NONE
77 
78       INTEGER              :: io_status
79       INTEGER              :: i
80 
81       LOGICAL              :: nml_read_error
82 
83       CHARACTER (LEN=1024) :: nml_name
84 
85       INTEGER, PARAMETER :: nml_write_unit= 9
86       INTEGER, PARAMETER :: nml_read_unit = 10
87 
88 
89 ! define as temporaries
90 #include <namelist_defines.inc>
91 
92 ! Statements that specify the namelists
93 #include <namelist_statements.inc>
94 
95       OPEN ( UNIT   = nml_read_unit    ,      &
96              FILE   = "namelist.input" ,      &
97              FORM   = "FORMATTED"      ,      &
98              STATUS = "OLD"            ,      &
99              IOSTAT = io_status         )
100 
101       IF ( io_status .NE. 0 ) THEN
102         CALL WRF_ERROR_FATAL ( 'ERROR OPENING namelist.input' )
103       ENDIF
104 
105 #ifndef NO_NAMELIST_PRINT
106       OPEN ( UNIT   = nml_write_unit    ,      &
107              FILE   = "namelist.output" ,      &
108              FORM   = "FORMATTED"      ,      &
109              STATUS = "REPLACE"        ,      &
110              IOSTAT = io_status         )
111 
112       IF ( io_status .NE. 0 ) THEN
113         CALL WRF_ERROR_FATAL ( 'ERROR OPENING namelist.output' )
114       ENDIF
115 #endif
116 
117 ! Statements that set the namelist vars to default vals
118 #  include <namelist_defaults.inc>
119 
120 ! Statements that read the namelist are in this file
121 #  include <config_reads.inc>
122 
123 ! 2004/04/28  JM (with consensus by the group of developers)
124 ! This is needed to ensure that nesting will work, since
125 ! different mp_physics packages have different numbers of 
126 ! tracers. Basically, this says that the microphysics option
127 ! specified on the highest numbered domain *is* the microphysics
128 ! option for the run. Not the best solution but okay for 2.0.
129 !
130 
131       DO i = 1, max_dom
132          mp_physics(i) = mp_physics(max_dom)
133       ENDDO
134 
135 ! Statements that assign the variables to the cfg record are in this file
136 ! except the namelist_derived variables where are assigned below
137 #undef SOURCE_RECORD
138 #undef DEST_RECORD
139 #undef SOURCE_REC_DEX
140 #define SOURCE_RECORD 
141 #define DEST_RECORD model_config_rec %
142 #define SOURCE_REC_DEX
143 #include <config_assigns.inc>
144 
145       CLOSE ( UNIT = nml_read_unit , IOSTAT = io_status )
146 
147       IF ( io_status .NE. 0 ) THEN
148         CALL WRF_ERROR_FATAL ( 'ERROR CLOSING namelist.input' )
149       ENDIF
150 
151 #ifndef NO_NAMELIST_PRINT
152       CLOSE ( UNIT = nml_write_unit , IOSTAT = io_status )
153 
154       IF ( io_status .NE. 0 ) THEN
155         CALL WRF_ERROR_FATAL ( 'ERROR CLOSING namelist.output' )
156       ENDIF
157 #endif
158 
159       RETURN
160 
161    END SUBROUTINE initial_config
162 
163 #if 1
164    SUBROUTINE get_config_as_buffer( buffer, buflen, ncopied )
165 ! note that model_config_rec_type must be defined as a sequence derived type
166       INTEGER,   INTENT(INOUT) ::  buffer(*)
167       INTEGER,   INTENT(IN)    ::  buflen
168       INTEGER,   INTENT(OUT)   ::  ncopied
169 !      TYPE(model_config_rec_type) :: model_config_rec
170       INTEGER :: nbytes
171       CALL wrf_num_bytes_between ( model_config_rec%last_item_in_struct ,   &
172                                    model_config_rec%first_item_in_struct ,  &
173                                    nbytes )
174 !      nbytes = loc(model_config_rec%last_item_in_struct) - &
175 !               loc(model_config_rec%first_item_in_struct)
176       IF ( nbytes .gt. buflen ) THEN
177         CALL wrf_error_fatal( &
178         "get_config_rec_as_buffer: buffer size too small for config_rec" )
179       ENDIF
180       CALL wrf_mem_copy( model_config_rec, buffer, nbytes )
181       ncopied = nbytes
182       RETURN
183    END SUBROUTINE get_config_as_buffer
184 
185    SUBROUTINE set_config_as_buffer( buffer, buflen )
186 ! note that model_config_rec_type must be defined as a sequence derived type
187       INTEGER,   INTENT(INOUT) ::  buffer(*)
188       INTEGER,   INTENT(IN)    ::  buflen
189 !      TYPE(model_config_rec_type) :: model_config_rec
190       INTEGER :: nbytes
191       CALL wrf_num_bytes_between ( model_config_rec%last_item_in_struct ,  &
192                                    model_config_rec%first_item_in_struct , &
193                                    nbytes )
194 !      nbytes = loc(model_config_rec%last_item_in_struct) - &
195 !               loc(model_config_rec%first_item_in_struct)
196       IF ( nbytes .gt. buflen ) THEN
197         CALL wrf_error_fatal( &
198         "set_config_rec_as_buffer: buffer length too small to fill model config record" )
199       ENDIF
200       CALL wrf_mem_copy( buffer, model_config_rec, nbytes )
201       RETURN
202    END SUBROUTINE set_config_as_buffer
203 #else
204    SUBROUTINE get_config_as_buffer( buffer, buflen, ncopied )
205 ! note that model_config_rec_type must be defined as a sequence derived type
206       INTEGER*1, INTENT(INOUT) ::  buffer(*)
207       INTEGER,   INTENT(IN)    ::  buflen
208       INTEGER,   INTENT(OUT)   ::  ncopied
209 !      TYPE(model_config_rec_type) :: model_config_rec
210       INTEGER :: nbytes
211       nbytes = loc(model_config_rec%last_item_in_struct) - &
212                loc(model_config_rec%first_item_in_struct)
213       IF ( nbytes .gt. buflen ) THEN
214         CALL wrf_error_fatal( &
215         "get_config_rec_as_buffer: buffer size too small for config_rec" )
216       ENDIF
217       CALL wrf_mem_copy( model_config_rec, buffer, nbytes )
218       ncopied = nbytes
219       RETURN
220    END SUBROUTINE get_config_as_buffer
221 
222    SUBROUTINE set_config_as_buffer( buffer, buflen )
223 ! note that model_config_rec_type must be defined as a sequence derived type
224       INTEGER*1, INTENT(INOUT) ::  buffer(*)
225       INTEGER,   INTENT(IN)    ::  buflen
226 !      TYPE(model_config_rec_type) :: model_config_rec
227       INTEGER :: nbytes
228       nbytes = loc(model_config_rec%last_item_in_struct) - &
229                loc(model_config_rec%first_item_in_struct)
230       IF ( nbytes .gt. buflen ) THEN
231         CALL wrf_error_fatal( &
232         "set_config_rec_as_buffer: buffer length too small to fill model config record" )
233       ENDIF
234       CALL wrf_mem_copy( buffer, model_config_rec, nbytes )
235       RETURN
236    END SUBROUTINE set_config_as_buffer
237 #endif
238 
239    SUBROUTINE model_to_grid_config_rec ( id_id , model_config_rec , grid_config_rec )
240       INTEGER , INTENT(IN)                         ::  id_id
241       TYPE ( model_config_rec_type ) , INTENT(IN)  ::  model_config_rec
242       TYPE ( grid_config_rec_type  ) , INTENT(OUT) ::  grid_config_rec
243 ! <DESCRIPTION>
244 ! This routine is called to populate a domain specific configuration
245 ! record of TYPE(grid_config_rec_type) with the configuration information
246 ! for that domain that is stored in TYPE(model_config_rec). Both types
247 ! are defined in frame/module_configure.F.  The input argument is the
248 ! record of type model_config_rec_type contains the model-wide
249 ! configuration information (that is, settings that apply to the model in
250 ! general) and configuration information for each individual domain.  The
251 ! output argument is the record of type grid_config_rec_type which
252 ! contains the model-wide configuration information and the
253 ! domain-specific information for this domain only.  In the
254 ! model_config_rec, the domain specific information is arrays, indexed by
255 ! the grid id's.  In the grid_config_rec the domain-specific information
256 ! is scalar and for the specific domain.  The first argument to this
257 ! routine is the grid id (top-most domain is always 1) as specified in
258 ! the domain-specific namelist variable grid_id.
259 ! 
260 ! The actual assignments form the model_config_rec_type to the
261 ! grid_config_rec_type are generate from the rconfig entries in the
262 ! Registry file and included by this routine from the file
263 ! inc/config_assigns.inc.
264 !
265 !NOTE: generated subroutines from Registry file rconfig entries are renamed nl_
266 ! instead of rconfig_ due to length limits for subroutine names.
267 !
268 ! 
269 ! </DESCRIPTION>
270 #undef SOURCE_RECORD
271 #undef SOURCE_REC_DEX
272 #undef DEST_RECORD
273 #define SOURCE_RECORD model_config_rec %
274 #define SOURCE_REC_DEX (id_id)
275 #define DEST_RECORD   grid_config_rec %
276 #include <config_assigns.inc>
277    END SUBROUTINE model_to_grid_config_rec
278 
279 ! Include the definitions of all the routines that return a namelist values
280 ! back to the driver. These are generated by the registry
281 
282    SUBROUTINE init_module_configure
283      IMPLICIT NONE
284      ! Local vars
285 
286      INTEGER i , j
287 
288      DO j = 1, max_domains
289 #include <scalar_tables_init.inc>
290      END DO
291    END SUBROUTINE init_module_configure
292 
293 ! When the compiler has Intel Inside (TM) (that is, ifort), the large
294 ! number of nl_get and nl_set routines inside the module causes the
295 ! compiler to never finish with this routine. For ifort, move the
296 ! routines outside the module. Note, the registry generates a 
297 ! USE module_configure for all the nl_get and nl_set routines
298 ! if IFORT_KLUDGE is in effect.
299 #ifdef IFORT_KLUDGE
300 
301 END MODULE module_configure
302 
303 # include <get_nl_config.inc>
304 
305 #else
306 
307 # include <get_nl_config.inc>
308 
309 END MODULE module_configure
310 
311 #endif
312 
313 ! Special (outside registry)
314 SUBROUTINE nl_get_mminlu ( idum , retval )
315   USE module_configure
316   CHARACTER(LEN=4)  :: retval
317   INTEGER idum
318   retval(1:4) = mminlu(1:4)   ! mminlu is defined in module_configure
319   RETURN
320 END SUBROUTINE nl_get_mminlu
321 SUBROUTINE nl_set_mminlu ( idum, inval )
322   USE module_configure
323   CHARACTER(LEN=4) :: inval
324   INTEGER idum
325   mminlu(1:4) = inval(1:4)    ! mminlu is defined in module_configure
326   RETURN
327 END SUBROUTINE nl_set_mminlu
328 
329 
330 SUBROUTINE set_scalar_indices_from_config ( idomain , dummy2, dummy1 )
331   USE module_driver_constants
332   USE module_state_description
333   USE module_wrf_error
334   USE module_configure
335   IMPLICIT NONE
336   INTEGER , INTENT(IN)  :: idomain
337   INTEGER               :: dummy1
338   INTEGER               :: dummy2
339 
340 !<DESCRIPTION>
341 !This routine is called to adjust the integer variables that are defined
342 !in frame/module_state_description.F (Registry-generated) and that serve
343 !as indices into 4D tracer arrays for moisture, chemistry, etc.
344 !Different domains (different grid data structures) are allowed to have
345 !different sets of tracers so these indices can vary from domain to
346 !domain. However, since the indices are defined globally in
347 !module_state_description (a shortcoming in the current software), it is
348 !necessary that these indices be reset each time a different grid is to
349 !be computed on.
350 !
351 !The scalar idices are set according to the particular physics
352 !packages -- more specifically in the case of the moisture tracers, microphysics
353 !packages -- that are stored for each domain in model_config_rec and
354 !indexed by the grid id, passed in as an argument to this routine.  (The
355 !initial_config() routine in module_configure is what reads the
356 !namelist.input file and sets model_config_rec.)
357 !
358 !The actual code for calculating the scalar indices on a particular
359 !domain is generated from the Registry state array definitions for the
360 !4d tracers and from the package definitions that indicate which physics
361 !packages use which tracers.
362 !
363 !</DESCRIPTION>
364 
365 #include <scalar_indices.inc>
366 #include <scalar_indices_init.inc>
367   RETURN
368 END SUBROUTINE set_scalar_indices_from_config