ROMS
Loading...
Searching...
No Matches
esmf_roms.h
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE esmf_roms_mod
3
4#if defined MODEL_COUPLING && defined ESMF_LIB
5!
6!git $Id$
7!=======================================================================
8! Copyright (c) 2002-2025 The ROMS Group !
9! Licensed under a MIT/X style license Hernan G. Arango !
10! See License_ROMS.md Ufuk Utku Turuncoglu !
11!=======================================================================
12! !
13! This module sets ROMS as the ocean gridded component using generic !
14! ESMF/NUOPC layer: !
15! !
16! ROMS_SetServices Sets ROMS component shared-object entry !
17! points using NUPOC generic methods for !
18! "initialize", "run", and "finalize". !
19! !
20! ROMS_SetInitializeP1 ROMS component phase 1 initialization: !
21! sets import and export fields long and !
22! short names into its respective state. !
23! !
24! ROMS_SetInitializeP2 ROMS component phase 2 initialization: !
25! Initializes component (ROMS_initialize), !
26! sets component grid (ROMS_SetGridArrays), !
27! and adds fields into import and export !
28! into respective states. !
29! !
30! ROMS_DataInit Exports ROMS component fields during !
31! initialization or restart. !
32! !
33! ROMS_SetClock Sets ROMS component date calendar, start !
34! and stop times, and coupling interval. !
35# ifdef ESM_SETRUNCLOCK
36! !
37! ROMS_SetRunClock Sets ROMS run clock manually. !
38# endif
39! !
40! ROMS_CheckImport Checks if ROMS component import field is !
41! at the correct time. !
42! !
43! ROMS_SetGridArrays Sets ROMS component staggered, horizontal !
44! grid arrays, and land/sea mask if any. !
45! !
46! ROMS_SetStates Adds ROMS component export and import !
47! fields into its respective state. !
48! !
49! ROMS_ModelAdvance Advances ROMS component for a coupling !
50! interval. It calls import and export !
51! routines. !
52! !
53! ROMS_SetFinalize Finalizes ROMS component execution. !
54! !
55! ROMS_Import Imports fields into ROMS. The fields are !
56! loaded into the snapshot storage arrays !
57! to allow time interpolation elsewhere. !
58! !
59! ROMS_Export Exports ROMS fields to other gridded !
60! components. !
61! !
62! ROMS_Rotate Rotates exchanged vector components from !
63! computational grid to geographical EAST !
64! and NORTH directions or vice versa. !
65! !
66! ESMF: Earth System Modeling Framework (Version 7 or higher) !
67! https://www.earthsystemcog.org/projects/esmf !
68! !
69! NUOPC: National Unified Operational Prediction Capability !
70! https://www.earthsystemcog.org/projects/nuopc !
71! !
72! ROMS: Regional Ocean Modeling System !
73! https://www.myroms.org !
74! !
75!=======================================================================
76!
77 USE esmf
78 USE nuopc
79 USE nuopc_model, &
80 & nuopc_setservices => setservices, &
81 & nuopc_label_advance => label_advance, &
82 & nuopc_label_datainitialize => label_datainitialize, &
83# ifdef ESM_SETRUNCLOCK
84 & nuopc_label_setrunclock => label_setrunclock, &
85# endif
86 & nuopc_label_setclock => label_setclock, &
87 & nuopc_label_checkimport => label_checkimport
88!
89 USE mod_esmf_esm ! ESM coupling structures and variables
90!
91!-----------------------------------------------------------------------
92! ROMS module association: parameters, variables, derived-type objects.
93!-----------------------------------------------------------------------
94!
95 USE roms_kernel_mod, ONLY : roms_initialize, &
96 & roms_run, &
97 & roms_finalize
98!
99 USE bc_2d_mod, ONLY : bc_r2d_tile
100 USE dateclock_mod, ONLY : roms_clock, caldate, time_string
101 USE exchange_2d_mod, ONLY : exchange_r2d_tile, &
102 & exchange_u2d_tile, &
103 & exchange_v2d_tile
104 USE get_metadata_mod, ONLY : couplingfield
105 USE mod_kinds, ONLY : dp, i4b, i8b, r4, r8
106 USE mod_forces, ONLY : forces
107 USE mod_grid, ONLY : grid
108 USE mod_iounits, ONLY : iname, sourcefile, stdout
109 USE mod_mixing, ONLY : mixing
110 USE mod_ncparam, ONLY : iinfo, idldwn, idlrad, idpair, &
111 & idqair, idrain, idsrad, idtair, &
112 & idtsur, iduair, idusms, idvair, &
113 & idvsms
114# ifdef TIME_INTERP
115 USE mod_netcdf, ONLY : netcdf_get_ivar, &
116 & netcdf_get_svar, &
117 & netcdf_get_time
118# endif
119 USE mod_ocean, ONLY : ocean
120 USE mod_param, ONLY : bounds, lm, mm, n, nghostpoints, &
121 & ngrids, ntilei, ntilej, inlm, &
122 & r2dvar, u2dvar, v2dvar
123 USE mod_scalars, ONLY : cp, ewperiodic, nsperiodic, noerror, &
124 & rclock, dt, exit_flag, itemp, isalt, &
125 & ntfirst, ntend, ntimes, &
126 & rho0, sec2day, tdays, time_ref
127 USE mod_stepping, ONLY : nstp, knew
128 USE mp_exchange_mod, ONLY : mp_exchange2d
129 USE strings_mod, ONLY : founderror, assign_string
130!
131!-----------------------------------------------------------------------
132 implicit none
133!-----------------------------------------------------------------------
134!
135 PUBLIC :: roms_setservices
136
137 PRIVATE :: roms_setinitializep1
138 PRIVATE :: roms_setinitializep2
139 PRIVATE :: roms_datainit
140 PRIVATE :: roms_setclock
141# ifdef ESM_SETRUNCLOCK
142 PRIVATE :: roms_setrunclock
143# endif
144 PRIVATE :: roms_checkimport
145 PRIVATE :: roms_setgridarrays
146 PRIVATE :: roms_setstates
147 PRIVATE :: roms_modeladvance
148 PRIVATE :: roms_setfinalize
149 PRIVATE :: roms_import
150 PRIVATE :: roms_export
151 PRIVATE :: roms_rotate
152!
153 PRIVATE
154!
155! Define parameters to rotate exchanged fields from geographical (EAST,
156! NORTH) to computational directions or vice versa. The resulting
157! vector components can be staggered (U- and V-points) or at cell
158! center (RHO-points: full or interior grid).
159!
160 integer, parameter :: geo2grid = 0 ! U- and V-points
161 integer, parameter :: geo2grid_rho = 0 ! RHO-points
162 integer, parameter :: grid2geo_rho = 1 ! export vector
163!
164!-----------------------------------------------------------------------
165 CONTAINS
166!-----------------------------------------------------------------------
167!
168 SUBROUTINE roms_setservices (model, rc)
169!
170!=======================================================================
171! !
172! Sets ROMS component shared-object entry points for "initialize", !
173! "run", and "finalize" by using NUOPC generic methods. !
174! !
175!=======================================================================
176!
177! Imported variable declarations.
178!
179 integer, intent(out) :: rc
180!
181 TYPE (esmf_gridcomp) :: model
182!
183! Local variable declarations.
184!
185 character (len=*), parameter :: myfile = &
186 & __FILE__//", ROMS_SetServices"
187!
188!-----------------------------------------------------------------------
189! Initialize return code flag to success state (no error).
190!-----------------------------------------------------------------------
191!
192 IF (esm_track) THEN
193 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetServices', &
194 & ', PET', petrank
195 FLUSH (trac)
196 END IF
197 rc=esmf_success
198!
199!-----------------------------------------------------------------------
200! Register NUOPC generic routines.
201!-----------------------------------------------------------------------
202!
203 CALL nuopc_compderive (model, &
204 & nuopc_setservices, &
205 & rc=rc)
206 IF (esmf_logfounderror(rctocheck=rc, &
207 & msg=esmf_logerr_passthru, &
208 & line=__line__, &
209 & file=myfile)) THEN
210 RETURN
211 END IF
212!
213!-----------------------------------------------------------------------
214! Register initialize routines.
215!-----------------------------------------------------------------------
216!
217! Set routine for Phase 1 initialization (import and export fields).
218!
219 CALL nuopc_compsetentrypoint (model, &
220 & methodflag=esmf_method_initialize, &
221 & phaselabellist=(/"IPDv00p1"/), &
222 & userroutine=roms_setinitializep1, &
223 & rc=rc)
224 IF (esmf_logfounderror(rctocheck=rc, &
225 & msg=esmf_logerr_passthru, &
226 & line=__line__, &
227 & file=myfile)) THEN
228 RETURN
229 END IF
230!
231! Set routine for Phase 2 initialization (exchange arrays).
232!
233 CALL nuopc_compsetentrypoint (model, &
234 & methodflag=esmf_method_initialize, &
235 & phaselabellist=(/"IPDv00p2"/), &
236 & userroutine=roms_setinitializep2, &
237 & rc=rc)
238 IF (esmf_logfounderror(rctocheck=rc, &
239 & msg=esmf_logerr_passthru, &
240 & line=__line__, &
241 & file=myfile)) THEN
242 RETURN
243 END IF
244!
245!-----------------------------------------------------------------------
246! Attach ROMS component phase independent specializing methods.
247!-----------------------------------------------------------------------
248!
249! Set routine for export initial/restart fields.
250!
251 CALL nuopc_compspecialize (model, &
252 & speclabel=nuopc_label_datainitialize, &
253 & specroutine=roms_datainit, &
254 & rc=rc)
255 IF (esmf_logfounderror(rctocheck=rc, &
256 & msg=esmf_logerr_passthru, &
257 & line=__line__, &
258 & file=myfile)) THEN
259 RETURN
260 END IF
261!
262! Set routine for setting ROMS clock.
263!
264 CALL nuopc_compspecialize (model, &
265 & speclabel=nuopc_label_setclock, &
266 & specroutine=roms_setclock, &
267 & rc=rc)
268 IF (esmf_logfounderror(rctocheck=rc, &
269 & msg=esmf_logerr_passthru, &
270 & line=__line__, &
271 & file=myfile)) THEN
272 RETURN
273 END IF
274
275# ifdef ESM_SETRUNCLOCK
276!
277! Set routine for setting ROMS run clock manually. First, remove the
278! default.
279!
280 CALL esmf_methodremove (model, &
281 & nuopc_label_setrunclock, &
282 & rc=rc)
283 IF (esmf_logfounderror(rctocheck=rc, &
284 & msg=esmf_logerr_passthru, &
285 & line=__line__, &
286 & file=myfile)) THEN
287 RETURN
288 END IF
289!
290 CALL nuopc_compspecialize (model, &
291 & speclabel=nuopc_label_setrunclock, &
292 & specroutine=roms_setrunclock, &
293 & rc=rc)
294 IF (esmf_logfounderror(rctocheck=rc, &
295 & msg=esmf_logerr_passthru, &
296 & line=__line__, &
297 & file=myfile)) THEN
298 RETURN
299 END IF
300# endif
301!
302! Set routine for checking import state.
303!
304 CALL nuopc_compspecialize (model, &
305 & speclabel=nuopc_label_checkimport, &
306 & specphaselabel="RunPhase1", &
307 & specroutine=roms_checkimport, &
308 & rc=rc)
309 IF (esmf_logfounderror(rctocheck=rc, &
310 & msg=esmf_logerr_passthru, &
311 & line=__line__, &
312 & file=myfile)) THEN
313 RETURN
314 END IF
315!
316! Set routine for time-stepping ROMS component.
317!
318 CALL nuopc_compspecialize (model, &
319 & speclabel=nuopc_label_advance, &
320 & specroutine=roms_modeladvance, &
321 & rc=rc)
322 IF (esmf_logfounderror(rctocheck=rc, &
323 & msg=esmf_logerr_passthru, &
324 & line=__line__, &
325 & file=myfile)) THEN
326 RETURN
327 END IF
328!
329!-----------------------------------------------------------------------
330! Register ROMS finalize routine.
331!-----------------------------------------------------------------------
332!
333 CALL esmf_gridcompsetentrypoint (model, &
334 & methodflag=esmf_method_finalize, &
335 & userroutine=roms_setfinalize, &
336 & rc=rc)
337 IF (esmf_logfounderror(rctocheck=rc, &
338 & msg=esmf_logerr_passthru, &
339 & line=__line__, &
340 & file=myfile)) THEN
341 RETURN
342 END IF
343!
344 IF (esm_track) THEN
345 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetServices', &
346 & ', PET', petrank
347 FLUSH (trac)
348 END IF
349!
350 RETURN
351 END SUBROUTINE roms_setservices
352!
353 SUBROUTINE roms_setinitializep1 (model, &
354 & ImportState, ExportState, &
355 & clock, rc)
356!
357!=======================================================================
358! !
359! ROMS component Phase 1 initialization: sets import and export !
360! fields long and short names into its respective state. !
361! !
362!=======================================================================
363!
364! Imported variable declarations.
365!
366 integer, intent(out) :: rc
367!
368 TYPE (esmf_gridcomp) :: model
369 TYPE (esmf_state) :: importstate
370 TYPE (esmf_state) :: exportstate
371 TYPE (esmf_clock) :: clock
372!
373! Local variable declarations.
374!
375 integer :: i, ng, localpet
376!
377 character (len=100) :: coupledset, statelabel
378 character (len=240) :: standardname, shortname
379
380 character (len=*), parameter :: myfile = &
381 & __FILE__//", ROMS_SetInitializeP1"
382!
383!-----------------------------------------------------------------------
384! Initialize return code flag to success state (no error).
385!-----------------------------------------------------------------------
386!
387 IF (esm_track) THEN
388 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetInitializeP1', &
389 & ', PET', petrank
390 FLUSH (trac)
391 END IF
392 rc=esmf_success
393!
394!-----------------------------------------------------------------------
395! Querry the Virtual Machine (VM) parallel environmemt for the MPI
396! current node rank.
397!-----------------------------------------------------------------------
398!
399 CALL esmf_gridcompget (model, &
400 & localpet=localpet, &
401 & rc=rc)
402 IF (esmf_logfounderror(rctocheck=rc, &
403 & msg=esmf_logerr_passthru, &
404 & line=__line__, &
405 & file=myfile)) THEN
406 RETURN
407 END IF
408!
409!-----------------------------------------------------------------------
410! Set ROMS Import State metadata.
411!-----------------------------------------------------------------------
412!
413! Add ROMS import state(s). If nesting, each grid has its own import
414! state.
415!
416 importing : IF (nimport(iroms).gt.0) THEN
417 DO ng=1,models(iroms)%Ngrids
418 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
419 coupledset=trim(coupled(iroms)%SetLabel(ng))
420 statelabel=trim(coupled(iroms)%ImpLabel(ng))
421 CALL nuopc_addnestedstate (importstate, &
422 & cplset=trim(coupledset), &
423 & nestedstatename=trim(statelabel),&
424 & nestedstate=models(iroms)% &
425 & importstate(ng), &
426 rc=rc)
427 IF (esmf_logfounderror(rctocheck=rc, &
428 & msg=esmf_logerr_passthru, &
429 & line=__line__, &
430 & file=myfile)) THEN
431 RETURN
432 END IF
433 IF (localpet.eq.0) THEN
434 WRITE (cplout,10) 'ROMS adding Import Nested State: ', &
435 & trim(statelabel), ng
436 END IF
437!
438! Add fields import state.
439!
440 DO i=1,nimport(iroms)
441 standardname=models(iroms)%ImportField(i)%standard_name
442 shortname =models(iroms)%ImportField(i)%short_name
443 IF (localpet.eq.0) THEN
444 WRITE (cplout,20) 'Advertising Import Field: ', &
445 & trim(shortname), trim(standardname)
446 END IF
447 CALL nuopc_advertise (models(iroms)%ImportState(ng), &
448 & standardname=trim(standardname), &
449 & name=trim(shortname), &
450 & rc=rc)
451 IF (esmf_logfounderror(rctocheck=rc, &
452 & msg=esmf_logerr_passthru, &
453 & line=__line__, &
454 & file=myfile)) THEN
455 RETURN
456 END IF
457
458# ifdef LONGWAVE_OUT
459!
460 IF (trim(shortname).eq.'LWrad') THEN
461 rc=esmf_rc_not_valid
462 IF (localpet.eq.0) THEN
463 WRITE (cplout,30) trim(shortname), 'LONGWAVE_OUT', &
464 & 'downward longwave radiation: dLWrad', &
465 & 'LONGWAVE_OUT'
466 END IF
467 IF (esmf_logfounderror(rctocheck=rc, &
468 & msg=esmf_logerr_passthru, &
469 & line=__line__, &
470 & file=myfile)) THEN
471 RETURN
472 END IF
473 END IF
474# endif
475 END DO
476 END IF
477 END DO
478 END IF importing
479!
480!-----------------------------------------------------------------------
481! Set ROMS Export State metadata.
482!-----------------------------------------------------------------------
483!
484! Add ROMS export state. If nesting, each grid has its own export
485! state.
486!
487 exporting : IF (nexport(iroms).gt.0) THEN
488 DO ng=1,models(iroms)%Ngrids
489 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
490 coupledset=trim(coupled(iroms)%SetLabel(ng))
491 statelabel=trim(coupled(iroms)%ExpLabel(ng))
492 CALL nuopc_addnestedstate (exportstate, &
493 & cplset=trim(coupledset), &
494 & nestedstatename=trim(statelabel),&
495 & nestedstate=models(iroms)% &
496 & exportstate(ng), &
497 rc=rc)
498 IF (esmf_logfounderror(rctocheck=rc, &
499 & msg=esmf_logerr_passthru, &
500 & line=__line__, &
501 & file=myfile)) THEN
502 RETURN
503 END IF
504 IF (localpet.eq.0) THEN
505 WRITE (cplout,10) 'ROMS adding Export Nested State: ', &
506 & trim(statelabel), ng
507 END IF
508!
509! Add fields to export state.
510!
511 DO i=1,nexport(iroms)
512 standardname=models(iroms)%ExportField(i)%standard_name
513 shortname =models(iroms)%ExportField(i)%short_name
514 IF (localpet.eq.0) THEN
515 WRITE (cplout,20) 'Advertising Export Field: ', &
516 & trim(shortname), trim(standardname)
517 END IF
518 CALL nuopc_advertise (models(iroms)%ExportState(ng), &
519 & standardname=trim(standardname), &
520 & name=trim(shortname), &
521 & rc=rc)
522 IF (esmf_logfounderror(rctocheck=rc, &
523 & msg=esmf_logerr_passthru, &
524 & line=__line__, &
525 & file=myfile)) THEN
526 RETURN
527 END IF
528 END DO
529 END IF
530 END DO
531 END IF exporting
532!
533 IF (esm_track) THEN
534 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetInitializeP1', &
535 & ', PET', petrank
536 FLUSH (trac)
537 END IF
538!
539 10 FORMAT (/,a,a,', ng = ',i0,/,31('='),/)
540 20 FORMAT (2x,a,"'",a,"'",t45,a)
541# ifdef LONGWAVE_OUT
542 30 FORMAT (/,' ROMS_SetInitializeP1 - incorrect field to process: ', &
543 & a,/,24x,'when activating option: ',a,/,24x, &
544 & 'use instead ',a,/,24x,'or deactivate option: ',a,/)
545# endif
546!
547 RETURN
548 END SUBROUTINE roms_setinitializep1
549!
550 SUBROUTINE roms_setinitializep2 (model, &
551 & ImportState, ExportState, &
552 & clock, rc)
553!
554!=======================================================================
555! !
556! ROMS component Phase 2 initialization: Initializes ROMS, sets !
557! component grid, and adds import and export fields to respective !
558! states. !
559! !
560!=======================================================================
561!
562! Imported variable declarations.
563!
564 integer, intent(out) :: rc
565!
566 TYPE (esmf_gridcomp) :: model
567 TYPE (esmf_state) :: importstate
568 TYPE (esmf_state) :: exportstate
569 TYPE (esmf_clock) :: clock
570!
571! Local variable declarations.
572!
573 logical, save :: first
574!
575 integer :: lbi, ubi, lbj, ubj
576 integer :: mycomm
577 integer :: ng, localpet, petcount, tile
578!
579 real (dp) :: driverduration, romsduration
580!
581 character (len=*), parameter :: myfile = &
582 & __FILE__//", ROMS_SetInitializeP2"
583!
584 TYPE (esmf_timeinterval) :: runduration, timestep
585 TYPE (esmf_time) :: currtime, starttime
586 TYPE (esmf_vm) :: vm
587!
588!-----------------------------------------------------------------------
589! Initialize return code flag to success state (no error).
590!-----------------------------------------------------------------------
591!
592 IF (esm_track) THEN
593 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetInitializeP2', &
594 & ', PET', petrank
595 FLUSH (trac)
596 END IF
597 rc=esmf_success
598!
599!-----------------------------------------------------------------------
600! Query the Virtual Machine (VM) parallel environmemt for the MPI
601! communicator handle and current node rank.
602!-----------------------------------------------------------------------
603!
604 CALL esmf_gridcompget (model, &
605 & vm=vm, &
606 & rc=rc)
607 IF (esmf_logfounderror(rctocheck=rc, &
608 & msg=esmf_logerr_passthru, &
609 & line=__line__, &
610 & file=myfile)) THEN
611 RETURN
612 END IF
613!
614 CALL esmf_vmget (vm, &
615 & localpet=localpet, &
616 & petcount=petcount, &
617 & mpicommunicator=mycomm, &
618 & rc=rc)
619 IF (esmf_logfounderror(rctocheck=rc, &
620 & msg=esmf_logerr_passthru, &
621 & line=__line__, &
622 & file=myfile)) THEN
623 RETURN
624 END IF
625 tile=localpet
626 esmcomm(iroms)=mycomm
627!
628!-----------------------------------------------------------------------
629! Initialize ROMS component. In nested applications, ROMS kernel will
630! allocate and initialize all grids with a single call to
631! "ROMS_initialize".
632!-----------------------------------------------------------------------
633!
634 first=.true.
635 CALL roms_initialize (first, mpicomm=mycomm)
636 IF (exit_flag.ne.noerror) THEN
637 rc=esmf_rc_obj_init
638 IF (esmf_logfounderror(rctocheck=rc, &
639 & msg=esmf_logerr_passthru, &
640 & line=__line__, &
641 & file=myfile)) THEN
642 RETURN
643 END IF
644 END IF
645
646# ifdef TIME_INTERP
647!
648!-----------------------------------------------------------------------
649! Create field time interpolation variable attributes NetCDF file. It
650! needs to be done after ROMS initialization since the NetCDF and
651! mpi interface use several variables from ROMS profiling that need
652! to be allocated.
653!-----------------------------------------------------------------------
654!
655 IF (petlayoutoption.eq.'CONCURRENT') THEN
656 CALL def_fieldatt (vm, rc)
657 IF (esmf_logfounderror(rctocheck=rc, &
658 & msg=esmf_logerr_passthru, &
659 & line=__line__, &
660 & file=myfile)) THEN
661 RETURN
662 END IF
663 END IF
664# endif
665!
666!-----------------------------------------------------------------------
667! Check ROMS simulation length and compare with that of the coupling
668! driver. We need to use the driver clock here since the ROMS
669! component clock has been not created before this intialization
670! phase.
671!-----------------------------------------------------------------------
672!
673 IF (models(iroms)%IsActive) THEN
674 CALL esmf_clockget (clockinfo(idriver)%Clock, &
675 & currtime=currtime, &
676 & timestep=timestep, &
677 & runduration=runduration, &
678 & rc=rc)
679 IF (esmf_logfounderror(rctocheck=rc, &
680 & msg=esmf_logerr_passthru, &
681 & line=__line__, &
682 & file=myfile)) THEN
683 RETURN
684 END IF
685!
686# ifdef REGRESS_STARTCLOCK
687 CALL esmf_timeintervalget (runduration-timestep, &
688 & s_r8=driverduration, &
689 & rc=rc)
690 IF (esmf_logfounderror(rctocheck=rc, &
691 & msg=esmf_logerr_passthru, &
692 & line=__line__, &
693 & file=myfile)) THEN
694 RETURN
695 END IF
696# else
697 CALL esmf_timeintervalget (runduration, &
698 & s_r8=driverduration, &
699 & rc=rc)
700 IF (esmf_logfounderror(rctocheck=rc, &
701 & msg=esmf_logerr_passthru, &
702 & line=__line__, &
703 & file=myfile)) THEN
704 RETURN
705 END IF
706# endif
707!
708 DO ng=1,models(iroms)%Ngrids
709 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
710 romsduration=(ntend(ng)-ntfirst(ng)+1)*dt(ng)
711 IF (romsduration.ne.driverduration) THEN
712 IF (localpet.eq.0) THEN
713 WRITE (cplout,10) romsduration, driverduration, &
714 & trim(inpname(iroms))
715 END IF
716 rc=esmf_rc_not_valid
717 RETURN
718 END IF
719 END IF
720 END DO
721 END IF
722!
723!-----------------------------------------------------------------------
724! Set-up grid and load coordinate data.
725!-----------------------------------------------------------------------
726!
727 DO ng=1,models(iroms)%Ngrids
728 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
729 CALL roms_setgridarrays (ng, tile, model, rc)
730 IF (esmf_logfounderror(rctocheck=rc, &
731 & msg=esmf_logerr_passthru, &
732 & line=__line__, &
733 & file=myfile)) THEN
734 RETURN
735 END IF
736 END IF
737 END DO
738!
739!-----------------------------------------------------------------------
740! Set-up fields and register to import/export states.
741!-----------------------------------------------------------------------
742!
743 DO ng=1,models(iroms)%Ngrids
744 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
745 CALL roms_setstates (ng, tile, model, rc)
746 IF (esmf_logfounderror(rctocheck=rc, &
747 & msg=esmf_logerr_passthru, &
748 & line=__line__, &
749 & file=myfile)) THEN
750 RETURN
751 END IF
752 END IF
753 END DO
754!
755 IF (esm_track) THEN
756 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetInitializeP2', &
757 & ', PET', petrank
758 FLUSH (trac)
759 END IF
760!
761 10 FORMAT (/,' ROMS_SetInitializeP2 - inconsitent configuration ', &
762 & 'run duration',/,24x, &
763 & 'ROMS Duration = ',f20.2,' seconds',/,24x, &
764 & 'Coupling Duration = ',f20.2,' seconds',/,24x, &
765 & 'Check paramenter NTIMES in ''',a,'''',a)
766!
767 RETURN
768 END SUBROUTINE roms_setinitializep2
769!
770 SUBROUTINE roms_datainit (model, rc)
771!
772!=======================================================================
773! !
774! Exports ROMS component fields during initialization or restart. !
775! !
776!=======================================================================
777!
778! Imported variable declarations.
779!
780 integer, intent(out) :: rc
781!
782 TYPE (esmf_gridcomp) :: model
783!
784! Local variable declarations.
785!
786 integer :: ng
787!
788 character (len=*), parameter :: myfile = &
789 & __FILE__//", ROMS_DataInit"
790!
791 TYPE (esmf_time) :: currenttime
792!
793!-----------------------------------------------------------------------
794! Initialize return code flag to success state (no error).
795!-----------------------------------------------------------------------
796!
797 IF (esm_track) THEN
798 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_DataInit', &
799 & ', PET', petrank
800 FLUSH (trac)
801 END IF
802 rc=esmf_success
803!
804!-----------------------------------------------------------------------
805! Get gridded component clock current time.
806!-----------------------------------------------------------------------
807!
808 CALL esmf_clockget (clockinfo(iroms)%Clock, &
809 & currtime=currenttime, &
810 & rc=rc)
811 IF (esmf_logfounderror(rctocheck=rc, &
812 & msg=esmf_logerr_passthru, &
813 & line=__line__, &
814 & file=myfile)) THEN
815 RETURN
816 END IF
817!
818!-----------------------------------------------------------------------
819! Export initialization or restart fields.
820!-----------------------------------------------------------------------
821!
822 IF (nexport(iroms).gt.0) THEN
823 DO ng=1,models(iroms)%Ngrids
824 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
825 CALL roms_export (ng, model, rc)
826 IF (esmf_logfounderror(rctocheck=rc, &
827 & msg=esmf_logerr_passthru, &
828 & line=__line__, &
829 & file=myfile)) THEN
830 RETURN
831 END IF
832 END IF
833 END DO
834 END IF
835!
836 IF (esm_track) THEN
837 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_DataInit', &
838 & ', PET', petrank
839 FLUSH (trac)
840 END IF
841!
842 RETURN
843 END SUBROUTINE roms_datainit
844!
845 SUBROUTINE roms_setclock (model, rc)
846!
847!=======================================================================
848! !
849! Sets ROMS component date calendar, start and stop time, and !
850! coupling interval. At initilization, the variable "tdays" is !
851! the initial time meassured in fractional days since the reference !
852! time. !
853! !
854!=======================================================================
855!
856! Imported variable declarations.
857!
858 integer, intent(out) :: rc
859!
860 TYPE (esmf_gridcomp) :: model
861!
862! Local variable declarations.
863!
864 integer :: ng
865 integer :: ref_year, start_year, stop_year
866 integer :: ref_month, start_month, stop_month
867 integer :: ref_day, start_day, stop_day
868 integer :: ref_hour, start_hour, stop_hour
869 integer :: ref_minute, start_minute, stop_minute
870 integer :: ref_second, start_second, stop_second
871 integer :: petcount, localpet
872 integer :: timefrac
873!
874 real(dp) :: mystarttime, mystoptime
875!
876 character (len= 22) :: calendar
877 character (len= 22) :: starttimestring, stoptimestring
878 character (len=160) :: message
879
880 character (len=*), parameter :: myfile = &
881 & __FILE__//", ROMS_SetClock"
882!
883 TYPE (esmf_calkind_flag) :: caltype
884 TYPE (esmf_clock) :: clock
885 TYPE (esmf_vm) :: vm
886!
887!-----------------------------------------------------------------------
888! Initialize return code flag to success state (no error).
889!-----------------------------------------------------------------------
890!
891 IF (esm_track) THEN
892 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetClock', &
893 & ', PET', petrank
894 FLUSH (trac)
895 END IF
896 rc=esmf_success
897!
898!-----------------------------------------------------------------------
899! Querry the Virtual Machine (VM) parallel environmemt for the MPI
900! communicator handle and current node rank.
901!-----------------------------------------------------------------------
902!
903 CALL esmf_gridcompget (model, &
904 & localpet=localpet, &
905 & petcount=petcount, &
906 & vm=vm, &
907 & rc=rc)
908 IF (esmf_logfounderror(rctocheck=rc, &
909 & msg=esmf_logerr_passthru, &
910 & line=__line__, &
911 & file=myfile)) THEN
912 RETURN
913 END IF
914!
915!-----------------------------------------------------------------------
916! Create ROMS component clock.
917!-----------------------------------------------------------------------
918!
919! Set ROMS time reference: model time is meassured as seconds since
920! reference time. ESMF does not support the Proleptic Gregorian
921! Calendar that extends backward the dates preceeding 15 October 1582
922! which always have a year length of 365.2425 days.
923!
924 ref_year =rclock%year
925 ref_month =rclock%month
926 ref_day =rclock%day
927 ref_hour =rclock%hour
928 ref_minute=rclock%minutes
929 ref_second=rclock%seconds
930 calendar =trim(rclock%calendar)
931!
932 IF (int(time_ref).eq.-1) THEN
933 caltype=esmf_calkind_360day
934 ELSE
935 caltype=esmf_calkind_gregorian
936 END IF
937!
938 clockinfo(iroms)%Calendar=esmf_calendarcreate(caltype, &
939 & name=trim(calendar),&
940 & rc=rc)
941 IF (esmf_logfounderror(rctocheck=rc, &
942 & msg=esmf_logerr_passthru, &
943 & line=__line__, &
944 & file=myfile)) THEN
945 RETURN
946 END IF
947!
948! Set reference time.
949!
950 CALL esmf_timeset (clockinfo(iroms)%ReferenceTime, &
951 & yy=ref_year, &
952 & mm=ref_month, &
953 & dd=ref_day, &
954 & h =ref_hour, &
955 & m =ref_minute, &
956 & s =ref_second, &
957 & calendar=clockinfo(iroms)%Calendar, &
958 & rc=rc)
959 IF (esmf_logfounderror(rctocheck=rc, &
960 & msg=esmf_logerr_passthru, &
961 & line=__line__, &
962 & file=myfile)) THEN
963 RETURN
964 END IF
965
966# ifdef REGRESS_STARTCLOCK
967!
968! Set start time, use the minimum value of all nested grids. Notice
969! that a coupling interval is substracted since the driver clock was
970! regressed by that amount to properly initialize all ESM components.
971!
972 mystarttime=minval(tdays)-clockinfo(iroms)%Time_Step/86400.0_dp
973# else
974!
975! Set start time, use the minimum value of all nested grids.
976!
977 mystarttime=minval(tdays)
978# endif
979!
980 clockinfo(iroms)%Time_Start=mystarttime*86400.0_dp
981 CALL caldate (mystarttime, &
982 & yy_i=start_year, &
983 & mm_i=start_month, &
984 & dd_i=start_day, &
985 & h_i =start_hour, &
986 & m_i =start_minute, &
987 & s_i =start_second)
988 CALL time_string (clockinfo(iroms)%Time_Start, &
989 & clockinfo(iroms)%Time_StartString)
990!
991 CALL esmf_timeset (clockinfo(iroms)%StartTime, &
992 & yy=start_year, &
993 & mm=start_month, &
994 & dd=start_day, &
995 & h =start_hour, &
996 & m =start_minute, &
997 & s =start_second, &
998 & ms=0, &
999 & calendar=clockinfo(iroms)%Calendar, &
1000 & rc=rc)
1001 IF (esmf_logfounderror(rctocheck=rc, &
1002 & msg=esmf_logerr_passthru, &
1003 & line=__line__, &
1004 & file=myfile)) THEN
1005 RETURN
1006 END IF
1007!
1008! Set stop time, use the maximum value of all nested grids.
1009!
1010 mystoptime=0.0_dp
1011 DO ng=1,models(iroms)%Ngrids
1012 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
1013 mystoptime=max(mystoptime, &
1014 & tdays(ng)+(real(ntimes(ng),dp)*dt(ng))*sec2day)
1015 END IF
1016 END DO
1017 clockinfo(iroms)%Time_Stop=mystoptime*86400.0_dp
1018 CALL caldate (mystoptime, &
1019 & yy_i=stop_year, &
1020 & mm_i=stop_month, &
1021 & dd_i=stop_day, &
1022 & h_i =stop_hour, &
1023 & m_i =stop_minute, &
1024 & s_i =stop_second)
1025 CALL time_string (clockinfo(iroms)%Time_Stop, &
1026 & clockinfo(iroms)%Time_StopString)
1027!
1028 CALL esmf_timeset (clockinfo(iroms)%StopTime, &
1029 & yy=stop_year, &
1030 & mm=stop_month, &
1031 & dd=stop_day, &
1032 & h =stop_hour, &
1033 & m =stop_minute, &
1034 & s =stop_second, &
1035 & calendar=clockinfo(iroms)%Calendar, &
1036 & rc=rc)
1037 IF (esmf_logfounderror(rctocheck=rc, &
1038 & msg=esmf_logerr_passthru, &
1039 & line=__line__, &
1040 & file=myfile)) THEN
1041 RETURN
1042 END IF
1043!
1044!-----------------------------------------------------------------------
1045! Modify component clock time step.
1046!-----------------------------------------------------------------------
1047!
1048 timefrac=0
1049 DO ng=1,models(iroms)%Ngrids
1050 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
1051 timefrac=max(timefrac, &
1052 & maxval(models(iroms)%TimeFrac(ng,:), &
1053 & mask=models(:)%IsActive))
1054 END IF
1055 END DO
1056 IF (timefrac.lt.1) THEN ! needs to be 1 or greater
1057 rc=esmf_rc_not_set ! cannot be 0
1058 IF (esmf_logfounderror(rctocheck=rc, &
1059 & msg=esmf_logerr_passthru, &
1060 & line=__line__, &
1061 & file=myfile)) THEN
1062 RETURN
1063 END IF
1064 END IF
1065!
1066 clockinfo(iroms)%TimeStep=clockinfo(idriver)%TimeStep/timefrac
1067!
1068!-----------------------------------------------------------------------
1069! Create ROMS component clock.
1070!-----------------------------------------------------------------------
1071!
1072 clockinfo(iroms)%Name='ROMS_clock'
1073 clock=esmf_clockcreate(clockinfo(iroms)%TimeStep, &
1074 & clockinfo(iroms)%StartTime, &
1075 & stoptime =clockinfo(iroms)%StopTime, &
1076 & reftime =clockinfo(iroms)%ReferenceTime, &
1077 & name =trim(clockinfo(iroms)%Name), &
1078 & rc=rc)
1079 IF (esmf_logfounderror(rctocheck=rc, &
1080 & msg=esmf_logerr_passthru, &
1081 & line=__line__, &
1082 & file=myfile)) THEN
1083 RETURN
1084 END IF
1085 clockinfo(iroms)%Clock=clock
1086!
1087! Set ROMS component clock.
1088!
1089 CALL esmf_gridcompset (model, &
1090 & clock=clockinfo(iroms)%Clock, &
1091 & rc=rc)
1092 IF (esmf_logfounderror(rctocheck=rc, &
1093 & msg=esmf_logerr_passthru, &
1094 & line=__line__, &
1095 & file=myfile)) THEN
1096 RETURN
1097 END IF
1098!
1099! Get current time.
1100!
1101 CALL esmf_clockget (clockinfo(iroms)%Clock, &
1102 & currtime=clockinfo(iroms)%CurrentTime, &
1103 & rc=rc)
1104 IF (esmf_logfounderror(rctocheck=rc, &
1105 & msg=esmf_logerr_passthru, &
1106 & line=__line__, &
1107 & file=myfile)) THEN
1108 RETURN
1109 END IF
1110!
1111!-----------------------------------------------------------------------
1112! Compare driver time against ROMS component time.
1113!-----------------------------------------------------------------------
1114!
1115 IF (clockinfo(idriver)%Restarted) THEN
1116 starttimestring=clockinfo(idriver)%Time_RestartString
1117 ELSE
1118 starttimestring=clockinfo(idriver)%Time_StartString
1119 END IF
1120!
1121! Report start and stop time clocks.
1122!
1123 IF (localpet.eq.0) THEN
1124 WRITE (cplout,'(/)')
1125 WRITE (cplout,10) 'DRIVER Calendar: ', &
1126 & trim(clockinfo(idriver)%CalendarString), &
1127 & 'DRIVER Start Clock: ', &
1128 & trim(clockinfo(idriver)%Time_StartString), &
1129 & 'DRIVER Stop Clock: ', &
1130 & trim(clockinfo(idriver)%Time_StopString)
1131!
1132 WRITE (cplout,10) 'ROMS Calendar: ', &
1133 & trim(clockinfo(iroms)%CalendarString), &
1134 & 'ROMS Start Clock: ', &
1135 & trim(clockinfo(iroms)%Time_StartString), &
1136 & 'ROMS Stop Clock: ', &
1137 & trim(clockinfo(iroms)%Time_StopString)
1138 END IF
1139!
1140! Compare Driver and ROMS clocks.
1141!
1142 IF (clockinfo(iroms)%Time_StartString(1:19).ne. &
1143 & starttimestring(1:19)) THEN
1144 IF (localpet.eq.0) THEN
1145 WRITE (cplout,20) 'ROMS Start Time: ', &
1146 & clockinfo(iroms)%Time_StartString(1:19), &
1147 & 'Driver Start Time: ', &
1148 & trim(starttimestring), &
1149 & ' are not equal!'
1150 END IF
1151 message='Driver and ROMS start times do not match: '// &
1152 & 'please check the config files.'
1153 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
1154 & msg=trim(message))
1155 RETURN
1156 END IF
1157!
1158 IF (clockinfo(iroms )%Time_StopString(1:19).ne. &
1159 & clockinfo(idriver)%Time_StopString(1:19)) THEN
1160 IF (localpet.eq.0) THEN
1161 WRITE (cplout,20) 'ROMS Stop Time: ', &
1162 & clockinfo(iroms )%Time_StopString(1:19), &
1163 & 'Driver Stop Time: ', &
1164 & trim(clockinfo(idriver)%Time_StopString), &
1165 & ' are not equal!'
1166 END IF
1167 message='Driver and ROMS stop times do not match: '// &
1168 & 'please check the config files.'
1169 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
1170 & msg=trim(message))
1171 RETURN
1172 END IF
1173!
1174 IF (trim(clockinfo(iroms )%CalendarString).ne. &
1175 & trim(clockinfo(idriver)%CalendarString)) THEN
1176 IF (localpet.eq.0) THEN
1177 WRITE (cplout,20) 'ROMS Calendar: ', &
1178 & trim(clockinfo(iroms )%CalendarString), &
1179 & 'Driver Calendar: ', &
1180 & trim(clockinfo(idriver)%CalendarString), &
1181 & ' are not equal!'
1182 END IF
1183 message='Driver and ROMS calendars do not match: '// &
1184 & 'please check the config files.'
1185 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
1186 & msg=trim(message))
1187 RETURN
1188 END IF
1189!
1190 IF (esm_track) THEN
1191 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetClock', &
1192 & ', PET', petrank
1193 FLUSH (trac)
1194 END IF
1195!
1196 10 FORMAT (2x,a,2x,a/,2x,a,2x,a,/,2x,a,2x,a,/)
1197 20 FORMAT (/,2x,a,a,/,2x,a,a,/,2x,a)
1198!
1199 RETURN
1200 END SUBROUTINE roms_setclock
1201
1202# ifdef ESM_SETRUNCLOCK
1203!
1204 SUBROUTINE roms_setrunclock (model, rc)
1205!
1206!=======================================================================
1207! !
1208! Sets ROMS run clock manually to avoid getting zero time stamps at !
1209! the first regridding call. !
1210! !
1211!=======================================================================
1212!
1213! Imported variable declarations.
1214!
1215 integer, intent(out) :: rc
1216!
1217 TYPE (esmf_gridcomp) :: model
1218!
1219! Local variable declarations.
1220!
1221 character (len=*), parameter :: myfile = &
1222 & __FILE__//", ROMS_SetRunClock"
1223!
1224 TYPE (esmf_clock) :: driverclock, modelclock
1225 TYPE (esmf_time) :: currtime
1226!
1227!-----------------------------------------------------------------------
1228! Initialize return code flag to success state (no error).
1229!-----------------------------------------------------------------------
1230!
1231 IF (esm_track) THEN
1232 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetRunClock', &
1233 & ', PET', petrank
1234 FLUSH (trac)
1235 END IF
1236 rc=esmf_success
1237!
1238!-----------------------------------------------------------------------
1239! Set ROMS run clock manually.
1240!-----------------------------------------------------------------------
1241!
1242! Inquire driver and model clock.
1243!
1244 CALL nuopc_modelget (model, &
1245 & driverclock=driverclock, &
1246 & modelclock=modelclock, &
1247 & rc=rc)
1248 IF (esmf_logfounderror(rctocheck=rc, &
1249 & msg=esmf_logerr_passthru, &
1250 & line=__line__, &
1251 & file=myfile)) THEN
1252 RETURN
1253 END IF
1254!
1255! Set model clock to have the current start time as the driver clock.
1256!
1257 CALL esmf_clockget (driverclock, &
1258 & currtime=currtime, &
1259 & rc=rc)
1260 IF (esmf_logfounderror(rctocheck=rc, &
1261 & msg=esmf_logerr_passthru, &
1262 & line=__line__, &
1263 & file=myfile)) THEN
1264 RETURN
1265 END IF
1266!
1267 CALL esmf_clockset (modelclock, &
1268 & currtime=currtime, &
1269 & rc=rc)
1270 IF (esmf_logfounderror(rctocheck=rc, &
1271 & msg=esmf_logerr_passthru, &
1272 & line=__line__, &
1273 & file=myfile)) THEN
1274 RETURN
1275 END IF
1276!
1277! Check and set the component clock against the driver clock.
1278!
1279 CALL nuopc_compchecksetclock (model, &
1280 & driverclock, &
1281 & rc=rc)
1282 IF (esmf_logfounderror(rctocheck=rc, &
1283 & msg=esmf_logerr_passthru, &
1284 & line=__line__, &
1285 & file=myfile)) THEN
1286 RETURN
1287 END IF
1288!
1289 IF (esm_track) THEN
1290 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetRunClock', &
1291 & ', PET', petrank
1292 FLUSH (trac)
1293 END IF
1294!
1295 RETURN
1296 END SUBROUTINE roms_setrunclock
1297# endif
1298!
1299 SUBROUTINE roms_checkimport (model, rc)
1300!
1301!=======================================================================
1302! !
1303! Checks if ROMS component import field is at the correct time. !
1304! !
1305!=======================================================================
1306!
1307! Imported variable declarations.
1308!
1309 integer, intent(out) :: rc
1310!
1311 TYPE (esmf_gridcomp) :: model
1312!
1313! Local variable declarations.
1314!
1315 logical :: isvalid, atcorrecttime
1316!
1317 integer :: importcount, i, is, localpet, ng
1318!
1319 real (dp) :: tcurrentinseconds
1320!
1321 character (len=22) :: drivertimestring, fieldtimestring
1322
1323 character (len=*), parameter :: myfile = &
1324 & __FILE__//", ROMS_CheckImport"
1325!
1326 character (ESMF_MAXSTR) :: string, fieldname
1327 character (ESMF_MAXSTR), allocatable :: importnamelist(:)
1328!
1329 TYPE (esmf_clock) :: driverclock
1330 TYPE (esmf_field) :: field
1331 TYPE (esmf_time) :: starttime, currenttime
1332 TYPE (esmf_time) :: drivertime, fieldtime
1333 TYPE (esmf_timeinterval) :: timestep
1334 TYPE (esmf_vm) :: vm
1335!
1336!-----------------------------------------------------------------------
1337! Initialize return code flag to success state (no error).
1338!-----------------------------------------------------------------------
1339!
1340 IF (esm_track) THEN
1341 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_CheckImport', &
1342 & ', PET', petrank
1343 FLUSH (trac)
1344 END IF
1345 rc=esmf_success
1346!
1347!-----------------------------------------------------------------------
1348! Query component.
1349!-----------------------------------------------------------------------
1350!
1351 CALL nuopc_modelget (model, &
1352 & driverclock=driverclock, &
1353 & rc=rc)
1354 IF (esmf_logfounderror(rctocheck=rc, &
1355 & msg=esmf_logerr_passthru, &
1356 & line=__line__, &
1357 & file=myfile)) THEN
1358 RETURN
1359 END IF
1360!
1361 CALL esmf_gridcompget (model, &
1362 & localpet=localpet, &
1363 & vm=vm, &
1364 & rc=rc)
1365 IF (esmf_logfounderror(rctocheck=rc, &
1366 & msg=esmf_logerr_passthru, &
1367 & line=__line__, &
1368 & file=myfile)) THEN
1369 RETURN
1370 END IF
1371!
1372!-----------------------------------------------------------------------
1373! Get the start time and current time from driver clock.
1374!-----------------------------------------------------------------------
1375!
1376 CALL esmf_clockget (driverclock, &
1377 & timestep=timestep, &
1378 & starttime=starttime, &
1379 & currtime=drivertime, &
1380 & rc=rc)
1381 IF (esmf_logfounderror(rctocheck=rc, &
1382 & msg=esmf_logerr_passthru, &
1383 & line=__line__, &
1384 & file=myfile)) THEN
1385 RETURN
1386 END IF
1387!
1388! Adjust driver clock for semi-implicit coupling.
1389
1390 IF (couplingtype.eq.1) THEN
1391 currenttime=drivertime ! explicit coupling
1392 ELSE
1393 currenttime=drivertime+timestep ! semi-implicit coupling
1394 END IF
1395!
1396 CALL esmf_timeget (currenttime, &
1397 & s_r8=tcurrentinseconds, &
1398 & timestringisofrac=drivertimestring, &
1399 & rc=rc)
1400 IF (esmf_logfounderror(rctocheck=rc, &
1401 & msg=esmf_logerr_passthru, &
1402 & line=__line__, &
1403 & file=myfile)) THEN
1404 RETURN
1405 END IF
1406 is=index(drivertimestring, 'T') ! remove 'T' in
1407 IF (is.gt.0) drivertimestring(is:is)=' ' ! ISO 8601 format
1408!
1409!-----------------------------------------------------------------------
1410! Get list of import fields.
1411!-----------------------------------------------------------------------
1412!
1413 IF (nimport(iroms).gt.0) THEN
1414 nested_loop : DO ng=1,models(iroms)%Ngrids
1415 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
1416 CALL esmf_stateget (models(iroms)%ImportState(ng), &
1417 & itemcount=importcount, &
1418 & rc=rc)
1419 IF (esmf_logfounderror(rctocheck=rc, &
1420 & msg=esmf_logerr_passthru, &
1421 & line=__line__, &
1422 & file=myfile)) THEN
1423 RETURN
1424 END IF
1425!
1426 IF (.not.allocated(importnamelist)) THEN
1427 allocate ( importnamelist(importcount) )
1428 END IF
1429!
1430 CALL esmf_stateget (models(iroms)%ImportState(ng), &
1431 & itemnamelist=importnamelist, &
1432 & rc=rc)
1433 IF (esmf_logfounderror(rctocheck=rc, &
1434 & msg=esmf_logerr_passthru, &
1435 & line=__line__, &
1436 & file=myfile)) THEN
1437 RETURN
1438 END IF
1439!
1440!-----------------------------------------------------------------------
1441! Only check fields in the ImportState object.
1442!-----------------------------------------------------------------------
1443!
1444 field_loop : DO i=1,importcount
1445 fieldname=trim(importnamelist(i))
1446 CALL esmf_stateget (models(iroms)%ImportState(ng), &
1447 & itemname=trim(fieldname), &
1448 & field=field, &
1449 & rc=rc)
1450 IF (esmf_logfounderror(rctocheck=rc, &
1451 & msg=esmf_logerr_passthru, &
1452 & line=__line__, &
1453 & file=myfile)) THEN
1454 RETURN
1455 END IF
1456!
1457! If debugging, report field timestamp.
1458!
1459 IF (debuglevel.gt.1) THEN
1460 CALL nuopc_gettimestamp (field, &
1461 & isvalid = isvalid, &
1462 & time = fieldtime, &
1463 & rc = rc)
1464 IF (esmf_logfounderror(rctocheck=rc, &
1465 & msg=esmf_logerr_passthru, &
1466 & line=__line__, &
1467 & file=myfile)) THEN
1468 RETURN
1469 END IF
1470!
1471 IF (isvalid) THEN
1472 CALL esmf_timeget (fieldtime, &
1473 & timestringisofrac = fieldtimestring, &
1474 & rc=rc)
1475 IF (esmf_logfounderror(rctocheck=rc, &
1476 & msg=esmf_logerr_passthru, &
1477 & line=__line__, &
1478 & file=myfile)) THEN
1479 RETURN
1480 END IF
1481 is=index(fieldtimestring, 'T') ! remove 'T'
1482 IF (is.gt.0) fieldtimestring(is:is)=' '
1483!
1484 IF (localpet.eq.0) THEN
1485 WRITE (cplout,10) trim(fieldname), &
1486 & trim(fieldtimestring), &
1487 & trim(drivertimestring)
1488 END IF
1489 END IF
1490 END IF
1491!
1492! Check if import field is at the correct time.
1493!
1494 string='ROMS_CheckImport - '//trim(fieldname)//' field'
1495!
1496 atcorrecttime=nuopc_isattime(field, &
1497 & currenttime, &
1498 & rc=rc)
1499 IF (esmf_logfounderror(rctocheck=rc, &
1500 & msg=esmf_logerr_passthru, &
1501 & line=__line__, &
1502 & file=myfile)) THEN
1503 RETURN
1504 END IF
1505!
1506 IF (.not.atcorrecttime) THEN
1507 CALL report_timestamp (field, currenttime, &
1508 & localpet, trim(string), rc)
1509!
1510 string='NUOPC INCOMPATIBILITY DETECTED: Import '// &
1511 & 'Fields not at correct time'
1512 CALL esmf_logseterror(esmf_rc_not_valid, &
1513 & msg=trim(string), &
1514 & line=__line__, &
1515 & file=myfile, &
1516 & rctoreturn=rc)
1517 RETURN
1518 END IF
1519 END DO field_loop
1520 IF (allocated(importnamelist)) deallocate (importnamelist)
1521 END IF
1522 END DO nested_loop
1523 END IF
1524!
1525 IF (esm_track) THEN
1526 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_CheckImport', &
1527 & ', PET', petrank
1528 FLUSH (trac)
1529 END IF
1530!
1531 10 FORMAT (1x,'ROMS_CheckImport - ',a,':',t32,'TimeStamp = ',a, &
1532 & ', DriverTime = ',a)
1533!
1534 RETURN
1535 END SUBROUTINE roms_checkimport
1536!
1537 SUBROUTINE roms_setgridarrays (ng, tile, model, rc)
1538!
1539!=======================================================================
1540! !
1541! Sets ROMS component staggered, horizontal grids arrays and !
1542! land/sea mask, if any. !
1543! !
1544!=======================================================================
1545!
1546! Imported variable declarations.
1547!
1548 integer, intent(in) :: ng, tile
1549 integer, intent(out) :: rc
1550!
1551 TYPE (esmf_gridcomp), intent(inout) :: model
1552!
1553! Local variable declarations.
1554!
1555 integer :: mytile, gtype, i, ivar, j, node
1556 integer :: istr, iend, jstr, jend
1557 integer :: istrr, iendr, jstrr, jendr
1558 integer :: localde, localdecount
1559 integer :: staggeredgelwidth(2)
1560 integer :: staggeredgeuwidth(2)
1561!
1562 integer, allocatable :: deblocklist(:,:,:)
1563 integer (i4b), pointer :: ptrm(:,:) => null() ! land/sea mask
1564!
1565 real (dp), pointer :: ptra(:,:) => null() ! area
1566 real (dp), pointer :: ptrx(:,:) => null() ! longitude
1567 real (dp), pointer :: ptry(:,:) => null() ! latitude
1568!
1569 character (len=*), parameter :: myfile = &
1570 & __FILE__//", ROMS_SetGridArrays"
1571!
1572 TYPE (esmf_distgrid) :: distgrid
1573 TYPE (esmf_staggerloc) :: staggerloc
1574!
1575!-----------------------------------------------------------------------
1576! Initialize return code flag to success state (no error).
1577!-----------------------------------------------------------------------
1578!
1579 IF (esm_track) THEN
1580 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetGridArrays', &
1581 & ', PET', petrank
1582 FLUSH (trac)
1583 END IF
1584 rc=esmf_success
1585!
1586!-----------------------------------------------------------------------
1587! Set limits of the grid arrays based on tile decomposition (MPI rank)
1588! and nested grid number.
1589!-----------------------------------------------------------------------
1590!
1591 istrr=bounds(ng)%IstrR(tile) ! Full range I-starting (RHO)
1592 iendr=bounds(ng)%IendR(tile) ! Full range I-ending (RHO)
1593 jstrr=bounds(ng)%JstrR(tile) ! Full range J-starting (RHO)
1594 jendr=bounds(ng)%JendR(tile) ! Full range J-ending (RHO)
1595!
1596 istr=bounds(ng)%Istr(tile) ! Full range I-starting (PSI, U)
1597 iend=bounds(ng)%Iend(tile) ! Full range I-ending (PSI)
1598 jstr=bounds(ng)%Jstr(tile) ! Full range J-starting (PSI, V)
1599 jend=bounds(ng)%Jend(tile) ! Full range J-ending (PSI)
1600!
1601! Set tiles lower and upper bounds for each decomposition element.
1602! In ROMS, the "exclusive region" for each decomposition element or
1603! horizontal tile ranges is bounded by (Istr:Iend, Jstr:Jend). Each
1604! tiled array is dimensioned as (LBi:UBi, LBj:UBj) which includes
1605! halo regions (usually 2 ghost points) and padding when appropriate
1606! (total/memory region). All ROMS arrays are horizontally dimensioned
1607! with the same bounds regardless if they are variables located at
1608! RHO-, PSI-, U-, or V-points. There is no halos at the boundary edges.
1609! The physical boundary is a U-points (east/west edges) and V-points
1610! (south/north edges). The boundary for RHO-points variables are
1611! located at half grid (dx,dy) distance away from the physical boundary
1612! at array indices(i=0; i=Lm+1) and (j=0; j=Mm+1).
1613!
1614! --------------------- UBj ESMF uses a very
1615! | | complicated array
1616! | Jend __________ | regions:
1617! | | | |
1618! | | | | * interior region
1619! | | | | * exclusive region
1620! | Jstr|__________| | * computational region
1621! | Istr Iend | * total (memory) region
1622! | |
1623! --------------------- LBj
1624! LBi UBi
1625!
1626 IF (.not.allocated(deblocklist)) THEN
1627 allocate ( deblocklist(2,2,ntilei(ng)*ntilej(ng)) )
1628 END IF
1629 DO mytile=0,ntilei(ng)*ntilej(ng)-1
1630 deblocklist(1,1,mytile+1)=bounds(ng)%Istr(mytile)
1631 deblocklist(1,2,mytile+1)=bounds(ng)%Iend(mytile)
1632 deblocklist(2,1,mytile+1)=bounds(ng)%Jstr(mytile)
1633 deblocklist(2,2,mytile+1)=bounds(ng)%Jend(mytile)
1634 END DO
1635!
1636!-----------------------------------------------------------------------
1637! Create ESMF DistGrid object based on model domain decomposition.
1638!-----------------------------------------------------------------------
1639!
1640! A single Decomposition Element (DE) per Persistent Execution Thread
1641! (PET).
1642!
1643 distgrid=esmf_distgridcreate(minindex=(/ 1, 1 /), &
1644 & maxindex=(/ lm(ng), mm(ng) /), &
1645 & deblocklist=deblocklist, &
1646 & rc=rc)
1647 IF (esmf_logfounderror(rctocheck=rc, &
1648 & msg=esmf_logerr_passthru, &
1649 & line=__line__, &
1650 & file=myfile)) THEN
1651 RETURN
1652 END IF
1653!
1654! Report ROMS DistGrid based on model domain decomposition.
1655!
1656 IF ((tile.eq.0).and.(debuglevel.gt.0)) THEN
1657 WRITE (cplout,10) ng, trim(gridtype(icenter))//" Point", &
1658 & ntilei(ng), ntilej(ng)
1659 DO mytile=1,ntilei(ng)*ntilej(ng)
1660 WRITE (cplout,20) mytile-1, deblocklist(1,1,mytile), &
1661 & deblocklist(1,2,mytile), &
1662 & deblocklist(2,1,mytile), &
1663 & deblocklist(2,2,mytile)
1664 END DO
1665 END IF
1666 IF (allocated(deblocklist)) deallocate (deblocklist)
1667!
1668!-----------------------------------------------------------------------
1669! Set component grid coordinates.
1670!-----------------------------------------------------------------------
1671!
1672! Define component grid location type: Arakawa C-grid.
1673!
1674! Icenter: RHO-point, cell center
1675! Icorner: PSI-point, cell corners
1676! Iupoint: U-point, cell west/east sides
1677! Ivpoint: V-point, cell south/north sides
1678!
1679 IF (.not.allocated(models(iroms)%mesh)) THEN
1680 allocate ( models(iroms)%mesh(4) )
1681 models(iroms)%mesh(1)%gtype=icenter
1682 models(iroms)%mesh(2)%gtype=icorner
1683 models(iroms)%mesh(3)%gtype=iupoint
1684 models(iroms)%mesh(4)%gtype=ivpoint
1685 END IF
1686!
1687! Create ESMF Grid. The array indices are global following ROMS
1688! design.
1689!
1690 models(iroms)%grid(ng)=esmf_gridcreate(distgrid=distgrid, &
1691 & gridedgelwidth=(/2,2/), &
1692 & gridedgeuwidth=(/2,2/), &
1693 & indexflag=esmf_index_global, &
1694 & name=trim(models(iroms)%name), &
1695 & rc=rc)
1696 IF (esmf_logfounderror(rctocheck=rc, &
1697 & msg=esmf_logerr_passthru, &
1698 & line=__line__, &
1699 & file=myfile)) THEN
1700 RETURN
1701 END IF
1702!
1703! Get number of local decomposition elements (DEs). Usually, a single
1704! DE is associated with each Persistent Execution Thread (PETs). Thus,
1705! localDEcount=1.
1706!
1707 CALL esmf_gridget (models(iroms)%grid(ng), &
1708 & localdecount=localdecount, &
1709 & rc=rc)
1710 IF (esmf_logfounderror(rctocheck=rc, &
1711 & msg=esmf_logerr_passthru, &
1712 & line=__line__, &
1713 & file=myfile)) THEN
1714 RETURN
1715 END IF
1716!
1717! Mesh coordinates for each variable type.
1718!
1719 mesh_loop : DO ivar=1,ubound(models(iroms)%mesh, dim=1)
1720!
1721! Set staggering type, Arakawa C-grid.
1722!
1723 SELECT CASE (models(iroms)%mesh(ivar)%gtype)
1724 CASE (icenter)
1725 staggerloc=esmf_staggerloc_center
1726 staggeredgelwidth=(/1,1/)
1727 staggeredgeuwidth=(/1,1/)
1728 CASE (icorner)
1729 staggerloc=esmf_staggerloc_corner
1730 staggeredgelwidth=(/1,1/)
1731 staggeredgeuwidth=(/2,2/)
1732 CASE (iupoint)
1733 staggerloc=esmf_staggerloc_edge1
1734 staggeredgelwidth=(/1,1/)
1735 staggeredgeuwidth=(/2,1/)
1736 CASE (ivpoint)
1737 staggerloc=esmf_staggerloc_edge2
1738 staggeredgelwidth=(/1,1/)
1739 staggeredgeuwidth=(/1,2/)
1740 END SELECT
1741!
1742! Allocate coordinate storage associated with staggered grid type.
1743! No coordinate values are set yet.
1744!
1745 CALL esmf_gridaddcoord (models(iroms)%grid(ng), &
1746 & staggerloc=staggerloc, &
1747 & staggeredgelwidth=staggeredgelwidth, &
1748 & staggeredgeuwidth=staggeredgeuwidth, &
1749 & rc=rc)
1750 IF (esmf_logfounderror(rctocheck=rc, &
1751 & msg=esmf_logerr_passthru, &
1752 & line=__line__, &
1753 & file=myfile)) THEN
1754 RETURN
1755 END IF
1756
1757# ifdef MASKING
1758!
1759! Allocate storage for land/sea masking.
1760!
1761 CALL esmf_gridadditem (models(iroms)%grid(ng), &
1762 & staggerloc=staggerloc, &
1763 & itemflag=esmf_griditem_mask, &
1764 & rc=rc)
1765 IF (esmf_logfounderror(rctocheck=rc, &
1766 & msg=esmf_logerr_passthru, &
1767 & line=__line__, &
1768 & file=myfile)) THEN
1769 RETURN
1770 END IF
1771 models(iroms)%LandValue=0
1772 models(iroms)%SeaValue=1
1773# endif
1774!
1775! Allocate storage for grid area.
1776!
1777 CALL esmf_gridadditem (models(iroms)%grid(ng), &
1778 & staggerloc=staggerloc, &
1779 & itemflag=esmf_griditem_area, &
1780 & rc=rc)
1781 IF (esmf_logfounderror(rctocheck=rc, &
1782 & msg=esmf_logerr_passthru, &
1783 & line=__line__, &
1784 & file=myfile)) THEN
1785 RETURN
1786 END IF
1787!
1788! Get pointers and set coordinates for the grid. Usually, the DO-loop
1789! is executed once since localDEcount=1.
1790!
1791 de_loop : DO localde=0,localdecount-1
1792 CALL esmf_gridgetcoord (models(iroms)%grid(ng), &
1793 & coorddim=1, &
1794 & localde=localde, &
1795 & staggerloc=staggerloc, &
1796 & farrayptr=ptrx, &
1797 & rc=rc)
1798 IF (esmf_logfounderror(rctocheck=rc, &
1799 & msg=esmf_logerr_passthru, &
1800 & line=__line__, &
1801 & file=myfile)) THEN
1802 RETURN
1803 END IF
1804!
1805 CALL esmf_gridgetcoord (models(iroms)%grid(ng), &
1806 & coorddim=2, &
1807 & localde=localde, &
1808 & staggerloc=staggerloc, &
1809 & farrayptr=ptry, &
1810 & rc=rc)
1811 IF (esmf_logfounderror(rctocheck=rc, &
1812 & msg=esmf_logerr_passthru, &
1813 & line=__line__, &
1814 & file=myfile)) THEN
1815 RETURN
1816 END IF
1817!
1818 CALL esmf_gridgetitem (models(iroms)%grid(ng), &
1819 & localde=localde, &
1820 & staggerloc=staggerloc, &
1821 & itemflag=esmf_griditem_mask, &
1822 & farrayptr=ptrm, &
1823 & rc=rc)
1824 IF (esmf_logfounderror(rctocheck=rc, &
1825 & msg=esmf_logerr_passthru, &
1826 & line=__line__, &
1827 & file=myfile)) THEN
1828 RETURN
1829 END IF
1830!
1831 CALL esmf_gridgetitem (models(iroms)%grid(ng), &
1832 & localde=localde, &
1833 & staggerloc=staggerloc, &
1834 & itemflag=esmf_griditem_area, &
1835 & farrayptr=ptra, &
1836 & rc=rc)
1837 IF (esmf_logfounderror(rctocheck=rc, &
1838 & msg=esmf_logerr_passthru, &
1839 & line=__line__, &
1840 & file=myfile)) THEN
1841 RETURN
1842 END IF
1843!
1844! Fill grid pointers.
1845!
1846 SELECT CASE (models(iroms)%mesh(ivar)%gtype)
1847! U-points
1848 CASE (icenter)
1849 DO j=jstrr,jendr
1850 DO i=istrr,iendr
1851 ptrx(i,j)=grid(ng)%lonr(i,j)
1852 ptry(i,j)=grid(ng)%latr(i,j)
1853# ifdef MASKING
1854 ptrm(i,j)=int(grid(ng)%rmask(i,j))
1855# else
1856 ptrm(i,j)=1
1857# endif
1858 ptra(i,j)=grid(ng)%om_r(i,j)*grid(ng)%on_r(i,j)
1859 END DO
1860 END DO
1861! PSI-points
1862 CASE (icorner)
1863 DO j=jstrr,jendr
1864 DO i=istrr,iendr
1865 ptrx(i,j)=grid(ng)%lonp(i,j)
1866 ptry(i,j)=grid(ng)%latp(i,j)
1867# ifdef MASKING
1868 ptrm(i,j)=int(grid(ng)%pmask(i,j))
1869# else
1870 ptrm(i,j)=1
1871# endif
1872 ptra(i,j)=grid(ng)%om_p(i,j)*grid(ng)%on_p(i,j)
1873 END DO
1874 END DO
1875! Extrapolate PSI-points at bottom edge
1876!
1877 IF (tile.lt.ntilei(ng)) THEN
1878 ptrx(:,jstr-1)=2.0_dp*ptrx(:,jstr)-ptrx(:,jstr+1)
1879 ptry(:,jstr-1)=2.0_dp*ptry(:,jstr)-ptry(:,jstr+1)
1880 ptrm(:,jstr-1)=ptrm(:,jstr)
1881 ptra(:,jstr-1)=ptra(:,jstr)
1882 END IF
1883! Extrapolate PSI-points at left edge
1884!
1885 IF (mod(tile,ntilei(ng)).eq.0) THEN
1886 ptrx(istr-1,:)=2.0_dp*ptrx(istr,:)-ptrx(istr+1,:)
1887 ptry(istr-1,:)=2.0_dp*ptry(istr,:)-ptry(istr+1,:)
1888 ptrm(istr-1,:)=ptrm(istr,:)
1889 ptra(istr-1,:)=ptra(istr,:)
1890 END IF
1891! Extrapolate PSI-points at top edge
1892!
1893 IF (tile.ge.(ntilei(ng)*(ntilej(ng)-1))) THEN
1894 ptrx(:,jend+2)=2.0_dp*ptrx(:,jend+1)-ptrx(:,jend)
1895 ptry(:,jend+2)=2.0_dp*ptry(:,jend+1)-ptry(:,jend)
1896 ptrm(:,jend+2)=ptrm(:,jend+1)
1897 ptra(:,jend+2)=ptra(:,jend+1)
1898 END IF
1899! Extrapolate PSI-points at right edge
1900!
1901 IF (mod(tile+1,ntilei(ng)).eq.0) THEN
1902 ptrx(iend+2,:)=2.0_dp*ptrx(iend+1,:)-ptrx(iend,:)
1903 ptry(iend+2,:)=2.0_dp*ptry(iend+1,:)-ptry(iend,:)
1904 ptrm(iend+2,:)=ptrm(iend+1,:)
1905 ptra(iend+2,:)=ptra(iend+1,:)
1906 END IF
1907! U-points
1908 CASE (iupoint)
1909 DO j=jstrr,jendr
1910 DO i=istr,iendr
1911 ptrx(i,j)=grid(ng)%lonu(i,j)
1912 ptry(i,j)=grid(ng)%latu(i,j)
1913# ifdef MASKING
1914 ptrm(i,j)=int(grid(ng)%umask(i,j))
1915# else
1916 ptrm(i,j)=1
1917# endif
1918 ptra(i,j)=grid(ng)%om_u(i,j)*grid(ng)%on_u(i,j)
1919 END DO
1920 END DO
1921! Extrapolate U-points at left edge
1922!
1923 IF (mod(tile,ntilei(ng)).eq.0) THEN
1924 ptrx(istr-1,:)=2.0_dp*ptrx(istr,:)-ptrx(istr+1,:)
1925 ptry(istr-1,:)=2.0_dp*ptry(istr,:)-ptry(istr+1,:)
1926 ptrm(istr-1,:)=ptrm(istr,:)
1927 ptra(istr-1,:)=ptra(istr,:)
1928 END IF
1929! Extrapolate U-points at right edge
1930!
1931 IF (mod(tile+1,ntilei(ng)).eq.0) THEN
1932 ptrx(iend+2,:)=2.0_dp*ptrx(iend+1,:)-ptrx(iend,:)
1933 ptry(iend+2,:)=2.0_dp*ptry(iend+1,:)-ptry(iend,:)
1934 ptrm(iend+2,:)=ptrm(iend+1,:)
1935 ptra(iend+2,:)=ptra(iend+1,:)
1936 END IF
1937! V-points
1938 CASE (ivpoint)
1939 DO j=jstr,jendr
1940 DO i=istrr,iendr
1941 ptrx(i,j)=grid(ng)%lonv(i,j)
1942 ptry(i,j)=grid(ng)%latv(i,j)
1943# ifdef MASKING
1944 ptrm(i,j)=int(grid(ng)%vmask(i,j))
1945# else
1946 ptrm(i,j)=1
1947# endif
1948 ptra(i,j)=grid(ng)%om_v(i,j)*grid(ng)%on_v(i,j)
1949 END DO
1950 END DO
1951! Extrapolate V-points at bottom edge
1952!
1953 IF (tile.lt.ntilei(ng)) THEN
1954 ptrx(:,jstr-1)=2.0_dp*ptrx(:,jstr)-ptrx(:,jstr+1)
1955 ptry(:,jstr-1)=2.0_dp*ptry(:,jstr)-ptry(:,jstr+1)
1956 ptrm(:,jstr-1)=ptrm(:,jstr)
1957 ptra(:,jstr-1)=ptra(:,jstr)
1958 END IF
1959! Extrapolate V-points at top edge
1960!
1961 IF (tile.ge.(ntilei(ng)*(ntilej(ng)-1))) THEN
1962 ptrx(:,jend+2)=2.0_dp*ptrx(:,jend+1)-ptrx(:,jend)
1963 ptry(:,jend+2)=2.0_dp*ptry(:,jend+1)-ptry(:,jend)
1964 ptrm(:,jend+2)=ptrm(:,jend+1)
1965 ptra(:,jend+2)=ptra(:,jend+1)
1966 END IF
1967 END SELECT
1968!
1969! Nullify pointers.
1970!
1971 IF ( associated(ptrx) ) nullify (ptrx)
1972 IF ( associated(ptry) ) nullify (ptry)
1973 IF ( associated(ptrm) ) nullify (ptrm)
1974 IF ( associated(ptra) ) nullify (ptra)
1975 END DO de_loop
1976!
1977! Debugging: write out component grid in VTK format.
1978!
1979 IF (debuglevel.ge.4) THEN
1980 gtype=models(iroms)%mesh(ivar)%gtype
1981 CALL esmf_gridwritevtk (models(iroms)%grid(ng), &
1982 & filename="roms_"// &
1983 & trim(gridtype(gtype))// &
1984 & "_point", &
1985 & staggerloc=staggerloc, &
1986 & rc=rc)
1987 IF (esmf_logfounderror(rctocheck=rc, &
1988 & msg=esmf_logerr_passthru, &
1989 & line=__line__, &
1990 & file=myfile)) THEN
1991 RETURN
1992 END IF
1993 END IF
1994 END DO mesh_loop
1995!
1996! Assign grid to gridded component.
1997!
1998 CALL esmf_gridcompset (model, &
1999 & grid=models(iroms)%grid(ng), &
2000 & rc=rc)
2001 IF (esmf_logfounderror(rctocheck=rc, &
2002 & msg=esmf_logerr_passthru, &
2003 & line=__line__, &
2004 & file=myfile)) THEN
2005 RETURN
2006 END IF
2007!
2008 IF (esm_track) THEN
2009 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetGridArrays', &
2010 & ', PET', petrank
2011 FLUSH (trac)
2012 END IF
2013 IF (debuglevel.gt.0) FLUSH (cplout)
2014!
2015 10 FORMAT (/,'ROMS Domain Decomposition:',/,25('='),/, &
2016 /,2x,'ROMS_DistGrid - Grid = ',i2.2,',',3x,'Mesh = ',a, &
2017 & ',',3x,'Partition = ',i0,' x ',i0)
2018 20 FORMAT (18x,'node = ',i0,t32,'Istr = ',i0,t45,'Iend = ',i0, &
2019 & t58,'Jstr = ',i0,t71,'Jend = ',i0)
2020!
2021 RETURN
2022 END SUBROUTINE roms_setgridarrays
2023!
2024 SUBROUTINE roms_setstates (ng, tile, model, rc)
2025!
2026!=======================================================================
2027! !
2028! Adds ROMS component export and import fields into its respective !
2029! state. !
2030! !
2031!=======================================================================
2032!
2033! Imported variable declarations.
2034!
2035 integer, intent(in) :: ng, tile
2036 integer, intent(out) :: rc
2037!
2038 TYPE (esmf_gridcomp) :: model
2039!
2040! Local variable declarations.
2041!
2042 integer :: id, ifld
2043 integer :: localde, localdecount, localpet
2044 integer :: exportcount, importcount
2045 integer :: staggeredgelwidth(2)
2046 integer :: staggeredgeuwidth(2)
2047!
2048 real (dp), dimension(:,:), pointer :: ptr2d => null()
2049!
2050 character (len=10) :: attlist(1)
2051
2052 character (len=*), parameter :: myfile = &
2053 & __FILE__//", ROMS_SetStates"
2054!
2055 character (ESMF_MAXSTR), allocatable :: exportnamelist(:)
2056 character (ESMF_MAXSTR), allocatable :: importnamelist(:)
2057!
2058 TYPE (esmf_arrayspec) :: arrayspec2d
2059 TYPE (esmf_field) :: field
2060 TYPE (esmf_staggerloc) :: staggerloc
2061 TYPE (esmf_vm) :: vm
2062!
2063!-----------------------------------------------------------------------
2064! Initialize return code flag to success state (no error).
2065!-----------------------------------------------------------------------
2066!
2067 IF (esm_track) THEN
2068 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetStates', &
2069 & ', PET', petrank
2070 FLUSH (trac)
2071 END IF
2072 rc=esmf_success
2073!
2074!-----------------------------------------------------------------------
2075! Query gridded component.
2076!-----------------------------------------------------------------------
2077!
2078! Get import and export states.
2079!
2080 CALL esmf_gridcompget (model, &
2081 & localpet=localpet, &
2082 & vm=vm, &
2083 & rc=rc)
2084 IF (esmf_logfounderror(rctocheck=rc, &
2085 & msg=esmf_logerr_passthru, &
2086 & line=__line__, &
2087 & file=myfile)) THEN
2088 RETURN
2089 END IF
2090!
2091! Get number of local decomposition elements (DEs). Usually, a single
2092! Decomposition Element (DE) is associated with each Persistent
2093! Execution Thread (PETs). Thus, localDEcount=1.
2094!
2095 CALL esmf_gridget (models(iroms)%grid(ng), &
2096 & localdecount=localdecount, &
2097 & rc=rc)
2098 IF (esmf_logfounderror(rctocheck=rc, &
2099 & msg=esmf_logerr_passthru, &
2100 & line=__line__, &
2101 & file=myfile)) THEN
2102 RETURN
2103 END IF
2104!
2105!-----------------------------------------------------------------------
2106! Set a 2D floating-point array descriptor.
2107!-----------------------------------------------------------------------
2108!
2109 CALL esmf_arrayspecset (arrayspec2d, &
2110 & typekind=esmf_typekind_r8, &
2111 & rank=2, &
2112 & rc=rc)
2113 IF (esmf_logfounderror(rctocheck=rc, &
2114 & msg=esmf_logerr_passthru, &
2115 & line=__line__, &
2116 & file=myfile)) THEN
2117 RETURN
2118 END IF
2119!
2120!-----------------------------------------------------------------------
2121! Add export fields into export state.
2122!-----------------------------------------------------------------------
2123!
2124 exporting : IF (nexport(iroms).gt.0) THEN
2125!
2126! Get number of fields to export.
2127!
2128 CALL esmf_stateget (models(iroms)%ExportState(ng), &
2129 & itemcount=exportcount, &
2130 & rc=rc)
2131 IF (esmf_logfounderror(rctocheck=rc, &
2132 & msg=esmf_logerr_passthru, &
2133 & line=__line__, &
2134 & file=myfile)) THEN
2135 RETURN
2136 END IF
2137!
2138! Get a list of export fields names.
2139!
2140 IF (.not.allocated(exportnamelist)) THEN
2141 allocate ( exportnamelist(exportcount) )
2142 END IF
2143 CALL esmf_stateget (models(iroms)%ExportState(ng), &
2144 & itemnamelist=exportnamelist, &
2145 & rc=rc)
2146 IF (esmf_logfounderror(rctocheck=rc, &
2147 & msg=esmf_logerr_passthru, &
2148 & line=__line__, &
2149 & file=myfile)) THEN
2150 RETURN
2151 END IF
2152!
2153! Set export field(s).
2154!
2155 DO ifld=1,exportcount
2156 id=field_index(models(iroms)%ExportField,exportnamelist(ifld))
2157!
2158 IF (nuopc_isconnected(models(iroms)%ExportState(ng), &
2159 & fieldname=trim(exportnamelist(ifld)), &
2160 & rc=rc)) THEN
2161!
2162! Set staggering type.
2163!
2164 SELECT CASE (models(iroms)%ExportField(id)%gtype)
2165 CASE (icenter) ! RHO-points
2166 staggerloc=esmf_staggerloc_center
2167 CASE (icorner) ! PSI-points
2168 staggerloc=esmf_staggerloc_corner
2169 CASE (iupoint) ! U-points
2170 staggerloc=esmf_staggerloc_edge1
2171 CASE (ivpoint) ! V-points
2172 staggerloc=esmf_staggerloc_edge2
2173 END SELECT
2174!
2175! Create 2D field from the Grid and arraySpec.
2176!
2177 field=esmf_fieldcreate(models(iroms)%grid(ng), &
2178 & arrayspec2d, &
2179 & indexflag=esmf_index_global, &
2180 & staggerloc=staggerloc, &
2181 & name=trim(exportnamelist(ifld)), &
2182 & rc=rc)
2183 IF (esmf_logfounderror(rctocheck=rc, &
2184 & msg=esmf_logerr_passthru, &
2185 & line=__line__, &
2186 & file=myfile)) THEN
2187 RETURN
2188 END IF
2189!
2190! Put data into state. Usually, the DO-loop is executed once since
2191! localDEcount=1.
2192!
2193 DO localde=0,localdecount-1
2194!
2195! Get pointer to DE-local memory allocation within field.
2196!
2197 CALL esmf_fieldget (field, &
2198 & localde=localde, &
2199 & farrayptr=ptr2d, &
2200 & rc=rc)
2201 IF (esmf_logfounderror(rctocheck=rc, &
2202 & msg=esmf_logerr_passthru, &
2203 & line=__line__, &
2204 & file=myfile)) THEN
2205 RETURN
2206 END IF
2207!
2208! Initialize pointer.
2209!
2210 ptr2d=missing_dp
2211!
2212! Nullify pointer to make sure that it does not point on a random part
2213! in the memory.
2214!
2215 IF ( associated(ptr2d) ) nullify (ptr2d)
2216 END DO
2217!
2218! Add field export state.
2219!
2220 CALL nuopc_realize (models(iroms)%ExportState(ng), &
2221 & field=field, &
2222 & rc=rc)
2223 IF (esmf_logfounderror(rctocheck=rc, &
2224 & msg=esmf_logerr_passthru, &
2225 & line=__line__, &
2226 & file=myfile)) THEN
2227 RETURN
2228 END IF
2229!
2230! Remove field from export state because it is not connected.
2231!
2232 ELSE
2233 IF (localpet.eq.0) THEN
2234 WRITE (cplout,10) trim(exportnamelist(ifld)), &
2235 & 'Export State: ', &
2236 & trim(coupled(iroms)%ExpLabel(ng))
2237 END IF
2238 CALL esmf_stateremove (models(iroms)%ExportState(ng), &
2239 & (/ trim(exportnamelist(ifld)) /), &
2240 & rc=rc)
2241 IF (esmf_logfounderror(rctocheck=rc, &
2242 & msg=esmf_logerr_passthru, &
2243 & line=__line__, &
2244 & file=myfile)) THEN
2245 RETURN
2246 END IF
2247 END IF
2248 END DO
2249!
2250! Deallocate arrays.
2251!
2252 IF ( allocated(exportnamelist) ) deallocate (exportnamelist)
2253!
2254 END IF exporting
2255!
2256!-----------------------------------------------------------------------
2257! Add import fields into import state.
2258!-----------------------------------------------------------------------
2259!
2260 importing : IF (nimport(iroms).gt.0) THEN
2261!
2262! Get number of fields to import.
2263!
2264 CALL esmf_stateget (models(iroms)%ImportState(ng), &
2265 & itemcount=importcount, &
2266 & rc=rc)
2267 IF (esmf_logfounderror(rctocheck=rc, &
2268 & msg=esmf_logerr_passthru, &
2269 & line=__line__, &
2270 & file=myfile)) THEN
2271 RETURN
2272 END IF
2273!
2274! Get a list of import fields names.
2275!
2276 IF (.not.allocated(importnamelist)) THEN
2277 allocate (importnamelist(importcount))
2278 END IF
2279 CALL esmf_stateget (models(iroms)%ImportState(ng), &
2280 & itemnamelist=importnamelist, &
2281 & rc=rc)
2282 IF (esmf_logfounderror(rctocheck=rc, &
2283 & msg=esmf_logerr_passthru, &
2284 & line=__line__, &
2285 & file=myfile)) THEN
2286 RETURN
2287 END IF
2288!
2289! Set import field(s).
2290!
2291 DO ifld=1,importcount
2292 id=field_index(models(iroms)%ImportField,importnamelist(ifld))
2293!
2294 IF (nuopc_isconnected(models(iroms)%ImportState(ng), &
2295 & fieldname=trim(importnamelist(ifld)), &
2296 & rc=rc)) THEN
2297!
2298! Set staggering type.
2299!
2300 SELECT CASE (models(iroms)%ImportField(id)%gtype)
2301 CASE (icenter) ! RHO-points
2302 staggerloc=esmf_staggerloc_center
2303 CASE (icorner) ! PSI-points
2304 staggerloc=esmf_staggerloc_corner
2305 CASE (iupoint) ! U-points
2306 staggerloc=esmf_staggerloc_edge1
2307 CASE (ivpoint) ! V-points
2308 staggerloc=esmf_staggerloc_edge2
2309 END SELECT
2310!
2311! Create 2D field from the Grid, arraySpec, total tile size.
2312! The array indices are global following ROMS design.
2313!
2314 field=esmf_fieldcreate(models(iroms)%grid(ng), &
2315 & arrayspec2d, &
2316 & indexflag=esmf_index_global, &
2317 & staggerloc=staggerloc, &
2318 & name=trim(importnamelist(ifld)), &
2319 & rc=rc)
2320 IF (esmf_logfounderror(rctocheck=rc, &
2321 & msg=esmf_logerr_passthru, &
2322 & line=__line__, &
2323 & file=myfile)) THEN
2324 RETURN
2325 END IF
2326
2327# ifdef TIME_INTERP_NOT
2328!
2329! Create standard Attribute Package for each export field. Then, nest
2330! custom Attribute Package around it.
2331!
2332 CALL esmf_attributeadd (field, &
2333 & convention='ESMF', &
2334 & purpose='General', &
2335 & rc=rc)
2336 IF (esmf_logfounderror(rctocheck=rc, &
2337 & msg=esmf_logerr_passthru, &
2338 & line=__line__, &
2339 & file=myfile)) THEN
2340 RETURN
2341 END IF
2342!
2343 attlist(1)='TimeInterp'
2344 CALL esmf_attributeadd (field, &
2345 & convention='CustomConvention', &
2346 & purpose='General', &
2347!! & purpose='Instance', &
2348 & attrlist=attlist, &
2349 & nestconvention='ESMF', &
2350 & nestpurpose='General', &
2351 & rc=rc)
2352 IF (esmf_logfounderror(rctocheck=rc, &
2353 & msg=esmf_logerr_passthru, &
2354 & line=__line__, &
2355 & file=myfile)) THEN
2356 RETURN
2357 END IF
2358# endif
2359!
2360! Put data into state. Usually, the DO-loop is executed once since
2361! localDEcount=1.
2362!
2363 DO localde=0,localdecount-1
2364!
2365! Get pointer to DE-local memory allocation within field.
2366!
2367 CALL esmf_fieldget (field, &
2368 & localde=localde, &
2369 & farrayptr=ptr2d, &
2370 & rc=rc)
2371 IF (esmf_logfounderror(rctocheck=rc, &
2372 & msg=esmf_logerr_passthru, &
2373 & line=__line__, &
2374 & file=myfile)) THEN
2375 RETURN
2376 END IF
2377!
2378! Initialize pointer.
2379!
2380 ptr2d=missing_dp
2381!
2382! Nullify pointer to make sure that it does not point on a random
2383! part in the memory.
2384!
2385 IF (associated(ptr2d)) nullify (ptr2d)
2386 END DO
2387!
2388! Add field import state.
2389!
2390 CALL nuopc_realize (models(iroms)%ImportState(ng), &
2391 & field=field, &
2392 & rc=rc)
2393 IF (esmf_logfounderror(rctocheck=rc, &
2394 & msg=esmf_logerr_passthru, &
2395 & line=__line__, &
2396 & file=myfile)) THEN
2397 RETURN
2398 END IF
2399!
2400! Remove field from import state because it is not connected.
2401!
2402 ELSE
2403 IF (localpet.eq.0) THEN
2404 WRITE (cplout,10) trim(importnamelist(ifld)), &
2405 & 'Import State: ', &
2406 & trim(coupled(iroms)%ImpLabel(ng))
2407 END IF
2408 CALL esmf_stateremove (models(iroms)%ImportState(ng), &
2409 & (/ trim(importnamelist(ifld)) /), &
2410 & rc=rc)
2411 IF (esmf_logfounderror(rctocheck=rc, &
2412 & msg=esmf_logerr_passthru, &
2413 & line=__line__, &
2414 & file=myfile)) THEN
2415 RETURN
2416 END IF
2417 END IF
2418 END DO
2419!
2420! Deallocate arrays.
2421!
2422 IF (allocated(importnamelist)) deallocate (importnamelist)
2423!
2424 END IF importing
2425!
2426 IF (esm_track) THEN
2427 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetStates', &
2428 & ', PET', petrank
2429 FLUSH (trac)
2430 END IF
2431!
2432 10 FORMAT (1x,'ROMS_SetStates - Removing field ''',a,''' from ',a, &
2433 & '''',a,'''',/,18x,'because it is not connected.')
2434!
2435 RETURN
2436 END SUBROUTINE roms_setstates
2437!
2438 SUBROUTINE roms_modeladvance (model, rc)
2439!
2440!=======================================================================
2441! !
2442! Advance ROMS component for a coupling interval (seconds) using !
2443! "ROMS_run". It also calls "ROMS_Import" and "ROMS_Export" to !
2444! import and export coupling fields, respectively. !
2445! !
2446! During configuration, the driver clock was decreased by a single !
2447! coupling interval (TimeStep) to allow the proper initialization !
2448! of the import and export fields pointers. ROMS is not advanced !
2449! on the first call to this routine, so the time stepping is over !
2450! the specified application start and ending dates. !
2451! !
2452# if defined TIME_INTERP
2453! On the first pass, it imports the LOWER time snapshot fields, !
2454! but cannot time-step ROMS until the next call after importing !
2455! the UPPER snapshot. Therefore, it starts time-stepping when !
2456! both LOWER and UPPER time snapshot fields are exchanged so that !
2457! ROMS can perform time interpolation. !
2458# else
2459! ROMS is actually advanced on the second call to this routine. !
2460# endif
2461! !
2462!=======================================================================
2463!
2464! Imported variable declarations.
2465!
2466 integer, intent(out) :: rc
2467!
2468 TYPE (esmf_gridcomp) :: model
2469!
2470! Local variable declarations.
2471!
2472 logical :: ladvance
2473 integer :: is, ng
2474 integer :: mytask, petcount, localpet, phase
2475!
2476 real (dp) :: couplinginterval, runinterval
2477 real (dp) :: tcurrentinseconds, tstopinseconds
2478!
2479 character (len=22) :: cinterval
2480 character (len=22) :: currtimestring, stoptimestring
2481
2482 character (len=*), parameter :: myfile = &
2483 & __FILE__//", ROMS_SetModelAdvance"
2484!
2485 TYPE (esmf_clock) :: clock
2486 TYPE (esmf_state) :: exportstate, importstate
2487 TYPE (esmf_time) :: referencetime
2488 TYPE (esmf_time) :: currenttime, stoptime
2489 TYPE (esmf_timeinterval) :: timestep
2490 TYPE (esmf_vm) :: vm
2491!
2492!-----------------------------------------------------------------------
2493! Initialize return code flag to success state (no error).
2494!-----------------------------------------------------------------------
2495!
2496 IF (esm_track) THEN
2497 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_ModelAdvance', &
2498 & ', PET', petrank
2499 FLUSH (trac)
2500 END IF
2501 rc=esmf_success
2502!
2503!-----------------------------------------------------------------------
2504! Get information about the gridded component.
2505!-----------------------------------------------------------------------
2506!
2507! Inquire about ROMS component.
2508!
2509 CALL esmf_gridcompget (model, &
2510 & importstate=importstate, &
2511 & exportstate=exportstate, &
2512 & clock=clock, &
2513 & localpet=localpet, &
2514 & petcount=petcount, &
2515 & currentphase=phase, &
2516 & vm=vm, &
2517 & rc=rc)
2518 IF (esmf_logfounderror(rctocheck=rc, &
2519 & msg=esmf_logerr_passthru, &
2520 & line=__line__, &
2521 & file=myfile)) THEN
2522 RETURN
2523 END IF
2524!
2525! Get time step interval, stopping time, reference time, and current
2526! time.
2527!
2528 CALL esmf_clockget (clock, &
2529 & timestep=timestep, &
2530 & stoptime=stoptime, &
2531 & reftime=referencetime, &
2532 & currtime=clockinfo(iroms)%CurrentTime, &
2533 & rc=rc)
2534 IF (esmf_logfounderror(rctocheck=rc, &
2535 & msg=esmf_logerr_passthru, &
2536 & line=__line__, &
2537 & file=myfile)) THEN
2538 RETURN
2539 END IF
2540!
2541! Current ROMS time (seconds).
2542!
2543 CALL esmf_timeget (clockinfo(iroms)%CurrentTime, &
2544 & s_r8=tcurrentinseconds, &
2545 & timestringisofrac=currtimestring, &
2546 & rc=rc)
2547 IF (esmf_logfounderror(rctocheck=rc, &
2548 & msg=esmf_logerr_passthru, &
2549 & line=__line__, &
2550 & file=myfile)) THEN
2551 RETURN
2552 END IF
2553 is=index(currtimestring, 'T') ! remove 'T' in
2554 IF (is.gt.0) currtimestring(is:is)=' ' ! ISO 8601 format
2555!
2556! ROMS stop time (seconds) for this coupling window.
2557!
2558 CALL esmf_timeget (clockinfo(iroms)%CurrentTime+timestep, &
2559 & s_r8=tstopinseconds, &
2560 & timestringisofrac=stoptimestring, &
2561 & rc=rc)
2562 IF (esmf_logfounderror(rctocheck=rc, &
2563 & msg=esmf_logerr_passthru, &
2564 & line=__line__, &
2565 & file=myfile)) THEN
2566 RETURN
2567 END IF
2568 is=index(stoptimestring, 'T') ! remove 'T' in
2569 IF (is.gt.0) stoptimestring(is:is)=' ' ! ISO 8601 form
2570!
2571! Get coupling time interval (seconds, double precision).
2572!
2573 CALL esmf_timeintervalget (timestep, &
2574 & s_r8=couplinginterval, &
2575 & rc=rc)
2576 IF (esmf_logfounderror(rctocheck=rc, &
2577 & msg=esmf_logerr_passthru, &
2578 & line=__line__, &
2579 & file=myfile)) THEN
2580 RETURN
2581 END IF
2582!
2583! Set ROMS running interval (seconds) for the current coupling window.
2584!
2585 runinterval=couplinginterval
2586!
2587! Set local model advance time stepping switch.
2588!
2589 ladvance=.true.
2590# ifdef TIME_INTERP
2591 IF ((models(iroms)%ImportCalls.eq.0).and. &
2592 & (nimport(iroms).gt.0)) THEN
2593 ladvance=.false.
2594 END IF
2595# else
2596# ifdef REGRESS_STARTCLOCK
2597 IF (tcurrentinseconds.eq.clockinfo(idriver)%Time_Start) THEN
2598 ladvance=.false.
2599 END IF
2600# endif
2601# endif
2602!
2603!-----------------------------------------------------------------------
2604! Report time information strings (YYYY-MM-DD hh:mm:ss).
2605!-----------------------------------------------------------------------
2606!
2607 IF (localpet.eq.0) THEN
2608 WRITE (cinterval,'(f15.2)') couplinginterval
2609 WRITE (cplout,10) trim(currtimestring), trim(stoptimestring), &
2610 & trim(adjustl(cinterval)), ladvance
2611 END IF
2612!
2613!-----------------------------------------------------------------------
2614! Get import fields from other ESM components.
2615!-----------------------------------------------------------------------
2616!
2617 IF (nimport(iroms).gt.0) THEN
2618 DO ng=1,models(iroms)%Ngrids
2619 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
2620 CALL roms_import (ng, model, rc)
2621 IF (esmf_logfounderror(rctocheck=rc, &
2622 & msg=esmf_logerr_passthru, &
2623 & line=__line__, &
2624 & file=myfile)) THEN
2625 RETURN
2626 END IF
2627 END IF
2628 END DO
2629 END IF
2630!
2631!-----------------------------------------------------------------------
2632! Run ROMS component. Notice that ROMS component is advanced when
2633! ng=1. In nested application, ROMS kernel (main2d or main3d) will
2634! advance all the nested grid in their logical order. In nesting,
2635! the execution order of the grids is critical since nesting is
2636! two-way by default.
2637!-----------------------------------------------------------------------
2638!
2639 IF (ladvance) THEN
2640 IF (esm_track) THEN
2641 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_Run', &
2642 & ', PET', petrank
2643 FLUSH (trac)
2644 END IF
2645 CALL roms_run (runinterval)
2646 IF (esm_track) THEN
2647 WRITE (trac,'(a,a,i0)') '==> Exiting ROMS_Run', &
2648 & ', PET', petrank
2649 FLUSH (trac)
2650 END IF
2651 END IF
2652!
2653 IF (exit_flag.ne.noerror) then
2654 IF (localpet.eq.0) then
2655 WRITE (cplout,'(a,i1)') 'ROMS component exit with flag = ', &
2656 & exit_flag
2657 END IF
2658 CALL roms_finalize
2659 CALL esmf_finalize (endflag=esmf_end_abort)
2660 END IF
2661!
2662!-----------------------------------------------------------------------
2663! Put export fields.
2664!-----------------------------------------------------------------------
2665!
2666 IF (nexport(iroms).gt.0) THEN
2667 DO ng=1,models(iroms)%Ngrids
2668 IF (any(coupled(iroms)%LinkedGrid(ng,:))) THEN
2669 CALL roms_export (ng, model, rc)
2670 IF (esmf_logfounderror(rctocheck=rc, &
2671 & msg=esmf_logerr_passthru, &
2672 & line=__line__, &
2673 & file=myfile)) THEN
2674 RETURN
2675 END IF
2676 END IF
2677 END DO
2678 END IF
2679!
2680 IF (esm_track) THEN
2681 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_ModelAdvance', &
2682 & ', PET', petrank
2683 FLUSH (trac)
2684 END IF
2685!
2686 10 FORMAT (3x,'ModelAdvance - ESMF, Running ROMS:',t42,a, &
2687 & ' => ',a,', [',a,' s], Advance: ',l1)
2688!
2689 RETURN
2690 END SUBROUTINE roms_modeladvance
2691!
2692 SUBROUTINE roms_setfinalize (model, &
2693 & ImportState, ExportState, &
2694 & clock, rc)
2695!
2696!=======================================================================
2697! !
2698! Finalize ROMS component execution. It calls ROMS_finalize. !
2699! !
2700!=======================================================================
2701!
2702! Imported variable declarations.
2703!
2704 integer, intent(out) :: rc
2705!
2706 TYPE (esmf_clock) :: clock
2707 TYPE (esmf_gridcomp) :: model
2708 TYPE (esmf_state) :: exportstate
2709 TYPE (esmf_state) :: importstate
2710!
2711! Local variable declarations.
2712!
2713 character (len=*), parameter :: myfile = &
2714 & __FILE__//", ROMS_SetFinalize"
2715!
2716!-----------------------------------------------------------------------
2717! Initialize return code flag to success state (no error).
2718!-----------------------------------------------------------------------
2719!
2720 IF (esm_track) THEN
2721 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_SetFinalize', &
2722 & ', PET', petrank
2723 FLUSH (trac)
2724 END IF
2725 rc=esmf_success
2726!
2727!-----------------------------------------------------------------------
2728! If ng=1, finalize ROMS component. In nesting applications this step
2729! needs to be done only once.
2730!-----------------------------------------------------------------------
2731!
2732 CALL roms_finalize
2733!
2734 IF (esm_track) THEN
2735 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_SetFinalize', &
2736 & ', PET', petrank
2737 FLUSH (trac)
2738 END IF
2739!
2740 RETURN
2741 END SUBROUTINE roms_setfinalize
2742!
2743 SUBROUTINE roms_import (ng, model, rc)
2744!
2745!=======================================================================
2746! !
2747! Imports fields into ROMS array structures. The fields aew loaded !
2748! into the snapshot storage arrays to allow time interpolation in !
2749! ROMS kernel. !
2750! !
2751!=======================================================================
2752!
2753! Imported variable declarations.
2754!
2755 integer, intent(in) :: ng
2756 integer, intent(out) :: rc
2757!
2758 TYPE (esmf_gridcomp) :: model
2759!
2760! Local variable declarations.
2761!
2762 logical :: loadit, ispresent
2763 logical :: got_stress(2), got_wind(2)
2764# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
2765 logical :: got_rhoair, got_wstar, got_wind_sbl(2)
2766# endif
2767!
2768 integer :: istr, iend, jstr, jend
2769 integer :: istrr, iendr, jstrr, jendr
2770 integer :: lbi, ubi, lbj, ubj
2771 integer :: importcount, tindex
2772 integer :: localde, localdecount, localpet, tile
2773 integer :: year, month, day, hour, minutes, seconds, sn, sd
2774 integer :: gtype, id, ifield, ifld, i, is, j
2775!
2776# ifdef TIME_INTERP
2777 integer, save :: record = 0
2778!
2779# endif
2780 real (dp), parameter :: eps = 1.0e-10_dp
2781!
2782 real (dp) :: timeindays, time_current, tmin, tmax, tstr, tend
2783# ifdef TIME_INTERP
2784 real (dp) :: mytimeindays
2785# endif
2786 real (dp) :: fseconds, romsclocktime
2787 real (dp) :: mytintrp(2), myvtime(2)
2788
2789 real (dp) :: myfmax(2), myfmin(2), fmin(2), fmax(2), fval
2790 real (dp) :: add_offset, romsscale, scale, cff1, cff2, cff3
2791 real (dp) :: freshwaterscale, stressscale, tracerfluxscale
2792# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
2793 real (dp) :: urel, vrel, wmag, wrel
2794# endif
2795 real (dp) :: attvalues(14)
2796!
2797 real (dp), pointer :: ptr2d(:,:) => null()
2798!
2799# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
2800 real (dp), allocatable :: rhoair(:,:), wstar(:,:)
2801 real (dp), allocatable :: uwrk(:,:), vwrk(:,:)
2802 real (dp), allocatable :: xwind(:,:), ywind(:,:)
2803# endif
2804 real (dp), allocatable :: ustress(:,:), vstress(:,:)
2805 real (dp), allocatable :: uwind(:,:), vwind(:,:)
2806!
2807 character (len=22) :: mydate(2)
2808# ifdef TIME_INTERP
2809 character (len=22) :: mydatestring(1,1,1)
2810# endif
2811 character (len=22) :: time_currentstring
2812 character (len=40) :: attname
2813
2814 character (len=*), parameter :: myfile = &
2815 & __FILE__//", ROMS_Import"
2816
2817 character (ESMF_MAXSTR) :: cname, ofile
2818 character (ESMF_MAXSTR), allocatable :: importnamelist(:)
2819!
2820 TYPE (esmf_attpack) :: attpack
2821 TYPE (esmf_clock) :: clock
2822 TYPE (esmf_field) :: field
2823 TYPE (esmf_time) :: currenttime
2824 TYPE (esmf_vm) :: vm
2825
2826# ifdef TIME_INTERP
2827!
2828 sourcefile=myfile
2829# endif
2830!
2831!-----------------------------------------------------------------------
2832! Initialize return code flag to success state (no error).
2833!-----------------------------------------------------------------------
2834!
2835 IF (esm_track) THEN
2836 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_Import', &
2837 & ', PET', petrank
2838 FLUSH (trac)
2839 END IF
2840 rc=esmf_success
2841!
2842!-----------------------------------------------------------------------
2843! Get information about the gridded component.
2844!-----------------------------------------------------------------------
2845!
2846 CALL esmf_gridcompget (model, &
2847 & clock=clock, &
2848 & localpet=localpet, &
2849 & vm=vm, &
2850 & name=cname, &
2851 & rc=rc)
2852 IF (esmf_logfounderror(rctocheck=rc, &
2853 & msg=esmf_logerr_passthru, &
2854 & line=__line__, &
2855 & file=myfile)) THEN
2856 RETURN
2857 END IF
2858!
2859! Get number of local decomposition elements (DEs). Usually, a single
2860! DE is associated with each Persistent Execution Thread (PETs). Thus,
2861! localDEcount=1.
2862!
2863 CALL esmf_gridget (models(iroms)%grid(ng), &
2864 & localdecount=localdecount, &
2865 & rc=rc)
2866 IF (esmf_logfounderror(rctocheck=rc, &
2867 & msg=esmf_logerr_passthru, &
2868 & line=__line__, &
2869 & file=myfile)) THEN
2870 RETURN
2871 END IF
2872!
2873! Set size of imported tiled-arrays.
2874!
2875 tile=localpet
2876!
2877 lbi=bounds(ng)%LBi(tile) ! lower bound I-direction
2878 ubi=bounds(ng)%UBi(tile) ! upper bound I-direction
2879 lbj=bounds(ng)%LBj(tile) ! lower bound J-direction
2880 ubj=bounds(ng)%UBj(tile) ! upper bound J-direction
2881!
2882 istrr=bounds(ng)%IstrR(tile) ! Full range I-starting (RHO)
2883 iendr=bounds(ng)%IendR(tile) ! Full range I-ending (RHO)
2884 jstrr=bounds(ng)%JstrR(tile) ! Full range J-starting (RHO)
2885 jendr=bounds(ng)%JendR(tile) ! Full range J-ending (RHO)
2886!
2887 istr=bounds(ng)%Istr(tile) ! Full range I-starting (PSI, U)
2888 iend=bounds(ng)%Iend(tile) ! Full range I-ending (PSI)
2889 jstr=bounds(ng)%Jstr(tile) ! Full range J-starting (PSI, V)
2890 jend=bounds(ng)%Jend(tile) ! Full range J-ending (PSI)
2891!
2892!-----------------------------------------------------------------------
2893! Get current time.
2894!-----------------------------------------------------------------------
2895!
2896 CALL esmf_clockget (clock, &
2897 & currtime=currenttime, &
2898 & rc=rc)
2899 IF (esmf_logfounderror(rctocheck=rc, &
2900 & msg=esmf_logerr_passthru, &
2901 & line=__line__, &
2902 & file=myfile)) THEN
2903 RETURN
2904 END IF
2905!
2906 CALL esmf_timeget (currenttime, &
2907 & yy=year, &
2908 & mm=month, &
2909 & dd=day, &
2910 & h =hour, &
2911 & m =minutes, &
2912 & s =seconds, &
2913 & sn=sn, &
2914 & sd=sd, &
2915 & rc=rc)
2916 IF (esmf_logfounderror(rctocheck=rc, &
2917 & msg=esmf_logerr_passthru, &
2918 & line=__line__, &
2919 & file=myfile)) THEN
2920 RETURN
2921 END IF
2922!
2923 CALL esmf_timeget (currenttime, &
2924 & s_r8=time_current, &
2925 & timestring=time_currentstring, &
2926 & rc=rc)
2927 IF (esmf_logfounderror(rctocheck=rc, &
2928 & msg=esmf_logerr_passthru, &
2929 & line=__line__, &
2930 & file=myfile)) THEN
2931 RETURN
2932 END IF
2933 timeindays=time_current/86400.0_dp
2934 is=index(time_currentstring, 'T') ! remove 'T' in
2935 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
2936!
2937!-----------------------------------------------------------------------
2938! Convert CurrentTime into ROMS clock ellapsed time since
2939! initialization in seconds from reference time.
2940! (The routine "ROMS_clock" is located in ROMS/Utility/dateclock.F)
2941!-----------------------------------------------------------------------
2942!
2943 fseconds=real(seconds,dp)+real(sn,dp)/real(sd,dp)
2944 CALL roms_clock (year, month, day, hour, minutes, fseconds, &
2945 & romsclocktime)
2946!
2947!-----------------------------------------------------------------------
2948! Get list of import fields.
2949!-----------------------------------------------------------------------
2950!
2951 CALL esmf_stateget (models(iroms)%ImportState(ng), &
2952 & itemcount=importcount, &
2953 & rc=rc)
2954 IF (esmf_logfounderror(rctocheck=rc, &
2955 & msg=esmf_logerr_passthru, &
2956 & line=__line__, &
2957 & file=myfile)) THEN
2958 RETURN
2959 END IF
2960!
2961 IF (.not.allocated(importnamelist)) THEN
2962 allocate ( importnamelist(importcount) )
2963 END IF
2964 CALL esmf_stateget (models(iroms)%ImportState(ng), &
2965 & itemnamelist=importnamelist, &
2966 & rc=rc)
2967 IF (esmf_logfounderror(rctocheck=rc, &
2968 & msg=esmf_logerr_passthru, &
2969 & line=__line__, &
2970 & file=myfile)) THEN
2971 RETURN
2972 END IF
2973
2974# ifdef TIME_INTERP
2975!
2976!-----------------------------------------------------------------------
2977! Advance unlimited dimension counter.
2978!-----------------------------------------------------------------------
2979!
2980 IF (petlayoutoption.eq.'CONCURRENT') THEN
2981 record=record+1
2982 END IF
2983# endif
2984!
2985!-----------------------------------------------------------------------
2986! Get import fields.
2987!-----------------------------------------------------------------------
2988!
2989! Set switches to rotate wind stress and wind component for curvilinear
2990! ROMS grid applications.
2991!
2992 got_stress(1:2)=.false.
2993 got_wind(1:2)=.false.
2994# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
2995 got_rhoair=.false.
2996 got_wstar=.false.
2997 got_wind_sbl(1:2)=.false.
2998# endif
2999!
3000! Loop over all import fields to process.
3001!
3002 fld_loop : DO ifld=1,importcount
3003 id=field_index(models(iroms)%ImportField, importnamelist(ifld))
3004!
3005! Get field from import state.
3006!
3007 CALL esmf_stateget (models(iroms)%ImportState(ng), &
3008 & trim(importnamelist(ifld)), &
3009 & field, &
3010 & rc=rc)
3011 IF (esmf_logfounderror(rctocheck=rc, &
3012 & msg=esmf_logerr_passthru, &
3013 & line=__line__, &
3014 & file=myfile)) THEN
3015 RETURN
3016 END IF
3017
3018# ifdef TIME_INTERP
3019!
3020! If cuncurrent coupling and importing time snapshots, update values
3021! in the MODELS(Iroms)%ImportField structure by reading import field
3022! interpolation attributes from source NetCDF file. It is very tricky
3023! to perform inter VM communications. It is easier to read them from
3024! a NetCDF file. ROMS needs these attributes to perform the time
3025! interpolation between snapshots in its kernel.
3026! (HGA: need to figure out how to do inter VM communications)
3027!
3028 IF (petlayoutoption.eq.'CONCURRENT') THEN
3029 CALL netcdf_get_ivar (ng, inlm, attfilename, 'Tindex', &
3030 & models(iroms)%ImportField(id)%Tindex, &
3031 & start=(/iroms,id,record/), &
3032 & total=(/1,1,1/))
3033 IF (founderror(exit_flag, noerror, __line__, &
3034 & myfile)) THEN
3035 rc=esmf_rc_file_read
3036 RETURN
3037 END IF
3038!
3039 is=models(iroms)%ImportField(id)%Tindex
3040 CALL netcdf_get_svar (ng, inlm, attfilename, 'Date', &
3041 & mydatestring, &
3042 & start=(/1,iroms,id,record/), &
3043 & total=(/22,1,1,1/))
3044 IF (founderror(exit_flag, noerror, __line__, &
3045 & myfile)) THEN
3046 rc=esmf_rc_file_read
3047 RETURN
3048 END IF
3049 models(iroms)%ImportField(id)%DateString(is)= &
3050 & mydatestring(1,1,1)
3051!
3052 CALL netcdf_get_time (ng, inlm, attfilename, 'Tcurrent', &
3053 & rclock%DateNumber, mytimeindays, &
3054 & start=(/iroms,id,record/), &
3055 & total=(/1,1,1/))
3056 IF (founderror(exit_flag, noerror, __line__, &
3057 & myfile)) THEN
3058 rc=esmf_rc_file_read
3059 RETURN
3060 END IF
3061!
3062 CALL netcdf_get_time (ng, inlm, attfilename, 'Tstr', &
3063 & rclock%DateNumber, &
3064 & models(iroms)%ImportField(id)%Tstr, &
3065 & start=(/iroms,id,record/), &
3066 & total=(/1,1,1/))
3067 IF (founderror(exit_flag, noerror, __line__, &
3068 & myfile)) THEN
3069 rc=esmf_rc_file_read
3070 RETURN
3071 END IF
3072!
3073 CALL netcdf_get_time (ng, inlm, attfilename, 'Tend', &
3074 & rclock%DateNumber, &
3075 & models(iroms)%ImportField(id)%Tend, &
3076 & start=(/iroms,id,record/), &
3077 & total=(/1,1,1/))
3078 IF (founderror(exit_flag, noerror, __line__, &
3079 & myfile)) THEN
3080 rc=esmf_rc_file_read
3081 RETURN
3082 END IF
3083!
3084 CALL netcdf_get_time (ng, inlm, attfilename, 'Tintrp', &
3085 & rclock%DateNumber, &
3086 & models(iroms)%ImportField(id)%Tintrp(is), &
3087 & start=(/iroms,id,record/), &
3088 & total=(/1,1,1/))
3089 IF (founderror(exit_flag, noerror, __line__, &
3090 & myfile)) THEN
3091 rc=esmf_rc_file_read
3092 RETURN
3093 END IF
3094!
3095 CALL netcdf_get_time (ng, inlm, attfilename, 'Vtime', &
3096 & rclock%DateNumber, &
3097 & models(iroms)%ImportField(id)%Vtime(is), &
3098 & start=(/iroms,id,record/), &
3099 & total=(/1,1,1/))
3100 IF (founderror(exit_flag, noerror, __line__, &
3101 & myfile)) THEN
3102 rc=esmf_rc_file_read
3103 RETURN
3104 END IF
3105 CALL netcdf_get_time (ng, inlm, attfilename, 'Tmin', &
3106 & rclock%DateNumber, &
3107 & models(iroms)%ImportField(id)%Tmin, &
3108 & start=(/iroms,id,record/), &
3109 & total=(/1,1,1/))
3110 IF (founderror(exit_flag, noerror, __line__, &
3111 & myfile)) THEN
3112 rc=esmf_rc_file_read
3113 RETURN
3114 END IF
3115!
3116 CALL netcdf_get_time (ng, inlm, attfilename, 'Tmax', &
3117 & rclock%DateNumber, &
3118 & models(iroms)%ImportField(id)%Tmax, &
3119 & start=(/iroms,id,record/), &
3120 & total=(/1,1,1/))
3121 IF (founderror(exit_flag, noerror, __line__, &
3122 & myfile)) THEN
3123 rc=esmf_rc_file_read
3124 RETURN
3125 END IF
3126 END IF
3127# endif
3128!
3129! Get field pointer. Usually, the DO-loop is executed once since
3130! localDEcount=1.
3131!
3132 de_loop : DO localde=0,localdecount-1
3133 CALL esmf_fieldget (field, &
3134 & localde=localde, &
3135 & farrayptr=ptr2d, &
3136 & rc=rc)
3137 IF (esmf_logfounderror(rctocheck=rc, &
3138 & msg=esmf_logerr_passthru, &
3139 & line=__line__, &
3140 & file=myfile)) THEN
3141 RETURN
3142 END IF
3143
3144# ifdef TIME_INTERP_NOT_WORKING
3145!
3146! Retrieve custom Attribute Package.
3147!
3148 CALL esmf_attributegetattpack (field, &
3149 & 'CustomConvention', &
3150 & 'General', &
3151!! & 'Instance', &
3152 & attpack=attpack, &
3153 & ispresent=ispresent, &
3154 & rc=rc)
3155 IF (esmf_logfounderror(rctocheck=rc, &
3156 & msg=esmf_logerr_passthru, &
3157 & line=__line__, &
3158 & file=myfile)) THEN
3159 RETURN
3160 END IF
3161!
3162! Get field custom attribute for field for time interpolation.
3163!
3164 CALL esmf_attributeget (field, &
3165 & name='TimeInterp', &
3166 & valuelist=attvalues, &
3167 & attpack=attpack, &
3168 & ispresent=ispresent, &
3169 & rc=rc)
3170 IF (esmf_logfounderror(rctocheck=rc, &
3171 & msg=esmf_logerr_passthru, &
3172 & line=__line__, &
3173 & file=myfile)) THEN
3174 RETURN
3175 END IF
3176# endif
3177!
3178! Load import data into ROMS component variable.
3179# ifdef TIME_INTERP
3180! If time interpolating in ROMS kernel, loaded import data into
3181! snapshot storage arrays so time interpolating is carry out.
3182! It is a generic strategy for the case that coupling interval
3183! is greater than ROMS time-step size. Usually, time persisting
3184! of coupling data may alter ocean solution. For example, it may
3185! affect the ocean circulation/energetics if atmospheric forcing
3186! is persisted during infrequent coupling (like every 3, 6, or
3187! 24 hours and so on).
3188# endif
3189!
3190 loadit=.true.
3191 scale =models(iroms)%ImportField(id)%scale_factor
3192 add_offset =models(iroms)%ImportField(id)%add_offset
3193 tindex =models(iroms)%ImportField(id)%Tindex
3194# ifdef TIME_INTERP
3195 tmin =models(iroms)%ImportField(id)%Tmin
3196 tmax =models(iroms)%ImportField(id)%Tmax
3197 tstr =models(iroms)%ImportField(id)%Tstr
3198 tend =models(iroms)%ImportField(id)%Tend
3199 mytintrp(1)=models(iroms)%ImportField(id)%Tintrp(1)
3200 mytintrp(2)=models(iroms)%ImportField(id)%Tintrp(2)
3201 myvtime(1) =models(iroms)%ImportField(id)%Vtime(1)
3202 myvtime(2) =models(iroms)%ImportField(id)%Vtime(2)
3203 mydate(1) =models(iroms)%ImportField(id)%DateString(1)
3204 mydate(2) =models(iroms)%ImportField(id)%DateString(2)
3205# endif
3206!
3207! Set ROMS momentum fluxes and tracer flux scales to kinematic values.
3208! Recall, that all the fluxes are kinematic.
3209!
3210 freshwaterscale=1.0_dp/rho0 ! Kg m-2 s-1 to m/s
3211 stressscale=1.0_dp/rho0 ! Pa=N m-2 to m2/s2
3212 tracerfluxscale=1.0_dp/(rho0*cp) ! Watts m-2 to C m/s
3213!
3214 fval=ptr2d(istrr,jstrr)
3215 myfmin(1)= missing_dp
3216 myfmax(1)=-missing_dp
3217 myfmin(2)= missing_dp
3218 myfmax(2)=-missing_dp
3219!
3220 SELECT CASE (trim(adjustl(importnamelist(ifld))))
3221
3222# if defined BULK_FLUXES || defined ECOSIM || defined ATM_PRESS
3223!
3224! Surface air pressure or mean sea level pressure (mb).
3225!
3226 CASE ('psfc', 'Pair', 'Pmsl')
3227 romsscale=scale
3228 ifield=idpair
3229 gtype=r2dvar
3230 tindex=3-iinfo(8,ifield,ng)
3231 DO j=jstrr,jendr
3232 DO i=istrr,iendr
3233 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3234 fval=scale*ptr2d(i,j)+add_offset
3235 ELSE
3236 fval=0.0_dp
3237 END IF
3238 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3239 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3240 myfmin(2)=min(myfmin(2),fval)
3241 myfmax(2)=max(myfmax(2),fval)
3242# ifdef TIME_INTERP
3243 forces(ng)%PairG(i,j,tindex)=fval
3244# else
3245 forces(ng)%Pair(i,j)=fval
3246# endif
3247 END DO
3248 END DO
3249# ifndef TIME_INTERP
3250 IF (localde.eq.localdecount-1) THEN
3251 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3252 CALL exchange_r2d_tile (ng, tile, &
3253 & lbi, ubi, lbj, ubj, &
3254 & forces(ng)%Pair)
3255 END IF
3256 CALL mp_exchange2d (ng, tile, inlm, 1, &
3257 & lbi, ubi, lbj, ubj, &
3258 & nghostpoints, &
3259 & ewperiodic(ng), nsperiodic(ng), &
3260 & forces(ng)%Pair)
3261 END IF
3262# endif
3263# endif
3264# if defined BULK_FLUXES || defined ECOSIM || \
3265 (defined shortwave && defined ana_srflux && defined albedo)
3266!
3267! Surface air temperature (Celsius).
3268!
3269 CASE ('tsfc', 'Tair')
3270 romsscale=scale
3271 ifield=idtair
3272 gtype=r2dvar
3273 tindex=3-iinfo(8,ifield,ng)
3274 DO j=jstrr,jendr
3275 DO i=istrr,iendr
3276 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3277 fval=scale*ptr2d(i,j)+add_offset
3278 ELSE
3279 fval=0.0_dp
3280 END IF
3281 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3282 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3283 myfmin(2)=min(myfmin(2),fval)
3284 myfmax(2)=max(myfmax(2),fval)
3285# ifdef TIME_INTERP
3286 forces(ng)%TairG(i,j,tindex)=fval
3287# else
3288 forces(ng)%Tair(i,j)=fval
3289# endif
3290 END DO
3291 END DO
3292# ifndef TIME_INTERP
3293 IF (localde.eq.localdecount-1) THEN
3294 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3295 CALL exchange_r2d_tile (ng, tile, &
3296 & lbi, ubi, lbj, ubj, &
3297 & forces(ng)%Tair)
3298 END IF
3299 CALL mp_exchange2d (ng, tile, inlm, 1, &
3300 & lbi, ubi, lbj, ubj, &
3301 & nghostpoints, &
3302 & ewperiodic(ng), nsperiodic(ng), &
3303 & forces(ng)%Tair)
3304 END IF
3305# endif
3306# endif
3307# if defined BULK_FLUXES || defined ECOSIM
3308!
3309! Surface air relative humidity (percentage). Notice that as the
3310! specific humidity, it is loaded to FORCES(ng)%Hair and "bulk_flux.F"
3311! will compute the specific humidity (kg/kg).
3312!
3313 CASE ('Qair')
3314 romsscale=scale
3315 ifield=idqair
3316 gtype=r2dvar
3317 tindex=3-iinfo(8,ifield,ng)
3318 DO j=jstrr,jendr
3319 DO i=istrr,iendr
3320 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3321 fval=scale*ptr2d(i,j)+add_offset
3322 ELSE
3323 fval=0.0_dp
3324 END IF
3325 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3326 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3327 myfmin(2)=min(myfmin(2),fval)
3328 myfmax(2)=max(myfmax(2),fval)
3329# ifdef TIME_INTERP
3330 forces(ng)%HairG(i,j,tindex)=fval
3331# else
3332 forces(ng)%Hair(i,j)=fval
3333# endif
3334 END DO
3335 END DO
3336# ifndef TIME_INTERP
3337 IF (localde.eq.localdecount-1) THEN
3338 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3339 CALL exchange_r2d_tile (ng, tile, &
3340 & lbi, ubi, lbj, ubj, &
3341 & forces(ng)%Hair)
3342 END IF
3343 CALL mp_exchange2d (ng, tile, inlm, 1, &
3344 & lbi, ubi, lbj, ubj, &
3345 & nghostpoints, &
3346 & ewperiodic(ng), nsperiodic(ng), &
3347 & forces(ng)%Hair)
3348 END IF
3349# endif
3350# endif
3351# if defined BULK_FLUXES
3352!
3353! Surface air specific humidity (kg kg-1).
3354!
3355 CASE ('Hair', 'qsfc')
3356 romsscale=scale
3357 ifield=idqair
3358 gtype=r2dvar
3359 tindex=3-iinfo(8,ifield,ng)
3360 DO j=jstrr,jendr
3361 DO i=istrr,iendr
3362 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3363 fval=scale*ptr2d(i,j)+add_offset
3364 ELSE
3365 fval=0.0_dp
3366 END IF
3367 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3368 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3369 myfmin(2)=min(myfmin(2),fval)
3370 myfmax(2)=max(myfmax(2),fval)
3371# ifdef TIME_INTERP
3372 forces(ng)%HairG(i,j,tindex)=fval
3373# else
3374 forces(ng)%Hair(i,j)=fval
3375# endif
3376 END DO
3377 END DO
3378# ifndef TIME_INTERP
3379 IF (localde.eq.localdecount-1) THEN
3380 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3381 CALL exchange_r2d_tile (ng, tile, &
3382 & lbi, ubi, lbj, ubj, &
3383 & forces(ng)%Hair)
3384 END IF
3385 CALL mp_exchange2d (ng, tile, inlm, 1, &
3386 & lbi, ubi, lbj, ubj, &
3387 & nghostpoints, &
3388 & ewperiodic(ng), nsperiodic(ng), &
3389 & forces(ng)%Hair)
3390 END IF
3391# endif
3392# endif
3393# if defined BULK_FLUXES
3394!
3395! Surface net longwave radiation (Celcius m s-1).
3396!
3397 CASE ('lwrd', 'LWrad')
3398 romsscale=tracerfluxscale
3399 ifield=idlrad
3400 gtype=r2dvar
3401 tindex=3-iinfo(8,ifield,ng)
3402 DO j=jstrr,jendr
3403 DO i=istrr,iendr
3404 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3405 fval=scale*ptr2d(i,j)+add_offset
3406 ELSE
3407 fval=0.0_dp
3408 END IF
3409 myfmin(1)=min(myfmin(1),fval)
3410 myfmax(1)=max(myfmax(1),fval)
3411 fval=fval*romsscale
3412 myfmin(2)=min(myfmin(2),fval)
3413 myfmax(2)=max(myfmax(2),fval)
3414# ifdef TIME_INTERP
3415 forces(ng)%lrflxG(i,j,tindex)=fval
3416# else
3417 forces(ng)%lrflx(i,j)=fval
3418# endif
3419 END DO
3420 END DO
3421# ifndef TIME_INTERP
3422 IF (localde.eq.localdecount-1) THEN
3423 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3424 CALL exchange_r2d_tile (ng, tile, &
3425 & lbi, ubi, lbj, ubj, &
3426 & forces(ng)%lrflx)
3427 END IF
3428 CALL mp_exchange2d (ng, tile, inlm, 1, &
3429 & lbi, ubi, lbj, ubj, &
3430 & nghostpoints, &
3431 & ewperiodic(ng), nsperiodic(ng), &
3432 & forces(ng)%lrflx)
3433 END IF
3434# endif
3435# endif
3436# if defined BULK_FLUXES && defined LONGWAVE_OUT
3437!
3438! Surface downward longwave radiation (Celcius m s-1). ROMS will
3439! substract the outgoing IR from model sea surface temperature.
3440!
3441 CASE ('dlwr', 'dLWrad', 'lwrad_down')
3442 romsscale=tracerfluxscale
3443 ifield=idldwn
3444 gtype=r2dvar
3445 tindex=3-iinfo(8,ifield,ng)
3446 DO j=jstrr,jendr
3447 DO i=istrr,iendr
3448 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3449 fval=scale*ptr2d(i,j)+add_offset
3450 ELSE
3451 fval=0.0_dp
3452 END IF
3453 myfmin(1)=min(myfmin(1),fval)
3454 myfmax(1)=max(myfmax(1),fval)
3455 fval=fval*romsscale
3456 myfmin(2)=min(myfmin(2),fval)
3457 myfmax(2)=max(myfmax(2),fval)
3458# ifdef TIME_INTERP
3459 forces(ng)%lrflxG(i,j,tindex)=fval
3460# else
3461 forces(ng)%lrflx(i,j)=fval
3462# endif
3463 END DO
3464 END DO
3465# ifndef TIME_INTERP
3466 IF (localde.eq.localdecount-1) THEN
3467 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3468 CALL exchange_r2d_tile (ng, tile, &
3469 & lbi, ubi, lbj, ubj, &
3470 & forces(ng)%lrflx)
3471 END IF
3472 CALL mp_exchange2d (ng, tile, inlm, 1, &
3473 & lbi, ubi, lbj, ubj, &
3474 & nghostpoints, &
3475 & ewperiodic(ng), nsperiodic(ng), &
3476 & forces(ng)%lrflx)
3477 END IF
3478# endif
3479# endif
3480# if defined BULK_FLUXES
3481!
3482! Rain fall rate (kg m-2 s-1).
3483!
3484 CASE ('prec', 'rain')
3485 romsscale=scale
3486 ifield=idrain
3487 gtype=r2dvar
3488 tindex=3-iinfo(8,ifield,ng)
3489 DO j=jstrr,jendr
3490 DO i=istrr,iendr
3491 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3492 fval=scale*ptr2d(i,j)+add_offset
3493 ELSE
3494 fval=0.0_dp
3495 END IF
3496 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3497 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3498 myfmin(2)=min(myfmin(2),fval)
3499 myfmax(2)=max(myfmax(2),fval)
3500# ifdef TIME_INTERP
3501 forces(ng)%rainG(i,j,tindex)=fval
3502# else
3503 forces(ng)%rain(i,j)=fval
3504# endif
3505 END DO
3506 END DO
3507# ifndef TIME_INTERP
3508 IF (localde.eq.localdecount-1) THEN
3509 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3510 CALL exchange_r2d_tile (ng, tile, &
3511 & lbi, ubi, lbj, ubj, &
3512 & forces(ng)%rain)
3513 END IF
3514 CALL mp_exchange2d (ng, tile, inlm, 1, &
3515 & lbi, ubi, lbj, ubj, &
3516 & nghostpoints, &
3517 & ewperiodic(ng), nsperiodic(ng), &
3518 & forces(ng)%rain)
3519 END IF
3520# endif
3521# endif
3522# if defined BULK_FLUXES || defined ECOSIM
3523!
3524! Surface eastward wind component (m s-1). Imported wind component
3525! is at RHO-points.
3526!
3527 CASE ('wndu', 'Uwind')
3528 IF (.not.allocated(uwind)) THEN
3529 allocate ( uwind(lbi:ubi,lbj:ubj) )
3530 uwind=missing_dp
3531 END IF
3532 got_wind(1)=.true.
3533 romsscale=scale
3534 ifield=iduair
3535 gtype=r2dvar
3536 tindex=3-iinfo(8,ifield,ng)
3537 DO j=jstrr,jendr
3538 DO i=istrr,iendr
3539 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3540 fval=scale*ptr2d(i,j)+add_offset
3541 ELSE
3542 fval=0.0_dp
3543 END IF
3544 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3545 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3546 myfmin(2)=min(myfmin(2),fval)
3547 myfmax(2)=max(myfmax(2),fval)
3548# ifdef TIME_INTERP
3549 forces(ng)%UwindG(i,j,tindex)=fval
3550# else
3551 uwind(i,j)=fval
3552# endif
3553 END DO
3554 END DO
3555# ifndef TIME_INTERP
3556 IF (localde.eq.localdecount-1) THEN
3557 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3558 CALL exchange_r2d_tile (ng, tile, &
3559 & lbi, ubi, lbj, ubj, &
3560 & uwind)
3561 END IF
3562 CALL mp_exchange2d (ng, tile, inlm, 1, &
3563 & lbi, ubi, lbj, ubj, &
3564 & nghostpoints, &
3565 & ewperiodic(ng), nsperiodic(ng), &
3566 & uwind)
3567 END IF
3568# endif
3569# endif
3570# if defined BULK_FLUXES || defined ECOSIM
3571!
3572! Surface northward wind component (m s-1). Imported wind component
3573! is at RHO-points.
3574!
3575 CASE ('wndv', 'Vwind')
3576 IF (.not.allocated(vwind)) THEN
3577 allocate ( vwind(lbi:ubi,lbj:ubj) )
3578 vwind=missing_dp
3579 END IF
3580 got_wind(2)=.true.
3581 romsscale=scale
3582 ifield=idvair
3583 gtype=r2dvar
3584 tindex=3-iinfo(8,ifield,ng)
3585 DO j=jstrr,jendr
3586 DO i=istrr,iendr
3587 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3588 fval=scale*ptr2d(i,j)+add_offset
3589 ELSE
3590 fval=0.0_dp
3591 END IF
3592 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3593 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3594 myfmin(2)=min(myfmin(2),fval)
3595 myfmax(2)=max(myfmax(2),fval)
3596# ifdef TIME_INTERP
3597 forces(ng)%VwindG(i,j,tindex)=fval
3598# else
3599 vwind(i,j)=fval
3600# endif
3601 END DO
3602 END DO
3603# ifndef TIME_INTERP
3604 IF (localde.eq.localdecount-1) THEN
3605 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3606 CALL exchange_r2d_tile (ng, tile, &
3607 & lbi, ubi, lbj, ubj, &
3608 & vwind)
3609 END IF
3610 CALL mp_exchange2d (ng, tile, inlm, 1, &
3611 & lbi, ubi, lbj, ubj, &
3612 & nghostpoints, &
3613 & ewperiodic(ng), nsperiodic(ng), &
3614 & vwind)
3615 END IF
3616# endif
3617# endif
3618# if defined SHORTWAVE
3619!
3620! Surface solar shortwave radiation (Celsius m s-1).
3621!
3622 CASE ('swrd', 'swrad', 'SWrad', 'SWrad_daily')
3623 romsscale=tracerfluxscale
3624 ifield=idsrad
3625 gtype=r2dvar
3626 tindex=3-iinfo(8,ifield,ng)
3627 DO j=jstrr,jendr
3628 DO i=istrr,iendr
3629 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3630 fval=scale*ptr2d(i,j)+add_offset
3631 ELSE
3632 fval=0.0_dp
3633 END IF
3634 myfmin(1)=min(myfmin(1),fval)
3635 myfmax(1)=max(myfmax(1),fval)
3636 fval=fval*romsscale
3637 myfmin(2)=min(myfmin(2),fval)
3638 myfmax(2)=max(myfmax(2),fval)
3639# ifdef TIME_INTERP
3640 forces(ng)%srflxG(i,j,tindex)=fval
3641# else
3642 forces(ng)%srflx(i,j)=fval
3643# endif
3644 END DO
3645 END DO
3646# ifndef TIME_INTERP
3647 IF (localde.eq.localdecount-1) THEN
3648 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3649 CALL exchange_r2d_tile (ng, tile, &
3650 & lbi, ubi, lbj, ubj, &
3651 & forces(ng)%srflx)
3652 END IF
3653 CALL mp_exchange2d (ng, tile, inlm, 1, &
3654 & lbi, ubi, lbj, ubj, &
3655 & nghostpoints, &
3656 & ewperiodic(ng), nsperiodic(ng), &
3657 & forces(ng)%srflx)
3658 END IF
3659# endif
3660# endif
3661# if !defined BULK_FLUXES
3662!
3663! Net longwave radiation flux(W m-2). Used for debugging and plotting
3664! purposes to check the fluxes used for the computation of the surface
3665! net heat flux in NUOPC cap file "esmf_atm.F".
3666!
3667 CASE ('lwr', 'LWrad')
3668 romsscale=tracerfluxscale
3669 ifield=idlrad
3670 gtype=r2dvar
3671 tindex=3-iinfo(8,ifield,ng)
3672 DO j=jstrr,jendr
3673 DO i=istrr,iendr
3674 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3675 fval=scale*ptr2d(i,j)+add_offset
3676 ELSE
3677 fval=0.0_dp
3678 END IF
3679 myfmin(1)=min(myfmin(1),fval)
3680 myfmax(1)=max(myfmax(1),fval)
3681 fval=fval*romsscale
3682 myfmin(2)=min(myfmin(2),fval)
3683 myfmax(2)=max(myfmax(2),fval)
3684 forces(ng)%lrflx(i,j)=fval
3685 END DO
3686 END DO
3687!
3688! Surface downward longwave radiation flux(W m-2). Used for debugging
3689! and plotting purposes to check the fluxes used for the computation
3690! of the surface net heat flux in NUOPC cap file "esmf_atm.F".
3691!
3692 CASE ('dlwr', 'dLWrad', 'lwrad_down')
3693 romsscale=tracerfluxscale
3694 ifield=idldwn
3695 gtype=r2dvar
3696 tindex=3-iinfo(8,ifield,ng)
3697 DO j=jstrr,jendr
3698 DO i=istrr,iendr
3699 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3700 fval=scale*ptr2d(i,j)+add_offset
3701 ELSE
3702 fval=0.0_dp
3703 END IF
3704 myfmin(1)=min(myfmin(1),fval)
3705 myfmax(1)=max(myfmax(1),fval)
3706 fval=fval*romsscale
3707 myfmin(2)=min(myfmin(2),fval)
3708 myfmax(2)=max(myfmax(2),fval)
3709 forces(ng)%lrflx(i,j)=fval
3710 END DO
3711 END DO
3712!
3713! Surface latent heat flux (W m-2). Used for plotting and debugging
3714! purposes (DebugLevel=3) to check the components of the net surface
3715! net heat flux computation.
3716!
3717 CASE ('latent', 'LHfx')
3718 romsscale=tracerfluxscale
3719 gtype=r2dvar
3720 DO j=jstrr,jendr
3721 DO i=istrr,iendr
3722 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3723 fval=scale*ptr2d(i,j)+add_offset
3724 ELSE
3725 fval=0.0_dp
3726 END IF
3727 myfmin(1)=min(myfmin(1),fval)
3728 myfmax(1)=max(myfmax(1),fval)
3729 fval=fval*romsscale
3730 myfmin(2)=min(myfmin(2),fval)
3731 myfmax(2)=max(myfmax(2),fval)
3732 forces(ng)%lhflx(i,j)=fval
3733 END DO
3734 END DO
3735!
3736! Surface sensible heat flux (W m-2). Used for plotting and debugging
3737! purposes (DebugLevel=3) to check the components of the net surface
3738! net heat flux computation.
3739!
3740 CASE ('sensible', 'SHfx')
3741 romsscale=tracerfluxscale
3742 gtype=r2dvar
3743 DO j=jstrr,jendr
3744 DO i=istrr,iendr
3745 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3746 fval=scale*ptr2d(i,j)+add_offset
3747 ELSE
3748 fval=0.0_dp
3749 END IF
3750 myfmin(1)=min(myfmin(1),fval)
3751 myfmax(1)=max(myfmax(1),fval)
3752 fval=fval*romsscale
3753 myfmin(2)=min(myfmin(2),fval)
3754 myfmax(2)=max(myfmax(2),fval)
3755 forces(ng)%shflx(i,j)=fval
3756 END DO
3757 END DO
3758!
3759! Surface net heat flux (Celsius m s-1).
3760!
3761 CASE ('nflx', 'shflux')
3762 romsscale=tracerfluxscale
3763 ifield=idtsur(itemp)
3764 gtype=r2dvar
3765 tindex=3-iinfo(8,ifield,ng)
3766 DO j=jstrr,jendr
3767 DO i=istrr,iendr
3768 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3769 fval=scale*ptr2d(i,j)+add_offset
3770 ELSE
3771 fval=0.0_dp
3772 END IF
3773 myfmin(1)=min(myfmin(1),fval)
3774 myfmax(1)=max(myfmax(1),fval)
3775 fval=fval*romsscale
3776 myfmin(2)=min(myfmin(2),fval)
3777 myfmax(2)=max(myfmax(2),fval)
3778# ifdef TIME_INTERP
3779 forces(ng)%stfluxG(i,j,tindex,itemp)=fval
3780# else
3781 forces(ng)%stflux(i,j,itemp)=fval
3782# endif
3783 END DO
3784 END DO
3785# ifndef TIME_INTERP
3786 IF (localde.eq.localdecount-1) THEN
3787 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3788 CALL exchange_r2d_tile (ng, tile, &
3789 & lbi, ubi, lbj, ubj, &
3790 & forces(ng)%stflux(:,:,itemp))
3791 END IF
3792 CALL mp_exchange2d (ng, tile, inlm, 1, &
3793 & lbi, ubi, lbj, ubj, &
3794 & nghostpoints, &
3795 & ewperiodic(ng), nsperiodic(ng), &
3796 & forces(ng)%stflux(:,:,itemp))
3797 END IF
3798# endif
3799# endif
3800# if !defined BULK_FLUXES && defined SALINITY
3801!
3802! Surface net freshwater flux: E-P (m s-1).
3803!
3804 CASE ('sflx', 'swflux')
3805 romsscale=freshwaterscale
3806 ifield=idtsur(isalt)
3807 gtype=r2dvar
3808 tindex=3-iinfo(8,ifield,ng)
3809 DO j=jstrr,jendr
3810 DO i=istrr,iendr
3811 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3812 fval=scale*ptr2d(i,j)+add_offset
3813 ELSE
3814 fval=0.0_dp
3815 END IF
3816 myfmin(1)=min(myfmin(1),fval)
3817 myfmax(1)=max(myfmax(1),fval)
3818 fval=fval*romsscale
3819 myfmin(2)=min(myfmin(2),fval)
3820 myfmax(2)=max(myfmax(2),fval)
3821# ifdef TIME_INTERP
3822 forces(ng)%stfluxG(i,j,tindex,isalt)=fval
3823# else
3824 forces(ng)%stflux(i,j,isalt)=fval
3825# endif
3826 END DO
3827 END DO
3828# ifndef TIME_INTERP
3829 IF (localde.eq.localdecount-1) THEN
3830 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3831 CALL exchange_r2d_tile (ng, tile, &
3832 & lbi, ubi, lbj, ubj, &
3833 & forces(ng)%stflux(:,:,isalt))
3834 END IF
3835 CALL mp_exchange2d (ng, tile, inlm, 1, &
3836 & lbi, ubi, lbj, ubj, &
3837 & nghostpoints, &
3838 & ewperiodic(ng), nsperiodic(ng), &
3839 & forces(ng)%stflux(:,:,isalt))
3840 END IF
3841# endif
3842# endif
3843# if !defined BULK_FLUXES
3844!
3845! Surface eastward wind stress component (m2 s-2). Imported stress
3846! component is at RHO-points.
3847!
3848 CASE ('taux', 'sustr')
3849 IF (.not.allocated(ustress)) THEN
3850 allocate ( ustress(lbi:ubi,lbj:ubj) )
3851 ustress=missing_dp
3852 END IF
3853 got_stress(1)=.true.
3854 romsscale=stressscale
3855 ifield=idusms
3856 gtype=u2dvar
3857 tindex=3-iinfo(8,ifield,ng)
3858 DO j=jstrr,jendr
3859 DO i=istrr,iendr
3860 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3861 fval=scale*ptr2d(i,j)+add_offset
3862 ELSE
3863 fval=0.0_dp
3864 END IF
3865 myfmin(1)=min(myfmin(1),fval)
3866 myfmax(1)=max(myfmax(1),fval)
3867 fval=fval*romsscale
3868 myfmin(2)=min(myfmin(2),fval)
3869 myfmax(2)=max(myfmax(2),fval)
3870# ifdef TIME_INTERP
3871 forces(ng)%sustrG(i,j,tindex)=fval
3872# else
3873 ustress(i,j)=fval
3874# endif
3875 END DO
3876 END DO
3877 IF (localde.eq.localdecount-1) THEN
3878 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3879 CALL exchange_r2d_tile (ng, tile, &
3880 & lbi, ubi, lbj, ubj, &
3881 & ustress)
3882 END IF
3883 CALL mp_exchange2d (ng, tile, inlm, 1, &
3884 & lbi, ubi, lbj, ubj, &
3885 & nghostpoints, &
3886 & ewperiodic(ng), nsperiodic(ng), &
3887 & ustress)
3888 END IF
3889# endif
3890# if !defined BULK_FLUXES
3891!
3892! Surface northward wind stress component (m2 s-2). Imported stress
3893! component is at RHO-points.
3894!
3895 CASE ('tauy', 'svstr')
3896 IF (.not.allocated(vstress)) THEN
3897 allocate ( vstress(lbi:ubi,lbj:ubj) )
3898 vstress=missing_dp
3899 END IF
3900 got_stress(2)=.true.
3901 romsscale=stressscale
3902 ifield=idvsms
3903 gtype=v2dvar
3904 tindex=3-iinfo(8,ifield,ng)
3905 DO j=jstrr,jendr
3906 DO i=istrr,iendr
3907 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3908 fval=scale*ptr2d(i,j)+add_offset
3909 ELSE
3910 fval=0.0_dp
3911 END IF
3912 myfmin(1)=min(myfmin(1),fval)
3913 myfmax(1)=max(myfmax(1),fval)
3914 fval=fval*romsscale
3915 myfmin(2)=min(myfmin(2),fval)
3916 myfmax(2)=max(myfmax(2),fval)
3917# ifdef TIME_INTERP
3918 forces(ng)%svstrG(i,j,tindex)=fval
3919# else
3920 vstress(i,j)=fval
3921# endif
3922 END DO
3923 END DO
3924 IF (localde.eq.localdecount-1) THEN
3925 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3926 CALL exchange_r2d_tile (ng, tile, &
3927 & lbi, ubi, lbj, ubj, &
3928 & vstress)
3929 END IF
3930 CALL mp_exchange2d (ng, tile, inlm, 1, &
3931 & lbi, ubi, lbj, ubj, &
3932 & nghostpoints, &
3933 & ewperiodic(ng), nsperiodic(ng), &
3934 & vstress)
3935 END IF
3936# endif
3937# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
3938!
3939! Surface air density (kg/m3).
3940!
3941 CASE ('RhoAir')
3942 IF (.not.allocated(rhoair)) THEN
3943 allocate ( rhoair(lbi:ubi,lbj:ubj) )
3944 rhoair=missing_dp
3945 END IF
3946 got_rhoair=.true.
3947 romsscale=scale
3948 DO j=jstrr,jendr
3949 DO i=istrr,iendr
3950 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3951 fval=scale*ptr2d(i,j)+add_offset
3952 ELSE
3953 fval=0.0_dp
3954 END IF
3955 myfmin(1)=min(myfmin(1),fval)
3956 myfmax(1)=max(myfmax(1),fval)
3957 fval=fval*romsscale
3958 myfmin(2)=min(myfmin(2),fval)
3959 myfmax(2)=max(myfmax(2),fval)
3960 rhoair(i,j)=fval
3961 END DO
3962 END DO
3963 IF (localde.eq.localdecount-1) THEN
3964 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3965 CALL exchange_r2d_tile (ng, tile, &
3966 & lbi, ubi, lbj, ubj, &
3967 & rhoair)
3968 END IF
3969 CALL mp_exchange2d (ng, tile, inlm, 1, &
3970 & lbi, ubi, lbj, ubj, &
3971 & nghostpoints, &
3972 & ewperiodic(ng), nsperiodic(ng), &
3973 & rhoair)
3974 END IF
3975!
3976! Eastward wind component (m s-1) at surface boundary layer. Imported
3977! wind component is at RHO-points.
3978!
3979 CASE ('Uwind_sbl')
3980 IF (.not.allocated(xwind)) THEN
3981 allocate ( xwind(lbi:ubi,lbj:ubj) )
3982 xwind=missing_dp
3983 END IF
3984 got_wind_sbl(1)=.true.
3985 romsscale=scale
3986 DO j=jstrr,jendr
3987 DO i=istrr,iendr
3988 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3989 fval=scale*ptr2d(i,j)+add_offset
3990 ELSE
3991 fval=0.0_dp
3992 END IF
3993 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3994 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3995 fval=fval*romsscale
3996 myfmin(2)=min(myfmin(2),fval)
3997 myfmax(2)=max(myfmax(2),fval)
3998 xwind(i,j)=fval
3999 END DO
4000 END DO
4001 IF (localde.eq.localdecount-1) THEN
4002 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4003 CALL exchange_r2d_tile (ng, tile, &
4004 & lbi, ubi, lbj, ubj, &
4005 & xwind)
4006 END IF
4007 CALL mp_exchange2d (ng, tile, inlm, 1, &
4008 & lbi, ubi, lbj, ubj, &
4009 & nghostpoints, &
4010 & ewperiodic(ng), nsperiodic(ng), &
4011 & xwind)
4012 END IF
4013!
4014! Northward wind component (m s-1) at surface boundary layer. Imported
4015! wind component is at RHO-points.
4016!
4017 CASE ('Vwind_sbl')
4018 IF (.not.allocated(ywind)) THEN
4019 allocate ( ywind(lbi:ubi,lbj:ubj) )
4020 ywind=missing_dp
4021 END IF
4022 got_wind_sbl(2)=.true.
4023 romsscale=scale
4024 DO j=jstrr,jendr
4025 DO i=istrr,iendr
4026 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
4027 fval=scale*ptr2d(i,j)+add_offset
4028 ELSE
4029 fval=0.0_dp
4030 END IF
4031 myfmin(1)=min(myfmin(1),ptr2d(i,j))
4032 myfmax(1)=max(myfmax(1),ptr2d(i,j))
4033 fval=fval*romsscale
4034 myfmin(2)=min(myfmin(2),fval)
4035 myfmax(2)=max(myfmax(2),fval)
4036 ywind(i,j)=fval
4037 END DO
4038 END DO
4039 IF (localde.eq.localdecount-1) THEN
4040 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4041 CALL exchange_r2d_tile (ng, tile, &
4042 & lbi, ubi, lbj, ubj, &
4043 & ywind)
4044 END IF
4045 CALL mp_exchange2d (ng, tile, inlm, 1, &
4046 & lbi, ubi, lbj, ubj, &
4047 & nghostpoints, &
4048 & ewperiodic(ng), nsperiodic(ng), &
4049 & ywind)
4050 END IF
4051!
4052! Surface frictional wind magnitude (m s-1) from similarity theory.
4053! Imported wind magnitude is at RHO-points.
4054!
4055 CASE ('Wstar')
4056 IF (.not.allocated(wstar)) THEN
4057 allocate ( wstar(lbi:ubi,lbj:ubj) )
4058 wstar=missing_dp
4059 END IF
4060 got_wstar=.true.
4061 romsscale=scale
4062 DO j=jstrr,jendr
4063 DO i=istrr,iendr
4064 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
4065 fval=scale*ptr2d(i,j)+add_offset
4066 ELSE
4067 fval=0.0_dp
4068 END IF
4069 myfmin(1)=min(myfmin(1),ptr2d(i,j))
4070 myfmax(1)=max(myfmax(1),ptr2d(i,j))
4071 fval=fval*romsscale
4072 myfmin(2)=min(myfmin(2),fval)
4073 myfmax(2)=max(myfmax(2),fval)
4074 wstar(i,j)=fval
4075 END DO
4076 END DO
4077 IF (localde.eq.localdecount-1) THEN
4078 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4079 CALL exchange_r2d_tile (ng, tile, &
4080 & lbi, ubi, lbj, ubj, &
4081 & wstar)
4082 END IF
4083 CALL mp_exchange2d (ng, tile, inlm, 1, &
4084 & lbi, ubi, lbj, ubj, &
4085 & nghostpoints, &
4086 & ewperiodic(ng), nsperiodic(ng), &
4087 & wstar)
4088 END IF
4089# endif
4090!
4091! Import field not found.
4092!
4093 CASE DEFAULT
4094 IF (localpet.eq.0) THEN
4095 WRITE (cplout,10) trim(importnamelist(ifld)), &
4096 & trim(time_currentstring), &
4097 & trim(cinpname)
4098 END IF
4099 exit_flag=9
4100 IF (founderror(exit_flag, noerror, __line__, &
4101 & myfile)) THEN
4102 rc=esmf_rc_not_found
4103 RETURN
4104 END IF
4105 END SELECT
4106!
4107! Print pointer information.
4108!
4109 IF (debuglevel.eq.4) THEN
4110 WRITE (cplout,20) localpet, localde, &
4111 & lbound(ptr2d,dim=1), ubound(ptr2d,dim=1), &
4112 & lbound(ptr2d,dim=2), ubound(ptr2d,dim=2), &
4113 & istrr, iendr, jstrr, jendr
4114 END IF
4115!
4116! Nullify pointer to make sure that it does not point on a random
4117! part in the memory.
4118!
4119 IF (associated(ptr2d)) nullify (ptr2d)
4120 END DO de_loop
4121!
4122! Get import field minimun and maximum values.
4123!
4124 CALL esmf_vmallreduce (vm, &
4125 & senddata=myfmin, &
4126 & recvdata=fmin, &
4127 & count=2, &
4128 & reduceflag=esmf_reduce_min, &
4129 & rc=rc)
4130 IF (esmf_logfounderror(rctocheck=rc, &
4131 & msg=esmf_logerr_passthru, &
4132 & line=__line__, &
4133 & file=myfile)) THEN
4134 RETURN
4135 END IF
4136!
4137 CALL esmf_vmallreduce (vm, &
4138 & senddata=myfmax, &
4139 & recvdata=fmax, &
4140 & count=2, &
4141 & reduceflag=esmf_reduce_max, &
4142 & rc=rc)
4143 IF (esmf_logfounderror(rctocheck=rc, &
4144 & msg=esmf_logerr_passthru, &
4145 & line=__line__, &
4146 & file=myfile)) THEN
4147 RETURN
4148 END IF
4149!
4150! Write out import field information.
4151!
4152 IF ((debuglevel.ge.0).and.(localpet.eq.0)) THEN
4153 WRITE (cplout,30) trim(importnamelist(ifld)), &
4154# ifdef TIME_INTERP
4155 & trim(mydate(tindex)), ng, &
4156 & fmin(1), fmax(1), tindex
4157# else
4158 & trim(time_currentstring), ng, &
4159 & fmin(1), fmax(1)
4160# endif
4161 IF (romsscale.ne.1.0_dp) THEN
4162 WRITE (cplout,40) fmin(2), fmax(2), &
4163 & ' romsScale = ', romsscale
4164 ELSE IF (add_offset.ne.0.0_dp) THEN
4165 WRITE (cplout,40) fmin(2), fmax(2), &
4166 & ' AddOffset = ', add_offset
4167 END IF
4168 END IF
4169
4170# ifdef TIME_INTERP
4171!
4172! Load ROMS metadata information needed for time interpolation and
4173! reporting.
4174!
4175 IF (loadit) THEN
4176 linfo(1,ifield,ng)=.true. ! Lgrided
4177 linfo(3,ifield,ng)=.false. ! Lonerec
4178 iinfo(1,ifield,ng)=gtype
4179 iinfo(8,ifield,ng)=tindex
4180 finfo(1,ifield,ng)=tmin
4181 finfo(2,ifield,ng)=tmax
4182 finfo(3,ifield,ng)=tstr
4183 finfo(4,ifield,ng)=tend
4184 finfo(8,ifield,ng)=fmin(1)
4185 finfo(9,ifield,ng)=fmax(1)
4186 vtime(tindex,ifield,ng)=myvtime(tindex)
4187 tintrp(tindex,ifield,ng)=mytintrp(tindex)*86400.0_dp
4188 END IF
4189# endif
4190!
4191! Debugging: write out import field into NetCDF file.
4192!
4193 IF ((debuglevel.ge.3).and. &
4194 & models(iroms)%ImportField(id)%debug_write) THEN
4195 WRITE (ofile,50) ng, trim(importnamelist(ifld)), &
4196 & year, month, day, hour, minutes, seconds
4197 CALL esmf_fieldwrite (field, &
4198 & trim(ofile), &
4199 & overwrite=.true., &
4200 & rc=rc)
4201 IF (esmf_logfounderror(rctocheck=rc, &
4202 & msg=esmf_logerr_passthru, &
4203 & line=__line__, &
4204 & file=myfile)) THEN
4205 RETURN
4206 END IF
4207 END IF
4208
4209 END DO fld_loop
4210
4211# if defined BULK_FLUXES || defined ECOSIM
4212!
4213! If applicable, rotate wind components to ROMS curvilinear grid.
4214!
4215 IF (got_wind(1).and.got_wind(2)) THEN
4216 CALL roms_rotate (ng, tile, geo2grid_rho, &
4217 & lbi, ubi, lbj, ubj, &
4218 & uwind, vwind, &
4219 & forces(ng)%Uwind, forces(ng)%Vwind)
4220 deallocate (uwind)
4221 deallocate (vwind)
4222 END IF
4223# endif
4224# if !defined BULK_FLUXES
4225!
4226! If applicable, rotate wind stress components to ROMS curvilinear
4227! grid.
4228!
4229 IF (got_stress(1).and.got_stress(2)) THEN
4230 CALL roms_rotate (ng, tile, geo2grid, &
4231 & lbi, ubi, lbj, ubj, &
4232 & ustress, vstress, &
4233 & forces(ng)%sustr, forces(ng)%svstr)
4234 deallocate (ustress)
4235 deallocate (vstress)
4236 END IF
4237# endif
4238# if defined WIND_MINUS_CURRENT && !defined BULK_FLUXES
4239!
4240! If applicable, compute surface wind stress components. The surface
4241! ocean currents are substracted to the wind.
4242!
4243! The wind stress component are computed as:
4244!
4245! taux/rho0 = RhoAir * Cd * Wrel * Urel
4246! tauy/rho0 = RhoAir * Cd * Wrel * Vrel
4247! where
4248! Cd = Wstr**2 / Wmag**2
4249!
4250! so the magnitude is diminished by the weaker relative (wind minus
4251! current) components. The coupling is incompleate becasue there is
4252! not feeback to the atmosphere (wind is not modified by currents).
4253!
4254 myfmin= missing_dp
4255 myfmax=-missing_dp
4256!
4257 IF (got_rhoair.and.got_wstar.and. &
4258 & got_wind_sbl(1).and.got_wind_sbl(2)) THEN
4259 IF (.not.allocated(uwrk)) THEN
4260 allocate ( uwrk(lbi:ubi,lbj:ubj) )
4261 uwrk=missing_dp
4262 END IF
4263 IF (.not.allocated(vwrk)) THEN
4264 allocate ( vwrk(lbi:ubi,lbj:ubj) )
4265 vwrk=missing_dp
4266 END IF
4267!
4268 CALL roms_rotate (ng, tile, grid2geo_rho, &
4269 & lbi, ubi, lbj, ubj, &
4270 & ocean(ng)%u(:,:,n(ng),nstp(ng)), &
4271 & ocean(ng)%v(:,:,n(ng),nstp(ng)), &
4272 & uwrk, vwrk) ! rotated currents to E-N
4273!
4274 DO j=jstr-1,jend+1
4275 DO i=istr-1,iend+1
4276 romsscale=stressscale ! m3/kg
4277 urel=xwind(i,j)-uwrk(i,j) ! relative wind:
4278 vrel=ywind(i,j)-vwrk(i,j) ! wind minus current
4279 wmag=sqrt(xwind(i,j)*xwind(i,j)+ &
4280 & ywind(i,j)*ywind(i,j)) ! ATM wind magnitude
4281 wrel=sqrt(urel*urel+vrel*vrel) ! relative magmitude
4282 cff1=romsscale*rhoair(i,j)
4283 cff2=wstar(i,j)*wstar(i,j)/(wmag*wmag+eps)
4284 cff3=cff1*cff2*wrel ! m/s
4285 uwrk(i,j)=cff3*urel ! m2/s2
4286 vwrk(i,j)=cff3*vrel ! m2/s2
4287 myfmin(1)=min(myfmin(1),uwrk(i,j))
4288 myfmin(2)=min(myfmin(2),vwrk(i,j))
4289 myfmax(1)=max(myfmax(1),uwrk(i,j))
4290 myfmax(2)=max(myfmax(2),vwrk(i,j))
4291 END DO
4292 END DO
4293 deallocate (rhoair)
4294 deallocate (wstar)
4295 deallocate (xwind)
4296 deallocate (ywind)
4297! ! rotate stress to grid
4298 CALL roms_rotate (ng, tile, geo2grid, &
4299 & lbi, ubi, lbj, ubj, &
4300 & uwrk, vwrk, &
4301 & forces(ng)%sustr, &
4302 & forces(ng)%svstr)
4303 deallocate (uwrk)
4304 deallocate (vwrk)
4305!
4306! Report computed wind stress minimum and maximum values.
4307!
4308 IF (debuglevel.ge.0) THEN
4309 CALL esmf_vmallreduce (vm, &
4310 & senddata=myfmin, &
4311 & recvdata=fmin, &
4312 & count=2, &
4313 & reduceflag=esmf_reduce_min, &
4314 & rc=rc)
4315 IF (esmf_logfounderror(rctocheck=rc, &
4316 & msg=esmf_logerr_passthru, &
4317 & line=__line__, &
4318 & file=myfile)) THEN
4319 RETURN
4320 END IF
4321!
4322 CALL esmf_vmallreduce (vm, &
4323 & senddata=myfmax, &
4324 & recvdata=fmax, &
4325 & count=2, &
4326 & reduceflag=esmf_reduce_max, &
4327 & rc=rc)
4328 IF (esmf_logfounderror(rctocheck=rc, &
4329 & msg=esmf_logerr_passthru, &
4330 & line=__line__, &
4331 & file=myfile)) THEN
4332 RETURN
4333 END IF
4334!
4335 IF (localpet.eq.0) THEN
4336 WRITE (cplout,60) 'sustr', &
4337 & trim(time_currentstring), ng, &
4338 & fmin(1)/stressscale, &
4339 & fmax(1)/stressscale
4340 WRITE (cplout,40) fmin(1), fmax(1), &
4341 & ' romsScale = ', stressscale
4342!
4343 WRITE (cplout,60) 'svstr', &
4344 & trim(time_currentstring), ng, &
4345 & fmin(2)/stressscale, &
4346 & fmax(2)/stressscale
4347 WRITE (cplout,40) fmin(2), fmax(2), &
4348 & ' romsScale = ', stressscale
4349 END IF
4350 END IF
4351 END IF
4352# endif
4353!
4354! Deallocate local arrays.
4355!
4356 IF (allocated(importnamelist)) deallocate (importnamelist)
4357!
4358! Update ROMS import calls counter.
4359!
4360 IF (importcount.gt.0) THEN
4361 models(iroms)%ImportCalls=models(iroms)%ImportCalls+1
4362 END IF
4363!
4364 IF (esm_track) THEN
4365 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_Import', &
4366 & ', PET', petrank
4367 FLUSH (trac)
4368 END IF
4369 IF (debuglevel.gt.0) FLUSH (cplout)
4370!
4371 10 FORMAT (/,3x,' ROMS_Import - unable to find option to import: ', &
4372 & a,t72,a,/,18x,'check ''Import(roms)'' in input script: ', &
4373 & a)
4374 20 FORMAT (18x,'PET/DE [',i3.3,'/',i2.2,'], Pointer Size: ',4i8, &
4375 & /,36x,'Tiling Range: ',4i8)
4376 30 FORMAT (3x,' ROMS_Import - ESMF: importing field ''',a,'''', &
4377 & t72,a,2x,'Grid ',i2.2, &
4378# ifdef TIME_INTERP
4379 & /,19x,'(InpMin = ', 1p,e15.8,0p,' InpMax = ',1p,e15.8,0p, &
4380 & ' SnapshotIndex = ',i1,')')
4381# else
4382 & /,19x,'(InpMin = ', 1p,e15.8,0p,' InpMax = ',1p,e15.8,0p, &
4383 & ')')
4384# endif
4385 40 FORMAT (19x,'(OutMin = ', 1p,e15.8,0p,' OutMax = ',1p,e15.8,0p, &
4386 & 1x,a,1p,e15.8,0p,')')
4387 50 FORMAT ('roms_',i2.2,'_import_',a,'_',i4.4,2('-',i2.2),'_', &
4388 & i2.2,2('.',i2.2),'.nc')
4389 60 FORMAT (3x,' ROMS_Import - ESMF: computing field ''',a,'''', &
4390 & t72,a,2x,'Grid ',i2.2, &
4391 & /,19x,'(InpMin = ', 1p,e15.8,0p,' InpMax = ',1p,e15.8,0p, &
4392 & ')')
4393!
4394 RETURN
4395 END SUBROUTINE roms_import
4396!
4397 SUBROUTINE roms_export (ng, model, rc)
4398!
4399!=======================================================================
4400! !
4401! Exports ROMS fields to other coupled gridded components. !
4402! !
4403!=======================================================================
4404!
4405! Imported variable declarations.
4406!
4407 integer, intent(in) :: ng
4408 integer, intent(out) :: rc
4409!
4410 TYPE (esmf_gridcomp) :: model
4411!
4412! Local variable declarations.
4413!
4414 logical :: get_barotropic
4415 logical :: get_surfacecurrent
4416!
4417 integer :: istr, iend, jstr, jend
4418 integer :: istrr, iendr, jstrr, jendr
4419 integer :: lbi, ubi, lbj, ubj
4420 integer :: exportcount
4421 integer :: localde, localdecount, localpet, tile
4422 integer :: year, month, day, hour, minutes, seconds, sn, sd
4423 integer :: ifld, i, is, j
4424!
4425 real (dp) :: fmin(1), fmax(1), fval, myfmin(1), myfmax(1)
4426!
4427 real (dp), pointer :: ptr2d(:,:) => null()
4428!
4429 real (dp), allocatable :: ubar(:,:), vbar(:,:)
4430 real (dp), allocatable :: usur(:,:), vsur(:,:)
4431!
4432 character (len=22) :: time_currentstring
4433
4434 character (len=:), allocatable :: fldname
4435
4436 character (len=*), parameter :: myfile = &
4437 & __FILE__//", ROMS_Export"
4438
4439 character (ESMF_MAXSTR) :: cname, ofile
4440 character (ESMF_MAXSTR), allocatable :: exportnamelist(:)
4441!
4442 TYPE (esmf_field) :: field
4443 TYPE (esmf_time) :: currenttime
4444 TYPE (esmf_vm) :: vm
4445!
4446!-----------------------------------------------------------------------
4447! Initialize return code flag to success state (no error).
4448!-----------------------------------------------------------------------
4449!
4450 IF (esm_track) THEN
4451 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_Export', &
4452 & ', PET', petrank
4453 FLUSH (trac)
4454 END IF
4455 rc=esmf_success
4456!
4457!-----------------------------------------------------------------------
4458! Get information about the gridded component.
4459!-----------------------------------------------------------------------
4460!
4461 CALL esmf_gridcompget (model, &
4462 & localpet=localpet, &
4463 & vm=vm, &
4464 & name=cname, &
4465 & rc=rc)
4466 IF (esmf_logfounderror(rctocheck=rc, &
4467 & msg=esmf_logerr_passthru, &
4468 & line=__line__, &
4469 & file=myfile)) THEN
4470 RETURN
4471 END IF
4472!
4473! Get number of local decomposition elements (DEs). Usually, a single
4474! DE is associated with each Persistent Execution Thread (PETs). Thus,
4475! localDEcount=1.
4476!
4477 CALL esmf_gridget (models(iroms)%grid(ng), &
4478 & localdecount=localdecount, &
4479 & rc=rc)
4480 IF (esmf_logfounderror(rctocheck=rc, &
4481 & msg=esmf_logerr_passthru, &
4482 & line=__line__, &
4483 & file=myfile)) THEN
4484 RETURN
4485 END IF
4486!
4487! Set horizontal tile bounds.
4488!
4489 tile=localpet
4490!
4491 lbi=bounds(ng)%LBi(tile) ! lower bound I-direction
4492 ubi=bounds(ng)%UBi(tile) ! upper bound I-direction
4493 lbj=bounds(ng)%LBj(tile) ! lower bound J-direction
4494 ubj=bounds(ng)%UBj(tile) ! upper bound J-direction
4495!
4496 istrr=bounds(ng)%IstrR(tile) ! Full range I-starting (RHO)
4497 iendr=bounds(ng)%IendR(tile) ! Full range I-ending (RHO)
4498 jstrr=bounds(ng)%JstrR(tile) ! Full range J-starting (RHO)
4499 jendr=bounds(ng)%JendR(tile) ! Full range J-ending (RHO)
4500!
4501 istr=bounds(ng)%Istr(tile) ! Full range I-starting (PSI, U)
4502 iend=bounds(ng)%Iend(tile) ! Full range I-ending (PSI)
4503 jstr=bounds(ng)%Jstr(tile) ! Full range J-starting (PSI, V)
4504 jend=bounds(ng)%Jend(tile) ! Full range J-ending (PSI)
4505!
4506!-----------------------------------------------------------------------
4507! Get current time.
4508!-----------------------------------------------------------------------
4509!
4510 CALL esmf_clockget (clockinfo(iroms)%Clock, &
4511 & currtime=currenttime, &
4512 & rc=rc)
4513 IF (esmf_logfounderror(rctocheck=rc, &
4514 & msg=esmf_logerr_passthru, &
4515 & line=__line__, &
4516 & file=myfile)) THEN
4517 RETURN
4518 END IF
4519!
4520 CALL esmf_timeget (currenttime, &
4521 & yy=year, &
4522 & mm=month, &
4523 & dd=day, &
4524 & h =hour, &
4525 & m =minutes, &
4526 & s =seconds, &
4527 & sn=sn, &
4528 & sd=sd, &
4529 & timestring=time_currentstring, &
4530 & rc=rc)
4531 IF (esmf_logfounderror(rctocheck=rc, &
4532 & msg=esmf_logerr_passthru, &
4533 & line=__line__, &
4534 & file=myfile)) THEN
4535 RETURN
4536 END IF
4537 is=index(time_currentstring, 'T') ! remove 'T' in
4538 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
4539!
4540!-----------------------------------------------------------------------
4541! Get list of export fields.
4542!-----------------------------------------------------------------------
4543!
4544 CALL esmf_stateget (models(iroms)%ExportState(ng), &
4545 & itemcount=exportcount, &
4546 & rc=rc)
4547 IF (esmf_logfounderror(rctocheck=rc, &
4548 & msg=esmf_logerr_passthru, &
4549 & line=__line__, &
4550 & file=myfile)) THEN
4551 RETURN
4552 END IF
4553!
4554 IF (.not. allocated(exportnamelist)) THEN
4555 allocate ( exportnamelist(exportcount) )
4556 END IF
4557!
4558 CALL esmf_stateget (models(iroms)%ExportState(ng), &
4559 & itemnamelist=exportnamelist, &
4560 & rc=rc)
4561 IF (esmf_logfounderror(rctocheck=rc, &
4562 & msg=esmf_logerr_passthru, &
4563 & line=__line__, &
4564 & file=myfile)) THEN
4565 RETURN
4566 END IF
4567!
4568!-----------------------------------------------------------------------
4569! Load export fields.
4570!-----------------------------------------------------------------------
4571!
4572 get_barotropic=.true.
4573 get_surfacecurrent=.true.
4574!
4575 fld_loop : DO ifld=1,exportcount
4576!
4577! Get field from export state.
4578!
4579 CALL esmf_stateget (models(iroms)%ExportState(ng), &
4580 & trim(exportnamelist(ifld)), &
4581 & field, &
4582 & rc=rc)
4583 IF (esmf_logfounderror(rctocheck=rc, &
4584 & msg=esmf_logerr_passthru, &
4585 & line=__line__, &
4586 & file=myfile)) THEN
4587 RETURN
4588 END IF
4589!
4590! Get field pointer. Usually, the DO-loop is executed once since
4591! localDEcount=1.
4592!
4593 de_loop : DO localde=0,localdecount-1
4594 CALL esmf_fieldget (field, &
4595 & localde=localde, &
4596 & farrayptr=ptr2d, &
4597 & rc=rc)
4598 IF (esmf_logfounderror(rctocheck=rc, &
4599 & msg=esmf_logerr_passthru, &
4600 & line=__line__, &
4601 & file=myfile)) THEN
4602 RETURN
4603 END IF
4604!
4605! Initialize pointer to missing value.
4606!
4607 ptr2d=missing_dp
4608!
4609! Load field data into export state. Notice that all export fields
4610! are kept as computed by ROMS. The imported component does the
4611! proper scaling, physical units conversion, and other manipulations.
4612! It is done to avoid applying such transformations twice.
4613!
4614 SELECT CASE (trim(adjustl(exportnamelist(ifld))))
4615!
4616! Sea surface temperature (C).
4617# if defined EXCLUDE_SPONGE && \
4618 (defined data_coupling && !defined ANA_SPONGE)
4619! If using a diffusion sponge, remove the SST points in the sponge area
4620! to supress the spurious influence of open boundary conditions in the
4621! computation of the net heat flux. The SST values in the sponge are
4622! from the large scale DATA component in the merged ocean/data field
4623! imported by the atmosphere model.
4624# endif
4625!
4626 CASE ('sst', 'SST')
4627 myfmin(1)= missing_dp
4628 myfmax(1)=-missing_dp
4629 DO j=jstrr,jendr
4630 DO i=istrr,iendr
4631# if defined EXCLUDE_SPONGE && \
4632 (defined data_coupling && !defined ANA_SPONGE)
4633 IF (ltracersponge(itemp,ng).and. &
4634 & mixing(ng)%diff_factor(i,j).gt.1.0_dp) THEN
4635 fval=missing_dp
4636 ELSE
4637 fval=ocean(ng)%t(i,j,n(ng),nstp(ng),itemp)
4638# ifdef MASKING
4639 IF (grid(ng)%rmask(i,j).gt.0.0_r8) THEN
4640 myfmin(1)=min(myfmin(1),fval)
4641 myfmax(1)=max(myfmax(1),fval)
4642 END IF
4643# else
4644 myfmin(1)=min(myfmin(1),fval)
4645 myfmax(1)=max(myfmax(1),fval)
4646# endif
4647 END IF
4648# else
4649 fval=ocean(ng)%t(i,j,n(ng),nstp(ng),itemp)
4650# ifdef MASKING
4651 IF (grid(ng)%rmask(i,j).gt.0.0_r8) THEN
4652 myfmin(1)=min(myfmin(1),fval)
4653 myfmax(1)=max(myfmax(1),fval)
4654 END IF
4655# else
4656 myfmin(1)=min(myfmin(1),fval)
4657 myfmax(1)=max(myfmax(1),fval)
4658# endif
4659# endif
4660 ptr2d(i,j)=fval
4661 END DO
4662 END DO
4663!
4664! Sea surface height (m).
4665!
4666 CASE ('ssh', 'SSH')
4667 myfmin(1)=1.0_dp
4668 myfmax(1)=0.0_dp
4669 DO j=jstrr,jendr
4670 DO i=istrr,iendr
4671 fval=ocean(ng)%zeta(i,j,knew(ng))
4672# ifdef MASKING
4673 IF (grid(ng)%rmask(i,j).gt.0.0_r8) THEN
4674 myfmin(1)=min(myfmin(1),fval)
4675 myfmax(1)=max(myfmax(1),fval)
4676 END IF
4677# else
4678 myfmin(1)=min(myfmin(1),fval)
4679 myfmax(1)=max(myfmax(1),fval)
4680# endif
4681 ptr2d(i,j)=fval
4682 END DO
4683 END DO
4684!
4685! Depth-integrated (barotropic) currents (m/s) at interior RHO-points
4686! (East/North direction).
4687!
4688 CASE ('Ubar', 'Vbar')
4689 IF (founderror(assign_string(fldname, &
4690 & exportnamelist(ifld)), &
4691 & noerror, __line__, myfile)) THEN
4692 rc=esmf_rc_not_found
4693 RETURN
4694 END IF
4695!
4696 IF (get_barotropic) THEN
4697 get_barotropic=.false.
4698 IF (.not.allocated(ubar)) THEN
4699 allocate ( ubar(lbi:ubi,lbj:ubj) )
4700 ubar=missing_dp
4701 END IF
4702 IF (.not.allocated(vbar)) THEN
4703 allocate ( vbar(lbi:ubi,lbj:ubj) )
4704 vbar=missing_dp
4705 END IF
4706 CALL roms_rotate (ng, tile, grid2geo_rho, &
4707 & lbi, ubi, lbj, ubj, &
4708 & ocean(ng)%ubar(:,:,knew(ng)), &
4709 & ocean(ng)%vbar(:,:,knew(ng)), &
4710 & ubar, vbar)
4711 END IF
4712!
4713 IF (fldname.eq.'Ubar') THEN
4714 DO j=jstr,jend
4715 DO i=istr,iend
4716 fval=ubar(i,j)
4717 myfmin(1)=min(myfmin(1),fval)
4718 myfmax(1)=max(myfmax(1),fval)
4719 ptr2d(i,j)=fval
4720 END DO
4721 END DO
4722 deallocate (ubar)
4723 ELSE
4724 DO j=jstr,jend
4725 DO i=istr,iend
4726 fval=vbar(i,j)
4727 myfmin(1)=min(myfmin(1),fval)
4728 myfmax(1)=max(myfmax(1),fval)
4729 ptr2d(i,j)=fval
4730 END DO
4731 END DO
4732 deallocate (vbar)
4733 END IF
4734!
4735! Surface currents (m/s) at interior RHO-points (East/North direction).
4736!
4737 CASE ('Usur', 'Vsur')
4738 IF (founderror(assign_string(fldname, &
4739 & exportnamelist(ifld)), &
4740 & noerror, __line__, myfile)) THEN
4741 rc=esmf_rc_not_found
4742 RETURN
4743 END IF
4744!
4745 IF (get_surfacecurrent) THEN
4746 get_surfacecurrent=.false.
4747 IF (.not.allocated(ubar)) THEN
4748 allocate ( usur(lbi:ubi,lbj:ubj) )
4749 usur=missing_dp
4750 END IF
4751 IF (.not.allocated(vbar)) THEN
4752 allocate ( vsur(lbi:ubi,lbj:ubj) )
4753 vsur=missing_dp
4754 END IF
4755 CALL roms_rotate (ng, tile, grid2geo_rho, &
4756 & lbi, ubi, lbj, ubj, &
4757 & ocean(ng)%u(:,:,n(ng),nstp(ng)), &
4758 & ocean(ng)%v(:,:,n(ng),nstp(ng)), &
4759 & usur, vsur)
4760 END IF
4761!
4762 IF (fldname.eq.'Usur') THEN
4763 DO j=jstr,jend
4764 DO i=istr,iend
4765 fval=usur(i,j)
4766 myfmin(1)=min(myfmin(1),fval)
4767 myfmax(1)=max(myfmax(1),fval)
4768 ptr2d(i,j)=fval
4769 END DO
4770 END DO
4771 deallocate (usur)
4772 ELSE
4773 DO j=jstr,jend
4774 DO i=istr,iend
4775 fval=vsur(i,j)
4776 myfmin(1)=min(myfmin(1),fval)
4777 myfmax(1)=max(myfmax(1),fval)
4778 ptr2d(i,j)=fval
4779 END DO
4780 END DO
4781 deallocate (vsur)
4782 END IF
4783!
4784! Bathymetry (m). It can be time dependent due sediment morphology.
4785!
4786 CASE ('bath')
4787 myfmin(1)=1.0_dp
4788 myfmax(1)=0.0_dp
4789 DO j=jstrr,jendr
4790 DO i=istrr,iendr
4791 fval=grid(ng)%h(i,j)
4792 myfmin(1)=min(myfmin(1),fval)
4793 myfmax(1)=max(myfmax(1),fval)
4794 ptr2d(i,j)=fval
4795 END DO
4796 END DO
4797
4798# if defined MASKING
4799!
4800! Update wet point land/sea mask, if differs from static mask.
4801!
4802 CASE ('mask_rho', 'rmask', 'msk')
4803 myfmin(1)=1.0_dp
4804 myfmax(1)=0.0_dp
4805 DO j=jstrr,jendr
4806 DO i=istrr,iendr
4807 IF (grid(ng)%rmask(i,j).gt.0.0_r8) THEN
4808# ifdef WET_DRY
4809 IF (grid(ng)%rmask(i,j).ne. &
4810 & grid(ng)%rmask_wet(i,j)) THEN
4811 ptr2d(i,j)=grid(ng)%rmask_wet(i,j)
4812 ELSE
4813 ptr2d(i,j)=grid(ng)%rmask(i,j)
4814 END IF
4815# else
4816 ptr2d(i,j)=grid(ng)%rmask(i,j)
4817# endif
4818 myfmin(1)=min(myfmin(1),ptr2d(i,j))
4819 myfmax(1)=max(myfmax(1),ptr2d(i,j))
4820 END IF
4821 END DO
4822 END DO
4823# endif
4824!
4825! Export field not found.
4826!
4827 CASE DEFAULT
4828 IF (localpet.eq.0) THEN
4829 WRITE (cplout,10) trim(adjustl(exportnamelist(ifld))), &
4830 & trim(cinpname)
4831 END IF
4832 rc=esmf_rc_not_found
4833 IF (esmf_logfounderror(rctocheck=rc, &
4834 & msg=esmf_logerr_passthru, &
4835 & line=__line__, &
4836 & file=myfile)) THEN
4837 RETURN
4838 END IF
4839 END SELECT
4840!
4841! Nullify pointer to make sure that it does not point on a random
4842! part in the memory.
4843!
4844 IF (associated(ptr2d)) nullify (ptr2d)
4845 END DO de_loop
4846!
4847! Get export field minimun and maximum values.
4848!
4849 CALL esmf_vmallreduce (vm, &
4850 & senddata=myfmin, &
4851 & recvdata=fmin, &
4852 & count=1, &
4853 & reduceflag=esmf_reduce_min, &
4854 & rc=rc)
4855 IF (esmf_logfounderror(rctocheck=rc, &
4856 & msg=esmf_logerr_passthru, &
4857 & line=__line__, &
4858 & file=myfile)) THEN
4859 RETURN
4860 END IF
4861!
4862 CALL esmf_vmallreduce (vm, &
4863 & senddata=myfmax, &
4864 & recvdata=fmax, &
4865 & count=1, &
4866 & reduceflag=esmf_reduce_max, &
4867 & rc=rc)
4868 IF (esmf_logfounderror(rctocheck=rc, &
4869 & msg=esmf_logerr_passthru, &
4870 & line=__line__, &
4871 & file=myfile)) THEN
4872 RETURN
4873 END IF
4874!
4875 IF (localpet.eq.0) THEN
4876 WRITE (cplout,20) trim(exportnamelist(ifld)), &
4877 & trim(time_currentstring), ng, &
4878 & fmin(1), fmax(1)
4879 END IF
4880!
4881! Debugging: write out field into a NetCDF file.
4882!
4883 IF ((debuglevel.ge.3).and. &
4884 & models(iroms)%ExportField(ifld)%debug_write) THEN
4885 WRITE (ofile,30) ng, trim(exportnamelist(ifld)), &
4886 year, month, day, hour, minutes, seconds
4887 CALL esmf_fieldwrite (field, &
4888 & trim(ofile), &
4889 & overwrite=.true., &
4890 & rc=rc)
4891 IF (esmf_logfounderror(rctocheck=rc, &
4892 & msg=esmf_logerr_passthru, &
4893 & line=__line__, &
4894 & file=myfile)) THEN
4895 RETURN
4896 END IF
4897 END IF
4898 END DO fld_loop
4899!
4900! Deallocate local arrays.
4901!
4902 IF (allocated(exportnamelist)) deallocate (exportnamelist)
4903!
4904! Update ROMS export calls counter.
4905!
4906 IF (exportcount.gt.0) THEN
4907 models(iroms)%ExportCalls=models(iroms)%ExportCalls+1
4908 END IF
4909!
4910 IF (esm_track) THEN
4911 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_Export', &
4912 & ', PET', petrank
4913 FLUSH (trac)
4914 END IF
4915 FLUSH (cplout)
4916!
4917 10 FORMAT (/,3x,' ROMS_Export - unable to find option to export: ', &
4918 & a,/,18x,'check ''Export(roms)'' in input script: ',a)
4919 20 FORMAT (3x,' ROMS_Export - ESMF: exporting field ''',a,'''', &
4920 & t72,a,2x,'Grid ',i2.2,/, &
4921 & 18x,'(OutMin = ', 1p,e15.8,0p,' OutMax = ',1p,e15.8,0p, &
4922 & ')')
4923 30 FORMAT ('roms_',i2.2,'_export_',a,'_',i4.4,2('-',i2.2),'_', &
4924 & i2.2,2('.',i2.2),'.nc')
4925
4926 RETURN
4927 END SUBROUTINE roms_export
4928!
4929 SUBROUTINE roms_rotate (ng, tile, Lrotate, &
4930 & LBi, UBi, LBj, UBj, &
4931 & Uinp, Vinp, &
4932 & Uout, Vout)
4933!
4934!=======================================================================
4935! !
4936! It rotates exchanged vector components from computational grid to !
4937! geographical EAST and NORTH directions or vice versa acccording to !
4938! Lrotate flag: !
4939! !
4940! Lrotate = geo2grid_rho RHO-points rotation !
4941! Lrotate = grid2geo_rho Exporting interior RHO-points !
4942! Lrotate = geo2grid U- and V-points staggered rotation !
4943! !
4944!=======================================================================
4945!
4946! Imported variable declarations.
4947!
4948 integer, intent(in) :: ng, tile, lrotate
4949 integer, intent(in) :: lbi, ubi, lbj, ubj
4950!
4951 real (dp), intent(in) :: uinp(lbi:ubi,lbj:ubj)
4952 real (dp), intent(in) :: vinp(lbi:ubi,lbj:ubj)
4953 real (r8), intent(out) :: uout(lbi:ubi,lbj:ubj)
4954 real (r8), intent(out) :: vout(lbi:ubi,lbj:ubj)
4955!
4956! Local variable declarations.
4957!
4958 integer :: i, j
4959 integer :: istrr, iendr, jstrr, jendr
4960 integer :: istr, iend, jstr, jend
4961!
4962 real :: urho, vrho
4963!
4964 real (r8) :: urot(lbi:ubi,lbj:ubj)
4965 real (r8) :: vrot(lbi:ubi,lbj:ubj)
4966!
4967!-----------------------------------------------------------------------
4968! Initialize.
4969!-----------------------------------------------------------------------
4970!
4971 IF (esm_track) THEN
4972 WRITE (trac,'(a,a,i0)') '==> Entering ROMS_Rotate', &
4973 & ', PET', petrank
4974 FLUSH (trac)
4975 END IF
4976!
4977! Set horizontal tile bounds.
4978!
4979 istrr=bounds(ng)%IstrR(tile) ! Full range I-starting (RHO)
4980 iendr=bounds(ng)%IendR(tile) ! Full range I-ending (RHO)
4981 jstrr=bounds(ng)%JstrR(tile) ! Full range J-starting (RHO)
4982 jendr=bounds(ng)%JendR(tile) ! Full range J-ending (RHO)
4983!
4984 istr=bounds(ng)%Istr(tile) ! Full range I-starting (PSI, U)
4985 iend=bounds(ng)%Iend(tile) ! Full range I-ending (PSI)
4986 jstr=bounds(ng)%Jstr(tile) ! Full range J-starting (PSI, V)
4987 jend=bounds(ng)%Jend(tile) ! Full range J-ending (PSI)
4988
4989# ifdef CURVGRID
4990!
4991!-----------------------------------------------------------------------
4992! Rotate from geographical (EAST, NORTH) to computational grid
4993! directions (ROMS import case).
4994!-----------------------------------------------------------------------
4995!
4996 IF ((lrotate.eq.geo2grid).or.(lrotate.eq.geo2grid_rho)) THEN
4997 DO j=jstrr,jendr
4998 DO i=istrr,iendr
4999 urot(i,j)=uinp(i,j)*grid(ng)%CosAngler(i,j)+ &
5000 & vinp(i,j)*grid(ng)%SinAngler(i,j)
5001 vrot(i,j)=vinp(i,j)*grid(ng)%CosAngler(i,j)- &
5002 & uinp(i,j)*grid(ng)%SinAngler(i,j)
5003 END DO
5004 END DO
5005!
5006! There is an option to import the rotated vector to staggered U- and
5007! V-locations (arithmetic avererage) or import vector at its native
5008! cell center (RHO-points).
5009!
5010 IF (lrotate.eq.geo2grid_rho) THEN ! RHO-points
5011 DO j=jstrr,jendr
5012 DO i=istrr,iendr
5013 uout(i,j)=urot(i,j)
5014 vout(i,j)=vrot(i,j)
5015 END DO
5016 END DO
5017!
5018 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5019 CALL exchange_r2d_tile (ng, tile, &
5020 & lbi, ubi, lbj, ubj, &
5021 & uout)
5022 CALL exchange_r2d_tile (ng, tile, &
5023 & lbi, ubi, lbj, ubj, &
5024 & vout)
5025 END IF
5026
5027 ELSE IF (lrotate.eq.geo2grid) THEN ! U- and V-points
5028 DO j=jstrr,jendr
5029 DO i=istr,iendr
5030 uout(i,j)=0.5_r8*(urot(i-1,j)+urot(i,j))
5031# ifdef MASKING
5032 uout(i,j)=uout(i,j)*grid(ng)%umask(i,j)
5033# endif
5034# ifdef WET_DRY
5035 uout(i,j)=uout(i,j)*grid(ng)%umask_wet(i,j)
5036# endif
5037 END DO
5038 END DO
5039 DO j=jstr,jendr
5040 DO i=istrr,iendr
5041 vout(i,j)=0.5_r8*(vrot(i,j-1)+vrot(i,j))
5042# ifdef MASKING
5043 vout(i,j)=vout(i,j)*grid(ng)%vmask(i,j)
5044# endif
5045# ifdef WET_DRY
5046 vout(i,j)=vout(i,j)*grid(ng)%vmask_wet(i,j)
5047# endif
5048 END DO
5049 END DO
5050
5051 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5052 CALL exchange_u2d_tile (ng, tile, &
5053 & lbi, ubi, lbj, ubj, &
5054 & uout)
5055 CALL exchange_v2d_tile (ng, tile, &
5056 & lbi, ubi, lbj, ubj, &
5057 & vout)
5058 END IF
5059 END IF
5060!
5061!-----------------------------------------------------------------------
5062! Rotate from computational grid to geographical (EAST, NORTH)
5063! directions (ROMS Export case: vector at RHO-points).
5064!-----------------------------------------------------------------------
5065!
5066 ELSE IF (lrotate.eq.grid2geo_rho) THEN
5067 uout=0.0_r8
5068 vout=0.0_r8
5069 DO j=jstr,jend
5070 DO i=istr,iend
5071 urho=0.5_r8*(uinp(i,j)+uinp(i+1,j))
5072 vrho=0.5_r8*(vinp(i,j)+vinp(i,j+1))
5073 uout(i,j)=urho*grid(ng)%CosAngler(i,j)- &
5074 & vrho*grid(ng)%SinAngler(i,j)
5075 vout(i,j)=vrho*grid(ng)%CosAngler(i,j)+ &
5076 & urho*grid(ng)%SinAngler(i,j)
5077# ifdef MASKING
5078 uout(i,j)=uout(i,j)*grid(ng)%rmask(i,j)
5079 vout(i,j)=vout(i,j)*grid(ng)%rmask(i,j)
5080# endif
5081# ifdef WET_DRY
5082 uout(i,j)=uout(i,j)*grid(ng)%rmask_wet(i,j)
5083 vout(i,j)=vout(i,j)*grid(ng)%rmask_wet(i,j)
5084# endif
5085 END DO
5086 END DO
5087!
5088 CALL bc_r2d_tile (ng, tile, &
5089 & lbi, ubi, lbj, ubj, &
5090 & uout)
5091 CALL bc_r2d_tile (ng, tile, &
5092 & lbi, ubi, lbj, ubj, &
5093 & vout)
5094!
5095 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5096 CALL exchange_r2d_tile (ng, tile, &
5097 & lbi, ubi, lbj, ubj, &
5098 & uout)
5099 CALL exchange_r2d_tile (ng, tile, &
5100 & lbi, ubi, lbj, ubj, &
5101 & vout)
5102 END IF
5103 END IF
5104# else
5105!
5106!-----------------------------------------------------------------------
5107! Otherwise, load unrotated components to staggered location. ROMS grid
5108! is not curvilinear (ROMS import case). It is very unlikely to have
5109! realistic applications that are not curvilinear and rotated).
5110!-----------------------------------------------------------------------
5111!
5112 IF (lrotate.eq.geo2grid_rho) THEN ! RHO-points
5113 DO j=jstrr,jendr
5114 DO i=istrr,iendr
5115 uout(i,j)=uinp(i,j)
5116 vout(i,j)=vinp(i,j)
5117 END DO
5118 END DO
5119!
5120 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5121 CALL exchange_r2d_tile (ng, tile, &
5122 & lbi, ubi, lbj, ubj, &
5123 & uout)
5124 CALL exchange_r2d_tile (ng, tile, &
5125 & lbi, ubi, lbj, ubj, &
5126 & vout)
5127 END IF
5128
5129 ELSE IF (lrotate.eq.geo2grid) THEN ! U- and V-points
5130 DO j=jstrr,jendr
5131 DO i=istr,iendr
5132 uout(i,j)=0.5_r8*(uinp(i-1,j)+uinp(i,j))
5133# ifdef MASKING
5134 uout(i,j)=uout(i,j)*grid(ng)%umask(i,j)
5135# endif
5136# ifdef WET_DRY
5137 uout(i,j)=uout(i,j)*grid(ng)%umask_wet(i,j)
5138# endif
5139 END DO
5140 END DO
5141 DO j=jstr,jendr
5142 DO i=istrr,iendr
5143 vout(i,j)=0.5_r8*(vinp(i,j-1)+vinp(i,j))
5144# ifdef MASKING
5145 vout(i,j)=vout(i,j)*grid(ng)%vmask(i,j)
5146# endif
5147# ifdef WET_DRY
5148 vout(i,j)=vout(i,j)*grid(ng)%vmask_wet(i,j)
5149# endif
5150 END DO
5151 END DO
5152!
5153 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5154 CALL exchange_u2d_tile (ng, tile, &
5155 & lbi, ubi, lbj, ubj, &
5156 & uout)
5157 CALL exchange_v2d_tile (ng, tile, &
5158 & lbi, ubi, lbj, ubj, &
5159 & vout)
5160 END IF
5161 END IF
5162# endif
5163!
5164!-----------------------------------------------------------------------
5165! Distributed-memory tile (halo) exchange.
5166!-----------------------------------------------------------------------
5167!
5168 CALL mp_exchange2d (ng, tile, inlm, 2, &
5169 & lbi, ubi, lbj, ubj, &
5170 & nghostpoints, &
5171 & ewperiodic(ng), nsperiodic(ng), &
5172 & uout, vout)
5173!
5174 IF (esm_track) THEN
5175 WRITE (trac,'(a,a,i0)') '<== Exiting ROMS_Rotate', &
5176 & ', PET', petrank
5177 FLUSH (trac)
5178 END IF
5179!
5180 END SUBROUTINE roms_rotate
5181!
5182#endif
5183 END MODULE esmf_roms_mod
mod_netcdf::netcdf_get_ivar
Definition mod_netcdf.F:59
mod_netcdf::netcdf_get_svar
Definition mod_netcdf.F:70
mod_netcdf::netcdf_get_time
Definition mod_netcdf.F:77
bc_2d_mod
Definition bc_2d.F:2
bc_2d_mod::bc_r2d_tile
subroutine bc_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition bc_2d.F:44
dateclock_mod
Definition dateclock.F:2
dateclock_mod::time_string
subroutine, public time_string(mytime, date_string)
Definition dateclock.F:1272
dateclock_mod::roms_clock
subroutine, public roms_clock(year, month, day, hour, minutes, seconds, clocktime)
Definition dateclock.F:1153
dateclock_mod::caldate
subroutine, public caldate(currenttime, yy_i, yd_i, mm_i, dd_i, h_i, m_i, s_i, yd_dp, dd_dp, h_dp, m_dp, s_dp)
Definition dateclock.F:76
esmf_roms_mod
Definition esmf_ice_cice.h:2
esmf_roms_mod::roms_setservices
subroutine, public roms_setservices(model, rc)
Definition esmf_roms.h:169
esmf_roms_mod::grid2geo_rho
integer, parameter grid2geo_rho
Definition esmf_roms.h:162
esmf_roms_mod::roms_setgridarrays
subroutine, private roms_setgridarrays(ng, tile, model, rc)
Definition esmf_roms.h:1538
esmf_roms_mod::roms_export
subroutine, private roms_export(ng, model, rc)
Definition esmf_roms.h:4398
esmf_roms_mod::roms_setfinalize
subroutine, private roms_setfinalize(model, importstate, exportstate, clock, rc)
Definition esmf_roms.h:2695
esmf_roms_mod::roms_rotate
subroutine, private roms_rotate(ng, tile, lrotate, lbi, ubi, lbj, ubj, uinp, vinp, uout, vout)
Definition esmf_roms.h:4933
esmf_roms_mod::roms_setstates
subroutine, private roms_setstates(ng, tile, model, rc)
Definition esmf_roms.h:2025
esmf_roms_mod::roms_setinitializep2
subroutine, private roms_setinitializep2(model, importstate, exportstate, clock, rc)
Definition esmf_roms.h:553
esmf_roms_mod::roms_setinitializep1
subroutine, private roms_setinitializep1(model, importstate, exportstate, clock, rc)
Definition esmf_roms.h:356
esmf_roms_mod::roms_setrunclock
subroutine, private roms_setrunclock(model, rc)
Definition esmf_roms.h:1205
esmf_roms_mod::roms_checkimport
subroutine, private roms_checkimport(model, rc)
Definition esmf_roms.h:1300
esmf_roms_mod::roms_datainit
subroutine, private roms_datainit(model, rc)
Definition esmf_roms.h:771
esmf_roms_mod::geo2grid_rho
integer, parameter geo2grid_rho
Definition esmf_roms.h:161
esmf_roms_mod::roms_import
subroutine, private roms_import(ng, model, rc)
Definition esmf_roms.h:2744
esmf_roms_mod::roms_modeladvance
subroutine, private roms_modeladvance(model, rc)
Definition esmf_roms.h:2439
esmf_roms_mod::geo2grid
integer, parameter geo2grid
Definition esmf_roms.h:160
esmf_roms_mod::roms_setclock
subroutine, private roms_setclock(model, rc)
Definition esmf_roms.h:846
exchange_2d_mod
Definition exchange_2d.F:2
exchange_2d_mod::exchange_r2d_tile
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:253
exchange_2d_mod::exchange_u2d_tile
subroutine exchange_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:440
exchange_2d_mod::exchange_v2d_tile
subroutine exchange_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:627
get_metadata_mod
Definition get_metadata.F:2
mod_esmf_esm
Definition mod_esmf_esm.F:2
mod_esmf_esm::def_fieldatt
subroutine, public def_fieldatt(vm, rc)
Definition mod_esmf_esm.F:4653
mod_esmf_esm::iroms
integer iroms
Definition mod_esmf_esm.F:433
mod_esmf_esm::cinpname
character(len=256) cinpname
Definition mod_esmf_esm.F:639
mod_esmf_esm::nexport
integer, dimension(:), allocatable nexport
Definition mod_esmf_esm.F:451
mod_esmf_esm::petlayoutoption
character(len=10) petlayoutoption
Definition mod_esmf_esm.F:475
mod_esmf_esm::icenter
integer, parameter icenter
Definition mod_esmf_esm.F:561
mod_esmf_esm::timestep
integer, dimension(6) timestep
Definition mod_esmf_esm.F:501
mod_esmf_esm::trac
integer trac
Definition mod_esmf_esm.F:543
mod_esmf_esm::inpname
character(len=256), dimension(:), allocatable inpname
Definition mod_esmf_esm.F:651
mod_esmf_esm::iupoint
integer, parameter iupoint
Definition mod_esmf_esm.F:563
mod_esmf_esm::debuglevel
integer debuglevel
Definition mod_esmf_esm.F:527
mod_esmf_esm::couplingtype
integer couplingtype
Definition mod_esmf_esm.F:467
mod_esmf_esm::missing_dp
real(dp), parameter missing_dp
Definition mod_esmf_esm.F:675
mod_esmf_esm::cplout
integer cplout
Definition mod_esmf_esm.F:656
mod_esmf_esm::gridtype
character(len=6), dimension(0:4) gridtype
Definition mod_esmf_esm.F:566
mod_esmf_esm::esmcomm
integer, dimension(:), allocatable esmcomm
Definition mod_esmf_esm.F:485
mod_esmf_esm::esm_track
logical esm_track
Definition mod_esmf_esm.F:542
mod_esmf_esm::idriver
integer idriver
Definition mod_esmf_esm.F:432
mod_esmf_esm::field_index
integer function, public field_index(fnames, fvalue)
Definition mod_esmf_esm.F:1083
mod_esmf_esm::coupled
type(esm_cplset), dimension(:), allocatable, target coupled
Definition mod_esmf_esm.F:151
mod_esmf_esm::clockinfo
type(esm_clock), dimension(:), allocatable, target clockinfo
Definition mod_esmf_esm.F:396
mod_esmf_esm::nimport
integer, dimension(:), allocatable nimport
Definition mod_esmf_esm.F:450
mod_esmf_esm::ivpoint
integer, parameter ivpoint
Definition mod_esmf_esm.F:564
mod_esmf_esm::tol_dp
real(dp), parameter tol_dp
Definition mod_esmf_esm.F:679
mod_esmf_esm::attfilename
character(len=17), parameter attfilename
Definition mod_esmf_esm.F:666
mod_esmf_esm::petrank
integer petrank
Definition mod_esmf_esm.F:481
mod_esmf_esm::icorner
integer, parameter icorner
Definition mod_esmf_esm.F:562
mod_esmf_esm::models
type(esm_model), dimension(:), allocatable, target models
Definition mod_esmf_esm.F:360
mod_esmf_esm::report_timestamp
subroutine, public report_timestamp(field, currtime, localpet, string, rc)
Definition mod_esmf_esm.F:3869
mod_forces
Definition mod_forces.F:2
mod_forces::forces
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_iounits
Definition mod_iounits.F:2
mod_iounits::iname
character(len=256) iname
Definition mod_iounits.F:298
mod_iounits::stdout
integer stdout
Definition mod_iounits.F:195
mod_iounits::sourcefile
character(len=256) sourcefile
Definition mod_iounits.F:317
mod_kinds
Definition mod_kinds.F:2
mod_kinds::r4
integer, parameter r4
Definition mod_kinds.F:26
mod_kinds::r8
integer, parameter r8
Definition mod_kinds.F:28
mod_kinds::i8b
integer, parameter i8b
Definition mod_kinds.F:23
mod_kinds::dp
integer, parameter dp
Definition mod_kinds.F:25
mod_kinds::i4b
integer, parameter i4b
Definition mod_kinds.F:22
mod_mixing
Definition mod_mixing.F:2
mod_mixing::mixing
type(t_mixing), dimension(:), allocatable mixing
Definition mod_mixing.F:399
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::idvair
integer idvair
Definition mod_ncparam.F:358
mod_ncparam::idvsms
integer idvsms
Definition mod_ncparam.F:377
mod_ncparam::linfo
logical, dimension(:,:,:), allocatable linfo
Definition mod_ncparam.F:574
mod_ncparam::idpair
integer idpair
Definition mod_ncparam.F:263
mod_ncparam::vtime
real(dp), dimension(:,:,:), allocatable vtime
Definition mod_ncparam.F:584
mod_ncparam::idtsur
integer, dimension(:), allocatable idtsur
Definition mod_ncparam.F:453
mod_ncparam::tintrp
real(dp), dimension(:,:,:), allocatable tintrp
Definition mod_ncparam.F:583
mod_ncparam::idldwn
integer idldwn
Definition mod_ncparam.F:223
mod_ncparam::iduair
integer iduair
Definition mod_ncparam.F:323
mod_ncparam::finfo
real(dp), dimension(:,:,:), allocatable finfo
Definition mod_ncparam.F:580
mod_ncparam::idqair
integer idqair
Definition mod_ncparam.F:272
mod_ncparam::iinfo
integer, dimension(:,:,:), allocatable iinfo
Definition mod_ncparam.F:578
mod_ncparam::idlrad
integer idlrad
Definition mod_ncparam.F:229
mod_ncparam::idusms
integer idusms
Definition mod_ncparam.F:339
mod_ncparam::idrain
integer idrain
Definition mod_ncparam.F:287
mod_ncparam::idsrad
integer idsrad
Definition mod_ncparam.F:293
mod_ncparam::idtair
integer idtair
Definition mod_ncparam.F:305
mod_netcdf
Definition mod_netcdf.F:2
mod_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
mod_param
Definition mod_param.F:2
mod_param::inlm
integer, parameter inlm
Definition mod_param.F:662
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::bounds
type(t_bounds), dimension(:), allocatable bounds
Definition mod_param.F:232
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_param::lm
integer, dimension(:), allocatable lm
Definition mod_param.F:455
mod_param::u2dvar
integer, parameter u2dvar
Definition mod_param.F:718
mod_param::ngrids
integer ngrids
Definition mod_param.F:113
mod_param::ntilei
integer, dimension(:), allocatable ntilei
Definition mod_param.F:677
mod_param::mm
integer, dimension(:), allocatable mm
Definition mod_param.F:456
mod_param::r2dvar
integer, parameter r2dvar
Definition mod_param.F:717
mod_param::v2dvar
integer, parameter v2dvar
Definition mod_param.F:719
mod_param::ntilej
integer, dimension(:), allocatable ntilej
Definition mod_param.F:678
mod_scalars
Definition mod_scalars.F:2
mod_scalars::ntimes
integer, dimension(:), allocatable ntimes
Definition mod_scalars.F:336
mod_scalars::dt
real(dp), dimension(:), allocatable dt
Definition mod_scalars.F:269
mod_scalars::ewperiodic
logical, dimension(:), allocatable ewperiodic
Definition mod_scalars.F:510
mod_scalars::nsperiodic
logical, dimension(:), allocatable nsperiodic
Definition mod_scalars.F:511
mod_scalars::cp
real(dp) cp
Definition mod_scalars.F:456
mod_scalars::ltracersponge
logical, dimension(:,:), allocatable ltracersponge
Definition mod_scalars.F:946
mod_scalars::time_ref
real(dp) time_ref
Definition mod_scalars.F:100
mod_scalars::tdays
real(dp), dimension(:), allocatable tdays
Definition mod_scalars.F:261
mod_scalars::rclock
type(t_clock) rclock
Definition mod_scalars.F:120
mod_scalars::sec2day
real(dp), parameter sec2day
Definition mod_scalars.F:817
mod_scalars::ntend
integer, dimension(:), allocatable ntend
Definition mod_scalars.F:379
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::isalt
integer isalt
Definition mod_scalars.F:127
mod_scalars::itemp
integer itemp
Definition mod_scalars.F:126
mod_scalars::ntfirst
integer, dimension(:), allocatable ntfirst
Definition mod_scalars.F:377
mod_scalars::time
real(dp), dimension(:), allocatable time
Definition mod_scalars.F:262
mod_scalars::rho0
real(dp) rho0
Definition mod_scalars.F:787
mod_scalars::noerror
integer noerror
Definition mod_scalars.F:561
mod_stepping
Definition mod_stepping.F:2
mod_stepping::knew
integer, dimension(:), allocatable knew
Definition mod_stepping.F:64
mod_stepping::nstp
integer, dimension(:), allocatable nstp
Definition mod_stepping.F:71
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::mp_exchange2d
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:294
roms_kernel_mod
Definition ad_roms.h:1
roms_kernel_mod::roms_finalize
subroutine, public roms_finalize
Definition ad_roms.h:283
roms_kernel_mod::roms_run
subroutine, public roms_run(runinterval)
Definition ad_roms.h:239
roms_kernel_mod::roms_initialize
subroutine, public roms_initialize(first, mpicomm)
Definition ad_roms.h:52
strings_mod
Definition strings.F:2
strings_mod::assign_string
integer function, public assign_string(a, string)
Definition strings.F:368
strings_mod::standardname
subroutine, public standardname(sname, variable, prefix, suffix)
Definition strings.F:299
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52
get_metadata_mod::couplingfield
Definition get_metadata.F:44