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 USE module_cpl, ONLY : coupler_on, cpl_snd, cpl_defdomain USE module_xios, ONLY : xios_on, xios_initdomain, xios_finalizedomain USE module_dm, ONLY: domain_active_this_task 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 LOGICAL :: may_have_moved 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 ) CALL push_communicators_for_domain( grid%id ) 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 IF ( grid%active_this_task ) THEN CALL start_timing END IF 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 , & active_this_task = domain_active_this_task( nestid ), & grid = new_nest , & parent = grid , & kid = kid ) CALL Setup_Timekeeping (new_nest) CALL med_nest_initial ( grid , new_nest , config_flags ) IF ( grid%active_this_task ) THEN IF ( grid%dfi_stage == DFI_STARTFWD ) THEN CALL wrf_dfi_startfwd_init(new_nest) ENDIF IF (coupler_on) CALL cpl_defdomain( new_nest ) IF ( xios_on) CALL xios_initdomain( new_nest, config_flags ) ENDIF END DO IF ( a_nest_was_opened ) THEN CALL set_overlaps ( grid ) END IF IF ( grid%active_this_task ) THEN CALL dfi_accumulate ( grid ) IF (xios_on) CALL WRFU_AlarmRingerOn( grid%alarms( HISTORY_ALARM ) ) ENDIF IF ( grid%active_this_task ) THEN CALL med_before_solve_io ( grid , config_flags ) ENDIF grid_ptr => grid DO WHILE ( ASSOCIATED( grid_ptr ) ) IF ( grid_ptr%active_this_task ) THEN CALL set_current_grid_ptr( grid_ptr ) CALL wrf_debug( 100 , 'module_integrate: calling solve interface ' ) CALL solve_interface ( grid_ptr ) ENDIF 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 ) IF ( grid%active_this_task ) THEN CALL med_after_solve_io ( grid , config_flags ) ENDIF 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) ENDIF ENDDO DO kid = 1, max_nests IF ( ASSOCIATED( grid_ptr%nests(kid)%ptr ) ) THEN CALL set_current_grid_ptr( grid_ptr%nests(kid)%ptr ) WRITE(message,*)grid%id,' module_integrate: recursive call to integrate ' CALL wrf_debug( 100 , message ) CALL integrate ( grid_ptr%nests(kid)%ptr ) WRITE(message,*)grid%id,' module_integrate: back from recursive call to integrate ' CALL wrf_debug( 100 , message ) ENDIF ENDDO may_have_moved = .FALSE. DO kid = 1, max_nests IF ( ASSOCIATED( grid_ptr%nests(kid)%ptr ) ) THEN CALL set_current_grid_ptr( grid_ptr%nests(kid)%ptr ) 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 IF (coupler_on) CALL cpl_snd( grid_ptr ) grid_ptr => grid_ptr%sibling END DO CALL set_current_grid_ptr( grid ) IF ( wrf_dm_on_monitor() ) THEN IF ( grid%active_this_task ) 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) ) ENDIF ENDIF CALL med_endup_step ( grid , config_flags ) END DO IF ( grid%active_this_task ) THEN CALL dfi_accumulate ( grid ) ENDIF IF (xios_on) CALL WRFU_AlarmRingerOn( grid%alarms( HISTORY_ALARM ) ) IF ( grid%id .EQ. 1 ) THEN IF ( grid%active_this_task ) CALL med_last_solve_io ( grid , config_flags ) IF (xios_on) CALL xios_finalizedomain( grid%id ) 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 ) IF ( grid%active_this_task ) CALL med_last_solve_io ( grid , config_flags ) IF (xios_on) CALL xios_finalizedomain( grid%id ) ENDIF ENDIF ENDIF END IF CALL pop_communicators_for_domain END SUBROUTINE integrate END MODULE module_integrate