wrfv2_fire/frame/module_configure.F

   1 !WRF:DRIVER_LAYER:CONFIGURATION
   2 !
   3
   4 MODULE module_scalar_tables
   5   USE module_driver_constants
   6   USE module_state_description
   7 #include <scalar_tables.inc>
   8 CONTAINS
   9   SUBROUTINE init_module_scalar_tables
  10      INTEGER i , j
  11      DO j = 1, max_domains
  12 #include <scalar_tables_init.inc>
  13      END DO
  14   END SUBROUTINE init_module_scalar_tables
  15 END MODULE module_scalar_tables
  16
  17 MODULE module_configure
  18
  19    USE module_driver_constants
  20    USE module_state_description
  21    USE module_wrf_error
  22
  23    TYPE model_config_rec_type
  24       SEQUENCE
  25 ! Statements that declare namelist variables are in this file
  26 ! Note that the namelist is SEQUENCE and generated such that the first item is an
  27 ! integer, first_item_in_struct and the last is an integer last_item_in_struct
  28 ! this provides a way of converting this to a buffer for passing to and from
  29 ! the driver.
  30 #include <namelist_defines.inc>
  31    END TYPE model_config_rec_type
  32
  33    TYPE grid_config_rec_type
  34 #include <namelist_defines2.inc>
  35    END TYPE grid_config_rec_type
  36
  37    TYPE(model_config_rec_type) :: model_config_rec
  38
  39 !#include <scalar_tables.inc>
  40
  41 ! special entries (put here but not enshrined in Registry for one reason or other)
  42
  43 !   CHARACTER (LEN=256) :: mminlu = ' '             ! character string for landuse table
  44
  45 CONTAINS
  46
  47
  48 ! Model layer, even though it does I/O -- special case of namelist I/O.
  49
  50    SUBROUTINE initial_config
  51 !<DESCRIPTION>
  52 ! This routine reads in the namelist.input file and sets
  53 ! module_config_rec, a structure of TYPE(model_config_rec_type), which is is seen via USE association by any
  54 ! subprogram that uses module_configure.  The module_config_rec structure
  55 ! contains all namelist settings for all domains.  Variables that apply
  56 ! to the entire run and have only one value regardless of domain are
  57 ! scalars.  Variables that allow different settings for each domain are
  58 ! defined as arrays of dimension max_domains (defined in
  59 ! frame/module_driver_constants.F, from a setting passed in from
  60 ! configure.wrf). There is another type in WRF, TYPE(grid_config_rec_type), in which
  61 ! all fields pertain only to a single domain (and are all scalars). The subroutine
  62 ! model_to_grid_config_rec(), also in frame/module_configure.F, is used to retrieve
  63 ! the settings for a given domain from a TYPE(module_config_rec_type) and put them into
  64 ! a TYPE(grid_config_rec_type), variables of which type are often called <em>config_flags</em>
  65 ! in the WRF code.
  66 !
  67 ! Most of the code in this routine is generated from the Registry file
  68 ! rconfig entries and included from the following files (found in the inc directory):
  69 !
  70 ! <pre>
  71 ! namelist_defines.inc  declarations of namelist variables (local to this routine)
  72 ! namelist_statements.inc       NAMELIST statements for each variable
  73 ! namelist_defaults.inc assignment to default values if specified in Registry
  74 ! config_reads.inc              read statements for each namelist record
  75 ! config_assigns.inc    assign each variable to field in module_config_rec
  76 ! </pre>
  77 !
  78 !NOTE: generated subroutines from Registry file rconfig entries are renamed nl_
  79 ! instead of rconfig_ due to length limits for subroutine names.
  80 !
  81 ! Note for version WRF 2.0: there is code here to force all domains to
  82 ! have the same mp_physics setting. This is because different mp_physics
  83 ! packages have different numbers of tracers but the nest forcing and
  84 ! feedback code relies on the parent and nest having the same number and
  85 ! kind of tracers. This means that the microphysics option
  86 ! specified on the highest numbered domain is the microphysics
  87 ! option for <em>all</em> domains in the run. This will be revisited.
  88 !
  89 !</DESCRIPTION>
  90       IMPLICIT NONE
  91
  92       INTEGER              :: io_status
  93       INTEGER              :: i
  94
  95       LOGICAL              :: nml_read_error
  96
  97       CHARACTER (LEN=1024) :: nml_name
  98
  99       INTEGER, PARAMETER :: nml_write_unit= 9
 100       INTEGER, PARAMETER :: nml_read_unit = 10
 101
 102
 103 ! define as temporaries
 104 #include <namelist_defines.inc>
 105
 106 ! Statements that specify the namelists
 107 #include <namelist_statements.inc>
 108
 109       OPEN ( UNIT   = nml_read_unit    ,      &
 110              FILE   = "namelist.input" ,      &
 111              FORM   = "FORMATTED"      ,      &
 112              STATUS = "OLD"            ,      &
 113              IOSTAT = io_status         )
 114
 115       IF ( io_status .NE. 0 ) THEN
 116         CALL WRF_ERROR_FATAL ( 'ERROR OPENING namelist.input' )
 117       ENDIF
 118
 119 #ifndef NO_NAMELIST_PRINT
 120       OPEN ( UNIT   = nml_write_unit    ,      &
 121              FILE   = "namelist.output" ,      &
 122              FORM   = "FORMATTED"      ,      &
 123              STATUS = "REPLACE"        ,      &
 124              IOSTAT = io_status         )
 125
 126       IF ( io_status .NE. 0 ) THEN
 127         CALL WRF_ERROR_FATAL ( 'ERROR OPENING namelist.output' )
 128       ENDIF
 129 #endif
 130
 131 ! Statements that set the namelist vars to default vals
 132 #  include <namelist_defaults.inc>
 133
 134 ! Statements that read the namelist are in this file
 135 #  include <config_reads.inc>
 136
 137 ! 2004/04/28  JM (with consensus by the group of developers)
 138 ! This is needed to ensure that nesting will work, since
 139 ! different mp_physics packages have different numbers of
 140 ! tracers. Basically, this says that the microphysics option
 141 ! specified on the highest numbered domain *is* the microphysics
 142 ! option for the run. Not the best solution but okay for 2.0.
 143 !
 144
 145       DO i = 1, max_dom
 146          mp_physics(i) = mp_physics(max_dom)
 147       ENDDO
 148
 149 ! Statements that assign the variables to the cfg record are in this file
 150 ! except the namelist_derived variables where are assigned below
 151 #undef SOURCE_RECORD
 152 #undef DEST_RECORD
 153 #undef SOURCE_REC_DEX
 154 #define SOURCE_RECORD
 155 #define DEST_RECORD model_config_rec %
 156 #define SOURCE_REC_DEX
 157 #include <config_assigns.inc>
 158
 159 #ifdef PLANET
 160 !***************** special conversion for timesteps *********************
 161 ! 2004-12-07 ADT Notes
 162 ! NB: P2SI needs to defined in multiple places.  Right now this
 163 ! requirement is a kludge, and if I can find something more elegant
 164 ! I will try to implement it later.
 165 !
 166 ! Beware: dt as the namelist timestep is now obsolete.  The new
 167 ! variable "timestep" (which is an *integer* number of seconds),
 168 ! with the (optional) additional specification of a fraction (to
 169 ! make non-integer timesteps) now acts as the true timestep.
 170 ! In share/set_timekeeping.F the integer(s) are converted to a real
 171 ! number and put back in dt anyway!
 172 ! We will deal with the case of the integer variables in
 173 ! share/set_timekeeping.F itself.  For now, since they left dt in
 174 ! the namelist definition, I will leave this here just in case ...
 175       model_config_rec%dt    = dt    * P2SI
 176 ! All of the following variables are told to be input in *MINUTES*
 177 ! These values are converted to units of timesteps in the various
 178 ! init routines in phys/module_physics_init.F by dividing by the
 179 ! formula STEP = (xxDT*60./dt).  So it seems safe to multiply them
 180 ! by P2SI here (with the exception of adding roundoff error later).
 181 ! See notes in phys/module_radiation_driver for the radt example.
 182       model_config_rec%radt  = radt  * P2SI
 183       model_config_rec%bldt  = bldt  * P2SI
 184       model_config_rec%cudt  = cudt  * P2SI
 185       model_config_rec%gsmdt = gsmdt * P2SI
 186 !************************************************************************
 187 #endif
 188
 189       CLOSE ( UNIT = nml_read_unit , IOSTAT = io_status )
 190
 191       IF ( io_status .NE. 0 ) THEN
 192         CALL WRF_ERROR_FATAL ( 'ERROR CLOSING namelist.input' )
 193       ENDIF
 194
 195 #ifndef NO_NAMELIST_PRINT
 196       CLOSE ( UNIT = nml_write_unit , IOSTAT = io_status )
 197
 198       IF ( io_status .NE. 0 ) THEN
 199         CALL WRF_ERROR_FATAL ( 'ERROR CLOSING namelist.output' )
 200       ENDIF
 201 #endif
 202
 203       RETURN
 204
 205    END SUBROUTINE initial_config
 206
 207 #if 1
 208    SUBROUTINE get_config_as_buffer( buffer, buflen, ncopied )
 209 ! note that model_config_rec_type must be defined as a sequence derived type
 210       INTEGER,   INTENT(INOUT) ::  buffer(*)
 211       INTEGER,   INTENT(IN)    ::  buflen
 212       INTEGER,   INTENT(OUT)   ::  ncopied
 213 !      TYPE(model_config_rec_type) :: model_config_rec
 214       INTEGER :: nbytes
 215       CALL wrf_num_bytes_between ( model_config_rec%last_item_in_struct ,   &
 216                                    model_config_rec%first_item_in_struct ,  &
 217                                    nbytes )
 218 !      nbytes = loc(model_config_rec%last_item_in_struct) - &
 219 !               loc(model_config_rec%first_item_in_struct)
 220       IF ( nbytes .gt. buflen ) THEN
 221         CALL wrf_error_fatal( &
 222         "get_config_rec_as_buffer: buffer size too small for config_rec" )
 223       ENDIF
 224       CALL wrf_mem_copy( model_config_rec, buffer, nbytes )
 225       ncopied = nbytes
 226       RETURN
 227    END SUBROUTINE get_config_as_buffer
 228
 229    SUBROUTINE set_config_as_buffer( buffer, buflen )
 230 ! note that model_config_rec_type must be defined as a sequence derived type
 231       INTEGER,   INTENT(INOUT) ::  buffer(*)
 232       INTEGER,   INTENT(IN)    ::  buflen
 233 !      TYPE(model_config_rec_type) :: model_config_rec
 234       INTEGER :: nbytes
 235       CALL wrf_num_bytes_between ( model_config_rec%last_item_in_struct ,  &
 236                                    model_config_rec%first_item_in_struct , &
 237                                    nbytes )
 238 !      nbytes = loc(model_config_rec%last_item_in_struct) - &
 239 !               loc(model_config_rec%first_item_in_struct)
 240       IF ( nbytes .gt. buflen ) THEN
 241         CALL wrf_error_fatal( &
 242         "set_config_rec_as_buffer: buffer length too small to fill model config record" )
 243       ENDIF
 244       CALL wrf_mem_copy( buffer, model_config_rec, nbytes )
 245       RETURN
 246    END SUBROUTINE set_config_as_buffer
 247 #else
 248    SUBROUTINE get_config_as_buffer( buffer, buflen, ncopied )
 249 ! note that model_config_rec_type must be defined as a sequence derived type
 250       INTEGER*1, INTENT(INOUT) ::  buffer(*)
 251       INTEGER,   INTENT(IN)    ::  buflen
 252       INTEGER,   INTENT(OUT)   ::  ncopied
 253 !      TYPE(model_config_rec_type) :: model_config_rec
 254       INTEGER :: nbytes
 255       nbytes = loc(model_config_rec%last_item_in_struct) - &
 256                loc(model_config_rec%first_item_in_struct)
 257       IF ( nbytes .gt. buflen ) THEN
 258         CALL wrf_error_fatal( &
 259         "get_config_rec_as_buffer: buffer size too small for config_rec" )
 260       ENDIF
 261       CALL wrf_mem_copy( model_config_rec, buffer, nbytes )
 262       ncopied = nbytes
 263       RETURN
 264    END SUBROUTINE get_config_as_buffer
 265
 266    SUBROUTINE set_config_as_buffer( buffer, buflen )
 267 ! note that model_config_rec_type must be defined as a sequence derived type
 268       INTEGER*1, INTENT(INOUT) ::  buffer(*)
 269       INTEGER,   INTENT(IN)    ::  buflen
 270 !      TYPE(model_config_rec_type) :: model_config_rec
 271       INTEGER :: nbytes
 272       nbytes = loc(model_config_rec%last_item_in_struct) - &
 273                loc(model_config_rec%first_item_in_struct)
 274       IF ( nbytes .gt. buflen ) THEN
 275         CALL wrf_error_fatal( &
 276         "set_config_rec_as_buffer: buffer length too small to fill model config record" )
 277       ENDIF
 278       CALL wrf_mem_copy( buffer, model_config_rec, nbytes )
 279       RETURN
 280    END SUBROUTINE set_config_as_buffer
 281 #endif
 282
 283    SUBROUTINE model_to_grid_config_rec ( id_id , model_config_rec , grid_config_rec )
 284       INTEGER , INTENT(IN)                         ::  id_id
 285       TYPE ( model_config_rec_type ) , INTENT(IN)  ::  model_config_rec
 286       TYPE ( grid_config_rec_type  ) , INTENT(OUT) ::  grid_config_rec
 287 ! <DESCRIPTION>
 288 ! This routine is called to populate a domain specific configuration
 289 ! record of TYPE(grid_config_rec_type) with the configuration information
 290 ! for that domain that is stored in TYPE(model_config_rec). Both types
 291 ! are defined in frame/module_configure.F.  The input argument is the
 292 ! record of type model_config_rec_type contains the model-wide
 293 ! configuration information (that is, settings that apply to the model in
 294 ! general) and configuration information for each individual domain.  The
 295 ! output argument is the record of type grid_config_rec_type which
 296 ! contains the model-wide configuration information and the
 297 ! domain-specific information for this domain only.  In the
 298 ! model_config_rec, the domain specific information is arrays, indexed by
 299 ! the grid id's.  In the grid_config_rec the domain-specific information
 300 ! is scalar and for the specific domain.  The first argument to this
 301 ! routine is the grid id (top-most domain is always 1) as specified in
 302 ! the domain-specific namelist variable grid_id.
 303 !
 304 ! The actual assignments form the model_config_rec_type to the
 305 ! grid_config_rec_type are generate from the rconfig entries in the
 306 ! Registry file and included by this routine from the file
 307 ! inc/config_assigns.inc.
 308 !
 309 !NOTE: generated subroutines from Registry file rconfig entries are renamed nl_
 310 ! instead of rconfig_ due to length limits for subroutine names.
 311 !
 312 !
 313 ! </DESCRIPTION>
 314 #undef SOURCE_RECORD
 315 #undef SOURCE_REC_DEX
 316 #undef DEST_RECORD
 317 #define SOURCE_RECORD model_config_rec %
 318 #define SOURCE_REC_DEX (id_id)
 319 #define DEST_RECORD   grid_config_rec %
 320 #include <config_assigns.inc>
 321    END SUBROUTINE model_to_grid_config_rec
 322
 323
 324    FUNCTION in_use_for_config ( id, vname ) RESULT ( in_use )
 325      INTEGER, INTENT(IN) :: id
 326      CHARACTER*(*), INTENT(IN) :: vname
 327      LOGICAL in_use
 328      INTEGER uses
 329
 330      uses = 0
 331      in_use = .TRUE.
 332
 333 #  include <in_use_for_config.inc>
 334
 335      RETURN
 336    END FUNCTION
 337
 338
 339 ! Include the definitions of all the routines that return a namelist values
 340 ! back to the driver. These are generated by the registry
 341
 342    SUBROUTINE init_module_configure
 343      USE module_scalar_tables
 344      IMPLICIT NONE
 345      CALL init_module_scalar_tables
 346    END SUBROUTINE init_module_configure
 347
 348    SUBROUTINE wrf_alt_nml_dynamics (nml_read_unit, nml_name)
 349 !
 350 !<DESCRIPTION>
 351 ! If there is an error reading the DYNAMICS namelist, this routine is
 352 ! called to check for namelist variables that have been removed by the
 353 ! developers and are still in user's namelists.
 354 !</DESCRIPTION>
 355 !
 356      IMPLICIT NONE
 357      INTEGER, INTENT(IN)       :: nml_read_unit
 358      CHARACTER*(*), INTENT(IN) :: nml_name
 359      INTEGER                   :: nml_error
 360
 361 #include <namelist_defines.inc>
 362 #include <namelist_statements.inc>
 363
 364 ! These are the variables that have been removed
 365      logical , DIMENSION(max_domains) :: pd_moist
 366      logical , DIMENSION(max_domains) :: pd_chem
 367      logical , DIMENSION(max_domains) :: pd_tke
 368      logical , DIMENSION(max_domains) :: pd_scalar
 369      NAMELIST /dynamics/ pd_moist
 370      NAMELIST /dynamics/ pd_chem
 371      NAMELIST /dynamics/ pd_tke
 372      NAMELIST /dynamics/ pd_scalar
 373
 374 ! Read the namelist again, if it succeeds after adding the above variables,
 375 ! it probably failed these are still in the namelist.  If it fails again, we
 376 ! will return.
 377
 378      REWIND ( UNIT = nml_read_unit )
 379      READ   ( UNIT = nml_read_unit , NML = dynamics , iostat=nml_error )
 380
 381      IF ( nml_error .EQ. 0 ) then    ! Successul, rm variables must be problem
 382         CALL wrf_debug(0, "Are pd_moist, pd_chem, pd_tke, or pd_scalar still in your "// &
 383                               TRIM(nml_name)//" namelist?")
 384         CALL wrf_error_fatal("Replace them with moist_adv_opt, chem_adv_opt, tke_adv_opt"// &
 385                              " and scalar_adv_opt, respectively.")
 386      ELSE     ! Still failed
 387         return
 388      ENDIF
 389
 390    END SUBROUTINE wrf_alt_nml_dynamics
 391
 392    SUBROUTINE wrf_alt_nml_physics (nml_read_unit, nml_name)
 393 !
 394 !<DESCRIPTION>
 395 ! If there is an error reading the PHYSICS namelist, this routine is
 396 ! called to check for namelist variables that have been removed by the
 397 ! developers and are still in user's namelists.
 398 !</DESCRIPTION>
 399 !
 400      IMPLICIT NONE
 401      INTEGER, INTENT(IN)       :: nml_read_unit
 402      CHARACTER*(*), INTENT(IN) :: nml_name
 403      INTEGER                   :: nml_error
 404
 405 #include <namelist_defines.inc>
 406 #include <namelist_statements.inc>
 407
 408 ! These are the variables that have been removed
 409      integer , DIMENSION(max_domains) :: ucmcall
 410      NAMELIST /physics/ ucmcall
 411
 412 ! Read the namelist again, if it succeeds after adding the above variables,
 413 ! it probably failed these are still in the namelist.  If it fails again, we
 414 ! will return.
 415
 416      REWIND ( UNIT = nml_read_unit )
 417      READ   ( UNIT = nml_read_unit , NML = physics , iostat=nml_error )
 418
 419      IF ( nml_error .EQ. 0 ) then    ! Successul, rm variables must be problem
 420         CALL wrf_debug(0,"Is ucmcall still in your "// TRIM(nml_name)//" namelist?")
 421         CALL wrf_error_fatal("Replace it with sf_urban_physics")
 422      ELSE     ! Still failed
 423         return
 424      ENDIF
 425
 426    END SUBROUTINE wrf_alt_nml_physics
 427
 428    SUBROUTINE wrf_alt_nml_fdda (nml_read_unit, nml_name)
 429 !
 430 !<DESCRIPTION>
 431 ! If there is an error reading the FDDA namelist, this routine is
 432 ! called to check for namelist variables that have been removed by the
 433 ! developers and are still in user's namelists.
 434 !</DESCRIPTION>
 435 !
 436      IMPLICIT NONE
 437      INTEGER, INTENT(IN)       :: nml_read_unit
 438      CHARACTER*(*), INTENT(IN) :: nml_name
 439      INTEGER                   :: nml_error
 440
 441 #include <namelist_defines.inc>
 442 #include <namelist_statements.inc>
 443
 444 ! These are the variables that have been removed
 445      integer , DIMENSION(max_domains) :: obs_nobs_prt
 446      NAMELIST /fdda/ obs_nobs_prt
 447
 448 ! Read the namelist again, if it succeeds after adding the above variables,
 449 ! it probably failed these are still in the namelist.  If it fails again, we
 450 ! will return.
 451
 452      REWIND ( UNIT = nml_read_unit )
 453      READ   ( UNIT = nml_read_unit , NML = fdda , iostat=nml_error )
 454
 455      IF ( nml_error .EQ. 0 ) then    ! Successul, rm variables must be problem
 456         CALL wrf_debug(0,"Is obs_nobs_prt still in your "// TRIM(nml_name)//" namelist?")
 457         CALL wrf_error_fatal("Replace it with obs_prt_max")
 458      ELSE     ! Still failed
 459         return
 460      ENDIF
 461
 462    END SUBROUTINE wrf_alt_nml_fdda
 463
 464 END MODULE module_configure
 465
 466
 467 SUBROUTINE set_scalar_indices_from_config ( idomain , dummy2, dummy1 )
 468   USE module_driver_constants
 469   USE module_state_description
 470   USE module_wrf_error
 471   USE module_configure, ONLY : model_config_rec
 472   USE module_scalar_tables
 473   IMPLICIT NONE
 474   INTEGER , INTENT(IN)  :: idomain
 475   INTEGER               :: dummy1
 476   INTEGER               :: dummy2
 477
 478 !<DESCRIPTION>
 479 !This routine is called to adjust the integer variables that are defined
 480 !in frame/module_state_description.F (Registry-generated) and that serve
 481 !as indices into 4D tracer arrays for moisture, chemistry, etc.
 482 !Different domains (different grid data structures) are allowed to have
 483 !different sets of tracers so these indices can vary from domain to
 484 !domain. However, since the indices are defined globally in
 485 !module_state_description (a shortcoming in the current software), it is
 486 !necessary that these indices be reset each time a different grid is to
 487 !be computed on.
 488 !
 489 !The scalar idices are set according to the particular physics
 490 !packages -- more specifically in the case of the moisture tracers, microphysics
 491 !packages -- that are stored for each domain in model_config_rec and
 492 !indexed by the grid id, passed in as an argument to this routine.  (The
 493 !initial_config() routine in module_configure is what reads the
 494 !namelist.input file and sets model_config_rec.)
 495 !
 496 !The actual code for calculating the scalar indices on a particular
 497 !domain is generated from the Registry state array definitions for the
 498 !4d tracers and from the package definitions that indicate which physics
 499 !packages use which tracers.
 500 !
 501 !</DESCRIPTION>
 502
 503 #include <scalar_indices.inc>
 504 #include <scalar_indices_init.inc>
 505   RETURN
 506 END SUBROUTINE set_scalar_indices_from_config
 507