wrfv2_fire/main/real_em.F

   1 !  Create an initial data set for the WRF model based on real data.  This
   2 !  program is specifically set up for the Eulerian, mass-based coordinate.
   3 PROGRAM real_data
   4
   5    USE module_machine
   6    USE module_domain, ONLY : domain, alloc_and_configure_domain, &
   7         domain_clock_set, head_grid, program_name, domain_clockprint
   8    USE module_initialize_real, ONLY : wrfu_initialize, find_my_parent, find_my_parent2
   9    USE module_initialize_real
  10    USE module_io_domain
  11    USE module_driver_constants
  12    USE module_configure, ONLY : grid_config_rec_type, model_config_rec, &
  13         initial_config, get_config_as_buffer, set_config_as_buffer
  14    USE module_timing
  15    USE module_state_description, ONLY : realonly
  16 #ifdef NO_LEAP_CALENDAR
  17    USE module_symbols_util, ONLY: wrfu_cal_noleap
  18 #else
  19    USE module_symbols_util, ONLY: wrfu_cal_gregorian
  20 #endif
  21    USE module_check_a_mundo
  22 #ifdef WRF_CHEM
  23    USE module_input_chem_data
  24    USE module_input_chem_bioemiss
  25 !  USE module_input_chem_emissopt3
  26 #endif
  27    USE module_utility, ONLY : WRFU_finalize
  28
  29    IMPLICIT NONE
  30
  31 #ifdef WRF_CHEM
  32   ! interface
  33    INTERFACE
  34      ! mediation-supplied
  35      SUBROUTINE med_read_wrf_chem_bioemiss ( grid , config_flags)
  36        USE module_domain
  37        TYPE (domain) grid
  38        TYPE (grid_config_rec_type) config_flags
  39      END SUBROUTINE med_read_wrf_chem_bioemiss
  40    END INTERFACE
  41 #endif
  42
  43    REAL    :: time , bdyfrq
  44
  45    INTEGER :: loop , levels_to_process , debug_level
  46
  47
  48    TYPE(domain) , POINTER :: null_domain
  49    TYPE(domain) , POINTER :: grid , another_grid
  50    TYPE(domain) , POINTER :: grid_ptr , grid_ptr2
  51    TYPE (grid_config_rec_type)              :: config_flags
  52    INTEGER                :: number_at_same_level
  53
  54    INTEGER :: max_dom, domain_id , grid_id , parent_id , parent_id1 , id
  55    INTEGER :: e_we , e_sn , i_parent_start , j_parent_start
  56    INTEGER :: idum1, idum2
  57 #ifdef DM_PARALLEL
  58    INTEGER                 :: nbytes
  59    INTEGER, PARAMETER      :: configbuflen = 4* CONFIG_BUF_LEN
  60    INTEGER                 :: configbuf( configbuflen )
  61    LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
  62 #endif
  63    LOGICAL found_the_id
  64
  65    INTEGER :: ids , ide , jds , jde , kds , kde
  66    INTEGER :: ims , ime , jms , jme , kms , kme
  67    INTEGER :: ips , ipe , jps , jpe , kps , kpe
  68    INTEGER :: ijds , ijde , spec_bdy_width
  69    INTEGER :: i , j , k , idts, rc
  70    INTEGER :: sibling_count , parent_id_hold , dom_loop
  71
  72    CHARACTER (LEN=80)     :: message
  73
  74    INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
  75    INTEGER ::   end_year ,   end_month ,   end_day ,   end_hour ,   end_minute ,   end_second
  76    INTEGER :: interval_seconds , real_data_init_type
  77    INTEGER :: time_loop_max , time_loop
  78 real::t1,t2
  79    INTERFACE
  80      SUBROUTINE Setup_Timekeeping( grid )
  81       USE module_domain, ONLY : domain
  82       TYPE(domain), POINTER :: grid
  83      END SUBROUTINE Setup_Timekeeping
  84    END INTERFACE
  85
  86    LOGICAL :: ok_so_far
  87
  88 #include "version_decl"
  89
  90    !  Define the name of this program (program_name defined in module_domain)
  91
  92    ! NOTE: share/input_wrf.F tests first 7 chars of this name to decide
  93    ! whether to read P_TOP as metadata from the SI (yes, if .eq. REAL_EM)
  94
  95    program_name = "REAL_EM " // TRIM(release_version) // " PREPROCESSOR"
  96
  97 #ifdef DM_PARALLEL
  98    CALL disable_quilting
  99 #endif
 100
 101    !  Initialize the modules used by the WRF system.  Many of the CALLs made from the
 102    !  init_modules routine are NO-OPs.  Typical initializations are: the size of a
 103    !  REAL, setting the file handles to a pre-use value, defining moisture and
 104    !  chemistry indices, etc.
 105
 106    CALL       wrf_debug ( 100 , 'real_em: calling init_modules ' )
 107    CALL init_modules(1)   ! Phase 1 returns after MPI_INIT() (if it is called)
 108 #ifdef NO_LEAP_CALENDAR
 109    CALL WRFU_Initialize( defaultCalKind=WRFU_CAL_NOLEAP, rc=rc )
 110 #else
 111    CALL WRFU_Initialize( defaultCalKind=WRFU_CAL_GREGORIAN, rc=rc )
 112 #endif
 113    CALL init_modules(2)   ! Phase 2 resumes after MPI_INIT() (if it is called)
 114
 115    !  The configuration switches mostly come from the NAMELIST input.
 116
 117 #ifdef DM_PARALLEL
 118    IF ( wrf_dm_on_monitor() ) THEN
 119       CALL initial_config
 120    END IF
 121    CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
 122    CALL wrf_dm_bcast_bytes( configbuf, nbytes )
 123    CALL set_config_as_buffer( configbuf, configbuflen )
 124    CALL wrf_dm_initialize
 125 #else
 126    CALL initial_config
 127 #endif
 128    CALL check_nml_consistency
 129    CALL set_physics_rconfigs
 130
 131    CALL nl_get_debug_level ( 1, debug_level )
 132    CALL set_wrf_debug_level ( debug_level )
 133
 134    CALL  wrf_message ( program_name )
 135
 136    !  There are variables in the Registry that are only required for the real
 137    !  program, fields that come from the WPS package.  We define the run-time
 138    !  flag that says to allocate space for these input-from-WPS-only arrays.
 139
 140    CALL nl_set_use_wps_input ( 1 , REALONLY )
 141
 142    !  Allocate the space for the mother of all domains.
 143
 144    NULLIFY( null_domain )
 145    CALL       wrf_debug ( 100 , 'real_em: calling alloc_and_configure_domain ' )
 146    CALL alloc_and_configure_domain ( domain_id  = 1           , &
 147                                      grid       = head_grid   , &
 148                                      parent     = null_domain , &
 149                                      kid        = -1            )
 150
 151    grid => head_grid
 152    CALL nl_get_max_dom ( 1 , max_dom )
 153
 154    IF ( model_config_rec%interval_seconds .LE. 0 ) THEN
 155      CALL wrf_error_fatal( 'namelist value for interval_seconds must be > 0')
 156    END IF
 157
 158    all_domains : DO domain_id = 1 , max_dom
 159
 160       IF ( ( model_config_rec%input_from_file(domain_id) ) .OR. &
 161            ( domain_id .EQ. 1 ) ) THEN
 162
 163          IF ( domain_id .GT. 1 ) THEN
 164
 165             CALL nl_get_grid_id        ( domain_id, grid_id        )
 166             CALL nl_get_parent_id      ( domain_id, parent_id      )
 167             CALL nl_get_e_we           ( domain_id, e_we           )
 168             CALL nl_get_e_sn           ( domain_id, e_sn           )
 169             CALL nl_get_i_parent_start ( domain_id, i_parent_start )
 170             CALL nl_get_j_parent_start ( domain_id, j_parent_start )
 171             WRITE (message,FMT='(A,2I3,2I4,2I3)') &
 172             'new allocated  domain: id, par id, dims i/j, start i/j =', &
 173             grid_id, parent_id, e_we, e_sn, i_parent_start, j_parent_start
 174
 175             CALL wrf_debug ( 100 , message )
 176             CALL nl_get_grid_id        ( parent_id, grid_id        )
 177             CALL nl_get_parent_id      ( parent_id, parent_id1     )
 178             CALL nl_get_e_we           ( parent_id, e_we           )
 179             CALL nl_get_e_sn           ( parent_id, e_sn           )
 180             CALL nl_get_i_parent_start ( parent_id, i_parent_start )
 181             CALL nl_get_j_parent_start ( parent_id, j_parent_start )
 182             WRITE (message,FMT='(A,2I3,2I4,2I3)') &
 183             'parent domain: id, par id, dims i/j, start i/j =', &
 184             grid_id, parent_id1, e_we, e_sn, i_parent_start, j_parent_start
 185             CALL wrf_debug ( 100 , message )
 186
 187             CALL nl_get_grid_id        ( domain_id, grid_id        )
 188             CALL nl_get_parent_id      ( domain_id, parent_id      )
 189             CALL nl_get_e_we           ( domain_id, e_we           )
 190             CALL nl_get_e_sn           ( domain_id, e_sn           )
 191             CALL nl_get_i_parent_start ( domain_id, i_parent_start )
 192             CALL nl_get_j_parent_start ( domain_id, j_parent_start )
 193             grid_ptr2 => head_grid
 194             found_the_id = .FALSE.
 195 !           CALL find_my_parent ( grid_ptr2 , grid_ptr , domain_id , parent_id , found_the_id )
 196             CALL find_my_parent2( grid_ptr2 , grid_ptr ,             parent_id , found_the_id )
 197             IF ( found_the_id ) THEN
 198
 199                sibling_count = 0
 200                DO dom_loop = 2 , domain_id
 201                  CALL nl_get_parent_id ( dom_loop, parent_id_hold )
 202                  IF ( parent_id_hold .EQ. parent_id ) THEN
 203                     sibling_count = sibling_count + 1
 204                  END IF
 205                END DO
 206                CALL alloc_and_configure_domain ( domain_id  = domain_id    , &
 207                                                  grid       = another_grid , &
 208                                                  parent     = grid_ptr     , &
 209                                                  kid        = sibling_count )
 210                grid => another_grid
 211             ELSE
 212               CALL wrf_error_fatal( 'real_em.F: Could not find the parent domain')
 213             END IF
 214          END IF
 215
 216          CALL Setup_Timekeeping ( grid )
 217          CALL set_current_grid_ptr( grid )
 218          CALL domain_clockprint ( 150, grid, &
 219                 'DEBUG real:  clock after Setup_Timekeeping,' )
 220          CALL domain_clock_set( grid, &
 221                                 time_step_seconds=model_config_rec%interval_seconds )
 222          CALL domain_clockprint ( 150, grid, &
 223                 'DEBUG real:  clock after timeStep set,' )
 224
 225
 226          CALL       wrf_debug ( 100 , 'real_em: calling set_scalar_indices_from_config ' )
 227          CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
 228
 229          CALL       wrf_debug ( 100 , 'real_em: calling model_to_grid_config_rec ' )
 230          CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 231
 232          !  Some simple checks.
 233
 234          ok_so_far = .TRUE.
 235
 236          DO loop = 2 , model_config_rec%max_dom
 237             IF ( model_config_rec%e_vert(loop) .NE.  model_config_rec%e_vert(1) ) THEN
 238                CALL  wrf_message ( 'e_vert must be the same for each domain' )
 239                ok_so_far = .FALSE.
 240             END IF
 241          END DO
 242          IF ( .NOT. ok_so_far ) THEN
 243             CALL wrf_error_fatal( 'fix namelist.input settings' )
 244          END IF
 245
 246          !  Initialize the WRF IO: open files, init file handles, etc.
 247
 248          CALL       wrf_debug ( 100 , 'real_em: calling init_wrfio' )
 249          CALL init_wrfio
 250
 251          !  Some of the configuration values may have been modified from the initial READ
 252          !  of the NAMELIST, so we re-broadcast the configuration records.
 253
 254 #ifdef DM_PARALLEL
 255          CALL       wrf_debug ( 100 , 'real_em: re-broadcast the configuration records' )
 256          CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
 257          CALL wrf_dm_bcast_bytes( configbuf, nbytes )
 258          CALL set_config_as_buffer( configbuf, configbuflen )
 259 #endif
 260
 261          !   No looping in this layer.
 262
 263          CALL       wrf_debug ( 100 , 'calling med_sidata_input' )
 264          CALL med_sidata_input ( grid , config_flags )
 265          CALL       wrf_debug ( 100 , 'backfrom med_sidata_input' )
 266
 267       ELSE
 268          CYCLE all_domains
 269       END IF
 270
 271    END DO all_domains
 272
 273    CALL set_current_grid_ptr( head_grid )
 274
 275    !  We are done.
 276
 277    CALL       wrf_debug (   0 , 'real_em: SUCCESS COMPLETE REAL_EM INIT' )
 278
 279    CALL wrf_shutdown
 280
 281    CALL WRFU_Finalize( rc=rc )
 282
 283 END PROGRAM real_data
 284
 285 SUBROUTINE med_sidata_input ( grid , config_flags )
 286   ! Driver layer
 287    USE module_domain
 288    USE module_io_domain
 289   ! Model layer
 290    USE module_configure
 291    USE module_bc_time_utilities
 292    USE module_initialize_real
 293    USE module_optional_input
 294 #ifdef WRF_CHEM
 295    USE module_input_chem_data
 296    USE module_input_chem_bioemiss
 297 !  USE module_input_chem_emissopt3
 298 #endif
 299
 300    USE module_date_time
 301    USE module_utility
 302
 303    IMPLICIT NONE
 304
 305
 306   ! Interface
 307    INTERFACE
 308      SUBROUTINE start_domain ( grid , allowed_to_read )  ! comes from module_start in appropriate dyn_ directory
 309        USE module_domain
 310        TYPE (domain) grid
 311        LOGICAL, INTENT(IN) :: allowed_to_read
 312      END SUBROUTINE start_domain
 313    END INTERFACE
 314
 315   ! Arguments
 316    TYPE(domain)                :: grid
 317    TYPE (grid_config_rec_type) :: config_flags
 318   ! Local
 319    INTEGER                :: time_step_begin_restart
 320    INTEGER                :: idsi , ierr , myproc
 321    CHARACTER (LEN=80)      :: si_inpname
 322    CHARACTER (LEN=80)      :: message
 323
 324    CHARACTER(LEN=19) :: start_date_char , end_date_char , current_date_char , next_date_char
 325
 326    INTEGER :: time_loop_max , loop, rc
 327    INTEGER :: julyr , julday
 328    REAL :: gmt
 329 real::t1,t2,t3,t4
 330
 331    grid%input_from_file = .true.
 332    grid%input_from_file = .false.
 333
 334    CALL compute_si_start_and_end ( model_config_rec%start_year  (grid%id) , &
 335                                    model_config_rec%start_month (grid%id) , &
 336                                    model_config_rec%start_day   (grid%id) , &
 337                                    model_config_rec%start_hour  (grid%id) , &
 338                                    model_config_rec%start_minute(grid%id) , &
 339                                    model_config_rec%start_second(grid%id) , &
 340                                    model_config_rec%  end_year  (grid%id) , &
 341                                    model_config_rec%  end_month (grid%id) , &
 342                                    model_config_rec%  end_day   (grid%id) , &
 343                                    model_config_rec%  end_hour  (grid%id) , &
 344                                    model_config_rec%  end_minute(grid%id) , &
 345                                    model_config_rec%  end_second(grid%id) , &
 346                                    model_config_rec%interval_seconds      , &
 347                                    model_config_rec%real_data_init_type   , &
 348                                    start_date_char , end_date_char , time_loop_max )
 349
 350    !  Override stop time with value computed above.
 351    CALL domain_clock_set( grid, stop_timestr=end_date_char )
 352
 353    ! TBH:  for now, turn off stop time and let it run data-driven
 354    CALL WRFU_ClockStopTimeDisable( grid%domain_clock, rc=rc )
 355    CALL wrf_check_error( WRFU_SUCCESS, rc, &
 356                          'WRFU_ClockStopTimeDisable(grid%domain_clock) FAILED', &
 357                          __FILE__ , &
 358                          __LINE__  )
 359    CALL domain_clockprint ( 150, grid, &
 360           'DEBUG med_sidata_input:  clock after stopTime set,' )
 361
 362    !  Here we define the initial time to process, for later use by the code.
 363
 364    current_date_char = start_date_char
 365    start_date = start_date_char // '.0000'
 366    current_date = start_date
 367
 368    CALL nl_set_bdyfrq ( grid%id , REAL(model_config_rec%interval_seconds) )
 369
 370    !!!!!!!  Loop over each time period to process.
 371
 372    CALL cpu_time ( t1 )
 373    DO loop = 1 , time_loop_max
 374
 375       internal_time_loop = loop
 376       IF ( ( grid%id .GT. 1 ) .AND. ( loop .GT. 1 ) .AND. &
 377            ( model_config_rec%grid_fdda(grid%id) .EQ. 0 ) .AND. &
 378            ( model_config_rec%sst_update .EQ. 0 ) ) EXIT
 379
 380       print *,' '
 381       print *,'-----------------------------------------------------------------------------'
 382       print *,' '
 383       print '(A,I2,A,A,A,I4,A,I4)' , &
 384       ' Domain ',grid%id,': Current date being processed: ',current_date, ', which is loop #',loop,' out of ',time_loop_max
 385
 386       !  After current_date has been set, fill in the julgmt stuff.
 387
 388       CALL geth_julgmt ( config_flags%julyr , config_flags%julday , config_flags%gmt )
 389
 390         print *,'configflags%julyr, %julday, %gmt:',config_flags%julyr, config_flags%julday, config_flags%gmt
 391       !  Now that the specific Julian info is available, save these in the model config record.
 392
 393       CALL nl_set_gmt (grid%id, config_flags%gmt)
 394       CALL nl_set_julyr (grid%id, config_flags%julyr)
 395       CALL nl_set_julday (grid%id, config_flags%julday)
 396
 397       !  Open the input file for real.  This is either the "new" one or the "old" one.  The "new" one could have
 398       !  a suffix for the type of the data format.  Check to see if either is around.
 399
 400       CALL cpu_time ( t3 )
 401       WRITE ( wrf_err_message , FMT='(A,A)' )'med_sidata_input: calling open_r_dataset for ', &
 402                                              TRIM(config_flags%auxinput1_inname)
 403       CALL wrf_debug ( 100 , wrf_err_message )
 404       IF ( config_flags%auxinput1_inname(1:8) .NE. 'wrf_real' ) THEN
 405          CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , &
 406                                     current_date_char , config_flags%io_form_auxinput1 )
 407       ELSE
 408          CALL construct_filename2a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , &
 409                                     current_date_char )
 410       END IF
 411       CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
 412       IF ( ierr .NE. 0 ) THEN
 413          CALL wrf_error_fatal( 'error opening ' // TRIM(si_inpname) // &
 414                                ' for input; bad date in namelist or file not in directory' )
 415       END IF
 416
 417       !  Input data.
 418
 419       CALL wrf_debug ( 100 , 'med_sidata_input: calling input_auxinput1' )
 420       CALL input_auxinput1 ( idsi ,   grid , config_flags , ierr )
 421       CALL cpu_time ( t4 )
 422       WRITE ( wrf_err_message , FMT='(A,I10,A)' ) 'Timing for input ',NINT(t4-t3) ,' s.'
 423       CALL wrf_debug( 0, wrf_err_message )
 424
 425       !  Possible optional SI input.  This sets flags used by init_domain.
 426
 427       CALL cpu_time ( t3 )
 428       IF ( loop .EQ. 1 ) THEN
 429          already_been_here = .FALSE.
 430          CALL       wrf_debug ( 100 , 'med_sidata_input: calling init_module_optional_input' )
 431          CALL init_module_optional_input ( grid , config_flags )
 432       END IF
 433       CALL       wrf_debug ( 100 , 'med_sidata_input: calling optional_input' )
 434       CALL optional_input ( grid , idsi , config_flags )
 435
 436       !  Initialize the mother domain for this time period with input data.
 437
 438       CALL       wrf_debug ( 100 , 'med_sidata_input: calling init_domain' )
 439       grid%input_from_file = .true.
 440       CALL init_domain ( grid )
 441       CALL cpu_time ( t4 )
 442       WRITE ( wrf_err_message , FMT='(A,I10,A)' ) 'Timing for processing ',NINT(t4-t3) ,' s.'
 443       CALL wrf_debug( 0, wrf_err_message )
 444       CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 445
 446       !  Close this file that is output from the SI and input to this pre-proc.
 447
 448       CALL       wrf_debug ( 100 , 'med_sidata_input: back from init_domain' )
 449       CALL close_dataset ( idsi , config_flags , "DATASET=AUXINPUT1" )
 450
 451 #ifdef WRF_CHEM
 452       IF ( loop == 1 ) THEN
 453          IF( grid%chem_opt > 0 ) then
 454            ! Read the chemistry data from a previous wrf forecast (wrfout file)
 455            IF(grid%chem_in_opt == 1 ) THEN
 456               message = 'INITIALIZING CHEMISTRY WITH OLD SIMULATION'
 457               CALL  wrf_message ( message )
 458
 459               CALL med_read_wrf_chem_input ( grid , config_flags)
 460
 461               IF(grid%emiss_opt == ECPTEC .or. grid%emiss_opt == GOCART_ECPTEC   &
 462                                          .or. grid%biomass_burn_opt == BIOMASSB) THEN
 463                  message = 'READING EMISSIONS DATA OPT 3'
 464                  CALL  wrf_message ( message )
 465                  CALL med_read_wrf_chem_emissopt3 ( grid , config_flags)
 466               END IF
 467
 468               IF(grid%bio_emiss_opt == 2 ) THEN
 469                  message = 'READING BEIS3.11 EMISSIONS DATA'
 470                  CALL  wrf_message ( message )
 471                  CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
 472               else IF(grid%bio_emiss_opt == 3 ) THEN !shc
 473                  message = 'READING MEGAN 2 EMISSIONS DATA'
 474                  CALL  wrf_message ( message )
 475                  CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
 476               END IF
 477
 478               IF(grid%dust_opt == 1 .or. grid%dmsemis_opt == 1 .or. grid%chem_opt == 300) THEN !shc
 479                  message = 'READING GOCART BG AND/OR DUST and DMS REF FIELDS'
 480                  CALL  wrf_message ( message )
 481                  CALL med_read_wrf_chem_gocart_bg ( grid , config_flags)
 482               END IF
 483
 484            ELSEIF(grid%chem_in_opt == 0)then
 485               ! Generate chemistry data from a idealized vertical profile
 486               message = 'STARTING WITH BACKGROUND CHEMISTRY '
 487               CALL  wrf_message ( message )
 488
 489               CALL input_chem_profile ( grid )
 490
 491               IF(grid%bio_emiss_opt == 2 ) THEN
 492                  message = 'READING BEIS3.11 EMISSIONS DATA'
 493                  CALL  wrf_message ( message )
 494                  CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
 495               else IF(grid%bio_emiss_opt == 3 ) THEN !shc
 496                  message = 'READING MEGAN 2 EMISSIONS DATA'
 497                  CALL  wrf_message ( message )
 498                  CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
 499               END IF
 500               IF(grid%emiss_opt == ECPTEC .or. grid%emiss_opt == GOCART_ECPTEC   &
 501                                          .or. grid%biomass_burn_opt == BIOMASSB) THEN
 502                  message = 'READING EMISSIONS DATA OPT 3'
 503                  CALL  wrf_message ( message )
 504 !                CALL med_read_bin_chem_emissopt3 ( grid , config_flags)
 505                  CALL med_read_wrf_chem_emissopt3 ( grid , config_flags)
 506               END IF
 507
 508               IF(grid%dust_opt == 1 .or. grid%dmsemis_opt == 1 .or. grid%chem_opt == 300) THEN !shc
 509                  message = 'READING GOCART BG AND/OR DUST and DMS REF FIELDS'
 510                  CALL  wrf_message ( message )
 511                  CALL med_read_wrf_chem_gocart_bg ( grid , config_flags)
 512               END IF
 513
 514            ELSE
 515              message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
 516              CALL  wrf_message ( message )
 517            END IF
 518          END IF
 519       END IF
 520 #endif
 521
 522       CALL cpu_time ( t3 )
 523       CALL assemble_output ( grid , config_flags , loop , time_loop_max )
 524       CALL cpu_time ( t4 )
 525       WRITE ( wrf_err_message , FMT='(A,I10,A)' ) 'Timing for output ',NINT(t4-t3) ,' s.'
 526       CALL wrf_debug( 0, wrf_err_message )
 527       CALL cpu_time ( t2 )
 528       WRITE ( wrf_err_message , FMT='(A,I4,A,I10,A)' ) 'Timing for loop # ',loop,' = ',NINT(t2-t1) ,' s.'
 529       CALL wrf_debug( 0, wrf_err_message )
 530
 531       !  If this is not the last time, we define the next time that we are going to process.
 532
 533       IF ( loop .NE. time_loop_max ) THEN
 534          CALL geth_newdate ( current_date_char , start_date_char , loop * model_config_rec%interval_seconds )
 535          current_date =  current_date_char // '.0000'
 536          CALL domain_clockprint ( 150, grid, &
 537                 'DEBUG med_sidata_input:  clock before current_date set,' )
 538          WRITE (wrf_err_message,*) &
 539            'DEBUG med_sidata_input:  before currTime set, current_date = ',TRIM(current_date)
 540          CALL wrf_debug ( 150 , wrf_err_message )
 541          CALL domain_clock_set( grid, current_date(1:19) )
 542          CALL domain_clockprint ( 150, grid, &
 543                 'DEBUG med_sidata_input:  clock after current_date set,' )
 544       END IF
 545       CALL cpu_time ( t1 )
 546    END DO
 547
 548 END SUBROUTINE med_sidata_input
 549
 550 SUBROUTINE compute_si_start_and_end (  &
 551    start_year , start_month , start_day , start_hour , start_minute , start_second , &
 552      end_year ,   end_month ,   end_day ,   end_hour ,   end_minute ,   end_second , &
 553    interval_seconds , real_data_init_type , &
 554    start_date_char , end_date_char , time_loop_max )
 555
 556    USE module_date_time
 557
 558    IMPLICIT NONE
 559
 560    INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
 561    INTEGER ::   end_year ,   end_month ,   end_day ,   end_hour ,   end_minute ,   end_second
 562    INTEGER :: interval_seconds , real_data_init_type
 563    INTEGER :: time_loop_max , time_loop
 564
 565    CHARACTER(LEN=19) :: current_date_char , start_date_char , end_date_char , next_date_char
 566
 567 #ifdef PLANET
 568    WRITE ( start_date_char , FMT = '(I4.4,"-",I5.5,"_",I2.2,":",I2.2,":",I2.2)' ) &
 569            start_year,start_day,start_hour,start_minute,start_second
 570    WRITE (   end_date_char , FMT = '(I4.4,"-",I5.5,"_",I2.2,":",I2.2,":",I2.2)' ) &
 571              end_year,  end_day,  end_hour,  end_minute,  end_second
 572 #else
 573    WRITE ( start_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
 574            start_year,start_month,start_day,start_hour,start_minute,start_second
 575    WRITE (   end_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
 576              end_year,  end_month,  end_day,  end_hour,  end_minute,  end_second
 577 #endif
 578
 579    IF ( end_date_char .LT. start_date_char ) THEN
 580       CALL wrf_error_fatal( 'Ending date in namelist ' // end_date_char // ' prior to beginning date ' // start_date_char )
 581    END IF
 582
 583 !  start_date = start_date_char // '.0000'
 584
 585    !  Figure out our loop count for the processing times.
 586
 587    time_loop = 1
 588    PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',start_date_char,'.'
 589    current_date_char = start_date_char
 590    loop_count : DO
 591       CALL geth_newdate ( next_date_char , current_date_char , interval_seconds )
 592       IF      ( next_date_char .LT. end_date_char ) THEN
 593          time_loop = time_loop + 1
 594          PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',next_date_char,'.'
 595          current_date_char = next_date_char
 596       ELSE IF ( next_date_char .EQ. end_date_char ) THEN
 597          time_loop = time_loop + 1
 598          PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',next_date_char,'.'
 599          PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
 600          time_loop_max = time_loop
 601          EXIT loop_count
 602       ELSE IF ( next_date_char .GT. end_date_char ) THEN
 603          PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
 604          time_loop_max = time_loop
 605          EXIT loop_count
 606       END IF
 607    END DO loop_count
 608 END SUBROUTINE compute_si_start_and_end
 609
 610 SUBROUTINE assemble_output ( grid , config_flags , loop , time_loop_max )
 611
 612    USE module_big_step_utilities_em
 613    USE module_domain
 614    USE module_io_domain
 615    USE module_configure
 616    USE module_date_time
 617    USE module_bc
 618    IMPLICIT NONE
 619
 620    TYPE(domain)                 :: grid
 621    TYPE (grid_config_rec_type)  :: config_flags
 622    INTEGER , INTENT(IN)         :: loop , time_loop_max
 623
 624    INTEGER :: ids , ide , jds , jde , kds , kde
 625    INTEGER :: ims , ime , jms , jme , kms , kme
 626    INTEGER :: ips , ipe , jps , jpe , kps , kpe
 627    INTEGER :: ijds , ijde , spec_bdy_width
 628    INTEGER :: i , j , k , idts
 629
 630    INTEGER :: id1 , interval_seconds , ierr, rc, sst_update, grid_fdda
 631    INTEGER , SAVE :: id, id2,  id4
 632    CHARACTER (LEN=80) :: inpname , bdyname
 633    CHARACTER(LEN= 4) :: loop_char
 634 character *19 :: temp19
 635 character *24 :: temp24 , temp24b
 636
 637    REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: ubdy3dtemp1 , vbdy3dtemp1 , tbdy3dtemp1 , pbdy3dtemp1 , qbdy3dtemp1
 638    REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: mbdy2dtemp1
 639    REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: ubdy3dtemp2 , vbdy3dtemp2 , tbdy3dtemp2 , pbdy3dtemp2 , qbdy3dtemp2
 640    REAL , DIMENSION(:,:,:) , ALLOCATABLE , SAVE :: mbdy2dtemp2
 641 real::t1,t2
 642
 643    !  Various sizes that we need to be concerned about.
 644
 645    ids = grid%sd31
 646    ide = grid%ed31
 647    kds = grid%sd32
 648    kde = grid%ed32
 649    jds = grid%sd33
 650    jde = grid%ed33
 651
 652    ims = grid%sm31
 653    ime = grid%em31
 654    kms = grid%sm32
 655    kme = grid%em32
 656    jms = grid%sm33
 657    jme = grid%em33
 658
 659    ips = grid%sp31
 660    ipe = grid%ep31
 661    kps = grid%sp32
 662    kpe = grid%ep32
 663    jps = grid%sp33
 664    jpe = grid%ep33
 665
 666    ijds = MIN ( ids , jds )
 667    ijde = MAX ( ide , jde )
 668
 669    !  Boundary width, scalar value.
 670
 671    spec_bdy_width = model_config_rec%spec_bdy_width
 672    interval_seconds = model_config_rec%interval_seconds
 673    sst_update = model_config_rec%sst_update
 674    grid_fdda = model_config_rec%grid_fdda(grid%id)
 675
 676
 677    IF ( loop .EQ. 1 ) THEN
 678
 679       IF ( ( time_loop_max .EQ. 1 )  .OR. ( config_flags%polar ) ) THEN
 680
 681          !  No need to allocate space since we do not need the lateral boundary data yet
 682          !  or at all (in case of the polar flag).
 683
 684       ELSE
 685
 686          !  This is the space needed to save the current 3d data for use in computing
 687          !  the lateral boundary tendencies.
 688
 689          IF ( ALLOCATED ( ubdy3dtemp1 ) ) DEALLOCATE ( ubdy3dtemp1 )
 690          IF ( ALLOCATED ( vbdy3dtemp1 ) ) DEALLOCATE ( vbdy3dtemp1 )
 691          IF ( ALLOCATED ( tbdy3dtemp1 ) ) DEALLOCATE ( tbdy3dtemp1 )
 692          IF ( ALLOCATED ( pbdy3dtemp1 ) ) DEALLOCATE ( pbdy3dtemp1 )
 693          IF ( ALLOCATED ( qbdy3dtemp1 ) ) DEALLOCATE ( qbdy3dtemp1 )
 694          IF ( ALLOCATED ( mbdy2dtemp1 ) ) DEALLOCATE ( mbdy2dtemp1 )
 695          IF ( ALLOCATED ( ubdy3dtemp2 ) ) DEALLOCATE ( ubdy3dtemp2 )
 696          IF ( ALLOCATED ( vbdy3dtemp2 ) ) DEALLOCATE ( vbdy3dtemp2 )
 697          IF ( ALLOCATED ( tbdy3dtemp2 ) ) DEALLOCATE ( tbdy3dtemp2 )
 698          IF ( ALLOCATED ( pbdy3dtemp2 ) ) DEALLOCATE ( pbdy3dtemp2 )
 699          IF ( ALLOCATED ( qbdy3dtemp2 ) ) DEALLOCATE ( qbdy3dtemp2 )
 700          IF ( ALLOCATED ( mbdy2dtemp2 ) ) DEALLOCATE ( mbdy2dtemp2 )
 701
 702          ALLOCATE ( ubdy3dtemp1(ims:ime,kms:kme,jms:jme) )
 703          ALLOCATE ( vbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
 704          ALLOCATE ( tbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
 705          ALLOCATE ( pbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
 706          ALLOCATE ( qbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
 707          ALLOCATE ( mbdy2dtemp1(ims:ime,1:1,    jms:jme) )
 708          ALLOCATE ( ubdy3dtemp2(ims:ime,kms:kme,jms:jme) )
 709          ALLOCATE ( vbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
 710          ALLOCATE ( tbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
 711          ALLOCATE ( pbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
 712          ALLOCATE ( qbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
 713          ALLOCATE ( mbdy2dtemp2(ims:ime,1:1,    jms:jme) )
 714
 715       END IF
 716
 717       !  Open the wrfinput file.  From this program, this is an *output* file.
 718
 719       CALL construct_filename1( inpname , 'wrfinput' , grid%id , 2 )
 720       CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_input , "DATASET=INPUT", ierr )
 721       IF ( ierr .NE. 0 ) THEN
 722          CALL wrf_error_fatal( 'real: error opening wrfinput for writing' )
 723       END IF
 724       CALL output_input ( id1, grid , config_flags , ierr )
 725       CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
 726
 727       IF ( time_loop_max .NE. 1 ) THEN
 728          IF(sst_update .EQ. 1)THEN
 729            CALL construct_filename1( inpname , 'wrflowinp' , grid%id , 2 )
 730            CALL open_w_dataset ( id4, TRIM(inpname) , grid , config_flags , output_auxinput4 , "DATASET=AUXINPUT4", ierr )
 731            IF ( ierr .NE. 0 ) THEN
 732               CALL wrf_error_fatal( 'real: error opening wrflowinp for writing' )
 733            END IF
 734            CALL output_auxinput4 ( id4, grid , config_flags , ierr )
 735          END IF
 736       END IF
 737
 738       IF ( ( time_loop_max .EQ. 1 )  .OR. ( config_flags%polar ) ) THEN
 739
 740          !  No need to couple data since no lateral BCs required.
 741
 742       ELSE
 743
 744          !  We need to save the 3d data to compute a difference during the next loop.  Couple the
 745          !  3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
 746
 747          !  u, theta, h, scalars coupled with my; v coupled with mx
 748          CALL couple ( grid%mu_2 , grid%mub , ubdy3dtemp1 , grid%u_2                 , 'u' , grid%msfuy , &
 749                        ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
 750          CALL couple ( grid%mu_2 , grid%mub , vbdy3dtemp1 , grid%v_2                 , 'v' , grid%msfvx , &
 751                        ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
 752          CALL couple ( grid%mu_2 , grid%mub , tbdy3dtemp1 , grid%t_2                 , 't' , grid%msfty , &
 753                        ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
 754          CALL couple ( grid%mu_2 , grid%mub , pbdy3dtemp1 , grid%ph_2                , 'h' , grid%msfty , &
 755                        ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
 756          CALL couple ( grid%mu_2 , grid%mub , qbdy3dtemp1 , grid%moist(:,:,:,P_QV)      , 't' , grid%msfty , &
 757                        ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
 758
 759          DO j = jps , MIN(jde-1,jpe)
 760             DO i = ips , MIN(ide-1,ipe)
 761                mbdy2dtemp1(i,1,j) = grid%mu_2(i,j)
 762             END DO
 763          END DO
 764
 765       END IF
 766
 767       IF(grid_fdda .GE. 1)THEN
 768          DO j = jps , jpe
 769             DO k = kps , kpe
 770                DO i = ips , ipe
 771                   grid%fdda3d(i,k,j,p_u_ndg_old) = grid%u_2(i,k,j)
 772                   grid%fdda3d(i,k,j,p_v_ndg_old) = grid%v_2(i,k,j)
 773                   grid%fdda3d(i,k,j,p_t_ndg_old) = grid%t_2(i,k,j)
 774                   grid%fdda3d(i,k,j,p_q_ndg_old) = grid%moist(i,k,j,P_QV)
 775                   grid%fdda3d(i,k,j,p_ph_ndg_old) = grid%ph_2(i,k,j)
 776                END DO
 777             END DO
 778          END DO
 779
 780          DO j = jps , jpe
 781             DO i = ips , ipe
 782                grid%fdda2d(i,1,j,p_mu_ndg_old) = grid%mu_2(i,j)
 783 !              grid%fdda2d(i,1,j,p_t2_ndg_old) = grid%t2(i,j)
 784 !              grid%fdda2d(i,1,j,p_q2_ndg_old) = grid%q2(i,j)
 785 !              grid%fdda2d(i,1,j,p_sn_ndg_old) = grid%snow(i,j)
 786             END DO
 787          END DO
 788       END IF
 789
 790       IF ( ( time_loop_max .EQ. 1 )  .OR. ( config_flags%polar ) ) THEN
 791
 792          !  No need to build boundary arrays, since no lateral BCs are being generated.
 793
 794       ELSE
 795
 796          !  There are 2 components to the lateral boundaries.  First, there is the starting
 797          !  point of this time period - just the outer few rows and columns.
 798
 799          CALL stuff_bdy     ( ubdy3dtemp1 , grid%u_bxs, grid%u_bxe, grid%u_bys, grid%u_bye, &
 800                                                               'U' , spec_bdy_width      , &
 801                                                                     ids , ide , jds , jde , kds , kde , &
 802                                                                     ims , ime , jms , jme , kms , kme , &
 803                                                                     ips , ipe , jps , jpe , kps , kpe )
 804          CALL stuff_bdy     ( vbdy3dtemp1 , grid%v_bxs, grid%v_bxe, grid%v_bys, grid%v_bye, &
 805                                                               'V' , spec_bdy_width      , &
 806                                                                     ids , ide , jds , jde , kds , kde , &
 807                                                                     ims , ime , jms , jme , kms , kme , &
 808                                                                     ips , ipe , jps , jpe , kps , kpe )
 809          CALL stuff_bdy     ( tbdy3dtemp1 , grid%t_bxs, grid%t_bxe, grid%t_bys, grid%t_bye, &
 810                                                               'T' , spec_bdy_width      , &
 811                                                                     ids , ide , jds , jde , kds , kde , &
 812                                                                     ims , ime , jms , jme , kms , kme , &
 813                                                                     ips , ipe , jps , jpe , kps , kpe )
 814          CALL stuff_bdy     ( pbdy3dtemp1 , grid%ph_bxs, grid%ph_bxe, grid%ph_bys, grid%ph_bye, &
 815                                                               'W' , spec_bdy_width      , &
 816                                                                     ids , ide , jds , jde , kds , kde , &
 817                                                                     ims , ime , jms , jme , kms , kme , &
 818                                                                     ips , ipe , jps , jpe , kps , kpe )
 819          CALL stuff_bdy     ( qbdy3dtemp1 , grid%moist_bxs(:,:,:,P_QV), grid%moist_bxe(:,:,:,P_QV),     &
 820                                             grid%moist_bys(:,:,:,P_QV), grid%moist_bye(:,:,:,P_QV),     &
 821                                                               'T' , spec_bdy_width      ,               &
 822                                                                     ids , ide , jds , jde , kds , kde , &
 823                                                                     ims , ime , jms , jme , kms , kme , &
 824                                                                     ips , ipe , jps , jpe , kps , kpe )
 825          CALL stuff_bdy     ( mbdy2dtemp1 , grid%mu_bxs, grid%mu_bxe, grid%mu_bys, grid%mu_bye, &
 826                                                               'M' , spec_bdy_width      , &
 827                                                                     ids , ide , jds , jde , 1 , 1 , &
 828                                                                     ims , ime , jms , jme , 1 , 1 , &
 829                                                                     ips , ipe , jps , jpe , 1 , 1 )
 830       END IF
 831
 832
 833    ELSE IF ( loop .GT. 1 ) THEN
 834
 835       IF(sst_update .EQ. 1)THEN
 836         CALL output_auxinput4 ( id4, grid , config_flags , ierr )
 837       END IF
 838
 839       !  Open the boundary and the fdda file.
 840
 841       IF ( loop .eq. 2 ) THEN
 842          IF ( (grid%id .eq. 1) .and. ( .NOT. config_flags%polar ) ) THEN
 843             CALL construct_filename1( bdyname , 'wrfbdy' , grid%id , 2 )
 844             CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , output_boundary , "DATASET=BOUNDARY", ierr )
 845             IF ( ierr .NE. 0 ) THEN
 846                CALL wrf_error_fatal( 'real: error opening wrfbdy for writing' )
 847             END IF
 848          END IF
 849          IF(grid_fdda .GE. 1)THEN
 850             CALL construct_filename1( inpname , 'wrffdda' , grid%id , 2 )
 851             CALL open_w_dataset ( id2, TRIM(inpname) , grid , config_flags , output_auxinput10 , "DATASET=AUXINPUT10", ierr )
 852             IF ( ierr .NE. 0 ) THEN
 853                CALL wrf_error_fatal( 'real: error opening wrffdda for writing' )
 854             END IF
 855          END IF
 856       ELSE
 857          IF ( .NOT. domain_clockisstoptime(grid) ) THEN
 858             CALL domain_clockadvance( grid )
 859             CALL domain_clockprint ( 150, grid, &
 860                    'DEBUG assemble_output:  clock after ClockAdvance,' )
 861          END IF
 862       END IF
 863
 864       IF ( config_flags%polar ) THEN
 865
 866          !  No need to couple fields, since no lateral BCs are required.
 867
 868       ELSE
 869
 870          !  Couple this time period's data with total mu, and save it in the *bdy3dtemp2 arrays.
 871
 872          !  u, theta, h, scalars coupled with my; v coupled with mx
 873          CALL couple ( grid%mu_2 , grid%mub , ubdy3dtemp2 , grid%u_2                 , 'u' , grid%msfuy , &
 874                        ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
 875          CALL couple ( grid%mu_2 , grid%mub , vbdy3dtemp2 , grid%v_2                 , 'v' , grid%msfvx , &
 876                        ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
 877          CALL couple ( grid%mu_2 , grid%mub , tbdy3dtemp2 , grid%t_2                 , 't' , grid%msfty , &
 878                        ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
 879          CALL couple ( grid%mu_2 , grid%mub , pbdy3dtemp2 , grid%ph_2                , 'h' , grid%msfty , &
 880                        ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
 881          CALL couple ( grid%mu_2 , grid%mub , qbdy3dtemp2 , grid%moist(:,:,:,P_QV)      , 't' , grid%msfty , &
 882                        ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
 883
 884          DO j = jps , jpe
 885             DO i = ips , ipe
 886                mbdy2dtemp2(i,1,j) = grid%mu_2(i,j)
 887             END DO
 888          END DO
 889
 890       END IF
 891
 892       IF(grid_fdda .GE. 1)THEN
 893          DO j = jps , jpe
 894             DO k = kps , kpe
 895                DO i = ips , ipe
 896                   grid%fdda3d(i,k,j,p_u_ndg_new) = grid%u_2(i,k,j)
 897                   grid%fdda3d(i,k,j,p_v_ndg_new) = grid%v_2(i,k,j)
 898                   grid%fdda3d(i,k,j,p_t_ndg_new) = grid%t_2(i,k,j)
 899                   grid%fdda3d(i,k,j,p_q_ndg_new) = grid%moist(i,k,j,P_QV)
 900                   grid%fdda3d(i,k,j,p_ph_ndg_new) = grid%ph_2(i,k,j)
 901                END DO
 902             END DO
 903          END DO
 904
 905          DO j = jps , jpe
 906             DO i = ips , ipe
 907                grid%fdda2d(i,1,j,p_mu_ndg_new) = grid%mu_2(i,j)
 908 !              grid%fdda2d(i,1,j,p_t2_ndg_new) = grid%t2(i,j)
 909 !              grid%fdda2d(i,1,j,p_q2_ndg_new) = grid%q2(i,j)
 910 !              grid%fdda2d(i,1,j,p_sn_ndg_new) = grid%snow(i,j)
 911             END DO
 912          END DO
 913       END IF
 914
 915       IF ( config_flags%polar ) THEN
 916
 917          !  No need to build boundary arrays, since no lateral BCs are being generated.
 918
 919       ELSE
 920
 921          !  During all of the loops after the first loop, we first compute the boundary
 922          !  tendencies with the current data values (*bdy3dtemp2 arrays) and the previously
 923          !  saved information stored in the *bdy3dtemp1 arrays.
 924
 925          CALL stuff_bdytend ( ubdy3dtemp2 , ubdy3dtemp1 , REAL(interval_seconds) ,                 &
 926                                                                grid%u_btxs, grid%u_btxe,     &
 927                                                                grid%u_btys, grid%u_btye,     &
 928                                                                'U' , &
 929                                                                spec_bdy_width      , &
 930                                                                ids , ide , jds , jde , kds , kde , &
 931                                                                ims , ime , jms , jme , kms , kme , &
 932                                                                ips , ipe , jps , jpe , kps , kpe )
 933          CALL stuff_bdytend ( vbdy3dtemp2 , vbdy3dtemp1 , REAL(interval_seconds) ,                 &
 934                                                                grid%v_btxs, grid%v_btxe,     &
 935                                                                grid%v_btys, grid%v_btye,     &
 936                                                                'V' , &
 937                                                                spec_bdy_width      , &
 938                                                                ids , ide , jds , jde , kds , kde , &
 939                                                                ims , ime , jms , jme , kms , kme , &
 940                                                                ips , ipe , jps , jpe , kps , kpe )
 941          CALL stuff_bdytend ( tbdy3dtemp2 , tbdy3dtemp1 , REAL(interval_seconds) ,                 &
 942                                                                grid%t_btxs, grid%t_btxe,     &
 943                                                                grid%t_btys, grid%t_btye,     &
 944                                                                'T' , &
 945                                                                spec_bdy_width      , &
 946                                                                ids , ide , jds , jde , kds , kde , &
 947                                                                ims , ime , jms , jme , kms , kme , &
 948                                                                ips , ipe , jps , jpe , kps , kpe )
 949          CALL stuff_bdytend ( pbdy3dtemp2 , pbdy3dtemp1 , REAL(interval_seconds) ,                 &
 950                                                                grid%ph_btxs, grid%ph_btxe,   &
 951                                                                grid%ph_btys, grid%ph_btye,   &
 952                                                                'W' , &
 953                                                                spec_bdy_width      , &
 954                                                                ids , ide , jds , jde , kds , kde , &
 955                                                                ims , ime , jms , jme , kms , kme , &
 956                                                                ips , ipe , jps , jpe , kps , kpe )
 957          CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , REAL(interval_seconds) ,                 &
 958                                                                grid%moist_btxs(:,:,:,P_QV), grid%moist_btxe(:,:,:,P_QV), &
 959                                                                grid%moist_btys(:,:,:,P_QV), grid%moist_btye(:,:,:,P_QV), &
 960                                                                'T' , &
 961                                                                spec_bdy_width      , &
 962                                                                ids , ide , jds , jde , kds , kde , &
 963                                                                ims , ime , jms , jme , kms , kme , &
 964                                                                ips , ipe , jps , jpe , kps , kpe )
 965          CALL stuff_bdytend ( mbdy2dtemp2 , mbdy2dtemp1 , REAL(interval_seconds) ,                 &
 966                                                                grid%mu_btxs, grid%mu_btxe,   &
 967                                                                grid%mu_btys, grid%mu_btye,   &
 968                                                                'M' , &
 969                                                                spec_bdy_width      , &
 970                                                                ids , ide , jds , jde , 1 , 1 , &
 971                                                                ims , ime , jms , jme , 1 , 1 , &
 972                                                                ips , ipe , jps , jpe , 1 , 1 )
 973       END IF
 974
 975       !  Both pieces of the boundary data are now available to be written (initial time and tendency).
 976       !  This looks ugly, these date shifting things.  What's it for?  We want the "Times" variable
 977       !  in the lateral BDY file to have the valid times of when the initial fields are written.
 978       !  That's what the loop-2 thingy is for with the start date.  We increment the start_date so
 979       !  that the starting time in the attributes is the second time period.  Why you may ask.  I
 980       !  agree, why indeed.
 981
 982       CALL domain_clockprint ( 150, grid, &
 983              'DEBUG assemble_output:  clock before 1st current_date set,' )
 984       WRITE (wrf_err_message,*) &
 985         'DEBUG assemble_output:  before 1st currTime set, current_date = ',TRIM(current_date)
 986       CALL wrf_debug ( 150 , wrf_err_message )
 987       CALL domain_clock_set( grid, current_date(1:19) )
 988       CALL domain_clockprint ( 150, grid, &
 989              'DEBUG assemble_output:  clock after 1st current_date set,' )
 990
 991       temp24= current_date
 992       temp24b=start_date
 993       start_date = current_date
 994       CALL geth_newdate ( temp19 , temp24b(1:19) , (loop-2) * model_config_rec%interval_seconds )
 995       current_date = temp19 //  '.0000'
 996       CALL domain_clockprint ( 150, grid, &
 997              'DEBUG assemble_output:  clock before 2nd current_date set,' )
 998       WRITE (wrf_err_message,*) &
 999         'DEBUG assemble_output:  before 2nd currTime set, current_date = ',TRIM(current_date)
1000       CALL wrf_debug ( 150 , wrf_err_message )
1001       CALL domain_clock_set( grid, current_date(1:19) )
1002       CALL domain_clockprint ( 150, grid, &
1003              'DEBUG assemble_output:  clock after 2nd current_date set,' )
1004
1005       IF ( config_flags%polar ) THEN
1006
1007          !  No need to ouput boundary data for polar cases.
1008
1009       ELSE
1010
1011          !  Output boundary file.
1012
1013          IF(grid%id .EQ. 1)THEN
1014            print *,'LBC valid between these times ',current_date, ' ',start_date
1015            CALL output_boundary ( id, grid , config_flags , ierr )
1016          END IF
1017
1018       END IF
1019
1020       !  Output gridded/analysis FDDA file.
1021
1022       IF(grid_fdda .GE. 1) THEN
1023          CALL output_auxinput10 ( id2, grid , config_flags , ierr )
1024       END IF
1025
1026       current_date = temp24
1027       start_date = temp24b
1028       CALL domain_clockprint ( 150, grid, &
1029              'DEBUG assemble_output:  clock before 3rd current_date set,' )
1030       WRITE (wrf_err_message,*) &
1031         'DEBUG assemble_output:  before 3rd currTime set, current_date = ',TRIM(current_date)
1032       CALL wrf_debug ( 150 , wrf_err_message )
1033       CALL domain_clock_set( grid, current_date(1:19) )
1034       CALL domain_clockprint ( 150, grid, &
1035              'DEBUG assemble_output:  clock after 3rd current_date set,' )
1036
1037       !  OK, for all of the loops, we output the initialzation data, which would allow us to
1038       !  start the model at any of the available analysis time periods.
1039
1040       IF ( config_flags%all_ic_times ) THEN
1041          CALL construct_filename2a ( inpname , 'wrfinput_d<domain>.<date>' , grid%id , 2 , TRIM(current_date) )
1042          CALL open_w_dataset ( id1, inpname , grid , config_flags , output_input , "DATASET=INPUT", ierr )
1043          IF ( ierr .NE. 0 ) THEN
1044             CALL wrf_error_fatal( 'real: error opening' // inpname // ' for writing' )
1045          END IF
1046          CALL output_input ( id1, grid , config_flags , ierr )
1047          CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
1048       END IF
1049
1050       !  Is this or is this not the last time time?  We can remove some unnecessary
1051       !  stores if it is not.
1052
1053       IF     ( loop .LT. time_loop_max ) THEN
1054
1055          IF ( config_flags%polar ) THEN
1056
1057             !  No need to swap old for new for the boundary data, it is not required.
1058
1059          ELSE
1060
1061             !  We need to save the 3d data to compute a difference during the next loop.  Couple the
1062             !  3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
1063             !  We load up the boundary data again for use in the next loop.
1064
1065             DO j = jps , jpe
1066                DO k = kps , kpe
1067                   DO i = ips , ipe
1068                      ubdy3dtemp1(i,k,j) = ubdy3dtemp2(i,k,j)
1069                      vbdy3dtemp1(i,k,j) = vbdy3dtemp2(i,k,j)
1070                      tbdy3dtemp1(i,k,j) = tbdy3dtemp2(i,k,j)
1071                      pbdy3dtemp1(i,k,j) = pbdy3dtemp2(i,k,j)
1072                      qbdy3dtemp1(i,k,j) = qbdy3dtemp2(i,k,j)
1073                   END DO
1074                END DO
1075             END DO
1076
1077             DO j = jps , jpe
1078                DO i = ips , ipe
1079                   mbdy2dtemp1(i,1,j) = mbdy2dtemp2(i,1,j)
1080                END DO
1081             END DO
1082
1083          END IF
1084
1085          IF(grid_fdda .GE. 1)THEN
1086             DO j = jps , jpe
1087                DO k = kps , kpe
1088                   DO i = ips , ipe
1089                      grid%fdda3d(i,k,j,p_u_ndg_old) = grid%fdda3d(i,k,j,p_u_ndg_new)
1090                      grid%fdda3d(i,k,j,p_v_ndg_old) = grid%fdda3d(i,k,j,p_v_ndg_new)
1091                      grid%fdda3d(i,k,j,p_t_ndg_old) = grid%fdda3d(i,k,j,p_t_ndg_new)
1092                      grid%fdda3d(i,k,j,p_q_ndg_old) = grid%fdda3d(i,k,j,p_q_ndg_new)
1093                      grid%fdda3d(i,k,j,p_ph_ndg_old) = grid%fdda3d(i,k,j,p_ph_ndg_new)
1094                   END DO
1095                END DO
1096             END DO
1097
1098             DO j = jps , jpe
1099                DO i = ips , ipe
1100                   grid%fdda2d(i,1,j,p_mu_ndg_old) = grid%fdda2d(i,1,j,p_mu_ndg_new)
1101 !                 grid%fdda2d(i,1,j,p_t2_ndg_old) = grid%fdda2d(i,1,j,p_t2_ndg_new)
1102 !                 grid%fdda2d(i,1,j,p_q2_ndg_old) = grid%fdda2d(i,1,j,p_q2_ndg_new)
1103 !                 grid%fdda2d(i,1,j,p_sn_ndg_old) = grid%fdda2d(i,1,j,p_sn_ndg_new)
1104                END DO
1105             END DO
1106          END IF
1107
1108          IF ( config_flags%polar ) THEN
1109
1110             !  No need to build boundary arrays, since no lateral BCs are being generated.
1111
1112          ELSE
1113
1114             !  There are 2 components to the lateral boundaries.  First, there is the starting
1115             !  point of this time period - just the outer few rows and columns.
1116
1117             CALL stuff_bdy     ( ubdy3dtemp1 , grid%u_bxs, grid%u_bxe, grid%u_bys, grid%u_bye, &
1118                                                                  'U' , spec_bdy_width      , &
1119                                                                        ids , ide , jds , jde , kds , kde , &
1120                                                                        ims , ime , jms , jme , kms , kme , &
1121                                                                        ips , ipe , jps , jpe , kps , kpe )
1122             CALL stuff_bdy     ( vbdy3dtemp1 , grid%v_bxs, grid%v_bxe, grid%v_bys, grid%v_bye, &
1123                                                                  'V' , spec_bdy_width      , &
1124                                                                        ids , ide , jds , jde , kds , kde , &
1125                                                                        ims , ime , jms , jme , kms , kme , &
1126                                                                        ips , ipe , jps , jpe , kps , kpe )
1127             CALL stuff_bdy     ( tbdy3dtemp1 , grid%t_bxs, grid%t_bxe, grid%t_bys, grid%t_bye, &
1128                                                                  'T' , spec_bdy_width      , &
1129                                                                        ids , ide , jds , jde , kds , kde , &
1130                                                                        ims , ime , jms , jme , kms , kme , &
1131                                                                        ips , ipe , jps , jpe , kps , kpe )
1132             CALL stuff_bdy     ( pbdy3dtemp1 , grid%ph_bxs, grid%ph_bxe, grid%ph_bys, grid%ph_bye, &
1133                                                                  'W' , spec_bdy_width      , &
1134                                                                        ids , ide , jds , jde , kds , kde , &
1135                                                                        ims , ime , jms , jme , kms , kme , &
1136                                                                        ips , ipe , jps , jpe , kps , kpe )
1137             CALL stuff_bdy     ( qbdy3dtemp1 , grid%moist_bxs(:,:,:,P_QV), grid%moist_bxe(:,:,:,P_QV),     &
1138                                                grid%moist_bys(:,:,:,P_QV), grid%moist_bye(:,:,:,P_QV),     &
1139                                                                  'T' , spec_bdy_width      ,               &
1140                                                                        ids , ide , jds , jde , kds , kde , &
1141                                                                        ims , ime , jms , jme , kms , kme , &
1142                                                                        ips , ipe , jps , jpe , kps , kpe )
1143             CALL stuff_bdy     ( mbdy2dtemp1 , grid%mu_bxs, grid%mu_bxe, grid%mu_bys, grid%mu_bye, &
1144                                                                  'M' , spec_bdy_width      , &
1145                                                                        ids , ide , jds , jde , 1 , 1 , &
1146                                                                        ims , ime , jms , jme , 1 , 1 , &
1147                                                                        ips , ipe , jps , jpe , 1 , 1 )
1148
1149          END IF
1150
1151       ELSE IF ( loop .EQ. time_loop_max ) THEN
1152
1153          !  If this is the last time through here, we need to close the files.
1154
1155          IF ( config_flags%polar ) THEN
1156
1157             !  No need to close the boundary file, it was never used.
1158
1159          ELSE
1160             IF(grid%id .EQ. 1) THEN
1161                CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
1162             END IF
1163          END IF
1164
1165          IF(grid_fdda .GE. 1) THEN
1166             CALL close_dataset ( id2 , config_flags , "DATASET=AUXINPUT10" )
1167          END IF
1168
1169          IF(sst_update .EQ. 1)THEN
1170             CALL close_dataset ( id4 , config_flags , "DATASET=AUXINPUT4" )
1171          END IF
1172
1173       END IF
1174
1175    END IF
1176
1177 END SUBROUTINE assemble_output