!WRF:MEDIATION_LAYER:IO
!
SUBROUTINE med_calc_model_time ( grid , config_flags , start_step , step , end_step ) 2,4
! Driver layer
USE module_domain
! Model layer
USE module_configure
USE module_date_time
IMPLICIT NONE
! Arguments
TYPE(domain) :: grid
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
INTEGER , INTENT(IN) :: start_step , step , end_step
! Local data
REAL :: time
time = head_grid%dt * head_grid%total_time_steps
CALL calc_current_date
(grid%id, time)
END SUBROUTINE med_calc_model_time
SUBROUTINE med_before_solve_io ( grid , config_flags , start_step , step , end_step ) 1,5
! Driver layer
USE module_domain
! Model layer
USE module_configure
IMPLICIT NONE
! Arguments
TYPE(domain) :: grid
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
INTEGER , INTENT(IN) :: start_step , step , end_step
CALL med_latbound_in
( grid , config_flags , start_step , step , end_step )
CALL med_history_out
( grid , config_flags , start_step , step , end_step )
CALL med_restart_out
( grid , config_flags , start_step , step , end_step )
RETURN
END SUBROUTINE med_before_solve_io
SUBROUTINE med_after_solve_io ( grid , config_flags , start_step , step , end_step ) 1,3
! Driver layer
USE module_domain
USE module_timing
! Model layer
USE module_configure
IMPLICIT NONE
! Arguments
TYPE(domain) :: grid
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
INTEGER , INTENT(IN) :: start_step , step , end_step
RETURN
END SUBROUTINE med_after_solve_io
SUBROUTINE med_nest_initial ( parent , nest , config_flags , start_step , step , end_step ) 1,5
! Driver layer
USE module_domain
USE module_timing
! Model layer
USE module_configure
IMPLICIT NONE
! Arguments
TYPE(domain) , POINTER :: parent, nest
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
INTEGER , INTENT(IN) :: start_step , step , end_step
! Local
INTEGER :: idum1 , idum2 , fid
INTERFACE
SUBROUTINE med_interp_domain ( parent , nest )
USE module_domain
TYPE(domain) , POINTER :: parent , nest
END SUBROUTINE med_interp_domain
END INTERFACE
! initialize nest with interpolated data from the parent
CALL med_interp_domain
( parent, nest )
! might also have calls here to do input from a file into the nest
RETURN
END SUBROUTINE med_nest_initial
SUBROUTINE med_nest_force ( parent , nest , config_flags , start_step , step , end_step ) 1,5
! Driver layer
USE module_domain
USE module_timing
! Model layer
USE module_configure
IMPLICIT NONE
! Arguments
TYPE(domain) , POINTER :: parent, nest
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
INTEGER , INTENT(IN) :: start_step , step , end_step
! Local
INTEGER :: idum1 , idum2 , fid
INTERFACE
SUBROUTINE med_force_domain ( parent , nest )
USE module_domain
TYPE(domain) , POINTER :: parent , nest
END SUBROUTINE med_force_domain
END INTERFACE
! force nest with interpolated data from the parent
CALL med_force_domain
( parent, nest )
! might also have calls here to do input from a file into the nest
RETURN
END SUBROUTINE med_nest_force
SUBROUTINE med_nest_feedback ( parent , nest , config_flags , start_step , step , end_step ) 1,5
! Driver layer
USE module_domain
USE module_timing
! Model layer
USE module_configure
IMPLICIT NONE
! Arguments
TYPE(domain) , POINTER :: parent, nest
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
INTEGER , INTENT(IN) :: start_step , step , end_step
! Local
INTEGER :: idum1 , idum2 , fid
INTERFACE
SUBROUTINE med_feedback_domain ( parent , nest )
USE module_domain
TYPE(domain) , POINTER :: parent , nest
END SUBROUTINE med_feedback_domain
END INTERFACE
! feedback nest with interpolated data from the parent
CALL med_feedback_domain
( parent, nest )
RETURN
END SUBROUTINE med_nest_feedback
SUBROUTINE med_last_solve_io ( grid , config_flags , start_step , step , end_step ) 1,4
! Driver layer
USE module_domain
! Model layer
USE module_configure
IMPLICIT NONE
! Arguments
TYPE(domain) :: grid
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
INTEGER , INTENT(IN) :: start_step , step , end_step
CALL med_history_out
( grid , config_flags , start_step , step , end_step )
CALL med_restart_out
( grid , config_flags , start_step , step , end_step )
RETURN
END SUBROUTINE med_last_solve_io
SUBROUTINE med_restart_out ( grid , config_flags , start_step , step , end_step ) 2,12
! Driver layer
USE module_domain
USE module_io_domain
! Model layer
USE module_configure
USE module_bc_time_utilities
IMPLICIT NONE
! Arguments
TYPE(domain) :: grid
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
INTEGER , INTENT(IN) :: start_step , step , end_step
! Local
LOGICAL, EXTERNAL :: wrf_dm_on_monitor
CHARACTER*80 :: rstname , outname
INTEGER :: fid , rid
CHARACTER (LEN=256) :: message
INTEGER :: ierr
INTEGER :: myproc
! - RESTART OUTPUT ** (good for 1-million steps on one domain only, for now)
IF(grid%time_step_count_restart .GT. 0 ) THEN
IF(grid%id .EQ. 1 .AND. &
mod(grid%total_time_steps, grid%time_step_count_restart) .eq. 0 .AND. &
grid%total_time_steps .NE. grid%time_step_begin_restart .AND. &
grid%total_time_steps > 0 ) THEN
IF ( wrf_dm_on_monitor() ) THEN
CALL start_timing
END IF
CALL construct_filename
( rstname , 'wrfrst' , grid%id , 2 , grid%total_time_steps , 6 )
WRITE( message , '("med_restart_out: opening ",A," for writing")' ) TRIM ( rstname )
CALL wrf_debug
( 0 , message )
grid%write_metadata = .false.
CALL open_w_dataset
( rid, TRIM(rstname), grid , &
config_flags , output_restart , "DATASET=RESTART", ierr )
IF ( ierr .NE. 0 ) THEN
CALL WRF_ERROR_FATAL
( message )
ENDIF
grid%write_metadata = .true.
CALL output_restart
( rid, grid , config_flags , ierr )
IF ( wrf_dm_on_monitor() ) THEN
WRITE ( message , FMT = '("Writing restart for domain ",I8)' ) grid%id
CALL end_timing
( TRIM(message) )
END IF
CALL close_dataset
( rid , config_flags , "DATASET=RESTART" )
END IF
END IF
RETURN
END SUBROUTINE med_restart_out
SUBROUTINE med_history_out ( grid , config_flags , start_step , step , end_step ) 4,13
! Driver layer
USE module_domain
USE module_io_domain
! Model layer
USE module_configure
USE module_bc_time_utilities
IMPLICIT NONE
! Arguments
TYPE(domain) :: grid
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
INTEGER , INTENT(IN) :: start_step , step , end_step
! Local
LOGICAL, EXTERNAL :: wrf_dm_on_monitor
CHARACTER*80 :: rstname , outname
INTEGER :: fid , rid
CHARACTER (LEN=256) :: message
INTEGER :: ierr
INTEGER :: myproc
IF(mod(head_grid%total_time_steps, grid%time_step_count_output) .eq. 0) THEN
IF ( wrf_dm_on_monitor() ) THEN
CALL start_timing
END IF
IF ( grid%oid .eq. 0 ) THEN
CALL construct_filename
( outname , 'wrfout' , grid%id , 2 , grid%total_time_steps , 6 )
WRITE ( message , '("med_history_out 1: opening ",A," for writing. ",I3)') TRIM ( outname ), ierr
CALL wrf_debug
( 0, message )
grid%write_metadata = .false.
CALL open_w_dataset
( grid%oid, TRIM(outname), grid , &
config_flags , output_history , "DATASET=HISTORY", ierr )
IF ( ierr .NE. 0 ) THEN
CALL wrf_error_fatal
( message )
ENDIF
IF ( ierr .NE. 0 ) THEN
CALL wrf_error_fatal
( message )
ENDIF
grid%write_metadata = .true.
ELSE
grid%write_metadata = .false.
END IF
CALL output_history
( grid%oid, grid , config_flags , ierr )
grid%nframes = grid%nframes + 1
IF ( grid%nframes >= config_flags%frames_per_outfile ) THEN
CALL close_dataset
( grid%oid , config_flags , "DATASET=HISTORY" )
grid%nframes = 0
grid%oid = 0
ENDIF
IF ( wrf_dm_on_monitor() ) THEN
WRITE ( message , FMT = '("Writing output for domain ",I8)' ) grid%id
CALL end_timing
( TRIM(message) )
END IF
END IF
RETURN
END SUBROUTINE med_history_out
SUBROUTINE med_latbound_in ( grid , config_flags , start_step , step , end_step ) 1,20
! Driver layer
USE module_domain
USE module_io_domain
! Model layer
USE module_configure
USE module_bc_time_utilities
IMPLICIT NONE
! Arguments
TYPE(domain) :: grid
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
INTEGER , INTENT(IN) :: start_step , step , end_step
! Local data
LOGICAL, EXTERNAL :: wrf_dm_on_monitor
LOGICAL :: lbc_opened
INTEGER :: idum1 , idum2 , ierr , open_status , fid
REAL :: time, btime, bfrq
CHARACTER (LEN=256) :: message
CHARACTER (LEN=80) :: bdyname
#include <wrf_io_flags.h>
IF ( grid%id .EQ. 1 .AND. config_flags%specified ) THEN
IF ( ( lbc_read_time( grid%total_time_steps * grid%dt ) ) .AND. &
( end_step - step .LT. 1 ) ) THEN
CALL wrf_debug
( 100 , 'med_latbound_in: Skipping attempt to read lateral boundary file during last time step ' )
ELSE IF ( lbc_read_time( grid%total_time_steps * grid%dt ) ) THEN
IF ( wrf_dm_on_monitor() ) CALL start_timing
CALL construct_filename1
( bdyname , 'wrfbdy' , grid%id , 2 )
CALL wrf_inquire_opened
(head_grid%lbc_fid , TRIM(bdyname) , open_status , ierr )
IF ( open_status .EQ. WRF_FILE_OPENED_FOR_READ ) THEN
lbc_opened = .TRUE.
ELSE
lbc_opened = .FALSE.
ENDIF
CALL wrf_dm_bcast_bytes
( lbc_opened , LWORDSIZE )
IF ( .NOT. lbc_opened ) THEN
CALL construct_filename1
( bdyname , 'wrfbdy' , grid%id , 2 )
CALL open_r_dataset
( head_grid%lbc_fid, TRIM(bdyname) , grid , config_flags , "DATASET=BOUNDARY", ierr )
IF ( ierr .NE. 0 ) THEN
WRITE( message, * ) 'med_latbound_in: error opening ',TRIM(bdyname), ' for reading. IERR = ',ierr
CALL WRF_ERROR_FATAL
( message )
ENDIF
ENDIF
CALL wrf_debug
( 100 , 'med_latbound_in: calling input_boundary ' )
CALL input_boundary
( grid%lbc_fid, grid , config_flags , ierr )
CALL get_time_to_read_again
(btime)
time = grid%dt * grid%total_time_steps
DO WHILE (time .GE. btime - 0.5*grid%dt)
CALL wrf_debug
( 100 , 'med_latbound_in: calling input_boundary ' )
CALL input_boundary
( grid%lbc_fid, grid , config_flags , ierr )
CALL get_time_to_read_again
(btime)
ENDDO
IF ( ierr .NE. 0 ) THEN
WRITE( message, * ) 'med_latbound_in: error reading ',TRIM(bdyname), ' IERR = ',ierr
CALL WRF_ERROR_FATAL
( message )
ENDIF
CALL get_bdyfrq (grid%id, bfrq)
IF(time - (btime-bfrq) .LT. 0.5*grid%dt )grid%dtbc = 0.
IF ( wrf_dm_on_monitor() ) THEN
WRITE ( message , FMT = '("processing lateral boundary for domain ",I8)' ) grid%id
CALL end_timing
( TRIM(message) )
ENDIF
ENDIF
ENDIF
RETURN
END SUBROUTINE med_latbound_in
SUBROUTINE med_setup_step ( grid , config_flags , start_step , step , end_step ) 1,3
! Driver layer
USE module_domain
! Model layer
USE module_configure
IMPLICIT NONE
! Arguments
TYPE(domain) :: grid
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
INTEGER , INTENT(IN) :: start_step , step , end_step
! Local
INTEGER :: idum1 , idum2
grid%itimestep = step
CALL set_scalar_indices_from_config
( grid%id , idum1 , idum2 )
RETURN
END SUBROUTINE med_setup_step