Ticket #29: mct_roms_wrf.h

File mct_roms_wrf.h, 22.5 KB (added by m.hadfield, 19 years ago)
Line 
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