wrfv2_fire/share/module_optional_si_input.F

   1 MODULE module_optional_si_input
   2
   3    INTEGER :: flag_metgrid  , flag_tavgsfc  , flag_psfc     , flag_soilhgt
   4
   5    INTEGER :: flag_qv       , flag_qc       , flag_qr       , flag_qi       , flag_qs       , flag_qg
   6
   7    INTEGER :: flag_st000010 , flag_st010040 , flag_st040100 , flag_st100200 , flag_st010200 , &
   8               flag_sm000010 , flag_sm010040 , flag_sm040100 , flag_sm100200 , flag_sm010200 , &
   9               flag_sw000010 , flag_sw010040 , flag_sw040100 , flag_sw100200 , flag_sw010200
  10
  11    INTEGER :: flag_st000007 , flag_st007028 , flag_st028100 , flag_st100255 , &
  12               flag_sm000007 , flag_sm007028 , flag_sm028100 , flag_sm100255
  13
  14    INTEGER :: flag_soilt000 , flag_soilt005 , flag_soilt020 , flag_soilt040 , flag_soilt160 , flag_soilt300 , &
  15               flag_soilm000 , flag_soilm005 , flag_soilm020 , flag_soilm040 , flag_soilm160 , flag_soilm300 , &
  16               flag_soilw000 , flag_soilw005 , flag_soilw020 , flag_soilw040 , flag_soilw160 , flag_soilw300
  17
  18    INTEGER :: flag_sst      , flag_toposoil , flag_snowh
  19
  20    INTEGER                  :: num_st_levels_input , num_sm_levels_input , num_sw_levels_input
  21    INTEGER                  :: num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc
  22    INTEGER , DIMENSION(100) ::     st_levels_input ,     sm_levels_input ,     sw_levels_input
  23    REAL , ALLOCATABLE , DIMENSION(:,:,:) :: st_input , sm_input , sw_input
  24
  25    CHARACTER (LEN=8) , PRIVATE :: flag_name
  26
  27    LOGICAL :: already_been_here
  28
  29 CONTAINS
  30
  31 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  32
  33    SUBROUTINE init_module_optional_si_input ( grid , config_flags )
  34
  35       USE module_domain
  36       USE module_configure
  37
  38       IMPLICIT NONE
  39
  40       TYPE ( domain ) :: grid
  41       TYPE (grid_config_rec_type) :: config_flags
  42
  43       INTEGER :: ids, ide, jds, jde, kds, kde, &
  44                  ims, ime, jms, jme, kms, kme, &
  45                  its, ite, jts, jte, kts, kte
  46
  47       !  Get the various indices, assume XZY ordering.
  48
  49       ids = grid%sd31 ; ide = grid%ed31 ;
  50       kds = grid%sd32 ; kde = grid%ed32 ;
  51       jds = grid%sd33 ; jde = grid%ed33 ;
  52
  53       ims = grid%sm31 ; ime = grid%em31 ;
  54       kms = grid%sm32 ; kme = grid%em32 ;
  55       jms = grid%sm33 ; jme = grid%em33 ;
  56
  57       its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
  58       kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
  59       jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
  60
  61       IF ( .NOT. already_been_here ) THEN
  62
  63          num_st_levels_alloc = config_flags%num_soil_layers * 3 ! used to be 2
  64          num_sm_levels_alloc = config_flags%num_soil_layers * 3
  65          num_sw_levels_alloc = config_flags%num_soil_layers * 3
  66
  67          IF ( ALLOCATED ( st_input ) ) DEALLOCATE ( st_input )
  68          IF ( ALLOCATED ( sm_input ) ) DEALLOCATE ( sm_input )
  69          IF ( ALLOCATED ( sw_input ) ) DEALLOCATE ( sw_input )
  70
  71          ALLOCATE ( st_input(ims:ime,num_st_levels_alloc,jms:jme) )
  72          ALLOCATE ( sm_input(ims:ime,num_sm_levels_alloc,jms:jme) )
  73          ALLOCATE ( sw_input(ims:ime,num_sw_levels_alloc,jms:jme) )
  74
  75       END IF
  76
  77       already_been_here = .TRUE.
  78
  79    END SUBROUTINE init_module_optional_si_input
  80
  81 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  82
  83    SUBROUTINE optional_si_input ( grid , fid )
  84
  85       USE module_configure
  86       USE module_domain
  87
  88       IMPLICIT NONE
  89
  90       TYPE ( domain ) :: grid
  91       INTEGER , INTENT(IN) :: fid
  92
  93       INTEGER :: ids, ide, jds, jde, kds, kde, &
  94                  ims, ime, jms, jme, kms, kme, &
  95                  its, ite, jts, jte, kts, kte
  96
  97       !  Get the various indices, assume XZY ordering.
  98
  99       ids = grid%sd31 ; ide = grid%ed31 ;
 100       kds = grid%sd32 ; kde = grid%ed32 ;
 101       jds = grid%sd33 ; jde = grid%ed33 ;
 102
 103       ims = grid%sm31 ; ime = grid%em31 ;
 104       kms = grid%sm32 ; kme = grid%em32 ;
 105       jms = grid%sm33 ; jme = grid%em33 ;
 106
 107       its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
 108       kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
 109       jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
 110
 111
 112       CALL optional_tavgsfc    ( grid , fid , &
 113                                  ids, ide, jds, jde, kds, kde, &
 114                                  ims, ime, jms, jme, kms, kme, &
 115                                  its, ite, jts, jte, kts, kte  )
 116
 117       CALL optional_moist      ( grid , fid , &
 118                                  ids, ide, jds, jde, kds, kde, &
 119                                  ims, ime, jms, jme, kms, kme, &
 120                                  its, ite, jts, jte, kts, kte  )
 121
 122       CALL optional_metgrid    ( grid , fid , &
 123                                  ids, ide, jds, jde, kds, kde, &
 124                                  ims, ime, jms, jme, kms, kme, &
 125                                  its, ite, jts, jte, kts, kte  )
 126
 127       CALL optional_sst        ( grid , fid , &
 128                                  ids, ide, jds, jde, kds, kde, &
 129                                  ims, ime, jms, jme, kms, kme, &
 130                                  its, ite, jts, jte, kts, kte  )
 131
 132       CALL optional_snowh      ( grid , fid , &
 133                                  ids, ide, jds, jde, kds, kde, &
 134                                  ims, ime, jms, jme, kms, kme, &
 135                                  its, ite, jts, jte, kts, kte  )
 136
 137       IF (  ( model_config_rec%sf_surface_physics(grid%id) .EQ. 1 ) .OR. &
 138             ( model_config_rec%sf_surface_physics(grid%id) .EQ. 2 ) .OR. &
 139             ( model_config_rec%sf_surface_physics(grid%id) .EQ. 3 ) .OR. &
 140             ( model_config_rec%sf_surface_physics(grid%id) .EQ. 99 ) ) THEN
 141
 142          CALL optional_lsm        ( grid , fid , &
 143                                     ids, ide, jds, jde, kds, kde, &
 144                                     ims, ime, jms, jme, kms, kme, &
 145                                     its, ite, jts, jte, kts, kte  )
 146
 147          CALL optional_lsm_levels ( grid , fid , &
 148                                     ids, ide, jds, jde, kds, kde, &
 149                                     ims, ime, jms, jme, kms, kme, &
 150                                     its, ite, jts, jte, kts, kte  )
 151       END IF
 152
 153    END SUBROUTINE optional_si_input
 154
 155 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 156
 157    SUBROUTINE optional_moist ( grid , fid , &
 158                                ids, ide, jds, jde, kds, kde, &
 159                                ims, ime, jms, jme, kms, kme, &
 160                                its, ite, jts, jte, kts, kte  )
 161
 162       USE module_io_wrf
 163       USE module_domain
 164
 165 USE module_configure
 166 USE module_io_domain
 167
 168       IMPLICIT NONE
 169
 170       TYPE ( domain ) :: grid
 171       INTEGER , INTENT(IN) :: fid
 172
 173       INTEGER :: ids, ide, jds, jde, kds, kde, &
 174                  ims, ime, jms, jme, kms, kme, &
 175                  its, ite, jts, jte, kts, kte
 176
 177       INTEGER :: itmp , icnt , ierr
 178
 179       flag_qv       = 0
 180       flag_qc       = 0
 181       flag_qr       = 0
 182       flag_qi       = 0
 183       flag_qs       = 0
 184       flag_qg       = 0
 185
 186       flag_name(1:8) = 'QV      '
 187       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 188       IF ( ierr .EQ. 0 ) THEN
 189          flag_qv       = itmp
 190       END IF
 191       flag_name(1:8) = 'QC      '
 192       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 193       IF ( ierr .EQ. 0 ) THEN
 194          flag_qc       = itmp
 195       END IF
 196       flag_name(1:8) = 'QR      '
 197       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 198       IF ( ierr .EQ. 0 ) THEN
 199          flag_qr       = itmp
 200       END IF
 201       flag_name(1:8) = 'QI      '
 202       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 203       IF ( ierr .EQ. 0 ) THEN
 204          flag_qi       = itmp
 205       END IF
 206       flag_name(1:8) = 'QS      '
 207       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 208       IF ( ierr .EQ. 0 ) THEN
 209          flag_qs       = itmp
 210       END IF
 211       flag_name(1:8) = 'QG      '
 212       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 213       IF ( ierr .EQ. 0 ) THEN
 214          flag_qg       = itmp
 215       END IF
 216
 217    END SUBROUTINE optional_moist
 218
 219 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 220
 221    SUBROUTINE optional_metgrid ( grid , fid , &
 222                                  ids, ide, jds, jde, kds, kde, &
 223                                  ims, ime, jms, jme, kms, kme, &
 224                                  its, ite, jts, jte, kts, kte  )
 225
 226       USE module_io_wrf
 227       USE module_domain
 228 USE module_configure
 229 USE module_io_domain
 230
 231       IMPLICIT NONE
 232
 233       TYPE ( domain ) :: grid
 234       INTEGER , INTENT(IN) :: fid
 235
 236       INTEGER :: ids, ide, jds, jde, kds, kde, &
 237                  ims, ime, jms, jme, kms, kme, &
 238                  its, ite, jts, jte, kts, kte
 239
 240       INTEGER :: itmp , icnt , ierr
 241
 242       flag_metgrid = 0
 243
 244       flag_name(1:8) = 'METGRID '
 245       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 246       IF ( ierr .EQ. 0 ) THEN
 247          flag_metgrid  = itmp
 248       END IF
 249
 250    END SUBROUTINE optional_metgrid
 251
 252 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 253
 254    SUBROUTINE optional_sst ( grid , fid , &
 255                              ids, ide, jds, jde, kds, kde, &
 256                              ims, ime, jms, jme, kms, kme, &
 257                              its, ite, jts, jte, kts, kte  )
 258
 259       USE module_io_wrf
 260       USE module_domain
 261 USE module_configure
 262 USE module_io_domain
 263
 264       IMPLICIT NONE
 265
 266       TYPE ( domain ) :: grid
 267       INTEGER , INTENT(IN) :: fid
 268
 269       INTEGER :: ids, ide, jds, jde, kds, kde, &
 270                  ims, ime, jms, jme, kms, kme, &
 271                  its, ite, jts, jte, kts, kte
 272
 273       INTEGER :: itmp , icnt , ierr
 274
 275       flag_sst      = 0
 276
 277       flag_name(1:8) = 'SST     '
 278       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 279       IF ( ierr .EQ. 0 ) THEN
 280          flag_sst      = itmp
 281       END IF
 282
 283    END SUBROUTINE optional_sst
 284
 285
 286 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 287
 288    SUBROUTINE optional_tavgsfc ( grid , fid , &
 289                                  ids, ide, jds, jde, kds, kde, &
 290                                  ims, ime, jms, jme, kms, kme, &
 291                                  its, ite, jts, jte, kts, kte  )
 292
 293       USE module_io_wrf
 294       USE module_domain
 295 USE module_configure
 296 USE module_io_domain
 297
 298       IMPLICIT NONE
 299
 300       TYPE ( domain ) :: grid
 301       INTEGER , INTENT(IN) :: fid
 302
 303       INTEGER :: ids, ide, jds, jde, kds, kde, &
 304                  ims, ime, jms, jme, kms, kme, &
 305                  its, ite, jts, jte, kts, kte
 306
 307       INTEGER :: itmp , icnt , ierr
 308
 309       flag_tavgsfc  = 0
 310
 311       flag_name(1:8) = 'TAVGSFC '
 312       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 313       IF ( ierr .EQ. 0 ) THEN
 314          flag_tavgsfc  = itmp
 315       END IF
 316
 317    END SUBROUTINE optional_tavgsfc
 318
 319 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 320
 321    SUBROUTINE optional_snowh ( grid , fid , &
 322                                ids, ide, jds, jde, kds, kde, &
 323                                ims, ime, jms, jme, kms, kme, &
 324                                its, ite, jts, jte, kts, kte  )
 325
 326       USE module_io_wrf
 327       USE module_domain
 328 USE module_configure
 329 USE module_io_domain
 330
 331       IMPLICIT NONE
 332
 333       TYPE ( domain ) :: grid
 334       INTEGER , INTENT(IN) :: fid
 335
 336       INTEGER :: ids, ide, jds, jde, kds, kde, &
 337                  ims, ime, jms, jme, kms, kme, &
 338                  its, ite, jts, jte, kts, kte
 339
 340       INTEGER :: itmp , icnt , ierr
 341
 342       flag_snowh    = 0
 343
 344       flag_name(1:8) = 'SNOWH   '
 345       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 346       IF ( ierr .EQ. 0 ) THEN
 347          flag_snowh    = itmp
 348       END IF
 349
 350    END SUBROUTINE optional_snowh
 351
 352 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 353
 354    SUBROUTINE optional_lsm ( grid , fid , &
 355                              ids, ide, jds, jde, kds, kde, &
 356                              ims, ime, jms, jme, kms, kme, &
 357                              its, ite, jts, jte, kts, kte  )
 358
 359       USE module_io_wrf
 360       USE module_domain
 361 USE module_configure
 362 USE module_io_domain
 363
 364       IMPLICIT NONE
 365
 366       TYPE ( domain ) :: grid
 367       INTEGER , INTENT(IN) :: fid
 368
 369       INTEGER :: ids, ide, jds, jde, kds, kde, &
 370                  ims, ime, jms, jme, kms, kme, &
 371                  its, ite, jts, jte, kts, kte
 372
 373       INTEGER :: itmp , icnt , ierr
 374
 375       flag_psfc     = 0
 376       flag_soilhgt  = 0
 377       flag_toposoil = 0
 378
 379       flag_name(1:8) = 'TOPOSOIL'
 380       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 381       IF ( ierr .EQ. 0 ) THEN
 382          flag_toposoil = itmp
 383       END IF
 384
 385       flag_name(1:8) = 'PSFC    '
 386       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 387       IF ( ierr .EQ. 0 ) THEN
 388          flag_psfc     = itmp
 389       END IF
 390
 391       flag_name(1:8) = 'SOILHGT '
 392       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 393       IF ( ierr .EQ. 0 ) THEN
 394          flag_soilhgt  = itmp
 395       END IF
 396
 397    END SUBROUTINE optional_lsm
 398
 399 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 400
 401    SUBROUTINE optional_lsm_levels ( grid , fid , &
 402                                     ids, ide, jds, jde, kds, kde, &
 403                                     ims, ime, jms, jme, kms, kme, &
 404                                     its, ite, jts, jte, kts, kte  )
 405
 406       USE module_io_wrf
 407       USE module_domain
 408 USE module_configure
 409 USE module_io_domain
 410
 411       IMPLICIT NONE
 412
 413       TYPE ( domain ) :: grid
 414       INTEGER , INTENT(IN) :: fid
 415
 416       INTEGER :: ids, ide, jds, jde, kds, kde, &
 417                  ims, ime, jms, jme, kms, kme, &
 418                  its, ite, jts, jte, kts, kte
 419
 420       INTEGER :: itmp , icnt , ierr , i , j
 421
 422       !  Initialize the soil temp and moisture flags to "field not found".
 423
 424       flag_st000010 = 0
 425       flag_st010040 = 0
 426       flag_st040100 = 0
 427       flag_st100200 = 0
 428       flag_st010200 = 0
 429
 430       flag_sm000010 = 0
 431       flag_sm010040 = 0
 432       flag_sm040100 = 0
 433       flag_sm100200 = 0
 434       flag_sm010200 = 0
 435
 436       flag_sw000010 = 0
 437       flag_sw010040 = 0
 438       flag_sw040100 = 0
 439       flag_sw100200 = 0
 440       flag_sw010200 = 0
 441
 442       flag_st000007 = 0
 443       flag_st007028 = 0
 444       flag_st028100 = 0
 445       flag_st100255 = 0
 446
 447       flag_sm000007 = 0
 448       flag_sm007028 = 0
 449       flag_sm028100 = 0
 450       flag_sm100255 = 0
 451
 452       flag_soilt000 = 0
 453       flag_soilt005 = 0
 454       flag_soilt020 = 0
 455       flag_soilt040 = 0
 456       flag_soilt160 = 0
 457       flag_soilt300 = 0
 458
 459       flag_soilm000 = 0
 460       flag_soilm005 = 0
 461       flag_soilm020 = 0
 462       flag_soilm040 = 0
 463       flag_soilm160 = 0
 464       flag_soilm300 = 0
 465
 466       flag_soilw000 = 0
 467       flag_soilw005 = 0
 468       flag_soilw020 = 0
 469       flag_soilw040 = 0
 470       flag_soilw160 = 0
 471       flag_soilw300 = 0
 472
 473       !  How many soil levels have we found?  Well, right now, none.
 474
 475       num_st_levels_input = 0
 476       num_sm_levels_input = 0
 477       num_sw_levels_input = 0
 478       st_levels_input = -1
 479       sm_levels_input = -1
 480       sw_levels_input = -1
 481
 482       flag_name(1:8) = 'ST000010'
 483       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 484       IF ( ierr .EQ. 0 ) THEN
 485          flag_st000010 = itmp
 486          num_st_levels_input = num_st_levels_input + 1
 487          st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
 488          DO j = jts , MIN(jde-1,jte)
 489             DO i = its , MIN(ide-1,ite)
 490                st_input(i,num_st_levels_input + 1,j) = grid%st000010(i,j)
 491             END DO
 492          END DO
 493       END IF
 494       flag_name(1:8) = 'ST010040'
 495       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 496       IF ( ierr .EQ. 0 ) THEN
 497          flag_st010040 = itmp
 498          num_st_levels_input = num_st_levels_input + 1
 499          st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
 500          DO j = jts , MIN(jde-1,jte)
 501             DO i = its , MIN(ide-1,ite)
 502                st_input(i,num_st_levels_input + 1,j) = grid%st010040(i,j)
 503             END DO
 504          END DO
 505       END IF
 506       flag_name(1:8) = 'ST040100'
 507       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 508       IF ( ierr .EQ. 0 ) THEN
 509          flag_st040100 = itmp
 510          num_st_levels_input = num_st_levels_input + 1
 511          st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
 512          DO j = jts , MIN(jde-1,jte)
 513             DO i = its , MIN(ide-1,ite)
 514                st_input(i,num_st_levels_input + 1,j) = grid%st040100(i,j)
 515             END DO
 516          END DO
 517       END IF
 518       flag_name(1:8) = 'ST100200'
 519       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 520       IF ( ierr .EQ. 0 ) THEN
 521          flag_st100200 = itmp
 522          num_st_levels_input = num_st_levels_input + 1
 523          st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
 524          DO j = jts , MIN(jde-1,jte)
 525             DO i = its , MIN(ide-1,ite)
 526                st_input(i,num_st_levels_input + 1,j) = grid%st100200(i,j)
 527             END DO
 528          END DO
 529       END IF
 530       flag_name(1:8) = 'ST010200'
 531       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 532       IF ( ierr .EQ. 0 ) THEN
 533          flag_st010200 = itmp
 534          num_st_levels_input = num_st_levels_input + 1
 535          st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
 536          DO j = jts , MIN(jde-1,jte)
 537             DO i = its , MIN(ide-1,ite)
 538                st_input(i,num_st_levels_input + 1,j) = grid%st010200(i,j)
 539             END DO
 540          END DO
 541       END IF
 542       flag_name(1:8) = 'SM000010'
 543       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 544       IF ( ierr .EQ. 0 ) THEN
 545          flag_sm000010 = itmp
 546          num_sm_levels_input = num_sm_levels_input + 1
 547          sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
 548          DO j = jts , MIN(jde-1,jte)
 549             DO i = its , MIN(ide-1,ite)
 550                sm_input(i,num_sm_levels_input + 1,j) = grid%sm000010(i,j)
 551             END DO
 552          END DO
 553       END IF
 554       flag_name(1:8) = 'SM010040'
 555       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 556       IF ( ierr .EQ. 0 ) THEN
 557          flag_sm010040 = itmp
 558          num_sm_levels_input = num_sm_levels_input + 1
 559          sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
 560          DO j = jts , MIN(jde-1,jte)
 561             DO i = its , MIN(ide-1,ite)
 562                sm_input(i,num_sm_levels_input + 1,j) = grid%sm010040(i,j)
 563             END DO
 564          END DO
 565       END IF
 566       flag_name(1:8) = 'SM040100'
 567       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 568       IF ( ierr .EQ. 0 ) THEN
 569          flag_sm040100 = itmp
 570          num_sm_levels_input = num_sm_levels_input + 1
 571          sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
 572          DO j = jts , MIN(jde-1,jte)
 573             DO i = its , MIN(ide-1,ite)
 574                sm_input(i,num_sm_levels_input + 1,j) = grid%sm040100(i,j)
 575             END DO
 576          END DO
 577       END IF
 578       flag_name(1:8) = 'SM100200'
 579       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 580       IF ( ierr .EQ. 0 ) THEN
 581          flag_sm100200 = itmp
 582          num_sm_levels_input = num_sm_levels_input + 1
 583          sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
 584          DO j = jts , MIN(jde-1,jte)
 585             DO i = its , MIN(ide-1,ite)
 586                sm_input(i,num_sm_levels_input + 1,j) = grid%sm100200(i,j)
 587             END DO
 588          END DO
 589       END IF
 590       flag_name(1:8) = 'SM010200'
 591       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 592       IF ( ierr .EQ. 0 ) THEN
 593          flag_sm010200 = itmp
 594          num_sm_levels_input = num_sm_levels_input + 1
 595          sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
 596          DO j = jts , MIN(jde-1,jte)
 597             DO i = its , MIN(ide-1,ite)
 598                sm_input(i,num_sm_levels_input + 1,j) = grid%sm010200(i,j)
 599             END DO
 600          END DO
 601       END IF
 602       flag_name(1:8) = 'SW000010'
 603       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 604       IF ( ierr .EQ. 0 ) THEN
 605          flag_sw000010 = itmp
 606          num_sw_levels_input = num_sw_levels_input + 1
 607          sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
 608          DO j = jts , MIN(jde-1,jte)
 609             DO i = its , MIN(ide-1,ite)
 610                sw_input(i,num_sw_levels_input + 1,j) = grid%sw000010(i,j)
 611             END DO
 612          END DO
 613       END IF
 614       flag_name(1:8) = 'SW010040'
 615       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 616       IF ( ierr .EQ. 0 ) THEN
 617          flag_sw010040 = itmp
 618          num_sw_levels_input = num_sw_levels_input + 1
 619          sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
 620          DO j = jts , MIN(jde-1,jte)
 621             DO i = its , MIN(ide-1,ite)
 622                sw_input(i,num_sw_levels_input + 1,j) = grid%sw010040(i,j)
 623             END DO
 624          END DO
 625       END IF
 626       flag_name(1:8) = 'SW040100'
 627       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 628       IF ( ierr .EQ. 0 ) THEN
 629          flag_sw040100 = itmp
 630          num_sw_levels_input = num_sw_levels_input + 1
 631          sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
 632          DO j = jts , MIN(jde-1,jte)
 633             DO i = its , MIN(ide-1,ite)
 634                sw_input(i,num_sw_levels_input + 1,j) = grid%sw040100(i,j)
 635             END DO
 636          END DO
 637       END IF
 638       flag_name(1:8) = 'SW100200'
 639       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 640       IF ( ierr .EQ. 0 ) THEN
 641          flag_sw100200 = itmp
 642          num_sw_levels_input = num_sw_levels_input + 1
 643          sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
 644          DO j = jts , MIN(jde-1,jte)
 645             DO i = its , MIN(ide-1,ite)
 646                sw_input(i,num_sw_levels_input + 1,j) = grid%sw100200(i,j)
 647             END DO
 648          END DO
 649       END IF
 650       flag_name(1:8) = 'SW010200'
 651       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 652       IF ( ierr .EQ. 0 ) THEN
 653          flag_sw010200 = itmp
 654          num_sw_levels_input = num_sw_levels_input + 1
 655          sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
 656          DO j = jts , MIN(jde-1,jte)
 657             DO i = its , MIN(ide-1,ite)
 658                sw_input(i,num_sw_levels_input + 1,j) = grid%sw010200(i,j)
 659             END DO
 660          END DO
 661       END IF
 662       flag_name(1:8) = 'ST000007'
 663       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 664       IF ( ierr .EQ. 0 ) THEN
 665          flag_st000007 = itmp
 666          num_st_levels_input = num_st_levels_input + 1
 667          st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
 668          DO j = jts , MIN(jde-1,jte)
 669             DO i = its , MIN(ide-1,ite)
 670                st_input(i,num_st_levels_input + 1,j) = grid%st000007(i,j)
 671             END DO
 672          END DO
 673       END IF
 674       flag_name(1:8) = 'ST007028'
 675       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 676       IF ( ierr .EQ. 0 ) THEN
 677          flag_st007028 = itmp
 678          num_st_levels_input = num_st_levels_input + 1
 679          st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
 680          DO j = jts , MIN(jde-1,jte)
 681             DO i = its , MIN(ide-1,ite)
 682                st_input(i,num_st_levels_input + 1,j) = grid%st007028(i,j)
 683             END DO
 684          END DO
 685       END IF
 686       flag_name(1:8) = 'ST028100'
 687       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 688       IF ( ierr .EQ. 0 ) THEN
 689          flag_st028100 = itmp
 690          num_st_levels_input = num_st_levels_input + 1
 691          st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
 692          DO j = jts , MIN(jde-1,jte)
 693             DO i = its , MIN(ide-1,ite)
 694                st_input(i,num_st_levels_input + 1,j) = grid%st028100(i,j)
 695             END DO
 696          END DO
 697       END IF
 698       flag_name(1:8) = 'ST100255'
 699       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 700       IF ( ierr .EQ. 0 ) THEN
 701          flag_st100255 = itmp
 702          num_st_levels_input = num_st_levels_input + 1
 703          st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
 704          DO j = jts , MIN(jde-1,jte)
 705             DO i = its , MIN(ide-1,ite)
 706                st_input(i,num_st_levels_input + 1,j) = grid%st100255(i,j)
 707             END DO
 708          END DO
 709       END IF
 710       flag_name(1:8) = 'SM000007'
 711       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 712       IF ( ierr .EQ. 0 ) THEN
 713          flag_sm000007 = itmp
 714          num_sm_levels_input = num_sm_levels_input + 1
 715          sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
 716          DO j = jts , MIN(jde-1,jte)
 717             DO i = its , MIN(ide-1,ite)
 718                sm_input(i,num_sm_levels_input + 1,j) = grid%sm000007(i,j)
 719             END DO
 720          END DO
 721       END IF
 722       flag_name(1:8) = 'SM007028'
 723       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 724       IF ( ierr .EQ. 0 ) THEN
 725          flag_sm007028 = itmp
 726          num_sm_levels_input = num_sm_levels_input + 1
 727          sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
 728          DO j = jts , MIN(jde-1,jte)
 729             DO i = its , MIN(ide-1,ite)
 730                sm_input(i,num_sm_levels_input + 1,j) = grid%sm007028(i,j)
 731             END DO
 732          END DO
 733       END IF
 734       flag_name(1:8) = 'SM028100'
 735       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 736       IF ( ierr .EQ. 0 ) THEN
 737          flag_sm028100 = itmp
 738          num_sm_levels_input = num_sm_levels_input + 1
 739          sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
 740          DO j = jts , MIN(jde-1,jte)
 741             DO i = its , MIN(ide-1,ite)
 742                sm_input(i,num_sm_levels_input + 1,j) = grid%sm028100(i,j)
 743             END DO
 744          END DO
 745       END IF
 746       flag_name(1:8) = 'SM100255'
 747       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 748       IF ( ierr .EQ. 0 ) THEN
 749          flag_sm100255 = itmp
 750          num_sm_levels_input = num_sm_levels_input + 1
 751          sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
 752          DO j = jts , MIN(jde-1,jte)
 753             DO i = its , MIN(ide-1,ite)
 754                sm_input(i,num_sm_levels_input + 1,j) = grid%sm100255(i,j)
 755             END DO
 756          END DO
 757       END IF
 758       flag_name(1:8) = 'SOILT000'
 759       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 760       IF ( ierr .EQ. 0 ) THEN
 761          flag_soilt000 = itmp
 762          num_st_levels_input = num_st_levels_input + 1
 763          st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
 764          DO j = jts , MIN(jde-1,jte)
 765             DO i = its , MIN(ide-1,ite)
 766                st_input(i,num_st_levels_input ,j) = grid%soilt000(i,j)
 767             END DO
 768          END DO
 769       END IF
 770       flag_name(1:8) = 'SOILT005'
 771       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 772       IF ( ierr .EQ. 0 ) THEN
 773          flag_soilt005 = itmp
 774          num_st_levels_input = num_st_levels_input + 1
 775          st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
 776          DO j = jts , MIN(jde-1,jte)
 777             DO i = its , MIN(ide-1,ite)
 778                st_input(i,num_st_levels_input ,j) = grid%soilt005(i,j)
 779             END DO
 780          END DO
 781       END IF
 782       flag_name(1:8) = 'SOILT020'
 783       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 784       IF ( ierr .EQ. 0 ) THEN
 785          flag_soilt020 = itmp
 786          num_st_levels_input = num_st_levels_input + 1
 787          st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
 788          DO j = jts , MIN(jde-1,jte)
 789             DO i = its , MIN(ide-1,ite)
 790                st_input(i,num_st_levels_input ,j) = grid%soilt020(i,j)
 791             END DO
 792          END DO
 793       END IF
 794       flag_name(1:8) = 'SOILT040'
 795       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 796       IF ( ierr .EQ. 0 ) THEN
 797          flag_soilt040 = itmp
 798          num_st_levels_input = num_st_levels_input + 1
 799          st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
 800          DO j = jts , MIN(jde-1,jte)
 801             DO i = its , MIN(ide-1,ite)
 802                st_input(i,num_st_levels_input ,j) = grid%soilt040(i,j)
 803             END DO
 804          END DO
 805       END IF
 806       flag_name(1:8) = 'SOILT160'
 807       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 808       IF ( ierr .EQ. 0 ) THEN
 809          flag_soilt160 = itmp
 810          num_st_levels_input = num_st_levels_input + 1
 811          st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
 812          DO j = jts , MIN(jde-1,jte)
 813             DO i = its , MIN(ide-1,ite)
 814                st_input(i,num_st_levels_input ,j) = grid%soilt160(i,j)
 815             END DO
 816          END DO
 817       END IF
 818       flag_name(1:8) = 'SOILT300'
 819       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 820       IF ( ierr .EQ. 0 ) THEN
 821          flag_soilt300 = itmp
 822          num_st_levels_input = num_st_levels_input + 1
 823          st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
 824          DO j = jts , MIN(jde-1,jte)
 825             DO i = its , MIN(ide-1,ite)
 826                st_input(i,num_st_levels_input ,j) = grid%soilt300(i,j)
 827             END DO
 828          END DO
 829       END IF
 830       flag_name(1:8) = 'SOILM000'
 831       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 832       IF ( ierr .EQ. 0 ) THEN
 833          flag_soilm000 = itmp
 834          num_sm_levels_input = num_sm_levels_input + 1
 835          sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
 836          DO j = jts , MIN(jde-1,jte)
 837             DO i = its , MIN(ide-1,ite)
 838                sm_input(i,num_sm_levels_input ,j) = grid%soilm000(i,j)
 839             END DO
 840          END DO
 841       END IF
 842       flag_name(1:8) = 'SOILM005'
 843       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 844       IF ( ierr .EQ. 0 ) THEN
 845          flag_soilm005 = itmp
 846          num_sm_levels_input = num_sm_levels_input + 1
 847          sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
 848          DO j = jts , MIN(jde-1,jte)
 849             DO i = its , MIN(ide-1,ite)
 850                sm_input(i,num_sm_levels_input ,j) = grid%soilm005(i,j)
 851             END DO
 852          END DO
 853       END IF
 854       flag_name(1:8) = 'SOILM020'
 855       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 856       IF ( ierr .EQ. 0 ) THEN
 857          flag_soilm020 = itmp
 858          num_sm_levels_input = num_sm_levels_input + 1
 859          sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
 860          DO j = jts , MIN(jde-1,jte)
 861             DO i = its , MIN(ide-1,ite)
 862                sm_input(i,num_sm_levels_input ,j) = grid%soilm020(i,j)
 863             END DO
 864          END DO
 865       END IF
 866       flag_name(1:8) = 'SOILM040'
 867       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 868       IF ( ierr .EQ. 0 ) THEN
 869          flag_soilm040 = itmp
 870          num_sm_levels_input = num_sm_levels_input + 1
 871          sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
 872          DO j = jts , MIN(jde-1,jte)
 873             DO i = its , MIN(ide-1,ite)
 874                sm_input(i,num_sm_levels_input ,j) = grid%soilm040(i,j)
 875             END DO
 876          END DO
 877       END IF
 878       flag_name(1:8) = 'SOILM160'
 879       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 880       IF ( ierr .EQ. 0 ) THEN
 881          flag_soilm160 = itmp
 882          num_sm_levels_input = num_sm_levels_input + 1
 883          sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
 884          DO j = jts , MIN(jde-1,jte)
 885             DO i = its , MIN(ide-1,ite)
 886                sm_input(i,num_sm_levels_input ,j) = grid%soilm160(i,j)
 887             END DO
 888          END DO
 889       END IF
 890       flag_name(1:8) = 'SOILM300'
 891       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 892       IF ( ierr .EQ. 0 ) THEN
 893          flag_soilm300 = itmp
 894          num_sm_levels_input = num_sm_levels_input + 1
 895          sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
 896          DO j = jts , MIN(jde-1,jte)
 897             DO i = its , MIN(ide-1,ite)
 898                sm_input(i,num_sm_levels_input ,j) = grid%soilm300(i,j)
 899             END DO
 900          END DO
 901       END IF
 902       flag_name(1:8) = 'SOILW000'
 903       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 904       IF ( ierr .EQ. 0 ) THEN
 905          flag_soilw000 = itmp
 906          num_sw_levels_input = num_sw_levels_input + 1
 907          sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
 908          DO j = jts , MIN(jde-1,jte)
 909             DO i = its , MIN(ide-1,ite)
 910                sw_input(i,num_sw_levels_input ,j) = grid%soilw000(i,j)
 911             END DO
 912          END DO
 913       END IF
 914       flag_name(1:8) = 'SOILW005'
 915       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 916       IF ( ierr .EQ. 0 ) THEN
 917          flag_soilw005 = itmp
 918          num_sw_levels_input = num_sw_levels_input + 1
 919          sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
 920          DO j = jts , MIN(jde-1,jte)
 921             DO i = its , MIN(ide-1,ite)
 922                sw_input(i,num_sw_levels_input ,j) = grid%soilw005(i,j)
 923             END DO
 924          END DO
 925       END IF
 926       flag_name(1:8) = 'SOILW020'
 927       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 928       IF ( ierr .EQ. 0 ) THEN
 929          flag_soilw020 = itmp
 930          num_sw_levels_input = num_sw_levels_input + 1
 931          sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
 932          DO j = jts , MIN(jde-1,jte)
 933             DO i = its , MIN(ide-1,ite)
 934                sw_input(i,num_sw_levels_input ,j) = grid%soilw020(i,j)
 935             END DO
 936          END DO
 937       END IF
 938       flag_name(1:8) = 'SOILW040'
 939       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 940       IF ( ierr .EQ. 0 ) THEN
 941          flag_soilw040 = itmp
 942          num_sw_levels_input = num_sw_levels_input + 1
 943          sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
 944          DO j = jts , MIN(jde-1,jte)
 945             DO i = its , MIN(ide-1,ite)
 946                sw_input(i,num_sw_levels_input ,j) = grid%soilw040(i,j)
 947             END DO
 948          END DO
 949       END IF
 950       flag_name(1:8) = 'SOILW160'
 951       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 952       IF ( ierr .EQ. 0 ) THEN
 953          flag_soilw160 = itmp
 954          num_sw_levels_input = num_sw_levels_input + 1
 955          sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
 956          DO j = jts , MIN(jde-1,jte)
 957             DO i = its , MIN(ide-1,ite)
 958                sw_input(i,num_sw_levels_input ,j) = grid%soilw160(i,j)
 959             END DO
 960          END DO
 961       END IF
 962       flag_name(1:8) = 'SOILW300'
 963       CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
 964       IF ( ierr .EQ. 0 ) THEN
 965          flag_soilw300 = itmp
 966          num_sw_levels_input = num_sw_levels_input + 1
 967          sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
 968          DO j = jts , MIN(jde-1,jte)
 969             DO i = its , MIN(ide-1,ite)
 970                sw_input(i,num_sw_levels_input ,j) = grid%soilw300(i,j)
 971             END DO
 972          END DO
 973       END IF
 974
 975       !  OK, let's do a quick sanity check.
 976
 977       IF ( ( num_st_levels_input .GT. num_st_levels_alloc ) .OR. &
 978            ( num_sm_levels_input .GT. num_sm_levels_alloc ) .OR. &
 979            ( num_sw_levels_input .GT. num_sw_levels_alloc ) ) THEN
 980          print *,'pain and woe, the soil level allocation is too small'
 981          CALL wrf_error_fatal ( 'soil_levels_too_few' )
 982       END IF
 983
 984    END SUBROUTINE optional_lsm_levels
 985
 986 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 987
 988    FUNCTION char2int1( string3 ) RESULT ( int1 )
 989       CHARACTER (LEN=3) , INTENT(IN) :: string3
 990       INTEGER :: i1 , int1
 991       READ(string3,fmt='(I3)') i1
 992       int1 = i1
 993    END FUNCTION char2int1
 994
 995 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 996
 997    FUNCTION char2int2( string6 ) RESULT ( int1 )
 998       CHARACTER (LEN=6) , INTENT(IN) :: string6
 999       INTEGER :: i2 , i1 , int1
1000       READ(string6,fmt='(I3,I3)') i1,i2
1001       int1 = ( i2 + i1 ) / 2
1002    END FUNCTION char2int2
1003
1004 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1005
1006 END MODULE module_optional_si_input