Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

wrf_ESMFMod.F @ 409

Last change on this file since 409 was 1, checked in by lfita, 10 years ago

-- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 43.4 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', timevals, itemCount=SIZE(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', timevals, itemCount=SIZE(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', timevals, itemCount=SIZE(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(INOUT) :: 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	INTEGER :: thecount ! 'one attribute ... ah ah ah. TWO attributes! ah ah ah!!
129	CHARACTER*256 mess
130	! start time
131	thecount = SIZE(timevals)
132	CALL ESMF_AttributeGet(state, 'ComponentStartTime', timevals, itemCount=thecount, rc=rc)
133	IF ( rc /= ESMF_SUCCESS ) THEN
134	!JM return but don't fail; let the caller figure out what to do
135	RETURN
136	ENDIF
137	year = timevals(1)
138	month = timevals(2)
139	day = timevals(3)
140	hour = timevals(4)
141	minute = timevals(5)
142	second = timevals(6)
143	CALL ESMF_TimeSet(startTime, yy=year, mm=month, dd=day, &
144	h=hour, m=minute, s=second, rc=rc)
145	IF ( rc /= ESMF_SUCCESS ) THEN
146	CALL wrf_error_fatal ( 'ESMF_TimeSet(startTime) failed' )
147	ENDIF
148	! stop time
149	thecount = SIZE(timevals)
150	CALL ESMF_AttributeGet(state, 'ComponentStopTime', timevals, itemCount=thecount, rc=rc)
151	IF ( rc /= ESMF_SUCCESS ) THEN
152	!JM return but don't fail; let the caller figure out what to do
153	!CALL wrf_error_fatal ( 'ESMF_AttributeGet(ComponentStopTime) failed' )
154	RETURN
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	CALL ESMF_TimeSet(stopTime, yy=year, mm=month, dd=day, &
163	h=hour, m=minute, s=second, rc=rc)
164	IF ( rc /= ESMF_SUCCESS ) THEN
165	CALL wrf_error_fatal ( 'ESMF_TimeSet(stopTime) failed' )
166	ENDIF
167	! coupling time step
168	thecount = SIZE(timevals)
169	CALL ESMF_AttributeGet(state, 'ComponentCouplingInterval', timevals, itemCount=thecount, rc=rc)
170	IF ( rc /= ESMF_SUCCESS ) THEN
171	!JM return but don't fail; let the caller figure out what to do
172	!CALL wrf_error_fatal ( 'ESMF_AttributeGet(ComponentCouplingInterval) failed' )
173	RETURN
174	ENDIF
175	year = timevals(1)
176	month = timevals(2)
177	day = timevals(3)
178	hour = timevals(4)
179	minute = timevals(5)
180	second = timevals(6)
181	CALL ESMF_TimeIntervalSet(couplingInterval, yy=year, mm=month, d=day, &
182	h=hour, m=minute, s=second, rc=rc)
183	IF ( rc /= ESMF_SUCCESS ) THEN
184	CALL wrf_error_fatal ( 'ESMF_TimeIntervalSet(couplingInterval) failed' )
185	ENDIF
186	END SUBROUTINE GetTimesFromState
187
188
189
190	! Extract time information attached as meta-data from one or more
191	! ESMF_States. To use this with more than one ESMF_State, put the
192	! ESMF_States into a single ESMF_State. If times differ, an attempt
193	! is made to reconcile them.
194	SUBROUTINE GetTimesFromStates( state, startTime, stopTime, couplingInterval )
195	USE ESMF_Mod
196	TYPE(ESMF_State), INTENT(INOUT) :: state
197	TYPE(ESMF_Time), INTENT(INOUT) :: startTime
198	TYPE(ESMF_Time), INTENT(INOUT) :: stopTime
199	TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingInterval
200	! locals
201	INTEGER :: rc
202	INTEGER :: numItems, numStates, i, istate
203	TYPE(ESMF_StateItemType), ALLOCATABLE :: itemTypes(:)
204	TYPE(ESMF_State) :: tmpState
205	CHARACTER (len=ESMF_MAXSTR), ALLOCATABLE :: itemNames(:)
206	TYPE(ESMF_Time), ALLOCATABLE :: startTimes(:)
207	TYPE(ESMF_Time), ALLOCATABLE :: stopTimes(:)
208	TYPE(ESMF_TimeInterval), ALLOCATABLE :: couplingIntervals(:)
209	CHARACTER (len=132) :: mess
210
211	! Unfortunately, implementing this is unnecessarily difficult due
212	! to lack of Iterators for ESMF_State.
213
214	! Since there are no convenient iterators for ESMF_State,
215	! write a lot of code...
216	! Figure out how many items are in the ESMF_State
217	CALL ESMF_StateGet(state, itemCount=numItems, rc=rc)
218	IF ( rc /= ESMF_SUCCESS) THEN
219	CALL wrf_error_fatal ( 'ESMF_StateGet(numItems) failed' )
220	ENDIF
221	! allocate an array to hold the types of all items
222	ALLOCATE( itemTypes(numItems) )
223	! allocate an array to hold the names of all items
224	ALLOCATE( itemNames(numItems) )
225	! get the item types and names
226	CALL ESMF_StateGet(state, stateitemtypeList=itemTypes, &
227	itemNameList=itemNames, rc=rc)
228	IF ( rc /= ESMF_SUCCESS) THEN
229	WRITE(str,*) 'ESMF_StateGet itemTypes failed with rc = ', rc
230	CALL wrf_error_fatal ( str )
231	ENDIF
232	! count how many items are ESMF_States
233	numStates = 0
234	DO i=1,numItems
235	IF ( itemTypes(i) == ESMF_STATEITEM_STATE ) THEN
236	numStates = numStates + 1
237	ENDIF
238	ENDDO
239	ALLOCATE( startTimes(numStates), stopTimes(numStates), &
240	couplingIntervals(numStates) )
241	IF ( numStates > 0) THEN
242	! finally, extract nested ESMF_States by name, if there are any
243	! (should be able to do this by index at least!)
244	istate = 0
245	DO i=1,numItems
246	IF ( itemTypes(i) == ESMF_STATEITEM_STATE ) THEN
247	CALL ESMF_StateGet( state, itemName=TRIM(itemNames(i)), &
248	nestedState=tmpState, rc=rc )
249	IF ( rc /= ESMF_SUCCESS) THEN
250	WRITE(str,*) 'ESMF_StateGet(',TRIM(itemNames(i)),') failed'
251	CALL wrf_error_fatal ( str )
252	ENDIF
253	istate = istate + 1
254	CALL GetTimesFromState( tmpState, startTimes(istate), &
255	stopTimes(istate), &
256	couplingIntervals(istate), rc )
257	IF ( rc /= ESMF_SUCCESS ) THEN
258	istate = istate - 1
259	ENDIF
260	ENDIF
261	ENDDO
262	IF ( istate .EQ. 1 ) THEN
263	! this presupposes that 1 of the child states exist and has
264	! valid times in it. Use that one.
265	CALL write(mess,'WARNING: Only ',TRIM(itemNames(1)), &
266	' is valid and has time info in it. Using that.')
267	CALL wrf_message(mess)
268	CALL ESMF_StateGet( state, itemName=TRIM(itemNames(1)), &
269	nestedState=tmpState, rc=rc )
270	CALL GetTimesFromState( tmpState, startTime, stopTime, &
271	couplingInterval , rc )
272	ELSE IF ( istate .GT. 1 ) THEN
273	CALL ReconcileTimes( startTimes, stopTimes, couplingIntervals, &
274	startTime, stopTime, couplingInterval )
275	ELSE
276	CALL wrf_error_fatal('no valid states with times found. giving up.')
277	ENDIF
278	ELSE
279	! there are no nested ESMF_States so use parent state only
280	CALL GetTimesFromState( state, startTime, stopTime, &
281	couplingInterval , rc )
282	ENDIF
283
284	! deallocate locals
285	DEALLOCATE( itemTypes )
286	DEALLOCATE( itemNames )
287	DEALLOCATE( startTimes, stopTimes, couplingIntervals )
288
289	END SUBROUTINE GetTimesFromStates
290
291
292	! Reconcile all times and intervals in startTimes, stopTimes, and
293	! couplingIntervals and return the results in startTime, stopTime, and
294	! couplingInterval. Abort if reconciliation is not possible.
295	SUBROUTINE ReconcileTimes( startTimes, stopTimes, couplingIntervals, &
296	startTime, stopTime, couplingInterval )
297	TYPE(ESMF_Time), INTENT(INOUT) :: startTimes(:)
298	TYPE(ESMF_Time), INTENT(INOUT) :: stopTimes(:)
299	TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingIntervals(:)
300	TYPE(ESMF_Time), INTENT(INOUT) :: startTime
301	TYPE(ESMF_Time), INTENT(INOUT) :: stopTime
302	TYPE(ESMF_TimeInterval), INTENT(INOUT) :: couplingInterval
303	! locals
304	INTEGER :: numTimes, numTimesTmp, i
305
306	! how many sets of time info?
307	numTimes = SIZE(startTimes)
308	IF ( numTimes < 2 ) THEN
309	CALL wrf_error_fatal ( 'SIZE(startTimes) too small' )
310	ENDIF
311	numTimesTmp = SIZE(stopTimes)
312	IF ( numTimes /= numTimesTmp ) THEN
313	CALL wrf_error_fatal ( 'incorrect SIZE(stopTimes)' )
314	ENDIF
315	numTimesTmp = SIZE(couplingIntervals)
316	IF ( numTimes /= numTimesTmp ) THEN
317	CALL wrf_error_fatal ( 'incorrect SIZE(couplingIntervals)' )
318	ENDIF
319
320	! reconcile
321	!TODO: For now this is very simple. Fancy it up later.
322	DO i = 1, numTimes
323	IF ( i == 1 ) THEN
324	startTime = startTimes(i)
325	stopTime = stopTimes(i)
326	couplingInterval = couplingIntervals(i)
327	ELSE
328	IF ( startTimes(i) /= startTime ) THEN
329	CALL wrf_message ( 'ReconcileTimes: inconsistent startTimes. Using first.' )
330	startTimes(i) = startTime
331	ENDIF
332	IF ( stopTimes(i) /= stopTime ) THEN
333	CALL wrf_message ( 'ReconcileTimes: inconsistent stopTimes. Using first.' )
334	stopTimes(i) = stopTime
335	ENDIF
336	IF ( couplingIntervals(i) /= couplingInterval ) THEN
337	CALL wrf_message ( 'ReconcileTimes: inconsistent couplingIntervals. Using first.' )
338	couplingIntervals(i) = couplingInterval
339	ENDIF
340	ENDIF
341
342	ENDDO
343
344	END SUBROUTINE ReconcileTimes
345
346
347
348	!TODO: Eliminate this once this information can be derived via other
349	!TODO: means.
350	SUBROUTINE AttachDecompToState( state, &
351	ids, ide, jds, jde, kds, kde, &
352	ims, ime, jms, jme, kms, kme, &
353	ips, ipe, jps, jpe, kps, kpe, &
354	domdesc, bdy_mask )
355	TYPE(ESMF_State), INTENT(INOUT) :: state
356	INTEGER, INTENT(IN ) :: ids, ide, jds, jde, kds, kde
357	INTEGER, INTENT(IN ) :: ims, ime, jms, jme, kms, kme
358	INTEGER, INTENT(IN ) :: ips, ipe, jps, jpe, kps, kpe
359	INTEGER, INTENT(IN ) :: domdesc
360	LOGICAL, INTENT(IN ) :: bdy_mask(4)
361	! locals
362	INTEGER :: i, rc
363	! big enough to hold the integer values listed above
364	INTEGER(ESMF_KIND_I4) :: intvals(19)
365	! big enough to hold the logical values listed above
366	! TYPE(ESMF_Logical) :: logvals(4)
367	logical :: logvals(4)
368
369	! first the logicals
370	! Usually, when writing an API for a target language, it is considered
371	! good practice to use native types of the target language in the
372	! interfaces.
373	logvals = .FALSE.
374	DO i = 1, SIZE(bdy_mask)
375	IF (bdy_mask(i)) THEN
376	logvals(i) = .TRUE.
377	ENDIF
378	ENDDO
379	CALL ESMF_AttributeSet(state, 'DecompositionLogicals', logvals, itemCount=SIZE(logvals), rc=rc)
380	IF ( rc /= ESMF_SUCCESS) THEN
381	CALL wrf_error_fatal ( 'ESMF_AttributeSet(DecompositionLogicals) failed' )
382	ENDIF
383	! now the integers
384	intvals(1) = ids
385	intvals(2) = ide
386	intvals(3) = jds
387	intvals(4) = jde
388	intvals(5) = kds
389	intvals(6) = kde
390	intvals(7) = ims
391	intvals(8) = ime
392	intvals(9) = jms
393	intvals(10) = jme
394	intvals(11) = kms
395	intvals(12) = kme
396	intvals(13) = ips
397	intvals(14) = ipe
398	intvals(15) = jps
399	intvals(16) = jpe
400	intvals(17) = kps
401	intvals(18) = kpe
402	intvals(19) = domdesc
403	CALL ESMF_AttributeSet(state, 'DecompositionIntegers', intvals, itemCount=SIZE(intvals), rc=rc)
404	IF ( rc /= ESMF_SUCCESS) THEN
405	CALL wrf_error_fatal ( 'ESMF_AttributeSet(DecompositionIntegers) failed' )
406	ENDIF
407	END SUBROUTINE AttachDecompToState
408
409
410
411	!TODO: Eliminate this once this information can be derived via other
412	!TODO: means.
413	SUBROUTINE GetDecompFromState( state, &
414	ids, ide, jds, jde, kds, kde, &
415	ims, ime, jms, jme, kms, kme, &
416	ips, ipe, jps, jpe, kps, kpe, &
417	domdesc, bdy_mask )
418	TYPE(ESMF_State), INTENT(INOUT) :: state
419	INTEGER, INTENT( OUT) :: ids, ide, jds, jde, kds, kde
420	INTEGER, INTENT( OUT) :: ims, ime, jms, jme, kms, kme
421	INTEGER, INTENT( OUT) :: ips, ipe, jps, jpe, kps, kpe
422	INTEGER, INTENT( OUT) :: domdesc
423	LOGICAL, INTENT( OUT) :: bdy_mask(4)
424	! locals
425	INTEGER :: i, rc
426	! big enough to hold the integer values listed above
427	INTEGER(ESMF_KIND_I4) :: intvals(19)
428	! big enough to hold the logical values listed above
429	logical :: logvals(4)
430	integer :: thecount ! ah ah ah
431
432	! first the logicals
433	thecount = SIZE(logvals)
434	CALL ESMF_AttributeGet(state, 'DecompositionLogicals', logvals, itemCount=thecount, rc=rc)
435	IF ( rc /= ESMF_SUCCESS) THEN
436	CALL wrf_error_fatal ( 'ESMF_AttributeGet(DecompositionLogicals) failed' )
437	ENDIF
438	! Usually, when writing an API for a target language, it is considered
439	! good practice to use native types of the target language in the
440	! interfaces.
441	bdy_mask = .FALSE.
442	DO i = 1, SIZE(logvals)
443	IF (logvals(i) ) THEN
444	bdy_mask(i) = .TRUE.
445	ENDIF
446	ENDDO
447	! now the integers
448	thecount = SIZE(intvals)
449	CALL ESMF_AttributeGet(state, 'DecompositionIntegers', intvals, itemCount=thecount, rc=rc)
450	IF ( rc /= ESMF_SUCCESS) THEN
451	CALL wrf_error_fatal ( 'ESMF_AttributeGet(DecompositionIntegers) failed' )
452	ENDIF
453	ids = intvals(1)
454	ide = intvals(2)
455	jds = intvals(3)
456	jde = intvals(4)
457	kds = intvals(5)
458	kde = intvals(6)
459	ims = intvals(7)
460	ime = intvals(8)
461	jms = intvals(9)
462	jme = intvals(10)
463	kms = intvals(11)
464	kme = intvals(12)
465	ips = intvals(13)
466	ipe = intvals(14)
467	jps = intvals(15)
468	jpe = intvals(16)
469	kps = intvals(17)
470	kpe = intvals(18)
471	domdesc = intvals(19)
472	END SUBROUTINE GetDecompFromState
473
474
475
476	END MODULE module_metadatautils
477
478
479
480	MODULE module_wrf_component_top
481	!<DESCRIPTION>
482	! This module defines wrf_component_init1(), wrf_component_init2(),
483	! wrf_component_run(), and wrf_component_finalize() routines that are called
484	! when WRF is run as an ESMF component.
485	!</DESCRIPTION>
486
487	USE ESMF_Mod
488	USE module_wrf_top, ONLY : wrf_init, wrf_run, wrf_finalize
489	USE module_domain, ONLY : head_grid, get_ijk_from_grid
490	USE module_state_description
491	USE module_streams
492
493	USE module_esmf_extensions
494	USE module_metadatautils, ONLY: AttachTimesToState, AttachDecompToState
495
496
497
498	IMPLICIT NONE
499
500	! everything is private by default
501	PRIVATE
502
503	! Public entry points
504	PUBLIC wrf_component_init1
505	PUBLIC wrf_component_init2
506	PUBLIC wrf_component_run
507	PUBLIC wrf_component_finalize
508
509	! private stuff
510	CHARACTER (ESMF_MAXSTR) :: str
511
512	CONTAINS
513
514
515	SUBROUTINE wrf_component_init1( gcomp, importState, exportState, clock, rc )
516	TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
517	TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState
518	TYPE(ESMF_State), TARGET, INTENT(INOUT) :: exportState
519	TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
520	#ifdef DM_PARALLEL
521	TYPE(ESMF_VM) :: vm
522	INTEGER :: mpicomtmp
523	#endif
524	INTEGER, INTENT( OUT) :: rc
525	!<DESCRIPTION>
526	! WRF component init routine, phase 1. Passes relevant coupling
527	! information back as metadata on exportState.
528	!
529	! The arguments are:
530	! gcomp Component
531	! importState Importstate
532	! exportState Exportstate
533	! clock External clock
534	! rc Return code; equals ESMF_SUCCESS if there are no errors,
535	! otherwise ESMF_FAILURE.
536	!</DESCRIPTION>
537	!TODO: Note that much of the decomposition-related meta-data attached to the
538	!TODO: exportState are WRF-specific and are only useful if other components
539	!TODO: want to re-use the WRF IOAPI with the same decomposition as the WRF
540	!TODO: model. This is true for the simple WRF+CPL+SST test case, but will
541	!TODO: not be in general. Of course other components are free to ignore this
542	!TODO: information.
543
544	! Local variables
545	TYPE(ESMF_GridComp), POINTER :: p_gcomp
546	TYPE(ESMF_State), POINTER :: p_importState
547	TYPE(ESMF_State), POINTER :: p_exportState
548	TYPE(ESMF_Clock), POINTER :: p_clock
549	! Time hackery
550	TYPE(ESMF_Time) :: startTime
551	TYPE(ESMF_Time) :: stopTime
552	TYPE(ESMF_TimeInterval) :: couplingInterval
553	! decomposition hackery
554	INTEGER :: ids, ide, jds, jde, kds, kde
555	INTEGER :: ims, ime, jms, jme, kms, kme
556	INTEGER :: ips, ipe, jps, jpe, kps, kpe
557	INTEGER :: domdesc
558	LOGICAL :: bdy_mask(4)
559	CHARACTER(LEN=256) :: couplingIntervalString
560
561	rc = ESMF_SUCCESS
562
563	p_gcomp => gcomp
564	p_importState => importState
565	p_exportState => exportState
566	p_clock => clock
567	! NOTE: It will be possible to remove this call once ESMF supports
568	! interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
569	! ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
570	CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
571	exportState=p_exportState, clock=p_clock )
572
573	#ifdef DM_PARALLEL
574	CALL ESMF_VMGetCurrent(vm, rc=rc)
575	IF ( rc /= ESMF_SUCCESS ) THEN
576	CALL wrf_error_fatal ( 'wrf_component_init1: ESMF_VMGetCurrent failed' )
577	ENDIF
578	CALL ESMF_VMGet(vm, mpiCommunicator=mpicomtmp, rc=rc)
579	IF ( rc /= ESMF_SUCCESS ) THEN
580	CALL wrf_error_fatal ( 'wrf_component_init1: ESMF_VMGet failed' )
581	ENDIF
582	CALL wrf_set_dm_communicator( mpicomtmp )
583	#endif
584
585	! Call WRF "init" routine, which, for a DM_PARALLEL run, will recognize
586	! that ESMF has already called MPI_INIT and respond appropriately.
587	CALL wrf_init( no_init1=.TRUE. )
588
589	! For now, use settings from WRF component intialization to set up
590	! top-level clock. Per suggestion from ESMF Core team, these are passed
591	! back as attributes on exportState.
592	CALL wrf_clockprint( 100, head_grid%domain_clock, &
593	'DEBUG wrf_component_init1(): head_grid%domain_clock,' )
594	CALL ESMF_ClockGet(head_grid%domain_clock, startTime=startTime, &
595	stopTime=stopTime, rc=rc)
596	IF ( rc /= ESMF_SUCCESS ) THEN
597	CALL wrf_error_fatal ( 'wrf_component_init1: ESMF_ClockGet failed' )
598	ENDIF
599	CALL wrf_debug( 500, 'DEBUG wrf_component_init1(): before wrf_findCouplingInterval' )
600	CALL wrf_findCouplingInterval( startTime, stopTime, couplingInterval )
601	CALL wrf_debug( 500, 'DEBUG wrf_component_init1(): after wrf_findCouplingInterval' )
602	CALL ESMF_TimeIntervalGet( couplingInterval, TimeString=couplingIntervalString, &
603	rc=rc )
604	IF ( rc /= ESMF_SUCCESS ) THEN
605	CALL wrf_error_fatal ( 'wrf_component_init1: ESMF_TimeIntervalGet failed' )
606	ENDIF
607	CALL wrf_debug( 100, 'DEBUG wrf_component_init1(): couplingInterval = '//TRIM(couplingIntervalString) )
608	CALL AttachTimesToState( exportState, startTime, stopTime, couplingInterval )
609	CALL wrf_getDecompInfo( ids, ide, jds, jde, kds, kde, &
610	ims, ime, jms, jme, kms, kme, &
611	ips, ipe, jps, jpe, kps, kpe, &
612	domdesc, bdy_mask )
613	CALL AttachDecompToState( exportState, &
614	ids, ide, jds, jde, kds, kde, &
615	ims, ime, jms, jme, kms, kme, &
616	ips, ipe, jps, jpe, kps, kpe, &
617	domdesc, bdy_mask )
618	CALL AttachDecompToState( importState, &
619	ids, ide, jds, jde, kds, kde, &
620	ims, ime, jms, jme, kms, kme, &
621	ips, ipe, jps, jpe, kps, kpe, &
622	domdesc, bdy_mask )
623
624	END SUBROUTINE wrf_component_init1
625
626
627
628	SUBROUTINE wrf_component_init2( gcomp, importState, exportState, clock, rc )
629	TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
630	TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState
631	TYPE(ESMF_State), TARGET, INTENT(INOUT) :: exportState
632	TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
633	INTEGER, INTENT( OUT) :: rc
634	!<DESCRIPTION>
635	! WRF component init routine, phase 2. Initializes importState and
636	! exportState.
637	!
638	! The arguments are:
639	! gcomp Component
640	! importState Importstate
641	! exportState Exportstate
642	! clock External clock
643	! rc Return code; equals ESMF_SUCCESS if there are no errors,
644	! otherwise ESMF_FAILURE.
645	!</DESCRIPTION>
646
647	! Local variables
648	TYPE(ESMF_GridComp), POINTER :: p_gcomp
649	TYPE(ESMF_State), POINTER :: p_importState
650	TYPE(ESMF_State), POINTER :: p_exportState
651	TYPE(ESMF_Clock), POINTER :: p_clock
652	! Time hackery
653	TYPE(ESMF_Time) :: startTime
654	TYPE(ESMF_Time) :: stopTime
655	TYPE(ESMF_TimeInterval) :: couplingInterval
656	! decomposition hackery
657	INTEGER :: ids, ide, jds, jde, kds, kde
658	INTEGER :: ims, ime, jms, jme, kms, kme
659	INTEGER :: ips, ipe, jps, jpe, kps, kpe
660	INTEGER :: domdesc
661	LOGICAL :: bdy_mask(4)
662	TYPE(ESMF_StateType) :: statetype
663	INTEGER :: itemCount, i
664	CHARACTER (ESMF_MAXSTR) :: statename
665	CHARACTER (ESMF_MAXSTR), ALLOCATABLE :: itemNames(:)
666	TYPE(ESMF_StateItemType), ALLOCATABLE :: itemTypes(:)
667
668	CALL wrf_debug ( 100, 'wrf_component_init2(): begin' )
669	! check exportState
670	CALL ESMF_StateGet( exportState, itemCount=itemCount, &
671	statetype=statetype, rc=rc )
672	IF ( rc /= ESMF_SUCCESS ) THEN
673	CALL wrf_error_fatal("wrf_component_init2: ESMF_StateGet(exportState) failed" )
674	ENDIF
675	WRITE (str,*) 'wrf_component_init2: exportState itemCount = ', itemCount
676	CALL wrf_debug ( 100 , TRIM(str) )
677	IF ( statetype /= ESMF_STATE_EXPORT ) THEN
678	CALL wrf_error_fatal("wrf_component_init2: exportState is not an export state" )
679	ENDIF
680	! check importState
681	CALL ESMF_StateGet( importState, itemCount=itemCount, &
682	statetype=statetype, rc=rc )
683	IF ( rc /= ESMF_SUCCESS ) THEN
684	CALL wrf_error_fatal("wrf_component_init2: ESMF_StateGet(importState) failed" )
685	ENDIF
686	WRITE (str,*) 'wrf_component_init2: importState itemCount = ', itemCount
687	CALL wrf_debug ( 100 , TRIM(str) )
688	IF ( statetype /= ESMF_STATE_IMPORT ) THEN
689	CALL wrf_error_fatal("wrf_component_init2: importState is not an import state" )
690	ENDIF
691
692	p_gcomp => gcomp
693	p_importState => importState
694	p_exportState => exportState
695	p_clock => clock
696	! NOTE: It will be possible to remove this call once ESMF supports
697	! interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
698	! ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
699	CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
700	exportState=p_exportState, clock=p_clock )
701
702	! populate ESMF import and export states
703	CALL wrf_state_populate( rc )
704	IF ( rc /= 0 ) THEN
705	CALL wrf_error_fatal ( 'wrf_component_init2: wrf_state_populate failed' )
706	ENDIF
707
708	! examine importState
709	WRITE (str,*) 'wrf_component_init2: EXAMINING importState...'
710	CALL wrf_debug ( 100 , TRIM(str) )
711	CALL ESMF_StateGet( importState, itemCount=itemCount, &
712	statetype=statetype, name=statename, rc=rc )
713	IF ( rc /= ESMF_SUCCESS ) THEN
714	CALL wrf_error_fatal("wrf_component_init2: ESMF_StateGet(importState) failed B" )
715	ENDIF
716	IF ( statetype /= ESMF_STATE_IMPORT ) THEN
717	CALL wrf_error_fatal("wrf_component_init2: importState is not an import state" )
718	ENDIF
719	WRITE (str,*) 'wrf_component_init2: importState <',TRIM(statename), &
720	'> itemCount = ', itemCount
721	CALL wrf_debug ( 100 , TRIM(str) )
722	ALLOCATE ( itemNames(itemCount), itemTypes(itemCount) )
723	CALL ESMF_StateGet( importState, itemNameList=itemNames, &
724	stateitemtypeList=itemTypes, rc=rc )
725	IF ( rc /= ESMF_SUCCESS ) THEN
726	CALL wrf_error_fatal("wrf_component_init2: ESMF_StateGet(importState) failed C" )
727	ENDIF
728	DO i=1, itemCount
729	IF ( itemTypes(i) == ESMF_STATEITEM_FIELD ) THEN
730	WRITE(str,*) 'wrf_component_init2: importState contains field <',TRIM(itemNames(i)),'>'
731	CALL wrf_debug ( 100 , TRIM(str) )
732	ENDIF
733	ENDDO
734	DEALLOCATE ( itemNames, itemTypes )
735	WRITE (str,*) 'wrf_component_init2: DONE EXAMINING importState...'
736	CALL wrf_debug ( 100 , TRIM(str) )
737
738	! examine exportState
739	WRITE (str,*) 'wrf_component_init2: EXAMINING exportState...'
740	CALL wrf_debug ( 100 , TRIM(str) )
741	CALL ESMF_StateGet( exportState, itemCount=itemCount, &
742	statetype=statetype, name=statename, rc=rc )
743	IF ( rc /= ESMF_SUCCESS ) THEN
744	CALL wrf_error_fatal("wrf_component_init2: ESMF_StateGet(exportState) failed B" )
745	ENDIF
746	IF ( statetype /= ESMF_STATE_EXPORT ) THEN
747	CALL wrf_error_fatal("wrf_component_init2: exportState is not an export state" )
748	ENDIF
749	WRITE (str,*) 'wrf_component_init2: exportState <',TRIM(statename), &
750	'> itemCount = ', itemCount
751	CALL wrf_debug ( 100 , TRIM(str) )
752	ALLOCATE ( itemNames(itemCount), itemTypes(itemCount) )
753	CALL ESMF_StateGet( exportState, itemNameList=itemNames, &
754	stateitemtypeList=itemTypes, rc=rc )
755	IF ( rc /= ESMF_SUCCESS ) THEN
756	CALL wrf_error_fatal("wrf_component_init2: ESMF_StateGet(exportState) failed C" )
757	ENDIF
758	DO i=1, itemCount
759	IF ( itemTypes(i) == ESMF_STATEITEM_FIELD ) THEN
760	WRITE(str,*) 'wrf_component_init2: exportState contains field <',TRIM(itemNames(i)),'>'
761	CALL wrf_debug ( 100 , TRIM(str) )
762	ENDIF
763	ENDDO
764	DEALLOCATE ( itemNames, itemTypes )
765	WRITE (str,*) 'wrf_component_init2: DONE EXAMINING exportState...'
766	CALL wrf_debug ( 100 , TRIM(str) )
767
768	CALL wrf_debug ( 100, 'DEBUG wrf_component_init2(): end' )
769
770	END SUBROUTINE wrf_component_init2
771
772
773
774	SUBROUTINE wrf_component_run( gcomp, importState, exportState, clock, rc )
775	TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
776	TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState
777	TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
778	INTEGER, INTENT( OUT) :: rc
779	!<DESCRIPTION>
780	! WRF component run routine.
781	!
782	! The arguments are:
783	! gcomp Component
784	! importState Importstate
785	! exportState Exportstate
786	! clock External clock
787	! rc Return code; equals ESMF_SUCCESS if there are no errors,
788	! otherwise ESMF_FAILURE.
789	!</DESCRIPTION>
790
791	! Local variables
792	TYPE(ESMF_GridComp), POINTER :: p_gcomp
793	TYPE(ESMF_State), POINTER :: p_importState
794	TYPE(ESMF_State), POINTER :: p_exportState
795	TYPE(ESMF_Clock), POINTER :: p_clock
796	! timing
797	TYPE(ESMF_Time) :: currentTime, nextTime
798	TYPE(ESMF_TimeInterval) :: runLength ! how long to run in this call
799	CHARACTER(LEN=256) :: timeStr
800
801	CALL wrf_debug ( 100 , 'DEBUG wrf_component_run(): begin' )
802
803	p_gcomp => gcomp
804	p_importState => importState
805	p_exportState => exportState
806	p_clock => clock
807	! NOTE: It will be possible to remove this call once ESMF supports
808	! interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
809	! ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
810	CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
811	exportState=p_exportState, clock=p_clock )
812
813	! connect ESMF clock with WRF domain clock
814	CALL ESMF_ClockGet( clock, currTime=currentTime, timeStep=runLength, rc=rc )
815	IF ( rc /= ESMF_SUCCESS ) THEN
816	CALL wrf_error_fatal ( 'wrf_component_run: ESMF_ClockGet failed' )
817	ENDIF
818	CALL wrf_clockprint(100, clock, &
819	'DEBUG wrf_component_run(): clock,')
820	nextTime = currentTime + runLength
821	head_grid%start_subtime = currentTime
822	head_grid%stop_subtime = nextTime
823	CALL wrf_timetoa ( head_grid%start_subtime, timeStr )
824	WRITE (str,*) 'wrf_component_run: head_grid%start_subtime ',TRIM(timeStr)
825	CALL wrf_debug ( 100 , TRIM(str) )
826	CALL wrf_timetoa ( head_grid%stop_subtime, timeStr )
827	WRITE (str,*) 'wrf_component_run: head_grid%stop_subtime ',TRIM(timeStr)
828	CALL wrf_debug ( 100 , TRIM(str) )
829
830	! Call WRF "run" routine
831	CALL wrf_debug ( 100 , 'DEBUG wrf_component_run(): calling wrf_run()' )
832	CALL wrf_run( )
833	CALL wrf_debug ( 100 , 'DEBUG wrf_component_run(): back from wrf_run()' )
834
835	CALL wrf_debug ( 100 , 'DEBUG wrf_component_run(): end' )
836
837	END SUBROUTINE wrf_component_run
838
839
840
841	SUBROUTINE wrf_component_finalize( gcomp, importState, exportState, clock, rc )
842	TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
843	TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState
844	TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
845	INTEGER, INTENT( OUT) :: rc
846	!<DESCRIPTION>
847	! WRF component finalize routine.
848	!
849	! The arguments are:
850	! gcomp Component
851	! importState Importstate
852	! exportState Exportstate
853	! clock External clock
854	! rc Return code; equals ESMF_SUCCESS if there are no errors,
855	! otherwise ESMF_FAILURE.
856	!</DESCRIPTION>
857
858	! Local variables
859	TYPE(ESMF_GridComp), POINTER :: p_gcomp
860	TYPE(ESMF_State), POINTER :: p_importState
861	TYPE(ESMF_State), POINTER :: p_exportState
862	TYPE(ESMF_Clock), POINTER :: p_clock
863	INTEGER :: rc
864	p_gcomp => gcomp
865	p_importState => importState
866	p_exportState => exportState
867	p_clock => clock
868	! NOTE: It will be possible to remove this call once ESMF supports
869	! interfaces ESMF_ClockGetCurrent(), ESMF_ImportStateGetCurrent(),
870	! ESMF_ExportStateGetCurrent(), and ESMF_GridCompGetCurrent().
871	CALL ESMF_SetCurrent( gcomp=p_gcomp, importState=p_importState, &
872	exportState=p_exportState, clock=p_clock )
873
874	! Call WRF "finalize" routine, suppressing call to MPI_FINALIZE so
875	! ESMF can do it (if needed) during ESMF_Finalize().
876	CALL wrf_finalize( no_shutdown=.TRUE. )
877
878	rc = ESMF_SUCCESS
879
880	END SUBROUTINE wrf_component_finalize
881
882
883
884	SUBROUTINE wrf_findCouplingInterval( startTime, stopTime, couplingInterval )
885	TYPE(ESMF_Time), INTENT(IN ) :: startTime
886	TYPE(ESMF_Time), INTENT(IN ) :: stopTime
887	TYPE(ESMF_TimeInterval), INTENT( OUT) :: couplingInterval
888	!<DESCRIPTION>
889	! WRF convenience routine for deducing coupling interval. The startTime
890	! and stopTime arguments are only used for determining a default value
891	! when coupling is not actually being done.
892	!
893	! The arguments are:
894	! startTime start time
895	! stopTime stop time
896	! couplingInterval coupling interval
897	!</DESCRIPTION>
898	! locals
899	LOGICAL :: foundcoupling
900	INTEGER :: rc
901	INTEGER :: io_form
902	! external function prototype
903	INTEGER, EXTERNAL :: use_package
904
905	! deduce coupling time-step
906	foundcoupling = .FALSE.
907	!TODO: This bit just finds the FIRST case and extracts coupling interval...
908	!TODO: Add error-checking for over-specification.
909	!TODO: Add support for multiple coupling intervals later...
910	!TODO: Add support for coupling that does not begin immediately later...
911	!TODO: Get rid of duplication once I/O refactoring is finished (and
912	!TODO: auxio streams can be addressed via index).
913
914	#include "med_find_esmf_coupling.inc"
915
916	! look for erroneous use of io_form...
917	CALL nl_get_io_form_restart( 1, io_form )
918	IF ( use_package( io_form ) == IO_ESMF ) THEN
919	CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ERROR: ESMF cannot be used for WRF restart I/O' )
920	ENDIF
921	CALL nl_get_io_form_input( 1, io_form )
922	IF ( use_package( io_form ) == IO_ESMF ) THEN
923	CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ERROR: ESMF cannot be used for WRF input' )
924	ENDIF
925	CALL nl_get_io_form_history( 1, io_form )
926	IF ( use_package( io_form ) == IO_ESMF ) THEN
927	CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ERROR: ESMF cannot be used for WRF history output' )
928	ENDIF
929	CALL nl_get_io_form_boundary( 1, io_form )
930	IF ( use_package( io_form ) == IO_ESMF ) THEN
931	CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ERROR: ESMF cannot be used for WRF boundary I/O' )
932	ENDIF
933
934	! If nobody uses IO_ESMF, then default is to run WRF all the way to
935	! the end.
936	IF ( .NOT. foundcoupling ) THEN
937	couplingInterval = stopTime - startTime
938	call wrf_debug ( 1, 'WARNING: ESMF coupling not used in this WRF run' )
939	ENDIF
940
941	END SUBROUTINE wrf_findCouplingInterval
942
943
944
945	SUBROUTINE wrf_getDecompInfo( ids, ide, jds, jde, kds, kde, &
946	ims, ime, jms, jme, kms, kme, &
947	ips, ipe, jps, jpe, kps, kpe, &
948	domdesc, bdy_mask )
949	INTEGER, INTENT(OUT) :: ids, ide, jds, jde, kds, kde
950	INTEGER, INTENT(OUT) :: ims, ime, jms, jme, kms, kme
951	INTEGER, INTENT(OUT) :: ips, ipe, jps, jpe, kps, kpe
952	INTEGER, INTENT(OUT) :: domdesc
953	LOGICAL, INTENT(OUT) :: bdy_mask(4)
954	!<DESCRIPTION>
955	! WRF convenience routine for deducing decomposition information.
956	!TODO: Note that domdesc is meaningful only for SPMD alternating event loops.
957	!TODO: For concurrent operation (SPMD or MPMD), we will need to create a new
958	!TODO: "domdesc" suitable for the task layout of the SST component. For
959	!TODO: MPMD alternating event loops, we will need to serialize domdesc and
960	!TODO: store it as metadata within the export state. Similar arguments apply
961	!TODO: to [ij][mp][se] and bdy_mask.
962	!
963	! The arguments are:
964	! ids, ide, jds, jde, kds, kde Domain extent.
965	! ims, ime, jms, jme, kms, kme Memory extent.
966	! ips, ipe, jps, jpe, kps, kpe Patch extent.
967	! domdesc Domain descriptor for external
968	! distributed-memory communication
969	! package (opaque to WRF).
970	! bdy_mask Boundary mask flags indicating which
971	! domain boundaries are on this task.
972	!</DESCRIPTION>
973	! extract decomposition information from head_grid
974	CALL get_ijk_from_grid( head_grid , &
975	ids, ide, jds, jde, kds, kde, &
976	ims, ime, jms, jme, kms, kme, &
977	ips, ipe, jps, jpe, kps, kpe )
978	#if 0
979	! JM
980	! with version 3 of ESMF's staggering concepts, WRF's non-staggered grid is equivalent to
981	! esmf's 'exclusive' region -- that is the set of points that are owned by the 'DE' (eyeroll)
982	! WRF, on the other hand, is returning the 'staggered' dimensions here. So convert to the
983	! unstaggered dims before returning.
984	! Don't bother with vertical dimension for the time being, since we're only doing 2D coupling.
985	!
986	ide = ide-1 ; ipe = MIN(ide,ipe)
987	jde = jde-1 ; jpe = MIN(jde,jpe)
988	#else
989	! JM
990	! with version 4 I have no damned clue at this writing... just random shots for now
991	! see if this works.
992	ipe = MIN(ide-1,ipe)
993	jpe = MIN(jde-1,jpe)
994	#endif
995
996	domdesc = head_grid%domdesc
997	bdy_mask = head_grid%bdy_mask
998	END SUBROUTINE wrf_getDecompInfo
999
1000
1001	SUBROUTINE wrf_state_populate( ierr )
1002	! Driver layer
1003	USE module_domain, ONLY : domain
1004	USE module_io_domain
1005	! Model layer
1006	USE module_configure, ONLY : grid_config_rec_type, model_to_grid_config_rec
1007	USE module_bc_time_utilities
1008
1009	IMPLICIT NONE
1010
1011	!<DESCRIPTION>
1012	! Populate WRF import and export states from Registry-generated code.
1013	! For now, only head_grid can be coupled.
1014	!
1015	!</DESCRIPTION>
1016	!TODO: Extend later to include child
1017	!TODO: domains, possibly via nested ESMF_State's.
1018
1019	! Arguments
1020	INTEGER, INTENT(OUT) :: ierr
1021	! Local
1022	TYPE(domain), POINTER :: grid
1023	TYPE(grid_config_rec_type) :: config_flags
1024	INTEGER :: stream, idum1, idum2, io_form
1025	CHARACTER*80 :: fname, n2
1026	! external function prototype
1027	INTEGER, EXTERNAL :: use_package
1028
1029	! for now support coupling to head_grid only
1030	grid => head_grid
1031	! TODO: Use actual grid via current_grid%id via something like this...
1032	! IF ( current_grid_set ) THEN
1033	! grid => current_grid
1034	! ELSE
1035	! ERROR
1036	! ENDIF
1037
1038	CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
1039	CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
1040
1041	stream = 0
1042	ierr = 0
1043
1044	#include "med_open_esmf_calls.inc"
1045
1046	END SUBROUTINE wrf_state_populate
1047
1048	END MODULE module_wrf_component_top
1049
1050
1051
1052	MODULE module_wrf_setservices
1053	!<DESCRIPTION>
1054	! This module defines WRF "Set Services" method wrf_register()
1055	! used for ESMF coupling.
1056	!</DESCRIPTION>
1057
1058	USE module_wrf_component_top, ONLY: wrf_component_init1, &
1059	wrf_component_init2, &
1060	wrf_component_run, &
1061	wrf_component_finalize
1062	USE ESMF_Mod
1063
1064	IMPLICIT NONE
1065
1066	! everything is private by default
1067	PRIVATE
1068
1069	! Public entry point for ESMF_GridCompSetServices()
1070	PUBLIC WRF_register
1071
1072	! private stuff
1073	CHARACTER (ESMF_MAXSTR) :: str
1074
1075	CONTAINS
1076
1077
1078	SUBROUTINE wrf_register(gcomp, rc)
1079	TYPE(ESMF_GridComp), INTENT(INOUT) :: gcomp
1080	INTEGER, INTENT(OUT) :: rc
1081	!
1082	!<DESCRIPTION>
1083	! WRF_register - Externally visible registration routine
1084	!
1085	! User-supplied SetServices routine.
1086	! The Register routine sets the subroutines to be called
1087	! as the init, run, and finalize routines. Note that these are
1088	! private to the module.
1089	!
1090	! The arguments are:
1091	! gcomp Component
1092	! rc Return code; equals ESMF_SUCCESS if there are no errors,
1093	! otherwise ESMF_FAILURE.
1094	!</DESCRIPTION>
1095
1096	rc = ESMF_SUCCESS
1097	! Register the callback routines.
1098	call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETINIT, &
1099	wrf_component_init1, 1, rc)
1100	IF ( rc /= ESMF_SUCCESS) THEN
1101	CALL wrf_error_fatal ( 'wrf_register: ESMF_GridCompSetEntryPoint(wrf_component_init1) failed' )
1102	ENDIF
1103	call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETINIT, &
1104	wrf_component_init2, 2, rc)
1105	IF ( rc /= ESMF_SUCCESS) THEN
1106	CALL wrf_error_fatal ( 'wrf_register: ESMF_GridCompSetEntryPoint(wrf_component_init2) failed' )
1107	ENDIF
1108	call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETRUN, &
1109	wrf_component_run, ESMF_SINGLEPHASE, rc)
1110	IF ( rc /= ESMF_SUCCESS) THEN
1111	CALL wrf_error_fatal ( 'wrf_register: ESMF_GridCompSetEntryPoint(wrf_component_run) failed' )
1112	ENDIF
1113	call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETFINAL, &
1114	wrf_component_finalize, ESMF_SINGLEPHASE, rc)
1115	IF ( rc /= ESMF_SUCCESS) THEN
1116	CALL wrf_error_fatal ( 'wrf_register: ESMF_GridCompSetEntryPoint(wrf_component_finalize) failed' )
1117	ENDIF
1118	PRINT *,'WRF: Registered Initialize, Run, and Finalize routines'
1119
1120	END SUBROUTINE wrf_register
1121
1122	END MODULE module_wrf_setservices
1123

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

Download in other formats:

Original Format