Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

wrf_SST_ESMF.F @ 3709

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

Line
1	!WRF:DRIVER_LAYER:MAIN
2	!
3
4	!<DESCRIPTION>
5	! ESMF Application Wrapper for coupling WRF with a "dummy" component
6	! that simply reads SSTs from a file, sends to WRF, receives SST from
7	! WRF (two-way coupling). and checks that the SSTs match.
8	!
9	! This file contains the main program and associated modules for the
10	! SST "dummy" component and a simple coupler. It creates ESMF Gridded
11	! and Coupler Components.
12	!
13	! This source file is only built when ESMF coupling is used.
14	!
15	!</DESCRIPTION>
16
17
18
19	!<DESCRIPTION>
20	! Modules module_sst_component_top and module_sst_setservices define the
21	! "SST" dummy component.
22	!</DESCRIPTION>
23
24	MODULE module_sst_component_top
25	!<DESCRIPTION>
26	! This module defines sst_component_init1(), sst_component_init2(),
27	! sst_component_run1(), sst_component_run2(), and sst_component_finalize()
28	! routines that are called when SST is run as an ESMF component.
29	!</DESCRIPTION>
30
31	USE ESMF_Mod
32	USE module_esmf_extensions
33	USE module_metadatautils, ONLY: AttachTimesToState
34
35
36	IMPLICIT NONE
37
38	! everything is private by default
39	PRIVATE
40
41	! Public entry points
42	PUBLIC sst_component_init1
43	PUBLIC sst_component_init2
44	PUBLIC sst_component_run1
45	PUBLIC sst_component_run2
46	PUBLIC sst_component_finalize
47
48	! private stuff
49	TYPE(ESMF_Grid), SAVE :: esmfgrid ! grid used in fields
50	CHARACTER (4096) :: str
51	INTEGER, SAVE :: fid ! file handle
52	! decomposition information
53	INTEGER, SAVE :: ids, ide, jds, jde, kds, kde
54	INTEGER, SAVE :: ims, ime, jms, jme, kms, kme
55	INTEGER, SAVE :: ips, ipe, jps, jpe, kps, kpe
56	!$$$here... change names to remove tmp_ ...
57	REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_out_sst(:,:)
58	REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_out_landmask(:,:)
59	REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_in_sst(:,:)
60	REAL(ESMF_KIND_R4), POINTER, SAVE :: tmp_data_in_landmask(:,:)
61	!$$$DEBUG
62	PUBLIC :: ids, ide, jds, jde, kds, kde
63	PUBLIC :: ims, ime, jms, jme, kms, kme
64	PUBLIC :: ips, ipe, jps, jpe, kps, kpe
65	!$$$END DEBUG
66	INTEGER, SAVE :: domdesc
67	LOGICAL, SAVE :: bdy_mask(4)
68	! MPI communicator, if needed
69	INTEGER, SAVE :: mpicom
70	! field data
71	REAL, POINTER, SAVE :: file_landmask_data(:,:), file_sst_data(:,:)
72	! input data file name
73	CHARACTER ( ESMF_MAXSTR ), SAVE :: sstinfilename
74	! field names
75	INTEGER, PARAMETER :: datacount = 2
76	INTEGER, PARAMETER :: SST_INDX = 1
77	INTEGER, PARAMETER :: LANDMASK_INDX = 2
78	CHARACTER(LEN=ESMF_MAXSTR), SAVE :: datanames(datacount)
79	TYPE real2d
80	REAL, POINTER :: r2d(:,:)
81	END TYPE real2d
82	TYPE(real2d) :: this_data(datacount)
83
84
85	CONTAINS
86
87
88
89	! First-phase "init" reads "SST" data file and returns "time" metadata in
90	! exportState.
91	SUBROUTINE sst_component_init1( gcomp, importState, exportState, clock, rc )
92	USE module_io
93	TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
94	TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState
95	TYPE(ESMF_State), TARGET, INTENT(INOUT) :: exportState
96	TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
97	INTEGER, INTENT( OUT) :: rc
98	!<DESCRIPTION>
99	! SST component init routine, phase 1.
100	!
101	! The arguments are:
102	! gcomp Component
103	! importState Importstate
104	! exportState Exportstate
105	! clock External clock
106	! rc Return code; equals ESMF_SUCCESS if there are no errors,
107	! otherwise ESMF_FAILURE.
108	!</DESCRIPTION>
109
110	#ifdef DM_PARALLEL
111	INCLUDE 'mpif.h'
112	#endif
113
114	! Local variables
115	CHARACTER (LEN=19) :: date_string
116	#ifdef DM_PARALLEL
117	TYPE(ESMF_VM) :: vm
118	INTEGER :: mpicomtmp
119	#endif
120	TYPE(ESMF_Time) :: startTime, stopTime, currentTime, dataTime
121	TYPE(ESMF_TimeInterval) :: timeStep
122	INTEGER :: ierr, num_steps, time_loop_max
123	INTEGER :: status_next_var
124
125	!$$$ For now, sstinfilename is hard-coded
126	!$$$ Upgrade to use a variant of construct_filename() via startTime
127	!$$$ extracted from clock.
128	sstinfilename = 'sstin_d01_000000'
129
130	! get MPI communicator out of current VM and duplicate (if needed)
131	#ifdef DM_PARALLEL
132	CALL ESMF_VMGetCurrent(vm, rc=rc)
133	IF ( rc /= ESMF_SUCCESS ) THEN
134	CALL wrf_error_fatal ( 'sst_component_init1: ESMF_VMGetCurrent failed' )
135	ENDIF
136	CALL ESMF_VMGet(vm, mpiCommunicator=mpicomtmp, rc=rc)
137	IF ( rc /= ESMF_SUCCESS ) THEN
138	CALL wrf_error_fatal ( 'sst_component_init1: ESMF_VMGet failed' )
139	ENDIF
140	CALL MPI_Comm_dup( mpicomtmp, mpicom, ierr )
141	#else
142	mpicom = 0
143	#endif
144	! Open the "SST" input data file for reading.
145	write(str,'(A,A)') 'Subroutine sst_component_init1: Opening data file ', &
146	TRIM(sstinfilename)
147	CALL wrf_message ( TRIM(str) )
148	CALL wrf_open_for_read ( TRIM(sstinfilename) , &
149	mpicom , &
150	mpicom , &
151	"DATASET=INPUT" , &
152	fid , &
153	ierr )
154	IF ( ierr .NE. 0 ) THEN
155	WRITE( str , FMT='(A,A,A,I8)' ) &
156	'subroutine sst_component_init1: error opening ', &
157	TRIM(sstinfilename),' for reading ierr=',ierr
158	CALL wrf_error_fatal ( TRIM(str) )
159	ENDIF
160	WRITE( str , FMT='(A,A,A,I8)' ) &
161	'subroutine sst_component_init1: opened file ', &
162	TRIM(sstinfilename),' for reading fid=',fid
163	CALL wrf_debug ( 100, TRIM(str) )
164
165	! How many data time levels are in the SST input file?
166	num_steps = -1
167	time_loop_max = 0
168	CALL wrf_debug ( 100, 'subroutine sst_component_init1: find time_loop_max' )
169	! compute SST start time, time step, and end time here
170	get_the_right_time : DO
171	CALL wrf_get_next_time ( fid, date_string, status_next_var )
172	write(str,'(A,A)') 'Subroutine sst_component_init1: SST data startTime: ', &
173	date_string
174	CALL wrf_debug ( 100 , TRIM(str) )
175	IF ( status_next_var == 0 ) THEN
176	IF ( time_loop_max == 0 ) THEN
177	CALL wrf_atotime( date_string, startTime )
178	ELSEIF ( time_loop_max == 1 ) THEN
179	! assumes fixed time step!
180	CALL wrf_atotime( date_string, dataTime )
181	timeStep = dataTime - startTime
182	ENDIF
183	time_loop_max = time_loop_max + 1
184	CALL wrf_atotime( date_string, stopTime )
185	ELSE
186	EXIT get_the_right_time
187	ENDIF
188	END DO get_the_right_time
189	CALL wrf_timetoa ( stopTime, date_string )
190	write(str,'(A,A)') 'Subroutine sst_component_init1: SST data stopTime: ', &
191	date_string
192	CALL wrf_debug ( 100 , TRIM(str) )
193	! attach times to exportState for use by driver
194	CALL AttachTimesToState( exportState, startTime, stopTime, timeStep )
195
196	! There should be a more elegant way to get to the beginning of the
197	! file, but this will do.
198	CALL wrf_ioclose( fid , ierr )
199	IF ( ierr .NE. 0 ) THEN
200	CALL wrf_error_fatal ( 'sst_component_init1: wrf_ioclose failed' )
201	ENDIF
202	WRITE( str , FMT='(A,I8)' ) &
203	'subroutine sst_component_init1: closed file fid=',fid
204	CALL wrf_debug ( 100, TRIM(str) )
205
206	! set up field names
207	!$$$ use CF conventions for "standard_name" once WRF Registry supports them
208	!$$$ datanames(SST_INDX) = "sea_surface_temperature"
209	!$$$ datanames(LANDMASK_INDX) = "land_binary_mask"
210	datanames(SST_INDX) = "SST"
211	datanames(LANDMASK_INDX) = "LANDMASK"
212
213	rc = ESMF_SUCCESS
214
215	END SUBROUTINE sst_component_init1
216
217
218
219	SUBROUTINE read_data( exportState, clock )
220	USE module_io
221	TYPE(ESMF_State), INTENT(INOUT) :: exportState
222	TYPE(ESMF_Clock), INTENT(IN ) :: clock
223	!<DESCRIPTION>
224	! Reads data from file and stores. Then
225	! stuffs the file data into the SST exportState.
226	!</DESCRIPTION>
227
228	#include <wrf_status_codes.h>
229	#include <wrf_io_flags.h>
230
231	! Local variables
232	CHARACTER (LEN=19) :: date_string
233	TYPE(ESMF_Time) :: currentTime, dataTime
234	REAL(ESMF_KIND_R4), POINTER :: out_sst_ptr(:,:), out_landmask_ptr(:,:)
235	TYPE(ESMF_Field) :: out_sst_field, out_landmask_field
236	TYPE(ESMF_Field) :: in_sst_field, in_landmask_field
237	INTEGER :: i, j
238	CHARACTER(LEN=ESMF_MAXSTR) :: fieldname, debugmsg, errormsg, timestr
239	INTEGER :: ierr
240	INTEGER :: rc
241
242	! This call to wrf_get_next_time will position the dataset over the next
243	! time-frame in the file and return the date_string, which is used as an
244	! argument to the read_field routines in the blocks of code included
245	! below.
246
247	CALL wrf_get_next_time( fid, date_string , ierr )
248	WRITE(str,'(A,A)') 'Subroutine read_data: SST data time: ', &
249	date_string
250	CALL wrf_debug ( 100 , TRIM(str) )
251	IF ( ierr .NE. 0 .AND. ierr .NE. WRF_WARN_NOTSUPPORTED .AND. &
252	ierr .NE. WRF_WARN_DRYRUN_READ ) THEN
253	CALL wrf_error_fatal ( "... May have run out of valid SST data ..." )
254	ELSE IF ( ierr .NE. WRF_WARN_NOTSUPPORTED .AND. &
255	ierr .NE. WRF_WARN_DRYRUN_READ) THEN
256	! check input time against current time (which will be start time at
257	! beginning)
258	CALL wrf_atotime( date_string, dataTime )
259	CALL ESMF_ClockGet( clock, CurrTime=currentTime, rc=rc )
260	IF (rc /= ESMF_SUCCESS) THEN
261	CALL wrf_error_fatal ( 'read_data: ESMF_ClockGet() failed' )
262	ENDIF
263	CALL wrf_clockprint(150, clock, &
264	'DEBUG read_data(): get currentTime from clock,')
265	IF ( dataTime .NE. currentTime ) THEN
266	CALL wrf_timetoa ( dataTime, timestr )
267	WRITE( errormsg , * )'Time in file: ',trim( timestr )
268	CALL wrf_message ( trim(errormsg) )
269	CALL wrf_timetoa ( currentTime, timestr )
270	WRITE( errormsg , * )'Time on domain: ',trim( timestr )
271	CALL wrf_message ( trim(errormsg) )
272	CALL wrf_error_fatal( &
273	"ERROR Time in input file not equal to time on domain ERROR" )
274	ENDIF
275	ENDIF
276
277	! doing this in a loop only works if staggering is the same for all fields
278	this_data(SST_INDX)%r2d => file_sst_data
279	this_data(LANDMASK_INDX)%r2d => file_landmask_data
280	DO i=1, datacount
281	fieldname = TRIM(datanames(i))
282	debugmsg = 'ext_read_field '//TRIM(fieldname)//' memorder XY'
283	errormsg = 'could not read '//TRIM(fieldname)//' data from file'
284	CALL wrf_ext_read_field ( &
285	fid , & ! DataHandle
286	date_string , & ! DateStr
287	TRIM(fieldname) , & ! Data Name
288	this_data(i)%r2d , & ! Field
289	WRF_REAL , & ! FieldType
290	mpicom , & ! Comm
291	mpicom , & ! I/O Comm
292	domdesc , & ! Domain descriptor
293	bdy_mask , & ! bdy_mask
294	'XY' , & ! MemoryOrder
295	'' , & ! Stagger
296	TRIM(debugmsg) , & ! Debug message
297	ids , (ide-1) , jds , (jde-1) , 1 , 1 , &
298	ims , ime , jms , jme , 1 , 1 , &
299	ips , MIN( (ide-1), ipe ) , jps , MIN( (jde-1), jpe ) , 1 , 1 , &
300	ierr )
301	IF (ierr /= 0) THEN
302	CALL wrf_error_fatal ( TRIM(errormsg) )
303	ENDIF
304	ENDDO
305
306	! stuff fields into exportState
307	!$$$ change this to Bundles, eventually
308	CALL ESMF_StateGetField( exportState, TRIM(datanames(SST_INDX)), &
309	out_sst_field, rc=rc )
310	IF (rc /= ESMF_SUCCESS) THEN
311	CALL wrf_error_fatal ( &
312	'could not find sea_surface_temperature field in exportState' )
313	ENDIF
314	CALL ESMF_StateGetField( exportState, TRIM(datanames(LANDMASK_INDX)), &
315	out_landmask_field, rc=rc )
316	IF (rc /= ESMF_SUCCESS) THEN
317	CALL wrf_error_fatal ( &
318	'could not find land_binary_mask field in exportState' )
319	ENDIF
320	CALL ESMF_FieldGetDataPointer( out_sst_field, out_sst_ptr, rc=rc )
321	IF (rc /= ESMF_SUCCESS) THEN
322	CALL wrf_error_fatal ( &
323	'could not find sea_surface_temperature data in sea_surface_temperature field' )
324	ENDIF
325	CALL ESMF_FieldGetDataPointer( out_landmask_field, out_landmask_ptr, rc=rc )
326	IF (rc /= ESMF_SUCCESS) THEN
327	CALL wrf_error_fatal ( &
328	'could not find land_binary_mask data in land_binary_mask field' )
329	ENDIF
330	! staggered starts/ends
331	DO j= jps , MIN( (jde-1), jpe )
332	DO i= ips , MIN( (ide-1), ipe )
333	out_sst_ptr(i,j) = file_sst_data(i,j)
334	out_landmask_ptr(i,j) = file_landmask_data(i,j)
335	ENDDO
336	ENDDO
337
338	END SUBROUTINE read_data
339
340
341
342
343	SUBROUTINE compare_data( importState, clock )
344	TYPE(ESMF_State), INTENT(INOUT) :: importState
345	!$$$ remove clock after debugging is finished
346	TYPE(ESMF_Clock), INTENT(INOUT) :: clock
347	!<DESCRIPTION>
348	! Gets data from coupler via importState
349	! and compares with data read from file and
350	! error-exits if they differ.
351	!
352	! The arguments are:
353	! importState Importstate
354	!</DESCRIPTION>
355
356	! Local variables
357	TYPE(ESMF_Field) :: in_sst_field, in_landmask_field
358	REAL(ESMF_KIND_R4), POINTER :: in_sst_ptr(:,:), in_landmask_ptr(:,:)
359	REAL, POINTER :: in_sst_ptr_real(:,:), in_landmask_ptr_real(:,:)
360	INTEGER :: i, j
361	INTEGER :: rc
362	LOGICAL :: landmask_ok, sst_ok
363	!$$$DEBUG
364	TYPE(ESMF_Time) :: currentTime
365	INTEGER, SAVE :: numtimes=0 ! track number of calls
366	CHARACTER(LEN=256) :: timestamp
367	!$$$END DEBUG
368
369	!$$$DEBUG
370	! count calls...
371	CALL ESMF_ClockGet( clock, CurrTime=currentTime, rc=rc )
372	IF (rc /= ESMF_SUCCESS) THEN
373	CALL wrf_error_fatal ( 'compare_data: ESMF_ClockGet() failed' )
374	ENDIF
375	CALL wrf_timetoa ( currentTime, timestamp )
376	numtimes = numtimes + 1
377	WRITE(str,*) 'SST compare_data: begin, numtimes = ',numtimes,' time = ',TRIM(timestamp)
378	CALL wrf_debug ( 100 , TRIM(str) )
379	!$$$END DEBUG
380
381	! extract data from the importState and compare with data from file
382	!$$$ change this to Bundles, eventually
383	CALL ESMF_StateGetField( importState, TRIM(datanames(SST_INDX)), &
384	in_sst_field, rc=rc )
385	IF (rc /= ESMF_SUCCESS) THEN
386	CALL wrf_error_fatal ( &
387	'could not extract sea_surface_temperature field from importState' )
388	ENDIF
389	CALL ESMF_StateGetField( importState, TRIM(datanames(LANDMASK_INDX)), &
390	in_landmask_field, rc=rc )
391	IF (rc /= ESMF_SUCCESS) THEN
392	CALL wrf_error_fatal ( &
393	'could not extract land_binary_mask field from importState' )
394	ENDIF
395	CALL ESMF_FieldGetDataPointer( in_sst_field, in_sst_ptr, rc=rc )
396	IF (rc /= ESMF_SUCCESS) THEN
397	CALL wrf_error_fatal ( &
398	'could not extract sea_surface_temperature data from sea_surface_temperature field' )
399	ENDIF
400	ALLOCATE( in_sst_ptr_real(ims:ime,jms:jme) )
401	WRITE( str,* ) 'compare_data, ips:ipe,jps:jpe = ', &
402	ips,':',ipe,',',jps,':',jpe, &
403	', in_sst_ptr(BOUNDS) = ', &
404	LBOUND(in_sst_ptr,1),':',UBOUND(in_sst_ptr,1),',', &
405	LBOUND(in_sst_ptr,2),':',UBOUND(in_sst_ptr,2)
406	CALL wrf_debug ( 100 , TRIM(str) )
407	DO j= jms, jme
408	DO i= ims, ime
409	in_sst_ptr_real(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging
410	ENDDO
411	ENDDO
412	in_sst_ptr_real(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe)) = &
413	in_sst_ptr(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe))
414	CALL ESMF_FieldGetDataPointer( in_landmask_field, in_landmask_ptr, rc=rc )
415	IF (rc /= ESMF_SUCCESS) THEN
416	CALL wrf_error_fatal ( &
417	'could not extract land_binary_mask data from land_binary_mask field' )
418	ENDIF
419	ALLOCATE( in_landmask_ptr_real(ims:ime,jms:jme) )
420	WRITE( str,* ) 'compare_data, ips:ipe,jps:jpe = ', &
421	ips,':',ipe,',',jps,':',jpe, &
422	', in_landmask_ptr(BOUNDS) = ', &
423	LBOUND(in_landmask_ptr,1),':',UBOUND(in_landmask_ptr,1),',', &
424	LBOUND(in_landmask_ptr,2),':',UBOUND(in_landmask_ptr,2)
425	CALL wrf_debug ( 100 , TRIM(str) )
426	DO j= jms, jme
427	DO i= ims, ime
428	in_landmask_ptr_real(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging
429	ENDDO
430	ENDDO
431	in_landmask_ptr_real(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe)) = &
432	in_landmask_ptr(ips:MIN((ide-1),ipe),jps:MIN((jde-1),jpe))
433
434	! compare LANDMASK...
435	landmask_ok = .TRUE.
436	! staggered starts/ends
437	LANDMASK_COMPARE : DO j= jps , MIN( (jde-1), jpe )
438	DO i= ips , MIN( (ide-1), ipe )
439	IF ( file_landmask_data(i,j) /= in_landmask_ptr_real(i,j) ) THEN
440	landmask_ok = .FALSE.
441	WRITE( str , * ) 'error landmask mismatch at (i,j) = (',i,',',j, &
442	'), values are',file_landmask_data(i,j),' and ', &
443	in_landmask_ptr_real(i,j)
444	EXIT LANDMASK_COMPARE
445	ENDIF
446	ENDDO
447	ENDDO LANDMASK_COMPARE
448	!$$$DEBUG
449	!CALL wrf_debug( 100, 'compare_data: writing DEBUG1_SSTcmp_FILE_LANDMASK_'//TRIM(timestamp) )
450	!OPEN( UNIT=985, FILE='DEBUG1_SSTcmp_FILE_LANDMASK_'//TRIM(timestamp), FORM='formatted' )
451	!WRITE (985,'(a)') 'LANDMASK'
452	!DO j = jps, MIN( (jde-1), jpe )
453	! DO i = ips, MIN( (ide-1), ipe )
454	! WRITE (985,*) '(',i,',',j,'): ',file_landmask_data(i,j)
455	! ENDDO
456	!ENDDO
457	!CLOSE (985)
458	!CALL wrf_debug( 100, 'compare_data: writing DEBUG1_SSTcmp_FROM_WRF_LANDMASK_'//TRIM(timestamp) )
459	!OPEN( UNIT=985, FILE='DEBUG1_SSTcmp_FROM_WRF_LANDMASK_'//TRIM(timestamp), FORM='formatted' )
460	!WRITE (985,'(a)') 'LANDMASK'
461	!DO j = jps, MIN( (jde-1), jpe )
462	! DO i = ips, MIN( (ide-1), ipe )
463	! WRITE (985,*) '(',i,',',j,'): ',in_landmask_ptr_real(i,j)
464	! ENDDO
465	!ENDDO
466	!CLOSE (985)
467	!$$$END DEBUG
468	IF ( landmask_ok ) THEN
469	WRITE(str,*) 'compare_data: LANDMASK compares OK'
470	CALL wrf_debug ( 100 , TRIM(str) )
471	ELSE
472	CALL wrf_error_fatal ( TRIM(str) )
473	ENDIF
474
475	! compare SST...
476	sst_ok = .TRUE.
477	! staggered starts/ends
478	SST_COMPARE : DO j= jps , MIN( (jde-1), jpe )
479	DO i= ips , MIN( (ide-1), ipe )
480	IF ( file_sst_data(i,j) /= in_sst_ptr_real(i,j) ) THEN
481	sst_ok = .FALSE.
482	WRITE( str , * ) 'error sst mismatch at (i,j) = (',i,',',j, &
483	'), values are',file_sst_data(i,j),' and ', &
484	in_sst_ptr_real(i,j)
485	EXIT SST_COMPARE
486	ENDIF
487	ENDDO
488	ENDDO SST_COMPARE
489	!$$$DEBUG
490	!CALL wrf_debug( 100, 'compare_data: writing DEBUG1_SSTcmp_FILE_SST_'//TRIM(timestamp) )
491	!OPEN( UNIT=985, FILE='DEBUG1_SSTcmp_FILE_SST_'//TRIM(timestamp), FORM='formatted' )
492	!WRITE (985,'(a)') 'SST'
493	!DO j = jps, MIN( (jde-1), jpe )
494	! DO i = ips, MIN( (ide-1), ipe )
495	! WRITE (985,*) '(',i,',',j,'): ',file_sst_data(i,j)
496	! ENDDO
497	!ENDDO
498	!CLOSE (985)
499	!CALL wrf_debug( 100, 'compare_data: writing DEBUG1_SSTcmp_FROM_WRF_SST_'//TRIM(timestamp) )
500	!OPEN( UNIT=985, FILE='DEBUG1_SSTcmp_FROM_WRF_SST_'//TRIM(timestamp), FORM='formatted' )
501	!WRITE (985,'(a)') 'SST'
502	!DO j = jps, MIN( (jde-1), jpe )
503	! DO i = ips, MIN( (ide-1), ipe )
504	! WRITE (985,*) '(',i,',',j,'): ',in_sst_ptr_real(i,j)
505	! ENDDO
506	!ENDDO
507	!CLOSE (985)
508	!$$$END DEBUG
509	IF ( sst_ok ) THEN
510	WRITE(str,*) 'compare_data: SST compares OK'
511	CALL wrf_debug ( 100 , TRIM(str) )
512	ELSE
513	CALL wrf_error_fatal ( TRIM(str) )
514	ENDIF
515
516	DEALLOCATE( in_sst_ptr_real, in_landmask_ptr_real )
517
518	!$$$DEBUG
519	WRITE(str,*) 'compare_data: end, numtimes = ',numtimes
520	CALL wrf_debug ( 100 , TRIM(str) )
521	!$$$END DEBUG
522
523	END SUBROUTINE compare_data
524
525
526
527
528	! Second-phase "init" gets decomposition information from
529	! importState.
530	SUBROUTINE sst_component_init2( gcomp, importState, exportState, clock, rc )
531	USE module_metadatautils, ONLY: GetDecompFromState
532	USE module_io
533	TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
534	TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState
535	TYPE(ESMF_State), TARGET, INTENT(INOUT) :: exportState
536	TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
537	INTEGER, INTENT( OUT) :: rc
538	!<DESCRIPTION>
539	! SST component init routine, phase 2.
540	!
541	! The arguments are:
542	! gcomp Component
543	! importState Importstate
544	! exportState Exportstate
545	! clock External clock
546	! rc Return code; equals ESMF_SUCCESS if there are no errors,
547	! otherwise ESMF_FAILURE.
548	!</DESCRIPTION>
549
550	! Local variables
551	TYPE(ESMF_RelLoc) :: horzRelloc
552	TYPE(ESMF_Field) :: out_sst_field, out_landmask_field
553	TYPE(ESMF_Field) :: in_sst_field, in_landmask_field
554	INTEGER, PARAMETER :: NUMDIMS=2
555	INTEGER :: DomainStart(NUMDIMS)
556	INTEGER :: DomainEnd(NUMDIMS)
557	INTEGER :: MemoryStart(NUMDIMS)
558	INTEGER :: MemoryEnd(NUMDIMS)
559	INTEGER :: PatchStart(NUMDIMS)
560	INTEGER :: PatchEnd(NUMDIMS)
561	INTEGER :: rc, i, j
562	INTEGER :: ierr
563
564	! Get decomposition information from importState. Note that index
565	! values are for staggered dimensions, following the WRF convention.
566	!$$$ TBH: Note that this will only work for SPMD serial operation. For
567	!$$$ TBH: concurrent operation (SPMD or MPMD), we will need to create a new
568	!$$$ TBH: "domdesc" suitable for the task layout of the SST component. For
569	!$$$ TBH: MPMD serial operation, we will need to extract serialized domdesc
570	!$$$ TBH: from export state metadata and de-serialize it. Similar arguments
571	!$$$ TBH: apply to [ij][mp][se] and bdy_mask.
572	write(str,*) 'sst_component_init2: calling GetDecompFromState'
573	CALL wrf_debug ( 100 , TRIM(str) )
574	CALL GetDecompFromState( importState, &
575	ids, ide, jds, jde, kds, kde, &
576	ims, ime, jms, jme, kms, kme, &
577	ips, ipe, jps, jpe, kps, kpe, &
578	domdesc, bdy_mask )
579	write(str,*) 'sst_component_init2: back from GetDecompFromState'
580	CALL wrf_debug ( 100 , TRIM(str) )
581	write(str,*) 'sst_component_init2: ids, ide, jds, jde, kds, kde = ', ids, ide, jds, jde, kds, kde
582	CALL wrf_debug ( 100 , TRIM(str) )
583	write(str,*) 'sst_component_init2: ims, ime, jms, jme, kms, kme = ', ims, ime, jms, jme, kms, kme
584	CALL wrf_debug ( 100 , TRIM(str) )
585	write(str,*) 'sst_component_init2: ips, ipe, jps, jpe, kps, kpe = ', ips, ipe, jps, jpe, kps, kpe
586	CALL wrf_debug ( 100 , TRIM(str) )
587
588	! allocate space for data read from disk
589	ALLOCATE( file_sst_data (ims:ime,jms:jme) )
590	DO j= jms, jme
591	DO i= ims, ime
592	file_sst_data(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging
593	ENDDO
594	ENDDO
595	!$$$ Hmmm... really need to load these pointers here? Check...
596	this_data(SST_INDX)%r2d => file_sst_data
597	ALLOCATE( file_landmask_data(ims:ime,jms:jme) )
598	DO j= jms, jme
599	DO i= ims, ime
600	file_landmask_data(i,j) = -(i*1000.0 + j)/100000.0 ! obvious bad value for debugging
601	ENDDO
602	ENDDO
603	this_data(LANDMASK_INDX)%r2d => file_landmask_data
604
605	! Create ESMF_Fields in importState and exportState
606	! Create ESMF_Grid. Use exactly the same method as WRF so WRFIO will
607	! work (ugh).
608	DomainStart(1) = ids; DomainEnd(1) = ide;
609	DomainStart(2) = jds; DomainEnd(2) = jde;
610	MemoryStart(1) = ims; MemoryEnd(1) = ime;
611	MemoryStart(2) = jms; MemoryEnd(2) = jme;
612	PatchStart(1) = ips; PatchEnd(1) = ipe;
613	PatchStart(2) = jps; PatchEnd(2) = jpe
614	CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: Calling ioesmf_create_grid_int()' )
615	CALL ioesmf_create_grid_int( esmfgrid, NUMDIMS, &
616	DomainStart, DomainEnd, &
617	MemoryStart, MemoryEnd, &
618	PatchStart, PatchEnd )
619	CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: back from ioesmf_create_grid_int()' )
620	! create ESMF_Fields
621	!$$$ use CF standard_names later
622	!$$$here... This is a complete HACK!! Need to communicate horzrelloc
623	!$$$here... during init sometime...
624	horzrelloc=ESMF_CELL_CENTER
625	! Note use of patch dimension for POINTERs allocated by ESMF.
626	CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: Calling ESMF_GridValidate(esmfgrid)' )
627	CALL ESMF_GridValidate( esmfgrid, rc=rc )
628	IF ( rc /= ESMF_SUCCESS ) THEN
629	WRITE( str,* ) 'Error in ESMF_GridValidate ', &
630	__FILE__ , &
631	', line ', &
632	__LINE__ , &
633	', error code = ',rc
634	! TBH: debugging error exit here...
635	CALL wrf_error_fatal ( TRIM(str) )
636	ENDIF
637	CALL wrf_debug ( 5 , 'DEBUG sst_component_init2: back OK from ESMF_GridValidate(esmfgrid)' )
638	!TBH ! let ESMF allocate tmp_data_out_sst
639	!TBH ! Note that ESMF will deallocate it when the internal ESMF_Array object
640	!TBH ! is explicitly destroyed. Assuming that we can figure out how to safely
641	!TBH ! destroy it!!! (And we have gone around and around on this one. @#$%!)
642	!BELAY THAT: do it ourselves for now...
643	ALLOCATE( tmp_data_out_sst(ips:ipe,jps:jpe) )
644	write(str,*) 'sst_component_init2: tmp_data_out_sst(', &
645	LBOUND(tmp_data_out_sst,1),':',UBOUND(tmp_data_out_sst,1),',',LBOUND(tmp_data_out_sst,2),':',UBOUND(tmp_data_out_sst,2),')'
646	CALL wrf_debug ( 100 , TRIM(str) )
647	CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(out_sst_field)' )
648	out_sst_field = ESMF_FieldCreate( &
649	esmfgrid, tmp_data_out_sst, &
650	copyflag=ESMF_DATA_REF, &
651	horzrelloc=horzrelloc, &
652	name=TRIM(datanames(SST_INDX)), &
653	! lbounds=(/ips,jps/), &
654	! ubounds=(/ipe,jpe/), &
655	rc=rc )
656	IF ( rc /= ESMF_SUCCESS ) THEN
657	WRITE( str,* ) 'ESMF_FieldCreate(out_sst_field) failed ', &
658	__FILE__ , &
659	', line ', &
660	__LINE__ , &
661	', error code = ',rc
662	CALL wrf_error_fatal ( TRIM(str) )
663	ENDIF
664	CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(out_sst_field)' )
665	write(str,*) 'sst_component_init2: ips:ipe,jps:jpe = ', &
666	ips,':',ipe,',',jps,':',jpe
667	CALL wrf_debug ( 100 , TRIM(str) )
668	! validate ESMF allocation
669	IF ( ( ips /= LBOUND(tmp_data_out_sst,1) ) .OR. ( ipe /= UBOUND(tmp_data_out_sst,1) ) .OR. &
670	( jps /= LBOUND(tmp_data_out_sst,2) ) .OR. ( jpe /= UBOUND(tmp_data_out_sst,2) ) ) THEN
671	WRITE( str,* ) 'ESMF_FieldCreate(out_sst_field) allocation failed ', &
672	__FILE__ , &
673	', line ', &
674	__LINE__ , &
675	', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, &
676	', tmp_data_out_sst(BOUNDS) = ',LBOUND(tmp_data_out_sst,1),':',UBOUND(tmp_data_out_sst,1),',', &
677	LBOUND(tmp_data_out_sst,2),':',UBOUND(tmp_data_out_sst,2)
678	CALL wrf_error_fatal ( TRIM(str) )
679	ENDIF
680	!TBH ! let ESMF allocate tmp_data_out_landmask
681	!TBH ! Note that ESMF will deallocate it when the internal ESMF_Array object
682	!TBH ! is explicitly destroyed. Assuming that we can figure out how to safely
683	!TBH ! destroy it!!! (And we have gone around and around on this one. @#$%!)
684	!BELAY THAT: do it ourselves for now...
685	ALLOCATE( tmp_data_out_landmask(ips:ipe,jps:jpe) )
686	write(str,*) 'sst_component_init2: tmp_data_out_landmask(', &
687	LBOUND(tmp_data_out_landmask,1),':',UBOUND(tmp_data_out_landmask,1),',',LBOUND(tmp_data_out_landmask,2),':',UBOUND(tmp_data_out_landmask,2),')'
688	CALL wrf_debug ( 100 , TRIM(str) )
689	CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(out_landmask_field)' )
690	out_landmask_field = ESMF_FieldCreate( &
691	esmfgrid, tmp_data_out_landmask, &
692	copyflag=ESMF_DATA_REF, &
693	horzrelloc=horzrelloc, &
694	name=TRIM(datanames(LANDMASK_INDX)), &
695	! lbounds=(/ips,jps/), &
696	! ubounds=(/ipe,jpe/), &
697	rc=rc )
698	IF ( rc /= ESMF_SUCCESS ) THEN
699	CALL wrf_error_fatal ( 'ESMF_FieldCreate(out_landmask_field) failed' )
700	ENDIF
701	CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(out_landmask_field)' )
702	! validate ESMF allocation
703	IF ( ( ips /= LBOUND(tmp_data_out_landmask,1) ) .OR. ( ipe /= UBOUND(tmp_data_out_landmask,1) ) .OR. &
704	( jps /= LBOUND(tmp_data_out_landmask,2) ) .OR. ( jpe /= UBOUND(tmp_data_out_landmask,2) ) ) THEN
705	WRITE( str,* ) 'ESMF_FieldCreate(out_landmask_field) allocation failed ', &
706	__FILE__ , &
707	', line ', &
708	__LINE__ , &
709	', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, &
710	', tmp_data_out_landmask(BOUNDS) = ',LBOUND(tmp_data_out_landmask,1),':',UBOUND(tmp_data_out_landmask,1),',', &
711	LBOUND(tmp_data_out_landmask,2),':',UBOUND(tmp_data_out_landmask,2)
712	CALL wrf_error_fatal ( TRIM(str) )
713	ENDIF
714	!TBH ! let ESMF allocate tmp_data_in_sst
715	!TBH ! Note that ESMF will deallocate it when the internal ESMF_Array object
716	!TBH ! is explicitly destroyed. Assuming that we can figure out how to safely
717	!TBH ! destroy it!!! (And we have gone around and around on this one. @#$%!)
718	!BELAY THAT: do it ourselves for now...
719	ALLOCATE( tmp_data_in_sst(ips:ipe,jps:jpe) )
720	write(str,*) 'sst_component_init2: tmp_data_in_sst(', &
721	LBOUND(tmp_data_in_sst,1),':',UBOUND(tmp_data_in_sst,1),',',LBOUND(tmp_data_in_sst,2),':',UBOUND(tmp_data_in_sst,2),')'
722	CALL wrf_debug ( 100 , TRIM(str) )
723	CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(in_sst_field)' )
724	in_sst_field = ESMF_FieldCreate( &
725	esmfgrid, tmp_data_in_sst, &
726	copyflag=ESMF_DATA_REF, &
727	horzrelloc=horzrelloc, &
728	name=TRIM(datanames(SST_INDX)), &
729	! lbounds=(/ips,jps/), &
730	! ubounds=(/ipe,jpe/), &
731	rc=rc )
732	IF ( rc /= ESMF_SUCCESS ) THEN
733	CALL wrf_error_fatal ( 'ESMF_FieldCreate(in_sst_field) failed' )
734	ENDIF
735	CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(in_sst_field)' )
736	! validate ESMF allocation
737	IF ( ( ips /= LBOUND(tmp_data_in_sst,1) ) .OR. ( ipe /= UBOUND(tmp_data_in_sst,1) ) .OR. &
738	( jps /= LBOUND(tmp_data_in_sst,2) ) .OR. ( jpe /= UBOUND(tmp_data_in_sst,2) ) ) THEN
739	WRITE( str,* ) 'ESMF_FieldCreate(in_sst_field) allocation failed ', &
740	__FILE__ , &
741	', line ', &
742	__LINE__ , &
743	', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, &
744	', tmp_data_in_sst(BOUNDS) = ',LBOUND(tmp_data_in_sst,1),':',UBOUND(tmp_data_in_sst,1),',', &
745	LBOUND(tmp_data_in_sst,2),':',UBOUND(tmp_data_in_sst,2)
746	CALL wrf_error_fatal ( TRIM(str) )
747	ENDIF
748	!TBH ! let ESMF allocate tmp_data_in_landmask
749	!TBH ! Note that ESMF will deallocate it when the internal ESMF_Array object
750	!TBH ! is explicitly destroyed. Assuming that we can figure out how to safely
751	!TBH ! destroy it!!! (And we have gone around and around on this one. @#$%!)
752	!BELAY THAT: do it ourselves for now...
753	ALLOCATE( tmp_data_in_landmask(ips:ipe,jps:jpe) )
754	write(str,*) 'sst_component_init2: tmp_data_in_landmask(', &
755	LBOUND(tmp_data_in_landmask,1),':',UBOUND(tmp_data_in_landmask,1),',',LBOUND(tmp_data_in_landmask,2),':',UBOUND(tmp_data_in_landmask,2),')'
756	CALL wrf_debug ( 100 , TRIM(str) )
757	CALL wrf_debug ( 100, 'sst_component_init2: calling ESMF_FieldCreate(in_landmask_field)' )
758	in_landmask_field = ESMF_FieldCreate( &
759	esmfgrid, tmp_data_in_landmask, &
760	copyflag=ESMF_DATA_REF, &
761	horzrelloc=horzrelloc, &
762	name=TRIM(datanames(LANDMASK_INDX)), &
763	! lbounds=(/ips,jps/), &
764	! ubounds=(/ipe,jpe/), &
765	rc=rc )
766	IF ( rc /= ESMF_SUCCESS ) THEN
767	CALL wrf_error_fatal ( 'ESMF_FieldCreate(in_landmask_field) failed' )
768	ENDIF
769	CALL wrf_debug ( 100, 'sst_component_init2: back from ESMF_FieldCreate(in_landmask_field)' )
770	! validate ESMF allocation
771	IF ( ( ips /= LBOUND(tmp_data_in_landmask,1) ) .OR. ( ipe /= UBOUND(tmp_data_in_landmask,1) ) .OR. &
772	( jps /= LBOUND(tmp_data_in_landmask,2) ) .OR. ( jpe /= UBOUND(tmp_data_in_landmask,2) ) ) THEN
773	WRITE( str,* ) 'ESMF_FieldCreate(in_landmask_field) allocation failed ', &
774	__FILE__ , &
775	', line ', &
776	__LINE__ , &
777	', ips:ipe,jps:jpe = ',ips,':',ipe,',',jps,':',jpe, &
778	', tmp_data_in_landmask(BOUNDS) = ',LBOUND(tmp_data_in_landmask,1),':',UBOUND(tmp_data_in_landmask,1),',', &
779	LBOUND(tmp_data_in_landmask,2),':',UBOUND(tmp_data_in_landmask,2)
780	CALL wrf_error_fatal ( TRIM(str) )
781	ENDIF
782
783	! attach ESMF_Field to importState
784	CALL ESMF_StateAddField( importState, in_sst_field, rc=rc )
785	IF ( rc /= ESMF_SUCCESS ) THEN
786	CALL wrf_error_fatal ( 'ESMF_StateAddField(in_sst_field) failed' )
787	ENDIF
788	CALL ESMF_StateAddField( importState, in_landmask_field, rc=rc )
789	IF ( rc /= ESMF_SUCCESS ) THEN
790	CALL wrf_error_fatal ( 'ESMF_StateAddField(in_landmask_field) failed' )
791	ENDIF
792	! attach ESMF_Field to exportState
793	CALL ESMF_StateAddField( exportState, out_sst_field, rc=rc )
794	IF ( rc /= ESMF_SUCCESS ) THEN
795	CALL wrf_error_fatal ( 'ESMF_StateAddField(out_sst_field) failed' )
796	ENDIF
797	CALL ESMF_StateAddField( exportState, out_landmask_field, rc=rc )
798	IF ( rc /= ESMF_SUCCESS ) THEN
799	CALL wrf_error_fatal ( 'ESMF_StateAddField(out_landmask_field) failed' )
800	ENDIF
801
802	! Open the "SST" input data file for reading.
803	write(str,'(A,A)') 'sst_component_init2: Opening data file ', &
804	TRIM(sstinfilename)
805	CALL wrf_message ( TRIM(str) )
806	CALL wrf_open_for_read ( TRIM(sstinfilename) , &
807	mpicom , &
808	mpicom , &
809	"DATASET=INPUT" , &
810	fid , &
811	ierr )
812	IF ( ierr .NE. 0 ) THEN
813	WRITE( str , FMT='(A,A,A,I8)' ) &
814	'sst_component_init2: error opening ', &
815	TRIM(sstinfilename),' for reading ierr=',ierr
816	CALL wrf_error_fatal ( TRIM(str) )
817	ENDIF
818	WRITE( str , FMT='(A,A,A,I8)' ) &
819	'subroutine sst_component_init2: opened file ', &
820	TRIM(sstinfilename),' for reading fid=',fid
821	CALL wrf_debug ( 100, TRIM(str) )
822
823	write(str,'(A)') 'sst_component_init2: returning rc=ESMF_SUCCESS'
824	CALL wrf_debug ( 100 , TRIM(str) )
825
826	rc = ESMF_SUCCESS
827
828	END SUBROUTINE sst_component_init2
829
830
831
832	SUBROUTINE sst_component_run1( gcomp, importState, exportState, clock, rc )
833	TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
834	TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState
835	TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
836	INTEGER, INTENT( OUT) :: rc
837	!<DESCRIPTION>
838	! SST component run routine, phase 1.
839	! Read "SST" data from file and stuff into exportState.
840	!
841	! The arguments are:
842	! gcomp Component
843	! importState Importstate
844	! exportState Exportstate
845	! clock External clock
846	! rc Return code; equals ESMF_SUCCESS if there are no errors,
847	! otherwise ESMF_FAILURE.
848	!</DESCRIPTION>
849
850	rc = ESMF_SUCCESS
851
852	! Get "SST" data from file and stuff it into exportState.
853	CALL read_data( exportState, clock )
854
855	END SUBROUTINE sst_component_run1
856
857
858
859	SUBROUTINE sst_component_run2( gcomp, importState, exportState, clock, rc )
860	TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
861	TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState
862	TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
863	INTEGER, INTENT( OUT) :: rc
864	!<DESCRIPTION>
865	! SST component run routine, phase 2.
866	! Get from importState, compare with file data, and error-exit
867	! if they differ... If they are the same, then
868	! stuff the file data into the exportState.
869	!
870	! The arguments are:
871	! gcomp Component
872	! importState Importstate
873	! exportState Exportstate
874	! clock External clock
875	! rc Return code; equals ESMF_SUCCESS if there are no errors,
876	! otherwise ESMF_FAILURE.
877	!</DESCRIPTION>
878
879	rc = ESMF_SUCCESS
880
881	! Get from importState, compare with file data, and error_exit
882	! if they differ...
883	! This works because WRF loads its exportState BEFORE integrating.
884	CALL wrf_clockprint ( 50, clock, 'sst_component_run2: clock before call to compare_data()' )
885	CALL compare_data( importState, clock )
886	CALL wrf_clockprint ( 50, clock, 'sst_component_run2: clock after call to compare_data()' )
887
888	END SUBROUTINE sst_component_run2
889
890
891
892	SUBROUTINE sst_component_finalize( gcomp, importState, exportState, clock, rc )
893	USE module_io
894	TYPE(ESMF_GridComp), TARGET, INTENT(INOUT) :: gcomp
895	TYPE(ESMF_State), TARGET, INTENT(INOUT) :: importState, exportState
896	TYPE(ESMF_Clock), TARGET, INTENT(INOUT) :: clock
897	INTEGER, INTENT( OUT) :: rc
898	!<DESCRIPTION>
899	! SST component finalize routine.
900	!
901	! The arguments are:
902	! gcomp Component
903	! importState Importstate
904	! exportState Exportstate
905	! clock External clock
906	! rc Return code; equals ESMF_SUCCESS if there are no errors,
907	! otherwise ESMF_FAILURE.
908	!</DESCRIPTION>
909
910	! Local variables
911	TYPE(ESMF_Field) :: tmp_field
912	INTEGER :: i, ierr
913
914	rc = ESMF_SUCCESS
915
916	! destroy ESMF_Fields and other "deep" objects created by this component
917	! note that this component relied on ESMF to allocate data pointers during
918	! calls to ESMF_FieldCreate() so it also expects ESMF to free these pointers
919	!$$$here... remove duplication
920	DO i=1, datacount
921	! destroy field in importState
922	CALL ESMF_StateGetField( importState, TRIM(datanames(i)), tmp_field, &
923	rc=rc )
924	IF (rc /= ESMF_SUCCESS) THEN
925	WRITE( str , * ) &
926	'sst_component_finalize: ESMF_StateGetField( importState,', &
927	TRIM(datanames(i)),') failed'
928	CALL wrf_error_fatal ( TRIM(str) )
929	ENDIF
930	CALL ESMF_FieldDestroy( tmp_field, rc=rc )
931	IF (rc /= ESMF_SUCCESS) THEN
932	WRITE( str , * ) &
933	'sst_component_finalize: ESMF_FieldDestroy( importState,', &
934	TRIM(datanames(i)),') failed'
935	CALL wrf_error_fatal ( TRIM(str) )
936	ENDIF
937	! destroy field in exportState
938	CALL ESMF_StateGetField( exportState, TRIM(datanames(i)), tmp_field, &
939	rc=rc )
940	IF (rc /= ESMF_SUCCESS) THEN
941	WRITE( str , * ) &
942	'sst_component_finalize: ESMF_StateGetField( exportState,', &
943	TRIM(datanames(i)),') failed'
944	CALL wrf_error_fatal ( TRIM(str) )
945	ENDIF
946	CALL ESMF_FieldDestroy( tmp_field, rc=rc )
947	IF (rc /= ESMF_SUCCESS) THEN
948	WRITE( str , * ) &
949	'sst_component_finalize: ESMF_FieldDestroy( exportState,', &
950	TRIM(datanames(i)),') failed'
951	CALL wrf_error_fatal ( TRIM(str) )
952	ENDIF
953	ENDDO
954
955	! deallocate space for data read from disk
956	DEALLOCATE( file_sst_data, file_landmask_data )
957
958	! close SST data file
959	WRITE( str , FMT='(A,I8)' ) &
960	'subroutine sst_component_finalize: closing file fid=',fid
961	CALL wrf_debug ( 100, TRIM(str) )
962	CALL wrf_ioclose( fid , ierr )
963	IF ( ierr .NE. 0 ) THEN
964	CALL wrf_error_fatal ( 'sst_component_finalize: wrf_ioclose failed' )
965	ENDIF
966
967	END SUBROUTINE sst_component_finalize
968
969
970	END MODULE module_sst_component_top
971
972
973
974
975	MODULE module_sst_setservices
976	!<DESCRIPTION>
977	! This module defines SST "Set Services" method sst_register()
978	! used for ESMF coupling.
979	!</DESCRIPTION>
980
981	USE module_sst_component_top, ONLY: sst_component_init1, &
982	sst_component_init2, &
983	sst_component_run1, &
984	sst_component_run2, &
985	sst_component_finalize
986	USE ESMF_Mod
987
988	IMPLICIT NONE
989
990	! everything is private by default
991	PRIVATE
992
993	! Public entry point for ESMF_GridCompSetServices()
994	PUBLIC SST_register
995
996	! private stuff
997	CHARACTER (ESMF_MAXSTR) :: str
998
999	CONTAINS
1000
1001
1002	SUBROUTINE sst_register(gcomp, rc)
1003	TYPE(ESMF_GridComp), INTENT(INOUT) :: gcomp
1004	INTEGER, INTENT(OUT) :: rc
1005	INTEGER :: finalrc
1006	!
1007	!<DESCRIPTION>
1008	! SST_register - Externally visible registration routine
1009	!
1010	! User-supplied SetServices routine.
1011	! The Register routine sets the subroutines to be called
1012	! as the init, run, and finalize routines. Note that these are
1013	! private to the module.
1014	!
1015	! The arguments are:
1016	! gcomp Component
1017	! rc Return code; equals ESMF_SUCCESS if there are no errors,
1018	! otherwise ESMF_FAILURE.
1019	!</DESCRIPTION>
1020
1021	finalrc = ESMF_SUCCESS
1022	! Register the callback routines.
1023	call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETINIT, &
1024	sst_component_init1, 1, rc)
1025	IF ( rc /= ESMF_SUCCESS) THEN
1026	WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_init1) failed with rc = ', rc
1027	CALL wrf_error_fatal ( TRIM(str) )
1028	ENDIF
1029	call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETINIT, &
1030	sst_component_init2, 2, rc)
1031	IF ( rc /= ESMF_SUCCESS) THEN
1032	WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_init2) failed with rc = ', rc
1033	CALL wrf_error_fatal ( TRIM(str) )
1034	ENDIF
1035	call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETRUN, &
1036	sst_component_run1, 1, rc)
1037	IF ( rc /= ESMF_SUCCESS) THEN
1038	WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_run1) failed with rc = ', rc
1039	CALL wrf_error_fatal ( TRIM(str) )
1040	ENDIF
1041	call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETRUN, &
1042	sst_component_run2, 2, rc)
1043	IF ( rc /= ESMF_SUCCESS) THEN
1044	WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_run2) failed with rc = ', rc
1045	CALL wrf_error_fatal ( TRIM(str) )
1046	ENDIF
1047	call ESMF_GridCompSetEntryPoint(gcomp, ESMF_SETFINAL, &
1048	sst_component_finalize, ESMF_SINGLEPHASE, rc)
1049	IF ( rc /= ESMF_SUCCESS) THEN
1050	WRITE(str,*) 'ESMF_GridCompSetEntryPoint(sst_component_finalize) failed with rc = ', rc
1051	CALL wrf_error_fatal ( TRIM(str) )
1052	ENDIF
1053
1054	PRINT *,'SST: Registered Initialize, Run, and Finalize routines'
1055
1056	rc = finalrc
1057
1058	END SUBROUTINE sst_register
1059
1060	END MODULE module_sst_setservices
1061
1062
1063
1064	!<DESCRIPTION>
1065	! Module module_wrfsst_coupler defines the
1066	! "WRF-SST" coupler component. It provides two-way coupling between
1067	! the "SST" and "WRF" components.
1068	! In its run routine it transfers data directly from the
1069	! SST Component's export state to the WRF Component's import state.
1070	! It also transfers data directly from the
1071	! WRF Component's export state to the SST Component's import state.
1072	!
1073	! This is derived from src/demo/coupled_flow/src/CouplerMod.F90
1074	! created by Nancy Collins and others on the ESMF Core Team.
1075	!
1076	!</DESCRIPTION>
1077
1078	MODULE module_wrfsst_coupler
1079
1080	USE ESMF_Mod
1081
1082	IMPLICIT NONE
1083
1084	! everything is private by default
1085	PRIVATE
1086
1087	! Public entry point
1088	PUBLIC WRFSSTCpl_register
1089
1090	! private data members
1091	! route handles and flags
1092	TYPE(ESMF_RouteHandle), SAVE :: fromWRF_rh, fromSST_rh
1093	LOGICAL, SAVE :: fromWRF_rh_ready = .FALSE.
1094	LOGICAL, SAVE :: fromSST_rh_ready = .FALSE.
1095	! field names
1096	INTEGER, PARAMETER :: datacount = 2
1097	INTEGER, PARAMETER :: SST_INDX = 1
1098	INTEGER, PARAMETER :: LANDMASK_INDX = 2
1099	CHARACTER(LEN=ESMF_MAXSTR), SAVE :: datanames(datacount)
1100	CHARACTER(LEN=ESMF_MAXSTR) :: str
1101
1102
1103	CONTAINS
1104
1105
1106	SUBROUTINE WRFSSTCpl_register(comp, rc)
1107	TYPE(ESMF_CplComp), INTENT(INOUT) :: comp
1108	INTEGER, INTENT(OUT) :: rc
1109	!
1110	!<DESCRIPTION>
1111	! WRFSSTCpl_register - Externally visible registration routine
1112	!
1113	! User-supplied SetServices routine.
1114	! The Register routine sets the subroutines to be called
1115	! as the init, run, and finalize routines. Note that these are
1116	! private to the module.
1117	!
1118	! The arguments are:
1119	! comp Component
1120	! rc Return code; equals ESMF_SUCCESS if there are no errors,
1121	! otherwise ESMF_FAILURE.
1122	!</DESCRIPTION>
1123
1124	! guilty until proven innocent
1125	rc = ESMF_FAILURE
1126
1127	! Register the callback routines.
1128
1129	call ESMF_CplCompSetEntryPoint(comp, ESMF_SETINIT, WRFSSTCpl_init, &
1130	ESMF_SINGLEPHASE, rc)
1131	IF ( rc /= ESMF_SUCCESS ) THEN
1132	CALL wrf_error_fatal ( 'ESMF_CplCompSetEntryPoint(WRFSSTCpl_init) failed' )
1133	ENDIF
1134	call ESMF_CplCompSetEntryPoint(comp, ESMF_SETRUN, WRFSSTCpl_run, &
1135	ESMF_SINGLEPHASE, rc)
1136	IF ( rc /= ESMF_SUCCESS ) THEN
1137	CALL wrf_error_fatal ( 'ESMF_CplCompSetEntryPoint(WRFSSTCpl_run) failed' )
1138	ENDIF
1139	call ESMF_CplCompSetEntryPoint(comp, ESMF_SETFINAL, WRFSSTCpl_final, &
1140	ESMF_SINGLEPHASE, rc)
1141	IF ( rc /= ESMF_SUCCESS ) THEN
1142	CALL wrf_error_fatal ( 'ESMF_CplCompSetEntryPoint(WRFSSTCpl_final) failed' )
1143	ENDIF
1144
1145	print *, "module_wrfsst_coupler: Registered Initialize, Run, and Finalize routines"
1146
1147	END SUBROUTINE WRFSSTCpl_register
1148
1149
1150	SUBROUTINE WRFSSTCpl_init(comp, importState, exportState, clock, rc)
1151	USE module_metadatautils, ONLY: AttachDecompToState, GetDecompFromState
1152	TYPE(ESMF_CplComp), INTENT(INOUT) :: comp
1153	TYPE(ESMF_State), INTENT(INOUT) :: importState, exportState
1154	TYPE(ESMF_Clock), INTENT(INOUT) :: clock
1155	INTEGER, INTENT(OUT) :: rc
1156	!<DESCRIPTION>
1157	! WRF-SST coupler component init routine. This simply passes needed
1158	! metadata from WRF to SST. Initialization of ESMF_RouteHandle objects
1159	! is handled later via lazy evaluation.
1160	!
1161	! The arguments are:
1162	! comp Component
1163	! importState Importstate
1164	! exportState Exportstate
1165	! clock External clock
1166	! rc Return code; equals ESMF_SUCCESS if there are no errors,
1167	! otherwise ESMF_FAILURE.
1168	!</DESCRIPTION>
1169
1170	! Local variables
1171	CHARACTER(ESMF_MAXSTR) :: importstatename
1172	! decomposition information
1173	INTEGER :: ids, ide, jds, jde, kds, kde
1174	INTEGER :: ims, ime, jms, jme, kms, kme
1175	INTEGER :: ips, ipe, jps, jpe, kps, kpe
1176	INTEGER :: domdesc
1177	LOGICAL :: bdy_mask(4)
1178
1179	PRINT *, "DEBUG: Coupler Init starting"
1180
1181	! guilty until proven innocent
1182	rc = ESMF_FAILURE
1183
1184	CALL ESMF_StateGet(importState, name=importstatename, rc=rc)
1185	IF ( rc /= ESMF_SUCCESS ) THEN
1186	CALL wrf_error_fatal ( 'WRFSSTCpl_init: ESMF_StateGet failed' )
1187	ENDIF
1188
1189	IF ( TRIM(importstatename) .EQ. "WRF Export State" ) THEN
1190	! get metadata from WRF export state
1191	CALL GetDecompFromState( importState, &
1192	ids, ide, jds, jde, kds, kde, &
1193	ims, ime, jms, jme, kms, kme, &
1194	ips, ipe, jps, jpe, kps, kpe, &
1195	domdesc, bdy_mask )
1196	! put metadata from in SST import state
1197	CALL AttachDecompToState( exportState, &
1198	ids, ide, jds, jde, kds, kde, &
1199	ims, ime, jms, jme, kms, kme, &
1200	ips, ipe, jps, jpe, kps, kpe, &
1201	domdesc, bdy_mask )
1202
1203
1204	ELSE
1205	CALL wrf_error_fatal ( 'WRFSSTCpl_init: invalid importState name' )
1206	ENDIF
1207
1208	! set up field names
1209	!$$$ use CF conventions for "standard_name" once WRF Registry supports them
1210	!$$$ datanames(SST_INDX) = "sea_surface_temperature"
1211	!$$$ datanames(LANDMASK_INDX) = "land_binary_mask"
1212	datanames(SST_INDX) = "SST"
1213	datanames(LANDMASK_INDX) = "LANDMASK"
1214
1215	PRINT *, "DEBUG: Coupler Init returning"
1216
1217	END SUBROUTINE WRFSSTCpl_init
1218
1219
1220
1221	SUBROUTINE WRFSSTCpl_run(comp, importState, exportState, clock, rc)
1222	!$$$DEBUG
1223	! get ips,ipe, ... from this hack for debugging
1224	USE module_sst_component_top
1225	!$$$END DEBUG
1226	TYPE(ESMF_CplComp), INTENT(INOUT) :: comp
1227	TYPE(ESMF_State), INTENT(INOUT) :: importState, exportState
1228	TYPE(ESMF_Clock), INTENT(INOUT) :: clock
1229	INTEGER, INTENT(OUT) :: rc
1230	!<DESCRIPTION>
1231	! WRF-SST coupler component run routine.
1232	!
1233	! The arguments are:
1234	! comp Component
1235	! importState Importstate
1236	! exportState Exportstate
1237	! clock External clock
1238	! rc Return code; equals ESMF_SUCCESS if there are no errors,
1239	! otherwise ESMF_FAILURE.
1240	!</DESCRIPTION>
1241
1242	! Local variables
1243	TYPE(ESMF_Field) :: src_field, dst_field
1244	TYPE(ESMF_RouteHandle) :: routehandle
1245	TYPE(ESMF_VM) :: vm
1246	LOGICAL :: build_fromWRF_rh, build_fromSST_rh, fromWRF
1247	CHARACTER(LEN=ESMF_MAXSTR) :: importStatename
1248	CHARACTER(LEN=ESMF_MAXSTR) :: SST_exportStatename, WRF_exportStatename
1249	INTEGER :: i
1250	!$$$DEBUG
1251	TYPE(ESMF_Time) :: currentTime
1252	CHARACTER(LEN=256) :: timestamp, directionString
1253	INTEGER :: ii, jj
1254	REAL(ESMF_KIND_R4), POINTER :: tmp_data_ptr(:,:)
1255	!$$$END DEBUG
1256
1257	WRITE(str,*) 'WRFSSTCpl_run: begin'
1258	CALL wrf_debug ( 100 , TRIM(str) )
1259
1260	!$$$DEBUG
1261	CALL ESMF_ClockGet( clock, CurrTime=currentTime, rc=rc )
1262	IF (rc /= ESMF_SUCCESS) THEN
1263	CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_ClockGet() failed' )
1264	ENDIF
1265	CALL wrf_timetoa ( currentTime, timestamp )
1266	!$$$END DEBUG
1267
1268	! guilty until proven innocent
1269	rc = ESMF_FAILURE
1270
1271	! Which way is this coupling going?
1272	WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_StateGet(importState,name,...)'
1273	CALL wrf_debug ( 100 , TRIM(str) )
1274	CALL ESMF_StateGet( importState, name=importStatename, rc=rc )
1275	IF ( rc /= ESMF_SUCCESS ) THEN
1276	CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_StateGet(importState,name,...) failed' )
1277	ENDIF
1278	WRITE(str,*) 'WRFSSTCpl_run: back from ESMF_StateGet, importStatename = <',TRIM(importStatename),'>'
1279	CALL wrf_debug ( 100 , TRIM(str) )
1280
1281	! first time through in each direction: create route handle and
1282	! associated objects
1283	WRF_exportStatename = "WRF Export State"
1284	SST_exportStatename = "SST Export State"
1285	IF ( TRIM(importStatename) .EQ. TRIM(WRF_exportStatename) ) THEN
1286	fromWRF = .TRUE.
1287	directionString = 'WRFtoSST'
1288	ELSE IF ( TRIM(importStatename) .EQ. TRIM(SST_exportStatename) ) THEN
1289	fromWRF = .FALSE.
1290	directionString = 'SSTtoWRF'
1291	ELSE
1292	CALL wrf_error_fatal ( 'WRFSSTCpl_run: invalid importState name' )
1293	ENDIF
1294	WRITE(str,*) 'WRFSSTCpl_run: fromWRF = ',fromWRF
1295	CALL wrf_debug ( 100 , TRIM(str) )
1296	build_fromWRF_rh = fromWRF .AND. ( .NOT. fromWRF_rh_ready )
1297	build_fromSST_rh = ( .NOT. fromWRF ) .AND. ( .NOT. fromSST_rh_ready )
1298	WRITE(str,*) 'WRFSSTCpl_run: build_fromWRF_rh = ',build_fromWRF_rh
1299	CALL wrf_debug ( 100 , TRIM(str) )
1300	WRITE(str,*) 'WRFSSTCpl_run: build_fromSST_rh = ',build_fromSST_rh
1301	CALL wrf_debug ( 100 , TRIM(str) )
1302	IF ( build_fromWRF_rh .OR. build_fromSST_rh ) THEN
1303	CALL ESMF_CplCompGet( comp, vm=vm, rc=rc )
1304	IF ( rc /= ESMF_SUCCESS ) THEN
1305	CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_CplCompGet failed' )
1306	ENDIF
1307	! The use of literal index "1" here indicates that we don't care which
1308	! ESMF_Field we get so we might as well get the first one.
1309	!$$$ Right now, staggering of all fields is identical. Do we need more than one
1310	!$$$ routeHandle if there is more than one staggering?
1311	WRITE(str,*) 'WRFSSTCpl_run: grabbing first field <',TRIM(datanames(1)), &
1312	'> from import state'
1313	CALL wrf_debug ( 100 , TRIM(str) )
1314	CALL ESMF_StateGetField( importState, TRIM(datanames(1)), src_field, &
1315	rc=rc )
1316	IF ( rc /= ESMF_SUCCESS ) THEN
1317	CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_StateGetField(importState) failed' )
1318	ENDIF
1319	WRITE(str,*) 'WRFSSTCpl_run: grabbing first field <',TRIM(datanames(1)), &
1320	'> from export state'
1321	CALL wrf_debug ( 100 , TRIM(str) )
1322	CALL ESMF_StateGetField( exportState, TRIM(datanames(1)), dst_field, &
1323	rc=rc )
1324	IF ( rc /= ESMF_SUCCESS ) THEN
1325	CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_StateGetField(exportState) failed' )
1326	ENDIF
1327	IF ( build_fromWRF_rh ) THEN
1328	WRITE(str,*) 'WRFSSTCpl_run: creating fromWRF_rh'
1329	CALL wrf_debug ( 100 , TRIM(str) )
1330	fromWRF_rh = ESMF_RouteHandleCreate( rc )
1331	IF ( rc /= ESMF_SUCCESS ) THEN
1332	CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_RouteHandleCreate(fromWRF_rh) failed' )
1333	ENDIF
1334	WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_FieldRedistStore(fromWRF_rh)'
1335	CALL wrf_debug ( 100 , TRIM(str) )
1336	CALL ESMF_FieldRedistStore( src_field, dst_field, vm, &
1337	routehandle=fromWRF_rh, rc=rc )
1338	IF ( rc /= ESMF_SUCCESS ) THEN
1339	CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_FieldRedistStore(fromWRF_rh) failed' )
1340	ENDIF
1341	fromWRF_rh_ready = .TRUE.
1342	ENDIF
1343	IF ( build_fromSST_rh ) THEN
1344	WRITE(str,*) 'WRFSSTCpl_run: creating fromSST_rh'
1345	CALL wrf_debug ( 100 , TRIM(str) )
1346	fromSST_rh = ESMF_RouteHandleCreate( rc )
1347	IF ( rc /= ESMF_SUCCESS ) THEN
1348	CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_RouteHandleCreate(fromSST_rh) failed' )
1349	ENDIF
1350	WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_FieldRedistStore(fromSST_rh)'
1351	CALL wrf_debug ( 100 , TRIM(str) )
1352	CALL ESMF_FieldRedistStore( src_field, dst_field, vm, &
1353	routehandle=fromSST_rh, rc=rc )
1354	IF ( rc /= ESMF_SUCCESS ) THEN
1355	CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_FieldRedistStore(fromSST_rh) failed' )
1356	ENDIF
1357	fromSST_rh_ready = .TRUE.
1358	ENDIF
1359	DO i=1, datacount
1360	WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_StateSetNeeded(importState, ',TRIM(datanames(i)),')'
1361	CALL wrf_debug ( 100 , TRIM(str) )
1362	CALL ESMF_StateSetNeeded( importState, TRIM(datanames(i)), &
1363	ESMF_NEEDED, rc=rc )
1364	IF ( rc /= ESMF_SUCCESS ) THEN
1365	WRITE(str,*) 'WRFSSTCpl_run: ESMF_StateSetNeeded(',TRIM(datanames(i)),') failed'
1366	CALL wrf_error_fatal ( str )
1367	ENDIF
1368	ENDDO
1369	ENDIF
1370
1371	! In this case, the coupling is symmetric - you call redist going
1372	! both ways - so we only care about the coupling direction in order
1373	! to get the right routehandle selected.
1374	IF ( fromWRF ) THEN
1375	WRITE(str,*) 'WRFSSTCpl_run: routehandle = fromWRF_rh'
1376	CALL wrf_debug ( 100 , TRIM(str) )
1377	routehandle = fromWRF_rh
1378	ELSE
1379	WRITE(str,*) 'WRFSSTCpl_run: routehandle = fromSST_rh'
1380	CALL wrf_debug ( 100 , TRIM(str) )
1381	routehandle = fromSST_rh
1382	ENDIF
1383
1384	DO i=1, datacount
1385	WRITE(str,*) 'WRFSSTCpl_run: grabbing field <',TRIM(datanames(i)),'>'
1386	CALL wrf_debug ( 100 , TRIM(str) )
1387	! check isneeded flag here
1388	IF ( .NOT. ESMF_StateIsNeeded( importState, TRIM(datanames(i)), rc=rc ) ) THEN
1389	IF ( rc /= ESMF_SUCCESS ) THEN
1390	WRITE(str,*) 'WRFSSTCpl_run: ESMF_StateIsNeeded(',TRIM(datanames(i)),') failed'
1391	CALL wrf_error_fatal ( str )
1392	ENDIF
1393	WRITE(str,*) 'WRFSSTCpl_run: skipping field <',TRIM(datanames(i)),'>'
1394	CALL wrf_debug ( 100 , TRIM(str) )
1395	CYCLE
1396	ENDIF
1397
1398	WRITE(str,*) 'WRFSSTCpl_run: processing field <',TRIM(datanames(i)),'>'
1399	CALL wrf_debug ( 100 , TRIM(str) )
1400
1401	! The following piece of code provides an example of calling the data
1402	! redistribution routine between two Fields in the Coupler Component.
1403	! Unlike regrid, which translates between
1404	! different Grids, redist translates between different DELayouts on
1405	! the same Grid. The first two lines get the Fields from the
1406	! States, each corresponding to a different subcomponent. One is
1407	! an Export State and the other is an Import State.
1408	!
1409	WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_StateGetField(importState,', &
1410	TRIM(datanames(i)),')...'
1411	CALL wrf_debug ( 100 , TRIM(str) )
1412	CALL ESMF_StateGetField( importState, TRIM(datanames(i)), src_field, &
1413	rc=rc )
1414	IF ( rc /= ESMF_SUCCESS ) THEN
1415	WRITE(str,*) 'WRFSSTCpl_run: ESMF_StateGetField(importState,', &
1416	TRIM(datanames(i)),') failed'
1417	CALL wrf_error_fatal ( str )
1418	ENDIF
1419
1420	!$$$$ debugging...
1421	!$$$ CALL ESMF_CplCompRun(compCplWRFSST, exportStateSST, &
1422	!$$$ importStateWRF, driverClock, rc=rc)
1423	!$$$ Why is LANDMASK not on importStateWRF? May be moot now due to fix in Registry...
1424
1425	WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_StateGetField(exportState,', &
1426	TRIM(datanames(i)),')...'
1427	CALL wrf_debug ( 100 , TRIM(str) )
1428	CALL ESMF_StateGetField( exportState, TRIM(datanames(i)), dst_field, &
1429	rc=rc )
1430	IF ( rc /= ESMF_SUCCESS ) THEN
1431	WRITE(str,*) 'WRFSSTCpl_run: ESMF_StateGetField(exportState,', &
1432	TRIM(datanames(i)),') failed'
1433	CALL wrf_error_fatal ( str )
1434	ENDIF
1435
1436	! The redist routine uses information contained in the Fields and the
1437	! Coupler VM object to call the communication routines to move the data.
1438	! Because many Fields may share the same Grid association, the same
1439	! routing information may be needed repeatedly. Route information is
1440	! saved so the precomputed information can be retained. The following
1441	! is an example of a Field redist call:
1442	!$$$DEBUG
1443	!CALL wrf_debug ( 100, 'WRFSSTCpl_run '//TRIM(directionString)//': calling ESMF_FieldPrint( src_field )' )
1444	!CALL ESMF_FieldPrint( src_field, rc=rc )
1445	!CALL wrf_debug ( 100, 'WRFSSTCpl_run '//TRIM(directionString)//': back from ESMF_FieldPrint( src_field )' )
1446	!CALL ESMF_FieldGetDataPointer( src_field, tmp_data_ptr, rc=rc )
1447	!IF (rc /= ESMF_SUCCESS) THEN
1448	! WRITE(str,*) 'WRFSSTCpl_run '//TRIM(directionString)//': ESMF_FieldGetDataPointer( src_field, '//TRIM(datanames(i))//' ) returned rc = ',rc
1449	! CALL wrf_debug ( 100 , TRIM(str) )
1450	! CALL wrf_error_fatal ( &
1451	! 'WRFSSTCpl_run '//TRIM(directionString)//': ESMF_FieldGetDataPointer( src_field, ... ) failed' )
1452	!ENDIF
1453	!CALL wrf_debug( 100, 'WRFSSTCpl_run: writing DEBUG1_CPLcmp_src_'//TRIM(directionString)//'_'//TRIM(datanames(i))//'_'//TRIM(timestamp) )
1454	!OPEN( UNIT=985, FILE='DEBUG1_CPLcmp_src_'//TRIM(directionString)//'_'//TRIM(datanames(i))//'_'//TRIM(timestamp), FORM='formatted' )
1455	!WRITE (985,'(a)') TRIM(datanames(i))
1456	!DO jj = jps, MIN( (jde-1), jpe )
1457	! DO ii = ips, MIN( (ide-1), ipe )
1458	! WRITE (985,*) '(',ii,',',jj,'): ',tmp_data_ptr(ii,jj)
1459	! ENDDO
1460	!ENDDO
1461	!CLOSE (985)
1462	!$$$END DEBUG
1463	WRITE(str,*) 'WRFSSTCpl_run: calling ESMF_FieldRedist for <', &
1464	TRIM(datanames(i)),'>...'
1465	CALL wrf_debug ( 100 , TRIM(str) )
1466	CALL ESMF_FieldRedist( src_field, dst_field, routehandle, rc=rc )
1467	IF ( rc /= ESMF_SUCCESS ) THEN
1468	CALL wrf_error_fatal ( 'WRFSSTCpl_run: ESMF_FieldRedist failed' )
1469	ENDIF
1470	WRITE(str,*) 'WRFSSTCpl_run: back from ESMF_FieldRedist for <', &
1471	TRIM(datanames(i)),'>...'
1472	CALL wrf_debug ( 100 , TRIM(str) )
1473	!$$$DEBUG
1474	!CALL wrf_debug ( 100, 'WRFSSTCpl_run '//TRIM(directionString)//': calling ESMF_FieldPrint( dst_field )' )
1475	!CALL ESMF_FieldPrint( dst_field, rc=rc )
1476	!CALL wrf_debug ( 100, 'WRFSSTCpl_run '//TRIM(directionString)//': back from ESMF_FieldPrint( dst_field )' )
1477	!CALL ESMF_FieldGetDataPointer( dst_field, tmp_data_ptr, rc=rc )
1478	!IF (rc /= ESMF_SUCCESS) THEN
1479	! WRITE(str,*) 'WRFSSTCpl_run '//TRIM(directionString)//': ESMF_FieldGetDataPointer( dst_field, '//TRIM(datanames(i))//' ) returned rc = ',rc
1480	! CALL wrf_debug ( 100 , TRIM(str) )
1481	! CALL wrf_error_fatal ( &
1482	! 'WRFSSTCpl_run '//TRIM(directionString)//': ESMF_FieldGetDataPointer( dst_field, ... ) failed' )
1483	!ENDIF
1484	!CALL wrf_debug( 100, 'WRFSSTCpl_run: writing DEBUG1_CPLcmp_dst_'//TRIM(directionString)//'_'//TRIM(datanames(i))//'_'//TRIM(timestamp) )
1485	!OPEN( UNIT=985, FILE='DEBUG1_CPLcmp_dst_'//TRIM(directionString)//'_'//TRIM(datanames(i))//'_'//TRIM(timestamp), FORM='formatted' )
1486	!WRITE (985,'(a)') TRIM(datanames(i))
1487	!DO jj = jps, MIN( (jde-1), jpe )
1488	! DO ii = ips, MIN( (ide-1), ipe )
1489	! WRITE (985,*) '(',ii,',',jj,'): ',tmp_data_ptr(ii,jj)
1490	! ENDDO
1491	!ENDDO
1492	!CLOSE (985)
1493	!$$$END DEBUG
1494
1495	ENDDO
1496
1497	WRITE(str,*) 'WRFSSTCpl_run: end'
1498	CALL wrf_debug ( 100 , TRIM(str) )
1499
1500	END SUBROUTINE WRFSSTCpl_run
1501
1502
1503
1504	SUBROUTINE WRFSSTCpl_final(comp, importState, exportState, clock, rc)
1505	TYPE(ESMF_CplComp) :: comp
1506	TYPE(ESMF_State), INTENT(INOUT) :: importState, exportState
1507	TYPE(ESMF_Clock), INTENT(INOUT) :: clock
1508	INTEGER, INTENT(OUT) :: rc
1509	!<DESCRIPTION>
1510	! WRF-SST coupler component finalize routine.
1511	!
1512	! The arguments are:
1513	! comp Component
1514	! importState Importstate
1515	! exportState Exportstate
1516	! clock External clock
1517	! rc Return code; equals ESMF_SUCCESS if there are no errors,
1518	! otherwise ESMF_FAILURE.
1519	!</DESCRIPTION>
1520
1521	PRINT *, "DEBUG: Coupler Final starting"
1522
1523	! guilty until proven innocent
1524	rc = ESMF_FAILURE
1525
1526	! Only thing to do here is release redist and route handles
1527	IF ( fromWRF_rh_ready ) THEN
1528	CALL ESMF_FieldRedistRelease(fromWRF_rh, rc)
1529	IF ( rc /= ESMF_SUCCESS ) THEN
1530	CALL wrf_error_fatal ( 'WRFSSTCpl_final: ESMF_FieldRedistRelease(fromWRF_rh) failed' )
1531	ENDIF
1532	CALL ESMF_RouteHandleDestroy(fromWRF_rh, rc)
1533	IF ( rc /= ESMF_SUCCESS ) THEN
1534	CALL wrf_error_fatal ( 'WRFSSTCpl_final: ESMF_RouteHandleDestroy(fromWRF_rh) failed' )
1535	ENDIF
1536	ENDIF
1537	IF ( fromSST_rh_ready ) THEN
1538	CALL ESMF_FieldRedistRelease(fromSST_rh, rc)
1539	IF ( rc /= ESMF_SUCCESS ) THEN
1540	CALL wrf_error_fatal ( 'WRFSSTCpl_final: ESMF_FieldRedistRelease(fromSST_rh) failed' )
1541	ENDIF
1542	CALL ESMF_RouteHandleDestroy(fromSST_rh, rc)
1543	IF ( rc /= ESMF_SUCCESS ) THEN
1544	CALL wrf_error_fatal ( 'WRFSSTCpl_final: ESMF_RouteHandleDestroy(fromSST_rh) failed' )
1545	ENDIF
1546	ENDIF
1547
1548	PRINT *, "DEBUG: Coupler Final returning"
1549
1550	END SUBROUTINE WRFSSTCpl_final
1551
1552
1553	END MODULE module_wrfsst_coupler
1554
1555
1556
1557
1558	PROGRAM wrf_SST_ESMF
1559
1560	!$$$AAAA
1561
1562	!$$$TBH: update this documentation!
1563
1564	!<DESCRIPTION>
1565	! ESMF Application Wrapper for coupling WRF with a "dummy" component
1566	! that simply reads SSTs from a file and sends them to WRF (one-way
1567	! coupling).
1568	!
1569	! Note that, like other WRF coupling methods (MCEL, MCT), ESMF coupling is
1570	! supported only via auxiliary input and history streams.
1571	!
1572	! This is the main program that creates the ESMF Gridded and Coupler
1573	! Component.
1574	!
1575	! "init" looks like this:
1576	! 1. Init phase 1 for WRF, sets WRF exportState metadata for "time"
1577	! and "domain" information needed by WRF IOAPI (which is called from
1578	! the SST component). It also sets up all WRF and WSF modules. Note
1579	! that this must be called before SST phase-1 init because SST uses
1580	! WRF IOAPI.
1581	! 2. Init phase 1 for SST, sets "time" metadata in SST exportState.
1582	! 3. Initialize coupler, passing decomposition metadata from WRF exportState
1583	! to SST importState.
1584	! 4. Resolve any "time" metadata inconsistencies and create top-level clock.
1585	! 5. Init phase 2 for SST, gets "domain" information from importState,
1586	! creates an ESMF_Grid based on "domain" information using the exact same
1587	! method as WRF (so WRF IOAPI calls will work), and sets up SST
1588	! importState and exportState.
1589	! 6. Init phase 2 for WRF, runs up to the end of the head_grid I/O "training"
1590	! phase (done in med_before_solve_io()). This initializes WRF
1591	! importState and exportState prior to the first coupling step during the
1592	! "run" loop. Note that this only works for head_grid at present because
1593	! recursion in WRF traversal of subdomains is not dealt with yet and
1594	! because the code that populates the WRF importState and exportState is
1595	! not yet sophisticated enough to handle creating and destroying nested
1596	! domains at any time during the model run.
1597	!$$$ NOTE: At the moment, any ESMF auxio that does not begin at the start
1598	!$$$ of the model run will FAIL due to the way WRF init phases have
1599	!$$$ been split. A solution would be to split the WRF run into two
1600	!$$$ phases instead and run the first part, which will stop after
1601	!$$$ "training", at the very start of the "run" loop". The main
1602	!$$$ implication of this change would be that WRF import and export
1603	!$$$ states would not be valid until after first-phase run were
1604	!$$$ called. A nasty business either way. TBH
1605	!
1606	!$$$here... Note that we really need nested states, one for each auxio stream!!
1607	!$$$here... For now, only support one input and/or one output stream via
1608	!$$$here... io_esmf. This condition is asserted in
1609	!$$$here... ext_esmf_open_for_read_begin() and
1610	!$$$here... ext_esmf_open_for_write_begin().
1611	!
1612	! "run" loop looks like this:
1613	! 1. Run SST phase 1, reads SST from file and writes it to SST exportState
1614	! for coupling to WRF.
1615	! 2. Couple SST exportState -> WRF importState. First iteration: set up
1616	! SST->WRF routeHandle via lazy evaluation.
1617	! 3. Run WRF. First iteration: head_grid resumes after I/O "training"
1618	! phase. Other iterations and domains: run normally.
1619	! Read WRF importState and write WRF exportState (via med_before_solve_io()).
1620	! Note that WRF assigns sst -> tsk for sea points in
1621	! share/module_soil_pre.F.
1622	!$$$here... However, WRF does NOT assign tsk -> sst. Do we need to send TSK
1623	!$$$here... from WRF too for self-test?
1624	!$$$here... eventually couple LANDMASK on first iteration only
1625	!$$$here... For concurrent coupling, must break wrf_run into two phases, first
1626	!$$$here... phase returns after the call to med_before_solve_io(), second phase
1627	!$$$here... resumes after the call to med_before_solve_io(). This is
1628	!$$$here... relatively easy if we limit ESMF coupling to head_grid, but is
1629	!$$$here... NOT so easy otherwise due to recursion. Also, we will need
1630	!$$$here... dynamic ESMF_States to couple to WRF nested domains since the
1631	!$$$here... nested domains may be created/destroyed at any time during the
1632	!$$$here... model run! Not clear that using ESMF to couple directly to WRF
1633	!$$$here... nested domains is a small effort, and not clear that it is needed.
1634	!
1635	!$$$ Note that moving init phase-2 to a first run phase and then splitting
1636	!$$$ yet again after med_before_solve_io() would lead to three run phases for
1637	!$$$ WRF. One could argue that since the current "everyone calls everything"
1638	!$$$ ESMF model for "concurrent components" is suboptimal for loosely-coupled
1639	!$$$ concurrency anyway, we should aviod the split after
1640	!$$$ med_before_solve_io(), limit ESMF use in WRF to sequential coupling, and
1641	!$$$ use MCEL/MCT for concurrent coupling. Food for thought... TBH
1642	!
1643	! 4. Couple WRF exportState -> SST importState. First iteration: set up
1644	! WRF->SST routeHandle via lazy evaluation.
1645	! 5. Run SST phase 2, compare SST from file with SST from WRF (via
1646	! SST importState) and error-exit if they differ.
1647	! 6. Advance clock and goto step 1
1648	!
1649	! "finalize" is trivial, except for destruction of ESMF objects which is
1650	! quite non-trivial at the moment.
1651	!
1652	!</DESCRIPTION>
1653
1654	!$$$ TBH: Need to eliminate duplication between wrf_ESMFApp.F
1655	!$$$ TBH: and wrf_SST_ESMF.F.
1656
1657	! WRF registration routine
1658	USE module_wrf_setservices, ONLY: WRF_register
1659	! SST registration routine
1660	USE module_sst_setservices, ONLY: SST_register
1661	! WRF-SST coupler registration routine
1662	USE module_wrfsst_coupler, ONLY: WRFSSTCpl_register
1663	! ESMF module, defines all ESMF data types and procedures
1664	USE ESMF_Mod
1665	! Not-yet-implemented ESMF features
1666	USE module_esmf_extensions
1667	! Component-independent utilities
1668	USE module_metadatautils, ONLY: GetTimesFromStates
1669
1670	IMPLICIT NONE
1671
1672	! Local variables
1673
1674	! Components
1675	TYPE(ESMF_GridComp) :: compGriddedWRF ! WRF
1676	TYPE(ESMF_GridComp) :: compGriddedSST ! SST reader
1677	TYPE(ESMF_CplComp) :: compCplWRFSST ! WRF-SST coupler
1678
1679	! State, Virtual Machine, and DELayout
1680	TYPE(ESMF_VM) :: vm
1681	TYPE(ESMF_State) :: importStateWRF, exportStateWRF
1682	TYPE(ESMF_State) :: importStateSST, exportStateSST
1683
1684	! A clock, some times, and a time step
1685	TYPE(ESMF_Clock) :: driverClock
1686	TYPE(ESMF_Time) :: startTime
1687	TYPE(ESMF_Time) :: stopTime
1688	TYPE(ESMF_TimeInterval) :: couplingInterval
1689
1690	! other misc stuff
1691	TYPE(ESMF_State) :: tmpState
1692	INTEGER :: timestepdebug
1693
1694	! Return codes for error checks
1695	INTEGER :: rc
1696	CHARACTER (ESMF_MAXSTR) :: str
1697
1698	! debugging
1699	CHARACTER(LEN=256) :: couplingIntervalString
1700
1701
1702	! Warn users that this is not yet ready for general use.
1703	PRINT *, ' W A R N I N G '
1704	PRINT *, ' ESMF COUPLING CAPABILITY IS EXPERIMENTAL AND UNSUPPORTED '
1705	PRINT *, ' IN THIS VERSION OF WRF-SST '
1706	PRINT *, ' U S E A T Y O U R O W N R I S K '
1707
1708	! This call includes everything that must be done before ESMF_Initialize()
1709	! is called.
1710	CALL init_modules(1) ! Phase 1 returns after MPI_INIT() (if it is called)
1711
1712	! Initialize ESMF, get the default Global VM, and set
1713	! the default calendar to be Gregorian.
1714	CALL ESMF_Initialize( vm=vm, defaultCalendar=ESMF_CAL_GREGORIAN, rc=rc )
1715	IF ( rc /= ESMF_SUCCESS ) THEN
1716	PRINT *, 'wrf_SST_ESMF: ESMF_Initialize failed'
1717	ENDIF
1718	! Note: wrf_debug and wrf_error_fatal are not initialized yet
1719	PRINT *, 'DEBUG wrf_SST_ESMF: returned from ESMF_Initialize'
1720	CALL ESMF_SetInitialized() ! eliminate this once ESMF does it internally
1721
1722	! Create the WRF Gridded Component, passing in the default VM.
1723	compGriddedWRF = ESMF_GridCompCreate(vm, "WRF Model", rc=rc)
1724	IF ( rc /= ESMF_SUCCESS ) THEN
1725	PRINT *, 'wrf_SST_ESMF: ESMF_GridCompCreate(WRF Model) failed'
1726	ENDIF
1727
1728	! Create the SST Gridded Component, passing in the default VM.
1729	compGriddedSST = ESMF_GridCompCreate(vm, "SST Dummy Model", rc=rc)
1730	IF ( rc /= ESMF_SUCCESS ) THEN
1731	PRINT *, 'wrf_SST_ESMF: ESMF_GridCompCreate(WRF Dummy Model) failed'
1732	ENDIF
1733
1734	! Create the WRF-SST Coupler Component, passing in the default VM.
1735	compCplWRFSST = ESMF_CplCompCreate(vm, "WRF-SST Coupler", rc=rc)
1736	IF ( rc /= ESMF_SUCCESS ) THEN
1737	PRINT *, 'wrf_SST_ESMF: ESMF_CplCompCreate failed'
1738	ENDIF
1739
1740	! Create empty import and export states for WRF
1741	importStateWRF = ESMF_StateCreate("WRF Import State", statetype=ESMF_STATE_IMPORT, rc=rc)
1742	IF ( rc /= ESMF_SUCCESS ) THEN
1743	PRINT *, 'wrf_SST_ESMF: ESMF_StateCreate(WRF Import State) failed'
1744	ENDIF
1745	exportStateWRF = ESMF_StateCreate("WRF Export State", statetype=ESMF_STATE_EXPORT, rc=rc)
1746	IF ( rc /= ESMF_SUCCESS ) THEN
1747	PRINT *, 'wrf_SST_ESMF: ESMF_StateCreate(WRF Export State) failed'
1748	ENDIF
1749
1750	! Create empty import and export states for SST
1751	importStateSST = ESMF_StateCreate("SST Import State", statetype=ESMF_STATE_IMPORT, rc=rc)
1752	IF ( rc /= ESMF_SUCCESS ) THEN
1753	PRINT *, 'wrf_SST_ESMF: ESMF_StateCreate(SST Import State) failed'
1754	ENDIF
1755	exportStateSST = ESMF_StateCreate("SST Export State", statetype=ESMF_STATE_EXPORT, rc=rc)
1756	IF ( rc /= ESMF_SUCCESS ) THEN
1757	PRINT *, 'wrf_SST_ESMF: ESMF_StateCreate(SST Export State) failed'
1758	ENDIF
1759
1760	! Register the WRF Gridded Component
1761	CALL ESMF_GridCompSetServices(compGriddedWRF, WRF_register, rc)
1762	IF ( rc /= ESMF_SUCCESS ) THEN
1763	PRINT *, 'wrf_SST_ESMF: ESMF_GridCompSetServices(compGriddedWRF) failed'
1764	ENDIF
1765
1766	! Register the SST Gridded Component
1767	CALL ESMF_GridCompSetServices(compGriddedSST, SST_register, rc)
1768	IF ( rc /= ESMF_SUCCESS ) THEN
1769	PRINT *, 'wrf_SST_ESMF: ESMF_GridCompSetServices(compGriddedSST) failed'
1770	ENDIF
1771
1772	! Register the WRF-SST Coupler Component
1773	CALL ESMF_CplCompSetServices(compCplWRFSST, WRFSSTCpl_register, rc)
1774	IF ( rc /= ESMF_SUCCESS ) THEN
1775	PRINT *, 'wrf_SST_ESMF: ESMF_CplCompSetServices failed'
1776	ENDIF
1777
1778	! Create top-level clock. There is no way to create an "empty" clock, so
1779	! stuff in bogus values for start time, stop time, and time step and fix
1780	! them after gridded component "init" phases return.
1781	CALL ESMF_TimeSet(startTime, yy=2000, mm=1, dd=1, &
1782	h=0, m=0, s=0, rc=rc)
1783	IF ( rc /= ESMF_SUCCESS ) THEN
1784	PRINT *, 'wrf_SST_ESMF: ESMF_TimeSet(startTime) failed'
1785	ENDIF
1786	CALL ESMF_TimeSet(stopTime, yy=2000, mm=1, dd=1, &
1787	h=12, m=0, s=0, rc=rc)
1788	IF ( rc /= ESMF_SUCCESS ) THEN
1789	PRINT *, 'wrf_SST_ESMF: ESMF_TimeSet(stopTime) failed'
1790	ENDIF
1791	CALL ESMF_TimeIntervalSet(couplingInterval, s=2, rc=rc)
1792	IF ( rc /= ESMF_SUCCESS ) THEN
1793	PRINT *, 'wrf_SST_ESMF: ESMF_TimeIntervalSet failed'
1794	ENDIF
1795	driverClock = ESMF_ClockCreate(timeStep=couplingInterval, &
1796	startTime=startTime, &
1797	stopTime=stopTime, rc=rc)
1798	IF ( rc /= ESMF_SUCCESS ) THEN
1799	PRINT *, 'wrf_SST_ESMF: ESMF_ClockCreate failed'
1800	ENDIF
1801
1802	! Init, Run, and Finalize section
1803
1804	! Init...
1805	! initialize WRF, phase 1
1806	! Phase 1 init returns WRF time and decomposition information as
1807	! exportState metadata.
1808	PRINT *, 'DEBUG wrf_SST_ESMF: calling phase-1 WRF init (wrf_component_init1)'
1809	CALL ESMF_GridCompInitialize(compGriddedWRF, importStateWRF, &
1810	exportStateWRF, driverClock, phase=1, rc=rc)
1811	! Note: wrf_debug and wrf_error_fatal are now initialized
1812	IF ( rc /= ESMF_SUCCESS ) THEN
1813	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompInitialize(WRF phase 1) failed' )
1814	ENDIF
1815
1816	! initialize SST, phase 1
1817	! Phase 1 init returns SST time information as
1818	! exportState metadata.
1819	PRINT *, 'DEBUG wrf_SST_ESMF: calling phase-1 SST init (sst_component_init1)'
1820	CALL ESMF_GridCompInitialize(compGriddedSST, importStateSST, &
1821	exportStateSST, driverClock, phase=1, rc=rc)
1822	IF ( rc /= ESMF_SUCCESS ) THEN
1823	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompInitialize(SST phase 1) failed' )
1824	ENDIF
1825
1826	! Reconcile clock settings from WRF and SST components to set up
1827	! top-level clock. These are passed back from each "init" as attributes
1828	! on exportState*.
1829	! Stuff both States into a single State to pass into GetTimesFromStates()
1830	! which is smart enough to deal with a Composite.
1831	PRINT *, 'DEBUG wrf_SST_ESMF: reconciling clock from WRF and SST components'
1832	tmpState = ESMF_StateCreate( rc=rc )
1833	IF ( rc /= ESMF_SUCCESS ) THEN
1834	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateCreate(tmpState) failed' )
1835	ENDIF
1836	CALL ESMF_StateAddState( tmpState, exportStateWRF, rc )
1837	IF ( rc /= ESMF_SUCCESS ) THEN
1838	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateAddState(exportStateWRF) failed' )
1839	ENDIF
1840	CALL ESMF_StateAddState( tmpState, exportStateSST, rc )
1841	IF ( rc /= ESMF_SUCCESS ) THEN
1842	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateAddState(exportStateSST) failed' )
1843	ENDIF
1844	CALL GetTimesFromStates( tmpState, startTime, stopTime, couplingInterval )
1845	CALL ESMF_TimeIntervalGet( couplingInterval, TimeString=couplingIntervalString, &
1846	rc=rc )
1847	IF ( rc /= ESMF_SUCCESS ) THEN
1848	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_TimeIntervalGet failed' )
1849	ENDIF
1850	CALL wrf_debug( 100, 'wrf_SST_ESMF: couplingInterval = '//TRIM(couplingIntervalString) )
1851	CALL ESMF_StateDestroy( tmpState, rc )
1852	IF ( rc /= ESMF_SUCCESS ) THEN
1853	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateDestroy(tmpState) failed' )
1854	ENDIF
1855	! update driver clock
1856	CALL ESMF_ClockDestroy(driverClock, rc)
1857	IF ( rc /= ESMF_SUCCESS ) THEN
1858	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_ClockDestroy failed' )
1859	ENDIF
1860	driverClock = ESMF_ClockCreate(timeStep=couplingInterval, &
1861	startTime=startTime, &
1862	stopTime=stopTime, rc=rc)
1863	IF ( rc /= ESMF_SUCCESS ) THEN
1864	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_ClockCreate(driverClock) failed' )
1865	ENDIF
1866	PRINT *, 'DEBUG wrf_SST_ESMF: done reconciling clock from WRF and SST components'
1867	CALL wrf_clockprint(50, driverClock, &
1868	'DEBUG wrf_SST_ESMF: driverClock after creation,')
1869
1870	! initialize WRF-SST Coupler
1871	PRINT *, 'DEBUG wrf_SST_ESMF: calling phase-1 CPL init (WRFSSTCpl_init)'
1872	CALL ESMF_CplCompInitialize(compCplWRFSST, exportStateWRF, &
1873	importStateSST, driverClock, rc=rc)
1874	IF ( rc /= ESMF_SUCCESS ) THEN
1875	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_CplCompInitialize(WRF -> SST) failed' )
1876	ENDIF
1877	! TBH: this bit is not needed
1878	! CALL ESMF_CplCompInitialize(compCplWRFSST, exportStateSST, &
1879	! importStateWRF, driverClock, rc=rc)
1880	! IF ( rc /= ESMF_SUCCESS ) THEN
1881	! CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_CplCompInitialize(SST -> WRF) failed' )
1882	! ENDIF
1883
1884	! initialize SST, phase 2
1885	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling phase-2 init for SST (sst_component_init2)'
1886	CALL wrf_debug ( 100 , TRIM(str) )
1887	CALL ESMF_GridCompInitialize(compGriddedSST, importStateSST, &
1888	exportStateSST, driverClock, phase=2, rc=rc)
1889	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from phase-2 init for SST'
1890	CALL wrf_debug ( 100 , TRIM(str) )
1891	IF ( rc /= ESMF_SUCCESS ) THEN
1892	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompInitialize(SST phase 2) failed' )
1893	ENDIF
1894
1895	! initialize WRF, phase 2
1896	! Phase 2 init sets up WRF importState and exportState.
1897	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling phase-2 init for WRF (wrf_component_init2)'
1898	CALL wrf_debug ( 100 , TRIM(str) )
1899	CALL ESMF_GridCompInitialize(compGriddedWRF, importStateWRF, &
1900	exportStateWRF, driverClock, phase=2, rc=rc)
1901	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from phase-2 init for WRF'
1902	CALL wrf_debug ( 100 , TRIM(str) )
1903	IF ( rc /= ESMF_SUCCESS ) THEN
1904	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompInitialize(WRF phase 2) failed' )
1905	ENDIF
1906
1907	CALL wrf_clockprint(50, driverClock, &
1908	'DEBUG wrf_SST_ESMF: driverClock before main time-stepping loop,')
1909	! Run...
1910	! main time-stepping loop
1911	timestepdebug = 0
1912	DO WHILE ( .NOT. ESMF_ClockIsStopTime(driverClock, rc) )
1913
1914	timestepdebug = timestepdebug + 1
1915	WRITE(str,'(A,I8)') 'PROGRAM wrf_SST_ESMF: Top of time-stepping loop, timestepdebug = ',timestepdebug
1916	CALL wrf_debug ( 100 , TRIM(str) )
1917	CALL wrf_clockprint(50, driverClock, &
1918	'DEBUG wrf_SST_ESMF: driverClock at top of time-stepping loop,')
1919
1920	! Run SST phase 1
1921	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling phase-1 run for SST (sst_component_run1)'
1922	CALL wrf_debug ( 100 , TRIM(str) )
1923	CALL ESMF_GridCompRun(compGriddedSST, importStateSST, exportStateSST, &
1924	driverClock, phase=1, rc=rc)
1925	IF ( rc /= ESMF_SUCCESS ) THEN
1926	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompRun(SST phase 1) failed' )
1927	ENDIF
1928	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from phase-1 run for SST (sst_component_run1)'
1929	CALL wrf_debug ( 100 , TRIM(str) )
1930
1931	! couple SST export -> WRF import
1932	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling run for CPL SST->WRF (WRFSSTCpl_run)'
1933	CALL wrf_debug ( 100 , TRIM(str) )
1934	CALL ESMF_CplCompRun(compCplWRFSST, exportStateSST, &
1935	importStateWRF, driverClock, rc=rc)
1936	IF ( rc /= ESMF_SUCCESS ) THEN
1937	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_CplCompRun(SST -> WRF) failed' )
1938	ENDIF
1939	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from run for CPL SST->WRF (WRFSSTCpl_run)'
1940	CALL wrf_debug ( 100 , TRIM(str) )
1941
1942	! Run WRF
1943	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling run for WRF (wrf_component_run)'
1944	CALL wrf_debug ( 100 , TRIM(str) )
1945	CALL ESMF_GridCompRun(compGriddedWRF, importStateWRF, exportStateWRF, &
1946	driverClock, rc=rc)
1947	IF ( rc /= ESMF_SUCCESS ) THEN
1948	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompRun(WRF) failed' )
1949	ENDIF
1950	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from run for WRF (wrf_component_run)'
1951	CALL wrf_debug ( 100 , TRIM(str) )
1952
1953	! couple WRF export -> SST import
1954	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling run for CPL WRF->SST (WRFSSTCpl_run)'
1955	CALL wrf_debug ( 100 , TRIM(str) )
1956	CALL ESMF_CplCompRun(compCplWRFSST, exportStateWRF, &
1957	importStateSST, driverClock, rc=rc)
1958	IF ( rc /= ESMF_SUCCESS ) THEN
1959	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_CplCompRun(WRF -> SST) failed' )
1960	ENDIF
1961	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from run for CPL WRF->SST (WRFSSTCpl_run)'
1962	CALL wrf_debug ( 100 , TRIM(str) )
1963
1964	! Run SST phase 2
1965	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: Calling phase-2 run for SST (sst_component_run2)'
1966	CALL wrf_debug ( 100 , TRIM(str) )
1967	CALL ESMF_GridCompRun(compGriddedSST, importStateSST, exportStateSST, &
1968	driverClock, phase=2, rc=rc)
1969	IF ( rc /= ESMF_SUCCESS ) THEN
1970	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompRun(SST phase 2) failed' )
1971	ENDIF
1972	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: back from phase-2 run for SST (sst_component_run2)'
1973	CALL wrf_debug ( 100 , TRIM(str) )
1974
1975	! advance clock to next coupling time step
1976	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: advancing clock'
1977	CALL wrf_debug ( 100 , TRIM(str) )
1978	CALL ESMF_ClockAdvance( driverClock, rc=rc )
1979	IF ( rc /= ESMF_SUCCESS ) THEN
1980	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_ClockAdvance failed' )
1981	ENDIF
1982	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: done advancing clock'
1983	CALL wrf_debug ( 100 , TRIM(str) )
1984
1985	CALL wrf_clockprint(50, driverClock, &
1986	'DEBUG wrf_SST_ESMF: driverClock at end of time-stepping loop,')
1987
1988	ENDDO
1989
1990	WRITE(str,'(A)') 'PROGRAM wrf_SST_ESMF: done with time-stepping loop'
1991	CALL wrf_debug ( 100 , TRIM(str) )
1992
1993	! clean up SST
1994	CALL ESMF_GridCompFinalize(compGriddedSST, importStateSST, exportStateSST, &
1995	driverClock, rc=rc)
1996	IF ( rc /= ESMF_SUCCESS ) THEN
1997	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompFinalize(compGriddedSST) failed' )
1998	ENDIF
1999
2000	! clean up compCplWRFSST
2001	CALL ESMF_CplCompFinalize( compCplWRFSST, exportStateWRF, importStateSST, &
2002	driverClock, rc=rc)
2003	IF ( rc /= ESMF_SUCCESS ) THEN
2004	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_CplCompFinalize(compCplWRFSST) failed' )
2005	ENDIF
2006
2007	! clean up WRF
2008	! must do this AFTER clean up of SST since SST uses WRF IOAPI
2009	CALL ESMF_GridCompFinalize(compGriddedWRF, importStateWRF, exportStateWRF, &
2010	driverClock, rc=rc)
2011	IF ( rc /= ESMF_SUCCESS ) THEN
2012	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompFinalize(compGriddedWRF) failed' )
2013	ENDIF
2014
2015	! Clean up
2016
2017	CALL ESMF_GridCompDestroy(compGriddedWRF, rc)
2018	IF ( rc /= ESMF_SUCCESS ) THEN
2019	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_GridCompDestroy(compGriddedWRF) failed' )
2020	ENDIF
2021	CALL ESMF_StateDestroy(importStateWRF, rc)
2022	IF ( rc /= ESMF_SUCCESS ) THEN
2023	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateDestroy(importStateWRF) failed' )
2024	ENDIF
2025	CALL ESMF_StateDestroy(exportStateWRF, rc)
2026	IF ( rc /= ESMF_SUCCESS ) THEN
2027	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateDestroy(exportStateWRF) failed' )
2028	ENDIF
2029	CALL ESMF_StateDestroy(importStateSST, rc)
2030	IF ( rc /= ESMF_SUCCESS ) THEN
2031	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateDestroy(importStateSST) failed' )
2032	ENDIF
2033	CALL ESMF_StateDestroy(exportStateSST, rc)
2034	IF ( rc /= ESMF_SUCCESS ) THEN
2035	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_StateDestroy(exportStateSST) failed' )
2036	ENDIF
2037	CALL ESMF_ClockDestroy(driverClock, rc)
2038	IF ( rc /= ESMF_SUCCESS ) THEN
2039	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_ClockDestroy(driverClock) failed' )
2040	ENDIF
2041
2042	CALL ESMF_Finalize( rc=rc )
2043	IF ( rc /= ESMF_SUCCESS ) THEN
2044	CALL wrf_error_fatal ( 'wrf_SST_ESMF: ESMF_Finalize failed' )
2045	ENDIF
2046
2047	END PROGRAM wrf_SST_ESMF
2048
2049

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

Download in other formats:

Original Format