module_integrate_ad.F
References to this file elsewhere.
1 !WRF:DRIVER_LAYER:INTEGRATION
2 !
3
4 MODULE module_integrate_ad
5
6 CONTAINS
7
8 RECURSIVE SUBROUTINE integrate_ad ( grid, nl_date_string, nl_date_index, ad_date_string, ad_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 esmf_clockmod
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 character(len=19), dimension(1000), intent(in) :: ad_date_string
29 integer, intent(inout) :: ad_date_index
30
31 ! module_integrate:integrate
32 ! <DESCRIPTION>
33 ! This is a driver-level routine that controls the integration of a
34 ! domain and subdomains rooted at the domain.
35 !
36 ! The integrate routine takes a domain pointed to by the argument
37 ! <em>grid</em> and advances the domain and its associated nests from the
38 ! grid's current time, stored as grid%current_time, to a given time
39 ! forward in the simulation, stored as grid%stop_subtime. The
40 ! stop_subtime value is arbitrary and does not have to be the same as
41 ! time that the domain finished integrating. The simulation stop time
42 ! for the grid is known to the grid's clock (grid%domain_clock) and that
43 ! is checked with a call to ESMF_ClockIsStopTime prior to beginning the
44 ! loop over time period that is specified by the
45 ! current_time/stop_subtime interval.
46 !
47 ! The clock, the simulation stop time for the domain, and other timing
48 ! aspects for the grid are set up in the routine
49 ! (<a href="setup_timekeeping.html">setup_timekeeping</a>) at the time
50 ! that the domain is initialized.
51 ! The lower-level time library and the type declarations for the times
52 ! and time intervals used are defined in external/esmf_time_f90 which,
53 ! depending on build-time options, either incorporates the embedded ESMF
54 ! subset implementation contained in that directory or incorporates a
55 ! site-specific installation of the ESMF library. Note that arithmetic and
56 ! comparison is performed on these data types using F90 operator overloading,
57 ! also defined in that library.
58 !
59 ! This routine is the lowest level of the WRF Driver Layer and for the most
60 ! part the WRF routines that are called from here are in the topmost level
61 ! of the Mediation Layer. Mediation layer routines typically are not
62 ! defined in modules. Therefore, the routines that this routine calls
63 ! have explicit interfaces specified in an interface block in this routine.
64 !
65 ! As part of the Driver Layer, this routine is intended to be non model-specific
66 ! and so a minimum of WRF-specific logic is coded at this level. Rather, there
67 ! are a number of calls to mediation layer routines that contain this logic, some
68 ! of which are merely stubs in WRF Mediation Layer that sits below this routine
69 ! in the call tree. The routines that integrate calls in WRF are defined in
70 ! share/mediation_integrate.F.
71 !
72 ! Flow of control
73 !
74 ! 1. Check to see that the domain is not finished
75 ! by testing the value returned by ESMF_ClockIsStopTime for the
76 ! domain.
77 !
78 ! 2. <a href=model_to_grid_config_rec.html>Model_to_grid_config_rec</a> is called to load the local config_flags
79 ! structure with the configuration information for the grid stored
80 ! in model_config_rec and indexed by the grid's unique integer id. These
81 ! structures are defined in frame/module_configure.F.
82 !
83 ! 3. The current time of the domain is retrieved from the domain's clock
84 ! using ESMF_ClockGet. There is another call to ESMF_ClockGet
85 ! inside the WHILE loop that follows.
86 !
87 ! 4. Iterate forward while the current time is less than the stop subtime.
88 !
89 ! 4.a. Start timing for this iteration (only on node zero in distributed-memory runs)
90 !
91 ! 4.b. Call <a href=med_setup_step.html>med_setup_step</a> to allow the mediation layer to
92 ! do anything that's needed to call the solver for this domain. In WRF this means setting
93 ! the indices into the 4D tracer arrays for the domain.
94 !
95 ! 4.c. Check for any nests that need to be started up at this time. This is done
96 ! calling the logical function <a href=nests_to_open.html>nests_to_open</a> (defined in
97 ! frame/module_nesting.F) which returns true and the index into the current domain's list
98 ! of children to use for the nest when one needs to be started.
99 !
100 ! 4.c.1 Call <a href=alloc_and_configure_domain.html>alloc_and_configure_domain</a> to allocate
101 ! the new nest and link it as a child of this grid.
102 !
103 ! 4.c.2 Call <a href=setup_Timekeeping.html>setup_Timekeeping</a> for the nest.
104 !
105 ! 4.c.3 Initialize the nest's arrays by calling <a href=med_nest_initial.html>med_nest_initial</a>. This will
106 ! either interpolate data from this grid onto the nest, read it in from a file, or both. In a restart run, this
107 ! is also where the nest reads in its restart file.
108 !
109 ! 4.d If a nest was opened above, check for and resolve overlaps (this is not implemented in WRF 2.0, which
110 ! supports multiple nests on the same level but does not support overlapping).
111 !
112 ! 4.e Give the mediation layer an opportunity to do something before the solver is called by
113 ! calling <a href=med_before_solve_io.html>med_before_solve_io</a>. In WRF this is the point at which history and
114 ! restart data is output.
115 !
116 ! 4.f Call <a href=solve_interface_ad.html>solve_interface_ad</a> which calls the solver that advance the domain
117 ! one time step, then advance the domain's clock by calling ESMF_ClockAdvance. Upon advancing the clock,
118 ! the current time for the grid is updated by calling ESMF_ClockGet. The enclosing WHILE loop around
119 ! this section is for handling other domains with which this domain may overlap. It is not active in WRF 2.0 and
120 ! only executes one trip.
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
163
164 ! Local
165 TYPE(ESMF_TimeInterval) :: zero_time, interval
166
167 ! interface
168 INTERFACE
169 ! mediation-supplied solver
170 SUBROUTINE solve_interface_ad ( grid )
171 USE module_domain
172 TYPE (domain) grid
173 END SUBROUTINE solve_interface_ad
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_nest_initial ( parent , grid , config_flags )
193 USE module_domain
194 USE module_configure
195 TYPE (domain), POINTER :: grid , parent
196 TYPE (grid_config_rec_type) config_flags
197 END SUBROUTINE med_nest_initial
198
199 ! mediation-supplied routine that gives mediation layer opportunity to
200 ! provide parent->nest forcing
201 SUBROUTINE med_nest_force ( parent , grid , config_flags )
202 USE module_domain
203 USE module_configure
204 TYPE (domain), POINTER :: grid , parent
205 TYPE (grid_config_rec_type) config_flags
206 END SUBROUTINE med_nest_force
207
208 #ifdef MOVE_NESTS
209 SUBROUTINE med_nest_move ( parent , grid )
210 USE module_domain
211 USE module_configure
212 TYPE (domain), POINTER :: grid , parent
213 END SUBROUTINE med_nest_move
214 #endif
215
216 ! mediation-supplied routine that gives mediation layer opportunity to
217 ! provide parent->nest feedback
218 SUBROUTINE med_nest_feedback ( parent , grid , config_flags )
219 USE module_domain
220 USE module_configure
221 TYPE (domain), POINTER :: grid , parent
222 TYPE (grid_config_rec_type) config_flags
223 END SUBROUTINE med_nest_feedback
224
225 ! mediation-supplied routine that gives mediation layer opportunity to
226 ! perform I/O prior to the close of this call to integrate
227 SUBROUTINE med_last_solve_io ( grid , config_flags )
228 USE module_domain
229 USE module_configure
230 TYPE (domain) grid
231 TYPE (grid_config_rec_type) config_flags
232 END SUBROUTINE med_last_solve_io
233 ! mediation-supplied routine that gives mediation layer opportunity to
234 ! perform setup before iteration over steps in this call to integrate
235 SUBROUTINE med_setup_step ( grid , config_flags )
236 USE module_domain
237 USE module_configure
238 TYPE (domain) grid
239 TYPE (grid_config_rec_type) config_flags
240 END SUBROUTINE med_setup_step
241 ! mediation-supplied routine that intializes the nest from the grid
242 ! by interpolation
243
244 SUBROUTINE Setup_Timekeeping( grid )
245 USE module_domain
246 TYPE(domain), POINTER :: grid
247 END SUBROUTINE
248
249 END INTERFACE
250
251 print *, 'ESMF_ClockIsStartTime(grid%domain_clock ,rc=rc)=', &
252 ESMF_ClockIsStartTime(grid%domain_clock ,rc=rc)
253
254 IF ( .NOT. ESMF_ClockIsStartTime(grid%domain_clock ,rc=rc) ) THEN
255 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
256
257 !-----start check nonlinear and adjoint input
258 CALL wrf_clockprint ( 150, grid%domain_clock, 'DEBUG: integrate_ad(),' )
259
260 CALL wrf_timetoa( domain_get_current_time(grid), currTime_str )
261
262 !-----start check non-linear input
263 if(currTime_str(1:19) .eq. nl_date_string(nl_date_index)(1:19)) then
264 write(unit=*, fmt='(a,i5,4(1x,a))') &
265 'xyh nl_date_index =', nl_date_index, &
266 'read NL at currTime_str(1:19)=', currTime_str(1:19), &
267 'nl_date_string(nl_date_index)(1:19)=', nl_date_string(nl_date_index)(1:19)
268 ! ----do input
269 CALL med_auxinput2_in4ad ( grid , config_flags , nl_date_string(nl_date_index) )
270 write(unit=10, fmt='(a,i4,2a,2x,a,f12.4)') &
271 'xyh nl_date_string(', nl_date_index, ')=',nl_date_string(nl_date_index)(1:19), &
272 'grid%t_2(1,1,1)=', grid%em_t_2(1,1,1)
273 nl_date_index = nl_date_index + 1
274 else
275 write(unit=*, fmt='(2a)') &
276 'xyh no NL state at ', currTime_str(1:19)
277 write(unit=*, fmt='(2a)') &
278 'xyh use NL state from ', nl_date_string(nl_date_index)
279 CALL med_auxinput2_in4ad ( grid , config_flags , nl_date_string(nl_date_index) )
280 write(unit=10, fmt='(a,i4,2a,2x,a,f12.4)') &
281 'xyh nl_date_string(', nl_date_index, ')=',nl_date_string(nl_date_index)(1:19), &
282 'grid%t_2(1,1,1)=', grid%em_t_2(1,1,1)
283 endif
284 !-----end check non-linear input
285
286
287
288 !-----Check and read the dfi forcing
289 CALL jcdfi_init_coef ( grid , config_flags )
290 CALL jcdfi_input_forcing ( grid , config_flags )
291 !-----start check adjoint input
292 if(currTime_str(1:19) .eq. ad_date_string(ad_date_index)(1:19)) then
293 print *, 'ad_date_index =', ad_date_index
294 write(unit=*, fmt='(2a)') &
295 'currTime_str(1:19)=', currTime_str(1:19), &
296 'ad_date_string(ad_date_index)(1:19)=', ad_date_string(ad_date_index)(1:19)
297 !- do input
298 CALL med_auxinput3_in ( grid , config_flags )
299 CALL add_forcing_to_ad(grid)
300 ad_date_index = ad_date_index + 1
301 ! else
302 ! write(unit=*, fmt='(2a)') &
303 ! 'currTime_str(1:19)=', currTime_str(1:19), &
304 ! 'ad_date_string(ad_date_index)(1:19)=', ad_date_string(ad_date_index)(1:19)
305 endif
306 dfi_counter = 0
307 CALL jcdfi_add_forcing ( grid , dfi_counter )
308 !-----end check adjoint input
309
310 CALL ESMF_TimeIntervalPrint(grid%domain_clock%clockint%TimeStep, 'DEBUG: integrate_ad.', rc)
311 CALL print_a_timeinterval(grid%domain_clock%clockint%TimeStep)
312
313 DO WHILE ( domain_get_current_time(grid) .GT. grid%start_subtime )
314 IF ( wrf_dm_on_monitor() ) THEN
315 CALL start_timing
316 END IF
317
318 !--------start check nonlinear and adjoint input
319
320 CALL wrf_clockprint ( 150, grid%domain_clock, 'DEBUG: integrate_ad(),' )
321
322 CALL wrf_timetoa( domain_get_current_time(grid), currTime_str )
323
324 !-----start check non-linear input
325 if(currTime_str(1:19) .eq. nl_date_string(nl_date_index)(1:19)) then
326 write(unit=*, fmt='(a,i5,4(1x,a))') &
327 'xyh nl_date_index =', nl_date_index, &
328 'read NL at currTime_str(1:19)=', currTime_str(1:19), &
329 'nl_date_string(nl_date_index)(1:19)=', nl_date_string(nl_date_index)(1:19)
330 ! ----do input
331 CALL med_auxinput2_in4ad ( grid , config_flags , nl_date_string(nl_date_index) )
332 write(unit=10, fmt='(a,i4,2a,2x,a,f12.4)') &
333 'xyh nl_date_string(', nl_date_index, ')=',nl_date_string(nl_date_index)(1:19), &
334 'grid%t_2(1,1,1)=', grid%em_t_2(1,1,1)
335 nl_date_index = nl_date_index + 1
336 else
337 write(unit=*, fmt='(2a)') &
338 'xyh no NL state at ', currTime_str(1:19)
339 write(unit=*, fmt='(2a)') &
340 'xyh use NL state from ', nl_date_string(nl_date_index)
341 CALL med_auxinput2_in4ad ( grid , config_flags , nl_date_string(nl_date_index) )
342 write(unit=10, fmt='(a,i4,2a,2x,a,f12.4)') &
343 'xyh nl_date_string(', nl_date_index, ')=',nl_date_string(nl_date_index)(1:19), &
344 'grid%t_2(1,1,1)=', grid%em_t_2(1,1,1)
345 endif
346 !-----end check non-linear input
347
348 !--------start check adjoint input
349
350 if(currTime_str(1:19) .eq. ad_date_string(ad_date_index)(1:19)) then
351 print *, 'ad_date_index =', ad_date_index
352 write(unit=*, fmt='(2a)') &
353 'currTime_str(1:19)=', currTime_str(1:19), &
354 'ad_date_string(ad_date_index)(1:19)=', ad_date_string(ad_date_index)(1:19)
355 !- do input
356 CALL med_auxinput3_in ( grid , config_flags )
357 CALL add_forcing_to_ad(grid)
358 ad_date_index = ad_date_index + 1
359 ! else
360 ! write(unit=*, fmt='(2a)') &
361 ! 'currTime_str(1:19)=', currTime_str(1:19), &
362 ! 'ad_date_string(ad_date_index)(1:19)=', ad_date_string(ad_date_index)(1:19)
363 endif
364 !--------end check adjoint input
365
366 CALL med_setup_step ( grid , config_flags )
367 a_nest_was_opened = .false.
368 ! for each nest whose time has come...
369 ! CALL med_var_solve_io ( grid , config_flags )
370 DO WHILE ( nests_to_open( grid , nestid , kid ) )
371 ! nestid is index into model_config_rec (module_configure) of the grid
372 ! to be opened; kid is index into an open slot in grid's list of children
373 a_nest_was_opened = .true.
374 CALL alloc_and_configure_domain ( domain_id = nestid , &
375 grid = new_nest , &
376 parent = grid , &
377 kid = kid )
378 CALL Setup_Timekeeping (new_nest)
379 CALL med_nest_initial ( grid , new_nest , config_flags )
380 END DO
381 IF ( a_nest_was_opened ) THEN
382 CALL set_overlaps ( grid ) ! find overlapping and set pointers
383 END IF
384 grid_ptr => grid
385 DO WHILE ( ASSOCIATED( grid_ptr ) )
386 CALL wrf_debug( 100 , 'module_integrate_ad: calling solve interface ad' )
387 CALL solve_interface_ad ( grid_ptr )
388 CALL wrf_clockprint ( 150, grid_ptr%domain_clock, &
389 'DEBUG integrate_ad(): before ESMF_ClockBack,' )
390 CALL ESMF_ClockBack( grid_ptr%domain_clock, rc=rc )
391
392 !--
393 !-- Add check _ad_date_string for input forcing.
394 !--
395 CALL wrf_check_error( ESMF_SUCCESS, rc, &
396 'ESMF_ClockAdvance() FAILED', &
397 __FILE__ , &
398 __LINE__ )
399 CALL wrf_clockprint ( 150, grid_ptr%domain_clock, &
400 'DEBUG integrate_ad(): after ESMF_ClockBack,' )
401 CALL wrf_debug( 100 , 'module_integrate_ad: back from solve interface ad' )
402 grid_ptr => grid_ptr%sibling
403 END DO
404 grid_ptr => grid
405 DO WHILE ( ASSOCIATED( grid_ptr ) )
406 DO kid = 1, max_nests
407 IF ( ASSOCIATED( grid_ptr%nests(kid)%ptr ) ) THEN
408 ! Recursive -- advance nests from previous time level to this time level.
409 CALL wrf_debug( 100 , 'module_integrate_ad: calling med_nest_force ' )
410 CALL med_nest_force ( grid_ptr , grid_ptr%nests(kid)%ptr , config_flags )
411 CALL wrf_debug( 100 , 'module_integrate_ad: back from med_nest_force ' )
412 grid_ptr%nests(kid)%ptr%start_subtime = domain_get_current_time(grid) - &
413 domain_get_time_step(grid)
414 grid_ptr%nests(kid)%ptr%stop_subtime = domain_get_current_time(grid)
415 CALL integrate_ad ( grid_ptr%nests(kid)%ptr, nl_date_string, nl_date_index, ad_date_string, ad_date_index )
416 CALL wrf_debug( 100 , 'module_integrate_ad: back from recursive call to integrate_ad ' )
417 CALL wrf_debug( 100 , 'module_integrate_ad: calling med_nest_feedback ' )
418 CALL med_nest_feedback ( grid_ptr , grid_ptr%nests(kid)%ptr , config_flags )
419 CALL wrf_debug( 100 , 'module_integrate_ad: back from med_nest_feedback ' )
420 #ifdef MOVE_NESTS
421 CALL med_nest_move ( grid_ptr , grid_ptr%nests(kid)%ptr )
422 #endif
423 END IF
424 END DO
425 grid_ptr => grid_ptr%sibling
426 END DO
427 ! Report on the timing for a single time step.
428 IF ( wrf_dm_on_monitor() ) THEN
429 CALL wrf_timetoa ( domain_get_current_time(grid), message2 )
430 WRITE ( message , FMT = '("main: time ",A," on domain ",I3)' ) TRIM(message2), grid%id
431 CALL end_timing ( TRIM(message) )
432 END IF
433 dfi_counter = dfi_counter + 1
434 CALL jcdfi_add_forcing ( grid , dfi_counter )
435 END DO
436 CALL jcdfi_finalize
437 ! Avoid double writes on nests if this is not really the last time;
438 ! Do check for write if the parent domain is ending.
439 IF ( grid%id .EQ. 1 ) THEN ! head_grid
440 ! CALL med_last_solve_ad_io ( grid , config_flags )
441
442 !--------start check nonlinear and adjoint input
443
444 CALL wrf_clockprint ( 1, grid%domain_clock, 'Check last time: integrate_ad(),' )
445
446 CALL wrf_timetoa( domain_get_current_time(grid), currTime_str )
447
448 !--------start check non-linear input
449 if(currTime_str(1:19) .eq. nl_date_string(nl_date_index)(1:19)) then
450 write(unit=*, fmt='(a,i5,4(1x,a))') &
451 'xyh nl_date_index =', nl_date_index, &
452 'read NL at currTime_str(1:19)=', currTime_str(1:19), &
453 'nl_date_string(nl_date_index)(1:19)=', nl_date_string(nl_date_index)(1:19)
454 ! ----------do input
455 CALL med_auxinput2_in4ad ( grid , config_flags , nl_date_string(nl_date_index) )
456 write(unit=10, fmt='(a,i4,2a,2x,a,f12.4)') &
457 'xyh nl_date_string(', nl_date_index, ')=',nl_date_string(nl_date_index)(1:19), &
458 'grid%t_2(1,1,1)=', grid%em_t_2(1,1,1)
459 nl_date_index = nl_date_index + 1
460 else
461 write(unit=*, fmt='(2a)') &
462 'xyh no NL state at ', currTime_str(1:19)
463 write(unit=*, fmt='(2a)') &
464 'xyh use NL state from ', nl_date_string(nl_date_index)
465 CALL med_auxinput2_in4ad ( grid , config_flags , nl_date_string(nl_date_index) )
466 write(unit=10, fmt='(a,i4,2a,2x,a,f12.4)') &
467 'xyh nl_date_string(', nl_date_index, ')=',nl_date_string(nl_date_index)(1:19), &
468 'grid%t_2(1,1,1)=', grid%em_t_2(1,1,1)
469 endif
470 !--------end check non-linear input
471
472 !--------start check adjoint input
473 if(currTime_str(1:19) .eq. ad_date_string(ad_date_index)(1:19)) then
474 print *, 'ad_date_index =', ad_date_index
475 write(unit=*, fmt='(2a)') &
476 'currTime_str(1:19)=', currTime_str(1:19), &
477 'ad_date_string(ad_date_index)(1:19)=', ad_date_string(ad_date_index)(1:19)
478 !- do input
479 CALL med_auxinput3_in ( grid , config_flags )
480 CALL add_forcing_to_ad(grid)
481 ad_date_index = ad_date_index + 1
482 ! else
483 ! write(unit=*, fmt='(2a)') &
484 ! 'currTime_str(1:19)=', currTime_str(1:19), &
485 ! 'ad_date_string(ad_date_index)(1:19)=', ad_date_string(ad_date_index)(1:19)
486 endif
487 !--------end check adjoint input
488 ! CALL med_last_solve_ad_io ( grid , config_flags )
489 call med_filter_out ( grid , config_flags )
490 !--------Force output last gradient.
491 call med_hist_out ( grid , 0 , config_flags )
492 ELSE
493 IF ( ESMF_ClockIsStartTime(grid%domain_clock , rc=rc) .OR. &
494 ESMF_ClockIsStartTime(grid%parents(1)%ptr%domain_clock , rc=rc ) ) THEN
495 ! CALL med_last_solve_ad_io ( grid , config_flags )
496 ENDIF
497 ENDIF
498 END IF
499
500 END SUBROUTINE integrate_ad
501
502 END MODULE module_integrate_ad
503