1 | !
|
---|
2 | !svn $Id: mct_roms_wrf.h 22 2007-03-23 00:54:05Z arango $
|
---|
3 | !================================================== Hernan G. Arango ===
|
---|
4 | ! Copyright (c) 2002-2007 The ROMS/TOMS Group Daniel Schaffer !
|
---|
5 | ! Licensed under a MIT/X style license !
|
---|
6 | ! See License_ROMS.txt !
|
---|
7 | !=======================================================================
|
---|
8 | ! !
|
---|
9 | ! This module is for coupling ROMS to WRF using the Model Coupling !
|
---|
10 | ! Toolkit (MCT; developed at the Argonne National Laboratory) and !
|
---|
11 | ! the WRF I/O API. !
|
---|
12 | ! !
|
---|
13 | ! Dan Schaffer, FSL, Daniel.S.Schaffer@noaa.gov !
|
---|
14 | ! !
|
---|
15 | !=======================================================================
|
---|
16 | !
|
---|
17 | implicit none
|
---|
18 |
|
---|
19 | integer, save :: ATM_TO_OCN_T_HANDLE
|
---|
20 | integer, save :: OCN_TO_ATM_T_HANDLE
|
---|
21 |
|
---|
22 | CONTAINS
|
---|
23 |
|
---|
24 | SUBROUTINE initialize_atmos_coupling (ng, tile)
|
---|
25 | !
|
---|
26 | !=======================================================================
|
---|
27 | ! !
|
---|
28 | ! Initialize atmosphere and ocean coupling stream. This is the !
|
---|
29 | ! training phase use to constuct MCT parallel interpolators and !
|
---|
30 | ! stablish communication patterns. !
|
---|
31 | ! !
|
---|
32 | !=======================================================================
|
---|
33 | !
|
---|
34 | USE mod_param
|
---|
35 | USE mod_parallel
|
---|
36 | USE mod_forces
|
---|
37 | USE mod_kinds
|
---|
38 | !
|
---|
39 | #include "wrf_io_flags.h"
|
---|
40 | !
|
---|
41 | ! Imported variable definitions.
|
---|
42 | !
|
---|
43 | integer, intent(in) :: ng, tile
|
---|
44 | !
|
---|
45 | ! Local variable declarations. Currently, WRF I/O API supports
|
---|
46 | ! single precision only.
|
---|
47 | !
|
---|
48 | integer :: IstrR, IendR, JstrR, JendR, IstrU, JstrV
|
---|
49 | integer :: MyStatus, RealType
|
---|
50 |
|
---|
51 | integer :: DomainDesc = 0
|
---|
52 |
|
---|
53 | integer :: DomainStr(2), DomainEnd(2)
|
---|
54 | integer :: MemoryStr(2), MemoryEnd(2)
|
---|
55 | integer :: PatchStr(2), PatchEnd(2)
|
---|
56 |
|
---|
57 | real(r4) :: FIELD(1,1)
|
---|
58 |
|
---|
59 | character (len=80) :: DateStr
|
---|
60 | character (len=80) :: MemoryOrder
|
---|
61 | character (len=80) :: Stagger
|
---|
62 | character (len=80) :: DimNames
|
---|
63 | character (len=80) :: VarName
|
---|
64 |
|
---|
65 | #include "tile.h"
|
---|
66 | #include "set_bounds.h"
|
---|
67 | !
|
---|
68 | !-----------------------------------------------------------------------
|
---|
69 | ! Set Model Coupling Toolkit (MCT) parameters.
|
---|
70 | !-----------------------------------------------------------------------
|
---|
71 | !
|
---|
72 | Stagger=""
|
---|
73 | DimNames=""
|
---|
74 | DateStr=""
|
---|
75 | MemoryOrder="XY"
|
---|
76 |
|
---|
77 | DomainStr(1)=1
|
---|
78 | DomainEnd(1)=Lm(ng)
|
---|
79 | DomainStr(2)=1
|
---|
80 | DomainEnd(2)=Mm(ng)
|
---|
81 |
|
---|
82 | MemoryStr(1)=LBi
|
---|
83 | MemoryEnd(1)=UBi
|
---|
84 | MemoryStr(2)=LBj
|
---|
85 | MemoryEnd(2)=UBj
|
---|
86 |
|
---|
87 | PatchStr(1)=Istr
|
---|
88 | PatchEnd(1)=Iend
|
---|
89 | PatchStr(2)=Jstr
|
---|
90 | PatchEnd(2)=Jend
|
---|
91 |
|
---|
92 | RealType=WRF_REAL ! single precision
|
---|
93 | !! RealType=WRF_DOUBLE ! double precision, not yet supported
|
---|
94 | !
|
---|
95 | !-----------------------------------------------------------------------
|
---|
96 | ! Begin training phase: open a coupling stream in which the calling
|
---|
97 | ! read data from component model.
|
---|
98 | !-----------------------------------------------------------------------
|
---|
99 | !
|
---|
100 | ! Atmosphere to ocean model.
|
---|
101 | !
|
---|
102 | CALL ext_mct_open_for_read_begin ("wrf", &
|
---|
103 | & MPI_COMM_WORLD, &
|
---|
104 | & OCN_COMM_WORLD, &
|
---|
105 | & "SPARSE_MATRIX_BASE_NAME=wrf_to_roms, COMPONENT_NAME=roms", &
|
---|
106 | & ATM_TO_OCN_T_HANDLE, &
|
---|
107 | & MyStatus)
|
---|
108 | IF (MyStatus.ne.0) THEN
|
---|
109 | CALL finalize_atmos_coupling &
|
---|
110 | & ("Coupling stream open for read failed")
|
---|
111 | END IF
|
---|
112 | !
|
---|
113 | ! Ocean to atmosphere model.
|
---|
114 | !
|
---|
115 | CALL ext_mct_open_for_read_begin ("wrf", &
|
---|
116 | & MPI_COMM_WORLD, &
|
---|
117 | & OCN_COMM_WORLD, &
|
---|
118 | & "SPARSE_MATRIX_BASE_NAME=roms_to_wrf, COMPONENT_NAME=roms", &
|
---|
119 | & OCN_TO_ATM_T_HANDLE, &
|
---|
120 | & MyStatus)
|
---|
121 | IF (MyStatus.ne.0) THEN
|
---|
122 | CALL finalize_atmos_coupling &
|
---|
123 | & ("Coupling stream open for read failed")
|
---|
124 | END IF
|
---|
125 | !
|
---|
126 | !-----------------------------------------------------------------------
|
---|
127 | ! In training phase: construct and cache away coupling-data transfer
|
---|
128 | ! communication patterns.
|
---|
129 | !-----------------------------------------------------------------------
|
---|
130 | !
|
---|
131 | ! Surface wind stress in the XI-direction.
|
---|
132 | !
|
---|
133 | WRITE (VarName, fmt='(a7)') "USTRESS"
|
---|
134 | CALL ext_mct_read_field (ATM_TO_OCN_T_HANDLE, &
|
---|
135 | & DateStr, &
|
---|
136 | & trim(VarName), &
|
---|
137 | & FIELD, &
|
---|
138 | & RealType, &
|
---|
139 | & MPI_COMM_WORLD, &
|
---|
140 | & OCN_COMM_WORLD, &
|
---|
141 | & DomainDesc, &
|
---|
142 | & MemoryOrder, &
|
---|
143 | & Stagger, &
|
---|
144 | & DimNames, &
|
---|
145 | & DomainStr, DomainEnd, &
|
---|
146 | & MemoryStr, MemoryEnd, &
|
---|
147 | & PatchStr, PatchEnd, &
|
---|
148 | & MyStatus)
|
---|
149 | IF (MyStatus.ne.0) THEN
|
---|
150 | CALL finalize_atmos_coupling ("Coupling training read failed")
|
---|
151 | END IF
|
---|
152 | !
|
---|
153 | ! Surface wind stress in the ETA-direction.
|
---|
154 | !
|
---|
155 | WRITE (VarName, fmt='(a7)') "VSTRESS"
|
---|
156 | CALL ext_mct_read_field (ATM_TO_OCN_T_HANDLE, &
|
---|
157 | & DateStr, &
|
---|
158 | & TRIM(VarName), &
|
---|
159 | & FIELD, &
|
---|
160 | & RealType, &
|
---|
161 | & MPI_COMM_WORLD, &
|
---|
162 | & OCN_COMM_WORLD, &
|
---|
163 | & DomainDesc, &
|
---|
164 | & MemoryOrder, &
|
---|
165 | & Stagger, &
|
---|
166 | & DimNames, &
|
---|
167 | & DomainStr, DomainEnd, &
|
---|
168 | & MemoryStr, MemoryEnd, &
|
---|
169 | & PatchStr, PatchEnd, &
|
---|
170 | & MyStatus)
|
---|
171 | IF (MyStatus.ne.0) THEN
|
---|
172 | CALL finalize_atmos_coupling ("Coupling training read failed")
|
---|
173 | END IF
|
---|
174 | !
|
---|
175 | ! Sea surface temperature.
|
---|
176 | !
|
---|
177 | WRITE (VarName, fmt='(a3)') "SST"
|
---|
178 | CALL ext_mct_write_field (OCN_TO_ATM_T_HANDLE, &
|
---|
179 | & DateStr, &
|
---|
180 | & TRIM(VarName), &
|
---|
181 | & FIELD, &
|
---|
182 | & RealType, &
|
---|
183 | & MPI_COMM_WORLD, &
|
---|
184 | & OCN_COMM_WORLD, &
|
---|
185 | & DomainDesc, &
|
---|
186 | & MemoryOrder, &
|
---|
187 | & Stagger, &
|
---|
188 | & DimNames, &
|
---|
189 | & DomainStr, DomainEnd, &
|
---|
190 | & MemoryStr, MemoryEnd, &
|
---|
191 | & PatchStr, PatchEnd, &
|
---|
192 | & MyStatus)
|
---|
193 | IF (MyStatus.ne.0) THEN
|
---|
194 | CALL finalize_atmos_coupling ("Coupling training write failed")
|
---|
195 | END IF
|
---|
196 | !
|
---|
197 | !-----------------------------------------------------------------------
|
---|
198 | ! End of training phase: the coupling stream is referred to by the
|
---|
199 | ! data handle.
|
---|
200 | !-----------------------------------------------------------------------
|
---|
201 | !
|
---|
202 | ! Read: atmosphere to ocean model.
|
---|
203 | !
|
---|
204 | CALL ext_mct_open_for_read_commit (ATM_TO_OCN_T_HANDLE, &
|
---|
205 | & MyStatus)
|
---|
206 | IF (MyStatus.ne.0) THEN
|
---|
207 | CALL finalize_atmos_coupling ("Coupling read commit failed")
|
---|
208 | END IF
|
---|
209 | !
|
---|
210 | ! Write: ocean to atmosphere model.
|
---|
211 | !
|
---|
212 | CALL ext_mct_open_for_write_commit (OCN_TO_ATM_T_HANDLE, &
|
---|
213 | & MyStatus)
|
---|
214 | IF (MyStatus.ne.0) THEN
|
---|
215 | CALL finalize_atmos_coupling ("Coupling write commit failed")
|
---|
216 | END IF
|
---|
217 |
|
---|
218 | END SUBROUTINE initialize_atmos_coupling
|
---|
219 |
|
---|
220 | SUBROUTINE atmos_coupling (ng, tile)
|
---|
221 | !
|
---|
222 | !=======================================================================
|
---|
223 | ! !
|
---|
224 | ! This subroutine reads and writes the coupling data streams between !
|
---|
225 | ! atmosphere and ocean models. Currently, the following data streams !
|
---|
226 | ! are processed: !
|
---|
227 | ! !
|
---|
228 | ! * Kinematic surface wind stress components (m2/s2). !
|
---|
229 | ! * Sea surface temperature (Celsius). !
|
---|
230 | ! !
|
---|
231 | !=======================================================================
|
---|
232 | !
|
---|
233 | USE mod_param
|
---|
234 | USE mod_forces
|
---|
235 | USE mod_grid
|
---|
236 | USE mod_ocean
|
---|
237 | USE mod_stepping
|
---|
238 | !
|
---|
239 | implicit none
|
---|
240 |
|
---|
241 | integer, intent(in) :: ng, tile
|
---|
242 |
|
---|
243 | # include "tile.h"
|
---|
244 | !
|
---|
245 | # ifdef PROFILE
|
---|
246 | CALL wclock_on (ng, iNLM, 36)
|
---|
247 | # endif
|
---|
248 | CALL atmos_coupling_tile (ng, Istr, Iend, Jstr, Jend, &
|
---|
249 | & LBi, UBi, LBj, UBj, &
|
---|
250 | & nrhs(ng), &
|
---|
251 | & GRID(ng) % angler, &
|
---|
252 | & OCEAN(ng) % t, &
|
---|
253 | & FORCES(ng) % sustr, &
|
---|
254 | & FORCES(ng) % svstr)
|
---|
255 | # ifdef PROFILE
|
---|
256 | CALL wclock_off (ng, iNLM, 36)
|
---|
257 | # endif
|
---|
258 | RETURN
|
---|
259 | END SUBROUTINE atmos_coupling
|
---|
260 | !
|
---|
261 | !***********************************************************************
|
---|
262 | SUBROUTINE atmos_coupling_tile (ng, Istr, Iend, Jstr, Jend, &
|
---|
263 | & LBi, UBi, LBj, UBj, &
|
---|
264 | & nrhs, &
|
---|
265 | & angler, &
|
---|
266 | & t, sustr, svstr)
|
---|
267 | !***********************************************************************
|
---|
268 | !
|
---|
269 | USE mod_param
|
---|
270 | USE mod_scalars
|
---|
271 | USE mod_parallel
|
---|
272 | !
|
---|
273 | #if defined EW_PERIODIC || defined NS_PERIODIC
|
---|
274 | USE exchange_2d_mod, ONLY : exchange_u2d_tile, exchange_v2d_tile
|
---|
275 | #endif
|
---|
276 | #ifdef DISTRIBUTE
|
---|
277 | USE mp_exchange_mod, ONLY : mp_exchange2d
|
---|
278 | #endif
|
---|
279 | !
|
---|
280 | implicit none
|
---|
281 | !
|
---|
282 | #include "wrf_io_flags.h"
|
---|
283 | !
|
---|
284 | ! Imported variable declarations.
|
---|
285 | !
|
---|
286 | integer, intent(in) :: ng, Iend, Istr, Jend, Jstr
|
---|
287 | integer, intent(in) :: LBi, UBi, LBj, UBj
|
---|
288 | integer, intent(in) :: nrhs
|
---|
289 | !
|
---|
290 | # ifdef ASSUMED_SHAPE
|
---|
291 | real(r8), intent(in) :: angler(LBi:,LBj:)
|
---|
292 | real(r8), intent(in) :: t(LBi:,LBj:,:,:,:)
|
---|
293 |
|
---|
294 | real(r8), intent(out) :: sustr(LBi:,LBj:)
|
---|
295 | real(r8), intent(out) :: svstr(LBi:,LBj:)
|
---|
296 | # else
|
---|
297 | real(r8), intent(in) :: angler(LBi:UBi,LBj:UBj)
|
---|
298 | real(r8), intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
|
---|
299 |
|
---|
300 | real(r8), intent(out) :: sustr(LBi:UBi,LBj:UBj)
|
---|
301 | real(r8), intent(out) :: svstr(LBi:UBi,LBj:UBj)
|
---|
302 | # endif
|
---|
303 | !
|
---|
304 | ! Local variable declarations. Currently, WRF I/O API supports
|
---|
305 | ! single precision only.
|
---|
306 | !
|
---|
307 | #ifdef DISTRIBUTE
|
---|
308 | # ifdef EW_PERIODIC
|
---|
309 | logical :: EWperiodic=.TRUE.
|
---|
310 | # else
|
---|
311 | logical :: EWperiodic=.FALSE.
|
---|
312 | # endif
|
---|
313 | # ifdef NS_PERIODIC
|
---|
314 | logical :: NSperiodic=.TRUE.
|
---|
315 | # else
|
---|
316 | logical :: NSperiodic=.FALSE.
|
---|
317 | # endif
|
---|
318 | #endif
|
---|
319 | integer :: IstrR, IendR, JstrR, JendR, IstrU, JstrV
|
---|
320 | integer :: MyStatus, RealType, i, j
|
---|
321 |
|
---|
322 | integer :: DomainDesc = 0
|
---|
323 | integer :: DomainStr(2), DomainEnd(2)
|
---|
324 | integer :: MemoryStr(2), MemoryEnd(2)
|
---|
325 | integer :: PatchStr(2), PatchEnd(2)
|
---|
326 |
|
---|
327 | real(r4) :: var_sum, var_sum_g
|
---|
328 | real(r8) :: cff
|
---|
329 |
|
---|
330 | real(r4), dimension(LBi:UBi,LBj:UBj) :: tmpX
|
---|
331 | real(r4), dimension(LBi:UBi,LBj:UBj) :: tmpY
|
---|
332 |
|
---|
333 | character (len=80) :: DateStr
|
---|
334 | character (len=80) :: MemoryOrder
|
---|
335 | character (len=80) :: Stagger
|
---|
336 | character (len=80) :: DimNames
|
---|
337 | character (len=80) :: VarName
|
---|
338 |
|
---|
339 | # include "set_bounds.h"
|
---|
340 | !
|
---|
341 | !-----------------------------------------------------------------------
|
---|
342 | ! Set Model Coupling Toolkit (MCT) parameters.
|
---|
343 | !-----------------------------------------------------------------------
|
---|
344 | !
|
---|
345 | Stagger=""
|
---|
346 | DimNames=""
|
---|
347 | DateStr=""
|
---|
348 | MemoryOrder="XY"
|
---|
349 |
|
---|
350 | DomainStr(1)=1
|
---|
351 | DomainEnd(1)=Lm(ng)
|
---|
352 | DomainStr(2)=1
|
---|
353 | DomainEnd(2)=Mm(ng)
|
---|
354 |
|
---|
355 | MemoryStr(1)=LBi
|
---|
356 | MemoryEnd(1)=UBi
|
---|
357 | MemoryStr(2)=LBj
|
---|
358 | MemoryEnd(2)=UBj
|
---|
359 |
|
---|
360 | PatchStr(1)=Istr
|
---|
361 | PatchEnd(1)=Iend
|
---|
362 | PatchStr(2)=Jstr
|
---|
363 | PatchEnd(2)=Jend
|
---|
364 |
|
---|
365 | RealType=WRF_REAL ! single precision
|
---|
366 | !! RealType=WRF_DOUBLE ! double precision, not yet supported
|
---|
367 | !
|
---|
368 | !-----------------------------------------------------------------------
|
---|
369 | ! Receive kinematic wind stress (m2/s2) from atmosphere model.
|
---|
370 | !-----------------------------------------------------------------------
|
---|
371 | !
|
---|
372 | IF (Master) THEN
|
---|
373 | PRINT *, 'ROMS/TOMS, receiving wind stresses'
|
---|
374 | END IF
|
---|
375 | !
|
---|
376 | ! Get wind-stress component in the XI-direction.
|
---|
377 | !
|
---|
378 | WRITE (VarName, fmt='(a7)') "USTRESS"
|
---|
379 | CALL ext_mct_read_field (ATM_TO_OCN_T_HANDLE, &
|
---|
380 | & DateStr, &
|
---|
381 | & TRIM(VarName), &
|
---|
382 | & tmpX, &
|
---|
383 | & RealType, &
|
---|
384 | & MPI_COMM_WORLD, &
|
---|
385 | & OCN_COMM_WORLD, &
|
---|
386 | & DomainDesc, &
|
---|
387 | & MemoryOrder, &
|
---|
388 | & Stagger, &
|
---|
389 | & DimNames, &
|
---|
390 | & DomainStr, DomainEnd, &
|
---|
391 | & MemoryStr, MemoryEnd, &
|
---|
392 | & PatchStr, PatchEnd, &
|
---|
393 | & MyStatus)
|
---|
394 | IF (MyStatus.ne.0) THEN
|
---|
395 | CALL finalize_atmos_coupling ("Coupling read failed")
|
---|
396 | END IF
|
---|
397 | !
|
---|
398 | ! Compute global average.
|
---|
399 | !
|
---|
400 | var_sum=SUM(tmpX(PatchStr(1):PatchEnd(1), &
|
---|
401 | & PatchStr(2):PatchEnd(2)))
|
---|
402 | CALL mpi_allreduce (var_sum, var_sum_g, 1, MPI_REAL, MPI_SUM, &
|
---|
403 | & OCN_COMM_WORLD, MyStatus)
|
---|
404 | IF (MyStatus.ne.MPI_SUCCESS) THEN
|
---|
405 | CALL finalize_atmos_coupling ("Coupling global sum failed")
|
---|
406 | END IF
|
---|
407 | IF (Master) THEN
|
---|
408 | cff=(DomainEnd(1)-DomainStr(1)+1)* &
|
---|
409 | & (DomainEnd(2)-DomainStr(2)+1)
|
---|
410 | PRINT *, 'received U wind-stress from WRF, average: ', &
|
---|
411 | & var_sum_g/cff
|
---|
412 | END IF
|
---|
413 | !
|
---|
414 | ! Get wind-stress component in the ETA-direction.
|
---|
415 | !
|
---|
416 | WRITE (VarName, FMT='(a7)') "VSTRESS"
|
---|
417 | CALL ext_mct_read_field (ATM_TO_OCN_T_HANDLE, &
|
---|
418 | & DateStr, &
|
---|
419 | & TRIM(VarName), &
|
---|
420 | & tmpY, &
|
---|
421 | & RealType, &
|
---|
422 | & MPI_COMM_WORLD, &
|
---|
423 | & OCN_COMM_WORLD, &
|
---|
424 | & DomainDesc, &
|
---|
425 | & MemoryOrder, &
|
---|
426 | & Stagger, &
|
---|
427 | & DimNames, &
|
---|
428 | & DomainStr, DomainEnd, &
|
---|
429 | & MemoryStr, MemoryEnd, &
|
---|
430 | & PatchStr, PatchEnd, &
|
---|
431 | & MyStatus)
|
---|
432 | IF (MyStatus.ne.0) THEN
|
---|
433 | CALL finalize_atmos_coupling ("Coupling read failed")
|
---|
434 | END IF
|
---|
435 | !
|
---|
436 | ! Compute global average.
|
---|
437 | !
|
---|
438 | var_sum=SUM(tmpY(PatchStr(1):PatchEnd(1), &
|
---|
439 | & PatchStr(2):PatchEnd(2)))
|
---|
440 | CALL mpi_allreduce (var_sum, var_sum_g, 1, MPI_REAL, MPI_SUM, &
|
---|
441 | & OCN_COMM_WORLD, MyStatus)
|
---|
442 | IF (MyStatus.ne.MPI_SUCCESS) THEN
|
---|
443 | CALL finalize_atmos_coupling ("Coupling global sum failed")
|
---|
444 | END IF
|
---|
445 | IF (Master) THEN
|
---|
446 | cff=(DomainEnd(1)-DomainStr(1)+1)* &
|
---|
447 | & (DomainEnd(2)-DomainStr(2)+1)
|
---|
448 | PRINT *, 'Received V wind-stress from WRF, average: ', &
|
---|
449 | & var_sum_g/cff
|
---|
450 | END IF
|
---|
451 | !
|
---|
452 | ! Scale to kinematic stress.
|
---|
453 | !
|
---|
454 | cff=1.0_r8/rho0
|
---|
455 | DO j=Jstr,Jend
|
---|
456 | DO i=Istr,Iend
|
---|
457 | sustr(i,j)=cff*tmpX(i,j)
|
---|
458 | svstr(i,j)=cff*tmpY(i,j)
|
---|
459 | END DO
|
---|
460 | END DO
|
---|
461 |
|
---|
462 | #if defined EW_PERIODIC || defined NS_PERIODIC
|
---|
463 | !
|
---|
464 | !-----------------------------------------------------------------------
|
---|
465 | ! Apply periodic boundary conditions.
|
---|
466 | !-----------------------------------------------------------------------
|
---|
467 | !
|
---|
468 | CALL exchange_u2d_tile (ng, iNLM, Istr, Iend, Jstr, Jend, &
|
---|
469 | & LBi, UBi, LBj, UBj, &
|
---|
470 | & sustr)
|
---|
471 | CALL exchange_v2d_tile (ng, iNLM, Istr, Iend, Jstr, Jend, &
|
---|
472 | & LBi, UBi, LBj, UBj, &
|
---|
473 | & svstr)
|
---|
474 | #endif
|
---|
475 | #ifdef DISTRIBUTE
|
---|
476 | !
|
---|
477 | !-----------------------------------------------------------------------
|
---|
478 | ! Exchange tile boundaries.
|
---|
479 | !-----------------------------------------------------------------------
|
---|
480 | !
|
---|
481 | CALL mp_exchange2d (ng, iNLM, 2, Istr, Iend, Jstr, Jend, &
|
---|
482 | & LBi, UBi, LBj, UBj, &
|
---|
483 | & NghostPoints, EWperiodic, NSperiodic, &
|
---|
484 | & sustr, svstr)
|
---|
485 | #endif
|
---|
486 | !
|
---|
487 | !-----------------------------------------------------------------------
|
---|
488 | ! Send sea surface temperature to atmosphere model.
|
---|
489 | !-----------------------------------------------------------------------
|
---|
490 | !
|
---|
491 | ! Load sea surface temperature into temporary array.
|
---|
492 | !
|
---|
493 | DO j=JstrR,JendR
|
---|
494 | DO i=IstrR,IendR
|
---|
495 | tmpX(i,j)=t(i,j,N(ng),nrhs,itemp)
|
---|
496 | END DO
|
---|
497 | END DO
|
---|
498 | !
|
---|
499 | ! Compute global average.
|
---|
500 | !
|
---|
501 | var_sum=SUM(tmpX(PatchStr(1):PatchEnd(1), &
|
---|
502 | PatchStr(2):PatchEnd(2)))
|
---|
503 | CALL mpi_allreduce (var_sum, var_sum_g, 1, MPI_REAL, MPI_SUM, &
|
---|
504 | & OCN_COMM_WORLD, MyStatus)
|
---|
505 | IF (MyStatus.ne.MPI_SUCCESS) THEN
|
---|
506 | CALL finalize_atmos_coupling ("Coupling global sum failed")
|
---|
507 | END IF
|
---|
508 | !
|
---|
509 | ! Send sea surface temperature to atmospheric model.
|
---|
510 | !
|
---|
511 | IF (Master) THEN
|
---|
512 | cff=(DomainEnd(1)-DomainStr(1)+1)* &
|
---|
513 | & (DomainEnd(2)-DomainStr(2)+1)
|
---|
514 | PRINT *, 'Sending SST to WRF, average: ', var_sum_g/cff
|
---|
515 | END IF
|
---|
516 | WRITE (VarName, fmt='(a3)') "SST"
|
---|
517 | CALL ext_mct_write_field (OCN_TO_ATM_T_HANDLE, &
|
---|
518 | & DateStr, &
|
---|
519 | & TRIM(VarName), &
|
---|
520 | & tmpX, &
|
---|
521 | & RealType, &
|
---|
522 | & MPI_COMM_WORLD, &
|
---|
523 | & OCN_COMM_WORLD, &
|
---|
524 | & DomainDesc, &
|
---|
525 | & MemoryOrder, &
|
---|
526 | & Stagger, &
|
---|
527 | & DimNames, &
|
---|
528 | & DomainStr, DomainEnd, &
|
---|
529 | & MemoryStr, MemoryEnd, &
|
---|
530 | & PatchStr, PatchEnd, &
|
---|
531 | & MyStatus)
|
---|
532 | IF (MyStatus.ne.0) THEN
|
---|
533 | CALL finalize_atmos_coupling ("Coupling write failed")
|
---|
534 | END IF
|
---|
535 |
|
---|
536 | RETURN
|
---|
537 | END SUBROUTINE atmos_coupling_tile
|
---|
538 |
|
---|
539 | SUBROUTINE finalize_atmos_coupling (string)
|
---|
540 | !
|
---|
541 | !=======================================================================
|
---|
542 | ! ===
|
---|
543 | ! This routines terminates execution during coupling error. ===
|
---|
544 | ! ===
|
---|
545 | !=======================================================================
|
---|
546 | !
|
---|
547 | ! Imported variable declarations.
|
---|
548 | !
|
---|
549 | character (len=*), intent(in) :: string
|
---|
550 | !
|
---|
551 | ! Local variable declarations.
|
---|
552 | !
|
---|
553 | integer :: MyStatus
|
---|
554 | !
|
---|
555 | !-----------------------------------------------------------------------
|
---|
556 | ! Terminate MPI execution environment.
|
---|
557 | !-----------------------------------------------------------------------
|
---|
558 | !
|
---|
559 | PRINT *, string
|
---|
560 | CALL mpi_finalize (MyStatus)
|
---|
561 |
|
---|
562 | STOP
|
---|
563 | END SUBROUTINE finalize_atmos_coupling
|
---|