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