Context Navigation

wrf_ESMFMod.F

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

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

Download in other formats:

Original Format