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