3***************************************************** john c. warner ***
4** copyright(c) 2002-2025 the roms group hernan g. arango **
5** licensed under a mit/x style license **
6** see license_roms.md **
7************************************************************************
9** these routines are
use couple roms to wrf atmosphere model **
10** using the model coupling toolkit(mct). **
12************************************************************************
15 SUBROUTINE initialize_ocn2atm_coupling (ng, tile)
34 integer,
intent(in) :: ng, tile
38 integer :: Istr, Iend, Jstr, Jend
39 integer :: IstrR, IendR, JstrR, JendR, IstrU, JstrV
40 integer :: Asize, Jsize, MyError
41 integer :: j, jc, nprocs
43 integer,
allocatable :: length(:)
44 integer,
allocatable :: start(:)
58 IF (
domain(ng)%Western_Edge(tile))
THEN
59 istrr=
bounds(ng)%Istr(tile)-1
61 istrr=
bounds(ng)%Istr(tile)
63 IF (
domain(ng)%Eastern_Edge(tile))
THEN
64 iendr=
bounds(ng)%Iend(tile)+1
66 iendr=
bounds(ng)%Iend(tile)
68 IF (
domain(ng)%Southern_Edge(tile))
THEN
69 jstrr=
bounds(ng)%Jstr(tile)-1
71 jstrr=
bounds(ng)%Jstr(tile)
73 IF (
domain(ng)%Northern_Edge(tile))
THEN
74 jendr=
bounds(ng)%Jend(tile)+1
76 jendr=
bounds(ng)%Jend(tile)
96 IF (.not.
allocated(start))
THEN
97 allocate ( start(jsize) )
99 IF (.not.
allocated(length))
THEN
100 allocate ( length(jsize) )
105 start(jc)=j*(
lm(ng)+2)+istrr+1
106 length(jc)=(iendr-istrr+1)
108 CALL globalsegmap_init (gsmaproms, start, length, 0, &
124 CALL attrvect_zero (ocn2atm_av)
132 IF (
allocated(start))
THEN
135 IF (
allocated(length))
THEN
140 END SUBROUTINE initialize_ocn2atm_coupling
142 SUBROUTINE ocn2atm_coupling (ng, tile)
182 integer,
intent(in) :: ng, tile
186 character (len=*),
parameter :: MyFile = &
194 CALL ocn2atm_coupling_tile (ng, tile, &
195 & lbi, ubi, lbj, ubj)
201 END SUBROUTINE ocn2atm_coupling
204 SUBROUTINE ocn2atm_coupling_tile (ng, tile, &
205 & LBi, UBi, LBj, UBj)
218 USE roms_import_mod,
ONLY : roms_import2d
219 USE roms_export_mod,
ONLY : roms_export2d
225 integer,
intent(in) :: ng, tile
226 integer,
intent(in) :: LBi, UBi, LBj, UBj
230 integer :: Istr, Iend, Jstr, Jend
231 integer :: IstrR, IendR, JstrR, JendR, IstrU, JstrV
232 integer :: Asize, Iimport, Iexport, MyError
233 integer :: gtype, i, id, ifield, j, status
235 real(r8) :: add_offset, scale
236 real(r8) :: RecvTime, SendTime, buffer(2), wtime(2)
240 real(r8),
pointer :: A(:)
242 character (len=3 ),
dimension(2) :: op_handle
243 character (len=40) :: code
252 istr=
bounds(ng)%Istr(tile)
253 iend=
bounds(ng)%Iend(tile)
254 jstr=
bounds(ng)%Jstr(tile)
255 jend=
bounds(ng)%Jend(tile)
257 IF (
domain(ng)%Western_Edge(tile))
THEN
258 istrr=
bounds(ng)%Istr(tile)-1
260 istrr=
bounds(ng)%Istr(tile)
262 IF (
domain(ng)%Eastern_Edge(tile))
THEN
263 iendr=
bounds(ng)%Iend(tile)+1
265 iendr=
bounds(ng)%Iend(tile)
267 IF (
domain(ng)%Southern_Edge(tile))
THEN
268 jstrr=
bounds(ng)%Jstr(tile)-1
270 jstrr=
bounds(ng)%Jstr(tile)
272 IF (
domain(ng)%Northern_Edge(tile))
THEN
273 jendr=
bounds(ng)%Jend(tile)+1
275 jendr=
bounds(ng)%Jend(tile)
283 allocate ( a(asize) )
300 buffer(1)=my_wtime(wtime)
301 CALL mct_recv (atm2ocn_av, romstowrf, myerror)
302 recvtime=recvtime+my_wtime(wtime)-buffer(1)
303 IF (myerror.ne.0)
THEN
305 WRITE (
stdout,10)
'atmosphere model, MyError = ', myerror
316 code=adjustl(
fields(id)%code)
319 add_offset=
fields(id)%AddOffset
321 SELECT CASE (trim(code))
323#if defined BULK_FLUXES || defined ECOSIM || defined ATM_PRESS
327 CALL attrvect_exportrattr (atm2ocn_av, trim(code), a, asize)
331 CALL roms_import2d (ng, tile, &
332 & id, gtype, scale, add_offset, &
334 & istrr, iendr, jstrr, jendr, &
335 & lbi, ubi, lbj, ubj, &
340#if defined BULK_FLUXES || defined ECOSIM || \
341 (defined shortwave && defined ana_srflux)
345 CALL attrvect_exportrattr (atm2ocn_av, trim(code), a, asize)
349 CALL roms_import2d (ng, tile, &
350 & id, gtype, scale, add_offset, &
352 & istrr, iendr, jstrr, jendr, &
353 & lbi, ubi, lbj, ubj, &
360 CALL attrvect_exportrattr (atm2ocn_av, trim(code), a, asize)
364 CALL roms_import2d (ng, tile, &
365 & id, gtype, scale, add_offset, &
367 & istrr, iendr, jstrr, jendr, &
368 & lbi, ubi, lbj, ubj, &
373#if defined BULK_FLUXES || defined ECOSIM
377 CALL attrvect_exportrattr (atm2ocn_av, trim(code), a, asize)
381 CALL roms_import2d (ng, tile, &
382 & id, gtype, scale, add_offset, &
384 & istrr, iendr, jstrr, jendr, &
385 & lbi, ubi, lbj, ubj, &
392 CALL attrvect_exportrattr (atm2ocn_av, trim(code), a, asize)
396 CALL roms_import2d (ng, tile, &
397 & id, gtype, scale, add_offset, &
399 & istrr, iendr, jstrr, jendr, &
400 & lbi, ubi, lbj, ubj, &
409 CALL attrvect_exportrattr (atm2ocn_av, trim(code), a, asize)
413 CALL roms_import2d (ng, tile, &
414 & id, gtype, scale, add_offset, &
416 & istrr, iendr, jstrr, jendr, &
417 & lbi, ubi, lbj, ubj, &
426 CALL attrvect_exportrattr (atm2ocn_av, trim(code), a, asize)
430 CALL roms_import2d (ng, tile, &
431 & id, gtype, scale, add_offset, &
433 & istrr, iendr, jstrr, jendr, &
434 & lbi, ubi, lbj, ubj, &
441 CALL attrvect_exportrattr (atm2ocn_av, trim(code), a, asize)
445 CALL roms_import2d (ng, tile, &
446 & id, gtype, scale, add_offset, &
448 & istrr, iendr, jstrr, jendr, &
449 & lbi, ubi, lbj, ubj, &
456 CALL attrvect_exportrattr (atm2ocn_av, trim(code), a, asize)
460 CALL roms_import2d (ng, tile, &
461 & id, gtype, scale, add_offset, &
463 & istrr, iendr, jstrr, jendr, &
464 & lbi, ubi, lbj, ubj, &
471 CALL attrvect_exportrattr (atm2ocn_av, trim(code), a, asize)
475 CALL roms_import2d (ng, tile, &
476 & id, gtype, scale, add_offset, &
478 & istrr, iendr, jstrr, jendr, &
479 & lbi, ubi, lbj, ubj, &
488 CALL attrvect_exportrattr (atm2ocn_av, trim(code), a, asize)
492 CALL roms_import2d (ng, tile, &
493 & id, gtype, scale, add_offset, &
495 & istrr, iendr, jstrr, jendr, &
496 & lbi, ubi, lbj, ubj, &
505 CALL attrvect_exportrattr (atm2ocn_av, trim(code), a, asize)
509 CALL roms_import2d (ng,
myrank, &
510 & id, gtype, scale, add_offset, &
512 & istrr, iendr, jstrr, jendr, &
513 & lbi, ubi, lbj, ubj, &
520 CALL attrvect_exportrattr (atm2ocn_av, trim(code), a, asize)
524 CALL roms_import2d (ng, tile, &
525 & id, gtype, scale, add_offset, &
527 & istrr, iendr, jstrr, jendr, &
528 & lbi, ubi, lbj, ubj, &
535 CALL attrvect_exportrattr (atm2ocn_av, trim(code), a, asize)
539 CALL roms_import2d (ng, tile, &
540 & id, gtype, scale, add_offset, &
542 & istrr, iendr, jstrr, jendr, &
543 & lbi, ubi, lbj, ubj, &
560 code=adjustl(
fields(id)%code)
563 add_offset=
fields(id)%AddOffset
565 SELECT CASE (trim(code))
569 CALL roms_export2d (ng, tile, &
570 & id, gtype, scale, add_offset, &
571 & lbi, ubi, lbj, ubj, &
576 CALL attrvect_importrattr (ocn2atm_av, trim(code), a, asize)
584 IF (iexport.gt.0)
THEN
585 buffer(2)=my_wtime(wtime)
586 CALL mct_send (ocn2atm_av, romstowrf, myerror)
587 sendtime=sendtime+my_wtime(wtime)-buffer(2)
588 IF (myerror.ne.0)
THEN
590 WRITE (
stdout,20)
'atmosphere model, MyError = ', myerror
610 IF (
master.and.((iimport.gt.0).or.(iexport.gt.0)))
THEN
616 WRITE (
stdout,40)
'ROMS Import: ',trim(
fields(id)%name), &
621 WRITE (
stdout,40)
'ROMS Export: ',trim(
fields(id)%name), &
631 10
FORMAT (
' OCN2ATM_COUPLING - error while receiving fields from ', &
633 20
FORMAT (
' OCN2ATM_COUPLING - error while sending fields to ', &
635 30
FORMAT (6x,
'OCN2ATM - (', i2.2,
') imported and (', i2.2, &
636 &
') exported fields,', t62,
't = ', a,/, 16x, &
637 &
'- ROMS coupling exchages wait clock (s):',/, 19x, &
638 &
'(Recv= ', 1p,e14.8,0p,
' Send= ', 1p,e14.8,0p,
')')
639 40
FORMAT (16x,
'- ',a,a, &
640 & /,19x,
'(Min= ',1p,e15.8,0p,
' Max= ',1p,e15.8,0p,
')')
643 END SUBROUTINE ocn2atm_coupling_tile
645 SUBROUTINE finalize_ocn2atm_coupling
662 CALL router_clean (romstowrf, myerror)
663 CALL attrvect_clean (ocn2atm_av, myerror)
664 CALL globalsegmap_clean (gsmaproms, myerror)
668 END SUBROUTINE finalize_ocn2atm_coupling
type(t_integer), dimension(:), allocatable exportid
integer, dimension(:), allocatable nexport
type(t_field), dimension(maxnumberfields) fields
character(len=240), dimension(:), allocatable exportlist
integer, dimension(:), allocatable nthreads
integer, dimension(:), allocatable nimport
type(t_integer), dimension(:), allocatable importid
type(t_forces), dimension(:), allocatable forces
type(t_ocean), dimension(:), allocatable ocean
integer, dimension(:), allocatable n
type(t_bounds), dimension(:), allocatable bounds
type(t_domain), dimension(:), allocatable domain
integer, dimension(:), allocatable lm
character(len=22), dimension(:), allocatable time_code
recursive subroutine wclock_off(ng, model, region, line, routine)
recursive subroutine wclock_on(ng, model, region, line, routine)