! Create an initial data set for the WRF model based on real data. This
! program is specifically set up for the NMM core.
PROGRAM real_data 
(docs) ,107
USE module_machine
USE module_domain
USE module_initialize_real
USE module_io_domain
USE module_driver_constants
USE module_configure
USE module_timing
#ifdef WRF_CHEM
USE module_input_chem_data
USE module_input_chem_bioemiss
#endif
USE module_utility
#ifdef DM_PARALLEL
USE module_dm
#endif
IMPLICIT NONE
REAL :: time , bdyfrq
INTEGER :: loop , levels_to_process , debug_level
TYPE(domain) , POINTER :: null_domain
TYPE(domain) , POINTER :: grid
TYPE (grid_config_rec_type) :: config_flags
INTEGER :: number_at_same_level
INTEGER :: max_dom, domain_id
INTEGER :: idum1, idum2
#ifdef DM_PARALLEL
INTEGER :: nbytes
! INTEGER, PARAMETER :: configbuflen = 2*1024
INTEGER, PARAMETER :: configbuflen = 4*CONFIG_BUF_LEN
INTEGER :: configbuf( configbuflen )
LOGICAL , EXTERNAL :: wrf_dm_on_monitor
#endif
INTEGER :: ids , ide , jds , jde , kds , kde
INTEGER :: ims , ime , jms , jme , kms , kme
INTEGER :: ips , ipe , jps , jpe , kps , kpe
INTEGER :: ijds , ijde , spec_bdy_width
INTEGER :: i , j , k , idts
#ifdef DEREF_KLUDGE
! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x
INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y
#endif
CHARACTER (LEN=80) :: message
INTEGER :: start_year , start_month , start_day
INTEGER :: start_hour , start_minute , start_second
INTEGER :: end_year , end_month , end_day , &
end_hour , end_minute , end_second
INTEGER :: interval_seconds , real_data_init_type
INTEGER :: time_loop_max , time_loop, rc
REAL :: t1,t2
#include "version_decl"
INTERFACE
SUBROUTINE Setup_Timekeeping( grid )
USE module_domain
TYPE(domain), POINTER :: grid
END SUBROUTINE Setup_Timekeeping
END INTERFACE
! Define the name of this program (program_name defined in module_domain)
program_name = "REAL_NMM " // TRIM(release_version) // " PREPROCESSOR"
#ifdef DM_PARALLEL
CALL disable_quilting
#endif
! CALL start()
! Initialize the modules used by the WRF system.
! Many of the CALLs made from the
! init_modules routine are NO-OPs. Typical initializations
! are: the size of a
! REAL, setting the file handles to a pre-use value, defining moisture and
! chemistry indices, etc.
CALL wrf_debug ( 100 , 'real_nmm: calling init_modules ' )
!!!! CALL init_modules
CALL init_modules(1) ! Phase 1 returns after MPI_INIT() (if it is called)
CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
CALL init_modules(2) ! Phase 2 resumes after MPI_INIT() (if it is called)
! The configuration switches mostly come from the NAMELIST input.
#ifdef DM_PARALLEL
IF ( wrf_dm_on_monitor() ) THEN
write(message,*) 'call initial_config'
CALL wrf_message ( message )
CALL initial_config
ENDIF
CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
CALL wrf_dm_bcast_bytes( configbuf, nbytes )
CALL set_config_as_buffer( configbuf, configbuflen )
CALL wrf_dm_initialize
#else
CALL initial_config
#endif
CALL nl_get_debug_level ( 1, debug_level )
CALL set_wrf_debug_level ( debug_level )
CALL wrf_message ( program_name )
! Allocate the space for the mother of all domains.
NULLIFY( null_domain )
CALL wrf_debug ( 100 , 'real_nmm: calling alloc_and_configure_domain ' )
CALL alloc_and_configure_domain ( domain_id = 1 , &
grid = head_grid , &
parent = null_domain , &
kid = -1 )
grid => head_grid
#include "deref_kludge.h"
CALL Setup_Timekeeping ( grid )
CALL domain_clock_set( grid, &
time_step_seconds=model_config_rec%interval_seconds )
CALL wrf_debug ( 100 , 'real_nmm: calling set_scalar_indices_from_config ' )
CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
CALL wrf_debug ( 100 , 'real_nmm: calling model_to_grid_config_rec ' )
CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
write(message,*) 'after model_to_grid_config_rec, e_we, e_sn are: ', &
config_flags%e_we, config_flags%e_sn
CALL wrf_message(message)
! Initialize the WRF IO: open files, init file handles, etc.
CALL wrf_debug ( 100 , 'real_nmm: calling init_wrfio' )
CALL init_wrfio
! Some of the configuration values may have been modified from the initial READ
! of the NAMELIST, so we re-broadcast the configuration records.
#ifdef DM_PARALLEL
CALL wrf_debug ( 100 , 'real_nmm: re-broadcast the configuration records' )
CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
CALL wrf_dm_bcast_bytes( configbuf, nbytes )
CALL set_config_as_buffer( configbuf, configbuflen )
#endif
! No looping in this layer.
CALL med_sidata_input ( grid , config_flags )
! We are done.
CALL wrf_debug ( 0 , 'real_nmm: SUCCESS COMPLETE REAL_NMM INIT' )
#ifdef DM_PARALLEL
CALL wrf_dm_shutdown
#endif
CALL WRFU_Finalize( rc=rc )
END PROGRAM real_data
SUBROUTINE med_sidata_input (docs) ( grid , config_flags ) 2,112
! Driver layer
USE module_domain
USE module_io_domain
! Model layer
USE module_configure
USE module_bc_time_utilities
USE module_initialize_real
USE module_optional_input
#ifdef WRF_CHEM
USE module_input_chem_data
USE module_input_chem_bioemiss
#endif
USE module_si_io_nmm
USE module_date_time
IMPLICIT NONE
! Interface
INTERFACE
SUBROUTINE start_domain ( grid , allowed_to_read )
USE module_domain
TYPE (domain) grid
LOGICAL, INTENT(IN) :: allowed_to_read
END SUBROUTINE start_domain
END INTERFACE
! Arguments
TYPE(domain) :: grid
TYPE (grid_config_rec_type) :: config_flags
! Local
INTEGER :: time_step_begin_restart
INTEGER :: idsi , ierr , myproc
CHARACTER (LEN=80) :: si_inpname
CHARACTER (LEN=132) :: message
CHARACTER(LEN=19) :: start_date_char , end_date_char , &
current_date_char , next_date_char
INTEGER :: time_loop_max , loop
INTEGER :: julyr , julday , LEN
INTEGER :: io_form_auxinput1
INTEGER, EXTERNAL :: use_package
LOGICAL :: using_binary_wrfsi
REAL :: gmt
REAL :: t1,t2
INTEGER :: numx_sm_levels_input,numx_st_levels_input
REAL,DIMENSION(100) :: smx_levels_input,stx_levels_input
#ifdef DEREF_KLUDGE
! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x
INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y
#endif
#include "deref_kludge.h"
grid%input_from_file = .true.
grid%input_from_file = .false.
CALL compute_si_start_and_end ( model_config_rec%start_year (grid%id) , &
model_config_rec%start_month (grid%id) , &
model_config_rec%start_day (grid%id) , &
model_config_rec%start_hour (grid%id) , &
model_config_rec%start_minute(grid%id) , &
model_config_rec%start_second(grid%id) , &
model_config_rec% end_year (grid%id) , &
model_config_rec% end_month (grid%id) , &
model_config_rec% end_day (grid%id) , &
model_config_rec% end_hour (grid%id) , &
model_config_rec% end_minute(grid%id) , &
model_config_rec% end_second(grid%id) , &
model_config_rec%interval_seconds , &
model_config_rec%real_data_init_type , &
start_date_char , end_date_char , time_loop_max )
! Here we define the initial time to process, for later use by the code.
current_date_char = start_date_char
! start_date = start_date_char // '.0000'
start_date = start_date_char
current_date = start_date
CALL nl_set_bdyfrq ( grid%id , REAL(model_config_rec%interval_seconds) )
! Loop over each time period to process.
write(message,*) 'time_loop_max: ', time_loop_max
CALL wrf_message(message)
DO loop = 1 , time_loop_max
internal_time_loop=loop
write(message,*) 'loop=', loop
CALL wrf_message(message)
write(message,*) '-----------------------------------------------------------'
CALL wrf_message(message)
write(message,*) ' '
CALL wrf_message(message)
write(message,'(A,A,A,I2,A,I2)') ' Current date being processed: ', &
current_date, ', which is loop #',loop,' out of ',time_loop_max
CALL wrf_message(message)
! After current_date has been set, fill in the julgmt stuff.
CALL geth_julgmt ( config_flags%julyr , config_flags%julday , &
config_flags%gmt )
! Now that the specific Julian info is available,
! save these in the model config record.
CALL nl_set_gmt (grid%id, config_flags%gmt)
CALL nl_set_julyr (grid%id, config_flags%julyr)
CALL nl_set_julday (grid%id, config_flags%julday)
CALL nl_get_io_form_auxinput1( 1, io_form_auxinput1 )
using_binary_wrfsi=.false.
write(message,*) 'TRIM(config_flags%auxinput1_inname): ', TRIM(config_flags%auxinput1_inname)
CALL wrf_message(message)
IF (config_flags%auxinput1_inname(1:10) .eq. 'real_input') THEN
using_binary_wrfsi=.true.
ENDIF
SELECT CASE ( use_package(io_form_auxinput1) )
#ifdef NETCDF
CASE ( IO_NETCDF )
! Open the wrfinput file.
current_date_char(11:11)='_'
WRITE ( wrf_err_message , FMT='(A,A)' )'med_sidata_input: calling open_r_dataset for ',TRIM(config_flags%auxinput1_inname)
CALL wrf_debug ( 100 , wrf_err_message )
IF ( config_flags%auxinput1_inname(1:8) .NE. 'wrf_real' ) THEN
CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char , &
config_flags%io_form_auxinput1 )
ELSE
CALL construct_filename2a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char )
END IF
CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
IF ( ierr .NE. 0 ) THEN
CALL wrf_error_fatal( 'error opening ' // TRIM(si_inpname) // ' for input; bad date in namelist or file not in directory' )
ENDIF
! Input data.
CALL wrf_debug (100, 'med_sidata_input: call input_aux_model_input1_wrf')
CALL input_aux_model_input1 ( idsi, grid, config_flags, ierr )
! Possible optional SI input. This sets flags used by init_domain.
IF ( loop .EQ. 1 ) THEN
CALL wrf_debug (100, 'med_sidata_input: call init_module_optional_input' )
CALL init_module_optional_input ( grid , config_flags )
CALL wrf_debug ( 100 , 'med_sidata_input: calling optional_input' )
!
CALL optional_input ( grid , idsi , config_flags )
write(0,*) 'maxval st_input(1) within real_nmm: ', maxval(st_input(:,1,:))
END IF
!
CALL close_dataset ( idsi , config_flags , "DATASET=AUXINPUT1" )
#endif
#ifdef INTIO
CASE ( IO_INTIO )
! Possible optional SI input. This sets flags used by init_domain.
IF ( loop .EQ. 1 ) THEN
CALL wrf_debug (100, 'med_sidata_input: call init_module_optional_input' )
CALL init_module_optional_input ( grid , config_flags )
END IF
IF (using_binary_wrfsi) THEN
current_date_char(11:11)='_'
CALL read_si ( grid, current_date_char )
current_date_char(11:11)='T'
ELSE
write(message,*) 'binary WPS branch'
CALL wrf_message(message)
CALL wrf_error_fatal("binary WPS support deferred for initial release")
! WRITE ( wrf_err_message , FMT='(A,A)' )'med_sidata_input: calling open_r_dataset for ',TRIM(config_flags%auxinput1_inname)
! CALL wrf_debug ( 100 , wrf_err_message )
! CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char , config_flags%io_form_auxinput1 )
! CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
! IF ( ierr .NE. 0 ) THEN
! CALL wrf_debug( 1 , 'error opening ' // TRIM(si_inpname) // ' for input; bad date in namelist or file not in directory' )
! CALL wrf_debug( 1 , 'will try again without the extension' )
! CALL construct_filename2a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char )
! CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
! IF ( ierr .NE. 0 ) THEN
! CALL wrf_error_fatal( 'error opening ' // TRIM(si_inpname) // ' for input; bad date in namelist or file not in directory' )
! ENDIF
! ENDIF
! Input data.
!!! believe problematic as binary data from WPS will be XYZ ordered, while this
!!! version of WRF will read in as XZY. OR read all fields in as unique
!!! Registry items that are XYZ, then swap. More memory, and more overhead, but
!!! better than having a stand alone "read_si" type code??
! CALL wrf_debug (100, 'med_sidata_input: call input_aux_model_input1_wrf')
! CALL input_aux_model_input1 ( idsi, grid, config_flags, ierr )
! Possible optional SI input. This sets flags used by init_domain.
! IF ( loop .EQ. 1 ) THEN
! CALL wrf_debug (100, 'med_sidata_input: call init_module_optional_input' )
! CALL init_module_optional_input ( grid , config_flags )
! END IF
! CALL wrf_debug ( 100 , 'med_sidata_input: calling optional_input' )
!
! CALL optional_input ( grid , idsi , config_flags)
! flag_metgrid=1
!
! CALL close_dataset ( idsi , config_flags , "DATASET=AUXINPUT1" )
ENDIF
#endif
CASE DEFAULT
CALL wrf_error_fatal('real: not valid io_form_auxinput1')
END SELECT
grid%islope=1
grid%vegfra=grid%vegfrc
grid%dfrlg=grid%dfl/9.81
grid%isurban=1
grid%isoilwater=14
! Initialize the mother domain for this time period with input data.
CALL wrf_debug ( 100 , 'med_sidata_input: calling init_domain' )
grid%input_from_file = .true.
CALL init_domain ( grid )
CALL model_to_grid_config_rec ( grid%id, model_config_rec, config_flags )
! Close this file that is output from the SI and input to this pre-proc.
CALL wrf_debug ( 100 , 'med_sidata_input: back from init_domain' )
!!! not sure about this, but doesnt seem like needs to be called each time
IF ( loop .EQ. 1 ) THEN
CALL start_domain ( grid , .TRUE.)
END IF
#ifdef WRF_CHEM
IF ( loop == 1 ) THEN
! IF ( ( grid%chem_opt .EQ. RADM2 ) .OR. &
! ( grid%chem_opt .EQ. RADM2SORG ) .OR. &
! ( grid%chem_opt .EQ. RACM ) .OR. &
! ( grid%chem_opt .EQ. RACMSORG ) ) THEN
IF( grid%chem_opt > 0 ) then
! Read the chemistry data from a previous wrf forecast (wrfout file)
IF(grid%chem_in_opt == 1 ) THEN
message = 'INITIALIZING CHEMISTRY WITH OLD SIMULATION'
CALL wrf_message ( message )
CALL input_ext_chem_file( grid )
IF(grid%bio_emiss_opt == BEIS311 ) THEN
message = 'READING BEIS3.11 EMISSIONS DATA'
CALL wrf_message ( message )
CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
else IF(grid%bio_emiss_opt == 3 ) THEN !shc
message = 'READING MEGAN 2 EMISSIONS DATA'
CALL wrf_message ( message )
CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
END IF
ELSEIF(grid%chem_in_opt == 0)then
! Generate chemistry data from a idealized vertical profile
message = 'STARTING WITH BACKGROUND CHEMISTRY '
CALL wrf_message ( message )
write(message,*)' ETA1 '
CALL wrf_message ( message )
! write(message,*) grid%eta1
! CALL wrf_message ( message )
CALL input_chem_profile ( grid )
IF(grid%bio_emiss_opt == BEIS311 ) THEN
message = 'READING BEIS3.11 EMISSIONS DATA'
CALL wrf_message ( message )
CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
else IF(grid%bio_emiss_opt == 3 ) THEN !shc
message = 'READING MEGAN 2 EMISSIONS DATA'
CALL wrf_message ( message )
CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
END IF
ELSE
message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
CALL wrf_message ( message )
ENDIF
ENDIF
ENDIF
#endif
config_flags%isurban=1
config_flags%isoilwater=14
CALL assemble_output ( grid , config_flags , loop , time_loop_max )
! Here we define the next time that we are going to process.
CALL geth_newdate ( current_date_char , start_date_char , &
loop * model_config_rec%interval_seconds )
current_date = current_date_char // '.0000'
CALL domain_clock_set( grid, current_date(1:19) )
write(message,*) 'current_date= ', current_date
CALL wrf_message(message)
END DO
END SUBROUTINE med_sidata_input
SUBROUTINE compute_si_start_and_end (docs) ( & 2,6
start_year, start_month, start_day, start_hour, &
start_minute, start_second, &
end_year , end_month , end_day , end_hour , &
end_minute , end_second , &
interval_seconds , real_data_init_type , &
start_date_char , end_date_char , time_loop_max )
USE module_date_time
IMPLICIT NONE
INTEGER :: start_year , start_month , start_day , &
start_hour , start_minute , start_second
INTEGER :: end_year , end_month , end_day , &
end_hour , end_minute , end_second
INTEGER :: interval_seconds , real_data_init_type
INTEGER :: time_loop_max , time_loop
CHARACTER(LEN=132) :: message
CHARACTER(LEN=19) :: current_date_char , start_date_char , &
end_date_char , next_date_char
! WRITE ( start_date_char , FMT = &
! '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
! start_year,start_month,start_day,start_hour,start_minute,start_second
! WRITE ( end_date_char , FMT = &
! '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
! end_year, end_month, end_day, end_hour, end_minute, end_second
WRITE ( start_date_char , FMT = &
'(I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2)' ) &
start_year,start_month,start_day,start_hour,start_minute,start_second
WRITE ( end_date_char , FMT = &
'(I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2)' ) &
end_year, end_month, end_day, end_hour, end_minute, end_second
! start_date = start_date_char // '.0000'
! Figure out our loop count for the processing times.
time_loop = 1
PRINT '(A,I4,A,A,A)','Time period #',time_loop, &
' to process = ',start_date_char,'.'
current_date_char = start_date_char
loop_count : DO
CALL geth_newdate (next_date_char, current_date_char, interval_seconds )
IF ( next_date_char .LT. end_date_char ) THEN
time_loop = time_loop + 1
PRINT '(A,I4,A,A,A)','Time period #',time_loop,&
' to process = ',next_date_char,'.'
current_date_char = next_date_char
ELSE IF ( next_date_char .EQ. end_date_char ) THEN
time_loop = time_loop + 1
PRINT '(A,I4,A,A,A)','Time period #',time_loop,&
' to process = ',next_date_char,'.'
PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
time_loop_max = time_loop
EXIT loop_count
ELSE IF ( next_date_char .GT. end_date_char ) THEN
PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
time_loop_max = time_loop
EXIT loop_count
END IF
END DO loop_count
write(message,*) 'done in si_start_and_end'
CALL wrf_message(message)
END SUBROUTINE compute_si_start_and_end
SUBROUTINE assemble_output (docs) ( grid , config_flags , loop , time_loop_max ) 3,144
!!! replace with something? USE module_big_step_utilities_em
USE module_domain
USE module_io_domain
USE module_configure
USE module_date_time
USE module_bc
IMPLICIT NONE
TYPE(domain) :: grid
TYPE (grid_config_rec_type) :: config_flags
INTEGER , INTENT(IN) :: loop , time_loop_max
INTEGER :: ids , ide , jds , jde , kds , kde
INTEGER :: ims , ime , jms , jme , kms , kme
INTEGER :: ips , ipe , jps , jpe , kps , kpe
INTEGER :: ijds , ijde , spec_bdy_width
INTEGER :: inc_h,inc_v
INTEGER :: i , j , k , idts
INTEGER :: id1 , interval_seconds , ierr, rc
INTEGER , SAVE :: id
CHARACTER (LEN=80) :: inpname , bdyname
CHARACTER(LEN= 4) :: loop_char
CHARACTER(LEN=132) :: message
character *19 :: temp19
character *24 :: temp24 , temp24b
REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ubdy3dtemp1 , vbdy3dtemp1 ,&
tbdy3dtemp1 , &
cwmbdy3dtemp1 , qbdy3dtemp1,&
q2bdy3dtemp1 , pdbdy2dtemp1
REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ubdy3dtemp2 , vbdy3dtemp2 , &
tbdy3dtemp2 , &
cwmbdy3dtemp2 , qbdy3dtemp2, &
q2bdy3dtemp2, pdbdy2dtemp2
REAL :: t1,t2
#ifdef DEREF_KLUDGE
! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x
INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y
#endif
#include "deref_kludge.h"
! Various sizes that we need to be concerned about.
ids = grid%sd31
ide = grid%ed31-1 ! 030730tst
jds = grid%sd32
jde = grid%ed32-1 ! 030730tst
kds = grid%sd33
kde = grid%ed33-1 ! 030730tst
ims = grid%sm31
ime = grid%em31
jms = grid%sm32
jme = grid%em32
kms = grid%sm33
kme = grid%em33
ips = grid%sp31
ipe = grid%ep31-1 ! 030730tst
jps = grid%sp32
jpe = grid%ep32-1 ! 030730tst
kps = grid%sp33
kpe = grid%ep33-1 ! 030730tst
if (IPE .ne. IDE) IPE=IPE+1
if (JPE .ne. JDE) JPE=JPE+1
write(message,*) 'assemble output (ids,ide): ', ids,ide
CALL wrf_message(message)
write(message,*) 'assemble output (ims,ime): ', ims,ime
CALL wrf_message(message)
write(message,*) 'assemble output (ips,ipe): ', ips,ipe
CALL wrf_message(message)
write(message,*) 'assemble output (jds,jde): ', jds,jde
CALL wrf_message(message)
write(message,*) 'assemble output (jms,jme): ', jms,jme
CALL wrf_message(message)
write(message,*) 'assemble output (jps,jpe): ', jps,jpe
CALL wrf_message(message)
write(message,*) 'assemble output (kds,kde): ', kds,kde
CALL wrf_message(message)
write(message,*) 'assemble output (kms,kme): ', kms,kme
CALL wrf_message(message)
write(message,*) 'assemble output (kps,kpe): ', kps,kpe
CALL wrf_message(message)
ijds = MIN ( ids , jds )
!mptest030805 ijde = MAX ( ide , jde )
ijde = MAX ( ide , jde ) + 1 ! to make stuff_bdy dimensions consistent with alloc
! Boundary width, scalar value.
spec_bdy_width = model_config_rec%spec_bdy_width
interval_seconds = model_config_rec%interval_seconds
!-----------------------------------------------------------------------
!
main_loop_test: IF ( loop .EQ. 1 ) THEN
!
!-----------------------------------------------------------------------
! This is the space needed to save the current 3d data for use in computing
! the lateral boundary tendencies.
ALLOCATE ( ubdy3dtemp1(ims:ime,jms:jme,kms:kme) )
ALLOCATE ( vbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
ALLOCATE ( tbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
ALLOCATE ( qbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
ALLOCATE ( cwmbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
ALLOCATE ( q2bdy3dtemp1(ims:ime,jms:jme,kms:kme) )
ALLOCATE ( pdbdy2dtemp1(ims:ime,jms:jme,1:1) )
ubdy3dtemp1=0.
vbdy3dtemp1=0.
tbdy3dtemp1=0.
qbdy3dtemp1=0.
cwmbdy3dtemp1=0.
q2bdy3dtemp1=0.
pdbdy2dtemp1=0.
ALLOCATE ( ubdy3dtemp2(ims:ime,jms:jme,kms:kme) )
ALLOCATE ( vbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
ALLOCATE ( tbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
ALLOCATE ( qbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
ALLOCATE ( cwmbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
ALLOCATE ( q2bdy3dtemp2(ims:ime,jms:jme,kms:kme) )
ALLOCATE ( pdbdy2dtemp2(ims:ime,jms:jme,1:1) )
ubdy3dtemp2=0.
vbdy3dtemp2=0.
tbdy3dtemp2=0.
qbdy3dtemp2=0.
cwmbdy3dtemp2=0.
q2bdy3dtemp2=0.
pdbdy2dtemp2=0.
! Open the wrfinput file. From this program, this is an *output* file.
CALL construct_filename1( inpname , 'wrfinput' , grid%id , 2 )
CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , &
output_model_input , "DATASET=INPUT", ierr )
IF ( ierr .NE. 0 ) THEN
CALL wrf_error_fatal( 'real: error opening wrfinput for writing' )
ENDIF
! CALL calc_current_date ( grid%id , 0. )
! grid%write_metadata = .true.
write(message,*) 'making call to output_model_input'
CALL wrf_message(message)
CALL output_model_input ( id1, grid , config_flags , ierr )
!***
!*** CLOSE THE WRFINPUT DATASET
!***
CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
! We need to save the 3d data to compute a
! difference during the next loop.
!
!-----------------------------------------------------------------------
!*** SOUTHERN BOUNDARY
!-----------------------------------------------------------------------
!
IF(JPS==JDS)THEN
J=1
DO k = kps , MIN(kde,kpe)
DO i = ips , MIN(ide,ipe)
ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
END DO
END DO
DO i = ips , MIN(ide,ipe)
pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
END DO
ENDIF
!
!-----------------------------------------------------------------------
!*** NORTHERN BOUNDARY
!-----------------------------------------------------------------------
!
IF(JPE==JDE)THEN
J=MIN(JDE,JPE)
DO k = kps , MIN(kde,kpe)
DO i = ips , MIN(ide,ipe)
ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
END DO
END DO
DO i = ips , MIN(ide,ipe)
pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
END DO
ENDIF
!
!-----------------------------------------------------------------------
!*** WESTERN BOUNDARY
!-----------------------------------------------------------------------
!
write(message,*) 'western boundary, store winds over J: ', jps, min(jpe,jde)
CALL wrf_message(message)
IF(IPS==IDS)THEN
I=1
DO k = kps , MIN(kde,kpe)
inc_h=mod(jps+1,2)
DO j = jps+inc_h, min(jde,jpe),2
if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
if(k==1)then
write(message,*)' loop=',loop,' i=',i,' j=',j,' tbdy3dtemp1(i,j,k)=',tbdy3dtemp1(i,j,k)
CALL wrf_debug(10,message)
endif
endif
END DO
END DO
DO k = kps , MIN(kde,kpe)
inc_v=mod(jps,2)
DO j = jps+inc_v, min(jde,jpe),2
if (J .ge. 2 .and. J .le. JDE-1 .and. mod(J,2) .eq. 0) then
ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
endif
END DO
END DO
!
inc_h=mod(jps+1,2)
DO j = jps+inc_h, min(jde,jpe),2
if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
write(message,*)' loop=',loop,' i=',i,' j=',j,' pdbdy2dtemp1(i,j)=',pdbdy2dtemp1(i,j,1)
CALL wrf_debug(10,message)
endif
END DO
ENDIF
!
!-----------------------------------------------------------------------
!*** EASTERN BOUNDARY
!-----------------------------------------------------------------------
!
IF(IPE==IDE)THEN
I=MIN(IDE,IPE)
!
DO k = kps , MIN(kde,kpe)
!
!*** Make sure the J loop is on the global boundary
!
inc_h=mod(jps+1,2)
DO j = jps+inc_h, min(jde,jpe),2
if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
endif
END DO
END DO
DO k = kps , MIN(kde,kpe)
inc_v=mod(jps,2)
DO j = jps+inc_v, min(jde,jpe),2
if (J .ge. 2 .and. J .le. JDE-1 .and. mod(J,2) .eq. 0) then
ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
endif
END DO
END DO
!
inc_h=mod(jps+1,2)
DO j = jps+inc_h, min(jde,jpe),2
if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
endif
END DO
ENDIF
! There are 2 components to the lateral boundaries.
! First, there is the starting
! point of this time period - just the outer few rows and columns.
CALL stuff_bdy_ijk (ubdy3dtemp1, grid%u_bxs, grid%u_bxe, &
grid%u_bys, grid%u_bye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdy_ijk (vbdy3dtemp1, grid%v_bxs, grid%v_bxe, &
grid%v_bys, grid%v_bye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdy_ijk (tbdy3dtemp1, grid%t_bxs, grid%t_bxe, &
grid%t_bys, grid%t_bye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdy_ijk (cwmbdy3dtemp1, grid%cwm_bxs, grid%cwm_bxe, &
grid%cwm_bys, grid%cwm_bye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdy_ijk (qbdy3dtemp1, grid%q_bxs, grid%q_bxe, &
grid%q_bys, grid%q_bye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdy_ijk (q2bdy3dtemp1, grid%q2_bxs, grid%q2_bxe, &
grid%q2_bys, grid%q2_bye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdy_ijk (pdbdy2dtemp1, grid%pd_bxs, grid%pd_bxe, &
grid%pd_bys, grid%pd_bye, &
'M', spec_bdy_width, &
ids , ide+1 , jds , jde+1 , 1 , 1 , &
ims , ime , jms , jme , 1 , 1 , &
ips , ipe , jps , jpe , 1 , 1 )
!-----------------------------------------------------------------------
!
ELSE IF ( loop .GT. 1 ) THEN
!
!-----------------------------------------------------------------------
write(message,*)' assemble_output loop=',loop,' in IF block'
call wrf_message(message)
! Open the boundary file.
IF ( loop .eq. 2 ) THEN
CALL construct_filename1( bdyname , 'wrfbdy' , grid%id , 2 )
CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , &
output_boundary , "DATASET=BOUNDARY", ierr )
IF ( ierr .NE. 0 ) THEN
CALL wrf_error_fatal( 'real: error opening wrfbdy for writing' )
ENDIF
! grid%write_metadata = .true.
ELSE
! what's this do?
! grid%write_metadata = .true.
! grid%write_metadata = .false.
CALL domain_clockadvance( grid )
END IF
!
!-----------------------------------------------------------------------
!*** SOUTHERN BOUNDARY
!-----------------------------------------------------------------------
!
IF(JPS==JDS)THEN
J=1
DO k = kps , MIN(kde,kpe)
DO i = ips , MIN(ide,ipe)
ubdy3dtemp2(i,j,k) = grid%u(i,j,k)
vbdy3dtemp2(i,j,k) = grid%v(i,j,k)
tbdy3dtemp2(i,j,k) = grid%t(i,j,k)
qbdy3dtemp2(i,j,k) = grid%q(i,j,k)
cwmbdy3dtemp2(i,j,k) = grid%cwm(i,j,k)
q2bdy3dtemp2(i,j,k) = grid%q2(i,j,k)
END DO
END DO
!
DO i = ips , MIN(ide,ipe)
pdbdy2dtemp2(i,j,1) = grid%pd(i,j)
END DO
ENDIF
!
!-----------------------------------------------------------------------
!*** NORTHERN BOUNDARY
!-----------------------------------------------------------------------
!
IF(JPE==JDE)THEN
J=MIN(JDE,JPE)
DO k = kps , MIN(kde,kpe)
DO i = ips , MIN(ide,ipe)
ubdy3dtemp2(i,j,k) = grid%u(i,j,k)
vbdy3dtemp2(i,j,k) = grid%v(i,j,k)
tbdy3dtemp2(i,j,k) = grid%t(i,j,k)
qbdy3dtemp2(i,j,k) = grid%q(i,j,k)
cwmbdy3dtemp2(i,j,k) = grid%cwm(i,j,k)
q2bdy3dtemp2(i,j,k) = grid%q2(i,j,k)
END DO
END DO
DO i = ips , MIN(ide,ipe)
pdbdy2dtemp2(i,j,1) = grid%pd(i,j)
END DO
ENDIF
!
!-----------------------------------------------------------------------
!*** WESTERN BOUNDARY
!-----------------------------------------------------------------------
!
IF(IPS==IDS)THEN
I=1
DO k = kps , MIN(kde,kpe)
inc_h=mod(jps+1,2)
if(k==1)then
write(message,*)' assemble_ouput loop=',loop,' inc_h=',inc_h,' jps=',jps
call wrf_debug(10,message)
endif
DO j = jps+inc_h, MIN(jde,jpe),2
if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
tbdy3dtemp2(i,j,k) = grid%t(i,j,k)
if(k==1)then
write(message,*)' loop=',loop,' i=',i,' j=',j,' tbdy3dtemp1(i,j,k)=',tbdy3dtemp1(i,j,k)
call wrf_debug(10,message)
endif
qbdy3dtemp2(i,j,k) = grid%q(i,j,k)
cwmbdy3dtemp2(i,j,k) = grid%cwm(i,j,k)
q2bdy3dtemp2(i,j,k) = grid%q2(i,j,k)
endif
END DO
END DO
!
DO k = kps , MIN(kde,kpe)
inc_v=mod(jps,2)
DO j = jps+inc_v, MIN(jde,jpe),2
if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
ubdy3dtemp2(i,j,k) = grid%u(i,j,k)
vbdy3dtemp2(i,j,k) = grid%v(i,j,k)
endif
END DO
END DO
inc_h=mod(jps+1,2)
DO j = jps+inc_h, MIN(jde,jpe),2
if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
pdbdy2dtemp2(i,j,1) = grid%pd(i,j)
write(message,*)' loop=',loop,' i=',i,' j=',j,' pdbdy2dtemp1(i,j)=',pdbdy2dtemp1(i,j,1)
CALL wrf_debug(10,message)
endif
END DO
ENDIF
!
!-----------------------------------------------------------------------
!*** EASTERN BOUNDARY
!-----------------------------------------------------------------------
!
IF(IPE==IDE)THEN
I=MIN(IDE,IPE)
DO k = kps , MIN(kde,kpe)
inc_h=mod(jps+1,2)
DO j = jps+inc_h, MIN(jde,jpe),2
if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
tbdy3dtemp2(i,j,k) = grid%t(i,j,k)
qbdy3dtemp2(i,j,k) = grid%q(i,j,k)
cwmbdy3dtemp2(i,j,k) = grid%cwm(i,j,k)
q2bdy3dtemp2(i,j,k) = grid%q2(i,j,k)
endif
END DO
END DO
DO k = kps , MIN(kde,kpe)
inc_v=mod(jps,2)
DO j = jps+inc_v, MIN(jde,jpe),2
if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
ubdy3dtemp2(i,j,k) = grid%u(i,j,k)
vbdy3dtemp2(i,j,k) = grid%v(i,j,k)
endif
END DO
END DO
inc_h=mod(jps+1,2)
DO j = jps+inc_h, MIN(jde,jpe),2
if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
pdbdy2dtemp2(i,j,1) = grid%pd(i,j)
endif
END DO
ENDIF
!-----------------------------------------------------------------------
! During all of the loops after the first loop,
! we first compute the boundary
! tendencies with the current data values
! (*bdy3dtemp2 arrays) and the previously
! saved information stored in the *bdy3dtemp1 arrays.
CALL stuff_bdytend_ijk ( ubdy3dtemp2 , ubdy3dtemp1 , REAL(interval_seconds),&
grid%u_btxs, grid%u_btxe, &
grid%u_btys, grid%u_btye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdytend_ijk ( vbdy3dtemp2 , vbdy3dtemp1 , REAL(interval_seconds),&
grid%v_btxs, grid%v_btxe, &
grid%v_btys, grid%v_btye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdytend_ijk ( tbdy3dtemp2 , tbdy3dtemp1 , REAL(interval_seconds),&
grid%t_btxs, grid%t_btxe, &
grid%t_btys, grid%t_btye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdytend_ijk ( cwmbdy3dtemp2 , cwmbdy3dtemp1 , REAL(interval_seconds),&
grid%cwm_btxs, grid%cwm_btxe, &
grid%cwm_btys, grid%cwm_btye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdytend_ijk ( qbdy3dtemp2 , qbdy3dtemp1 , REAL(interval_seconds),&
grid%q_btxs, grid%q_btxe, &
grid%q_btys, grid%q_btye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdytend_ijk ( q2bdy3dtemp2 , q2bdy3dtemp1 , REAL(interval_seconds),&
grid%q2_btxs, grid%q2_btxe, &
grid%q2_btys, grid%q2_btye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdytend_ijk( pdbdy2dtemp2 , pdbdy2dtemp1, REAL(interval_seconds),&
grid%pd_btxs, grid%pd_btxe, &
grid%pd_btys, grid%pd_btye, &
'M', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , 1 , 1 , &
ims , ime , jms , jme , 1 , 1 , &
ips , ipe , jps , jpe , 1 , 1 )
! Both pieces of the boundary data are now
! available to be written (initial time and tendency).
! This looks ugly, these date shifting things.
! What's it for? We want the "Times" variable
! in the lateral BDY file to have the valid times
! of when the initial fields are written.
! That's what the loop-2 thingy is for with the start date.
! We increment the start_date so
! that the starting time in the attributes is the
! second time period. Why you may ask. I
! agree, why indeed.
temp24= current_date
temp24b=start_date
start_date = current_date
CALL geth_newdate ( temp19 , temp24b(1:19) , &
(loop-2) * model_config_rec%interval_seconds )
current_date = temp19 // '.0000'
CALL domain_clock_set( grid, current_date(1:19) )
write(message,*) 'LBC valid between these times ',current_date, ' ',start_date
CALL wrf_message(message)
CALL output_boundary ( id, grid , config_flags , ierr )
current_date = temp24
start_date = temp24b
! OK, for all of the loops, we output the initialzation
! data, which would allow us to
! start the model at any of the available analysis time periods.
! WRITE ( loop_char , FMT = '(I4.4)' ) loop
! CALL open_w_dataset ( id1, 'wrfinput'//loop_char , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
! IF ( ierr .NE. 0 ) THEN
! CALL wrf_error_fatal( 'real: error opening wrfinput'//loop_char//' for writing' )
! ENDIF
! grid%write_metadata = .true.
! CALL calc_current_date ( grid%id , 0. )
! CALL output_model_input ( id1, grid , config_flags , ierr )
! CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
! Is this or is this not the last time time? We can remove some unnecessary
! stores if it is not.
IF ( loop .LT. time_loop_max ) THEN
! We need to save the 3d data to compute a
! difference during the next loop. Couple the
! 3d fields with total mu (mub + mu_2) and the
! stagger-specific map scale factor.
! We load up the boundary data again for use in the next loop.
!mp change these limits?????????
DO k = kps , kpe
DO j = jps , jpe
DO i = ips , ipe
ubdy3dtemp1(i,j,k) = ubdy3dtemp2(i,j,k)
vbdy3dtemp1(i,j,k) = vbdy3dtemp2(i,j,k)
tbdy3dtemp1(i,j,k) = tbdy3dtemp2(i,j,k)
cwmbdy3dtemp1(i,j,k) = cwmbdy3dtemp2(i,j,k)
qbdy3dtemp1(i,j,k) = qbdy3dtemp2(i,j,k)
q2bdy3dtemp1(i,j,k) = q2bdy3dtemp2(i,j,k)
END DO
END DO
END DO
!mp change these limits?????????
DO j = jps , jpe
DO i = ips , ipe
pdbdy2dtemp1(i,j,1) = pdbdy2dtemp2(i,j,1)
if (J .eq. jpe) write(0,*) 'I,J, PDBDy2dtemp1(i,j,1):' , I,J, PDBDy2dtemp1(i,j,1)
END DO
END DO
! There are 2 components to the lateral boundaries.
! First, there is the starting
! point of this time period - just the outer few rows and columns.
CALL stuff_bdy_ijk (ubdy3dtemp1, grid%u_bxs, grid%u_bxe, &
grid%u_bys, grid%u_bye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdy_ijk (vbdy3dtemp1, grid%v_bxs, grid%v_bxe, &
grid%v_bys, grid%v_bye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdy_ijk (tbdy3dtemp1, grid%t_bxs, grid%t_bxe, &
grid%t_bys, grid%t_bye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdy_ijk (cwmbdy3dtemp1, grid%cwm_bxs, grid%cwm_bxe, &
grid%cwm_bys, grid%cwm_bye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdy_ijk (qbdy3dtemp1, grid%q_bxs, grid%q_bxe, &
grid%q_bys, grid%q_bye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdy_ijk (q2bdy3dtemp1, grid%q2_bxs, grid%q2_bxe, &
grid%q2_bys, grid%q2_bye, &
'N', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , kds , kde+1 , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe+1 )
CALL stuff_bdy_ijk (pdbdy2dtemp1,grid%pd_bxs, grid%pd_bxe, &
grid%pd_bys, grid%pd_bye, &
'M', spec_bdy_width , &
ids , ide+1 , jds , jde+1 , 1 , 1 , &
ims , ime , jms , jme , 1 , 1 , &
ips , ipe , jps , jpe , 1 , 1 )
ELSE IF ( loop .EQ. time_loop_max ) THEN
! If this is the last time through here, we need to close the files.
CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
END IF
END IF main_loop_test
END SUBROUTINE assemble_output