wrfv2_fire/frame/module_integrate.F

   1 !WRF:DRIVER_LAYER:INTEGRATION
   2 !
   3
   4 MODULE module_integrate
   5
   6 CONTAINS
   7
   8 RECURSIVE SUBROUTINE integrate ( grid )
   9
  10
  11
  12    USE module_domain
  13    USE module_driver_constants
  14    USE module_nesting
  15    USE module_configure
  16    USE module_timing
  17    USE module_utility
  18
  19    IMPLICIT NONE
  20
  21    !  Input data.
  22
  23    TYPE(domain) , POINTER :: grid
  24
  25 ! module_integrate:integrate
  26 ! <DESCRIPTION>
  27 ! This is a driver-level routine that controls the integration of a
  28 ! domain and subdomains rooted at the domain.
  29 !
  30 ! The integrate routine takes a domain pointed to by the argument
  31 ! <em>grid</em> and advances the domain and its associated nests from the
  32 ! grid's current time, stored within grid%domain_clock, to a given time
  33 ! forward in the simulation, stored as grid%stop_subtime. The
  34 ! stop_subtime value is arbitrary and does not have to be the same as
  35 ! time that the domain finished integrating.  The simulation stop time
  36 ! for the grid is known to the grid's clock (grid%domain_clock) and that
  37 ! is checked with a call to domain_clockisstoptime prior to beginning the
  38 ! loop over time period that is specified by the
  39 ! current time/stop_subtime interval.
  40 !
  41 ! The clock, the simulation stop time for the domain, and other timing
  42 ! aspects for the grid are set up in the routine
  43 ! (<a href="setup_timekeeping.html">setup_timekeeping</a>) at the time
  44 ! that the domain is initialized.
  45 ! The lower-level time library and the type declarations for the times
  46 ! and time intervals used are defined either in
  47 ! external/esmf_time_f90/module_utility.F90 or in
  48 ! external/io_esmf/module_utility.F90 depending on a build-time decision to
  49 ! incorporate either the embedded ESMF subset implementation contained in
  50 ! external/esmf_time_f90 or to use a site-specific installation of the ESMF
  51 ! library.  This decision is made during the configuration step of the WRF
  52 ! build process.  Note that arithmetic and comparison is performed on these
  53 ! data types using F90 operator overloading, also defined in that library.
  54 !
  55 ! This routine is the lowest level of the WRF Driver Layer and for the most
  56 ! part the WRF routines that are called from here are in the topmost level
  57 ! of the Mediation Layer.  Mediation layer routines typically are not
  58 ! defined in modules. Therefore, the routines that this routine calls
  59 ! have explicit interfaces specified in an interface block in this routine.
  60 !
  61 ! As part of the Driver Layer, this routine is intended to be non model-specific
  62 ! and so a minimum of WRF-specific logic is coded at this level. Rather, there
  63 ! are a number of calls to mediation layer routines that contain this logic, some
  64 ! of which are merely stubs in WRF Mediation Layer that sits below this routine
  65 ! in the call tree.  The routines that integrate calls in WRF are defined in
  66 ! share/mediation_integrate.F.
  67 !
  68 ! Flow of control
  69 !
  70 ! 1. Check to see that the domain is not finished
  71 ! by testing the value returned by domain_clockisstoptime for the
  72 ! domain.
  73 !
  74 ! 2. <a href=model_to_grid_config_rec.html>Model_to_grid_config_rec</a> is called to load the local config_flags
  75 ! structure with the configuration information for the grid stored
  76 ! in model_config_rec and indexed by the grid's unique integer id. These
  77 ! structures are defined in frame/module_configure.F.
  78 !
  79 ! 3. The current time of the domain is retrieved from the domain's clock
  80 ! using domain_get_current_time.
  81 !
  82 ! 4. Iterate forward while the current time is less than the stop subtime.
  83 !
  84 ! 4.a. Start timing for this iteration (only on node zero in distributed-memory runs)
  85 !
  86 ! 4.b. Call <a href=med_setup_step.html>med_setup_step</a> to allow the mediation layer to
  87 ! do anything that's needed to call the solver for this domain.  In WRF this means setting
  88 ! the indices into the 4D tracer arrays for the domain.
  89 !
  90 ! 4.c. Check for any nests that need to be started up at this time.  This is done
  91 ! calling the logical function <a href=nests_to_open.html>nests_to_open</a> (defined in
  92 ! frame/module_nesting.F) which returns true and the index into the current domain's list
  93 ! of children to use for the nest when one needs to be started.
  94 !
  95 ! 4.c.1  Call <a href=alloc_and_configure_domain.html>alloc_and_configure_domain</a> to allocate
  96 ! the new nest and link it as a child of this grid.
  97 !
  98 ! 4.c.2  Call <a href=setup_Timekeeping.html>setup_Timekeeping</a> for the nest.
  99 !
 100 ! 4.c.3  Initialize the nest's arrays by calling <a href=med_nest_initial.html>med_nest_initial</a>. This will
 101 ! either interpolate data from this grid onto the nest, read it in from a file, or both. In a restart run, this
 102 ! is also where the nest reads in its restart file.
 103 !
 104 ! 4.d  If a nest was opened above, check for and resolve overlaps (this is not implemented in WRF 2.0, which
 105 ! supports multiple nests on the same level but does not support overlapping).
 106 !
 107 ! 4.e  Give the mediation layer an opportunity to do something before the solver is called by
 108 ! calling <a href=med_before_solve_io.html>med_before_solve_io</a>. In WRF this is the point at which history and
 109 ! restart data is output.
 110 !
 111 ! 4.f  Call <a href=solve_interface.html>solve_interface</a> which calls the solver that advance the domain
 112 ! one time step, then advance the domain's clock by calling domain_clockadvance.
 113 ! The enclosing WHILE loop around this section is for handling other domains
 114 ! with which this domain may overlap.  It is not active in WRF 2.0 and only
 115 ! executes one trip.
 116 !
 117 ! 4.g Call med_calc_model_time and med_after_solve_io, which are stubs in WRF.
 118 !
 119 ! 4.h Iterate over the children of this domain (<tt>DO kid = 1, max_nests</tt>) and check each child pointer to see
 120 ! if it is associated (and therefore, active).
 121 !
 122 ! 4.h.1  Force the nested domain boundaries from this domain by calling <a href=med_nest_force.html>med_nest_force</a>.
 123 !
 124 ! 4.h.2  Setup the time period over which the nest is to run. Sine the current grid has been advanced one time step
 125 ! and the nest has not, the start for the nest is this grid's current time minus one time step.  The nest's stop_subtime
 126 ! is the current time, bringing the nest up the same time level as this grid, its parent.
 127 !
 128 ! 4.h.3  Recursively call this routine, integrate, to advance the nest's time.  Since it is recursive, this will
 129 ! also advance all the domains who are nests of this nest and so on.  In other words, when this call returns, all
 130 ! the domains rooted at the nest will be at the current time.
 131 !
 132 ! 4.h.4  Feedback data from the nested domain back onto this domain by calling <a href=med_nest_feedback.html>med_nest_feedback</a>.
 133 !
 134 ! 4.i  Write the time to compute this grid and its subtree. This marks the end of the loop begun at step 4, above.
 135 !
 136 ! 5. Give the mediation layer an opportunity to do I/O at the end of the sequence of steps that brought the
 137 ! grid up to stop_subtime with a call to <a href=med_last_solve_io.html>med_last_solve_io</a>.  In WRF, this
 138 ! is used to generate the final history and/or restart output when the domain reaches the end of it's integration.
 139 ! There is logic here to make sure this occurs correctly on a nest, since the nest may finish before its parent.
 140 ! </DESCRIPTION>
 141
 142    !  Local data.
 143
 144    CHARACTER*32                           :: outname, rstname
 145    TYPE(domain) , POINTER                 :: grid_ptr , new_nest
 146    TYPE(domain)                           :: intermediate_grid
 147    INTEGER                                :: step
 148    INTEGER                                :: nestid , kid
 149    LOGICAL                                :: a_nest_was_opened
 150    INTEGER                                :: fid , rid
 151    LOGICAL                                :: lbc_opened
 152    REAL                                   :: time, btime, bfrq
 153    CHARACTER*256                          :: message, message2
 154    TYPE (grid_config_rec_type)            :: config_flags
 155    LOGICAL , EXTERNAL                     :: wrf_dm_on_monitor
 156    INTEGER                                :: idum1 , idum2 , ierr , open_status
 157    LOGICAL                                :: should_do_last_io
 158
 159    ! interface
 160    INTERFACE
 161        ! mediation-supplied solver
 162      SUBROUTINE solve_interface ( grid )
 163        USE module_domain
 164        TYPE (domain) grid
 165      END SUBROUTINE solve_interface
 166        ! mediation-supplied routine to allow driver to pass time information
 167        ! down to mediation/model layer
 168      SUBROUTINE med_calc_model_time ( grid , config_flags )
 169        USE module_domain
 170        USE module_configure
 171        TYPE (domain) grid
 172        TYPE (grid_config_rec_type) config_flags
 173      END SUBROUTINE med_calc_model_time
 174        ! mediation-supplied routine that gives mediation layer opportunity to
 175        ! perform I/O before the call to the solve routine
 176      SUBROUTINE med_before_solve_io ( grid , config_flags )
 177        USE module_domain
 178        USE module_configure
 179        TYPE (domain) grid
 180        TYPE (grid_config_rec_type) config_flags
 181      END SUBROUTINE med_before_solve_io
 182        ! mediation-supplied routine that gives mediation layer opportunity to
 183        ! perform I/O after the call to the solve routine
 184      SUBROUTINE med_after_solve_io ( grid , config_flags )
 185        USE module_domain
 186        USE module_configure
 187        TYPE (domain) grid
 188        TYPE (grid_config_rec_type) config_flags
 189      END SUBROUTINE med_after_solve_io
 190        ! mediation-supplied routine that gives mediation layer opportunity to
 191        ! perform I/O to initialize a new nest
 192      SUBROUTINE med_pre_nest_initial ( parent , newid , config_flags )
 193        USE module_domain
 194        USE module_configure
 195        TYPE (domain), POINTER ::  parent
 196        INTEGER, INTENT(IN)    ::  newid
 197        TYPE (grid_config_rec_type) config_flags
 198      END SUBROUTINE med_pre_nest_initial
 199      SUBROUTINE med_nest_initial ( parent , grid , config_flags )
 200        USE module_domain
 201        USE module_configure
 202        TYPE (domain), POINTER ::  grid , parent
 203        TYPE (grid_config_rec_type) config_flags
 204      END SUBROUTINE med_nest_initial
 205        ! mediation-supplied routine that gives mediation layer opportunity to
 206        ! provide parent->nest forcing
 207      SUBROUTINE med_nest_force ( parent , grid , config_flags )
 208        USE module_domain
 209        USE module_configure
 210        TYPE (domain), POINTER ::  grid, parent
 211        TYPE (grid_config_rec_type) config_flags
 212      END SUBROUTINE med_nest_force
 213
 214 #ifdef MOVE_NESTS
 215      SUBROUTINE med_nest_move ( parent , grid )
 216        USE module_domain
 217        USE module_configure
 218        TYPE (domain), POINTER ::  grid , parent
 219      END SUBROUTINE med_nest_move
 220 #endif
 221
 222        ! mediation-supplied routine that gives mediation layer opportunity to
 223        ! provide parent->nest feedback
 224      SUBROUTINE med_nest_feedback ( parent , grid , config_flags )
 225        USE module_domain
 226        USE module_configure
 227        TYPE (domain), POINTER ::  grid , parent
 228        TYPE (grid_config_rec_type) config_flags
 229      END SUBROUTINE med_nest_feedback
 230
 231        ! mediation-supplied routine that gives mediation layer opportunity to
 232        ! perform I/O prior to the close of this call to integrate
 233      SUBROUTINE med_last_solve_io ( grid , config_flags )
 234        USE module_domain
 235        USE module_configure
 236        TYPE (domain) grid
 237        TYPE (grid_config_rec_type) config_flags
 238      END SUBROUTINE med_last_solve_io
 239        ! mediation-supplied routine that gives mediation layer opportunity to
 240        ! perform setup before iteration over steps in this call to integrate
 241      SUBROUTINE med_setup_step ( grid , config_flags )
 242        USE module_domain
 243        USE module_configure
 244        TYPE (domain) grid
 245        TYPE (grid_config_rec_type) config_flags
 246      END SUBROUTINE med_setup_step
 247        ! mediation-supplied routine that gives mediation layer opportunity to
 248        ! perform setup before iteration over steps in this call to integrate
 249      SUBROUTINE med_endup_step ( grid , config_flags )
 250        USE module_domain
 251        USE module_configure
 252        TYPE (domain) grid
 253        TYPE (grid_config_rec_type) config_flags
 254      END SUBROUTINE med_endup_step
 255        ! mediation-supplied routine that intializes the nest from the grid
 256        ! by interpolation
 257
 258      SUBROUTINE Setup_Timekeeping( grid )
 259        USE module_domain
 260        TYPE(domain), POINTER :: grid
 261      END SUBROUTINE
 262
 263      SUBROUTINE dfi_accumulate( grid )
 264        USE module_domain
 265        TYPE(domain), POINTER :: grid
 266      END SUBROUTINE
 267
 268    END INTERFACE
 269
 270    ! This allows us to reference the current grid from anywhere beneath
 271    ! this point for debugging purposes.
 272    CALL set_current_grid_ptr( grid )
 273
 274    IF ( .NOT. domain_clockisstoptime( grid ) ) THEN
 275       CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 276       IF ( config_flags%grid_allowed ) THEN
 277          CALL domain_clockprint ( 150, grid, 'DEBUG:  top of integrate(),' )
 278          DO WHILE ( .NOT. domain_clockisstopsubtime(grid) )
 279             IF ( wrf_dm_on_monitor() ) THEN
 280                CALL start_timing
 281             END IF
 282             CALL med_setup_step ( grid , config_flags )
 283             a_nest_was_opened = .false.
 284             ! for each nest whose time has come...
 285             DO WHILE ( nests_to_open( grid , nestid , kid ) )
 286                ! nestid is index into model_config_rec (module_configure) of the grid
 287                ! to be opened; kid is index into an open slot in grid's list of children
 288                a_nest_was_opened = .true.
 289                CALL med_pre_nest_initial ( grid , nestid , config_flags )
 290                CALL alloc_and_configure_domain ( domain_id  = nestid ,   &
 291                                                  grid       = new_nest , &
 292                                                  parent     = grid ,     &
 293                                                  kid        = kid        )
 294                CALL Setup_Timekeeping (new_nest)
 295                CALL med_nest_initial ( grid , new_nest , config_flags )
 296             END DO
 297             IF ( a_nest_was_opened ) THEN
 298                CALL set_overlaps ( grid )   ! find overlapping and set pointers
 299             END IF
 300
 301             ! Accumulation calculation for DFI
 302             CALL dfi_accumulate ( grid )
 303
 304             CALL med_before_solve_io ( grid , config_flags )
 305             grid_ptr => grid
 306             DO WHILE ( ASSOCIATED( grid_ptr ) )
 307                CALL set_current_grid_ptr( grid_ptr )
 308                CALL wrf_debug( 100 , 'module_integrate: calling solve interface ' )
 309                CALL solve_interface ( grid_ptr )
 310                CALL domain_clockadvance ( grid_ptr )
 311                CALL wrf_debug( 100 , 'module_integrate: back from solve interface ' )
 312                ! print lots of time-related information for testing
 313                ! switch this on with namelist variable self_test_domain
 314                CALL domain_time_test( grid_ptr, 'domain_clockadvance' )
 315                grid_ptr => grid_ptr%sibling
 316             END DO
 317             CALL set_current_grid_ptr( grid )
 318             CALL med_calc_model_time ( grid , config_flags )
 319             CALL med_after_solve_io ( grid , config_flags )
 320             grid_ptr => grid
 321             DO WHILE ( ASSOCIATED( grid_ptr ) )
 322                DO kid = 1, max_nests
 323                  IF ( ASSOCIATED( grid_ptr%nests(kid)%ptr ) ) THEN
 324                    CALL set_current_grid_ptr( grid_ptr%nests(kid)%ptr )
 325                    ! Recursive -- advance nests from previous time level to this time level.
 326                    CALL wrf_debug( 100 , 'module_integrate: calling med_nest_force ' )
 327                    CALL med_nest_force ( grid_ptr , grid_ptr%nests(kid)%ptr , config_flags )
 328                    CALL wrf_debug( 100 , 'module_integrate: back from med_nest_force ' )
 329                    grid_ptr%nests(kid)%ptr%start_subtime = &
 330                      domain_get_current_time(grid) - domain_get_time_step(grid)
 331                    grid_ptr%nests(kid)%ptr%stop_subtime = &
 332                      domain_get_current_time(grid)
 333                    CALL integrate ( grid_ptr%nests(kid)%ptr )
 334                    CALL wrf_debug( 100 , 'module_integrate: back from recursive call to integrate ' )
 335                    CALL wrf_debug( 100 , 'module_integrate: calling med_nest_feedback ' )
 336                    CALL med_nest_feedback ( grid_ptr , grid_ptr%nests(kid)%ptr , config_flags )
 337                    CALL wrf_debug( 100 , 'module_integrate: back from med_nest_feedback ' )
 338 #ifdef MOVE_NESTS
 339                    IF ( .NOT. domain_clockisstoptime( head_grid ) ) THEN
 340                      CALL med_nest_move ( grid_ptr , grid_ptr%nests(kid)%ptr )
 341                    ENDIF
 342 #endif
 343                  END IF
 344                END DO
 345                grid_ptr => grid_ptr%sibling
 346             END DO
 347             CALL set_current_grid_ptr( grid )
 348             !  Report on the timing for a single time step.
 349             IF ( wrf_dm_on_monitor() ) THEN
 350                CALL domain_clock_get ( grid, current_timestr=message2 )
 351                WRITE ( message , FMT = '("main: time ",A," on domain ",I3)' ) TRIM(message2), grid%id
 352                CALL end_timing ( TRIM(message) )
 353             END IF
 354             CALL med_endup_step ( grid , config_flags )
 355          END DO
 356
 357          ! Accumulation calculation for DFI
 358          CALL dfi_accumulate ( grid )
 359
 360          ! Avoid double writes on nests if this is not really the last time;
 361          ! Do check for write if the parent domain is ending.
 362          IF ( grid%id .EQ. 1 ) THEN               ! head_grid
 363             CALL med_last_solve_io ( grid , config_flags )
 364          ELSE
 365 ! zip up the tree and see if any ancestor is at its stop time
 366             should_do_last_io = domain_clockisstoptime( head_grid )
 367             grid_ptr => grid
 368             DO WHILE ( grid_ptr%id .NE. 1 )
 369                IF ( domain_clockisstoptime( grid_ptr ) ) should_do_last_io = .TRUE.
 370                grid_ptr => grid_ptr%parents(1)%ptr
 371             ENDDO
 372             IF ( should_do_last_io ) THEN
 373                CALL med_last_solve_io ( grid , config_flags )
 374             ENDIF
 375          ENDIF
 376       ENDIF
 377    END IF
 378
 379 END SUBROUTINE integrate
 380
 381 END MODULE module_integrate
 382