module_integrate.F

References to this file elsewhere.
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    END INTERFACE
264 
265    ! This allows us to reference the current grid from anywhere beneath 
266    ! this point for debugging purposes.  
267    CALL set_current_grid_ptr( grid )
268 
269    IF ( .NOT. domain_clockisstoptime( grid ) ) THEN
270       CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
271       CALL domain_clockprint ( 150, grid, 'DEBUG:  top of integrate(),' )
272       DO WHILE ( .NOT. domain_clockisstopsubtime(grid) )
273          IF ( wrf_dm_on_monitor() ) THEN
274            CALL start_timing
275          END IF
276          CALL med_setup_step ( grid , config_flags )
277          a_nest_was_opened = .false.
278          ! for each nest whose time has come...
279          DO WHILE ( nests_to_open( grid , nestid , kid ) )
280             ! nestid is index into model_config_rec (module_configure) of the grid
281             ! to be opened; kid is index into an open slot in grid's list of children
282             a_nest_was_opened = .true.
283             CALL med_pre_nest_initial ( grid , nestid , config_flags )
284             CALL alloc_and_configure_domain ( domain_id  = nestid ,   &
285                                               grid       = new_nest , &
286                                               parent     = grid ,     &
287                                               kid        = kid        )
288             CALL Setup_Timekeeping (new_nest)
289             CALL med_nest_initial ( grid , new_nest , config_flags )
290          END DO
291          IF ( a_nest_was_opened ) THEN
292             CALL set_overlaps ( grid )   ! find overlapping and set pointers
293          END IF
294          CALL med_before_solve_io ( grid , config_flags )
295          grid_ptr => grid
296          DO WHILE ( ASSOCIATED( grid_ptr ) )
297             CALL set_current_grid_ptr( grid_ptr )
298             CALL wrf_debug( 100 , 'module_integrate: calling solve interface ' )
299             CALL solve_interface ( grid_ptr ) 
300             CALL domain_clockadvance ( grid_ptr )
301             CALL wrf_debug( 100 , 'module_integrate: back from solve interface ' )
302             ! print lots of time-related information for testing
303             ! switch this on with namelist variable self_test_domain
304             CALL domain_time_test( grid_ptr, 'domain_clockadvance' )
305             grid_ptr => grid_ptr%sibling
306          END DO
307          CALL set_current_grid_ptr( grid )
308          CALL med_calc_model_time ( grid , config_flags )
309          CALL med_after_solve_io ( grid , config_flags )
310          grid_ptr => grid
311          DO WHILE ( ASSOCIATED( grid_ptr ) )
312             DO kid = 1, max_nests
313               IF ( ASSOCIATED( grid_ptr%nests(kid)%ptr ) ) THEN
314                 CALL set_current_grid_ptr( grid_ptr%nests(kid)%ptr )
315                 ! Recursive -- advance nests from previous time level to this time level.
316                 CALL wrf_debug( 100 , 'module_integrate: calling med_nest_force ' )
317                 CALL med_nest_force ( grid_ptr , grid_ptr%nests(kid)%ptr , config_flags )
318                 CALL wrf_debug( 100 , 'module_integrate: back from med_nest_force ' )
319                 grid_ptr%nests(kid)%ptr%start_subtime = &
320                   domain_get_current_time(grid) - domain_get_time_step(grid)
321                 grid_ptr%nests(kid)%ptr%stop_subtime = &
322                   domain_get_current_time(grid)
323                 CALL integrate ( grid_ptr%nests(kid)%ptr ) 
324                 CALL wrf_debug( 100 , 'module_integrate: back from recursive call to integrate ' )
325                 CALL wrf_debug( 100 , 'module_integrate: calling med_nest_feedback ' )
326                 CALL med_nest_feedback ( grid_ptr , grid_ptr%nests(kid)%ptr , config_flags )
327                 CALL wrf_debug( 100 , 'module_integrate: back from med_nest_feedback ' )
328 #ifdef MOVE_NESTS
329                 IF ( .NOT. domain_clockisstoptime( head_grid ) ) THEN
330                   CALL med_nest_move ( grid_ptr , grid_ptr%nests(kid)%ptr )
331                 ENDIF
332 #endif
333               END IF
334             END DO
335             grid_ptr => grid_ptr%sibling
336          END DO
337          CALL set_current_grid_ptr( grid )
338          !  Report on the timing for a single time step.
339          IF ( wrf_dm_on_monitor() ) THEN
340 ! begin KLUDGE
341 ! ia32 pgi 6.0-2 and prescribed moving nest: the returned date string message2 is
342 ! corrupt after the first specified move UNLESS the string is initialized to all 
343 ! spaces - REMOVE THIS INIT OF MESSAGE2 WHEN POSSIBLE 
344 ! 2005 10 28
345             message2='                                                                ' // &
346                      '                                                                ' // &
347                      '                                                                ' // &
348                      '                                                                '
349 ! end KLUDGE
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       ! Avoid double writes on nests if this is not really the last time;
357       ! Do check for write if the parent domain is ending.
358       IF ( grid%id .EQ. 1 ) THEN               ! head_grid
359         CALL med_last_solve_io ( grid , config_flags )
360       ELSE
361 
362 ! zip up the tree and see if any ancestor is at its stop time
363         
364         should_do_last_io = domain_clockisstoptime( head_grid )
365         grid_ptr => grid 
366         DO WHILE ( grid_ptr%id .NE. 1 )
367            IF ( domain_clockisstoptime( grid_ptr ) ) should_do_last_io = .TRUE. 
368            grid_ptr => grid_ptr%parents(1)%ptr
369         ENDDO
370         IF ( should_do_last_io ) THEN 
371            CALL med_last_solve_io ( grid , config_flags )
372         ENDIF
373       ENDIF
374    END IF
375 
376 END SUBROUTINE integrate
377 
378 END MODULE module_integrate
379