wrf_ESMFMod.F
References to this file elsewhere.
1 !WRF:DRIVER_LAYER:MAIN
2 !
3
4 !<DESCRIPTION>
5 ! ESMF-specific modules for building WRF as an ESMF component.
6 !
7 ! This source file is only built when ESMF coupling is used.
8 !
9 !</DESCRIPTION>
10
11
12
13 MODULE module_metadatautils
14 !<DESCRIPTION>
15 ! This module defines component-independent "model metadata" utilities
16 ! used for ESMF coupling.
17 !</DESCRIPTION>
18 !$$$ Upgrade this later to support multiple coupling intervals via Alarms
19 !$$$ associated with top-level clock. Do this by adding TimesAttachedToState()
20 !$$$ inquiry function that will test an ESMF_State to see if the times are
21 !$$$ present via names defined in this module. Then call this for every
22 !$$$ component and resolve conflicts (somehow) for cases where two components
23 !$$$ define conflicting clocks. Of course, a component is allowed to not define
24 !$$$ a clock at all too...
25 !
26 !$$$ Replace meta-data names with "model metadata" conventions (when they exist)
27 !
28 !$$$ Refactor to remove duplication of hard-coded names!
29 !
30 USE ESMF_Mod
31
32 IMPLICIT NONE
33
34 ! everything is private by default
35 PRIVATE
36
37 ! Public interfaces
38 PUBLIC AttachTimesToState
39 PUBLIC GetTimesFromStates
40 PUBLIC AttachDecompToState
41 PUBLIC GetDecompFromState
42
43 ! private stuff
44 CHARACTER (ESMF_MAXSTR) :: str
45
46
47 CONTAINS
48
49
50 ! Attach time information to state as meta-data.
51 ! Update later to use some form of meta-data standards/conventions for
52 ! model "time" meta-data.
53 SUBROUTINE AttachTimesToState( state, startTime, stopTime, couplingInterval )
54 TYPE(ESMF_State), INTENT(INOUT) :: state
55 TYPE(ESMF_Time), INTENT(IN ) :: startTime
56 TYPE(ESMF_Time), INTENT(IN ) :: stopTime
57 TYPE(ESMF_TimeInterval), INTENT(IN ) :: couplingInterval
58 ! locals
59 INTEGER :: rc
60 INTEGER :: year, month, day, hour, minute, second
61 INTEGER(ESMF_KIND_I4) :: timevals(6) ! big enough to hold the vars listed above
62 ! start time
63 CALL ESMF_TimeGet(startTime, yy=year, mm=month, dd=day, &
64 h=hour, m=minute, s=second, rc=rc)
65 IF ( rc /= ESMF_SUCCESS ) THEN
66 CALL wrf_error_fatal ( 'ESMF_TimeGet(startTime) failed' )
67 ENDIF
68 timevals(1) = year
69 timevals(2) = month
70 timevals(3) = day
71 timevals(4) = hour
72 timevals(5) = minute
73 timevals(6) = second
74 CALL ESMF_StateSetAttribute(state, 'ComponentStartTime', &
75 SIZE(timevals), timevals, rc=rc)
76 IF ( rc /= ESMF_SUCCESS ) THEN
77 CALL wrf_error_fatal ( 'ESMF_StateSetAttribute(ComponentStartTime) failed' )
78 ENDIF
79 ! stop time
80 CALL ESMF_TimeGet(stopTime, yy=year, mm=month, dd=day, &
81 h=hour, m=minute, s=second, rc=rc)
82 IF ( rc /= ESMF_SUCCESS ) THEN
83 CALL wrf_error_fatal ( 'ESMF_TimeGet(stopTime) failed' )
84 ENDIF
85 timevals(1) = year
86 timevals(2) = month
87 timevals(3) = day
88 timevals(4) = hour
89 timevals(5) = minute
90 timevals(6) = second
91 CALL ESMF_StateSetAttribute(state, 'ComponentStopTime', &
92 SIZE(timevals), timevals, rc=rc)
93 IF ( rc /= ESMF_SUCCESS ) THEN
94 CALL wrf_error_fatal ( 'ESMF_StateSetAttribute(ComponentStopTime) failed' )
95 ENDIF
96 ! coupling time step
97 CALL ESMF_TimeIntervalGet(couplingInterval, yy=year, mm=month, d=day, &
98 h=hour, m=minute, s=second, rc=rc)
99 IF ( rc /= ESMF_SUCCESS ) THEN
100 CALL wrf_error_fatal ( 'ESMF_TimeIntervalGet(couplingInterval) failed' )
101 ENDIF
102 timevals(1) = year
103 timevals(2) = month
104 timevals(3) = day
105 timevals(4) = hour
106 timevals(5) = minute
107 timevals(6) = second
108 CALL ESMF_StateSetAttribute(state, 'ComponentCouplingInterval', &
109 SIZE(timevals), timevals, rc=rc)
110 IF ( rc /= ESMF_SUCCESS ) THEN
111 CALL wrf_error_fatal ( 'ESMF_StateSetAttribute(ComponentCouplingInterval) failed' )
112 ENDIF
113 END SUBROUTINE AttachTimesToState
114
115
116
117 ! Extract time information attached as meta-data from a single
118 ! ESMF_State.
119 ! Update later to use some form of meta-data standards/conventions for
120 ! model "time" meta-data.
121 SUBROUTINE GetTimesFromState( state, startTime, stopTime, couplingInterval )
122 TYPE(ESMF_State), INTENT(IN ) :: state
123 TYPE(ESMF_Time), INTENT(INOUT) :: startTime
124 TYPE(ESMF_Time), INTENT(INOUT) :: stopTime
125 TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingInterval
126 ! locals
127 INTEGER :: rc
128 INTEGER :: year, month, day, hour, minute, second
129 INTEGER(ESMF_KIND_I4) :: timevals(6) ! big enough to hold the vars listed above
130 ! start time
131 CALL ESMF_StateGetAttribute(state, 'ComponentStartTime', &
132 SIZE(timevals), timevals, rc=rc)
133 IF ( rc /= ESMF_SUCCESS ) THEN
134 CALL wrf_error_fatal ( 'ESMF_StateGetAttribute(ComponentStartTime) failed' )
135 ENDIF
136 year = timevals(1)
137 month = timevals(2)
138 day = timevals(3)
139 hour = timevals(4)
140 minute = timevals(5)
141 second = timevals(6)
142 CALL ESMF_TimeSet(startTime, yy=year, mm=month, dd=day, &
143 h=hour, m=minute, s=second, rc=rc)
144 IF ( rc /= ESMF_SUCCESS ) THEN
145 CALL wrf_error_fatal ( 'ESMF_TimeSet(startTime) failed' )
146 ENDIF
147 ! stop time
148 CALL ESMF_StateGetAttribute(state, 'ComponentStopTime', &
149 SIZE(timevals), timevals, rc=rc)
150 IF ( rc /= ESMF_SUCCESS ) THEN
151 CALL wrf_error_fatal ( 'ESMF_StateGetAttribute(ComponentStopTime) failed' )
152 ENDIF
153 year = timevals(1)
154 month = timevals(2)
155 day = timevals(3)
156 hour = timevals(4)
157 minute = timevals(5)
158 second = timevals(6)
159 CALL ESMF_TimeSet(stopTime, yy=year, mm=month, dd=day, &
160 h=hour, m=minute, s=second, rc=rc)
161 IF ( rc /= ESMF_SUCCESS ) THEN
162 CALL wrf_error_fatal ( 'ESMF_TimeSet(stopTime) failed' )
163 ENDIF
164 ! coupling time step
165 CALL ESMF_StateGetAttribute(state, 'ComponentCouplingInterval', &
166 SIZE(timevals), timevals, rc=rc)
167 IF ( rc /= ESMF_SUCCESS ) THEN
168 CALL wrf_error_fatal ( 'ESMF_StateGetAttribute(ComponentCouplingInterval) failed' )
169 ENDIF
170 year = timevals(1)
171 month = timevals(2)
172 day = timevals(3)
173 hour = timevals(4)
174 minute = timevals(5)
175 second = timevals(6)
176 CALL ESMF_TimeIntervalSet(couplingInterval, yy=year, mm=month, d=day, &
177 h=hour, m=minute, s=second, rc=rc)
178 IF ( rc /= ESMF_SUCCESS ) THEN
179 CALL wrf_error_fatal ( 'ESMF_TimeIntervalSet(couplingInterval) failed' )
180 ENDIF
181 END SUBROUTINE GetTimesFromState
182
183
184
185 ! Extract time information attached as meta-data from one or more
186 ! ESMF_States. To use this with more than one ESMF_State, put the
187 ! ESMF_States into a single ESMF_State. If times differ, an attempt
188 ! is made to reconcile them.
189 SUBROUTINE GetTimesFromStates( state, startTime, stopTime, couplingInterval )
190 TYPE(ESMF_State), INTENT(IN ) :: state
191 TYPE(ESMF_Time), INTENT(INOUT) :: startTime
192 TYPE(ESMF_Time), INTENT(INOUT) :: stopTime
193 TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingInterval
194 ! locals
195 INTEGER :: rc
196 INTEGER :: numItems, numStates, i, istate
197 TYPE(ESMF_StateItemType), ALLOCATABLE :: itemTypes(:)
198 TYPE(ESMF_State) :: tmpState
199 CHARACTER (len=ESMF_MAXSTR), ALLOCATABLE :: itemNames(:)
200 TYPE(ESMF_Time), ALLOCATABLE :: startTimes(:)
201 TYPE(ESMF_Time), ALLOCATABLE :: stopTimes(:)
202 TYPE(ESMF_TimeInterval), ALLOCATABLE :: couplingIntervals(:)
203
204 !$$$unfortunately, implementing this is an extraordinary pain in the @ss due
205 !$$$to lack of sane iterators for ESMF_State!!! @#$%!!
206
207 ! Since there are no convenient iterators for ESMF_State (@#$%),
208 ! write a lot of code...
209 ! Figure out how many items are in the ESMF_State
210 CALL ESMF_StateGet(state, itemCount=numItems, rc=rc)
211 IF ( rc /= ESMF_SUCCESS) THEN
212 CALL wrf_error_fatal ( 'ESMF_StateGet(numItems) failed' )
213 ENDIF
214 ! allocate an array to hold the types of all items
215 ALLOCATE( itemTypes(numItems) )
216 ! allocate an array to hold the names of all items
217 ALLOCATE( itemNames(numItems) )
218 ! get the item types and names
219 CALL ESMF_StateGet(state, stateitemtypeList=itemTypes, &
220 itemNameList=itemNames, rc=rc)
221 IF ( rc /= ESMF_SUCCESS) THEN
222 WRITE(str,*) 'ESMF_StateGet itemTypes failed with rc = ', rc
223 CALL wrf_error_fatal ( str )
224 ENDIF
225 ! count how many items are ESMF_States
226 numStates = 0
227 DO i=1,numItems
228 IF ( itemTypes(i) == ESMF_STATEITEM_STATE ) THEN
229 numStates = numStates + 1
230 ENDIF
231 ENDDO
232 ALLOCATE( startTimes(numStates), stopTimes(numStates), &
233 couplingIntervals(numStates) )
234 IF ( numStates > 0) THEN
235 ! finally, extract nested ESMF_States by name, if there are any
236 ! (should be able to do this by index at least -- @#%$)
237 istate = 0
238 DO i=1,numItems
239 IF ( itemTypes(i) == ESMF_STATEITEM_STATE ) THEN
240 CALL ESMF_StateGetState( state, nestedStateName=TRIM(itemNames(i)), &
241 nestedState=tmpState, rc=rc )
242 IF ( rc /= ESMF_SUCCESS) THEN
243 WRITE(str,*) 'ESMF_StateGetState(',TRIM(itemNames(i)),') failed'
244 CALL wrf_error_fatal ( str )
245 ENDIF
246 istate = istate + 1
247 CALL GetTimesFromState( tmpState, startTimes(istate), &
248 stopTimes(istate), &
249 couplingIntervals(istate) )
250 ENDIF
251 ENDDO
252 CALL ReconcileTimes( startTimes, stopTimes, couplingIntervals, &
253 startTime, stopTime, couplingInterval )
254 ELSE
255 ! there are no nested ESMF_States so use parent state only
256 CALL GetTimesFromState( state, startTime, stopTime, &
257 couplingInterval )
258 ENDIF
259
260 ! deallocate locals
261 DEALLOCATE( itemTypes )
262 DEALLOCATE( itemNames )
263 DEALLOCATE( startTimes, stopTimes, couplingIntervals )
264
265 END SUBROUTINE GetTimesFromStates
266
267
268 ! Reconcile all times and intervals in startTimes, stopTimes, and
269 ! couplingIntervals and return the results in startTime, stopTime, and
270 ! couplingInterval. Abort if reconciliation is not possible.
271 SUBROUTINE ReconcileTimes( startTimes, stopTimes, couplingIntervals, &
272 startTime, stopTime, couplingInterval )
273 TYPE(ESMF_Time), INTENT(IN ) :: startTimes(:)
274 TYPE(ESMF_Time), INTENT(IN ) :: stopTimes(:)
275 TYPE(ESMF_TimeInterval), INTENT(IN ) :: couplingIntervals(:)
276 TYPE(ESMF_Time), INTENT(INOUT) :: startTime
277 TYPE(ESMF_Time), INTENT(INOUT) :: stopTime
278 TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingInterval
279 ! locals
280 INTEGER :: numTimes, numTimesTmp, i
281
282 ! how many sets of time info?
283 numTimes = SIZE(startTimes)
284 IF ( numTimes < 2 ) THEN
285 CALL wrf_error_fatal ( 'SIZE(startTimes) too small' )
286 ENDIF
287 numTimesTmp = SIZE(stopTimes)
288 IF ( numTimes /= numTimesTmp ) THEN
289 CALL wrf_error_fatal ( 'incorrect SIZE(stopTimes)' )
290 ENDIF
291 numTimesTmp = SIZE(couplingIntervals)
292 IF ( numTimes /= numTimesTmp ) THEN
293 CALL wrf_error_fatal ( 'incorrect SIZE(couplingIntervals)' )
294 ENDIF
295
296 ! reconcile
297 !For now this is very simple. Fancy it up later.
298 DO i = 1, numTimes
299 IF ( i == 1 ) THEN
300 startTime = startTimes(i)
301 stopTime = stopTimes(i)
302 couplingInterval = couplingIntervals(i)
303 ELSE
304 IF ( startTimes(i) /= startTime ) THEN
305 CALL wrf_error_fatal ( 'ReconcileTimes: inconsistent startTimes' )
306 ENDIF
307 IF ( stopTimes(i) /= stopTime ) THEN
308 CALL wrf_error_fatal ( 'ReconcileTimes: inconsistent stopTimes' )
309 ENDIF
310 IF ( couplingIntervals(i) /= couplingInterval ) THEN
311 CALL wrf_error_fatal ( 'ReconcileTimes: inconsistent couplingIntervals' )
312 ENDIF
313 ENDIF
314
315 ENDDO
316
317 END SUBROUTINE ReconcileTimes
318
319
320
321 !$$$ TBH: Eliminate this once this information can be derived via other
322 !$$$ TBH: means.
323 SUBROUTINE AttachDecompToState( state, &
324 ids, ide, jds, jde, kds, kde, &
325 ims, ime, jms, jme, kms, kme, &
326 ips, ipe, jps, jpe, kps, kpe, &
327 domdesc, bdy_mask )
328 TYPE(ESMF_State), INTENT(INOUT) :: state
329 INTEGER, INTENT(IN ) :: ids, ide, jds, jde, kds, kde
330 INTEGER, INTENT(IN ) :: ims, ime, jms, jme, kms, kme
331 INTEGER, INTENT(IN ) :: ips, ipe, jps, jpe, kps, kpe
332 INTEGER, INTENT(IN ) :: domdesc
333 LOGICAL, INTENT(IN ) :: bdy_mask(4)
334 ! locals
335 INTEGER :: i, rc
336 ! big enough to hold the integer values listed above
337 INTEGER(ESMF_KIND_I4) :: intvals(19)
338 ! big enough to hold the logical values listed above
339 TYPE(ESMF_Logical) :: logvals(4) ! #$%*ing insane
340
341 ! first the logicals
342 ! Usually, when writing an API for a target language, it is considered
343 ! good practice to use native types of the target language in the
344 ! interfaces.
345 logvals = ESMF_FALSE
346 DO i = 1, SIZE(bdy_mask)
347 IF (bdy_mask(i)) THEN
348 logvals(i) = ESMF_TRUE
349 ENDIF
350 ENDDO
351 CALL ESMF_StateSetAttribute(state, 'DecompositionLogicals', &
352 SIZE(logvals), logvals, rc=rc)
353 IF ( rc /= ESMF_SUCCESS) THEN
354 CALL wrf_error_fatal ( 'ESMF_StateSetAttribute(DecompositionLogicals) failed' )
355 ENDIF
356 ! now the integers
357 intvals(1) = ids
358 intvals(2) = ide
359 intvals(3) = jds
360 intvals(4) = jde
361 intvals(5) = kds
362 intvals(6) = kde
363 intvals(7) = ims
364 intvals(8) = ime
365 intvals(9) = jms
366 intvals(10) = jme
367 intvals(11) = kms
368 intvals(12) = kme
369 intvals(13) = ips
370 intvals(14) = ipe
371 intvals(15) = jps
372 intvals(16) = jpe
373 intvals(17) = kps
374 intvals(18) = kpe
375 intvals(19) = domdesc
376 CALL ESMF_StateSetAttribute(state, 'DecompositionIntegers', &
377 SIZE(intvals), intvals, rc=rc)
378 IF ( rc /= ESMF_SUCCESS) THEN
379 CALL wrf_error_fatal ( 'ESMF_StateSetAttribute(DecompositionIntegers) failed' )
380 ENDIF
381 END SUBROUTINE AttachDecompToState
382
383
384
385 !$$$ TBH: Eliminate this once this information can be derived via other
386 !$$$ TBH: means.
387 SUBROUTINE GetDecompFromState( state, &
388 ids, ide, jds, jde, kds, kde, &
389 ims, ime, jms, jme, kms, kme, &
390 ips, ipe, jps, jpe, kps, kpe, &
391 domdesc, bdy_mask )
392 TYPE(ESMF_State), INTENT(IN ) :: state
393 INTEGER, INTENT( OUT) :: ids, ide, jds, jde, kds, kde
394 INTEGER, INTENT( OUT) :: ims, ime, jms, jme, kms, kme
395 INTEGER, INTENT( OUT) :: ips, ipe, jps, jpe, kps, kpe
396 INTEGER, INTENT( OUT) :: domdesc
397 LOGICAL, INTENT( OUT) :: bdy_mask(4)
398 ! locals
399 INTEGER :: i, rc
400 ! big enough to hold the integer values listed above
401 INTEGER(ESMF_KIND_I4) :: intvals(19)
402 ! big enough to hold the logical values listed above
403 TYPE(ESMF_Logical) :: logvals(4) ! #$%*ing insane
404
405 ! first the logicals
406 CALL ESMF_StateGetAttribute(state, 'DecompositionLogicals', &
407 SIZE(logvals), logvals, rc=rc)
408 IF ( rc /= ESMF_SUCCESS) THEN
409 CALL wrf_error_fatal ( 'ESMF_StateGetAttribute(DecompositionLogicals) failed' )
410 ENDIF
411 ! Usually, when writing an API for a target language, it is considered
412 ! good practice to use native types of the target language in the
413 ! interfaces.
414 bdy_mask = .FALSE.
415 DO i = 1, SIZE(logvals)
416 IF (logvals(i) == ESMF_TRUE) THEN
417 bdy_mask(i) = .TRUE.
418 ENDIF
419 ENDDO
420 ! now the integers
421 CALL ESMF_StateGetAttribute(state, 'DecompositionIntegers', &
422 SIZE(intvals), intvals, rc=rc)
423 IF ( rc /= ESMF_SUCCESS) THEN
424 CALL wrf_error_fatal ( 'ESMF_StateGetAttribute(DecompositionIntegers) failed' )
425 ENDIF
426 ids = intvals(1)
427 ide = intvals(2)
428 jds = intvals(3)
429 jde = intvals(4)
430 kds = intvals(5)
431 kde = intvals(6)
432 ims = intvals(7)
433 ime = intvals(8)
434 jms = intvals(9)
435 jme = intvals(10)
436 kms = intvals(11)
437 kme = intvals(12)
438 ips = intvals(13)
439 ipe = intvals(14)
440 jps = intvals(15)
441 jpe = intvals(16)
442 kps = intvals(17)
443 kpe = intvals(18)
444 domdesc = intvals(19)
445 END SUBROUTINE GetDecompFromState
446
447
448
449 END MODULE module_metadatautils
450
451
452
453 MODULE module_wrf_component_top
454 !<DESCRIPTION>
455 ! This module defines wrf_component_init1(), wrf_component_init2(),
456 ! wrf_component_run(), and wrf_component_finalize() routines that are called
457 ! when WRF is run as an ESMF component.
458 !</DESCRIPTION>
459
460 USE module_wrf_top
461 USE ESMF_Mod
462 USE module_esmf_extensions
463 USE module_metadatautils, ONLY: AttachTimesToState, AttachDecompToState
464
465
466
467 IMPLICIT NONE
468
469 ! everything is private by default
470 PRIVATE
471
472 ! Public entry points
473 PUBLIC wrf_component_init1
474 PUBLIC wrf_component_init2
475 PUBLIC wrf_component_run
476 PUBLIC wrf_component_finalize
477
478 ! private stuff
479 CHARACTER (ESMF_MAXSTR) :: str
480
481 CONTAINS
482
483
484 SUBROUTINE wrf_component_init1( gcomp, importState, exportState, clock, rc )
485 TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
486 TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState
487 TYPE(ESMF_State), TARGET, INTENT(INOUT) :: exportState
488 TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
489 INTEGER, INTENT( OUT) :: rc
490 !<DESCRIPTION>
491 ! WRF component init routine, phase 1. Passes relevant coupling
492 ! information back as metadata on exportState.
493 !
494 ! The arguments are:
495 ! gcomp Component
496 ! importState Importstate
497 ! exportState Exportstate
498 ! clock External clock
499 ! rc Return code; equals ESMF_SUCCESS if there are no errors,
500 ! otherwise ESMF_FAILURE.
501 !</DESCRIPTION>
502
503 ! Local variables
504 TYPE(ESMF_GridComp), POINTER :: p_gcomp
505 TYPE(ESMF_State), POINTER :: p_importState
506 TYPE(ESMF_State), POINTER :: p_exportState
507 TYPE(ESMF_Clock), POINTER :: p_clock
508 ! Time hackery
509 TYPE(ESMF_Time) :: startTime
510 TYPE(ESMF_Time) :: stopTime
511 TYPE(ESMF_TimeInterval) :: couplingInterval
512 ! decomposition hackery
513 INTEGER :: ids, ide, jds, jde, kds, kde
514 INTEGER :: ims, ime, jms, jme, kms, kme
515 INTEGER :: ips, ipe, jps, jpe, kps, kpe
516 INTEGER :: domdesc
517 LOGICAL :: bdy_mask(4)
518 CHARACTER(LEN=256) :: couplingIntervalString
519
520 rc = ESMF_SUCCESS
521
522 p_gcomp => gcomp
523 p_importState => importState
524 p_exportState => exportState
525 p_clock => clock
526 ! NOTE: It will be possible to remove this call once ESMF supports
527 ! interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
528 ! ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
529 CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
530 exportState=p_exportState, clock=p_clock )
531
532 ! Call WRF "init" routine, suppressing call to init_modules(1) since
533 ! it was already done by the AppDriver.
534 CALL wrf_init( no_init1=.TRUE. )
535
536 ! For now, use settings from WRF component intialization to set up
537 ! top-level clock. Per suggestion from ESMF Core team, these are passed
538 ! back as attributes on exportState.
539 CALL wrf_clockprint( 100, head_grid%domain_clock, &
540 'DEBUG wrf_component_init1(): head_grid%domain_clock,' )
541 CALL ESMF_ClockGet(head_grid%domain_clock, startTime=startTime, &
542 stopTime=stopTime, rc=rc)
543 IF ( rc /= ESMF_SUCCESS ) THEN
544 CALL wrf_error_fatal ( 'wrf_component_init1: ESMF_ClockGet failed' )
545 ENDIF
546 ! CALL wrf_debug( 100, 'DEBUG wrf_component_init1(): before wrf_findCouplingInterval' )
547 CALL wrf_findCouplingInterval( startTime, stopTime, couplingInterval )
548 ! CALL wrf_debug( 100, 'DEBUG wrf_component_init1(): after wrf_findCouplingInterval' )
549 CALL ESMF_TimeIntervalGet( couplingInterval, TimeString=couplingIntervalString, &
550 rc=rc )
551 IF ( rc /= ESMF_SUCCESS ) THEN
552 CALL wrf_error_fatal ( 'wrf_component_init1: ESMF_TimeIntervalGet failed' )
553 ENDIF
554 CALL wrf_debug( 100, 'DEBUG wrf_component_init1(): couplingInterval = '//TRIM(couplingIntervalString) )
555 CALL AttachTimesToState( exportState, startTime, stopTime, couplingInterval )
556 CALL wrf_getDecompInfo( ids, ide, jds, jde, kds, kde, &
557 ims, ime, jms, jme, kms, kme, &
558 ips, ipe, jps, jpe, kps, kpe, &
559 domdesc, bdy_mask )
560 CALL AttachDecompToState( exportState, &
561 ids, ide, jds, jde, kds, kde, &
562 ims, ime, jms, jme, kms, kme, &
563 ips, ipe, jps, jpe, kps, kpe, &
564 domdesc, bdy_mask )
565
566 END SUBROUTINE wrf_component_init1
567
568
569
570 SUBROUTINE wrf_component_init2( gcomp, importState, exportState, clock, rc )
571 TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
572 TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState
573 TYPE(ESMF_State), TARGET, INTENT(INOUT) :: exportState
574 TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
575 INTEGER, INTENT( OUT) :: rc
576 !<DESCRIPTION>
577 ! WRF component init routine, phase 2. Initializes importState and
578 ! exportState.
579 !
580 ! The arguments are:
581 ! gcomp Component
582 ! importState Importstate
583 ! exportState Exportstate
584 ! clock External clock
585 ! rc Return code; equals ESMF_SUCCESS if there are no errors,
586 ! otherwise ESMF_FAILURE.
587 !</DESCRIPTION>
588
589 ! Local variables
590 TYPE(ESMF_GridComp), POINTER :: p_gcomp
591 TYPE(ESMF_State), POINTER :: p_importState
592 TYPE(ESMF_State), POINTER :: p_exportState
593 TYPE(ESMF_Clock), POINTER :: p_clock
594 ! Time hackery
595 TYPE(ESMF_Time) :: startTime
596 TYPE(ESMF_Time) :: stopTime
597 TYPE(ESMF_TimeInterval) :: couplingInterval
598 ! decomposition hackery
599 INTEGER :: ids, ide, jds, jde, kds, kde
600 INTEGER :: ims, ime, jms, jme, kms, kme
601 INTEGER :: ips, ipe, jps, jpe, kps, kpe
602 INTEGER :: domdesc
603 LOGICAL :: bdy_mask(4)
604 TYPE(ESMF_StateType) :: statetype
605 INTEGER :: itemCount, i
606 CHARACTER (ESMF_MAXSTR) :: statename
607 CHARACTER (ESMF_MAXSTR), ALLOCATABLE :: itemNames(:)
608 TYPE(ESMF_StateItemType), ALLOCATABLE :: itemTypes(:)
609
610 CALL wrf_debug ( 100, 'wrf_component_init2(): begin' )
611 ! check exportState
612 CALL ESMF_StateGet( exportState, itemCount=itemCount, &
613 statetype=statetype, rc=rc )
614 IF ( rc /= ESMF_SUCCESS ) THEN
615 CALL wrf_error_fatal("wrf_component_init2: ESMF_StateGet(exportState) failed" )
616 ENDIF
617 WRITE (str,*) 'wrf_component_init2: exportState itemCount = ', itemCount
618 CALL wrf_debug ( 100 , TRIM(str) )
619 IF ( statetype /= ESMF_STATE_EXPORT ) THEN
620 CALL wrf_error_fatal("wrf_component_init2: exportState is not an export state" )
621 ENDIF
622 ! check importState
623 CALL ESMF_StateGet( importState, itemCount=itemCount, &
624 statetype=statetype, rc=rc )
625 IF ( rc /= ESMF_SUCCESS ) THEN
626 CALL wrf_error_fatal("wrf_component_init2: ESMF_StateGet(importState) failed" )
627 ENDIF
628 WRITE (str,*) 'wrf_component_init2: importState itemCount = ', itemCount
629 CALL wrf_debug ( 100 , TRIM(str) )
630 IF ( statetype /= ESMF_STATE_IMPORT ) THEN
631 CALL wrf_error_fatal("wrf_component_init2: importState is not an import state" )
632 ENDIF
633
634 p_gcomp => gcomp
635 p_importState => importState
636 p_exportState => exportState
637 p_clock => clock
638 ! NOTE: It will be possible to remove this call once ESMF supports
639 ! interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
640 ! ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
641 CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
642 exportState=p_exportState, clock=p_clock )
643
644
645 ! This bit of hackery causes wrf_component_run to advance the head_grid
646 ! of WRF up to the point where import and export states have been
647 ! initialized and then return.
648 head_grid%return_after_training_io = .TRUE.
649 CALL wrf_component_run( gcomp, importState, exportState, clock, rc )
650 IF ( rc /= ESMF_SUCCESS ) THEN
651 CALL wrf_error_fatal ( 'wrf_component_init2: wrf_component_run failed' )
652 ENDIF
653
654 ! examine importState
655 WRITE (str,*) 'wrf_component_init2: EXAMINING importState...'
656 CALL wrf_debug ( 100 , TRIM(str) )
657 CALL ESMF_StateGet( importState, itemCount=itemCount, &
658 statetype=statetype, name=statename, rc=rc )
659 IF ( rc /= ESMF_SUCCESS ) THEN
660 CALL wrf_error_fatal("wrf_component_init2: ESMF_StateGet(importState) failed B" )
661 ENDIF
662 IF ( statetype /= ESMF_STATE_IMPORT ) THEN
663 CALL wrf_error_fatal("wrf_component_init2: importState is not an import state" )
664 ENDIF
665 WRITE (str,*) 'wrf_component_init2: importState <',TRIM(statename), &
666 '> itemCount = ', itemCount
667 CALL wrf_debug ( 100 , TRIM(str) )
668 ALLOCATE ( itemNames(itemCount), itemTypes(itemCount) )
669 CALL ESMF_StateGet( importState, itemNameList=itemNames, &
670 stateitemtypeList=itemTypes, rc=rc )
671 IF ( rc /= ESMF_SUCCESS ) THEN
672 CALL wrf_error_fatal("wrf_component_init2: ESMF_StateGet(importState) failed C" )
673 ENDIF
674 DO i=1, itemCount
675 IF ( itemTypes(i) == ESMF_STATEITEM_FIELD ) THEN
676 WRITE(str,*) 'wrf_component_init2: importState contains field <',TRIM(itemNames(i)),'>'
677 CALL wrf_debug ( 100 , TRIM(str) )
678 ENDIF
679 ENDDO
680 DEALLOCATE ( itemNames, itemTypes )
681 WRITE (str,*) 'wrf_component_init2: DONE EXAMINING importState...'
682 CALL wrf_debug ( 100 , TRIM(str) )
683
684 ! examine exportState
685 WRITE (str,*) 'wrf_component_init2: EXAMINING exportState...'
686 CALL wrf_debug ( 100 , TRIM(str) )
687 CALL ESMF_StateGet( exportState, itemCount=itemCount, &
688 statetype=statetype, name=statename, rc=rc )
689 IF ( rc /= ESMF_SUCCESS ) THEN
690 CALL wrf_error_fatal("wrf_component_init2: ESMF_StateGet(exportState) failed B" )
691 ENDIF
692 IF ( statetype /= ESMF_STATE_EXPORT ) THEN
693 CALL wrf_error_fatal("wrf_component_init2: exportState is not an export state" )
694 ENDIF
695 WRITE (str,*) 'wrf_component_init2: exportState <',TRIM(statename), &
696 '> itemCount = ', itemCount
697 CALL wrf_debug ( 100 , TRIM(str) )
698 ALLOCATE ( itemNames(itemCount), itemTypes(itemCount) )
699 CALL ESMF_StateGet( exportState, itemNameList=itemNames, &
700 stateitemtypeList=itemTypes, rc=rc )
701 IF ( rc /= ESMF_SUCCESS ) THEN
702 CALL wrf_error_fatal("wrf_component_init2: ESMF_StateGet(exportState) failed C" )
703 ENDIF
704 DO i=1, itemCount
705 IF ( itemTypes(i) == ESMF_STATEITEM_FIELD ) THEN
706 WRITE(str,*) 'wrf_component_init2: exportState contains field <',TRIM(itemNames(i)),'>'
707 CALL wrf_debug ( 100 , TRIM(str) )
708 ENDIF
709 ENDDO
710 DEALLOCATE ( itemNames, itemTypes )
711 WRITE (str,*) 'wrf_component_init2: DONE EXAMINING exportState...'
712 CALL wrf_debug ( 100 , TRIM(str) )
713
714 CALL wrf_debug ( 100, 'DEBUG wrf_component_init2(): end' )
715
716 END SUBROUTINE wrf_component_init2
717
718
719
720 SUBROUTINE wrf_component_run( gcomp, importState, exportState, clock, rc )
721 TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
722 TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState
723 TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
724 INTEGER, INTENT( OUT) :: rc
725 !<DESCRIPTION>
726 ! WRF component run routine.
727 !
728 ! The arguments are:
729 ! gcomp Component
730 ! importState Importstate
731 ! exportState Exportstate
732 ! clock External clock
733 ! rc Return code; equals ESMF_SUCCESS if there are no errors,
734 ! otherwise ESMF_FAILURE.
735 !</DESCRIPTION>
736
737 ! Local variables
738 TYPE(ESMF_GridComp), POINTER :: p_gcomp
739 TYPE(ESMF_State), POINTER :: p_importState
740 TYPE(ESMF_State), POINTER :: p_exportState
741 TYPE(ESMF_Clock), POINTER :: p_clock
742 ! timing
743 TYPE(ESMF_Time) :: currentTime, nextTime
744 TYPE(ESMF_TimeInterval) :: runLength ! how long to run in this call
745 CHARACTER(LEN=256) :: timeStr
746
747 CALL wrf_debug ( 100 , 'DEBUG wrf_component_run(): begin' )
748
749 p_gcomp => gcomp
750 p_importState => importState
751 p_exportState => exportState
752 p_clock => clock
753 ! NOTE: It will be possible to remove this call once ESMF supports
754 ! interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
755 ! ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
756 CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
757 exportState=p_exportState, clock=p_clock )
758
759 ! connect ESMF clock with WRF domain clock
760 CALL ESMF_ClockGet( clock, currTime=currentTime, timeStep=runLength, rc=rc )
761 IF ( rc /= ESMF_SUCCESS ) THEN
762 CALL wrf_error_fatal ( 'wrf_component_run: ESMF_ClockGet failed' )
763 ENDIF
764 CALL wrf_clockprint(100, clock, &
765 'DEBUG wrf_component_run(): clock,')
766 nextTime = currentTime + runLength
767 head_grid%start_subtime = currentTime
768 head_grid%stop_subtime = nextTime
769 CALL wrf_timetoa ( head_grid%start_subtime, timeStr )
770 WRITE (str,*) 'wrf_component_run: head_grid%start_subtime ',TRIM(timeStr)
771 CALL wrf_debug ( 100 , TRIM(str) )
772 CALL wrf_timetoa ( head_grid%stop_subtime, timeStr )
773 WRITE (str,*) 'wrf_component_run: head_grid%stop_subtime ',TRIM(timeStr)
774 CALL wrf_debug ( 100 , TRIM(str) )
775
776 ! Call WRF "run" routine
777 CALL wrf_debug ( 100 , 'DEBUG wrf_component_run(): calling wrf_run()' )
778 CALL wrf_run( )
779 CALL wrf_debug ( 100 , 'DEBUG wrf_component_run(): back from wrf_run()' )
780
781 ! This bit of hackery will cause the next call to wrf_run() to
782 ! resume advance of the head_grid from the point where import and
783 ! export states were initialized. When grid%return_after_training_io
784 ! is .TRUE., wrf_run() returns right after import and export states
785 ! are initialized. This hack is triggered in wrf_component_init2.
786 IF ( head_grid%return_after_training_io ) THEN
787 head_grid%return_after_training_io = .FALSE.
788 ENDIF
789
790 CALL wrf_debug ( 100 , 'DEBUG wrf_component_run(): end' )
791
792 END SUBROUTINE wrf_component_run
793
794
795
796 SUBROUTINE wrf_component_finalize( gcomp, importState, exportState, clock, rc )
797 TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
798 TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState
799 TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
800 INTEGER, INTENT( OUT) :: rc
801 !<DESCRIPTION>
802 ! WRF component finalize routine.
803 !
804 ! The arguments are:
805 ! gcomp Component
806 ! importState Importstate
807 ! exportState Exportstate
808 ! clock External clock
809 ! rc Return code; equals ESMF_SUCCESS if there are no errors,
810 ! otherwise ESMF_FAILURE.
811 !</DESCRIPTION>
812
813 ! Local variables
814 TYPE(ESMF_GridComp), POINTER :: p_gcomp
815 TYPE(ESMF_State), POINTER :: p_importState
816 TYPE(ESMF_State), POINTER :: p_exportState
817 TYPE(ESMF_Clock), POINTER :: p_clock
818 INTEGER :: rc
819 p_gcomp => gcomp
820 p_importState => importState
821 p_exportState => exportState
822 p_clock => clock
823 ! NOTE: It will be possible to remove this call once ESMF supports
824 ! interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
825 ! ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
826 CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
827 exportState=p_exportState, clock=p_clock )
828
829 ! Call WRF "finalize" routine, suppressing call to MPI_FINALIZE so
830 ! ESMF can do it (if needed) during ESMF_Finalize().
831 CALL wrf_finalize( no_shutdown=.TRUE. )
832
833 rc = ESMF_SUCCESS
834
835 END SUBROUTINE wrf_component_finalize
836
837
838
839 SUBROUTINE wrf_findCouplingInterval( startTime, stopTime, couplingInterval )
840 TYPE(ESMF_Time), INTENT(IN ) :: startTime
841 TYPE(ESMF_Time), INTENT(IN ) :: stopTime
842 TYPE(ESMF_TimeInterval), INTENT( OUT) :: couplingInterval
843 !<DESCRIPTION>
844 ! WRF convenience routine for deducing coupling interval. The startTime
845 ! and stopTime arguments are only used for determining a default value
846 ! when coupling is not actually being done.
847 !
848 ! The arguments are:
849 ! startTime start time
850 ! stopTime stop time
851 ! couplingInterval coupling interval
852 !</DESCRIPTION>
853 ! locals
854 LOGICAL :: foundcoupling
855 INTEGER :: rc
856 INTEGER :: io_form
857 ! external function prototype
858 INTEGER, EXTERNAL :: use_package
859
860 ! deduce coupling time-step
861 foundcoupling = .FALSE.
862 !$$$here... this bit just finds the FIRST case and extracts coupling interval
863 !$$$here... add error-checking for over-specification
864 !$$$here... add support for multiple coupling intervals later...
865 !$$$here... add support for coupling that does not begin immediately later...
866 !$$$ get rid of this hideous duplication!!
867 IF ( .NOT. foundcoupling ) THEN
868 CALL nl_get_io_form_auxinput1( 1, io_form )
869 IF ( use_package( io_form ) == IO_ESMF ) THEN
870 CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT1_ALARM ), &
871 RingInterval=couplingInterval, rc=rc )
872 IF ( rc /= ESMF_SUCCESS ) THEN
873 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXINPUT1_ALARM) failed' )
874 ENDIF
875 foundcoupling = .TRUE.
876 ENDIF
877 ENDIF
878 IF ( .NOT. foundcoupling ) THEN
879 CALL nl_get_io_form_auxinput2( 1, io_form )
880 IF ( use_package( io_form ) == IO_ESMF ) THEN
881 CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT2_ALARM ), &
882 RingInterval=couplingInterval, rc=rc )
883 IF ( rc /= ESMF_SUCCESS ) THEN
884 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXINPUT2_ALARM) failed' )
885 ENDIF
886 foundcoupling = .TRUE.
887 ENDIF
888 ENDIF
889 IF ( .NOT. foundcoupling ) THEN
890 CALL nl_get_io_form_auxinput3( 1, io_form )
891 IF ( use_package( io_form ) == IO_ESMF ) THEN
892 CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT3_ALARM ), &
893 RingInterval=couplingInterval, rc=rc )
894 IF ( rc /= ESMF_SUCCESS ) THEN
895 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXINPUT3_ALARM) failed' )
896 ENDIF
897 foundcoupling = .TRUE.
898 ENDIF
899 ENDIF
900 IF ( .NOT. foundcoupling ) THEN
901 CALL nl_get_io_form_auxinput4( 1, io_form )
902 IF ( use_package( io_form ) == IO_ESMF ) THEN
903 CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT4_ALARM ), &
904 RingInterval=couplingInterval, rc=rc )
905 IF ( rc /= ESMF_SUCCESS ) THEN
906 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXINPUT4_ALARM) failed' )
907 ENDIF
908 foundcoupling = .TRUE.
909 ENDIF
910 ENDIF
911 IF ( .NOT. foundcoupling ) THEN
912 CALL nl_get_io_form_auxinput5( 1, io_form )
913 IF ( use_package( io_form ) == IO_ESMF ) THEN
914 CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT5_ALARM ), &
915 RingInterval=couplingInterval, rc=rc )
916 IF ( rc /= ESMF_SUCCESS ) THEN
917 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXINPUT5_ALARM) failed' )
918 ENDIF
919 foundcoupling = .TRUE.
920 ENDIF
921 ENDIF
922 IF ( .NOT. foundcoupling ) THEN
923 CALL nl_get_io_form_auxinput6( 1, io_form )
924 IF ( use_package( io_form ) == IO_ESMF ) THEN
925 CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT6_ALARM ), &
926 RingInterval=couplingInterval, rc=rc )
927 IF ( rc /= ESMF_SUCCESS ) THEN
928 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXINPUT6_ALARM) failed' )
929 ENDIF
930 foundcoupling = .TRUE.
931 ENDIF
932 ENDIF
933 IF ( .NOT. foundcoupling ) THEN
934 CALL nl_get_io_form_auxinput7( 1, io_form )
935 IF ( use_package( io_form ) == IO_ESMF ) THEN
936 CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT7_ALARM ), &
937 RingInterval=couplingInterval, rc=rc )
938 IF ( rc /= ESMF_SUCCESS ) THEN
939 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXINPUT7_ALARM) failed' )
940 ENDIF
941 foundcoupling = .TRUE.
942 ENDIF
943 ENDIF
944 IF ( .NOT. foundcoupling ) THEN
945 CALL nl_get_io_form_auxinput8( 1, io_form )
946 IF ( use_package( io_form ) == IO_ESMF ) THEN
947 CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT8_ALARM ), &
948 RingInterval=couplingInterval, rc=rc )
949 IF ( rc /= ESMF_SUCCESS ) THEN
950 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXINPUT8_ALARM) failed' )
951 ENDIF
952 foundcoupling = .TRUE.
953 ENDIF
954 ENDIF
955 IF ( .NOT. foundcoupling ) THEN
956 CALL nl_get_io_form_auxinput9( 1, io_form )
957 IF ( use_package( io_form ) == IO_ESMF ) THEN
958 CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT9_ALARM ), &
959 RingInterval=couplingInterval, rc=rc )
960 IF ( rc /= ESMF_SUCCESS ) THEN
961 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXINPUT9_ALARM) failed' )
962 ENDIF
963 foundcoupling = .TRUE.
964 ENDIF
965 ENDIF
966 IF ( .NOT. foundcoupling ) THEN
967 CALL nl_get_io_form_gfdda( 1, io_form )
968 IF ( use_package( io_form ) == IO_ESMF ) THEN
969 CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT10_ALARM ), &
970 RingInterval=couplingInterval, rc=rc )
971 IF ( rc /= ESMF_SUCCESS ) THEN
972 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXINPUT10_ALARM) failed' )
973 ENDIF
974 foundcoupling = .TRUE.
975 ENDIF
976 ENDIF
977 IF ( .NOT. foundcoupling ) THEN
978 CALL nl_get_io_form_auxinput11( 1, io_form )
979 IF ( use_package( io_form ) == IO_ESMF ) THEN
980 CALL ESMF_AlarmGet( head_grid%alarms( AUXINPUT11_ALARM ), &
981 RingInterval=couplingInterval, rc=rc )
982 IF ( rc /= ESMF_SUCCESS ) THEN
983 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXINPUT11_ALARM) failed' )
984 ENDIF
985 foundcoupling = .TRUE.
986 ENDIF
987 ENDIF
988
989
990 IF ( .NOT. foundcoupling ) THEN
991 CALL nl_get_io_form_auxhist1( 1, io_form )
992 IF ( use_package( io_form ) == IO_ESMF ) THEN
993 CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST1_ALARM ), &
994 RingInterval=couplingInterval, rc=rc )
995 IF ( rc /= ESMF_SUCCESS ) THEN
996 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXHIST1_ALARM) failed' )
997 ENDIF
998 foundcoupling = .TRUE.
999 ENDIF
1000 ENDIF
1001 IF ( .NOT. foundcoupling ) THEN
1002 CALL nl_get_io_form_auxhist2( 1, io_form )
1003 IF ( use_package( io_form ) == IO_ESMF ) THEN
1004 CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST2_ALARM ), &
1005 RingInterval=couplingInterval, rc=rc )
1006 IF ( rc /= ESMF_SUCCESS ) THEN
1007 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXHIST2_ALARM) failed' )
1008 ENDIF
1009 foundcoupling = .TRUE.
1010 ENDIF
1011 ENDIF
1012 IF ( .NOT. foundcoupling ) THEN
1013 CALL nl_get_io_form_auxhist3( 1, io_form )
1014 IF ( use_package( io_form ) == IO_ESMF ) THEN
1015 CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST3_ALARM ), &
1016 RingInterval=couplingInterval, rc=rc )
1017 IF ( rc /= ESMF_SUCCESS ) THEN
1018 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXHIST3_ALARM) failed' )
1019 ENDIF
1020 foundcoupling = .TRUE.
1021 ENDIF
1022 ENDIF
1023 IF ( .NOT. foundcoupling ) THEN
1024 CALL nl_get_io_form_auxhist4( 1, io_form )
1025 IF ( use_package( io_form ) == IO_ESMF ) THEN
1026 CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST4_ALARM ), &
1027 RingInterval=couplingInterval, rc=rc )
1028 IF ( rc /= ESMF_SUCCESS ) THEN
1029 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXHIST4_ALARM) failed' )
1030 ENDIF
1031 foundcoupling = .TRUE.
1032 ENDIF
1033 ENDIF
1034 IF ( .NOT. foundcoupling ) THEN
1035 CALL nl_get_io_form_auxhist5( 1, io_form )
1036 IF ( use_package( io_form ) == IO_ESMF ) THEN
1037 CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST5_ALARM ), &
1038 RingInterval=couplingInterval, rc=rc )
1039 IF ( rc /= ESMF_SUCCESS ) THEN
1040 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXHIST5_ALARM) failed' )
1041 ENDIF
1042 foundcoupling = .TRUE.
1043 ENDIF
1044 ENDIF
1045 IF ( .NOT. foundcoupling ) THEN
1046 CALL nl_get_io_form_auxhist6( 1, io_form )
1047 IF ( use_package( io_form ) == IO_ESMF ) THEN
1048 CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST6_ALARM ), &
1049 RingInterval=couplingInterval, rc=rc )
1050 IF ( rc /= ESMF_SUCCESS ) THEN
1051 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXHIST6_ALARM) failed' )
1052 ENDIF
1053 foundcoupling = .TRUE.
1054 ENDIF
1055 ENDIF
1056 IF ( .NOT. foundcoupling ) THEN
1057 CALL nl_get_io_form_auxhist7( 1, io_form )
1058 IF ( use_package( io_form ) == IO_ESMF ) THEN
1059 CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST7_ALARM ), &
1060 RingInterval=couplingInterval, rc=rc )
1061 IF ( rc /= ESMF_SUCCESS ) THEN
1062 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXHIST7_ALARM) failed' )
1063 ENDIF
1064 foundcoupling = .TRUE.
1065 ENDIF
1066 ENDIF
1067 IF ( .NOT. foundcoupling ) THEN
1068 CALL nl_get_io_form_auxhist8( 1, io_form )
1069 IF ( use_package( io_form ) == IO_ESMF ) THEN
1070 CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST8_ALARM ), &
1071 RingInterval=couplingInterval, rc=rc )
1072 IF ( rc /= ESMF_SUCCESS ) THEN
1073 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXHIST8_ALARM) failed' )
1074 ENDIF
1075 foundcoupling = .TRUE.
1076 ENDIF
1077 ENDIF
1078 IF ( .NOT. foundcoupling ) THEN
1079 CALL nl_get_io_form_auxhist9( 1, io_form )
1080 IF ( use_package( io_form ) == IO_ESMF ) THEN
1081 CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST9_ALARM ), &
1082 RingInterval=couplingInterval, rc=rc )
1083 IF ( rc /= ESMF_SUCCESS ) THEN
1084 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXHIST9_ALARM) failed' )
1085 ENDIF
1086 foundcoupling = .TRUE.
1087 ENDIF
1088 ENDIF
1089 IF ( .NOT. foundcoupling ) THEN
1090 CALL nl_get_io_form_auxhist10( 1, io_form )
1091 IF ( use_package( io_form ) == IO_ESMF ) THEN
1092 CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST10_ALARM ), &
1093 RingInterval=couplingInterval, rc=rc )
1094 IF ( rc /= ESMF_SUCCESS ) THEN
1095 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXHIST10_ALARM) failed' )
1096 ENDIF
1097 foundcoupling = .TRUE.
1098 ENDIF
1099 ENDIF
1100 IF ( .NOT. foundcoupling ) THEN
1101 CALL nl_get_io_form_auxhist11( 1, io_form )
1102 IF ( use_package( io_form ) == IO_ESMF ) THEN
1103 CALL ESMF_AlarmGet( head_grid%alarms( AUXHIST11_ALARM ), &
1104 RingInterval=couplingInterval, rc=rc )
1105 IF ( rc /= ESMF_SUCCESS ) THEN
1106 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXHIST11_ALARM) failed' )
1107 ENDIF
1108 foundcoupling = .TRUE.
1109 ENDIF
1110 ENDIF
1111
1112 ! look for erroneous use of io_form...
1113 CALL nl_get_io_form_restart( 1, io_form )
1114 IF ( use_package( io_form ) == IO_ESMF ) THEN
1115 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ERROR: ESMF cannot be used for WRF restart I/O' )
1116 ENDIF
1117 CALL nl_get_io_form_input( 1, io_form )
1118 IF ( use_package( io_form ) == IO_ESMF ) THEN
1119 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ERROR: ESMF cannot be used for WRF input' )
1120 ENDIF
1121 CALL nl_get_io_form_history( 1, io_form )
1122 IF ( use_package( io_form ) == IO_ESMF ) THEN
1123 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ERROR: ESMF cannot be used for WRF history output' )
1124 ENDIF
1125 CALL nl_get_io_form_boundary( 1, io_form )
1126 IF ( use_package( io_form ) == IO_ESMF ) THEN
1127 CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ERROR: ESMF cannot be used for WRF boundary I/O' )
1128 ENDIF
1129
1130 ! If nobody uses IO_ESMF, then default is to run WRF all the way to
1131 ! the end.
1132 IF ( .NOT. foundcoupling ) THEN
1133 couplingInterval = stopTime - startTime
1134 call wrf_debug ( 1, 'WARNING: ESMF coupling not used in this WRF run' )
1135 ENDIF
1136
1137 END SUBROUTINE wrf_findCouplingInterval
1138
1139
1140
1141 SUBROUTINE wrf_getDecompInfo( ids, ide, jds, jde, kds, kde, &
1142 ims, ime, jms, jme, kms, kme, &
1143 ips, ipe, jps, jpe, kps, kpe, &
1144 domdesc, bdy_mask )
1145 INTEGER, INTENT(OUT) :: ids, ide, jds, jde, kds, kde
1146 INTEGER, INTENT(OUT) :: ims, ime, jms, jme, kms, kme
1147 INTEGER, INTENT(OUT) :: ips, ipe, jps, jpe, kps, kpe
1148 INTEGER, INTENT(OUT) :: domdesc
1149 LOGICAL, INTENT(OUT) :: bdy_mask(4)
1150 !<DESCRIPTION>
1151 ! WRF convenience routine for deducing decomposition information.
1152 ! Note that domdesc is meaningful only for SPMD serial operation.
1153 ! For concurrent operation (SPMD or MPMD), we will need to create a new
1154 ! "domdesc" suitable for the task layout of the SST component. For
1155 ! MPMD serial operation, we will need to serialize domdesc and store it
1156 ! as metadata within the export state. Similar arguments apply
1157 ! to [ij][mp][se] and bdy_mask.
1158 !
1159 ! The arguments are:
1160 ! ids, ide, jds, jde, kds, kde Domain extent.
1161 ! ims, ime, jms, jme, kms, kme Memory extent.
1162 ! ips, ipe, jps, jpe, kps, kpe Patch extent.
1163 ! domdesc Domain descriptor for external
1164 ! distributed-memory communication
1165 ! package (opaque to WRF).
1166 ! bdy_mask Boundary mask flags indicating which
1167 ! domain boundaries are on this task.
1168 !</DESCRIPTION>
1169 ! extract decomposition information from head_grid
1170 CALL get_ijk_from_grid( head_grid , &
1171 ids, ide, jds, jde, kds, kde, &
1172 ims, ime, jms, jme, kms, kme, &
1173 ips, ipe, jps, jpe, kps, kpe )
1174 domdesc = head_grid%domdesc
1175 bdy_mask = head_grid%bdy_mask
1176 END SUBROUTINE wrf_getDecompInfo
1177
1178
1179 END MODULE module_wrf_component_top
1180
1181
1182
1183
1184 MODULE module_wrf_setservices
1185 !<DESCRIPTION>
1186 ! This module defines WRF "Set Services" method wrf_register()
1187 ! used for ESMF coupling.
1188 !</DESCRIPTION>
1189
1190 USE module_wrf_component_top, ONLY: wrf_component_init1, &
1191 wrf_component_init2, &
1192 wrf_component_run, &
1193 wrf_component_finalize
1194 USE ESMF_Mod
1195
1196 IMPLICIT NONE
1197
1198 ! everything is private by default
1199 PRIVATE
1200
1201 ! Public entry point for ESMF_GridCompSetServices()
1202 PUBLIC WRF_register
1203
1204 ! private stuff
1205 CHARACTER (ESMF_MAXSTR) :: str
1206
1207 CONTAINS
1208
1209
1210 SUBROUTINE wrf_register(gcomp, rc)
1211 TYPE(ESMF_GridComp), INTENT(INOUT) :: gcomp
1212 INTEGER, INTENT(OUT) :: rc
1213 !
1214 !<DESCRIPTION>
1215 ! WRF_register - Externally visible registration routine
1216 !
1217 ! User-supplied SetServices routine.
1218 ! The Register routine sets the subroutines to be called
1219 ! as the init, run, and finalize routines. Note that these are
1220 ! private to the module.
1221 !
1222 ! The arguments are:
1223 ! gcomp Component
1224 ! rc Return code; equals ESMF_SUCCESS if there are no errors,
1225 ! otherwise ESMF_FAILURE.
1226 !</DESCRIPTION>
1227
1228 rc = ESMF_SUCCESS
1229 ! Register the callback routines.
1230 call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETINIT, &
1231 wrf_component_init1, 1, rc)
1232 IF ( rc /= ESMF_SUCCESS) THEN
1233 CALL wrf_error_fatal ( 'wrf_register: ESMF_GridCompSetEntryPoint(wrf_component_init1) failed' )
1234 ENDIF
1235 call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETINIT, &
1236 wrf_component_init2, 2, rc)
1237 IF ( rc /= ESMF_SUCCESS) THEN
1238 CALL wrf_error_fatal ( 'wrf_register: ESMF_GridCompSetEntryPoint(wrf_component_init2) failed' )
1239 ENDIF
1240 call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETRUN, &
1241 wrf_component_run, ESMF_SINGLEPHASE, rc)
1242 IF ( rc /= ESMF_SUCCESS) THEN
1243 CALL wrf_error_fatal ( 'wrf_register: ESMF_GridCompSetEntryPoint(wrf_component_run) failed' )
1244 ENDIF
1245 call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETFINAL, &
1246 wrf_component_finalize, ESMF_SINGLEPHASE, rc)
1247 IF ( rc /= ESMF_SUCCESS) THEN
1248 CALL wrf_error_fatal ( 'wrf_register: ESMF_GridCompSetEntryPoint(wrf_component_finalize) failed' )
1249 ENDIF
1250 PRINT *,'WRF: Registered Initialize, Run, and Finalize routines'
1251
1252 END SUBROUTINE wrf_register
1253
1254 END MODULE module_wrf_setservices
1255