wrfv2_fire/main/real_nmm.F

   1 !  Create an initial data set for the WRF model based on real data.  This
   2 !  program is specifically set up for the NMM core.
   3
   4 PROGRAM real_data
   5
   6    USE module_machine
   7    USE module_domain
   8    USE module_initialize_real
   9    USE module_io_domain
  10    USE module_driver_constants
  11    USE module_configure
  12    USE module_timing
  13 #ifdef WRF_CHEM
  14    USE module_input_chem_data
  15    USE module_input_chem_bioemiss
  16 #endif
  17    USE module_utility
  18 #ifdef DM_PARALLEL
  19    USE module_dm
  20 #endif
  21
  22    IMPLICIT NONE
  23
  24    REAL    :: time , bdyfrq
  25
  26    INTEGER :: loop , levels_to_process , debug_level
  27
  28
  29    TYPE(domain) , POINTER :: null_domain
  30    TYPE(domain) , POINTER :: grid
  31    TYPE (grid_config_rec_type)              :: config_flags
  32    INTEGER                :: number_at_same_level
  33
  34    INTEGER :: max_dom, domain_id
  35    INTEGER :: idum1, idum2
  36 #ifdef DM_PARALLEL
  37    INTEGER                 :: nbytes
  38 !   INTEGER, PARAMETER      :: configbuflen = 2*1024
  39    INTEGER, PARAMETER      :: configbuflen = 4*CONFIG_BUF_LEN
  40    INTEGER                 :: configbuf( configbuflen )
  41    LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
  42 #endif
  43
  44    INTEGER :: ids , ide , jds , jde , kds , kde
  45    INTEGER :: ims , ime , jms , jme , kms , kme
  46    INTEGER :: ips , ipe , jps , jpe , kps , kpe
  47    INTEGER :: ijds , ijde , spec_bdy_width
  48    INTEGER :: i , j , k , idts
  49
  50 #ifdef DEREF_KLUDGE
  51 !  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
  52    INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
  53    INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
  54    INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
  55 #endif
  56
  57    CHARACTER (LEN=80)     :: message
  58
  59    INTEGER :: start_year , start_month , start_day
  60    INTEGER :: start_hour , start_minute , start_second
  61    INTEGER :: end_year ,   end_month ,   end_day ,   &
  62               end_hour ,   end_minute ,   end_second
  63    INTEGER :: interval_seconds , real_data_init_type
  64    INTEGER :: time_loop_max , time_loop, rc
  65    REAL    :: t1,t2
  66
  67 #include "version_decl"
  68
  69    INTERFACE
  70      SUBROUTINE Setup_Timekeeping( grid )
  71       USE module_domain
  72       TYPE(domain), POINTER :: grid
  73      END SUBROUTINE Setup_Timekeeping
  74    END INTERFACE
  75
  76    !  Define the name of this program (program_name defined in module_domain)
  77
  78    program_name = "REAL_NMM " // TRIM(release_version) // " PREPROCESSOR"
  79
  80 #ifdef DM_PARALLEL
  81    CALL disable_quilting
  82 #endif
  83
  84 !       CALL start()
  85
  86    !  Initialize the modules used by the WRF system.
  87    !  Many of the CALLs made from the
  88    !  init_modules routine are NO-OPs.  Typical initializations
  89    !  are: the size of a
  90    !  REAL, setting the file handles to a pre-use value, defining moisture and
  91    !  chemistry indices, etc.
  92
  93    CALL       wrf_debug ( 100 , 'real_nmm: calling init_modules ' )
  94
  95 !!!!   CALL init_modules
  96    CALL init_modules(1)   ! Phase 1 returns after MPI_INIT() (if it is called)
  97    CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
  98    CALL init_modules(2)   ! Phase 2 resumes after MPI_INIT() (if it is called)
  99
 100    !  The configuration switches mostly come from the NAMELIST input.
 101
 102 #ifdef DM_PARALLEL
 103    IF ( wrf_dm_on_monitor() ) THEN
 104       write(message,*) 'call initial_config'
 105       CALL wrf_message ( message )
 106       CALL initial_config
 107    ENDIF
 108    CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
 109    CALL wrf_dm_bcast_bytes( configbuf, nbytes )
 110    CALL set_config_as_buffer( configbuf, configbuflen )
 111    CALL wrf_dm_initialize
 112 #else
 113    CALL initial_config
 114 #endif
 115
 116
 117    CALL nl_get_debug_level ( 1, debug_level )
 118    CALL set_wrf_debug_level ( debug_level )
 119
 120    CALL  wrf_message ( program_name )
 121
 122    !  Allocate the space for the mother of all domains.
 123
 124    NULLIFY( null_domain )
 125    CALL  wrf_debug ( 100 , 'real_nmm: calling alloc_and_configure_domain ' )
 126    CALL alloc_and_configure_domain ( domain_id  = 1           , &
 127                                      grid       = head_grid   , &
 128                                      parent     = null_domain , &
 129                                      kid        = -1            )
 130
 131    grid => head_grid
 132
 133 #include "deref_kludge.h"
 134    CALL Setup_Timekeeping ( grid )
 135    CALL domain_clock_set( grid, &
 136                           time_step_seconds=model_config_rec%interval_seconds )
 137    CALL wrf_debug ( 100 , 'real_nmm: calling set_scalar_indices_from_config ' )
 138    CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
 139
 140    CALL     wrf_debug ( 100 , 'real_nmm: calling model_to_grid_config_rec ' )
 141
 142    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 143
 144    write(message,*) 'after model_to_grid_config_rec, e_we, e_sn are: ', &
 145                     config_flags%e_we, config_flags%e_sn
 146    CALL wrf_message(message)
 147
 148    !  Initialize the WRF IO: open files, init file handles, etc.
 149
 150    CALL       wrf_debug ( 100 , 'real_nmm: calling init_wrfio' )
 151    CALL init_wrfio
 152
 153 !  Some of the configuration values may have been modified from the initial READ
 154 !  of the NAMELIST, so we re-broadcast the configuration records.
 155
 156 #ifdef DM_PARALLEL
 157    CALL wrf_debug ( 100 , 'real_nmm: re-broadcast the configuration records' )
 158    CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
 159    CALL wrf_dm_bcast_bytes( configbuf, nbytes )
 160    CALL set_config_as_buffer( configbuf, configbuflen )
 161 #endif
 162
 163    !   No looping in this layer.
 164
 165    CALL med_sidata_input ( grid , config_flags )
 166
 167    !  We are done.
 168
 169    CALL       wrf_debug (   0 , 'real_nmm: SUCCESS COMPLETE REAL_NMM INIT' )
 170
 171 #ifdef DM_PARALLEL
 172     CALL wrf_dm_shutdown
 173 #endif
 174
 175    CALL WRFU_Finalize( rc=rc )
 176
 177 END PROGRAM real_data
 178
 179 SUBROUTINE med_sidata_input ( grid , config_flags )
 180   ! Driver layer
 181    USE module_domain
 182    USE module_io_domain
 183   ! Model layer
 184    USE module_configure
 185    USE module_bc_time_utilities
 186    USE module_initialize_real
 187    USE module_optional_input
 188 #ifdef WRF_CHEM
 189    USE module_input_chem_data
 190    USE module_input_chem_bioemiss
 191 #endif
 192
 193    USE module_si_io_nmm
 194
 195    USE module_date_time
 196
 197    IMPLICIT NONE
 198
 199
 200   ! Interface
 201    INTERFACE
 202      SUBROUTINE start_domain ( grid , allowed_to_read )
 203        USE module_domain
 204        TYPE (domain) grid
 205        LOGICAL, INTENT(IN) :: allowed_to_read
 206      END SUBROUTINE start_domain
 207    END INTERFACE
 208
 209   ! Arguments
 210    TYPE(domain)                :: grid
 211    TYPE (grid_config_rec_type) :: config_flags
 212   ! Local
 213    INTEGER                :: time_step_begin_restart
 214    INTEGER                :: idsi , ierr , myproc
 215    CHARACTER (LEN=80)      :: si_inpname
 216    CHARACTER (LEN=132)     :: message
 217
 218    CHARACTER(LEN=19) :: start_date_char , end_date_char , &
 219                         current_date_char , next_date_char
 220
 221    INTEGER :: time_loop_max , loop
 222    INTEGER :: julyr , julday , LEN
 223
 224    INTEGER :: io_form_auxinput1
 225    INTEGER, EXTERNAL :: use_package
 226
 227    LOGICAL :: using_binary_wrfsi
 228
 229    REAL :: gmt
 230    REAL :: t1,t2
 231
 232    INTEGER :: numx_sm_levels_input,numx_st_levels_input
 233    REAL,DIMENSION(100) :: smx_levels_input,stx_levels_input
 234
 235
 236 #ifdef DEREF_KLUDGE
 237 !  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
 238    INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
 239    INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
 240    INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
 241 #endif
 242
 243 #include "deref_kludge.h"
 244
 245
 246    grid%input_from_file = .true.
 247    grid%input_from_file = .false.
 248
 249    CALL compute_si_start_and_end ( model_config_rec%start_year  (grid%id) , &
 250                                    model_config_rec%start_month (grid%id) , &
 251                                    model_config_rec%start_day   (grid%id) , &
 252                                    model_config_rec%start_hour  (grid%id) , &
 253                                    model_config_rec%start_minute(grid%id) , &
 254                                    model_config_rec%start_second(grid%id) , &
 255                                    model_config_rec%  end_year  (grid%id) , &
 256                                    model_config_rec%  end_month (grid%id) , &
 257                                    model_config_rec%  end_day   (grid%id) , &
 258                                    model_config_rec%  end_hour  (grid%id) , &
 259                                    model_config_rec%  end_minute(grid%id) , &
 260                                    model_config_rec%  end_second(grid%id) , &
 261                                    model_config_rec%interval_seconds      , &
 262                                    model_config_rec%real_data_init_type   , &
 263                                    start_date_char , end_date_char , time_loop_max )
 264
 265    !  Here we define the initial time to process, for later use by the code.
 266
 267    current_date_char = start_date_char
 268 !   start_date = start_date_char // '.0000'
 269    start_date = start_date_char
 270    current_date = start_date
 271
 272    CALL nl_set_bdyfrq ( grid%id , REAL(model_config_rec%interval_seconds) )
 273
 274    !  Loop over each time period to process.
 275
 276    write(message,*) 'time_loop_max: ', time_loop_max
 277    CALL wrf_message(message)
 278    DO loop = 1 , time_loop_max
 279
 280      internal_time_loop=loop
 281
 282       write(message,*) 'loop=', loop
 283       CALL wrf_message(message)
 284
 285       write(message,*) '-----------------------------------------------------------'
 286       CALL wrf_message(message)
 287
 288       write(message,*) ' '
 289       CALL wrf_message(message)
 290       write(message,'(A,A,A,I2,A,I2)') ' Current date being processed: ', &
 291         current_date, ', which is loop #',loop,' out of ',time_loop_max
 292       CALL wrf_message(message)
 293
 294       !  After current_date has been set, fill in the julgmt stuff.
 295
 296       CALL geth_julgmt ( config_flags%julyr , config_flags%julday , &
 297                                               config_flags%gmt )
 298
 299       !  Now that the specific Julian info is available,
 300       !  save these in the model config record.
 301
 302       CALL nl_set_gmt (grid%id, config_flags%gmt)
 303       CALL nl_set_julyr (grid%id, config_flags%julyr)
 304       CALL nl_set_julday (grid%id, config_flags%julday)
 305
 306       CALL nl_get_io_form_auxinput1( 1, io_form_auxinput1 )
 307       using_binary_wrfsi=.false.
 308
 309
 310       write(message,*) 'TRIM(config_flags%auxinput1_inname): ', TRIM(config_flags%auxinput1_inname)
 311       CALL wrf_message(message)
 312
 313       IF (config_flags%auxinput1_inname(1:10) .eq. 'real_input') THEN
 314          using_binary_wrfsi=.true.
 315       ENDIF
 316
 317       SELECT CASE ( use_package(io_form_auxinput1) )
 318 #ifdef NETCDF
 319       CASE ( IO_NETCDF   )
 320
 321       !  Open the wrfinput file.
 322
 323         current_date_char(11:11)='_'
 324
 325        WRITE ( wrf_err_message , FMT='(A,A)' )'med_sidata_input: calling open_r_dataset for ',TRIM(config_flags%auxinput1_inname)
 326        CALL wrf_debug ( 100 , wrf_err_message )
 327        IF ( config_flags%auxinput1_inname(1:8) .NE. 'wrf_real' ) THEN
 328           CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char , &
 329                                      config_flags%io_form_auxinput1 )
 330        ELSE
 331           CALL construct_filename2a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char )
 332        END IF
 333        CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
 334
 335        IF ( ierr .NE. 0 ) THEN
 336           CALL wrf_error_fatal( 'error opening ' // TRIM(si_inpname) // ' for input; bad date in namelist or file not in directory' )
 337        ENDIF
 338
 339       !  Input data.
 340
 341       CALL wrf_debug (100, 'med_sidata_input: call input_aux_model_input1_wrf')
 342
 343       CALL input_aux_model_input1 ( idsi, grid, config_flags, ierr )
 344
 345       !  Possible optional SI input.  This sets flags used by init_domain.
 346
 347       IF ( loop .EQ. 1 ) THEN
 348          CALL  wrf_debug (100, 'med_sidata_input: call init_module_optional_input' )
 349          CALL init_module_optional_input ( grid , config_flags )
 350       CALL wrf_debug ( 100 , 'med_sidata_input: calling optional_input' )
 351 !
 352       CALL optional_input ( grid , idsi , config_flags )
 353         write(0,*) 'maxval st_input(1) within real_nmm: ', maxval(st_input(:,1,:))
 354       END IF
 355 !
 356       CALL close_dataset ( idsi , config_flags , "DATASET=AUXINPUT1" )
 357
 358 #endif
 359 #ifdef INTIO
 360       CASE ( IO_INTIO )
 361
 362       !  Possible optional SI input.  This sets flags used by init_domain.
 363
 364       IF ( loop .EQ. 1 ) THEN
 365          CALL  wrf_debug (100, 'med_sidata_input: call init_module_optional_input' )
 366          CALL init_module_optional_input ( grid , config_flags )
 367       END IF
 368
 369       IF (using_binary_wrfsi) THEN
 370
 371         current_date_char(11:11)='_'
 372         CALL read_si ( grid, current_date_char )
 373         current_date_char(11:11)='T'
 374
 375       ELSE
 376
 377         write(message,*) 'binary WPS branch'
 378         CALL wrf_message(message)
 379         CALL wrf_error_fatal("binary WPS support deferred for initial release")
 380
 381 !       WRITE ( wrf_err_message , FMT='(A,A)' )'med_sidata_input: calling open_r_dataset for ',TRIM(config_flags%auxinput1_inname)
 382 !       CALL wrf_debug ( 100 , wrf_err_message )
 383 !       CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char , config_flags%io_form_auxinput1 )
 384 !       CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
 385
 386 !         IF ( ierr .NE. 0 ) THEN
 387 !            CALL wrf_debug( 1 , 'error opening ' // TRIM(si_inpname) // ' for input; bad date in namelist or file not in directory' )
 388 !            CALL wrf_debug( 1 , 'will try again without the extension' )
 389 !            CALL construct_filename2a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char )
 390 !            CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
 391 !            IF ( ierr .NE. 0 ) THEN
 392 !               CALL wrf_error_fatal( 'error opening ' // TRIM(si_inpname) // ' for input; bad date in namelist or file not in directory' )
 393 !            ENDIF
 394 !         ENDIF
 395
 396       !  Input data.
 397
 398 !!! believe problematic as binary data from WPS will be XYZ ordered, while this
 399 !!! version of WRF will read in as XZY.  OR read all fields in as unique
 400 !!! Registry items that are XYZ, then swap.  More memory, and more overhead, but
 401 !!! better than having a stand alone "read_si" type code??
 402
 403 !      CALL wrf_debug (100, 'med_sidata_input: call input_aux_model_input1_wrf')
 404 !      CALL input_aux_model_input1 ( idsi, grid, config_flags, ierr )
 405
 406       !  Possible optional SI input.  This sets flags used by init_domain.
 407
 408 !      IF ( loop .EQ. 1 ) THEN
 409 !         CALL  wrf_debug (100, 'med_sidata_input: call init_module_optional_input' )
 410 !         CALL init_module_optional_input ( grid , config_flags )
 411 !      END IF
 412 !      CALL wrf_debug ( 100 , 'med_sidata_input: calling optional_input' )
 413 !
 414 !      CALL optional_input ( grid , idsi , config_flags)
 415 !        flag_metgrid=1
 416
 417 !
 418 !      CALL close_dataset ( idsi , config_flags , "DATASET=AUXINPUT1" )
 419
 420           ENDIF
 421
 422 #endif
 423       CASE DEFAULT
 424         CALL wrf_error_fatal('real: not valid io_form_auxinput1')
 425       END SELECT
 426
 427       grid%islope=1
 428       grid%vegfra=grid%vegfrc
 429       grid%dfrlg=grid%dfl/9.81
 430
 431       grid%isurban=1
 432       grid%isoilwater=14
 433
 434       !  Initialize the mother domain for this time period with input data.
 435
 436       CALL wrf_debug ( 100 , 'med_sidata_input: calling init_domain' )
 437       grid%input_from_file = .true.
 438
 439       CALL init_domain ( grid )
 440
 441       CALL model_to_grid_config_rec ( grid%id, model_config_rec, config_flags )
 442
 443       !  Close this file that is output from the SI and input to this pre-proc.
 444
 445       CALL wrf_debug ( 100 , 'med_sidata_input: back from init_domain' )
 446
 447
 448 !!! not sure about this, but doesnt seem like needs to be called each time
 449       IF ( loop .EQ. 1 ) THEN
 450         CALL start_domain ( grid , .TRUE.)
 451       END IF
 452
 453 #ifdef WRF_CHEM
 454       IF ( loop == 1 ) THEN
 455 !        IF ( ( grid%chem_opt .EQ. RADM2     ) .OR. &
 456 !             ( grid%chem_opt .EQ. RADM2SORG ) .OR. &
 457 !             ( grid%chem_opt .EQ. RACM      ) .OR. &
 458 !             ( grid%chem_opt .EQ. RACMSORG  ) ) THEN
 459          IF( grid%chem_opt > 0 ) then
 460            ! Read the chemistry data from a previous wrf forecast (wrfout file)
 461            IF(grid%chem_in_opt == 1 ) THEN
 462               message = 'INITIALIZING CHEMISTRY WITH OLD SIMULATION'
 463               CALL  wrf_message ( message )
 464
 465               CALL input_ext_chem_file( grid )
 466
 467               IF(grid%bio_emiss_opt == BEIS311 ) THEN
 468                  message = 'READING BEIS3.11 EMISSIONS DATA'
 469                  CALL  wrf_message ( message )
 470                  CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
 471               else IF(grid%bio_emiss_opt == 3 ) THEN !shc
 472                  message = 'READING MEGAN 2 EMISSIONS DATA'
 473                  CALL  wrf_message ( message )
 474                  CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
 475               END IF
 476
 477            ELSEIF(grid%chem_in_opt == 0)then
 478               ! Generate chemistry data from a idealized vertical profile
 479               message = 'STARTING WITH BACKGROUND CHEMISTRY '
 480               CALL  wrf_message ( message )
 481
 482               write(message,*)' ETA1 '
 483               CALL  wrf_message ( message )
 484 !             write(message,*) grid%eta1
 485 !             CALL  wrf_message ( message )
 486
 487               CALL input_chem_profile ( grid )
 488
 489               IF(grid%bio_emiss_opt == BEIS311 ) THEN
 490                  message = 'READING BEIS3.11 EMISSIONS DATA'
 491                  CALL  wrf_message ( message )
 492                  CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
 493               else IF(grid%bio_emiss_opt == 3 ) THEN !shc
 494                  message = 'READING MEGAN 2 EMISSIONS DATA'
 495                  CALL  wrf_message ( message )
 496                  CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
 497               END IF
 498
 499            ELSE
 500              message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
 501              CALL  wrf_message ( message )
 502            ENDIF
 503          ENDIF
 504       ENDIF
 505 #endif
 506
 507       config_flags%isurban=1
 508       config_flags%isoilwater=14
 509
 510       CALL assemble_output ( grid , config_flags , loop , time_loop_max )
 511
 512       !  Here we define the next time that we are going to process.
 513
 514       CALL geth_newdate ( current_date_char , start_date_char , &
 515                           loop * model_config_rec%interval_seconds )
 516       current_date =  current_date_char // '.0000'
 517
 518       CALL domain_clock_set( grid, current_date(1:19) )
 519
 520       write(message,*) 'current_date= ', current_date
 521       CALL wrf_message(message)
 522
 523    END DO
 524 END SUBROUTINE med_sidata_input
 525
 526 SUBROUTINE compute_si_start_and_end (  &
 527           start_year, start_month, start_day, start_hour, &
 528           start_minute, start_second, &
 529           end_year ,   end_month ,   end_day ,   end_hour , &
 530           end_minute ,   end_second , &
 531           interval_seconds , real_data_init_type , &
 532           start_date_char , end_date_char , time_loop_max )
 533
 534    USE module_date_time
 535
 536    IMPLICIT NONE
 537
 538    INTEGER :: start_year , start_month , start_day , &
 539               start_hour , start_minute , start_second
 540    INTEGER ::   end_year ,   end_month ,   end_day , &
 541                 end_hour ,   end_minute ,   end_second
 542    INTEGER :: interval_seconds , real_data_init_type
 543    INTEGER :: time_loop_max , time_loop
 544
 545    CHARACTER(LEN=132) :: message
 546    CHARACTER(LEN=19)  :: current_date_char , start_date_char , &
 547                         end_date_char , next_date_char
 548
 549 !   WRITE ( start_date_char , FMT = &
 550 !         '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
 551 !         start_year,start_month,start_day,start_hour,start_minute,start_second
 552 !   WRITE (   end_date_char , FMT = &
 553 !         '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
 554 !          end_year,  end_month,  end_day,  end_hour,  end_minute,  end_second
 555
 556    WRITE ( start_date_char , FMT = &
 557          '(I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2)' ) &
 558          start_year,start_month,start_day,start_hour,start_minute,start_second
 559    WRITE (   end_date_char , FMT = &
 560          '(I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2)' ) &
 561           end_year,  end_month,  end_day,  end_hour,  end_minute,  end_second
 562
 563 !  start_date = start_date_char // '.0000'
 564
 565    !  Figure out our loop count for the processing times.
 566
 567    time_loop = 1
 568    PRINT '(A,I4,A,A,A)','Time period #',time_loop, &
 569                         ' to process = ',start_date_char,'.'
 570    current_date_char = start_date_char
 571    loop_count : DO
 572       CALL geth_newdate (next_date_char, current_date_char, interval_seconds )
 573       IF      ( next_date_char .LT. end_date_char ) THEN
 574          time_loop = time_loop + 1
 575          PRINT '(A,I4,A,A,A)','Time period #',time_loop,&
 576                               ' to process = ',next_date_char,'.'
 577          current_date_char = next_date_char
 578       ELSE IF ( next_date_char .EQ. end_date_char ) THEN
 579          time_loop = time_loop + 1
 580          PRINT '(A,I4,A,A,A)','Time period #',time_loop,&
 581                               ' to process = ',next_date_char,'.'
 582          PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
 583          time_loop_max = time_loop
 584          EXIT loop_count
 585       ELSE IF ( next_date_char .GT. end_date_char ) THEN
 586          PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
 587          time_loop_max = time_loop
 588          EXIT loop_count
 589       END IF
 590    END DO loop_count
 591         write(message,*) 'done in si_start_and_end'
 592         CALL wrf_message(message)
 593 END SUBROUTINE compute_si_start_and_end
 594
 595 SUBROUTINE assemble_output ( grid , config_flags , loop , time_loop_max )
 596
 597 !!! replace with something?   USE module_big_step_utilities_em
 598
 599    USE module_domain
 600    USE module_io_domain
 601    USE module_configure
 602    USE module_date_time
 603    USE module_bc
 604    IMPLICIT NONE
 605
 606    TYPE(domain)                 :: grid
 607    TYPE (grid_config_rec_type)  :: config_flags
 608    INTEGER , INTENT(IN)         :: loop , time_loop_max
 609
 610    INTEGER :: ids , ide , jds , jde , kds , kde
 611    INTEGER :: ims , ime , jms , jme , kms , kme
 612    INTEGER :: ips , ipe , jps , jpe , kps , kpe
 613    INTEGER :: ijds , ijde , spec_bdy_width
 614    INTEGER :: inc_h,inc_v
 615    INTEGER :: i , j , k , idts
 616
 617    INTEGER :: id1 , interval_seconds , ierr, rc
 618    INTEGER , SAVE :: id
 619    CHARACTER (LEN=80) :: inpname , bdyname
 620    CHARACTER(LEN= 4) :: loop_char
 621    CHARACTER(LEN=132) :: message
 622 character *19 :: temp19
 623 character *24 :: temp24 , temp24b
 624
 625    REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ubdy3dtemp1 , vbdy3dtemp1 ,&
 626                                                 tbdy3dtemp1 , &
 627                                                 cwmbdy3dtemp1 , qbdy3dtemp1,&
 628                                                 q2bdy3dtemp1 , pdbdy2dtemp1
 629    REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ubdy3dtemp2 , vbdy3dtemp2 , &
 630                                                 tbdy3dtemp2 , &
 631                                                 cwmbdy3dtemp2 , qbdy3dtemp2, &
 632                                                 q2bdy3dtemp2, pdbdy2dtemp2
 633    REAL :: t1,t2
 634
 635 #ifdef DEREF_KLUDGE
 636 !  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
 637    INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
 638    INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
 639    INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
 640 #endif
 641
 642 #include "deref_kludge.h"
 643
 644
 645    !  Various sizes that we need to be concerned about.
 646
 647    ids = grid%sd31
 648    ide = grid%ed31-1 ! 030730tst
 649    jds = grid%sd32
 650    jde = grid%ed32-1 ! 030730tst
 651    kds = grid%sd33
 652    kde = grid%ed33-1 ! 030730tst
 653
 654    ims = grid%sm31
 655    ime = grid%em31
 656    jms = grid%sm32
 657    jme = grid%em32
 658    kms = grid%sm33
 659    kme = grid%em33
 660
 661    ips = grid%sp31
 662    ipe = grid%ep31-1 ! 030730tst
 663    jps = grid%sp32
 664    jpe = grid%ep32-1 ! 030730tst
 665    kps = grid%sp33
 666    kpe = grid%ep33-1 ! 030730tst
 667
 668         if (IPE .ne. IDE) IPE=IPE+1
 669         if (JPE .ne. JDE) JPE=JPE+1
 670
 671         write(message,*) 'assemble output (ids,ide): ', ids,ide
 672         CALL wrf_message(message)
 673         write(message,*) 'assemble output (ims,ime): ', ims,ime
 674         CALL wrf_message(message)
 675         write(message,*) 'assemble output (ips,ipe): ', ips,ipe
 676         CALL wrf_message(message)
 677
 678         write(message,*) 'assemble output (jds,jde): ', jds,jde
 679         CALL wrf_message(message)
 680         write(message,*) 'assemble output (jms,jme): ', jms,jme
 681         CALL wrf_message(message)
 682         write(message,*) 'assemble output (jps,jpe): ', jps,jpe
 683         CALL wrf_message(message)
 684
 685         write(message,*) 'assemble output (kds,kde): ', kds,kde
 686         CALL wrf_message(message)
 687         write(message,*) 'assemble output (kms,kme): ', kms,kme
 688         CALL wrf_message(message)
 689         write(message,*) 'assemble output (kps,kpe): ', kps,kpe
 690         CALL wrf_message(message)
 691
 692    ijds = MIN ( ids , jds )
 693 !mptest030805   ijde = MAX ( ide , jde )
 694    ijde = MAX ( ide , jde ) + 1   ! to make stuff_bdy dimensions consistent with alloc
 695
 696    !  Boundary width, scalar value.
 697
 698    spec_bdy_width = model_config_rec%spec_bdy_width
 699    interval_seconds = model_config_rec%interval_seconds
 700
 701 !-----------------------------------------------------------------------
 702 !
 703    main_loop_test: IF ( loop .EQ. 1 ) THEN
 704 !
 705 !-----------------------------------------------------------------------
 706
 707    !  This is the space needed to save the current 3d data for use in computing
 708    !  the lateral boundary tendencies.
 709
 710       ALLOCATE ( ubdy3dtemp1(ims:ime,jms:jme,kms:kme) )
 711       ALLOCATE ( vbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
 712       ALLOCATE ( tbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
 713       ALLOCATE ( qbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
 714       ALLOCATE ( cwmbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
 715       ALLOCATE ( q2bdy3dtemp1(ims:ime,jms:jme,kms:kme) )
 716       ALLOCATE ( pdbdy2dtemp1(ims:ime,jms:jme,1:1) )
 717
 718         ubdy3dtemp1=0.
 719         vbdy3dtemp1=0.
 720         tbdy3dtemp1=0.
 721         qbdy3dtemp1=0.
 722         cwmbdy3dtemp1=0.
 723         q2bdy3dtemp1=0.
 724         pdbdy2dtemp1=0.
 725
 726       ALLOCATE ( ubdy3dtemp2(ims:ime,jms:jme,kms:kme) )
 727       ALLOCATE ( vbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
 728       ALLOCATE ( tbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
 729       ALLOCATE ( qbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
 730       ALLOCATE ( cwmbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
 731       ALLOCATE ( q2bdy3dtemp2(ims:ime,jms:jme,kms:kme) )
 732       ALLOCATE ( pdbdy2dtemp2(ims:ime,jms:jme,1:1) )
 733
 734         ubdy3dtemp2=0.
 735         vbdy3dtemp2=0.
 736         tbdy3dtemp2=0.
 737         qbdy3dtemp2=0.
 738         cwmbdy3dtemp2=0.
 739         q2bdy3dtemp2=0.
 740         pdbdy2dtemp2=0.
 741
 742       !  Open the wrfinput file.  From this program, this is an *output* file.
 743
 744       CALL construct_filename1( inpname , 'wrfinput' , grid%id , 2 )
 745
 746       CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , &
 747                             output_model_input , "DATASET=INPUT", ierr )
 748
 749       IF ( ierr .NE. 0 ) THEN
 750       CALL wrf_error_fatal( 'real: error opening wrfinput for writing' )
 751       ENDIF
 752
 753 !     CALL calc_current_date ( grid%id , 0. )
 754 !      grid%write_metadata = .true.
 755
 756         write(message,*) 'making call to output_model_input'
 757         CALL wrf_message(message)
 758
 759         CALL output_model_input ( id1, grid , config_flags , ierr )
 760
 761 !***
 762 !***  CLOSE THE WRFINPUT DATASET
 763 !***
 764       CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
 765
 766       !  We need to save the 3d data to compute a
 767       !  difference during the next loop.
 768
 769 !
 770 !-----------------------------------------------------------------------
 771 !***  SOUTHERN BOUNDARY
 772 !-----------------------------------------------------------------------
 773 !
 774
 775         IF(JPS==JDS)THEN
 776           J=1
 777           DO k = kps , MIN(kde,kpe)
 778           DO i = ips , MIN(ide,ipe)
 779             ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
 780             vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
 781             tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
 782             qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
 783             cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
 784             q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
 785           END DO
 786           END DO
 787
 788           DO i = ips , MIN(ide,ipe)
 789             pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
 790           END DO
 791         ENDIF
 792
 793 !
 794 !-----------------------------------------------------------------------
 795 !***  NORTHERN BOUNDARY
 796 !-----------------------------------------------------------------------
 797 !
 798         IF(JPE==JDE)THEN
 799           J=MIN(JDE,JPE)
 800           DO k = kps , MIN(kde,kpe)
 801           DO i = ips , MIN(ide,ipe)
 802             ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
 803             vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
 804             tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
 805             qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
 806             cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
 807             q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
 808           END DO
 809           END DO
 810
 811           DO i = ips , MIN(ide,ipe)
 812             pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
 813           END DO
 814         ENDIF
 815
 816 !
 817 !-----------------------------------------------------------------------
 818 !***  WESTERN BOUNDARY
 819 !-----------------------------------------------------------------------
 820 !
 821         write(message,*) 'western boundary, store winds over J: ', jps, min(jpe,jde)
 822         CALL wrf_message(message)
 823
 824         IF(IPS==IDS)THEN
 825           I=1
 826           DO k = kps , MIN(kde,kpe)
 827           inc_h=mod(jps+1,2)
 828           DO j = jps+inc_h, min(jde,jpe),2
 829
 830         if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
 831             tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
 832             qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
 833             cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
 834             q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
 835       if(k==1)then
 836         write(message,*)' loop=',loop,' i=',i,' j=',j,' tbdy3dtemp1(i,j,k)=',tbdy3dtemp1(i,j,k)
 837         CALL wrf_debug(10,message)
 838       endif
 839         endif
 840           END DO
 841           END DO
 842
 843           DO k = kps , MIN(kde,kpe)
 844           inc_v=mod(jps,2)
 845           DO j = jps+inc_v, min(jde,jpe),2
 846         if (J .ge. 2 .and. J .le. JDE-1 .and. mod(J,2) .eq. 0) then
 847             ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
 848             vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
 849         endif
 850           END DO
 851           END DO
 852 !
 853           inc_h=mod(jps+1,2)
 854         DO j = jps+inc_h, min(jde,jpe),2
 855         if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
 856             pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
 857           write(message,*)' loop=',loop,' i=',i,' j=',j,' pdbdy2dtemp1(i,j)=',pdbdy2dtemp1(i,j,1)
 858           CALL wrf_debug(10,message)
 859         endif
 860           END DO
 861         ENDIF
 862 !
 863 !-----------------------------------------------------------------------
 864 !***  EASTERN BOUNDARY
 865 !-----------------------------------------------------------------------
 866 !
 867         IF(IPE==IDE)THEN
 868           I=MIN(IDE,IPE)
 869 !
 870           DO k = kps , MIN(kde,kpe)
 871 !
 872 !***   Make sure the J loop is on the global boundary
 873 !
 874           inc_h=mod(jps+1,2)
 875           DO j = jps+inc_h, min(jde,jpe),2
 876         if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
 877             tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
 878             qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
 879             cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
 880             q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
 881         endif
 882           END DO
 883           END DO
 884
 885           DO k = kps , MIN(kde,kpe)
 886           inc_v=mod(jps,2)
 887           DO j = jps+inc_v, min(jde,jpe),2
 888         if (J .ge. 2 .and. J .le. JDE-1 .and. mod(J,2) .eq. 0) then
 889             ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
 890             vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
 891         endif
 892           END DO
 893           END DO
 894 !
 895           inc_h=mod(jps+1,2)
 896           DO j = jps+inc_h, min(jde,jpe),2
 897         if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
 898             pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
 899         endif
 900           END DO
 901         ENDIF
 902
 903
 904       !  There are 2 components to the lateral boundaries.
 905       !  First, there is the starting
 906       !  point of this time period - just the outer few rows and columns.
 907
 908
 909  CALL stuff_bdy_ijk (ubdy3dtemp1, grid%u_bxs, grid%u_bxe, &
 910                                   grid%u_bys, grid%u_bye, &
 911                                   'N', spec_bdy_width  , &
 912                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
 913                                   ims , ime , jms , jme , kms , kme , &
 914                                   ips , ipe , jps , jpe , kps , kpe+1 )
 915
 916  CALL stuff_bdy_ijk (vbdy3dtemp1, grid%v_bxs, grid%v_bxe, &
 917                                   grid%v_bys, grid%v_bye, &
 918                                   'N', spec_bdy_width  , &
 919                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
 920                                   ims , ime , jms , jme , kms , kme , &
 921                                   ips , ipe , jps , jpe , kps , kpe+1 )
 922
 923  CALL stuff_bdy_ijk (tbdy3dtemp1, grid%t_bxs, grid%t_bxe, &
 924                                   grid%t_bys, grid%t_bye, &
 925                                   'N', spec_bdy_width  , &
 926                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
 927                                   ims , ime , jms , jme , kms , kme , &
 928                                   ips , ipe , jps , jpe , kps , kpe+1 )
 929
 930  CALL stuff_bdy_ijk (cwmbdy3dtemp1, grid%cwm_bxs, grid%cwm_bxe, &
 931                                   grid%cwm_bys, grid%cwm_bye, &
 932                                   'N', spec_bdy_width  , &
 933                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
 934                                   ims , ime , jms , jme , kms , kme , &
 935                                   ips , ipe , jps , jpe , kps , kpe+1 )
 936
 937  CALL stuff_bdy_ijk (qbdy3dtemp1, grid%q_bxs, grid%q_bxe, &
 938                                   grid%q_bys, grid%q_bye, &
 939                                   'N', spec_bdy_width  , &
 940                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
 941                                   ims , ime , jms , jme , kms , kme , &
 942                                   ips , ipe , jps , jpe , kps , kpe+1 )
 943
 944  CALL stuff_bdy_ijk (q2bdy3dtemp1, grid%q2_bxs, grid%q2_bxe, &
 945                                   grid%q2_bys, grid%q2_bye, &
 946                                   'N', spec_bdy_width  , &
 947                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
 948                                   ims , ime , jms , jme , kms , kme , &
 949                                   ips , ipe , jps , jpe , kps , kpe+1 )
 950
 951
 952  CALL stuff_bdy_ijk (pdbdy2dtemp1, grid%pd_bxs, grid%pd_bxe, &
 953                                    grid%pd_bys, grid%pd_bye, &
 954                                    'M', spec_bdy_width, &
 955                                    ids , ide+1 , jds , jde+1 , 1 , 1 , &
 956                                    ims , ime , jms , jme , 1 , 1 , &
 957                                    ips , ipe , jps , jpe , 1 , 1 )
 958
 959 !-----------------------------------------------------------------------
 960 !
 961    ELSE IF ( loop .GT. 1 ) THEN
 962 !
 963 !-----------------------------------------------------------------------
 964
 965       write(message,*)' assemble_output loop=',loop,' in IF block'
 966       call wrf_message(message)
 967
 968       !  Open the boundary file.
 969
 970       IF ( loop .eq. 2 ) THEN
 971          CALL construct_filename1( bdyname , 'wrfbdy' , grid%id , 2 )
 972       CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , &
 973                           output_boundary , "DATASET=BOUNDARY", ierr )
 974          IF ( ierr .NE. 0 ) THEN
 975                CALL wrf_error_fatal( 'real: error opening wrfbdy for writing' )
 976          ENDIF
 977 !         grid%write_metadata = .true.
 978       ELSE
 979 ! what's this do?
 980 !         grid%write_metadata = .true.
 981 !         grid%write_metadata = .false.
 982          CALL domain_clockadvance( grid )
 983       END IF
 984
 985 !
 986 !-----------------------------------------------------------------------
 987 !***  SOUTHERN BOUNDARY
 988 !-----------------------------------------------------------------------
 989 !
 990         IF(JPS==JDS)THEN
 991           J=1
 992           DO k = kps , MIN(kde,kpe)
 993           DO i = ips , MIN(ide,ipe)
 994             ubdy3dtemp2(i,j,k) = grid%u(i,j,k)
 995             vbdy3dtemp2(i,j,k) = grid%v(i,j,k)
 996             tbdy3dtemp2(i,j,k) = grid%t(i,j,k)
 997             qbdy3dtemp2(i,j,k) = grid%q(i,j,k)
 998             cwmbdy3dtemp2(i,j,k) = grid%cwm(i,j,k)
 999             q2bdy3dtemp2(i,j,k) = grid%q2(i,j,k)
1000           END DO
1001           END DO
1002 !
1003           DO i = ips , MIN(ide,ipe)
1004             pdbdy2dtemp2(i,j,1) = grid%pd(i,j)
1005           END DO
1006         ENDIF
1007
1008 !
1009 !-----------------------------------------------------------------------
1010 !***  NORTHERN BOUNDARY
1011 !-----------------------------------------------------------------------
1012 !
1013         IF(JPE==JDE)THEN
1014           J=MIN(JDE,JPE)
1015           DO k = kps , MIN(kde,kpe)
1016           DO i = ips , MIN(ide,ipe)
1017             ubdy3dtemp2(i,j,k) = grid%u(i,j,k)
1018             vbdy3dtemp2(i,j,k) = grid%v(i,j,k)
1019             tbdy3dtemp2(i,j,k) = grid%t(i,j,k)
1020             qbdy3dtemp2(i,j,k) = grid%q(i,j,k)
1021             cwmbdy3dtemp2(i,j,k) = grid%cwm(i,j,k)
1022             q2bdy3dtemp2(i,j,k) = grid%q2(i,j,k)
1023           END DO
1024           END DO
1025
1026           DO i = ips , MIN(ide,ipe)
1027             pdbdy2dtemp2(i,j,1) = grid%pd(i,j)
1028           END DO
1029         ENDIF
1030 !
1031 !-----------------------------------------------------------------------
1032 !***  WESTERN BOUNDARY
1033 !-----------------------------------------------------------------------
1034 !
1035         IF(IPS==IDS)THEN
1036           I=1
1037           DO k = kps , MIN(kde,kpe)
1038           inc_h=mod(jps+1,2)
1039       if(k==1)then
1040         write(message,*)' assemble_ouput loop=',loop,' inc_h=',inc_h,' jps=',jps
1041         call wrf_debug(10,message)
1042       endif
1043           DO j = jps+inc_h, MIN(jde,jpe),2
1044         if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1045             tbdy3dtemp2(i,j,k) = grid%t(i,j,k)
1046       if(k==1)then
1047         write(message,*)' loop=',loop,' i=',i,' j=',j,' tbdy3dtemp1(i,j,k)=',tbdy3dtemp1(i,j,k)
1048         call wrf_debug(10,message)
1049       endif
1050             qbdy3dtemp2(i,j,k) = grid%q(i,j,k)
1051             cwmbdy3dtemp2(i,j,k) = grid%cwm(i,j,k)
1052             q2bdy3dtemp2(i,j,k) = grid%q2(i,j,k)
1053         endif
1054           END DO
1055           END DO
1056 !
1057           DO k = kps , MIN(kde,kpe)
1058           inc_v=mod(jps,2)
1059           DO j = jps+inc_v, MIN(jde,jpe),2
1060         if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
1061             ubdy3dtemp2(i,j,k) = grid%u(i,j,k)
1062             vbdy3dtemp2(i,j,k) = grid%v(i,j,k)
1063         endif
1064           END DO
1065           END DO
1066
1067           inc_h=mod(jps+1,2)
1068         DO j = jps+inc_h, MIN(jde,jpe),2
1069         if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1070           pdbdy2dtemp2(i,j,1) = grid%pd(i,j)
1071           write(message,*)' loop=',loop,' i=',i,' j=',j,' pdbdy2dtemp1(i,j)=',pdbdy2dtemp1(i,j,1)
1072           CALL wrf_debug(10,message)
1073         endif
1074           END DO
1075         ENDIF
1076 !
1077 !-----------------------------------------------------------------------
1078 !***  EASTERN BOUNDARY
1079 !-----------------------------------------------------------------------
1080 !
1081         IF(IPE==IDE)THEN
1082           I=MIN(IDE,IPE)
1083
1084           DO k = kps , MIN(kde,kpe)
1085           inc_h=mod(jps+1,2)
1086           DO j = jps+inc_h, MIN(jde,jpe),2
1087         if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1088             tbdy3dtemp2(i,j,k) = grid%t(i,j,k)
1089             qbdy3dtemp2(i,j,k) = grid%q(i,j,k)
1090             cwmbdy3dtemp2(i,j,k) = grid%cwm(i,j,k)
1091             q2bdy3dtemp2(i,j,k) = grid%q2(i,j,k)
1092         endif
1093           END DO
1094           END DO
1095
1096           DO k = kps , MIN(kde,kpe)
1097           inc_v=mod(jps,2)
1098           DO j = jps+inc_v, MIN(jde,jpe),2
1099         if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
1100             ubdy3dtemp2(i,j,k) = grid%u(i,j,k)
1101             vbdy3dtemp2(i,j,k) = grid%v(i,j,k)
1102         endif
1103           END DO
1104           END DO
1105
1106           inc_h=mod(jps+1,2)
1107           DO j = jps+inc_h, MIN(jde,jpe),2
1108         if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
1109             pdbdy2dtemp2(i,j,1) = grid%pd(i,j)
1110         endif
1111           END DO
1112         ENDIF
1113 !-----------------------------------------------------------------------
1114       !  During all of the loops after the first loop,
1115       !  we first compute the boundary
1116       !  tendencies with the current data values
1117       !  (*bdy3dtemp2 arrays) and the previously
1118       !  saved information stored in the *bdy3dtemp1 arrays.
1119
1120
1121       CALL stuff_bdytend_ijk ( ubdy3dtemp2 , ubdy3dtemp1 , REAL(interval_seconds),&
1122                                    grid%u_btxs, grid%u_btxe, &
1123                                    grid%u_btys, grid%u_btye, &
1124                                    'N',  spec_bdy_width      , &
1125                                    ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1126                                    ims , ime , jms , jme , kms , kme , &
1127                                    ips , ipe , jps , jpe , kps , kpe+1 )
1128
1129       CALL stuff_bdytend_ijk ( vbdy3dtemp2 , vbdy3dtemp1 , REAL(interval_seconds),&
1130                                    grid%v_btxs, grid%v_btxe, &
1131                                    grid%v_btys, grid%v_btye, &
1132                                    'N',  spec_bdy_width      , &
1133                                    ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1134                                    ims , ime , jms , jme , kms , kme , &
1135                                    ips , ipe , jps , jpe , kps , kpe+1 )
1136
1137       CALL stuff_bdytend_ijk ( tbdy3dtemp2 , tbdy3dtemp1 , REAL(interval_seconds),&
1138                                    grid%t_btxs, grid%t_btxe, &
1139                                    grid%t_btys, grid%t_btye, &
1140                                    'N',  spec_bdy_width      , &
1141                                    ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1142                                    ims , ime , jms , jme , kms , kme , &
1143                                    ips , ipe , jps , jpe , kps , kpe+1 )
1144
1145       CALL stuff_bdytend_ijk ( cwmbdy3dtemp2 , cwmbdy3dtemp1 , REAL(interval_seconds),&
1146                                    grid%cwm_btxs, grid%cwm_btxe, &
1147                                    grid%cwm_btys, grid%cwm_btye, &
1148                                    'N',  spec_bdy_width      , &
1149                                    ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1150                                    ims , ime , jms , jme , kms , kme , &
1151                                    ips , ipe , jps , jpe , kps , kpe+1 )
1152
1153       CALL stuff_bdytend_ijk ( qbdy3dtemp2 , qbdy3dtemp1 , REAL(interval_seconds),&
1154                                    grid%q_btxs, grid%q_btxe, &
1155                                    grid%q_btys, grid%q_btye, &
1156                                    'N',  spec_bdy_width      , &
1157                                    ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1158                                    ims , ime , jms , jme , kms , kme , &
1159                                    ips , ipe , jps , jpe , kps , kpe+1 )
1160
1161       CALL stuff_bdytend_ijk ( q2bdy3dtemp2 , q2bdy3dtemp1 , REAL(interval_seconds),&
1162                                    grid%q2_btxs, grid%q2_btxe, &
1163                                    grid%q2_btys, grid%q2_btye, &
1164                                    'N',  spec_bdy_width      , &
1165                                    ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1166                                    ims , ime , jms , jme , kms , kme , &
1167                                    ips , ipe , jps , jpe , kps , kpe+1 )
1168
1169       CALL stuff_bdytend_ijk( pdbdy2dtemp2 , pdbdy2dtemp1, REAL(interval_seconds),&
1170                                    grid%pd_btxs, grid%pd_btxe, &
1171                                    grid%pd_btys, grid%pd_btye, &
1172                                    'M',  spec_bdy_width      , &
1173                                    ids , ide+1 , jds , jde+1 , 1 , 1 , &
1174                                    ims , ime   , jms , jme   , 1 , 1 , &
1175                                    ips , ipe   , jps , jpe   , 1 , 1 )
1176
1177
1178
1179       !  Both pieces of the boundary data are now
1180       !  available to be written (initial time and tendency).
1181       !  This looks ugly, these date shifting things.
1182       !  What's it for?  We want the "Times" variable
1183       !  in the lateral BDY file to have the valid times
1184       !  of when the initial fields are written.
1185       !  That's what the loop-2 thingy is for with the start date.
1186       !  We increment the start_date so
1187       !  that the starting time in the attributes is the
1188       !  second time period.  Why you may ask.  I
1189       !  agree, why indeed.
1190
1191       temp24= current_date
1192       temp24b=start_date
1193       start_date = current_date
1194       CALL geth_newdate ( temp19 , temp24b(1:19) , &
1195                          (loop-2) * model_config_rec%interval_seconds )
1196       current_date = temp19 //  '.0000'
1197        CALL domain_clock_set( grid, current_date(1:19) )
1198       write(message,*) 'LBC valid between these times ',current_date, ' ',start_date
1199       CALL wrf_message(message)
1200
1201       CALL output_boundary ( id, grid , config_flags , ierr )
1202       current_date = temp24
1203       start_date = temp24b
1204
1205       !  OK, for all of the loops, we output the initialzation
1206       !  data, which would allow us to
1207       !  start the model at any of the available analysis time periods.
1208
1209 !  WRITE ( loop_char , FMT = '(I4.4)' ) loop
1210 !  CALL open_w_dataset ( id1, 'wrfinput'//loop_char , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
1211 !  IF ( ierr .NE. 0 ) THEN
1212 !    CALL wrf_error_fatal( 'real: error opening wrfinput'//loop_char//' for writing' )
1213 !  ENDIF
1214 !  grid%write_metadata = .true.
1215
1216 !  CALL calc_current_date ( grid%id , 0. )
1217 !  CALL output_model_input ( id1, grid , config_flags , ierr )
1218 !  CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
1219
1220   !  Is this or is this not the last time time?  We can remove some unnecessary
1221   !  stores if it is not.
1222
1223       IF     ( loop .LT. time_loop_max ) THEN
1224
1225          !  We need to save the 3d data to compute a
1226          !  difference during the next loop.  Couple the
1227          !  3d fields with total mu (mub + mu_2) and the
1228          !  stagger-specific map scale factor.
1229          !  We load up the boundary data again for use in the next loop.
1230
1231
1232 !mp     change these limits?????????
1233
1234          DO k = kps , kpe
1235             DO j = jps , jpe
1236                DO i = ips , ipe
1237                   ubdy3dtemp1(i,j,k) = ubdy3dtemp2(i,j,k)
1238                   vbdy3dtemp1(i,j,k) = vbdy3dtemp2(i,j,k)
1239                   tbdy3dtemp1(i,j,k) = tbdy3dtemp2(i,j,k)
1240                   cwmbdy3dtemp1(i,j,k) = cwmbdy3dtemp2(i,j,k)
1241                   qbdy3dtemp1(i,j,k) = qbdy3dtemp2(i,j,k)
1242                   q2bdy3dtemp1(i,j,k) = q2bdy3dtemp2(i,j,k)
1243                END DO
1244             END DO
1245          END DO
1246
1247 !mp     change these limits?????????
1248
1249          DO j = jps , jpe
1250             DO i = ips , ipe
1251                pdbdy2dtemp1(i,j,1) = pdbdy2dtemp2(i,j,1)
1252         if (J .eq. jpe) write(0,*) 'I,J, PDBDy2dtemp1(i,j,1):' , I,J, PDBDy2dtemp1(i,j,1)
1253             END DO
1254          END DO
1255
1256   !  There are 2 components to the lateral boundaries.
1257   !   First, there is the starting
1258   !  point of this time period - just the outer few rows and columns.
1259
1260  CALL stuff_bdy_ijk (ubdy3dtemp1, grid%u_bxs, grid%u_bxe, &
1261                                   grid%u_bys, grid%u_bye, &
1262                                   'N', spec_bdy_width  , &
1263                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1264                                   ims , ime , jms , jme , kms , kme , &
1265                                   ips , ipe , jps , jpe , kps , kpe+1 )
1266
1267  CALL stuff_bdy_ijk (vbdy3dtemp1, grid%v_bxs, grid%v_bxe, &
1268                                   grid%v_bys, grid%v_bye, &
1269                                   'N', spec_bdy_width  , &
1270                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1271                                   ims , ime , jms , jme , kms , kme , &
1272                                   ips , ipe , jps , jpe , kps , kpe+1 )
1273
1274  CALL stuff_bdy_ijk (tbdy3dtemp1, grid%t_bxs, grid%t_bxe, &
1275                                   grid%t_bys, grid%t_bye, &
1276                                   'N', spec_bdy_width  , &
1277                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1278                                   ims , ime , jms , jme , kms , kme , &
1279                                   ips , ipe , jps , jpe , kps , kpe+1 )
1280
1281  CALL stuff_bdy_ijk (cwmbdy3dtemp1, grid%cwm_bxs, grid%cwm_bxe, &
1282                                   grid%cwm_bys, grid%cwm_bye, &
1283                                   'N', spec_bdy_width  , &
1284                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1285                                   ims , ime , jms , jme , kms , kme , &
1286                                   ips , ipe , jps , jpe , kps , kpe+1 )
1287
1288  CALL stuff_bdy_ijk (qbdy3dtemp1, grid%q_bxs, grid%q_bxe, &
1289                                   grid%q_bys, grid%q_bye, &
1290                                   'N', spec_bdy_width  , &
1291                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1292                                   ims , ime , jms , jme , kms , kme , &
1293                                   ips , ipe , jps , jpe , kps , kpe+1 )
1294
1295  CALL stuff_bdy_ijk (q2bdy3dtemp1, grid%q2_bxs, grid%q2_bxe, &
1296                                   grid%q2_bys, grid%q2_bye, &
1297                                   'N', spec_bdy_width  , &
1298                                   ids , ide+1 , jds , jde+1 , kds , kde+1 , &
1299                                   ims , ime , jms , jme , kms , kme , &
1300                                   ips , ipe , jps , jpe , kps , kpe+1 )
1301
1302  CALL stuff_bdy_ijk (pdbdy2dtemp1,grid%pd_bxs, grid%pd_bxe, &
1303                                   grid%pd_bys, grid%pd_bye, &
1304                                   'M', spec_bdy_width  , &
1305                                   ids , ide+1 , jds , jde+1 , 1 , 1 , &
1306                                   ims , ime , jms , jme , 1 , 1 , &
1307                                   ips , ipe , jps , jpe , 1 , 1 )
1308
1309       ELSE IF ( loop .EQ. time_loop_max ) THEN
1310
1311     !  If this is the last time through here, we need to close the files.
1312
1313          CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
1314
1315       END IF
1316
1317    END IF main_loop_test
1318
1319 END SUBROUTINE assemble_output