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