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