MODULE module_integrate
CONTAINS
RECURSIVE SUBROUTINE integrate ( grid )
USE module_domain
USE module_driver_constants
USE module_nesting
USE module_configure
USE module_timing
USE module_utility
IMPLICIT NONE
TYPE(domain) , POINTER :: grid
CHARACTER*32 :: outname, rstname
TYPE(domain) , POINTER :: grid_ptr , new_nest
TYPE(domain) :: intermediate_grid
INTEGER :: step
INTEGER :: nestid , kid
LOGICAL :: a_nest_was_opened
INTEGER :: fid , rid
LOGICAL :: lbc_opened
REAL :: time, btime, bfrq
CHARACTER*256 :: message, message2,message3
TYPE (grid_config_rec_type) :: config_flags
LOGICAL , EXTERNAL :: wrf_dm_on_monitor
INTEGER :: idum1 , idum2 , ierr , open_status
LOGICAL :: should_do_last_io
INTERFACE
SUBROUTINE solve_interface ( grid )
USE module_domain
TYPE (domain) grid
END SUBROUTINE solve_interface
SUBROUTINE med_calc_model_time ( grid , config_flags )
USE module_domain
USE module_configure
TYPE (domain) grid
TYPE (grid_config_rec_type) config_flags
END SUBROUTINE med_calc_model_time
SUBROUTINE med_before_solve_io ( grid , config_flags )
USE module_domain
USE module_configure
TYPE (domain) grid
TYPE (grid_config_rec_type) config_flags
END SUBROUTINE med_before_solve_io
SUBROUTINE med_after_solve_io ( grid , config_flags )
USE module_domain
USE module_configure
TYPE (domain) grid
TYPE (grid_config_rec_type) config_flags
END SUBROUTINE med_after_solve_io
SUBROUTINE med_pre_nest_initial ( parent , newid , config_flags )
USE module_domain
USE module_configure
TYPE (domain), POINTER :: parent
INTEGER, INTENT(IN) :: newid
TYPE (grid_config_rec_type) config_flags
END SUBROUTINE med_pre_nest_initial
SUBROUTINE med_nest_initial ( parent , grid , config_flags )
USE module_domain
USE module_configure
TYPE (domain), POINTER :: grid , parent
TYPE (grid_config_rec_type) config_flags
END SUBROUTINE med_nest_initial
SUBROUTINE med_nest_force ( parent , grid )
USE module_domain
USE module_configure
TYPE (domain), POINTER :: grid, parent
END SUBROUTINE med_nest_force
SUBROUTINE med_nest_feedback ( parent , grid , config_flags )
USE module_domain
USE module_configure
TYPE (domain), POINTER :: grid , parent
TYPE (grid_config_rec_type) config_flags
END SUBROUTINE med_nest_feedback
SUBROUTINE med_last_solve_io ( grid , config_flags )
USE module_domain
USE module_configure
TYPE (domain) grid
TYPE (grid_config_rec_type) config_flags
END SUBROUTINE med_last_solve_io
SUBROUTINE med_setup_step ( grid , config_flags )
USE module_domain
USE module_configure
TYPE (domain) grid
TYPE (grid_config_rec_type) config_flags
END SUBROUTINE med_setup_step
SUBROUTINE med_endup_step ( grid , config_flags )
USE module_domain
USE module_configure
TYPE (domain) grid
TYPE (grid_config_rec_type) config_flags
END SUBROUTINE med_endup_step
SUBROUTINE Setup_Timekeeping( grid )
USE module_domain
TYPE(domain), POINTER :: grid
END SUBROUTINE
SUBROUTINE dfi_accumulate( grid )
USE module_domain
TYPE(domain), POINTER :: grid
END SUBROUTINE
END INTERFACE
CALL set_current_grid_ptr( grid )
IF ( .NOT. domain_clockisstoptime( grid ) ) THEN
CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
IF ( config_flags%grid_allowed ) THEN
CALL domain_clockprint ( 150, grid, 'DEBUG: top of integrate(),' )
DO WHILE ( .NOT. domain_clockisstopsubtime(grid) )
IF ( wrf_dm_on_monitor() ) THEN
CALL start_timing
END IF
CALL med_setup_step ( grid , config_flags )
a_nest_was_opened = .false.
DO WHILE ( nests_to_open( grid , nestid , kid ) )
a_nest_was_opened = .true.
CALL med_pre_nest_initial ( grid , nestid , config_flags )
CALL alloc_and_configure_domain ( domain_id = nestid , &
grid = new_nest , &
parent = grid , &
kid = kid )
CALL Setup_Timekeeping (new_nest)
CALL med_nest_initial ( grid , new_nest , config_flags )
IF ( grid%dfi_stage == DFI_STARTFWD ) THEN
CALL wrf_dfi_startfwd_init(new_nest)
ENDIF
END DO
IF ( a_nest_was_opened ) THEN
CALL set_overlaps ( grid )
END IF
CALL dfi_accumulate ( grid )
CALL med_before_solve_io ( grid , config_flags )
grid_ptr => grid
DO WHILE ( ASSOCIATED( grid_ptr ) )
CALL set_current_grid_ptr( grid_ptr )
CALL wrf_debug( 100 , 'module_integrate: calling solve interface ' )
CALL solve_interface ( grid_ptr )
CALL domain_clockadvance ( grid_ptr )
CALL wrf_debug( 100 , 'module_integrate: back from solve interface ' )
CALL domain_time_test( grid_ptr, 'domain_clockadvance' )
grid_ptr => grid_ptr%sibling
END DO
CALL set_current_grid_ptr( grid )
CALL med_calc_model_time ( grid , config_flags )
CALL med_after_solve_io ( grid , config_flags )
grid_ptr => grid
DO WHILE ( ASSOCIATED( grid_ptr ) )
DO kid = 1, max_nests
IF ( ASSOCIATED( grid_ptr%nests(kid)%ptr ) ) THEN
CALL set_current_grid_ptr( grid_ptr%nests(kid)%ptr )
CALL wrf_debug( 100 , 'module_integrate: calling med_nest_force ' )
CALL med_nest_force ( grid_ptr , grid_ptr%nests(kid)%ptr )
CALL wrf_debug( 100 , 'module_integrate: back from med_nest_force ' )
grid_ptr%nests(kid)%ptr%start_subtime = &
domain_get_current_time(grid) - domain_get_time_step(grid)
grid_ptr%nests(kid)%ptr%stop_subtime = &
domain_get_current_time(grid)
CALL integrate ( grid_ptr%nests(kid)%ptr )
CALL wrf_debug( 100 , 'module_integrate: back from recursive call to integrate ' )
IF ( .NOT. ( domain_clockisstoptime(head_grid ) .OR. &
domain_clockisstoptime(grid ) .OR. &
domain_clockisstoptime(grid_ptr%nests(kid)%ptr) ) ) THEN
CALL wrf_debug( 100 , 'module_integrate: calling med_nest_feedback ' )
CALL med_nest_feedback ( grid_ptr , grid_ptr%nests(kid)%ptr , config_flags )
CALL wrf_debug( 100 , 'module_integrate: back from med_nest_feedback ' )
END IF
END IF
END DO
grid_ptr => grid_ptr%sibling
END DO
CALL set_current_grid_ptr( grid )
IF ( wrf_dm_on_monitor() ) THEN
CALL domain_clock_get ( grid, current_timestr=message2 )
if (config_flags%use_adaptive_time_step) then
WRITE ( message , FMT = '("main (dt=",F6.2,"): time ",A," on domain ",I3)' ) grid%dt, TRIM(message2), grid%id
else
WRITE ( message , FMT = '("main: time ",A," on domain ",I3)' ) TRIM(message2), grid%id
endif
CALL end_timing ( TRIM(message) )
END IF
CALL med_endup_step ( grid , config_flags )
END DO
CALL dfi_accumulate ( grid )
IF ( grid%id .EQ. 1 ) THEN
CALL med_last_solve_io ( grid , config_flags )
ELSE
should_do_last_io = domain_clockisstoptime( head_grid )
grid_ptr => grid
DO WHILE ( grid_ptr%id .NE. 1 )
IF ( domain_clockisstoptime( grid_ptr ) ) THEN
should_do_last_io = .TRUE.
END IF
grid_ptr => grid_ptr%parents(1)%ptr
ENDDO
IF ( should_do_last_io ) THEN
grid_ptr => grid
CALL med_nest_feedback ( grid_ptr%parents(1)%ptr, grid , config_flags )
CALL med_last_solve_io ( grid , config_flags )
ENDIF
ENDIF
ENDIF
END IF
END SUBROUTINE integrate
END MODULE module_integrate