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 | |
---|