wrf_SST_ESMF.F
References to this file elsewhere.
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