Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

wrf_ESMFMod.F @ 1198

Last change on this file since 1198 was 11, checked in by aslmd, 14 years ago
spiga@svn-planeto:ajoute le modele meso-echelle martien
File size: 50.0 KB

Line
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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format