share/module_optional_input.F

   1 MODULE module_optional_input
   2
   3    INTEGER :: flag_metgrid  , flag_tavgsfc  , flag_psfc     , flag_soilhgt  , flag_mf_xy , flag_slp , &
   4               flag_snow     , flag_snowh    , flag_tsk      , flag_pinterp  , flag_prho
   5
   6    INTEGER :: flag_qv       , flag_qc       , flag_qr       , flag_qi       , flag_qs       , &
   7               flag_qg       , flag_qh       , &
   8               flag_qni      , flag_qnc      , flag_qnr      , &
   9               flag_qns      , flag_qng      , flag_qnh      , &
  10               flag_qnwfa2d  , flag_qnifa2d  , flag_qnbca2d  , flag_qnocbb2d , flag_qnbcbb2d , &
  11               flag_qnwfa    , flag_qnifa    , flag_qnbca    , &
  12               flag_qnwfa_cl , flag_qnifa_cl , flag_qnbca_cl , &
  13               flag_p_wif    , &
  14               flag_sh       , flag_speccldl , flag_speccldf
  15
  16    INTEGER :: flag_soil_levels, flag_soil_layers
  17
  18    INTEGER :: flag_st000010 , flag_st010040 , flag_st040100 , flag_st100200 , flag_st010200 , &
  19               flag_sm000010 , flag_sm010040 , flag_sm040100 , flag_sm100200 , flag_sm010200 , &
  20               flag_sw000010 , flag_sw010040 , flag_sw040100 , flag_sw100200 , flag_sw010200
  21
  22    INTEGER :: flag_st000007 , flag_st007028 , flag_st028100 , flag_st100255 , &
  23               flag_sm000007 , flag_sm007028 , flag_sm028100 , flag_sm100255
  24
  25    INTEGER :: flag_soilt000 , flag_soilt005 , flag_soilt020 , flag_soilt040 , flag_soilt160 , flag_soilt300 , &
  26               flag_soilm000 , flag_soilm005 , flag_soilm020 , flag_soilm040 , flag_soilm160 , flag_soilm300 , &
  27               flag_soilw000 , flag_soilw005 , flag_soilw020 , flag_soilw040 , flag_soilw160 , flag_soilw300
  28
  29    INTEGER :: flag_sst      , flag_toposoil
  30
  31    INTEGER :: flag_icedepth , flag_icefrac  , flag_albsi , flag_snowsi
  32
  33    INTEGER :: flag_ptheta
  34
  35    INTEGER :: flag_excluded_middle
  36
  37    INTEGER :: flag_um_soil
  38    INTEGER :: flag_icepct
  39
  40    INTEGER :: flag_hgtmaxw  , flag_pmaxw    , flag_tmaxw    , flag_umaxw    , flag_vmaxw     , &
  41               flag_hgttrop  , flag_ptrop    , flag_ttrop    , flag_utrop    , flag_vtrop
  42    INTEGER :: flag_pmaxwnn  , flag_ptropnn
  43    INTEGER :: flag_extra_levels
  44
  45    INTEGER :: flag_canfra   , flag_clayfrac   , flag_erod     , flag_frc_urb2d , flag_imperv , &
  46               flag_lai12m   , flag_lake_depth , flag_sandfrac , flag_urb_param , flag_var_sso, &
  47               flag_bathymetry
  48
  49    integer :: flag_cldmask, flag_cldbasez, flag_cldtopz, flag_brtemp
  50
  51    INTEGER                  :: num_soil_levels_input
  52    INTEGER                  :: num_st_levels_input , num_sm_levels_input , num_sw_levels_input
  53    INTEGER                  :: num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc
  54    INTEGER , DIMENSION(100) ::     st_levels_input ,     sm_levels_input ,     sw_levels_input
  55    REAL , ALLOCATABLE , DIMENSION(:,:,:) :: st_input , sm_input , sw_input
  56
  57    CHARACTER (LEN=80) , PRIVATE :: flag_name
  58
  59    LOGICAL :: already_been_here
  60
  61 CONTAINS
  62
  63 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  64
  65    SUBROUTINE init_module_optional_input ( grid , config_flags )
  66
  67       USE module_domain , ONLY : domain
  68       USE module_configure , ONLY : grid_config_rec_type
  69
  70       IMPLICIT NONE
  71
  72       TYPE ( domain ) :: grid
  73       TYPE (grid_config_rec_type) :: config_flags
  74
  75       INTEGER :: ids, ide, jds, jde, kds, kde, &
  76                  ims, ime, jms, jme, kms, kme, &
  77                  its, ite, jts, jte, kts, kte
  78
  79       !  Get the various indices, assume XYZ & XZY ordering.
  80 #if (EM_CORE==1)
  81       ids = grid%sd31 ; ide = grid%ed31 ;
  82       kds = grid%sd32 ; kde = grid%ed32 ;
  83       jds = grid%sd33 ; jde = grid%ed33 ;
  84
  85       ims = grid%sm31 ; ime = grid%em31 ;
  86       kms = grid%sm32 ; kme = grid%em32 ;
  87       jms = grid%sm33 ; jme = grid%em33 ;
  88
  89       its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
  90       kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
  91       jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
  92 #endif
  93       IF ( .NOT. already_been_here ) THEN
  94
  95          num_st_levels_alloc = config_flags%num_soil_layers * 3 ! used to be 2
  96          num_sm_levels_alloc = config_flags%num_soil_layers * 3
  97          num_sw_levels_alloc = config_flags%num_soil_layers * 3
  98
  99          IF ( ALLOCATED ( st_input ) ) DEALLOCATE ( st_input )
 100          IF ( ALLOCATED ( sm_input ) ) DEALLOCATE ( sm_input )
 101          IF ( ALLOCATED ( sw_input ) ) DEALLOCATE ( sw_input )
 102
 103          ALLOCATE ( st_input(ims:ime,num_st_levels_alloc,jms:jme) )
 104          ALLOCATE ( sm_input(ims:ime,num_sm_levels_alloc,jms:jme) )
 105          ALLOCATE ( sw_input(ims:ime,num_sw_levels_alloc,jms:jme) )
 106
 107       END IF
 108
 109       already_been_here = .TRUE.
 110
 111    END SUBROUTINE init_module_optional_input
 112
 113 #if (DA_CORE != 1)
 114 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 115
 116    SUBROUTINE optional_input ( grid , fid, config_flags )
 117
 118       USE module_io_domain
 119       USE module_configure       , ONLY : grid_config_rec_type
 120       USE module_domain , ONLY : domain
 121
 122       IMPLICIT NONE
 123
 124       TYPE ( domain ) :: grid
 125       TYPE (grid_config_rec_type) :: config_flags
 126       INTEGER , INTENT(IN) :: fid
 127
 128       INTEGER :: ids, ide, jds, jde, kds, kde, &
 129                  ims, ime, jms, jme, kms, kme, &
 130                  its, ite, jts, jte, kts, kte
 131
 132       INTEGER :: itmp , icnt , ierr, num_layers
 133       CHARACTER (LEN=132) :: message
 134
 135       !  Get the various indices, assume XYZ & XZY ordering.
 136 #if (EM_CORE==1)
 137       ids = grid%sd31 ; ide = grid%ed31 ;
 138       kds = grid%sd32 ; kde = grid%ed32 ;
 139       jds = grid%sd33 ; jde = grid%ed33 ;
 140
 141       ims = grid%sm31 ; ime = grid%em31 ;
 142       kms = grid%sm32 ; kme = grid%em32 ;
 143       jms = grid%sm33 ; jme = grid%em33 ;
 144
 145       its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
 146       kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
 147       jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
 148 #endif
 149
 150       CALL optional_tsk        ( grid , fid , &
 151                                  ids, ide, jds, jde, kds, kde, &
 152                                  ims, ime, jms, jme, kms, kme, &
 153                                  its, ite, jts, jte, kts, kte  )
 154
 155       CALL optional_tavgsfc    ( grid , fid , &
 156                                  ids, ide, jds, jde, kds, kde, &
 157                                  ims, ime, jms, jme, kms, kme, &
 158                                  its, ite, jts, jte, kts, kte  )
 159
 160       CALL optional_moist      ( grid , fid , &
 161                                  ids, ide, jds, jde, kds, kde, &
 162                                  ims, ime, jms, jme, kms, kme, &
 163                                  its, ite, jts, jte, kts, kte  )
 164
 165       CALL optional_metgrid    ( grid , fid , &
 166                                  ids, ide, jds, jde, kds, kde, &
 167                                  ims, ime, jms, jme, kms, kme, &
 168                                  its, ite, jts, jte, kts, kte  )
 169
 170       CALL optional_sst        ( grid , fid , &
 171                                  ids, ide, jds, jde, kds, kde, &
 172                                  ims, ime, jms, jme, kms, kme, &
 173                                  its, ite, jts, jte, kts, kte  )
 174
 175       CALL optional_snowh      ( grid , fid , &
 176                                  ids, ide, jds, jde, kds, kde, &
 177                                  ims, ime, jms, jme, kms, kme, &
 178                                  its, ite, jts, jte, kts, kte  )
 179
 180
 181       CALL optional_sfc        ( grid , fid , &
 182                                  ids, ide, jds, jde, kds, kde, &
 183                                  ims, ime, jms, jme, kms, kme, &
 184                                  its, ite, jts, jte, kts, kte  )
 185
 186       CALL optional_ice        ( grid , fid , &
 187                                  config_flags%seaice_albedo_opt , &
 188                                  config_flags%seaice_snowdepth_opt , &
 189                                  config_flags%seaice_thickness_opt , &
 190                                  ids, ide, jds, jde, kds, kde, &
 191                                  ims, ime, jms, jme, kms, kme, &
 192                                  its, ite, jts, jte, kts, kte  )
 193
 194       CALL optional_geogrid    ( grid , fid , &
 195                                  ids, ide, jds, jde, kds, kde, &
 196                                  ims, ime, jms, jme, kms, kme, &
 197                                  its, ite, jts, jte, kts, kte  )
 198
 199       CALL optional_ptheta     ( grid , fid , &
 200                                  ids, ide, jds, jde, kds, kde, &
 201                                  ims, ime, jms, jme, kms, kme, &
 202                                  its, ite, jts, jte, kts, kte  )
 203
 204       CALL optional_excl_middle( grid , fid , &
 205                                  ids, ide, jds, jde, kds, kde, &
 206                                  ims, ime, jms, jme, kms, kme, &
 207                                  its, ite, jts, jte, kts, kte  )
 208
 209       CALL optional_levels     ( grid , fid , &
 210                                  ids, ide, jds, jde, kds, kde, &
 211                                  ims, ime, jms, jme, kms, kme, &
 212                                  its, ite, jts, jte, kts, kte  )
 213
 214       flag_soil_levels = 0
 215       flag_soil_layers = 0
 216
 217       !  How many soil levels have we found?  Well, right now, none.
 218
 219       num_st_levels_input = 0
 220       num_sm_levels_input = 0
 221       num_sw_levels_input = 0
 222
 223       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_SOIL_LEVELS', itmp, 1, icnt, ierr )
 224
 225       IF ( ierr .EQ. 0 ) THEN
 226          flag_soil_levels = itmp
 227          write (message,'(A50,I3)') 'flag_soil_levels read from met_em file is',flag_soil_levels
 228          CALL wrf_debug(0,message)
 229       END IF
 230
 231       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_SOIL_LAYERS', itmp, 1, icnt, ierr )
 232
 233       IF ( ierr .EQ. 0 ) THEN
 234          flag_soil_layers = itmp
 235          write (message,'(A50,I3)') 'flag_soil_layers read from met_em file is',flag_soil_layers
 236          CALL wrf_debug(0,message)
 237       END IF
 238
 239 #if (EM_CORE == 1)
 240       IF ( ( flag_soil_levels == 1 ) .OR. ( flag_soil_layers == 1 ) ) THEN
 241
 242          num_st_levels_input   = config_flags%num_metgrid_soil_levels
 243          num_sm_levels_input   = config_flags%num_metgrid_soil_levels
 244          num_sw_levels_input   = config_flags%num_metgrid_soil_levels
 245          num_soil_levels_input = config_flags%num_metgrid_soil_levels
 246
 247       END IF
 248 #endif
 249
 250       IF (  ( model_config_rec%sf_surface_physics(grid%id) .EQ. 1 ) .OR. &
 251             ( model_config_rec%sf_surface_physics(grid%id) .EQ. 2 ) .OR. &
 252             ( model_config_rec%sf_surface_physics(grid%id) .EQ. 3 ) .OR. &
 253             ( model_config_rec%sf_surface_physics(grid%id) .EQ. 4 ) .OR. &
 254             ( model_config_rec%sf_surface_physics(grid%id) .EQ. 5 ) .OR. &
 255             ( model_config_rec%sf_surface_physics(grid%id) .EQ. 7 ) .OR. &
 256             ( model_config_rec%sf_surface_physics(grid%id) .EQ. 8 ) .OR. & !fds
 257             ( model_config_rec%sf_surface_physics(grid%id) .EQ. 88 ) ) THEN
 258
 259          CALL optional_lsm_levels ( grid , fid , &
 260                                     ids, ide, jds, jde, kds, kde, &
 261                                     ims, ime, jms, jme, kms, kme, &
 262                                     its, ite, jts, jte, kts, kte  )
 263       END IF
 264
 265    END SUBROUTINE optional_input
 266
 267 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 268
 269    SUBROUTINE optional_moist ( grid , fid , &
 270                                ids, ide, jds, jde, kds, kde, &
 271                                ims, ime, jms, jme, kms, kme, &
 272                                its, ite, jts, jte, kts, kte  )
 273
 274       USE module_io_wrf
 275       USE module_domain , ONLY : domain
 276
 277 USE module_configure , ONLY : grid_config_rec_type
 278 USE module_io_domain
 279
 280       IMPLICIT NONE
 281
 282       TYPE ( domain ) :: grid
 283       INTEGER , INTENT(IN) :: fid
 284
 285       INTEGER :: ids, ide, jds, jde, kds, kde, &
 286                  ims, ime, jms, jme, kms, kme, &
 287                  its, ite, jts, jte, kts, kte
 288
 289       INTEGER :: itmp , icnt , ierr
 290
 291       flag_name = '                                                                                '
 292
 293       flag_qv       = 0
 294       flag_qc       = 0
 295       flag_qr       = 0
 296       flag_qi       = 0
 297       flag_qs       = 0
 298       flag_qg       = 0
 299       flag_qh       = 0
 300       flag_qni      = 0
 301       flag_qnc      = 0
 302       flag_qnr      = 0
 303       flag_qns      = 0
 304       flag_qng      = 0
 305       flag_qnh      = 0
 306       flag_qnwfa2d  = 0
 307       flag_qnifa2d  = 0
 308       flag_qnbca2d  = 0
 309       flag_qnocbb2d = 0
 310       flag_qnbcbb2d = 0
 311       flag_qnwfa    = 0
 312       flag_qnifa    = 0
 313       flag_qnbca    = 0
 314       flag_qnwfa_cl = 0
 315       flag_qnifa_cl = 0
 316       flag_qnbca_cl = 0
 317       flag_p_wif    = 0
 318       flag_sh       = 0
 319       flag_speccldl = 0
 320       flag_speccldf = 0
 321       flag_cldmask  = 0
 322       flag_cldbasez = 0
 323       flag_cldtopz  = 0
 324       flag_brtemp   = 0
 325
 326       flag_name(1:8) = 'QV      '
 327       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 328       IF ( ierr .EQ. 0 ) THEN
 329          flag_qv       = itmp
 330       END IF
 331       flag_name(1:8) = 'QC      '
 332       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 333       IF ( ierr .EQ. 0 ) THEN
 334          flag_qc       = itmp
 335       END IF
 336       flag_name(1:8) = 'QR      '
 337       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 338       IF ( ierr .EQ. 0 ) THEN
 339          flag_qr       = itmp
 340       END IF
 341       flag_name(1:8) = 'QI      '
 342       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 343       IF ( ierr .EQ. 0 ) THEN
 344          flag_qi       = itmp
 345       END IF
 346       flag_name(1:8) = 'QS      '
 347       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 348       IF ( ierr .EQ. 0 ) THEN
 349          flag_qs       = itmp
 350       END IF
 351       flag_name(1:8) = 'QG      '
 352       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 353       IF ( ierr .EQ. 0 ) THEN
 354          flag_qg       = itmp
 355       END IF
 356       flag_name(1:8) = 'QH      '
 357       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 358       IF ( ierr .EQ. 0 ) THEN
 359          flag_qh       = itmp
 360       END IF
 361       flag_name(1:8) = 'QNI      '
 362       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 363       IF ( ierr .EQ. 0 ) THEN
 364          flag_qni       = itmp
 365       END IF
 366       flag_name(1:8) = 'QNC      '
 367       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 368       IF ( ierr .EQ. 0 ) THEN
 369          flag_qnc       = itmp
 370       END IF
 371       flag_name(1:8) = 'QNR      '
 372       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 373       IF ( ierr .EQ. 0 ) THEN
 374          flag_qnr       = itmp
 375       END IF
 376       flag_name(1:8) = 'QNS      '
 377       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 378       IF ( ierr .EQ. 0 ) THEN
 379          flag_qns       = itmp
 380       END IF
 381       flag_name(1:8) = 'QNG      '
 382       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 383       IF ( ierr .EQ. 0 ) THEN
 384          flag_qng       = itmp
 385       END IF
 386       flag_name(1:8) = 'QNH      '
 387       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 388       IF ( ierr .EQ. 0 ) THEN
 389          flag_qnh       = itmp
 390       END IF
 391       flag_name(1:8) = 'QNWFA2D '
 392       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 393       IF ( ierr .EQ. 0 ) THEN
 394          flag_qnwfa2d   = itmp
 395       END IF
 396       flag_name(1:8) = 'QNIFA2D '
 397       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 398       IF ( ierr .EQ. 0 ) THEN
 399          flag_qnifa2d   = itmp
 400       END IF
 401       flag_name(1:8) = 'QNBCA2D '
 402       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 403       IF ( ierr .EQ. 0 ) THEN
 404          flag_qnbca2d   = itmp
 405       END IF
 406       flag_name(1:8) = 'QNOCBB2D'
 407       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 408       IF ( ierr .EQ. 0 ) THEN
 409          flag_qnocbb2d   = itmp
 410       END IF
 411       flag_name(1:8) = 'QNBCBB2D'
 412       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 413       IF ( ierr .EQ. 0 ) THEN
 414          flag_qnbcbb2d   = itmp
 415       END IF
 416       flag_name(1:8) = 'QNWFA    '
 417       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 418       IF ( ierr .EQ. 0 ) THEN
 419          flag_qnwfa     = itmp
 420       END IF
 421       flag_name(1:8) = 'QNIFA    '
 422       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 423       IF ( ierr .EQ. 0 ) THEN
 424          flag_qnifa     = itmp
 425       END IF
 426       flag_name(1:8) = 'QNBCA    '
 427       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 428       IF ( ierr .EQ. 0 ) THEN
 429          flag_qnbca     = itmp
 430       END IF
 431       flag_name(1:8) = 'QNWFA_CL'
 432       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 433       IF ( ierr .EQ. 0 ) THEN
 434          flag_qnwfa_cl  = itmp
 435       END IF
 436       flag_name(1:8) = 'QNIFA_CL'
 437       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 438       IF ( ierr .EQ. 0 ) THEN
 439          flag_qnifa_cl  = itmp
 440       END IF
 441       flag_name(1:8) = 'QNBCA_CL'
 442       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 443       IF ( ierr .EQ. 0 ) THEN
 444          flag_qnbca_cl  = itmp
 445       END IF
 446       flag_name(1:8) = 'P_WIF   '
 447       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 448       IF ( ierr .EQ. 0 ) THEN
 449          flag_p_wif     = itmp
 450       END IF
 451       flag_name(1:8) = 'SH      '
 452       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 453       IF ( ierr .EQ. 0 ) THEN
 454          flag_sh       = itmp
 455       END IF
 456       flag_name(1:8) = 'SPECCLDL'
 457       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 458       IF ( ierr .EQ. 0 ) THEN
 459          flag_speccldl = itmp
 460       END IF
 461       flag_name(1:8) = 'SPECCLDF'
 462       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 463       IF ( ierr .EQ. 0 ) THEN
 464          flag_speccldf = itmp
 465       END IF
 466       flag_name(1:8) = 'CLDMASK '
 467       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 468       IF ( ierr .EQ. 0 ) THEN
 469          flag_cldmask = itmp
 470       END IF
 471       flag_name(1:8) = 'CLDBASEZ'
 472       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 473       IF ( ierr .EQ. 0 ) THEN
 474          flag_cldbasez = itmp
 475       END IF
 476       flag_name(1:8) = 'CLDTOPZ '
 477       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 478       IF ( ierr .EQ. 0 ) THEN
 479          flag_cldtopz = itmp
 480       END IF
 481       flag_name(1:8) = 'BRTEMP  '
 482       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 483       IF ( ierr .EQ. 0 ) THEN
 484          flag_brtemp = itmp
 485       END IF
 486
 487    END SUBROUTINE optional_moist
 488
 489 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 490
 491    SUBROUTINE optional_metgrid ( grid , fid , &
 492                                  ids, ide, jds, jde, kds, kde, &
 493                                  ims, ime, jms, jme, kms, kme, &
 494                                  its, ite, jts, jte, kts, kte  )
 495
 496       USE module_io_wrf
 497       USE module_domain , ONLY : domain
 498 USE module_configure , ONLY : grid_config_rec_type
 499 USE module_io_domain
 500
 501       IMPLICIT NONE
 502
 503       TYPE ( domain ) :: grid
 504       INTEGER , INTENT(IN) :: fid
 505
 506       INTEGER :: ids, ide, jds, jde, kds, kde, &
 507                  ims, ime, jms, jme, kms, kme, &
 508                  its, ite, jts, jte, kts, kte
 509
 510       INTEGER :: itmp , icnt , ierr
 511
 512       flag_name = '                                                                                '
 513
 514       flag_metgrid = 0
 515
 516       flag_name(1:8) = 'METGRID '
 517       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 518       IF ( ierr .EQ. 0 ) THEN
 519          flag_metgrid  = itmp
 520       END IF
 521
 522       flag_pinterp = 0
 523
 524       flag_name(1:8) = 'P_INTERP'
 525       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 526       IF ( ierr .EQ. 0 ) THEN
 527          flag_pinterp  = itmp
 528       END IF
 529
 530       flag_mf_xy = 0
 531
 532       flag_name(1:8) = 'MF_XY   '
 533       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 534       IF ( ierr .EQ. 0 ) THEN
 535          flag_mf_xy    = itmp
 536       END IF
 537
 538       grid%flag_metgrid = flag_metgrid
 539       grid%flag_mf_xy   = flag_mf_xy
 540    END SUBROUTINE optional_metgrid
 541
 542 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 543
 544    SUBROUTINE optional_sst ( grid , fid , &
 545                              ids, ide, jds, jde, kds, kde, &
 546                              ims, ime, jms, jme, kms, kme, &
 547                              its, ite, jts, jte, kts, kte  )
 548
 549       USE module_io_wrf
 550       USE module_domain , ONLY : domain
 551 USE module_configure , ONLY : grid_config_rec_type
 552 USE module_io_domain
 553
 554       IMPLICIT NONE
 555
 556       TYPE ( domain ) :: grid
 557       INTEGER , INTENT(IN) :: fid
 558
 559       INTEGER :: ids, ide, jds, jde, kds, kde, &
 560                  ims, ime, jms, jme, kms, kme, &
 561                  its, ite, jts, jte, kts, kte
 562
 563       INTEGER :: itmp , icnt , ierr
 564
 565       flag_name = '                                                                                '
 566
 567       flag_sst      = 0
 568
 569       flag_name(1:8) = 'SST     '
 570       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 571       IF ( ierr .EQ. 0 ) THEN
 572          flag_sst      = itmp
 573       END IF
 574
 575    END SUBROUTINE optional_sst
 576
 577 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 578
 579    SUBROUTINE optional_levels ( grid , fid , &
 580                                 ids, ide, jds, jde, kds, kde, &
 581                                 ims, ime, jms, jme, kms, kme, &
 582                                 its, ite, jts, jte, kts, kte  )
 583
 584       USE module_io_wrf
 585       USE module_domain , ONLY : domain
 586 USE module_configure , ONLY : grid_config_rec_type
 587 USE module_io_domain
 588
 589       IMPLICIT NONE
 590
 591       TYPE ( domain ) :: grid
 592       INTEGER , INTENT(IN) :: fid
 593
 594       INTEGER :: ids, ide, jds, jde, kds, kde, &
 595                  ims, ime, jms, jme, kms, kme, &
 596                  its, ite, jts, jte, kts, kte
 597
 598       INTEGER :: itmp , icnt , ierr
 599
 600       flag_name = '                                                                                '
 601
 602       flag_hgtmaxw  = 0
 603       flag_pmaxw    = 0
 604       flag_pmaxwnn  = 0
 605       flag_tmaxw    = 0
 606       flag_umaxw    = 0
 607       flag_vmaxw    = 0
 608       flag_hgttrop  = 0
 609       flag_ptrop    = 0
 610       flag_ptropnn  = 0
 611       flag_ttrop    = 0
 612       flag_utrop    = 0
 613       flag_vtrop    = 0
 614       flag_extra_levels = 0
 615
 616       flag_name(1:8) = 'HGTMAXW '
 617       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 618       IF ( ierr .EQ. 0 ) THEN
 619          flag_hgtmaxw  = itmp
 620       END IF
 621       flag_name(1:8) = 'PMAXW   '
 622       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 623       IF ( ierr .EQ. 0 ) THEN
 624          flag_pmaxw    = itmp
 625       END IF
 626       flag_name(1:8) = 'PMAXWNN '
 627       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 628       IF ( ierr .EQ. 0 ) THEN
 629          flag_pmaxwnn  = itmp
 630       END IF
 631       flag_name(1:8) = 'TMAXW   '
 632       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 633       IF ( ierr .EQ. 0 ) THEN
 634          flag_tmaxw    = itmp
 635       END IF
 636       flag_name(1:8) = 'UMAXW   '
 637       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 638       IF ( ierr .EQ. 0 ) THEN
 639          flag_umaxw    = itmp
 640       END IF
 641       flag_name(1:8) = 'VMAXW   '
 642       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 643       IF ( ierr .EQ. 0 ) THEN
 644          flag_vmaxw    = itmp
 645       END IF
 646       flag_name(1:8) = 'HGTTROP '
 647       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 648       IF ( ierr .EQ. 0 ) THEN
 649          flag_hgttrop  = itmp
 650       END IF
 651       flag_name(1:8) = 'PTROP   '
 652       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 653       IF ( ierr .EQ. 0 ) THEN
 654          flag_ptrop    = itmp
 655       END IF
 656       flag_name(1:8) = 'PTROPNN '
 657       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 658       IF ( ierr .EQ. 0 ) THEN
 659          flag_ptropnn  = itmp
 660       END IF
 661       flag_name(1:8) = 'TTROP   '
 662       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 663       IF ( ierr .EQ. 0 ) THEN
 664          flag_ttrop    = itmp
 665       END IF
 666       flag_name(1:8) = 'UTROP   '
 667       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 668       IF ( ierr .EQ. 0 ) THEN
 669          flag_utrop    = itmp
 670       END IF
 671       flag_name(1:8) = 'VTROP   '
 672       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 673       IF ( ierr .EQ. 0 ) THEN
 674          flag_vtrop    = itmp
 675       END IF
 676
 677       !  Newer versions of WPS supply a nearest-neighbor version of pressure and a
 678       !  pressure that is suitable for interpolation.  If the nearest neighbor is
 679       !  missing, all fields are set to unavailable.
 680
 681       IF ( flag_pmaxwnn .EQ. 0 ) THEN
 682          flag_hgtmaxw  = 0
 683          flag_pmaxw    = 0
 684          flag_tmaxw    = 0
 685          flag_umaxw    = 0
 686          flag_vmaxw    = 0
 687       END IF
 688
 689       IF ( flag_ptropnn .EQ. 0 ) THEN
 690          flag_hgttrop  = 0
 691          flag_ptrop    = 0
 692          flag_ttrop    = 0
 693          flag_utrop    = 0
 694          flag_vtrop    = 0
 695       END IF
 696
 697       flag_extra_levels = flag_hgtmaxw*flag_pmaxw*flag_tmaxw*flag_umaxw*flag_vmaxw* &
 698                           flag_hgttrop*flag_ptrop*flag_ttrop*flag_utrop*flag_vtrop
 699
 700    END SUBROUTINE optional_levels
 701
 702 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 703
 704
 705    SUBROUTINE optional_geogrid ( grid , fid , &
 706                                  ids, ide, jds, jde, kds, kde, &
 707                                  ims, ime, jms, jme, kms, kme, &
 708                                  its, ite, jts, jte, kts, kte  )
 709
 710       USE module_io_wrf
 711       USE module_domain , ONLY : domain
 712 USE module_configure , ONLY : grid_config_rec_type
 713 USE module_io_domain
 714
 715       IMPLICIT NONE
 716
 717       TYPE ( domain ) :: grid
 718       INTEGER , INTENT(IN) :: fid
 719
 720       INTEGER :: ids, ide, jds, jde, kds, kde, &
 721                  ims, ime, jms, jme, kms, kme, &
 722                  its, ite, jts, jte, kts, kte
 723
 724       INTEGER :: itmp , icnt , ierr
 725
 726       flag_name = '                                                                                '
 727
 728       flag_canfra          = 0
 729
 730       flag_name(1:6)  = 'CANFRA'
 731       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 732       IF ( ierr .EQ. 0 ) THEN
 733          flag_canfra          = itmp
 734       END IF
 735
 736
 737       flag_name = '                                                                                '
 738
 739       flag_clayfrac        = 0
 740
 741       flag_name(1:8)  = 'CLAYFRAC'
 742       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 743       IF ( ierr .EQ. 0 ) THEN
 744          flag_clayfrac        = itmp
 745       END IF
 746
 747
 748       flag_name = '                                                                                '
 749
 750       flag_erod            = 0
 751
 752       flag_name(1:4)  = 'EROD'
 753       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 754       IF ( ierr .EQ. 0 ) THEN
 755          flag_erod            = itmp
 756       END IF
 757
 758
 759       flag_name = '                                                                                '
 760
 761       flag_frc_urb2d       = 0
 762
 763       flag_name(1:9)  = 'FRC_URB2D'
 764       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 765       IF ( ierr .EQ. 0 ) THEN
 766          flag_frc_urb2d       = itmp
 767       END IF
 768
 769
 770       flag_name = '                                                                                '
 771
 772       flag_imperv          = 0
 773
 774       flag_name(1:6)  = 'IMPERV'
 775       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 776       IF ( ierr .EQ. 0 ) THEN
 777          flag_imperv          = itmp
 778       END IF
 779
 780
 781       flag_name = '                                                                                '
 782
 783       flag_lai12m          = 0
 784
 785       flag_name(1:6)  = 'LAI12M'
 786       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 787       IF ( ierr .EQ. 0 ) THEN
 788          flag_lai12m          = itmp
 789       END IF
 790
 791
 792       flag_name = '                                                                                '
 793
 794       flag_lake_depth      = 0
 795
 796       flag_name(1:10) = 'LAKE_DEPTH'
 797       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 798       IF ( ierr .EQ. 0 ) THEN
 799          flag_lake_depth      = itmp
 800       END IF
 801
 802       flag_name = '                                                                                '
 803
 804       flag_bathymetry      = 0
 805
 806       flag_name(1:10) = 'BATHYMETRY'
 807       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 808       IF ( ierr .EQ. 0 ) THEN
 809          flag_bathymetry      = itmp
 810       END IF
 811
 812
 813       flag_name = '                                                                                '
 814
 815       flag_sandfrac        = 0
 816
 817       flag_name(1:8)  = 'SANDFRAC'
 818       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 819       IF ( ierr .EQ. 0 ) THEN
 820          flag_sandfrac        = itmp
 821       END IF
 822
 823
 824       flag_name = '                                                                                '
 825
 826       flag_urb_param       = 0
 827
 828       flag_name(1:9)  = 'URB_PARAM'
 829       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 830       IF ( ierr .EQ. 0 ) THEN
 831          flag_urb_param       = itmp
 832       END IF
 833
 834
 835       flag_name = '                                                                                '
 836
 837       flag_var_sso         = 0
 838
 839       flag_name(1:7)  = 'VAR_SSO'
 840       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 841       IF ( ierr .EQ. 0 ) THEN
 842          flag_var_sso         = itmp
 843       END IF
 844
 845    END SUBROUTINE optional_geogrid
 846
 847 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 848
 849    SUBROUTINE optional_tsk     ( grid , fid , &
 850                                  ids, ide, jds, jde, kds, kde, &
 851                                  ims, ime, jms, jme, kms, kme, &
 852                                  its, ite, jts, jte, kts, kte  )
 853
 854       USE module_io_wrf
 855       USE module_domain , ONLY : domain
 856 USE module_configure , ONLY : grid_config_rec_type
 857 USE module_io_domain
 858
 859       IMPLICIT NONE
 860
 861       TYPE ( domain ) :: grid
 862       INTEGER , INTENT(IN) :: fid
 863
 864       INTEGER :: ids, ide, jds, jde, kds, kde, &
 865                  ims, ime, jms, jme, kms, kme, &
 866                  its, ite, jts, jte, kts, kte
 867
 868       INTEGER :: itmp , icnt , ierr
 869
 870       flag_name = '                                                                                '
 871
 872       flag_tsk      = 0
 873
 874       flag_name(1:8) = 'TSK     '
 875       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 876       IF ( ierr .EQ. 0 ) THEN
 877          flag_tsk      = itmp
 878       END IF
 879
 880    END SUBROUTINE optional_tsk
 881
 882 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 883
 884    SUBROUTINE optional_tavgsfc ( grid , fid , &
 885                                  ids, ide, jds, jde, kds, kde, &
 886                                  ims, ime, jms, jme, kms, kme, &
 887                                  its, ite, jts, jte, kts, kte  )
 888
 889       USE module_io_wrf
 890       USE module_domain , ONLY : domain
 891 USE module_configure , ONLY : grid_config_rec_type
 892 USE module_io_domain
 893
 894       IMPLICIT NONE
 895
 896       TYPE ( domain ) :: grid
 897       INTEGER , INTENT(IN) :: fid
 898
 899       INTEGER :: ids, ide, jds, jde, kds, kde, &
 900                  ims, ime, jms, jme, kms, kme, &
 901                  its, ite, jts, jte, kts, kte
 902
 903       INTEGER :: itmp , icnt , ierr
 904
 905       flag_name = '                                                                                '
 906
 907       flag_tavgsfc  = 0
 908
 909       flag_name(1:8) = 'TAVGSFC '
 910       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 911       IF ( ierr .EQ. 0 ) THEN
 912          flag_tavgsfc  = itmp
 913       END IF
 914
 915    END SUBROUTINE optional_tavgsfc
 916
 917 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 918
 919    SUBROUTINE optional_snowh ( grid , fid , &
 920                                ids, ide, jds, jde, kds, kde, &
 921                                ims, ime, jms, jme, kms, kme, &
 922                                its, ite, jts, jte, kts, kte  )
 923
 924       USE module_io_wrf
 925       USE module_domain , ONLY : domain
 926 USE module_configure , ONLY : grid_config_rec_type
 927 USE module_io_domain
 928
 929       IMPLICIT NONE
 930
 931       TYPE ( domain ) :: grid
 932       INTEGER , INTENT(IN) :: fid
 933
 934       INTEGER :: ids, ide, jds, jde, kds, kde, &
 935                  ims, ime, jms, jme, kms, kme, &
 936                  its, ite, jts, jte, kts, kte
 937
 938       INTEGER :: itmp , icnt , ierr
 939
 940       flag_name = '                                                                                '
 941
 942       flag_snowh    = 0
 943
 944       flag_name(1:8) = 'SNOWH   '
 945       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 946       IF ( ierr .EQ. 0 ) THEN
 947          flag_snowh    = itmp
 948       END IF
 949
 950       flag_snow     = 0
 951
 952       flag_name(1:8) = 'SNOW    '
 953       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 954       IF ( ierr .EQ. 0 ) THEN
 955          flag_snow     = itmp
 956       END IF
 957       grid%flag_snow = flag_snow
 958
 959    END SUBROUTINE optional_snowh
 960
 961 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 962
 963    SUBROUTINE optional_sfc ( grid , fid , &
 964                              ids, ide, jds, jde, kds, kde, &
 965                              ims, ime, jms, jme, kms, kme, &
 966                              its, ite, jts, jte, kts, kte  )
 967
 968       USE module_io_wrf
 969       USE module_domain , ONLY : domain
 970 USE module_configure , ONLY : grid_config_rec_type
 971 USE module_io_domain
 972
 973       IMPLICIT NONE
 974
 975       TYPE ( domain ) :: grid
 976       INTEGER , INTENT(IN) :: fid
 977
 978       INTEGER :: ids, ide, jds, jde, kds, kde, &
 979                  ims, ime, jms, jme, kms, kme, &
 980                  its, ite, jts, jte, kts, kte
 981
 982       INTEGER :: itmp , icnt , ierr
 983
 984       flag_name = '                                                                                '
 985
 986       flag_psfc     = 0
 987       flag_soilhgt  = 0
 988       flag_toposoil = 0
 989       flag_slp      = 0
 990
 991       flag_name(1:8) = 'TOPOSOIL'
 992       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 993       IF ( ierr .EQ. 0 ) THEN
 994          flag_toposoil = itmp
 995       END IF
 996
 997       flag_name(1:8) = 'PSFC    '
 998       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 999       IF ( ierr .EQ. 0 ) THEN
1000          flag_psfc     = itmp
1001       END IF
1002
1003       flag_name(1:8) = 'SOILHGT '
1004       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1005       IF ( ierr .EQ. 0 ) THEN
1006          flag_soilhgt  = itmp
1007       END IF
1008
1009       flag_name(1:8) = 'SLP     '
1010       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1011       IF ( ierr .EQ. 0 ) THEN
1012          flag_slp      = itmp
1013       END IF
1014
1015       flag_name(1:8) = 'UM_SOIL '
1016       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1017       IF ( ierr .EQ. 0 ) THEN
1018          flag_um_soil  = itmp
1019       END IF
1020
1021       grid%flag_soilhgt = flag_soilhgt
1022       grid%flag_slp     = flag_slp
1023       grid%flag_psfc    = flag_psfc
1024    END SUBROUTINE optional_sfc
1025
1026 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1027
1028    SUBROUTINE optional_ice ( grid , fid , &
1029                              seaice_albedo_opt , &
1030                              seaice_snowdepth_opt , &
1031                              seaice_thickness_opt , &
1032                              ids, ide, jds, jde, kds, kde, &
1033                              ims, ime, jms, jme, kms, kme, &
1034                              its, ite, jts, jte, kts, kte  )
1035
1036       USE module_io_wrf
1037       USE module_domain , ONLY : domain
1038       USE module_configure , ONLY : grid_config_rec_type
1039       USE module_io_domain
1040
1041       IMPLICIT NONE
1042
1043       TYPE ( domain ) :: grid
1044       INTEGER , INTENT(IN) :: fid
1045       INTEGER , INTENT(IN) :: seaice_albedo_opt
1046       INTEGER , INTENT(IN) :: seaice_snowdepth_opt
1047       INTEGER , INTENT(IN) :: seaice_thickness_opt
1048
1049       INTEGER :: ids, ide, jds, jde, kds, kde, &
1050                  ims, ime, jms, jme, kms, kme, &
1051                  its, ite, jts, jte, kts, kte
1052
1053       INTEGER :: itmp , icnt , ierr, i, j
1054
1055       flag_name = '                                                                                '
1056
1057       flag_icedepth = 0
1058       flag_icefrac  = 0
1059       flag_albsi    = 0
1060       flag_snowsi   = 0
1061
1062       flag_name(1:8) = 'ICEFRAC '
1063       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1064       IF ( ierr .EQ. 0 ) THEN
1065          flag_icefrac  = itmp
1066       END IF
1067
1068       flag_name(1:8) = 'ICEPCT  '
1069       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1070       IF ( ierr .EQ. 0 ) THEN
1071          flag_icepct  = itmp
1072       END IF
1073
1074       flag_name(1:8) = 'ICEDEPTH'
1075       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1076       IF ( ierr .EQ. 0 ) THEN
1077          flag_icedepth = itmp
1078       END IF
1079
1080       flag_name(1:8) = 'ALBSI   '
1081       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1082       IF ( ierr .EQ. 0 ) THEN
1083          flag_albsi  = itmp
1084       END IF
1085
1086       flag_name(1:8) = 'SNOWSI  '
1087       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1088       IF ( ierr .EQ. 0 ) THEN
1089          flag_snowsi  = itmp
1090       END IF
1091
1092       !
1093       !  Check that ICEDEPTH field is available for SEAICE_THICKNESS_OPT == 1
1094       !
1095       IF ( flag_icedepth == 0 ) THEN
1096           IF ( seaice_thickness_opt == 1 ) THEN
1097              call wrf_error_fatal("Field ICEDEPTH not found in input.  Field ICEDEPTH is required if SEAICE_THICKNESS_OPT=1")
1098              ! DO j = jts , MIN(jde-1,jte)
1099              !     DO i = its , MIN(ide-1,ite)
1100              !         grid%icedepth(i,j) = -1.E8
1101              !     ENDDO
1102              ! ENDDO
1103           ENDIF
1104       ENDIF
1105
1106       !
1107       !  Check that ALBSI field is available for SEAICE_ALBEDO_OPT == 2
1108       !
1109       IF ( flag_albsi == 0 ) THEN
1110           IF ( seaice_albedo_opt == 2 ) THEN
1111              call wrf_error_fatal("Field ALBSI not found in input.  Field ALBSI is required if SEAICE_ALBEDO_OPT=2")
1112              ! DO j = jts , MIN(jde-1,jte)
1113              !     DO i = its , MIN(ide-1,ite)
1114              !         grid%albsi(i,j) = -1.E8
1115              !     ENDDO
1116              ! ENDDO
1117           ENDIF
1118       ENDIF
1119
1120       !
1121       !  Check that SNOWSI field is available for SEAICE_SNOWDEPTH_OPT == 1
1122       !
1123       IF ( flag_snowsi == 0 ) THEN
1124           IF ( seaice_snowdepth_opt == 1 ) THEN
1125              call wrf_error_fatal("Field SNOWSI not found in input.  Field SNOWSI is required if SEAICE_SNOWDEPTH_OPT=1")
1126              ! DO j = jts , MIN(jde-1,jte)
1127              !     DO i = its , MIN(ide-1,ite)
1128              !         grid%snowsi(i,j) = -1.E8
1129              !     ENDDO
1130              ! ENDDO
1131           ENDIF
1132       ENDIF
1133
1134    END SUBROUTINE optional_ice
1135
1136 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1137
1138    SUBROUTINE optional_ptheta ( grid , fid , &
1139                                 ids, ide, jds, jde, kds, kde, &
1140                                 ims, ime, jms, jme, kms, kme, &
1141                                 its, ite, jts, jte, kts, kte  )
1142
1143       USE module_io_wrf
1144       USE module_domain , ONLY : domain
1145       USE module_configure , ONLY : grid_config_rec_type
1146       USE module_io_domain
1147
1148       IMPLICIT NONE
1149
1150       TYPE ( domain ) :: grid
1151       INTEGER , INTENT(IN) :: fid
1152
1153       INTEGER :: ids, ide, jds, jde, kds, kde, &
1154                  ims, ime, jms, jme, kms, kme, &
1155                  its, ite, jts, jte, kts, kte
1156
1157       INTEGER :: itmp , icnt , ierr
1158
1159       flag_name = '                                                                                '
1160
1161       flag_ptheta = 0
1162
1163       flag_name(1:8) = 'PTHETA  '
1164       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1165       IF ( ierr .EQ. 0 ) THEN
1166          flag_ptheta = itmp
1167       END IF
1168
1169       flag_name = '                                                                                '
1170
1171       flag_prho = 0
1172
1173       flag_name(1:8) = 'PRHO    '
1174       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1175       IF ( ierr .EQ. 0 ) THEN
1176          flag_prho = itmp
1177       END IF
1178
1179    END SUBROUTINE optional_ptheta
1180
1181 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1182
1183    SUBROUTINE optional_excl_middle ( grid , fid , &
1184                                      ids, ide, jds, jde, kds, kde, &
1185                                      ims, ime, jms, jme, kms, kme, &
1186                                      its, ite, jts, jte, kts, kte  )
1187
1188       USE module_io_wrf
1189       USE module_domain , ONLY : domain
1190       USE module_configure , ONLY : grid_config_rec_type
1191       USE module_io_domain
1192
1193       IMPLICIT NONE
1194
1195       TYPE ( domain ) :: grid
1196       INTEGER , INTENT(IN) :: fid
1197
1198       INTEGER :: ids, ide, jds, jde, kds, kde, &
1199                  ims, ime, jms, jme, kms, kme, &
1200                  its, ite, jts, jte, kts, kte
1201
1202       INTEGER :: itmp , icnt , ierr
1203
1204       flag_name = '                                                                                '
1205
1206       flag_excluded_middle = 0
1207
1208       flag_name(1:16) = 'EXCLUDED_MIDDLE '
1209       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1210       IF ( ierr .EQ. 0 ) THEN
1211          flag_excluded_middle = itmp
1212       END IF
1213
1214    END SUBROUTINE optional_excl_middle
1215
1216 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1217
1218    SUBROUTINE optional_lsm_levels ( grid , fid , &
1219                                     ids, ide, jds, jde, kds, kde, &
1220                                     ims, ime, jms, jme, kms, kme, &
1221                                     its, ite, jts, jte, kts, kte  )
1222
1223       USE module_io_wrf
1224       USE module_domain , ONLY : domain
1225       !USE module_configure , ONLY : grid_config_rec_type
1226       USE module_io_domain
1227
1228       IMPLICIT NONE
1229
1230       TYPE ( domain ) :: grid
1231       INTEGER , INTENT(IN) :: fid
1232
1233       INTEGER :: ids, ide, jds, jde, kds, kde, &
1234                  ims, ime, jms, jme, kms, kme, &
1235                  its, ite, jts, jte, kts, kte
1236
1237       INTEGER :: itmp , icnt , ierr , i , j , k
1238       INTEGER :: level_above
1239       CHARACTER (LEN=132) :: message
1240
1241       !  Initialize the soil temp and moisture flags to "field not found".
1242
1243       flag_name = '                                                                                '
1244
1245       flag_st000010 = 0
1246       flag_st010040 = 0
1247       flag_st040100 = 0
1248       flag_st100200 = 0
1249       flag_st010200 = 0
1250
1251       flag_sm000010 = 0
1252       flag_sm010040 = 0
1253       flag_sm040100 = 0
1254       flag_sm100200 = 0
1255       flag_sm010200 = 0
1256
1257       flag_sw000010 = 0
1258       flag_sw010040 = 0
1259       flag_sw040100 = 0
1260       flag_sw100200 = 0
1261       flag_sw010200 = 0
1262
1263       flag_st000007 = 0
1264       flag_st007028 = 0
1265       flag_st028100 = 0
1266       flag_st100255 = 0
1267
1268       flag_sm000007 = 0
1269       flag_sm007028 = 0
1270       flag_sm028100 = 0
1271       flag_sm100255 = 0
1272
1273       flag_soilt000 = 0
1274       flag_soilt005 = 0
1275       flag_soilt020 = 0
1276       flag_soilt040 = 0
1277       flag_soilt160 = 0
1278       flag_soilt300 = 0
1279
1280       flag_soilm000 = 0
1281       flag_soilm005 = 0
1282       flag_soilm020 = 0
1283       flag_soilm040 = 0
1284       flag_soilm160 = 0
1285       flag_soilm300 = 0
1286
1287       flag_soilw000 = 0
1288       flag_soilw005 = 0
1289       flag_soilw020 = 0
1290       flag_soilw040 = 0
1291       flag_soilw160 = 0
1292       flag_soilw300 = 0
1293
1294       st_levels_input = -1
1295       sm_levels_input = -1
1296       sw_levels_input = -1
1297
1298 #if (EM_CORE==1)
1299 !-------------------------------------------------------------------------
1300 ! NOTE:  We are assuming that soil_layers are the same for each grid point
1301 !-------------------------------------------------------------------------
1302       IF ( flag_soil_levels == 1 ) THEN
1303
1304          DO k = 1, num_st_levels_input
1305             st_levels_input(k) = grid%soil_levels(its,num_st_levels_input + 1 - k,jts)
1306             sm_levels_input(k) = grid%soil_levels(its,num_st_levels_input + 1 - k,jts)
1307             sw_levels_input(k) = grid%soil_levels(its,num_st_levels_input + 1 - k,jts)
1308          END DO
1309
1310          !----------------------------------------------------------------
1311          ! Flip the input soil temperature/moisture/water
1312          ! profiles upside down to make k=1 closest to the sfc
1313          !----------------------------------------------------------------
1314          DO j = jts , MIN(jde-1,jte)
1315             DO k = 1, num_st_levels_input
1316                DO i = its , MIN(ide-1,ite)
1317                   st_input(i,k,j) = grid%soilt(i,num_st_levels_input + 1 - k,j)
1318                   sm_input(i,k,j) = grid%soilm(i,num_st_levels_input + 1 - k,j)
1319                   !-------------------------------------------------------------------------
1320                   ! Initialize sw_input to 0. For 3D RUC soil moisture, there is no sw,
1321                   ! but num_sw_levels_input is set to num_metgrid_soil_levels from the
1322                   ! namelist causing sw_input to be used in init_soil_#_real subroutines
1323                   !-------------------------------------------------------------------------
1324                   sw_input(i,k,j) = 0.0
1325                END DO
1326             END DO
1327          END DO
1328
1329       END IF    ! flag_soil_levels == 1
1330
1331       IF ( flag_soil_layers == 1 ) THEN
1332          level_above = 0
1333          DO k = 1, num_st_levels_input
1334             !-------------------------------------------------------------
1335             ! Calculate mid-point of each layer and set to st_levels_input
1336             ! Flip the input soil depths upside down to make k=1 closest to the sfc
1337             !-------------------------------------------------------------
1338             !st_levels_input(k) = (level_above + grid%soil_layers(its,num_st_levels_input + 1 - k,jts))/2
1339             !sm_levels_input(k) = (level_above + grid%soil_layers(its,num_st_levels_input + 1 - k,jts))/2
1340             !sw_levels_input(k) = (level_above + grid%soil_layers(its,num_st_levels_input + 1 - k,jts))/2
1341             !level_above = grid%soil_layers(its,num_st_levels_input + 1 - k,jts)
1342             !-------------------------------------------------------------
1343             ! If UM soil input, levels are cumulative (0-10cm, 0-25cm,
1344             ! etc.) so we simply take the midpoint of each level - GAC
1345             !-------------------------------------------------------------
1346             IF ( flag_um_soil == 1 ) THEN
1347               st_levels_input(k) = (grid%soil_layers(its,num_st_levels_input + 1 - k,jts))/2
1348               sm_levels_input(k) = (grid%soil_layers(its,num_st_levels_input + 1 - k,jts))/2
1349               sw_levels_input(k) = (grid%soil_layers(its,num_st_levels_input + 1 - k,jts))/2
1350             ELSE
1351               st_levels_input(k) = (level_above + grid%soil_layers(its,num_st_levels_input + 1 - k,jts))/2
1352               sm_levels_input(k) = (level_above + grid%soil_layers(its,num_st_levels_input + 1 - k,jts))/2
1353               sw_levels_input(k) = (level_above + grid%soil_layers(its,num_st_levels_input + 1 - k,jts))/2
1354               level_above = grid%soil_layers(its,num_st_levels_input + 1 - k,jts)
1355             END IF
1356
1357          END DO
1358
1359          !----------------------------------------------------------------
1360          ! Flip the input soil temperature/moisture/water
1361          ! profiles upside down to make k=1 closest to the sfc
1362          !----------------------------------------------------------------
1363          DO j = jts , MIN(jde-1,jte)
1364             DO k = 1, num_st_levels_input
1365                DO i = its , MIN(ide-1,ite)
1366                   st_input(i,k+1,j) = grid%st(i,num_st_levels_input + 1 - k,j)
1367                   sm_input(i,k+1,j) = grid%sm(i,num_st_levels_input + 1 - k,j)
1368                   sw_input(i,k+1,j) = grid%sw(i,num_st_levels_input + 1 - k,j)
1369                END DO
1370             END DO
1371          END DO
1372
1373          !----------------------------------------------------------------
1374          ! UM input is in kg/m2, convert to volumetric soil moisture here
1375          !----------------------------------------------------------------
1376          IF ( flag_um_soil == 1 ) THEN
1377             DO j = jts, MIN(jde-1,jte)
1378                DO k = 1, num_sm_levels_input
1379                   DO i = its, MIN(ide-1,ite)
1380                     sm_input(i,k+1,j)=100.*sm_input(i,k+1,j)/(2*sm_levels_input(k)*1000.)
1381                   END DO
1382                END DO
1383             END DO
1384          END IF
1385
1386       END IF    ! flag_soil_layers == 1
1387 #endif
1388
1389       IF ( ( flag_soil_levels == 0 ) .AND. ( flag_soil_layers == 0 ) ) THEN        ! Legacy code
1390
1391          flag_name(1:8) = 'ST000010'
1392          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1393          IF ( ierr .EQ. 0 ) THEN
1394             flag_st000010 = itmp
1395             num_st_levels_input = num_st_levels_input + 1
1396             st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
1397             DO j = jts , MIN(jde-1,jte)
1398                DO i = its , MIN(ide-1,ite)
1399                   st_input(i,num_st_levels_input + 1,j) = grid%st000010(i,j)
1400                END DO
1401             END DO
1402          END IF
1403          flag_name(1:8) = 'ST010040'
1404          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1405          IF ( ierr .EQ. 0 ) THEN
1406             flag_st010040 = itmp
1407             num_st_levels_input = num_st_levels_input + 1
1408             st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
1409             DO j = jts , MIN(jde-1,jte)
1410                DO i = its , MIN(ide-1,ite)
1411                   st_input(i,num_st_levels_input + 1,j) = grid%st010040(i,j)
1412                END DO
1413             END DO
1414          END IF
1415          flag_name(1:8) = 'ST040100'
1416          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1417          IF ( ierr .EQ. 0 ) THEN
1418             flag_st040100 = itmp
1419             num_st_levels_input = num_st_levels_input + 1
1420             st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
1421             DO j = jts , MIN(jde-1,jte)
1422                DO i = its , MIN(ide-1,ite)
1423                   st_input(i,num_st_levels_input + 1,j) = grid%st040100(i,j)
1424                END DO
1425             END DO
1426          END IF
1427          flag_name(1:8) = 'ST100200'
1428          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1429          IF ( ierr .EQ. 0 ) THEN
1430             flag_st100200 = itmp
1431             num_st_levels_input = num_st_levels_input + 1
1432             st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
1433             DO j = jts , MIN(jde-1,jte)
1434                DO i = its , MIN(ide-1,ite)
1435                   st_input(i,num_st_levels_input + 1,j) = grid%st100200(i,j)
1436                END DO
1437             END DO
1438          END IF
1439          flag_name(1:8) = 'ST010200'
1440          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1441          IF ( ierr .EQ. 0 ) THEN
1442             flag_st010200 = itmp
1443             num_st_levels_input = num_st_levels_input + 1
1444             st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
1445             DO j = jts , MIN(jde-1,jte)
1446                DO i = its , MIN(ide-1,ite)
1447                   st_input(i,num_st_levels_input + 1,j) = grid%st010200(i,j)
1448                END DO
1449             END DO
1450          END IF
1451          flag_name(1:8) = 'ST000007'
1452          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1453          IF ( ierr .EQ. 0 ) THEN
1454             flag_st000007 = itmp
1455             num_st_levels_input = num_st_levels_input + 1
1456             st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
1457             DO j = jts , MIN(jde-1,jte)
1458                DO i = its , MIN(ide-1,ite)
1459                   st_input(i,num_st_levels_input + 1,j) = grid%st000007(i,j)
1460                END DO
1461             END DO
1462          END IF
1463          flag_name(1:8) = 'ST007028'
1464          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1465          IF ( ierr .EQ. 0 ) THEN
1466             flag_st007028 = itmp
1467             num_st_levels_input = num_st_levels_input + 1
1468             st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
1469             DO j = jts , MIN(jde-1,jte)
1470                DO i = its , MIN(ide-1,ite)
1471                   st_input(i,num_st_levels_input + 1,j) = grid%st007028(i,j)
1472                END DO
1473             END DO
1474          END IF
1475          flag_name(1:8) = 'ST028100'
1476          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1477          IF ( ierr .EQ. 0 ) THEN
1478             flag_st028100 = itmp
1479             num_st_levels_input = num_st_levels_input + 1
1480             st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
1481             DO j = jts , MIN(jde-1,jte)
1482                DO i = its , MIN(ide-1,ite)
1483                   st_input(i,num_st_levels_input + 1,j) = grid%st028100(i,j)
1484                END DO
1485             END DO
1486          END IF
1487          flag_name(1:8) = 'ST100255'
1488          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1489          IF ( ierr .EQ. 0 ) THEN
1490             flag_st100255 = itmp
1491             num_st_levels_input = num_st_levels_input + 1
1492             st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
1493             DO j = jts , MIN(jde-1,jte)
1494                DO i = its , MIN(ide-1,ite)
1495                   st_input(i,num_st_levels_input + 1,j) = grid%st100255(i,j)
1496                END DO
1497             END DO
1498          END IF
1499          flag_name(1:8) = 'SOILT000'
1500          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1501          IF ( ierr .EQ. 0 ) THEN
1502             flag_soilt000 = itmp
1503             num_st_levels_input = num_st_levels_input + 1
1504             st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
1505             DO j = jts , MIN(jde-1,jte)
1506                DO i = its , MIN(ide-1,ite)
1507                   st_input(i,num_st_levels_input ,j) = grid%soilt000(i,j)
1508                END DO
1509             END DO
1510          END IF
1511          flag_name(1:8) = 'SOILT005'
1512          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1513          IF ( ierr .EQ. 0 ) THEN
1514             flag_soilt005 = itmp
1515             num_st_levels_input = num_st_levels_input + 1
1516             st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
1517             DO j = jts , MIN(jde-1,jte)
1518                DO i = its , MIN(ide-1,ite)
1519                   st_input(i,num_st_levels_input ,j) = grid%soilt005(i,j)
1520                END DO
1521             END DO
1522          END IF
1523          flag_name(1:8) = 'SOILT020'
1524          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1525          IF ( ierr .EQ. 0 ) THEN
1526             flag_soilt020 = itmp
1527             num_st_levels_input = num_st_levels_input + 1
1528             st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
1529             DO j = jts , MIN(jde-1,jte)
1530                DO i = its , MIN(ide-1,ite)
1531                   st_input(i,num_st_levels_input ,j) = grid%soilt020(i,j)
1532                END DO
1533             END DO
1534          END IF
1535          flag_name(1:8) = 'SOILT040'
1536          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1537          IF ( ierr .EQ. 0 ) THEN
1538             flag_soilt040 = itmp
1539             num_st_levels_input = num_st_levels_input + 1
1540             st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
1541             DO j = jts , MIN(jde-1,jte)
1542                DO i = its , MIN(ide-1,ite)
1543                   st_input(i,num_st_levels_input ,j) = grid%soilt040(i,j)
1544                END DO
1545             END DO
1546          END IF
1547          flag_name(1:8) = 'SOILT160'
1548          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1549          IF ( ierr .EQ. 0 ) THEN
1550             flag_soilt160 = itmp
1551             num_st_levels_input = num_st_levels_input + 1
1552             st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
1553             DO j = jts , MIN(jde-1,jte)
1554                DO i = its , MIN(ide-1,ite)
1555                   st_input(i,num_st_levels_input ,j) = grid%soilt160(i,j)
1556                END DO
1557             END DO
1558          END IF
1559          flag_name(1:8) = 'SOILT300'
1560          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1561          IF ( ierr .EQ. 0 ) THEN
1562             flag_soilt300 = itmp
1563             num_st_levels_input = num_st_levels_input + 1
1564             st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
1565             DO j = jts , MIN(jde-1,jte)
1566                DO i = its , MIN(ide-1,ite)
1567                   st_input(i,num_st_levels_input ,j) = grid%soilt300(i,j)
1568                END DO
1569             END DO
1570          END IF
1571
1572          flag_name(1:8) = 'SM000010'
1573          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1574          IF ( ierr .EQ. 0 ) THEN
1575             flag_sm000010 = itmp
1576             num_sm_levels_input = num_sm_levels_input + 1
1577             sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
1578             DO j = jts , MIN(jde-1,jte)
1579                DO i = its , MIN(ide-1,ite)
1580                   sm_input(i,num_sm_levels_input + 1,j) = grid%sm000010(i,j)
1581                END DO
1582             END DO
1583          END IF
1584          flag_name(1:8) = 'SM010040'
1585          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1586          IF ( ierr .EQ. 0 ) THEN
1587             flag_sm010040 = itmp
1588             num_sm_levels_input = num_sm_levels_input + 1
1589             sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
1590             DO j = jts , MIN(jde-1,jte)
1591                DO i = its , MIN(ide-1,ite)
1592                   sm_input(i,num_sm_levels_input + 1,j) = grid%sm010040(i,j)
1593                END DO
1594             END DO
1595          END IF
1596          flag_name(1:8) = 'SM040100'
1597          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1598          IF ( ierr .EQ. 0 ) THEN
1599             flag_sm040100 = itmp
1600             num_sm_levels_input = num_sm_levels_input + 1
1601             sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
1602             DO j = jts , MIN(jde-1,jte)
1603                DO i = its , MIN(ide-1,ite)
1604                   sm_input(i,num_sm_levels_input + 1,j) = grid%sm040100(i,j)
1605                END DO
1606             END DO
1607          END IF
1608          flag_name(1:8) = 'SM100200'
1609          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1610          IF ( ierr .EQ. 0 ) THEN
1611             flag_sm100200 = itmp
1612             num_sm_levels_input = num_sm_levels_input + 1
1613             sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
1614             DO j = jts , MIN(jde-1,jte)
1615                DO i = its , MIN(ide-1,ite)
1616                   sm_input(i,num_sm_levels_input + 1,j) = grid%sm100200(i,j)
1617                END DO
1618             END DO
1619          END IF
1620          flag_name(1:8) = 'SM010200'
1621          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1622          IF ( ierr .EQ. 0 ) THEN
1623             flag_sm010200 = itmp
1624             num_sm_levels_input = num_sm_levels_input + 1
1625             sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
1626             DO j = jts , MIN(jde-1,jte)
1627                DO i = its , MIN(ide-1,ite)
1628                   sm_input(i,num_sm_levels_input + 1,j) = grid%sm010200(i,j)
1629                END DO
1630             END DO
1631          END IF
1632          flag_name(1:8) = 'SM000007'
1633          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1634          IF ( ierr .EQ. 0 ) THEN
1635             flag_sm000007 = itmp
1636             num_sm_levels_input = num_sm_levels_input + 1
1637             sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
1638             DO j = jts , MIN(jde-1,jte)
1639                DO i = its , MIN(ide-1,ite)
1640                   sm_input(i,num_sm_levels_input + 1,j) = grid%sm000007(i,j)
1641                END DO
1642             END DO
1643          END IF
1644          flag_name(1:8) = 'SM007028'
1645          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1646          IF ( ierr .EQ. 0 ) THEN
1647             flag_sm007028 = itmp
1648             num_sm_levels_input = num_sm_levels_input + 1
1649             sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
1650             DO j = jts , MIN(jde-1,jte)
1651                DO i = its , MIN(ide-1,ite)
1652                   sm_input(i,num_sm_levels_input + 1,j) = grid%sm007028(i,j)
1653                END DO
1654             END DO
1655          END IF
1656          flag_name(1:8) = 'SM028100'
1657          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1658          IF ( ierr .EQ. 0 ) THEN
1659             flag_sm028100 = itmp
1660             num_sm_levels_input = num_sm_levels_input + 1
1661             sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
1662             DO j = jts , MIN(jde-1,jte)
1663                DO i = its , MIN(ide-1,ite)
1664                   sm_input(i,num_sm_levels_input + 1,j) = grid%sm028100(i,j)
1665                END DO
1666             END DO
1667          END IF
1668          flag_name(1:8) = 'SM100255'
1669          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1670          IF ( ierr .EQ. 0 ) THEN
1671             flag_sm100255 = itmp
1672             num_sm_levels_input = num_sm_levels_input + 1
1673             sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
1674             DO j = jts , MIN(jde-1,jte)
1675                DO i = its , MIN(ide-1,ite)
1676                   sm_input(i,num_sm_levels_input + 1,j) = grid%sm100255(i,j)
1677                END DO
1678             END DO
1679          END IF
1680          flag_name(1:8) = 'SOILM000'
1681          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1682          IF ( ierr .EQ. 0 ) THEN
1683             flag_soilm000 = itmp
1684             num_sm_levels_input = num_sm_levels_input + 1
1685             sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
1686             DO j = jts , MIN(jde-1,jte)
1687                DO i = its , MIN(ide-1,ite)
1688                   sm_input(i,num_sm_levels_input ,j) = grid%soilm000(i,j)
1689                END DO
1690             END DO
1691          END IF
1692          flag_name(1:8) = 'SOILM005'
1693          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1694          IF ( ierr .EQ. 0 ) THEN
1695             flag_soilm005 = itmp
1696             num_sm_levels_input = num_sm_levels_input + 1
1697             sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
1698             DO j = jts , MIN(jde-1,jte)
1699                DO i = its , MIN(ide-1,ite)
1700                   sm_input(i,num_sm_levels_input ,j) = grid%soilm005(i,j)
1701                END DO
1702             END DO
1703          END IF
1704          flag_name(1:8) = 'SOILM020'
1705          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1706          IF ( ierr .EQ. 0 ) THEN
1707             flag_soilm020 = itmp
1708             num_sm_levels_input = num_sm_levels_input + 1
1709             sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
1710             DO j = jts , MIN(jde-1,jte)
1711                DO i = its , MIN(ide-1,ite)
1712                   sm_input(i,num_sm_levels_input ,j) = grid%soilm020(i,j)
1713                END DO
1714             END DO
1715          END IF
1716          flag_name(1:8) = 'SOILM040'
1717          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1718          IF ( ierr .EQ. 0 ) THEN
1719             flag_soilm040 = itmp
1720             num_sm_levels_input = num_sm_levels_input + 1
1721             sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
1722             DO j = jts , MIN(jde-1,jte)
1723                DO i = its , MIN(ide-1,ite)
1724                   sm_input(i,num_sm_levels_input ,j) = grid%soilm040(i,j)
1725                END DO
1726             END DO
1727          END IF
1728          flag_name(1:8) = 'SOILM160'
1729          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1730          IF ( ierr .EQ. 0 ) THEN
1731             flag_soilm160 = itmp
1732             num_sm_levels_input = num_sm_levels_input + 1
1733             sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
1734             DO j = jts , MIN(jde-1,jte)
1735                DO i = its , MIN(ide-1,ite)
1736                   sm_input(i,num_sm_levels_input ,j) = grid%soilm160(i,j)
1737                END DO
1738             END DO
1739          END IF
1740          flag_name(1:8) = 'SOILM300'
1741          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1742          IF ( ierr .EQ. 0 ) THEN
1743             flag_soilm300 = itmp
1744             num_sm_levels_input = num_sm_levels_input + 1
1745             sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
1746             DO j = jts , MIN(jde-1,jte)
1747                DO i = its , MIN(ide-1,ite)
1748                   sm_input(i,num_sm_levels_input ,j) = grid%soilm300(i,j)
1749                END DO
1750             END DO
1751          END IF
1752
1753          flag_name(1:8) = 'SW000010'
1754          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1755          IF ( ierr .EQ. 0 ) THEN
1756             flag_sw000010 = itmp
1757             num_sw_levels_input = num_sw_levels_input + 1
1758             sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
1759             DO j = jts , MIN(jde-1,jte)
1760                DO i = its , MIN(ide-1,ite)
1761                   sw_input(i,num_sw_levels_input + 1,j) = grid%sw000010(i,j)
1762                END DO
1763             END DO
1764          END IF
1765          flag_name(1:8) = 'SW010040'
1766          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1767          IF ( ierr .EQ. 0 ) THEN
1768             flag_sw010040 = itmp
1769             num_sw_levels_input = num_sw_levels_input + 1
1770             sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
1771             DO j = jts , MIN(jde-1,jte)
1772                DO i = its , MIN(ide-1,ite)
1773                   sw_input(i,num_sw_levels_input + 1,j) = grid%sw010040(i,j)
1774                END DO
1775             END DO
1776          END IF
1777          flag_name(1:8) = 'SW040100'
1778          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1779          IF ( ierr .EQ. 0 ) THEN
1780             flag_sw040100 = itmp
1781             num_sw_levels_input = num_sw_levels_input + 1
1782             sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
1783             DO j = jts , MIN(jde-1,jte)
1784                DO i = its , MIN(ide-1,ite)
1785                   sw_input(i,num_sw_levels_input + 1,j) = grid%sw040100(i,j)
1786                END DO
1787             END DO
1788          END IF
1789          flag_name(1:8) = 'SW100200'
1790          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1791          IF ( ierr .EQ. 0 ) THEN
1792             flag_sw100200 = itmp
1793             num_sw_levels_input = num_sw_levels_input + 1
1794             sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
1795             DO j = jts , MIN(jde-1,jte)
1796                DO i = its , MIN(ide-1,ite)
1797                   sw_input(i,num_sw_levels_input + 1,j) = grid%sw100200(i,j)
1798                END DO
1799             END DO
1800          END IF
1801          flag_name(1:8) = 'SW010200'
1802          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1803          IF ( ierr .EQ. 0 ) THEN
1804             flag_sw010200 = itmp
1805             num_sw_levels_input = num_sw_levels_input + 1
1806             sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
1807             DO j = jts , MIN(jde-1,jte)
1808                DO i = its , MIN(ide-1,ite)
1809                   sw_input(i,num_sw_levels_input + 1,j) = grid%sw010200(i,j)
1810                END DO
1811             END DO
1812          END IF
1813          flag_name(1:8) = 'SOILW000'
1814          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1815          IF ( ierr .EQ. 0 ) THEN
1816             flag_soilw000 = itmp
1817             num_sw_levels_input = num_sw_levels_input + 1
1818             sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
1819             DO j = jts , MIN(jde-1,jte)
1820                DO i = its , MIN(ide-1,ite)
1821                   sw_input(i,num_sw_levels_input ,j) = grid%soilw000(i,j)
1822                END DO
1823             END DO
1824          END IF
1825          flag_name(1:8) = 'SOILW005'
1826          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1827          IF ( ierr .EQ. 0 ) THEN
1828             flag_soilw005 = itmp
1829             num_sw_levels_input = num_sw_levels_input + 1
1830             sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
1831             DO j = jts , MIN(jde-1,jte)
1832                DO i = its , MIN(ide-1,ite)
1833                   sw_input(i,num_sw_levels_input ,j) = grid%soilw005(i,j)
1834                END DO
1835             END DO
1836          END IF
1837          flag_name(1:8) = 'SOILW020'
1838          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1839          IF ( ierr .EQ. 0 ) THEN
1840             flag_soilw020 = itmp
1841             num_sw_levels_input = num_sw_levels_input + 1
1842             sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
1843             DO j = jts , MIN(jde-1,jte)
1844                DO i = its , MIN(ide-1,ite)
1845                   sw_input(i,num_sw_levels_input ,j) = grid%soilw020(i,j)
1846                END DO
1847             END DO
1848          END IF
1849          flag_name(1:8) = 'SOILW040'
1850          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1851          IF ( ierr .EQ. 0 ) THEN
1852             flag_soilw040 = itmp
1853             num_sw_levels_input = num_sw_levels_input + 1
1854             sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
1855             DO j = jts , MIN(jde-1,jte)
1856                DO i = its , MIN(ide-1,ite)
1857                   sw_input(i,num_sw_levels_input ,j) = grid%soilw040(i,j)
1858                END DO
1859             END DO
1860          END IF
1861          flag_name(1:8) = 'SOILW160'
1862          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1863          IF ( ierr .EQ. 0 ) THEN
1864             flag_soilw160 = itmp
1865             num_sw_levels_input = num_sw_levels_input + 1
1866             sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
1867             DO j = jts , MIN(jde-1,jte)
1868                DO i = its , MIN(ide-1,ite)
1869                   sw_input(i,num_sw_levels_input ,j) = grid%soilw160(i,j)
1870                END DO
1871             END DO
1872          END IF
1873          flag_name(1:8) = 'SOILW300'
1874          CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
1875          IF ( ierr .EQ. 0 ) THEN
1876             flag_soilw300 = itmp
1877             num_sw_levels_input = num_sw_levels_input + 1
1878             sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
1879             DO j = jts , MIN(jde-1,jte)
1880                DO i = its , MIN(ide-1,ite)
1881                   sw_input(i,num_sw_levels_input ,j) = grid%soilw300(i,j)
1882                END DO
1883             END DO
1884          END IF
1885
1886       END IF       ! End of legacy code for temperature and moisture
1887
1888 ! The flags flag_st*, flag_sm*, flag_sw*, flag_soilt*, flag_soilm*, flag_soilw* are no longer used.
1889 ! If the new flags flag_soil_layers or flag_soil_levels are not set in met_em, and some legacy
1890 ! flags are, reset the new flags
1891
1892       IF ( ( flag_soil_levels == 0 ) .AND. ( flag_soil_layers == 0 ) ) THEN
1893          IF ( flag_st000010 == 1 .OR. flag_st010040 == 1 .OR. flag_st040100 == 1 .OR. &
1894               flag_st100200 == 1 .OR. flag_st010200 == 1 .OR. &
1895               flag_sm000010 == 1 .OR. flag_sm010040 == 1 .OR. flag_sm040100 == 1 .OR. &
1896               flag_sm100200 == 1 .OR. flag_sm010200 == 1 .OR. &
1897               flag_sw000010 == 1 .OR. flag_sw010040 == 1 .OR. flag_sw040100 == 1 .OR. &
1898               flag_sw100200 == 1 .OR. flag_sw010200 == 1 .OR. &
1899               flag_st000007 == 1 .OR. flag_st007028 == 1 .OR. flag_st028100 == 1 .OR. &
1900               flag_st100255 == 1 .OR. &
1901               flag_sm000007 == 1 .OR. flag_sm007028 == 1 .OR. flag_sm028100 == 1 .OR. &
1902               flag_sm100255 == 1 ) THEN
1903             flag_soil_layers=1
1904          END IF
1905          IF ( flag_soilt000 == 1 .OR. flag_soilt005 == 1 .OR. flag_soilt020 == 1 .OR. &
1906               flag_soilt040 == 1 .OR. flag_soilt160 == 1 .OR. flag_soilt300 == 1 .OR. &
1907               flag_soilm000 == 1 .OR. flag_soilm005 == 1 .OR. flag_soilm020 == 1 .OR. &
1908               flag_soilm040 == 1 .OR. flag_soilm160 == 1 .OR. flag_soilm300 == 1 .OR. &
1909               flag_soilw000 == 1 .OR. flag_soilw005 == 1 .OR. flag_soilw020 == 1 .OR. &
1910               flag_soilw040 == 1 .OR. flag_soilw160 == 1 .OR. flag_soilw300 == 1 ) THEN
1911             flag_soil_levels=1
1912          END IF
1913       END IF
1914
1915       write (message,'(A,I3)') 'flag_soil_layers at end of optional_lsm_levels is',flag_soil_layers
1916       CALL wrf_debug(1,message)
1917       write (message,'(A,I3)') 'flag_soil_levels at end of optional_lsm_levels is',flag_soil_levels
1918       CALL wrf_debug(1,message)
1919
1920       write (message,'(A,10(i3,1x))') 'st_levels_input = ', (st_levels_input(k), k=1,num_st_levels_input)
1921       CALL wrf_debug(1,message)
1922       write (message,'(A,10(i3,1x))') 'sm_levels_input = ', (sm_levels_input(k), k=1,num_sm_levels_input)
1923       CALL wrf_debug(1,message)
1924       write (message,'(A,10(i3,1x))') 'sw_levels_input = ', (sw_levels_input(k), k=1,num_sw_levels_input)
1925       CALL wrf_debug(1,message)
1926
1927       !  OK, let's do a quick sanity check.
1928
1929       IF ( ( num_st_levels_input .GT. num_st_levels_alloc ) .OR. &
1930            ( num_sm_levels_input .GT. num_sm_levels_alloc ) .OR. &
1931            ( num_sw_levels_input .GT. num_sw_levels_alloc ) ) THEN
1932          print *,'pain and woe, the soil level allocation is too small'
1933          CALL wrf_error_fatal ( 'soil_levels_too_few' )
1934       END IF
1935
1936    END SUBROUTINE optional_lsm_levels
1937
1938 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1939
1940    FUNCTION char2int1( string3 ) RESULT ( int1 )
1941       CHARACTER (LEN=3) , INTENT(IN) :: string3
1942       INTEGER :: i1 , int1
1943       READ(string3,fmt='(I3)') i1
1944       int1 = i1
1945    END FUNCTION char2int1
1946
1947 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1948
1949    FUNCTION char2int2( string6 ) RESULT ( int1 )
1950       CHARACTER (LEN=6) , INTENT(IN) :: string6
1951       INTEGER :: i2 , i1 , int1
1952       READ(string6,fmt='(I3,I3)') i1,i2
1953       int1 = ( i2 + i1 ) / 2
1954    END FUNCTION char2int2
1955
1956 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1957 #endif
1958 END MODULE module_optional_input