ROMS
Loading...
Searching...
No Matches
esmf_atm_coamps.h
Go to the documentation of this file.
1 MODULE esmf_coamps_mod
2
3#if defined COAMPS_COUPLING && defined ESMF_LIB
4!
5!git $Id$
6!=======================================================================
7! Copyright (c) 2002-2025 The ROMS Group !
8! Licensed under a MIT/X style license Hernan G. Arango !
9! See License_ROMS.md !
10!=======================================================================
11! !
12! This module sets COAMPS as the atmospheric model gridded component !
13! using the generic ESMF/NUOPC layer: !
14! !
15! ATM_SetServices Sets ATM component shared-object entry !
16! points using NUPOC generic methods for !
17! "initialize", "run", and "finalize". !
18! !
19! COAMPS_SetInitializeP1 COAMPS component phase 1 initialization: !
20! sets import and export fields long and !
21! short names into its respective state. !
22! !
23! COAMPS_SetInitializeP2 COAMPS component phase 2 initialization: !
24! Initializes component (COAMPS_Initialize),!
25! sets component grid (COAMPS_SetGridArrays)!
26! and adds fields into import and export !
27! into respective states (COAMPS_SetStates).!
28! !
29! COAMPS_DataInit Exports COAMPS component fields during !
30! initialization or restart. !
31! !
32! COAMPS_SetClock Sets COAMPS component date calendar, !
33! start and stop times, and coupling !
34! interval. !
35# ifdef ESM_SETRUNCLOCK
36! !
37! COAMPS_SetRunClock Sets COAMPS run clock manually. !
38# endif
39! !
40! COAMPS_CheckImport Checks if ROMS component import field is !
41! at the correct time. !
42! !
43! COAMPS_SetGridArrays Sets COAMPS component horizontal grid !
44! arrays, grid area, and land/sea mask. !
45! !
46! COAMPS_SetStates Adds COAMPS component export and import !
47! fields into its respective state. !
48! !
49! COAMPS_ModelAdvance Advances COAMPS component for a coupling !
50! interval. It calls import and export !
51! routines. !
52! !
53! COAMPS_SetFinalize Finalizes COAMPS component execution. !
54! !
55! COAMPS_Import Imports fields into COAMPS from other !
56! gridded components. !
57! !
58! COAMPS_ProcessImport Loads or merges import COAMPS fields. !
59! !
60! COAMPS_Export Exports COAMPS fields to other gridded !
61! components. !
62! !
63! ESMF: Earth System Modeling Framework (Version 7 or higher) !
64! https://www.earthsystemcog.org/projects/esmf !
65! !
66! NUOPC: National Unified Operational Prediction Capability !
67! https://www.earthsystemcog.org/projects/nuopc !
68! !
69! COAMPS: Coupled Ocean-Atmosphere Mesoscale Prediction System !
70! https://www.nrlmry.navy.mil/coamps-web/web/home !
71! !
72! !
73!=======================================================================
74!
75 USE esmf
76 USE nuopc
77 USE nuopc_model, &
78 & nuopc_setservices => setservices, &
79 & nuopc_label_advance => label_advance, &
80 & nuopc_label_datainitialize => label_datainitialize, &
81# ifdef ESM_SETRUNCLOCK
82 & nuopc_label_setrunclock => label_setrunclock, &
83# endif
84 & nuopc_label_setclock => label_setclock, &
85 & nuopc_label_checkimport => label_checkimport
86!
87 USE mod_esmf_esm ! ESM coupling structures and variables
88!
89 USE atmos_forecast, ONLY : coamps_initialize => atmos_init, &
90 & coamps_run => atmos_run, &
91 & coamps_finalize => atmos_finalize
92!
93 implicit none
94!
95 PUBLIC :: atm_setservices
96
97 PRIVATE :: coamps_setinitializep1
98 PRIVATE :: coamps_setinitializep2
99 PRIVATE :: coamps_datainit
100 PRIVATE :: coamps_setclock
101# ifdef ESM_SETRUNCLOCK
102 PRIVATE :: coamps_setrunclock
103# endif
104 PRIVATE :: coamps_checkimport
105 PRIVATE :: coamps_setgridarrays
106 PRIVATE :: coamps_setstates
107 PRIVATE :: coamps_modeladvance
108 PRIVATE :: coamps_setfinalize
109 PRIVATE :: coamps_import
110 PRIVATE :: coamps_processimport
111 PRIVATE :: coamps_export
112!
113 CONTAINS
114!
115 SUBROUTINE atm_setservices (model, rc)
116!
117!=======================================================================
118! !
119! Sets COAMPS component shared-object entry points for "initialize", !
120! "run", and "finalize" by using NUOPC generic methods. !
121! !
122!=======================================================================
123!
124! Imported variable declarations.
125!
126 integer, intent(out) :: rc
127!
128 TYPE (esmf_gridcomp) :: model
129!
130! Local variable declarations.
131!
132 character (len=*), parameter :: myfile = &
133 & __FILE__//", ATM_SetServices"
134!
135!-----------------------------------------------------------------------
136! Initialize return code flag to success state (no error).
137!-----------------------------------------------------------------------
138!
139 IF (esm_track) THEN
140 WRITE (trac,'(a,a,i0)') '==> Entering ATM_SetServices', &
141 & ', PET', petrank
142 FLUSH (trac)
143 END IF
144 rc=esmf_success
145!
146!-----------------------------------------------------------------------
147! Register NUOPC generic routines.
148!-----------------------------------------------------------------------
149!
150 CALL nuopc_compderive (model, &
151 & nuopc_setservices, &
152 & rc=rc)
153 IF (esmf_logfounderror(rctocheck=rc, &
154 & msg=esmf_logerr_passthru, &
155 & line=__line__, &
156 & file=myfile)) THEN
157 RETURN
158 END IF
159!
160!-----------------------------------------------------------------------
161! Register initialize routines.
162!-----------------------------------------------------------------------
163!
164! Set routine for Phase 1 initialization (import and export fields).
165!
166 CALL nuopc_compsetentrypoint (model, &
167 & methodflag=esmf_method_initialize, &
168 & phaselabellist=(/"IPDv00p1"/), &
169 & userroutine=coamps_setinitializep1, &
170 & rc=rc)
171 IF (esmf_logfounderror(rctocheck=rc, &
172 & msg=esmf_logerr_passthru, &
173 & line=__line__, &
174 & file=myfile)) THEN
175 RETURN
176 END IF
177!
178! Set routine for Phase 2 initialization.
179!
180 CALL nuopc_compsetentrypoint (model, &
181 & methodflag=esmf_method_initialize, &
182 & phaselabellist=(/"IPDv00p2"/), &
183 & userroutine=coamps_setinitializep2, &
184 & rc=rc)
185 IF (esmf_logfounderror(rctocheck=rc, &
186 & msg=esmf_logerr_passthru, &
187 & line=__line__, &
188 & file=myfile)) THEN
189 RETURN
190 END IF
191!
192!-----------------------------------------------------------------------
193! Attach COAMPS component phase independent specializing methods.
194!-----------------------------------------------------------------------
195!
196! Set routine for export initial/restart fields.
197!
198 CALL nuopc_compspecialize (model, &
199 & speclabel=nuopc_label_datainitialize, &
200 & specroutine=coamps_datainit, &
201 & rc=rc)
202 IF (esmf_logfounderror(rctocheck=rc, &
203 & msg=esmf_logerr_passthru, &
204 & line=__line__, &
205 & file=myfile)) THEN
206 RETURN
207 END IF
208!
209! Set routine for setting COAMPS clock.
210!
211 CALL nuopc_compspecialize (model, &
212 & speclabel=nuopc_label_setclock, &
213 & specroutine=coamps_setclock, &
214 & rc=rc)
215 IF (esmf_logfounderror(rctocheck=rc, &
216 & msg=esmf_logerr_passthru, &
217 & line=__line__, &
218 & file=myfile)) THEN
219 RETURN
220 END IF
221
222# ifdef ESM_SETRUNCLOCK
223!
224! Set routine for setting COAMPS run clock manually. First, remove the
225! default.
226!
227 CALL esmf_methodremove (model, &
228 & nuopc_label_setrunclock, &
229 & rc=rc)
230 IF (esmf_logfounderror(rctocheck=rc, &
231 & msg=esmf_logerr_passthru, &
232 & line=__line__, &
233 & file=myfile)) THEN
234 RETURN
235 END IF
236!
237 CALL nuopc_compspecialize (model, &
238 & speclabel=nuopc_label_setrunclock, &
239 & specroutine=coamps_setrunclock, &
240 & rc=rc)
241 IF (esmf_logfounderror(rctocheck=rc, &
242 & msg=esmf_logerr_passthru, &
243 & line=__line__, &
244 & file=myfile)) THEN
245 RETURN
246 END IF
247# endif
248!
249! Set routine for checking import state.
250!
251 CALL nuopc_compspecialize (model, &
252 & speclabel=nuopc_label_checkimport, &
253 & specphaselabel="RunPhase1", &
254 & specroutine=coamps_checkimport, &
255 & rc=rc)
256 IF (esmf_logfounderror(rctocheck=rc, &
257 & msg=esmf_logerr_passthru, &
258 & line=__line__, &
259 & file=myfile)) THEN
260 RETURN
261 END IF
262!
263! Set routine for time-stepping COAMPS component.
264!
265 CALL nuopc_compspecialize (model, &
266 & speclabel=nuopc_label_advance, &
267 & specroutine=coamps_modeladvance, &
268 & rc=rc)
269 IF (esmf_logfounderror(rctocheck=rc, &
270 & msg=esmf_logerr_passthru, &
271 & line=__line__, &
272 & file=myfile)) THEN
273 RETURN
274 END IF
275!
276!-----------------------------------------------------------------------
277! Register COAMPS finalize routine.
278!-----------------------------------------------------------------------
279!
280 CALL esmf_gridcompsetentrypoint (model, &
281 & methodflag=esmf_method_finalize, &
282 & userroutine=coamps_setfinalize, &
283 & rc=rc)
284 IF (esmf_logfounderror(rctocheck=rc, &
285 & msg=esmf_logerr_passthru, &
286 & line=__line__, &
287 & file=myfile)) THEN
288 RETURN
289 END IF
290!
291 IF (esm_track) THEN
292 WRITE (trac,'(a,a,i0)') '<== Exiting ATM_SetServices', &
293 & ', PET', petrank
294 FLUSH (trac)
295 END IF
296!
297 RETURN
298 END SUBROUTINE atm_setservices
299!
300 SUBROUTINE coamps_setinitializep1 (model, &
301 & ImportState, ExportState, &
302 & clock, rc)
303!
304!=======================================================================
305! !
306! COAMPS component Phase 1 initialization: sets import and export !
307! fields long and short names into its respective state. !
308! !
309!=======================================================================
310!
311! Imported variable declarations.
312!
313 integer, intent(out) :: rc
314!
315 TYPE (esmf_gridcomp) :: model
316 TYPE (esmf_state) :: importstate
317 TYPE (esmf_state) :: exportstate
318 TYPE (esmf_clock) :: clock
319!
320! Local variable declarations.
321!
322 integer :: i, ng
323!
324 character (len=100) :: coupledset, statelabel
325 character (len=240) :: standardname, shortname
326
327 character (len=*), parameter :: myfile = &
328 & __FILE__//", COAMPS_SetInitializeP1"
329!
330!-----------------------------------------------------------------------
331! Initialize return code flag to success state (no error).
332!-----------------------------------------------------------------------
333!
334 IF (esm_track) THEN
335 WRITE (trac,'(a,a,i0)') '==> Entering COAMPS_SetInitializeP1', &
336 & ', PET', petrank
337 FLUSH (trac)
338 END IF
339 rc=esmf_success
340!
341!-----------------------------------------------------------------------
342! Set COAMPS import state and fields.
343!-----------------------------------------------------------------------
344!
345 importing : IF (nimport(iatmos).gt.0) THEN
346 DO ng=1,models(iatmos)%Ngrids
347 IF (any(coupled(iatmos)%LinkedGrid(ng,:))) THEN
348 coupledset=trim(coupled(iatmos)%SetLabel(ng))
349 statelabel=trim(coupled(iatmos)%ImpLabel(ng))
350 CALL nuopc_addnestedstate (importstate, &
351 & cplset=trim(coupledset), &
352 & nestedstatename=trim(statelabel),&
353 & nestedstate=models(iatmos)% &
354 & importstate(ng), &
355 rc=rc)
356 IF (esmf_logfounderror(rctocheck=rc, &
357 & msg=esmf_logerr_passthru, &
358 & line=__line__, &
359 & file=myfile)) THEN
360 RETURN
361 END IF
362!
363! Add fields import state.
364!
365 DO i=1,nimport(iatmos)
366 standardname=models(iatmos)%ImportField(i)%standard_name
367 shortname =models(iatmos)%ImportField(i)%short_name
368 CALL nuopc_advertise (models(iatmos)%ImportState(ng), &
369 & standardname=trim(standardname), &
370 & name=trim(shortname), &
371 & rc=rc)
372 IF (esmf_logfounderror(rctocheck=rc, &
373 & msg=esmf_logerr_passthru, &
374 & line=__line__, &
375 & file=myfile)) THEN
376 RETURN
377 END IF
378 END DO
379 END IF
380 END DO
381 END IF importing
382!
383!-----------------------------------------------------------------------
384! Set COAMPS export state and fields.
385!-----------------------------------------------------------------------
386!
387 exporting : IF (nexport(iatmos).gt.0) THEN
388 DO ng=1,models(iatmos)%Ngrids
389 IF (any(coupled(iatmos)%LinkedGrid(ng,:))) THEN
390 coupledset=trim(coupled(iatmos)%SetLabel(ng))
391 statelabel=trim(coupled(iatmos)%ExpLabel(ng))
392 CALL nuopc_addnestedstate (exportstate, &
393 & cplset=trim(coupledset), &
394 & nestedstatename=trim(statelabel),&
395 & nestedstate=models(iatmos)% &
396 & exportstate(ng), &
397 rc=rc)
398 IF (esmf_logfounderror(rctocheck=rc, &
399 & msg=esmf_logerr_passthru, &
400 & line=__line__, &
401 & file=myfile)) THEN
402 RETURN
403 END IF
404!
405! Add fields to export state.
406!
407 DO i=1,nexport(iatmos)
408 standardname=models(iatmos)%ExportField(i)%standard_name
409 shortname =models(iatmos)%ExportField(i)%short_name
410 CALL nuopc_advertise (models(iatmos)%ExportState(ng), &
411 & standardname=trim(standardname), &
412 & name=trim(shortname), &
413 & rc=rc)
414 IF (esmf_logfounderror(rctocheck=rc, &
415 & msg=esmf_logerr_passthru, &
416 & line=__line__, &
417 & file=myfile)) THEN
418 RETURN
419 END IF
420 END DO
421 END IF
422 END DO
423 END IF exporting
424!
425 IF (esm_track) THEN
426 WRITE (trac,'(a,a,i0)') '<== Exiting COAMPS_SetInitializeP1', &
427 & ', PET', petrank
428 FLUSH (trac)
429 END IF
430!
431 RETURN
432 END SUBROUTINE coamps_setinitializep1
433!
434 SUBROUTINE coamps_setinitializep2 (model, &
435 & ImportState, ExportState, &
436 & clock, rc)
437!
438!=======================================================================
439! !
440! COAMPS component Phase 2 initialization: Initializes COAMPS, sets !
441! component grid, and adds import and export fields to respective !
442! states. !
443! !
444!=======================================================================
445!
446 USE avg_mod, ONLY : avg_init, avg_init_fld, avg_set_ptr
447 USE avg_mod, ONLY : fld_name, navg_fields
448 USE avg_mod, ONLY : ifld_airrhm, &
449 & ifld_airshm, &
450 & ifld_airtmp, &
451 & ifld_heaflx, &
452 & ifld_lahflx, &
453 & ifld_lonflx, &
454 & ifld_lwdown, &
455 & ifld_mstflx, &
456 & ifld_sehflx, &
457 & ifld_slpres, &
458 & ifld_solflx, &
459 & ifld_stress_u_true, &
460 & ifld_stress_v_true, &
461 & ifld_swdown, &
462 & ifld_ttlprr, &
463 & ifld_u10_true, &
464 & ifld_v10_true
465 USE coamm_memm, ONLY : t_nest2d_ptr
466 USE coamnl_mod, ONLY : locean
467 USE coamps_parms, ONLY : max_grids
468!
469! Imported variable declarations.
470!
471 integer, intent(out) :: rc
472!
473 TYPE (esmf_gridcomp) :: model
474 TYPE (esmf_state) :: importstate
475 TYPE (esmf_state) :: exportstate
476 TYPE (esmf_clock) :: clock
477!
478! Local variable declarations.
479!
480 logical :: got_heaflx, got_lwdown
481 logical :: ltau_0
482!
483 integer :: stepcount, ng
484 integer :: mycomm, localpet, petcount
485 integer :: exportcount, findex, ifld
486!
487 character (len=*), parameter :: myfile = &
488 & __FILE__//", COAMPS_SetInitializeP@"
489!
490 character (ESMF_MAXSTR), allocatable :: exportnamelist(:)
491!
492 TYPE (esmf_time) :: currenttime, starttime
493 TYPE (esmf_vm) :: vm
494!
495 TYPE (t_nest2d_ptr) :: exportpointer(ngridsa,navg_fields)
496!
497!-----------------------------------------------------------------------
498! Initialize return code flag to success state (no error).
499!-----------------------------------------------------------------------
500!
501 IF (esm_track) THEN
502 WRITE (trac,'(a,a,i0)') '==> Entering COAMPS_SetInitializeP2', &
503 & ', PET', petrank
504 FLUSH (trac)
505 END IF
506 rc=esmf_success
507!
508!-----------------------------------------------------------------------
509! Querry the Virtual Machine (VM) parallel environmemt for the MPI
510! communicator handle and current node rank.
511!-----------------------------------------------------------------------
512!
513 CALL esmf_gridcompget (model, &
514 & vm=vm, &
515 & rc=rc)
516 IF (esmf_logfounderror(rctocheck=rc, &
517 & msg=esmf_logerr_passthru, &
518 & line=__line__, &
519 & file=myfile)) THEN
520 RETURN
521 END IF
522!
523 CALL esmf_vmget (vm, &
524 & localpet=localpet, &
525 & petcount=petcount, &
526 & mpicommunicator=mycomm, &
527 & rc=rc)
528 IF (esmf_logfounderror(rctocheck=rc, &
529 & msg=esmf_logerr_passthru, &
530 & line=__line__, &
531 & file=myfile)) THEN
532 RETURN
533 END IF
534!
535!-----------------------------------------------------------------------
536! Initialize COAMPS component. In nested applications, COAMPS kernel
537! will allocate and initialize all grids with a single call to
538! "COAMPS_Initialize".
539!-----------------------------------------------------------------------
540!
541 CALL coamps_initialize (mycomm, .false., rc)
542 IF (esmf_logfounderror(rctocheck=rc, &
543 & msg=esmf_logerr_passthru, &
544 & line=__line__, &
545 & file=myfile)) THEN
546 RETURN
547 END IF
548!
549!-----------------------------------------------------------------------
550! Allocate COAMPS time-averaged export fields "avg" structure in terms
551! of the number of nested grids.
552!-----------------------------------------------------------------------
553!
554 CALL avg_init (models(iatmos)%Ngrids, .true.)
555!
556! Get list of export fields.
557!
558 nested_loop : DO ng=1,models(iatmos)%Ngrids
559 IF (any(coupled(iatmos)%LinkedGrid(ng,:))) THEN
560 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
561 & itemcount=exportcount, &
562 & rc=rc)
563 IF (esmf_logfounderror(rctocheck=rc, &
564 & msg=esmf_logerr_passthru, &
565 & line=__line__, &
566 & file=myfile)) THEN
567 RETURN
568 END IF
569!
570 IF (.not. allocated(exportnamelist)) THEN
571 allocate ( exportnamelist(exportcount) )
572 END IF
573 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
574 & itemnamelist=exportnamelist, &
575 & rc=rc)
576 IF (esmf_logfounderror(rctocheck=rc, &
577 & msg=esmf_logerr_passthru, &
578 & line=__line__, &
579 & file=myfile)) THEN
580 RETURN
581 END IF
582!
583! Allocate time-averaged export fields pointers in "avg" structure.
584! (See coamps/src/atmos/libsrc/amlib/avg_mod.F)
585!
586 got_heaflx=.false.
587 got_lwdown=.false.
588 DO ifld=1,exportcount
589 SELECT CASE (trim(adjustl(exportnamelist(ifld))))
590 CASE ('psfc', 'Pair')
591 findex=ifld_slpres ! sea level pressure
592 CASE ('tsfc', 'Tair')
593 findex=ifld_airtmp ! air temperature
594 CASE ('Hair')
595 findex=ifld_airshm ! specific humidity
596 CASE ('qsfc', 'Qair')
597 findex=ifld_airrhm ! relative humidity
598 CASE ('nflx', 'shflux')
599 findex=ifld_heaflx ! net heat flux
600 got_heaflx=.true.
601 CASE ('lwrd', 'LWrad')
602 findex=ifld_lonflx ! longwave flux
603 CASE ('dlwrd', 'dLWrad', 'lwrad_down')
604 findex=ifld_lwdown ! downward longwave flux
605 got_lwdown=.true.
606 CASE ('swrd', 'SWrad')
607 findex=ifld_solflx ! shortwave flux
608 CASE ('dswrd', 'dSWrad')
609 findex=ifld_swdown ! downward shortwave flux
610 CASE ('lhfx', 'LHfx')
611 findex=ifld_lahflx ! latent heat flux
612 CASE ('shfx', 'SHfx')
613 findex=ifld_sehflx ! sensible heat flux
614 CASE ('swflx', 'swflux')
615 findex=ifld_mstflx ! moisture (E-P) flux
616 CASE ('rain')
617 findex=ifld_ttlprr ! total precipitation rate
618 CASE ('taux', 'taux10', 'sustr')
619 findex=ifld_stress_u_true ! eastward wind stress
620 CASE ('tauy', 'tauy10', 'svstr')
621 findex=ifld_stress_v_true ! northward wind stress
622 CASE ('Uwind', 'u10', 'wndu')
623 findex=ifld_u10_true ! eastward wind
624 CASE ('Vwind', 'v10', 'wndv')
625 findex=ifld_v10_true ! northward wind
626 CASE DEFAULT
627 IF (localpet.eq.0) THEN
628 WRITE (cplout,10) trim(exportnamelist(ifld))
629 END IF
630 rc=esmf_rc_not_found
631 IF (esmf_logfounderror(rctocheck=rc, &
632 & msg=esmf_logerr_passthru, &
633 & line=__line__, &
634 & file=myfile)) THEN
635 RETURN
636 END IF
637 END SELECT
638 CALL avg_init_fld (ng, findex)
639 CALL avg_set_ptr (ng, findex, exportpointer(ng,findex)%p)
640 END DO
641 END IF
642 IF (allocated(exportnamelist)) deallocate (exportnamelist)
643!
644! If computing net heat flux, allocate time-averaged downward longwave
645! radiation for export.
646!
647 IF (.not.got_lwdown.and.got_heaflx) THEN
648 CALL avg_init_fld (ng, ifld_lwdown)
649 CALL avg_set_ptr (ng, ifld_lwdown, exportpointer(ng,findex)%p)
650 END IF
651 END DO nested_loop
652!
653!-----------------------------------------------------------------------
654! Run COAMPS with no time-stepping to finalize the initialization.
655!-----------------------------------------------------------------------
656!
657 ltau_0=.true.
658 stepcount=0
659 CALL coamps_run (ltau_0, stepcount)
660!
661! Activate "locean" to indicate that COAMPS is part of a coupled
662! system. It implies that COAMPS is invoked from the ESMF/NUOPC
663! driver as a coupled component. It is used to compute time-averaged
664! export fields in subroutine "coamm".
665!
666 locean=.true.
667!
668!-----------------------------------------------------------------------
669! Set-up grid and load coordinate data.
670!-----------------------------------------------------------------------
671!
672 DO ng=1,models(iatmos)%Ngrids
673 IF (any(coupled(iatmos)%LinkedGrid(ng,:))) THEN
674 CALL coamps_setgridarrays (ng, model, localpet, rc)
675 IF (esmf_logfounderror(rctocheck=rc, &
676 & msg=esmf_logerr_passthru, &
677 & line=__line__, &
678 & file=myfile)) THEN
679 RETURN
680 END IF
681 END IF
682 END DO
683!
684!-----------------------------------------------------------------------
685! Set-up fields and register to import/export states.
686!-----------------------------------------------------------------------
687!
688 DO ng=1,models(iatmos)%Ngrids
689 IF (any(coupled(iatmos)%LinkedGrid(ng,:))) THEN
690 CALL coamps_setstates (ng, model, rc)
691 IF (esmf_logfounderror(rctocheck=rc, &
692 & msg=esmf_logerr_passthru, &
693 & line=__line__, &
694 & file=myfile)) THEN
695 RETURN
696 END IF
697 END IF
698 END DO
699!
700 IF (esm_track) THEN
701 WRITE (trac,'(a,a,i0)') '<== Exiting COAMPS_SetInitializeP2', &
702 & ', PET', petrank
703 FLUSH (trac)
704 END IF
705!
706 10 FORMAT (/,' COAMPS_SetInitializeP2 - unable to find time-', &
707 & 'averaged index for Export Field: ',a)
708!
709 RETURN
710 END SUBROUTINE coamps_setinitializep2
711!
712 SUBROUTINE coamps_datainit (model, rc)
713!
714!=======================================================================
715! !
716! Exports COAMPS component fields during initialization or restart. !
717! !
718!=======================================================================
719!
720! Imported variable declarations.
721!
722 integer, intent(out) :: rc
723!
724 TYPE (esmf_gridcomp) :: model
725!
726! Local variable declarations.
727!
728 integer :: is, ng
729 integer :: localpet, petcount, phase
730!
731 character (len=*), parameter :: myfile = &
732 & __FILE__//", COAMPS_DataInit"
733!
734 TYPE (esmf_clock) :: clock
735 TYPE (esmf_time) :: currenttime
736 TYPE (esmf_timeinterval) :: timestep
737!
738!-----------------------------------------------------------------------
739! Initialize return code flag to success state (no error).
740!-----------------------------------------------------------------------
741!
742 IF (esm_track) THEN
743 WRITE (trac,'(a,a,i0)') '==> Entering COAMPS_DataInit', &
744 & ', PET', petrank
745 FLUSH (trac)
746 END IF
747 rc=esmf_success
748!
749!-----------------------------------------------------------------------
750! Get gridded component clock.
751!-----------------------------------------------------------------------
752!
753 CALL esmf_gridcompget (model, &
754 & clock=clock, &
755 & localpet=localpet, &
756 & petcount=petcount, &
757 & currentphase=phase, &
758 & rc=rc)
759 IF (esmf_logfounderror(rctocheck=rc, &
760 & msg=esmf_logerr_passthru, &
761 & line=__line__, &
762 & file=myfile)) THEN
763 RETURN
764 END IF
765!
766 CALL esmf_clockget (clock, &
767 & currtime=currenttime, &
768 & timestep=timestep, &
769 & rc=rc)
770 IF (esmf_logfounderror(rctocheck=rc, &
771 & msg=esmf_logerr_passthru, &
772 & line=__line__, &
773 & file=myfile)) THEN
774 RETURN
775 END IF
776!
777!-----------------------------------------------------------------------
778! If explicit coupling from atmosphere to ocean, export initialization
779! or restart fields.
780!-----------------------------------------------------------------------
781!
782 IF ((couplingtype.eq.0).and.(nexport(iatmos).gt.0)) THEN
783 DO ng=1,models(iatmos)%Ngrids
784 CALL coamps_export (ng, model, rc)
785 IF (esmf_logfounderror(rctocheck=rc, &
786 & msg=esmf_logerr_passthru, &
787 & line=__line__, &
788 & file=myfile)) THEN
789 RETURN
790 END IF
791 END DO
792 END IF
793!
794 IF (esm_track) THEN
795 WRITE (trac,'(a,a,i0)') '<== Exiting COAMPS_DataInit', &
796 & ', PET', petrank
797 FLUSH (trac)
798 END IF
799!
800 RETURN
801 END SUBROUTINE coamps_datainit
802!
803 SUBROUTINE coamps_setclock (model, rc)
804!
805!=======================================================================
806! !
807! Sets COAMPS component date calendar, start and stop time, and !
808! coupling interval. !
809! !
810!=======================================================================
811!
812 USE coamnl_mod, ONLY : ktaust ! starting time (hour, min, sec)
813 USE coamnl_mod, ONLY : ktauf ! ending time (hour, min, sec)
814!
815! Imported variable declarations.
816!
817 integer, intent(out) :: rc
818!
819 TYPE (esmf_gridcomp) :: model
820!
821! Local variable declarations.
822!
823 integer :: is, ng
824 integer :: localpet, petcount
825 integer :: timefrac
826# ifdef REGRESS_STARTCLOCK
827 integer :: regressstartdate(7)
828# endif
829!
830 character (len= 22) :: calendar
831# ifdef REGRESS_STARTCLOCK
832 character (len= 22) :: regressstartstring
833# endif
834 character (len= 22) :: starttimestring, stoptimestring
835 character (len=160) :: message
836
837 character (len=*), parameter :: myfile = &
838 & __FILE__//", COAMPS_SetClock"
839!
840 TYPE (esmf_calkind_flag) :: caltype
841 TYPE (esmf_clock) :: clock
842 TYPE (esmf_time) :: starttime
843 TYPE (esmf_vm) :: vm
844!
845!-----------------------------------------------------------------------
846! Initialize return code flag to success state (no error).
847!-----------------------------------------------------------------------
848!
849 IF (esm_track) THEN
850 WRITE (trac,'(a,a,i0)') '==> Entering COAMPS_SetClock', &
851 & ', PET', petrank
852 FLUSH (trac)
853 END IF
854 rc=esmf_success
855!
856!-----------------------------------------------------------------------
857! Querry the Virtual Machine (VM) parallel environmemt for the MPI
858! communicator handle and current node rank.
859!-----------------------------------------------------------------------
860!
861 CALL esmf_gridcompget (model, &
862 & localpet=localpet, &
863 & petcount=petcount, &
864 & vm=vm, &
865 & rc=rc)
866 IF (esmf_logfounderror(rctocheck=rc, &
867 & msg=esmf_logerr_passthru, &
868 & line=__line__, &
869 & file=myfile)) THEN
870 RETURN
871 END IF
872!
873!-----------------------------------------------------------------------
874! Create COAMPS component clock.
875!-----------------------------------------------------------------------
876!
877 calendar=trim(clockinfo(iatmos)%CalendarString)
878 IF (trim(calendar).eq.'gregorian') THEN
879 caltype=esmf_calkind_gregorian
880 ELSE
881 caltype=esmf_calkind_gregorian
882 END IF
883!
884 clockinfo(iatmos)%Calendar=esmf_calendarcreate(caltype, &
885 & name=trim(calendar), &
886 & rc=rc)
887 IF (esmf_logfounderror(rctocheck=rc, &
888 & msg=esmf_logerr_passthru, &
889 & line=__line__, &
890 & file=myfile)) THEN
891 RETURN
892 END IF
893!
894! Set reference time. Use driver configuration values.
895!
896 CALL esmf_timeset (clockinfo(iatmos)%ReferenceTime, &
897 & yy=referencedate(1), &
898 & mm=referencedate(2), &
899 & dd=referencedate(3), &
900 & h =referencedate(4), &
901 & m =referencedate(5), &
902 & s =referencedate(6), &
903 & calendar=clockinfo(iatmos)%Calendar, &
904 & rc=rc)
905 IF (esmf_logfounderror(rctocheck=rc, &
906 & msg=esmf_logerr_passthru, &
907 & line=__line__, &
908 & file=myfile)) THEN
909 RETURN
910 END IF
911
912# ifdef REGRESS_STARTCLOCK
913!
914! Use the same as driver. A coupling interval is substracted to the
915! driver clock to properly initialize all the ESM components.
916!
917 clockinfo(iatmos)%StartTime=clockinfo(idriver)%StartTime
918!
919 CALL esmf_timeget (clockinfo(iatmos)%StartTime, &
920 & yy=regressstartdate(1), &
921 & mm=regressstartdate(2), &
922 & dd=regressstartdate(3), &
923 & h= regressstartdate(4), &
924 & m= regressstartdate(5), &
925 & s= regressstartdate(6), &
926 & ms=regressstartdate(7), &
927 & timestring=regressstartstring, &
928 & rc=rc)
929 IF (esmf_logfounderror(rctocheck=rc, &
930 & msg=esmf_logerr_passthru, &
931 & line=__line__, &
932 & file=myfile)) THEN
933 RETURN
934 END IF
935# else
936!
937! Set start time. Use driver configuration values.
938!
939 CALL esmf_timeset (clockinfo(iatmos)%StartTime, &
940 yy=startdate(1), &
941 mm=startdate(2), &
942 dd=startdate(3), &
943 h =startdate(4), &
944 m =startdate(5), &
945 s =startdate(6), &
946 calendar=clockinfo(iatmos)%Calendar, &
947 rc=rc)
948 IF (esmf_logfounderror(rctocheck=rc, &
949 & msg=esmf_logerr_passthru, &
950 & line=__line__, &
951 & file=myfile)) THEN
952 RETURN
953 END IF
954# endif
955!
956! Set stop time. Use driver configuration values.
957!
958 CALL esmf_timeset (clockinfo(iatmos)%StopTime, &
959 & yy=stopdate(1), &
960 & mm=stopdate(2), &
961 & dd=stopdate(3), &
962 & h =stopdate(4), &
963 & m =stopdate(5), &
964 & s =stopdate(6), &
965 & calendar=clockinfo(iatmos)%Calendar, &
966 & rc=rc)
967 IF (esmf_logfounderror(rctocheck=rc, &
968 & msg=esmf_logerr_passthru, &
969 & line=__line__, &
970 & file=myfile)) THEN
971 RETURN
972 END IF
973!
974 CALL esmf_timeget (clockinfo(iatmos)%StopTime, &
975 & timestringisofrac=stoptimestring, &
976 & rc=rc)
977 IF (esmf_logfounderror(rctocheck=rc, &
978 & msg=esmf_logerr_passthru, &
979 & line=__line__, &
980 & file=myfile)) THEN
981 RETURN
982 END IF
983 is=index(stoptimestring, 'T') ! remove 'T' in
984 IF (is.gt.0) stoptimestring(is:is)=' ' ! ISO 8601 format
985 clockinfo(iatmos)%Time_StopString=stoptimestring
986!
987!-----------------------------------------------------------------------
988! Modify component clock time step.
989!-----------------------------------------------------------------------
990!
991 timefrac=0
992 DO ng=1,models(iatmos)%Ngrids
993 IF (any(coupled(iatmos)%LinkedGrid(ng,:))) THEN
994 timefrac=max(timefrac, &
995 & maxval(models(iatmos)%TimeFrac(ng,:), &
996 & mask=models(:)%IsActive))
997 END IF
998 END DO
999 IF (timefrac.lt.1) THEN ! needs to be 1 or greater
1000 rc=esmf_rc_not_set ! cannot be 0
1001 IF (esmf_logfounderror(rctocheck=rc, &
1002 & msg=esmf_logerr_passthru, &
1003 & line=__line__, &
1004 & file=myfile)) THEN
1005 RETURN
1006 END IF
1007 END IF
1008 clockinfo(iatmos)%TimeStep=clockinfo(idriver)%TimeStep/timefrac
1009!
1010!-----------------------------------------------------------------------
1011! Create COAMPS component clock.
1012!-----------------------------------------------------------------------
1013!
1014 clockinfo(iatmos)%Name='COAMPS_clock'
1015 clock=esmf_clockcreate(clockinfo(iatmos)%TimeStep, &
1016 & clockinfo(iatmos)%StartTime, &
1017 & stoptime =clockinfo(iatmos)%StopTime, &
1018 & reftime =clockinfo(iatmos)%ReferenceTime, &
1019 & name =trim(clockinfo(iatmos)%Name), &
1020 & rc=rc)
1021 IF (esmf_logfounderror(rctocheck=rc, &
1022 & msg=esmf_logerr_passthru, &
1023 & line=__line__, &
1024 & file=myfile)) THEN
1025 RETURN
1026 END IF
1027 clockinfo(iatmos)%Clock=clock
1028!
1029! Set ROMS component clock.
1030!
1031 CALL esmf_gridcompset (model, &
1032 & clock=clockinfo(iatmos)%Clock, &
1033 & rc=rc)
1034 IF (esmf_logfounderror(rctocheck=rc, &
1035 & msg=esmf_logerr_passthru, &
1036 & line=__line__, &
1037 & file=myfile)) THEN
1038 RETURN
1039 END IF
1040!
1041! Get current time.
1042!
1043 CALL esmf_clockget (clockinfo(iatmos)%Clock, &
1044 & currtime=clockinfo(iatmos)%CurrentTime, &
1045 & rc=rc)
1046 IF (esmf_logfounderror(rctocheck=rc, &
1047 & msg=esmf_logerr_passthru, &
1048 & line=__line__, &
1049 & file=myfile)) THEN
1050 RETURN
1051 END IF
1052!
1053!-----------------------------------------------------------------------
1054! Compare driver time against COAMPS component time.
1055!-----------------------------------------------------------------------
1056!
1057 IF (clockinfo(idriver)%Restarted) THEN
1058 starttimestring=clockinfo(idriver)%Time_RestartString
1059 ELSE
1060 starttimestring=clockinfo(idriver)%Time_StartString
1061 END IF
1062!
1063! Report start and stop time clocks.
1064!
1065 IF (localpet.eq.0) THEN
1066 WRITE (cplout,10) 'COAMPS Calendar: ', &
1067 & trim(clockinfo(iatmos)%CalendarString), &
1068 & 'COAMPS Start Clock: ', &
1069 & trim(clockinfo(iatmos)%Time_StartString), &
1070 & 'COAMPS Stop Clock: ', &
1071 & trim(clockinfo(iatmos )%Time_StopString)
1072 END IF
1073!
1074! Compare Driver and COAMPS clocks.
1075!
1076 IF (clockinfo(iatmos)%Time_StartString.ne. &
1077 & starttimestring) THEN
1078 IF (localpet.eq.0) THEN
1079 WRITE (cplout,20) 'COAMPS Start Time: ', &
1080 & trim(clockinfo(iatmos)%Time_StartString), &
1081 & 'Driver Start Time: ', &
1082 & trim(starttimestring), &
1083 & ' are not equal!'
1084 END IF
1085 message='Driver and COAMPS start times do not match: '// &
1086 & 'please check the config files.'
1087 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
1088 & msg=trim(message))
1089 RETURN
1090 END IF
1091!
1092 IF (clockinfo(iatmos )%Time_StopString(1:19).ne. &
1093 & clockinfo(idriver)%Time_StopString(1:19)) THEN
1094 IF (localpet.eq.0) THEN
1095 WRITE (cplout,20) 'COAMPS Stop Time: ', &
1096 & trim(clockinfo(iatmos )%Time_StopString), &
1097 & 'Driver Stop Time: ', &
1098 & trim(clockinfo(idriver)%Time_StopString), &
1099 & ' are not equal!'
1100 END IF
1101 message='Driver and COAMPS stop times do not match: '// &
1102 & 'please check the config files.'
1103 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
1104 & msg=trim(message))
1105 RETURN
1106 END IF
1107!
1108 IF (trim(clockinfo(iatmos )%CalendarString).ne. &
1109 & trim(clockinfo(idriver)%CalendarString)) THEN
1110 IF (localpet.eq.0) THEN
1111 WRITE (cplout,20) 'COAMPS Calendar: ', &
1112 & trim(clockinfo(iatmos )%CalendarString), &
1113 & 'Driver Calendar: ', &
1114 & trim(clockinfo(idriver)%CalendarString), &
1115 & ' are not equal!'
1116 END IF
1117 message='Driver and COAMPS calendars do not match: '// &
1118 & 'please check the config files.'
1119 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
1120 & msg=trim(message))
1121 RETURN
1122 END IF
1123!
1124 IF (esm_track) THEN
1125 WRITE (trac,'(a,a,i0)') '<== Exiting COAMPS_SetClock', &
1126 & ', PET', petrank
1127 FLUSH (trac)
1128 END IF
1129!
1130 10 FORMAT (2x,a,2x,a/,2x,a,2x,a,/,2x,a,2x,a,/)
1131 20 FORMAT (/,2x,a,a,/,2x,a,a,/,2x,a)
1132!
1133 RETURN
1134 END SUBROUTINE coamps_setclock
1135
1136# ifdef ESM_SETRUNCLOCK
1137!
1138 SUBROUTINE coamps_setrunclock (model, rc)
1139!
1140!=======================================================================
1141! !
1142! Sets COAMPS run clock manually to avoid getting zero time stamps at !
1143! the first regridding call. !
1144! !
1145!=======================================================================
1146!
1147! Imported variable declarations.
1148!
1149 integer, intent(out) :: rc
1150!
1151 TYPE (esmf_gridcomp) :: model
1152!
1153! Local variable declarations.
1154!
1155 character (len=*), parameter :: myfile = &
1156 & __FILE__//", COAMPS_SetRunClock"
1157!
1158 TYPE (esmf_clock) :: driverclock, modelclock
1159 TYPE (esmf_time) :: currtime
1160!
1161!-----------------------------------------------------------------------
1162! Initialize return code flag to success state (no error).
1163!-----------------------------------------------------------------------
1164!
1165 IF (esm_track) THEN
1166 WRITE (trac,'(a,a,i0)') '==> Entering COAMPS_SetRunClock', &
1167 & ', PET', petrank
1168 FLUSH (trac)
1169 END IF
1170 rc=esmf_success
1171!
1172!-----------------------------------------------------------------------
1173! Set ROMS run clock manually.
1174!-----------------------------------------------------------------------
1175!
1176! Inquire driver and model clock.
1177!
1178 CALL nuopc_modelget (model, &
1179 & driverclock=driverclock, &
1180 & modelclock=modelclock, &
1181 & rc=rc)
1182 IF (esmf_logfounderror(rctocheck=rc, &
1183 & msg=esmf_logerr_passthru, &
1184 & line=__line__, &
1185 & file=myfile)) THEN
1186 RETURN
1187 END IF
1188!
1189! Set model clock to have the current start time as the driver clock.
1190!
1191 CALL esmf_clockget (driverclock, &
1192 & currtime=currtime, &
1193 & rc=rc)
1194 IF (esmf_logfounderror(rctocheck=rc, &
1195 & msg=esmf_logerr_passthru, &
1196 & line=__line__, &
1197 & file=myfile)) THEN
1198 RETURN
1199 END IF
1200!
1201 CALL esmf_clockset (modelclock, &
1202 & currtime=currtime, &
1203 & rc=rc)
1204 IF (esmf_logfounderror(rctocheck=rc, &
1205 & msg=esmf_logerr_passthru, &
1206 & line=__line__, &
1207 & file=myfile)) THEN
1208 RETURN
1209 END IF
1210!
1211! Check and set the component clock against the driver clock.
1212!
1213 CALL nuopc_compchecksetclock (model, &
1214 & driverclock, &
1215 & rc=rc)
1216 IF (esmf_logfounderror(rctocheck=rc, &
1217 & msg=esmf_logerr_passthru, &
1218 & line=__line__, &
1219 & file=myfile)) THEN
1220 RETURN
1221 END IF
1222!
1223 IF (esm_track) THEN
1224 WRITE (trac,'(a,a,i0)') '<== Exiting COAMPS_SetRunClock', &
1225 & ', PET', petrank
1226 FLUSH (trac)
1227 END IF
1228!
1229 RETURN
1230 END SUBROUTINE coamps_setrunclock
1231# endif
1232!
1233 SUBROUTINE coamps_checkimport (model, rc)
1234!
1235!=======================================================================
1236! !
1237! Checks if COAMPS component import field is at the correct time. !
1238! !
1239!=======================================================================
1240!
1241! Imported variable declarations.
1242!
1243 integer, intent(out) :: rc
1244!
1245 TYPE (esmf_gridcomp) :: model
1246!
1247! Local variable declarations.
1248!
1249 logical :: isvalid, atcorrecttime
1250!
1251 integer :: importcount, i, is, localpet, ng
1252!
1253 real (dp) :: tcurrentinseconds
1254!
1255 character (len=22) :: drivertimestring, fieldtimestring
1256
1257 character (len=*), parameter :: myfile = &
1258 & __FILE__//", COAMPS_CheckImport"
1259!
1260 character (ESMF_MAXSTR) :: string, fieldname
1261 character (ESMF_MAXSTR), allocatable :: importnamelist(:)
1262!
1263 TYPE (esmf_clock) :: driverclock
1264 TYPE (esmf_field) :: field
1265 TYPE (esmf_time) :: starttime, currenttime
1266 TYPE (esmf_time) :: drivertime, fieldtime
1267 TYPE (esmf_timeinterval) :: timestep
1268 TYPE (esmf_vm) :: vm
1269!
1270!-----------------------------------------------------------------------
1271! Initialize return code flag to success state (no error).
1272!-----------------------------------------------------------------------
1273!
1274 IF (esm_track) THEN
1275 WRITE (trac,'(a,a,i0)') '==> Entering COAMPS_CheckImport', &
1276 & ', PET', petrank
1277 FLUSH (trac)
1278 END IF
1279 rc=esmf_success
1280!
1281!-----------------------------------------------------------------------
1282! Query component.
1283!-----------------------------------------------------------------------
1284!
1285 CALL nuopc_modelget (model, &
1286 & driverclock=driverclock, &
1287 & rc=rc)
1288 IF (esmf_logfounderror(rctocheck=rc, &
1289 & msg=esmf_logerr_passthru, &
1290 & line=__line__, &
1291 & file=myfile)) THEN
1292 RETURN
1293 END IF
1294!
1295 CALL esmf_gridcompget (model, &
1296 & localpet=localpet, &
1297 & vm=vm, &
1298 & rc=rc)
1299 IF (esmf_logfounderror(rctocheck=rc, &
1300 & msg=esmf_logerr_passthru, &
1301 & line=__line__, &
1302 & file=myfile)) THEN
1303 RETURN
1304 END IF
1305!
1306!-----------------------------------------------------------------------
1307! Get the start time and current time from driver clock.
1308!-----------------------------------------------------------------------
1309!
1310 CALL esmf_clockget (driverclock, &
1311 & timestep=timestep, &
1312 & starttime=starttime, &
1313 & currtime=drivertime, &
1314 & rc=rc)
1315 IF (esmf_logfounderror(rctocheck=rc, &
1316 & msg=esmf_logerr_passthru, &
1317 & line=__line__, &
1318 & file=myfile)) THEN
1319 RETURN
1320 END IF
1321!
1322 CALL esmf_timeget (drivertime, &
1323 & s_r8=tcurrentinseconds, &
1324 & timestringisofrac=drivertimestring, &
1325 & rc=rc)
1326 IF (esmf_logfounderror(rctocheck=rc, &
1327 & msg=esmf_logerr_passthru, &
1328 & line=__line__, &
1329 & file=myfile)) THEN
1330 RETURN
1331 END IF
1332 is=index(drivertimestring, 'T') ! remove 'T' in
1333 IF (is.gt.0) drivertimestring(is:is)=' ' ! ISO 8601 format
1334!
1335!-----------------------------------------------------------------------
1336! Get list of import fields.
1337!-----------------------------------------------------------------------
1338!
1339 IF (nimport(iatmos).gt.0) THEN
1340 nested_loop : DO ng=1,models(iatmos)%Ngrids
1341 IF (any(coupled(iatmos)%LinkedGrid(ng,:))) THEN
1342 CALL esmf_stateget (models(iatmos)%ImportState(ng), &
1343 & itemcount=importcount, &
1344 & rc=rc)
1345 IF (esmf_logfounderror(rctocheck=rc, &
1346 & msg=esmf_logerr_passthru, &
1347 & line=__line__, &
1348 & file=myfile)) THEN
1349 RETURN
1350 END IF
1351!
1352 IF (.not.allocated(importnamelist)) THEN
1353 allocate ( importnamelist(importcount) )
1354 END IF
1355!
1356 CALL esmf_stateget (models(iatmos)%ImportState(ng), &
1357 & itemnamelist=importnamelist, &
1358 & rc=rc)
1359 IF (esmf_logfounderror(rctocheck=rc, &
1360 & msg=esmf_logerr_passthru, &
1361 & line=__line__, &
1362 & file=myfile)) THEN
1363 RETURN
1364 END IF
1365!
1366!-----------------------------------------------------------------------
1367! Only check fields in the ImportState object.
1368!-----------------------------------------------------------------------
1369!
1370 field_loop : DO i=1,importcount
1371 fieldname=trim(importnamelist(i))
1372 CALL esmf_stateget (models(iatmos)%ImportState(ng), &
1373 & itemname=trim(fieldname), &
1374 & field=field, &
1375 & rc=rc)
1376 IF (esmf_logfounderror(rctocheck=rc, &
1377 & msg=esmf_logerr_passthru, &
1378 & line=__line__, &
1379 & file=myfile)) THEN
1380 RETURN
1381 END IF
1382!
1383! If debugging, report field timestamp.
1384!
1385 IF (debuglevel.gt.1) THEN
1386 CALL nuopc_gettimestamp (field, &
1387 & isvalid = isvalid, &
1388 & time = fieldtime, &
1389 & rc = rc)
1390 IF (esmf_logfounderror(rctocheck=rc, &
1391 & msg=esmf_logerr_passthru, &
1392 & line=__line__, &
1393 & file=myfile)) THEN
1394 RETURN
1395 END IF
1396!
1397 IF (isvalid) THEN
1398 CALL esmf_timeget (fieldtime, &
1399 & timestringisofrac = fieldtimestring, &
1400 & rc=rc)
1401 IF (esmf_logfounderror(rctocheck=rc, &
1402 & msg=esmf_logerr_passthru, &
1403 & line=__line__, &
1404 & file=myfile)) THEN
1405 RETURN
1406 END IF
1407 is=index(fieldtimestring, 'T') ! remove 'T'
1408 IF (is.gt.0) fieldtimestring(is:is)=' '
1409!
1410 IF (localpet.eq.0) THEN
1411 WRITE (cplout,10) trim(fieldname), &
1412 & trim(fieldtimestring), &
1413 & trim(drivertimestring)
1414 END IF
1415 END IF
1416 END IF
1417!
1418! Check if import field is at the correct time.
1419!
1420 string='COAMPS_CheckImport - '//trim(fieldname)//' field'
1421 currenttime=drivertime
1422!
1423 atcorrecttime=nuopc_isattime(field, &
1424 & currenttime, &
1425 & rc=rc)
1426 IF (esmf_logfounderror(rctocheck=rc, &
1427 & msg=esmf_logerr_passthru, &
1428 & line=__line__, &
1429 & file=myfile)) THEN
1430 RETURN
1431 END IF
1432!
1433 IF (.not.atcorrecttime) THEN
1434 CALL report_timestamp (field, currenttime, &
1435 & localpet, trim(string), rc)
1436!
1437 string='NUOPC INCOMPATIBILITY DETECTED: Import '// &
1438 & 'Fields not at correct time'
1439 CALL esmf_logseterror(esmf_rc_not_valid, &
1440 & msg=trim(string), &
1441 & line=__line__, &
1442 & file=myfile, &
1443 & rctoreturn=rc)
1444 RETURN
1445 END IF
1446 END DO field_loop
1447 IF (allocated(importnamelist)) deallocate (importnamelist)
1448 END IF
1449 END DO nested_loop
1450 END IF
1451!
1452 IF (esm_track) THEN
1453 WRITE (trac,'(a,a,i0)') '<== Exiting COAMPS_CheckImport', &
1454 & ', PET', petrank
1455 FLUSH (trac)
1456 END IF
1457!
1458 10 FORMAT (1x,'COAMPS_CheckImport - ',a,':',t32,'TimeStamp = ',a, &
1459 & ', DriverTime = ',a)
1460!
1461 RETURN
1462 END SUBROUTINE coamps_checkimport
1463!
1464 SUBROUTINE coamps_setgridarrays (ng, model, localPET, rc)
1465!
1466!=======================================================================
1467! !
1468! Sets COAMPS component staggered, horizontal grids arrays, grid !
1469! area, and land/sea mask. !
1470! !
1471! COAMPS Grid Decomposition: !
1472! ========================== !
1473! !
1474! COAMPS global horizontal domain for nest "ng": !
1475! !
1476! full-extent area: [0:m(ng)+1, 0:n(ng)+1] !
1477! physical area: [1:m(ng) , 1:n(ng) ] !
1478! computational area: [2:m(ng)-1, 2:n(ng)-1] !
1479! !
1480! COAMPS number of horizontal subdomains is "nprdom". !
1481! !
1482! COAMPS number of horizontal subdomains along each dimension for !
1483! nest "ng" is: !
1484! !
1485! domdec%ndx(ng) !
1486! domdec%ndy(ng) !
1487! !
1488! COAMPS supports only one horizontal subdomain (tile) per process !
1489! (that is, one DE per PET). !
1490! !
1491! COAMPS physical area bounds for horizontal subdomain (tile) in !
1492! nest "ng" are: !
1493! !
1494! [nlimx(ng)%bp(tile) : nlimx(ng)%ep(tile), !
1495! nlimy(ng)%bp(tile) : nlimy(ng)%ep(tile)] !
1496! !
1497! COAMPS computational area bounds for horizontal subdomain (tile) in !
1498! nest "ng" are: !
1499! !
1500! [nlimx(ng)%b (tile) : nlimx(ng)%e (tile), !
1501! nlimy(nn)%b (tile) : nlimy(ng)%e (tile)] !
1502! !
1503! COAMPS local horizontal subdomain (tile) area bounds for nest !
1504! "ng" are: !
1505! !
1506! Full-extent grid: [iminf(ng) : imaxf(ng), !
1507! jminf(ng) : jmaxf(ng)] !
1508! !
1509! Physical grid: [iminp_nest(ng) : imaxp_nest(ng), !
1510! jminp_nest(ng) : jmaxp_nest(ng)] !
1511! !
1512! Interior grid: [imini(ng) : imaxi(ng), !
1513! jmini(ng) : jmaxi(ng)] !
1514! !
1515! Relationship between COAMPS array and ESMF_Array subdomain regions. !
1516! The second index in the ESMF LBound/UBound arrays is the DE index, !
1517! which is always one since COAMPS only supports one DE per PET. !
1518! COAMPS array indexing is based on global grid index. ESMF array !
1519! indexing mirrors the COAMPS array indexing (ESMF_INDEX_GLOBAL). !
1520! !
1521! * ESMF Exclusive Region <=> COAMPS Physical Area !
1522! Partial halos for subdomains that contain the physical boundary !
1523! No halos otherwise !
1524! !
1525! Array bounds: !
1526! !
1527! ESMF [exclusiveLBound(1,1) : exclusiveUBound(1,1), !
1528! exclusiveLBound(2,1) : exclusiveUBound(2,1)] !
1529! !
1530! COAMPS [iminp : imaxp, !
1531! jminp : jmaxp] !
1532! !
1533! * ESMF Computational Region <=> COAMPS Physical Area !
1534! Partial halos for subdomains that contain the physical boundary !
1535! No halos otherwise !
1536! !
1537! Array bounds: !
1538! !
1539! ESMF [computationalLBound(1,1) : computationalUBound(1,1), !
1540! computationalLBound(2,1) : computationalUBound(2,1)] !
1541! !
1542! COAMPS [iminp : imaxp, !
1543! jminp : jmaxp] !
1544! !
1545! * ESMF Total Region <=> COAMPS Full Extent Area !
1546! Full halos !
1547! !
1548! Array bounds: !
1549! !
1550! ESMF [totalLBound(1,1) : totalUBound(1,1), !
1551! totalLBound(2,1) : totalUBound(2,1)] !
1552! !
1553! COAMPS [iminf : imaxf, !
1554! jminf : jmaxf] !
1555! !
1556!=======================================================================
1557!
1558 USE coamm_memm, ONLY : adom
1559 USE domdec, ONLY : iminf, imaxf, jminf, jmaxf, &
1560 & nlimx, nlimy, nprdom, ndx, ndy
1561 USE gridnl_mod, ONLY : delx, dely, m, n
1562!
1563! Imported variable declarations.
1564!
1565 integer, intent(in) :: ng, localpet
1566 integer, intent(out) :: rc
1567!
1568 TYPE (esmf_gridcomp), intent(inout) :: model
1569!
1570! Local variable declarations.
1571!
1572 integer :: gtype, i, ivar, j, node, tile
1573 integer :: localde, localdecount
1574 integer :: lbi, ubi, lbj, ubj
1575 integer :: clb(2), cub(2), elb(2), eub(2), tlb(2), tub(2)
1576!
1577 integer, allocatable :: deblocklist(:,:,:)
1578 integer (i4b), pointer :: ptrm(:,:) => null()
1579!
1580 real (dp), pointer :: ptra(:,:) => null()
1581 real (dp), pointer :: ptrx(:,:) => null()
1582 real (dp), pointer :: ptry(:,:) => null()
1583!
1584 character (len=40) :: name
1585
1586 character (len=*), parameter :: myfile = &
1587 & __FILE__//", COAMPS_SetGridArrays"
1588!
1589 TYPE (esmf_distgrid) :: distgrid
1590 TYPE (esmf_staggerloc) :: staggerloc
1591 TYPE (esmf_vm) :: vm
1592!
1593!-----------------------------------------------------------------------
1594! Initialize return code flag to success state (no error).
1595!-----------------------------------------------------------------------
1596!
1597 IF (esm_track) THEN
1598 WRITE (trac,'(a,a,i0)') '==> Entering COAMPS_SetGridArrays', &
1599 & ', PET', petrank
1600 FLUSH (trac)
1601 END IF
1602 rc=esmf_success
1603!
1604!-----------------------------------------------------------------------
1605! Querry the Virtual Machine (VM) parallel environmemt for the MPI
1606! communicator handle and current node rank.
1607!-----------------------------------------------------------------------
1608!
1609 CALL esmf_gridcompget (model, &
1610 & vm=vm, &
1611 & rc=rc)
1612 IF (esmf_logfounderror(rctocheck=rc, &
1613 & msg=esmf_logerr_passthru, &
1614 & line=__line__, &
1615 & file=myfile)) THEN
1616 RETURN
1617 END IF
1618!
1619!-----------------------------------------------------------------------
1620! Set tiles lower and upper bounds for each decomposition element
1621! (DE=1) in terms of global indices using the physical grid area
1622! (iminp:imaxp, jminp:jmaxp; no overlap between tiles).
1623!-----------------------------------------------------------------------
1624!
1625 IF (.not.allocated(deblocklist)) THEN
1626 allocate ( deblocklist(2,2,nprdom) )
1627 END IF
1628 DO tile=1,nprdom
1629 deblocklist(1,1,tile)=nlimx(ng)%bp(tile) ! iminp
1630 deblocklist(1,2,tile)=nlimx(ng)%ep(tile) ! imaxp
1631 deblocklist(2,1,tile)=nlimy(ng)%bp(tile) ! jminp
1632 deblocklist(2,2,tile)=nlimy(ng)%ep(tile) ! jmaxp
1633 END DO
1634!
1635!-----------------------------------------------------------------------
1636! Create ESMF DistGrid object based on model domain decomposition.
1637!-----------------------------------------------------------------------
1638!
1639! A single Decomposition Element (DE) per Persistent Execution Thread
1640! (PET).
1641!
1642 distgrid=esmf_distgridcreate(minindex=(/ 1, 1 /), &
1643 & maxindex=(/ m(ng), n(ng) /), &
1644 & deblocklist=deblocklist, &
1645 & rc=rc)
1646 IF (esmf_logfounderror(rctocheck=rc, &
1647 & msg=esmf_logerr_passthru, &
1648 & line=__line__, &
1649 & file=myfile)) THEN
1650 RETURN
1651 END IF
1652!
1653! Report COAMPS DistGrid based on model domain decomposition.
1654!
1655 IF ((localpet.eq.0).and.(debuglevel.gt.0)) THEN
1656 WRITE (cplout,10) ng, trim(gridtype(icenter))//" Point", &
1657 & ndx(ng), ndy(ng)
1658 DO node=1,nprdom
1659 WRITE (cplout,20) node-1, deblocklist(1,1,node), &
1660 & deblocklist(1,2,node), &
1661 & deblocklist(2,1,node), &
1662 & deblocklist(2,2,node)
1663 END DO
1664 END IF
1665 IF (allocated(deblocklist)) deallocate (deblocklist)
1666
1667# ifdef DATA_COUPLING
1668!
1669! Read in melding weights coefficients needed by COAMPS to merge
1670! imported fields from DATA and other ESM components at the specified
1671! nested grid because of incongruent grids.
1672!
1673 IF ((models(idata)%IsActive).and. &
1674 & (ng.eq.weights(iatmos)%NestedGrid)) THEN
1675 CALL get_weights (iatmos, m(ng), n(ng), vm, rc)
1676 IF (esmf_logfounderror(rctocheck=rc, &
1677 & msg=esmf_logerr_passthru, &
1678 & line=__line__, &
1679 & file=myfile)) THEN
1680 RETURN
1681 END IF
1682 END IF
1683# endif
1684!
1685!-----------------------------------------------------------------------
1686! Set component grid coordinates.
1687!-----------------------------------------------------------------------
1688!
1689! Define component grid location type: Although COAMPS is discritased
1690! on an Arakawa C-grid, it exports and imports fields at the grid cell
1691! center.
1692!
1693 IF (.not.allocated(models(iatmos)%mesh)) THEN
1694 allocate ( models(iatmos)%mesh(1) )
1695 models(iatmos)%mesh(1)%gtype=icenter
1696 END IF
1697!
1698! Create ESMF Grid.
1699!
1700 models(iatmos)%grid(ng)=esmf_gridcreate(distgrid=distgrid, &
1701 & coordsys=esmf_coordsys_sph_deg, &
1702 & coordtypekind=esmf_typekind_r8, &
1703 & gridedgelwidth=(/0,0/), &
1704 & gridedgeuwidth=(/0,0/), &
1705 & indexflag=esmf_index_global, &
1706 & name=trim(models(iatmos)%name), &
1707 & rc=rc)
1708 IF (esmf_logfounderror(rctocheck=rc, &
1709 & msg=esmf_logerr_passthru, &
1710 & line=__line__, &
1711 & file=myfile)) THEN
1712 RETURN
1713 END IF
1714!
1715! Get number of local decomposition elements (DEs). Usually, a single
1716! DE is associated with each Persistent Execution Thread (PETs). Thus,
1717! localDEcount=1.
1718!
1719 CALL esmf_gridget (models(iatmos)%grid(ng), &
1720 & localdecount=localdecount, &
1721 & rc=rc)
1722 IF (esmf_logfounderror(rctocheck=rc, &
1723 & msg=esmf_logerr_passthru, &
1724 & line=__line__, &
1725 & file=myfile)) THEN
1726 RETURN
1727 END IF
1728!
1729! Mesh coordinates for each variable type.
1730!
1731 mesh_loop : DO ivar=1,ubound(models(iatmos)%mesh, dim=1)
1732!
1733! Set staggering type, Arakawa C-grid.
1734!
1735 SELECT CASE (models(iatmos)%mesh(ivar)%gtype)
1736 CASE (icenter)
1737 staggerloc=esmf_staggerloc_center
1738 END SELECT
1739!
1740! Allocate coordinate storage associated with staggered grid type.
1741! No coordinate values are set yet.
1742!
1743 CALL esmf_gridaddcoord (models(iatmos)%grid(ng), &
1744 & staggerloc=staggerloc, &
1745 & rc=rc)
1746 IF (esmf_logfounderror(rctocheck=rc, &
1747 & msg=esmf_logerr_passthru, &
1748 & line=__line__, &
1749 & file=myfile)) THEN
1750 RETURN
1751 END IF
1752!
1753! Allocate storage for masking.
1754!
1755 CALL esmf_gridadditem (models(iatmos)%grid(ng), &
1756 & staggerloc=staggerloc, &
1757 & itemflag=esmf_griditem_mask, &
1758 & rc=rc)
1759 IF (esmf_logfounderror(rctocheck=rc, &
1760 & msg=esmf_logerr_passthru, &
1761 & line=__line__, &
1762 & file=myfile)) THEN
1763 RETURN
1764 END IF
1765!
1766! The COAMPS masking is as follows, -1: inland lake
1767! 0: sea water
1768! 1: land
1769! 2: sea ice
1770! 3: land ice
1771!
1772 models(iatmos)%LandValue=1
1773 models(iatmos)%SeaValue=0
1774!
1775! Allocate storage for grid area.
1776!
1777 CALL esmf_gridadditem (models(iatmos)%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. Notice that the indices for
1790! the exclusive, computational, and total regions
1791!
1792 de_loop : DO localde=0,localdecount-1
1793 CALL esmf_gridgetcoord (models(iatmos)%grid(ng), &
1794 & coorddim=1, &
1795 & staggerloc=staggerloc, &
1796 & localde=localde, &
1797 & farrayptr=ptrx, &
1798 & exclusivelbound=elb, &
1799 & exclusiveubound=eub, &
1800 & computationallbound=clb, &
1801 & computationalubound=cub, &
1802 & totallbound=tlb, &
1803 & totalubound=tub, &
1804 & rc=rc)
1805 IF (esmf_logfounderror(rctocheck=rc, &
1806 & msg=esmf_logerr_passthru, &
1807 & line=__line__, &
1808 & file=myfile)) THEN
1809 RETURN
1810 END IF
1811!
1812 CALL esmf_gridgetcoord (models(iatmos)%grid(ng), &
1813 & coorddim=2, &
1814 & staggerloc=staggerloc, &
1815 & localde=localde, &
1816 & farrayptr=ptry, &
1817 & exclusivelbound=elb, &
1818 & exclusiveubound=eub, &
1819 & computationallbound=clb, &
1820 & computationalubound=cub, &
1821 & totallbound=tlb, &
1822 & totalubound=tub, &
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(iatmos)%grid(ng), &
1832 & itemflag=esmf_griditem_mask, &
1833 & staggerloc=staggerloc, &
1834 & localde=localde, &
1835 & farrayptr=ptrm, &
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 CALL esmf_gridgetitem (models(iatmos)%grid(ng), &
1845 & itemflag=esmf_griditem_area, &
1846 & staggerloc=staggerloc, &
1847 & localde=localde, &
1848 & farrayptr=ptra, &
1849 & rc=rc)
1850 IF (esmf_logfounderror(rctocheck=rc, &
1851 & msg=esmf_logerr_passthru, &
1852 & line=__line__, &
1853 & file=myfile)) THEN
1854 RETURN
1855 END IF
1856!
1857! Fill grid pointers.
1858!
1859 SELECT CASE (models(iatmos)%mesh(ivar)%gtype)
1860 CASE (icenter)
1861 lbi=lbound(ptrx,1)
1862 ubi=ubound(ptrx,1)
1863 lbj=lbound(ptrx,2)
1864 ubj=ubound(ptrx,2)
1865 DO j=lbj,ubj
1866 DO i=lbi,ubi
1867 ptrx(i,j)=adom(ng)%aln(i,j)
1868 ptry(i,j)=adom(ng)%phi(i,j)
1869 ptrm(i,j)=adom(ng)%xland(i,j)
1870 ptra(i,j)=delx(ng)*dely(ng)
1871 END DO
1872 END DO
1873 END SELECT
1874!
1875! Nullify pointers.
1876!
1877 IF ( associated(ptrx) ) nullify (ptrx)
1878 IF ( associated(ptry) ) nullify (ptry)
1879 IF ( associated(ptrm) ) nullify (ptrm)
1880 IF ( associated(ptra) ) nullify (ptra)
1881 END DO de_loop
1882!
1883! Debugging: write out component grid in VTK format.
1884!
1885 IF (debuglevel.ge.4) THEN
1886 gtype=models(iatmos)%mesh(ivar)%gtype
1887 CALL esmf_gridwritevtk (models(iatmos)%grid(ng), &
1888 & filename="coamps_"// &
1889 & trim(gridtype(gtype))// &
1890 & "_point", &
1891 & staggerloc=staggerloc, &
1892 & rc=rc)
1893 IF (esmf_logfounderror(rctocheck=rc, &
1894 & msg=esmf_logerr_passthru, &
1895 & line=__line__, &
1896 & file=myfile)) THEN
1897 RETURN
1898 END IF
1899 END IF
1900 END DO mesh_loop
1901!
1902! Assign grid to gridded component.
1903!
1904 CALL esmf_gridcompset (model, &
1905 & grid=models(iatmos)%grid(ng), &
1906 & rc=rc)
1907 IF (esmf_logfounderror(rctocheck=rc, &
1908 & msg=esmf_logerr_passthru, &
1909 & line=__line__, &
1910 & file=myfile)) THEN
1911 RETURN
1912 END IF
1913!
1914 IF (esm_track) THEN
1915 WRITE (trac,'(a,a,i0)') '<== Exiting COAMPS_SetGridArrays', &
1916 & ', PET', petrank
1917 FLUSH (trac)
1918 END IF
1919 IF (debuglevel.gt.0) FLUSH (cplout)
1920!
1921 10 FORMAT ('COAMPS_DistGrid - Grid = ',i2.2,',',3x,'Mesh = ',a,',', &
1922 & 3x,'Partition = ',i0,' x ',i0)
1923 20 FORMAT (18x,'node = ',i0,t32,'Istr = ',i0,t45,'Iend = ',i0, &
1924 & t58,'Jstr = ',i0,t71,'Jend = ',i0)
1925!
1926 RETURN
1927 END SUBROUTINE coamps_setgridarrays
1928!
1929 SUBROUTINE coamps_setstates (ng, model, rc)
1930!
1931!=======================================================================
1932! !
1933! Adds COAMPS component export and import fields into its respective !
1934! state. !
1935! !
1936!=======================================================================
1937!
1938 USE domdec, ONLY : iminf, imaxf, jminf, jmaxf, &
1939 & ndom, nlimx, nlimy
1940!
1941! Imported variable declarations.
1942!
1943 integer, intent(in) :: ng
1944 integer, intent(out) :: rc
1945!
1946 TYPE (esmf_gridcomp) :: model
1947!
1948! Local variable declarations.
1949!
1950 integer :: i, id
1951 integer :: localde, localdecount
1952 integer :: localpet, petcount
1953 integer :: exportcount, importcount
1954 integer :: iminp, imaxp, jminp, jmaxp
1955 integer :: halolw(2), halouw(2)
1956!
1957 real (dp), dimension(:,:), pointer :: ptr2d => null()
1958!
1959 character (len=*), parameter :: myfile = &
1960 & __FILE__//", COAMPS_SetStates"
1961!
1962 character (ESMF_MAXSTR), allocatable :: exportnamelist(:)
1963 character (ESMF_MAXSTR), allocatable :: importnamelist(:)
1964!
1965 TYPE (esmf_arrayspec) :: arrayspec2d
1966 TYPE (esmf_field) :: field
1967 TYPE (esmf_staggerloc) :: staggerloc
1968 TYPE (esmf_vm) :: vm
1969!
1970!-----------------------------------------------------------------------
1971! Initialize return code flag to success state (no error).
1972!-----------------------------------------------------------------------
1973!
1974 IF (esm_track) THEN
1975 WRITE (trac,'(a,a,i0)') '==> Entering COAMPS_SetStates', &
1976 & ', PET', petrank
1977 FLUSH (trac)
1978 END IF
1979 rc=esmf_success
1980!
1981!-----------------------------------------------------------------------
1982! Compute lower and upper bound tile halo widths for ESMF fields.
1983!-----------------------------------------------------------------------
1984!
1985 iminp=nlimx(ng)%bp(ndom)
1986 imaxp=nlimx(ng)%ep(ndom)
1987 jminp=nlimy(ng)%bp(ndom)
1988 jmaxp=nlimy(ng)%ep(ndom)
1989!
1990 halolw(1)=iminp-iminf(ng)
1991 halolw(2)=jminp-jminf(ng)
1992 halouw(1)=imaxf(ng)-imaxp
1993 halouw(2)=jmaxf(ng)-jmaxp
1994!
1995!-----------------------------------------------------------------------
1996! Get gridded component information.
1997!-----------------------------------------------------------------------
1998!
1999! Get import and export states.
2000!
2001 CALL esmf_gridcompget (model, &
2002 & localpet=localpet, &
2003 & petcount=petcount, &
2004 & vm=vm, &
2005 & rc=rc)
2006 IF (esmf_logfounderror(rctocheck=rc, &
2007 & msg=esmf_logerr_passthru, &
2008 & line=__line__, &
2009 & file=myfile)) THEN
2010 RETURN
2011 END IF
2012!
2013! Get number of local decomposition elements (DEs). Usually, a single
2014! Decomposition Element (DE) is associated with each Persistent
2015! Execution Thread (PETs). Thus, localDEcount=1.
2016!
2017 CALL esmf_gridget (models(iatmos)%grid(ng), &
2018 & localdecount=localdecount, &
2019 & rc=rc)
2020 IF (esmf_logfounderror(rctocheck=rc, &
2021 & msg=esmf_logerr_passthru, &
2022 & line=__line__, &
2023 & file=myfile)) THEN
2024 RETURN
2025 END IF
2026!
2027!-----------------------------------------------------------------------
2028! Set a 2D floating-point array descriptor.
2029!-----------------------------------------------------------------------
2030!
2031 CALL esmf_arrayspecset (arrayspec2d, &
2032 & typekind=esmf_typekind_r8, &
2033 & rank=2, &
2034 & rc=rc)
2035 IF (esmf_logfounderror(rctocheck=rc, &
2036 & msg=esmf_logerr_passthru, &
2037 & line=__line__, &
2038 & file=myfile)) THEN
2039 RETURN
2040 END IF
2041!
2042!-----------------------------------------------------------------------
2043! Add export fields into export state.
2044!-----------------------------------------------------------------------
2045!
2046 exporting : IF (nexport(iatmos).gt.0) THEN
2047!
2048! Get number of fields to export.
2049!
2050 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
2051 & itemcount=exportcount, &
2052 & rc=rc)
2053 IF (esmf_logfounderror(rctocheck=rc, &
2054 & msg=esmf_logerr_passthru, &
2055 & line=__line__, &
2056 & file=myfile)) THEN
2057 RETURN
2058 END IF
2059!
2060! Get a list of export fields names.
2061!
2062 IF (.not.allocated(exportnamelist)) THEN
2063 allocate ( exportnamelist(exportcount) )
2064 END IF
2065 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
2066 & itemnamelist=exportnamelist, &
2067 & rc=rc)
2068 IF (esmf_logfounderror(rctocheck=rc, &
2069 & msg=esmf_logerr_passthru, &
2070 & line=__line__, &
2071 & file=myfile)) THEN
2072 RETURN
2073 END IF
2074!
2075! Set export field(s).
2076!
2077 DO i=1,exportcount
2078 id=field_index(models(iatmos)%ExportField, exportnamelist(i))
2079!
2080 IF (nuopc_isconnected(models(iatmos)%ExportState(ng), &
2081 & fieldname=trim(exportnamelist(i)), &
2082 & rc=rc)) THEN
2083!
2084! Set staggering type.
2085!
2086 SELECT CASE (models(iatmos)%ExportField(id)%gtype)
2087 CASE (icenter)
2088 staggerloc=esmf_staggerloc_center
2089 CASE (icorner)
2090 staggerloc=esmf_staggerloc_corner
2091 CASE (iupoint)
2092 staggerloc=esmf_staggerloc_edge1
2093 CASE (ivpoint)
2094 staggerloc=esmf_staggerloc_edge2
2095 END SELECT
2096!
2097! Create 2D field from the Grid and arraySpec.
2098!
2099 field=esmf_fieldcreate(models(iatmos)%grid(ng), &
2100 & arrayspec2d, &
2101 & indexflag=esmf_index_global, &
2102 & staggerloc=staggerloc, &
2103 & totallwidth=halolw, &
2104 & totaluwidth=halouw, &
2105 & name=trim(exportnamelist(i)), &
2106 & rc=rc)
2107 IF (esmf_logfounderror(rctocheck=rc, &
2108 & msg=esmf_logerr_passthru, &
2109 & line=__line__, &
2110 & file=myfile)) THEN
2111 RETURN
2112 END IF
2113!
2114! Put data into state. Usually, the DO-loop is executed once since
2115! localDEcount=1.
2116!
2117 DO localde=0,localdecount-1
2118!
2119! Get pointer to DE-local memory allocation within field.
2120!
2121 CALL esmf_fieldget (field, &
2122 & localde=localde, &
2123 & farrayptr=ptr2d, &
2124 & rc=rc)
2125 IF (esmf_logfounderror(rctocheck=rc, &
2126 & msg=esmf_logerr_passthru, &
2127 & line=__line__, &
2128 & file=myfile)) THEN
2129 RETURN
2130 END IF
2131!
2132! Initialize pointer.
2133!
2134 ptr2d=missing_dp
2135!
2136! Nullify pointer to make sure that it does not point on a random part
2137! in the memory.
2138!
2139 IF ( associated(ptr2d) ) nullify (ptr2d)
2140 END DO
2141!
2142! Add field export state.
2143!
2144 CALL nuopc_realize (models(iatmos)%ExportState(ng), &
2145 & field=field, &
2146 & rc=rc)
2147 IF (esmf_logfounderror(rctocheck=rc, &
2148 & msg=esmf_logerr_passthru, &
2149 & line=__line__, &
2150 & file=myfile)) THEN
2151 RETURN
2152 END IF
2153!
2154! Remove field from export state because it is not connected.
2155!
2156 ELSE
2157 IF (localpet.eq.0) THEN
2158 WRITE (cplout,10) trim(exportnamelist(i)), &
2159 & 'Export State: ', &
2160 & trim(coupled(iatmos)%ExpLabel(ng))
2161 END IF
2162 CALL esmf_stateremove (models(iatmos)%ExportState(ng), &
2163 & (/ trim(exportnamelist(i)) /), &
2164 & rc=rc)
2165 IF (esmf_logfounderror(rctocheck=rc, &
2166 & msg=esmf_logerr_passthru, &
2167 & line=__line__, &
2168 & file=myfile)) THEN
2169 RETURN
2170 END IF
2171 END IF
2172 END DO
2173!
2174! Deallocate arrays.
2175!
2176 IF ( allocated(exportnamelist) ) deallocate (exportnamelist)
2177!
2178 END IF exporting
2179!
2180!-----------------------------------------------------------------------
2181! Add import fields into import state.
2182!-----------------------------------------------------------------------
2183!
2184 importing : IF (nimport(iatmos).gt.0) THEN
2185!
2186! Get number of fields to import.
2187!
2188 CALL esmf_stateget (models(iatmos)%ImportState(ng), &
2189 & itemcount=importcount, &
2190 & rc=rc)
2191 IF (esmf_logfounderror(rctocheck=rc, &
2192 & msg=esmf_logerr_passthru, &
2193 & line=__line__, &
2194 & file=myfile)) THEN
2195 RETURN
2196 END IF
2197!
2198! Get a list of import fields names.
2199!
2200 IF (.not.allocated(importnamelist)) THEN
2201 allocate (importnamelist(importcount))
2202 END IF
2203 CALL esmf_stateget (models(iatmos)%ImportState(ng), &
2204 & itemnamelist=importnamelist, &
2205 & rc=rc)
2206 IF (esmf_logfounderror(rctocheck=rc, &
2207 & msg=esmf_logerr_passthru, &
2208 & line=__line__, &
2209 & file=myfile)) THEN
2210 RETURN
2211 END IF
2212!
2213! Set import field(s).
2214!
2215 DO i=1,importcount
2216 id=field_index(models(iatmos)%ImportField, importnamelist(i))
2217!
2218 IF (nuopc_isconnected(models(iatmos)%ImportState(ng), &
2219 & fieldname=trim(importnamelist(i)), &
2220 & rc=rc)) THEN
2221!
2222! Set staggering type.
2223!
2224 SELECT CASE (models(iatmos)%ImportField(id)%gtype)
2225 CASE (icenter)
2226 staggerloc=esmf_staggerloc_center
2227 CASE (icorner)
2228 staggerloc=esmf_staggerloc_corner
2229 CASE (iupoint)
2230 staggerloc=esmf_staggerloc_edge1
2231 CASE (ivpoint)
2232 staggerloc=esmf_staggerloc_edge2
2233 END SELECT
2234!
2235! Create 2D field from the Grid, arraySpec.
2236!
2237 field=esmf_fieldcreate(models(iatmos)%grid(ng), &
2238 & arrayspec2d, &
2239 & indexflag=esmf_index_global, &
2240 & staggerloc=staggerloc, &
2241 & totallwidth=halolw, &
2242 & totaluwidth=halouw, &
2243 & name=trim(importnamelist(i)), &
2244 & rc=rc)
2245 IF (esmf_logfounderror(rctocheck=rc, &
2246 & msg=esmf_logerr_passthru, &
2247 & line=__line__, &
2248 & file=myfile)) THEN
2249 RETURN
2250 END IF
2251!
2252! Put data into state. Usually, the DO-loop is executed once since
2253! localDEcount=1.
2254!
2255 DO localde=0,localdecount-1
2256!
2257! Get pointer to DE-local memory allocation within field.
2258!
2259 CALL esmf_fieldget (field, &
2260 & localde=localde, &
2261 & farrayptr=ptr2d, &
2262 & rc=rc)
2263 IF (esmf_logfounderror(rctocheck=rc, &
2264 & msg=esmf_logerr_passthru, &
2265 & line=__line__, &
2266 & file=myfile)) THEN
2267 RETURN
2268 END IF
2269!
2270! Initialize pointer.
2271!
2272 ptr2d=missing_dp
2273!
2274! Nullify pointer to make sure that it does not point on a random
2275! part in the memory.
2276!
2277 IF (associated(ptr2d)) nullify (ptr2d)
2278 END DO
2279!
2280! Add field import state.
2281!
2282 CALL nuopc_realize (models(iatmos)%ImportState(ng), &
2283 & field=field, &
2284 & rc=rc)
2285 IF (esmf_logfounderror(rctocheck=rc, &
2286 & msg=esmf_logerr_passthru, &
2287 & line=__line__, &
2288 & file=myfile)) THEN
2289 RETURN
2290 END IF
2291!
2292! Remove field from import state because it is not connected.
2293!
2294 ELSE
2295 IF (localpet.eq.0) THEN
2296 WRITE (cplout,10) trim(importnamelist(i)), &
2297 & 'Import State: ', &
2298 & trim(coupled(iatmos)%ImpLabel(ng))
2299 END IF
2300 CALL esmf_stateremove (models(iatmos)%ImportState(ng), &
2301 & (/ trim(importnamelist(i)) /), &
2302 & rc=rc)
2303 IF (esmf_logfounderror(rctocheck=rc, &
2304 & msg=esmf_logerr_passthru, &
2305 & line=__line__, &
2306 & file=myfile)) THEN
2307 RETURN
2308 END IF
2309 END IF
2310 END DO
2311!
2312! Deallocate arrays.
2313!
2314 IF (allocated(importnamelist)) deallocate (importnamelist)
2315!
2316 END IF importing
2317!
2318 IF (esm_track) THEN
2319 WRITE (trac,'(a,a,i0)') '<== Exiting COAMPS_SetStates', &
2320 & ', PET', petrank
2321 FLUSH (trac)
2322 END IF
2323!
2324!
2325 10 FORMAT ('COAMPS_SetStates - Removing field ''',a,''' from ',a, &
2326 & '''',a,'''',/,19x,'because it is not connected.')
2327!
2328 RETURN
2329 END SUBROUTINE coamps_setstates
2330!
2331 SUBROUTINE coamps_modeladvance (model, rc)
2332!
2333!=======================================================================
2334! !
2335! Advance COAMPS component for a coupling interval (seconds) using !
2336! "COAMPS_Run". It also calls "COAMPS_Import" and "COAMPS_Export" to !
2337! import and export coupling fields, respectively. !
2338! !
2339!=======================================================================
2340!
2341 USE coamnl_mod, ONLY : delta ! timestep in seconds
2342!
2343! Imported variable declarations.
2344!
2345 integer, intent(out) :: rc
2346!
2347 TYPE (esmf_gridcomp) :: model
2348!
2349! Local variable declarations.
2350!
2351 logical :: ladvance, ltau_0
2352!
2353 integer :: is, ng
2354 integer :: localpet, petcount, phase
2355 integer :: nstrstep, nendstep, stepcount
2356!
2357 real (dp) :: couplinginterval, secondssincestart
2358 real (dp) :: tcurrentinseconds, tstopinseconds
2359!
2360 character (len=22) :: cinterval
2361 character (len=22) :: currtimestring, stoptimestring
2362
2363 character (len=*), parameter :: myfile = &
2364 & __FILE__//", COAMPS_SetModelAdvance"
2365!
2366 TYPE (esmf_clock) :: clock
2367 TYPE (esmf_state) :: exportstate, importstate
2368 TYPE (esmf_timeinterval) :: timestep
2369 TYPE (esmf_time) :: referencetime
2370 TYPE (esmf_time) :: currenttime, starttime, stoptime
2371 TYPE (esmf_vm) :: vm
2372!
2373!-----------------------------------------------------------------------
2374! Initialize return code flag to success state (no error).
2375!-----------------------------------------------------------------------
2376!
2377 IF (esm_track) THEN
2378 WRITE (trac,'(a,a,i0)') '==> Entering COAMPS_ModelAdvance', &
2379 & ', PET', petrank
2380 FLUSH (trac)
2381 END IF
2382 rc=esmf_success
2383!
2384!-----------------------------------------------------------------------
2385! Get information about the gridded component.
2386!-----------------------------------------------------------------------
2387!
2388! Inquire about COAMPS component.
2389!
2390 CALL esmf_gridcompget (model, &
2391 & importstate=importstate, &
2392 & exportstate=exportstate, &
2393 & clock=clock, &
2394 & localpet=localpet, &
2395 & petcount=petcount, &
2396 & currentphase=phase, &
2397 & vm=vm, &
2398 & rc=rc)
2399 IF (esmf_logfounderror(rctocheck=rc, &
2400 & msg=esmf_logerr_passthru, &
2401 & line=__line__, &
2402 & file=myfile)) THEN
2403 RETURN
2404 END IF
2405!
2406! Get time step interval, stopping time, reference time, and current
2407! time.
2408!
2409 CALL esmf_clockget (clock, &
2410 & timestep=timestep, &
2411 & stoptime=stoptime, &
2412 & reftime=referencetime, &
2413 & currtime=clockinfo(iatmos)%CurrentTime, &
2414 & rc=rc)
2415 IF (esmf_logfounderror(rctocheck=rc, &
2416 & msg=esmf_logerr_passthru, &
2417 & line=__line__, &
2418 & file=myfile)) THEN
2419 RETURN
2420 END IF
2421!
2422! Current COAMPS time (seconds).
2423!
2424 CALL esmf_timeget (clockinfo(iatmos)%CurrentTime, &
2425 & s_r8=tcurrentinseconds, &
2426 & timestringisofrac=currtimestring, &
2427 & rc=rc)
2428 IF (esmf_logfounderror(rctocheck=rc, &
2429 & msg=esmf_logerr_passthru, &
2430 & line=__line__, &
2431 & file=myfile)) THEN
2432 RETURN
2433 END IF
2434 is=index(currtimestring, 'T') ! remove 'T' in
2435 IF (is.gt.0) currtimestring(is:is)=' ' ! ISO 8601 format
2436!
2437! COAMPS stop time (seconds) for this coupling window.
2438!
2439 CALL esmf_timeget (clockinfo(iatmos)%CurrentTime+timestep, &
2440 & s_r8=tstopinseconds, &
2441 & timestringisofrac=stoptimestring, &
2442 & rc=rc)
2443 IF (esmf_logfounderror(rctocheck=rc, &
2444 & msg=esmf_logerr_passthru, &
2445 & line=__line__, &
2446 & file=myfile)) THEN
2447 RETURN
2448 END IF
2449 is=index(stoptimestring, 'T') ! remove 'T' in
2450 IF (is.gt.0) stoptimestring(is:is)=' ' ! ISO 8601 form
2451!
2452! Get coupling time interval (seconds, double precision).
2453!
2454 CALL esmf_timeintervalget (timestep, &
2455 & s_r8=couplinginterval, &
2456 & rc=rc)
2457 IF (esmf_logfounderror(rctocheck=rc, &
2458 & msg=esmf_logerr_passthru, &
2459 & line=__line__, &
2460 & file=myfile)) THEN
2461 RETURN
2462 END IF
2463!
2464!-----------------------------------------------------------------------
2465! Calculate run time for the current coupling window.
2466!-----------------------------------------------------------------------
2467!
2468! Get elapsed time in seconds since start.
2469!
2470 IF (clockinfo(idriver)%Restarted) THEN
2471 secondssincestart=tcurrentinseconds- &
2472 & clockinfo(iatmos)%Time_Restart
2473 ELSE
2474 secondssincestart=tcurrentinseconds- &
2475 & clockinfo(iatmos)%Time_Start
2476 END IF
2477!
2478! Set number of COAMPS timesteps to run.
2479!
2480 nstrstep=int((secondssincestart+0.001_dp)/delta)+1
2481 nendstep=int(secondssincestart+couplinginterval+0.001_dp)/delta
2482 stepcount=nendstep-nstrstep+1
2483
2484# ifdef REGRESS_STARTCLOCK
2485!
2486! If regressed driver starting clock, avoid timestepping COAMPS during
2487! the regressed coupling interval.
2488!
2489 IF (tcurrentinseconds.gt.clockinfo(idriver)%Time_Start) THEN
2490 ladvance=.true.
2491 ELSE
2492 ladvance=.false.
2493 END IF
2494# else
2495!
2496! Set model advance switch.
2497!
2498 ladvance=.true.
2499# endif
2500!
2501!-----------------------------------------------------------------------
2502! Report time information strings (YYYY-MM-DD hh:mm:ss).
2503!-----------------------------------------------------------------------
2504!
2505 IF (localpet.eq.0) THEN
2506 WRITE (cinterval,'(f15.2)') couplinginterval
2507 WRITE (cplout,10) trim(currtimestring), trim(stoptimestring), &
2508 & trim(adjustl(cinterval)), ladvance
2509 END IF
2510!
2511!-----------------------------------------------------------------------
2512! Get import fields from other ESM components.
2513!-----------------------------------------------------------------------
2514!
2515 IF (nimport(iatmos).gt.0) THEN
2516 DO ng=1,models(iatmos)%Ngrids
2517 IF (any(coupled(iatmos)%LinkedGrid(ng,:))) THEN
2518 CALL coamps_import (ng, model, rc=rc)
2519 IF (esmf_logfounderror(rctocheck=rc, &
2520 & msg=esmf_logerr_passthru, &
2521 & line=__line__, &
2522 & file=myfile)) THEN
2523 RETURN
2524 END IF
2525 END IF
2526 END DO
2527 END IF
2528!
2529!-----------------------------------------------------------------------
2530! Run COAMPS component. Notice that atmosphere component is advanced
2531! when ng=1. In nested application, its numerical kernel will advance
2532! all the nested grids in their logical order.
2533!-----------------------------------------------------------------------
2534!
2535 IF (ladvance) THEN
2536 ltau_0=.false.
2537 IF (esm_track) THEN
2538 WRITE (trac,'(a,a,i0)') '==> Entering COAMPS_Run', &
2539 & ', PET', petrank
2540 FLUSH (trac)
2541 END IF
2542 CALL coamps_run (ltau_0, stepcount)
2543 IF (esm_track) THEN
2544 WRITE (trac,'(a,a,i0)') '==> Exiting COAMPS_Run', &
2545 & ', PET', petrank
2546 FLUSH (trac)
2547 END IF
2548 END IF
2549!
2550!-----------------------------------------------------------------------
2551! Put export fields.
2552!-----------------------------------------------------------------------
2553!
2554 IF (nexport(iatmos).gt.0) THEN
2555 DO ng=1,models(iatmos)%Ngrids
2556 IF (any(coupled(iatmos)%LinkedGrid(ng,:))) THEN
2557 CALL coamps_export (ng, model, rc=rc)
2558 IF (esmf_logfounderror(rctocheck=rc, &
2559 & msg=esmf_logerr_passthru, &
2560 & line=__line__, &
2561 & file=myfile)) THEN
2562 RETURN
2563 END IF
2564 END IF
2565 END DO
2566 END IF
2567!
2568 IF (esm_track) THEN
2569 WRITE (trac,'(a,a,i0)') '<== Exiting COAMPS_ModelAdvance', &
2570 & ', PET', petrank
2571 FLUSH (trac)
2572 END IF
2573!
2574 10 FORMAT (3x,'ModelAdvance - ESMF, Running COAMPS:',t42,a, &
2575 & ' => ',a,', [',a,' s], Advance: ',l1)
2576!
2577 RETURN
2578 END SUBROUTINE coamps_modeladvance
2579!
2580 SUBROUTINE coamps_setfinalize (model, &
2581 & ImportState, ExportState, &
2582 & clock, rc)
2583!
2584!=======================================================================
2585! !
2586! Finalize COAMPS component execution. It calls COAMPS_Finalize. !
2587! !
2588!=======================================================================
2589!
2590! Imported variable declarations.
2591!
2592 integer, intent(out) :: rc
2593!
2594 TYPE (esmf_clock) :: clock
2595 TYPE (esmf_gridcomp) :: model
2596 TYPE (esmf_state) :: exportstate
2597 TYPE (esmf_state) :: importstate
2598!
2599! Local variable declarations.
2600!
2601 character (len=*), parameter :: myfile = &
2602 & __FILE__//", COAMPS_SetFinalize"
2603!
2604!-----------------------------------------------------------------------
2605! Initialize return code flag to success state (no error).
2606!-----------------------------------------------------------------------
2607!
2608 IF (esm_track) THEN
2609 WRITE (trac,'(a,a,i0)') '==> Entering COAMPS_SetFinalize', &
2610 & ', PET', petrank
2611 FLUSH (trac)
2612 END IF
2613 rc=esmf_success
2614!
2615!-----------------------------------------------------------------------
2616! Finalize COAMPS component.
2617!-----------------------------------------------------------------------
2618!
2619 CALL coamps_finalize ()
2620 FLUSH (6) ! flush standard output buffer
2621!
2622 IF (esm_track) THEN
2623 WRITE (trac,'(a,a,i0)') '<== Exiting COAMPS_SetFinalize', &
2624 & ', PET', petrank
2625 FLUSH (trac)
2626 END IF
2627!
2628 RETURN
2629 END SUBROUTINE coamps_setfinalize
2630!
2631 SUBROUTINE coamps_import (ng, model, rc)
2632!
2633!=======================================================================
2634! !
2635! Imports fields into COAMPS array structure from other coupled !
2636! gridded components. !
2637! !
2638!=======================================================================
2639!
2640 USE coamm_memm, ONLY : adom
2641 USE domdec, ONLY : iminf, imaxf, jminf, jmaxf, &
2642 & ndom, nlimx, nlimy
2643!
2644! Imported variable declarations.
2645!
2646 integer, intent(in) :: ng
2647 integer, intent(out) :: rc
2648!
2649 TYPE (esmf_gridcomp) :: model
2650!
2651! Local variable declarations.
2652!
2653 logical :: got_sst(2)
2654!
2655 integer :: id, ifld, i, is, j
2656 integer :: year, month, day, hour, minutes, seconds, sn, sd
2657 integer :: seaice, seawater
2658 integer :: importcount
2659 integer :: localde, localdecount, localpet, petcount
2660 integer :: lbi, ubi, lbj, ubj
2661 integer :: iminp, imaxp, jminp, jmaxp
2662 integer :: ifield(2)
2663!
2664 real (dp) :: fseconds, timeindays, time_current
2665
2666 real (dp) :: myfmax(2), myfmin(2), fmin(2), fmax(2), fval
2667 real (dp) :: scale, add_offset
2668!
2669 real (dp), pointer :: ptr2d(:,:)
2670!
2671 real (dp), allocatable :: dat_sst(:,:), ocn_sst(:,:)
2672!
2673 character (len=22 ) :: time_currentstring
2674
2675 character (len=*), parameter :: myfile = &
2676 & __FILE__//", COAMPS_Import"
2677!
2678 character (ESMF_MAXSTR) :: fieldname, fld_name(2)
2679 character (ESMF_MAXSTR) :: cname, ofile
2680 character (ESMF_MAXSTR), allocatable :: importnamelist(:)
2681!
2682 TYPE (esmf_clock) :: clock
2683 TYPE (esmf_field) :: field
2684 TYPE (esmf_state) :: importstate
2685 TYPE (esmf_time) :: currenttime
2686 TYPE (esmf_vm) :: vm
2687!
2688!-----------------------------------------------------------------------
2689! Initialize return code flag to success state (no error).
2690!-----------------------------------------------------------------------
2691!
2692 IF (esm_track) THEN
2693 WRITE (trac,'(a,a,i0)') '==> Entering COAMPS_Import', &
2694 & ', PET', petrank
2695 FLUSH (trac)
2696 END IF
2697 rc=esmf_success
2698!
2699!-----------------------------------------------------------------------
2700! Compute COAMPS lower and upper bounds (non-overlapping) for physical
2701! area per nested grid and tile.
2702!-----------------------------------------------------------------------
2703!
2704 iminp=nlimx(ng)%bp(ndom)
2705 imaxp=nlimx(ng)%ep(ndom)
2706 jminp=nlimy(ng)%bp(ndom)
2707 jmaxp=nlimy(ng)%ep(ndom)
2708!
2709!-----------------------------------------------------------------------
2710! Get information about the gridded component.
2711!-----------------------------------------------------------------------
2712!
2713 CALL esmf_gridcompget (model, &
2714 & importstate=importstate, &
2715 & clock=clock, &
2716 & localpet=localpet, &
2717 & petcount=petcount, &
2718 & vm=vm, &
2719 & name=cname, &
2720 & rc=rc)
2721 IF (esmf_logfounderror(rctocheck=rc, &
2722 & msg=esmf_logerr_passthru, &
2723 & line=__line__, &
2724 & file=myfile)) THEN
2725 RETURN
2726 END IF
2727!
2728! Get number of local decomposition elements (DEs). Usually, a single
2729! DE is associated with each Persistent Execution Thread (PETs). Thus,
2730! localDEcount=1.
2731!
2732 CALL esmf_gridget (models(iatmos)%grid(ng), &
2733 & localdecount=localdecount, &
2734 & rc=rc)
2735 IF (esmf_logfounderror(rctocheck=rc, &
2736 & msg=esmf_logerr_passthru, &
2737 & line=__line__, &
2738 & file=myfile)) THEN
2739 RETURN
2740 END IF
2741!
2742!-----------------------------------------------------------------------
2743! Get current time.
2744!-----------------------------------------------------------------------
2745!
2746 CALL esmf_clockget (clock, &
2747 & currtime=currenttime, &
2748 & rc=rc)
2749 IF (esmf_logfounderror(rctocheck=rc, &
2750 & msg=esmf_logerr_passthru, &
2751 & line=__line__, &
2752 & file=myfile)) THEN
2753 RETURN
2754 END IF
2755!
2756 CALL esmf_timeget (currenttime, &
2757 & yy=year, &
2758 & mm=month, &
2759 & dd=day, &
2760 & h =hour, &
2761 & m =minutes, &
2762 & s =seconds, &
2763 & sn=sn, &
2764 & sd=sd, &
2765 & rc=rc)
2766 IF (esmf_logfounderror(rctocheck=rc, &
2767 & msg=esmf_logerr_passthru, &
2768 & line=__line__, &
2769 & file=myfile)) THEN
2770 RETURN
2771 END IF
2772!
2773 CALL esmf_timeget (currenttime, &
2774 & s_r8=time_current, &
2775 & timestring=time_currentstring, &
2776 & rc=rc)
2777 IF (esmf_logfounderror(rctocheck=rc, &
2778 & msg=esmf_logerr_passthru, &
2779 & line=__line__, &
2780 & file=myfile)) THEN
2781 RETURN
2782 END IF
2783 fseconds=real(seconds,dp)+real(sn,dp)/real(sd,dp)
2784 timeindays=time_current/86400.0_dp
2785 is=index(time_currentstring, 'T') ! remove 'T' in
2786 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
2787!
2788!-----------------------------------------------------------------------
2789! Get list of import fields.
2790!-----------------------------------------------------------------------
2791!
2792 CALL esmf_stateget (models(iatmos)%ImportState(ng), &
2793 & itemcount=importcount, &
2794 & rc=rc)
2795 IF (esmf_logfounderror(rctocheck=rc, &
2796 & msg=esmf_logerr_passthru, &
2797 & line=__line__, &
2798 & file=myfile)) THEN
2799 RETURN
2800 END IF
2801!
2802 IF (.not.allocated(importnamelist)) THEN
2803 allocate ( importnamelist(importcount) )
2804 END IF
2805 CALL esmf_stateget (models(iatmos)%ImportState(ng), &
2806 & itemnamelist=importnamelist, &
2807 & rc=rc)
2808 IF (esmf_logfounderror(rctocheck=rc, &
2809 & msg=esmf_logerr_passthru, &
2810 & line=__line__, &
2811 & file=myfile)) THEN
2812 RETURN
2813 END IF
2814!
2815!-----------------------------------------------------------------------
2816! Get import fields.
2817!-----------------------------------------------------------------------
2818!
2819! If the regridding includes an extrapolation option to fill unmapped
2820! grid cells due to incongruents ESM grids, the land/sea mask arras
2821! are used to load only the needed data.
2822!
2823 seawater=0 ! COAMPS sea water mask value
2824 seaice=2 ! COAMPS sea ice mask value
2825!
2826 got_sst(1)=.false. ! SST from OCN component
2827 got_sst(2)=.false. ! SST from DATA component
2828 ifield(1)=0 ! SST from OCN index
2829 ifield(2)=0 ! SST from DATA index
2830!
2831 fld_loop : DO ifld=1,importcount
2832 id=field_index(models(iatmos)%ImportField, importnamelist(ifld))
2833!
2834! Get field from import state.
2835!
2836 CALL esmf_stateget (models(iatmos)%ImportState(ng), &
2837 & trim(importnamelist(ifld)), &
2838 & field, &
2839 & rc=rc)
2840 IF (esmf_logfounderror(rctocheck=rc, &
2841 & msg=esmf_logerr_passthru, &
2842 & line=__line__, &
2843 & file=myfile)) THEN
2844 RETURN
2845 END IF
2846!
2847! Get field pointer. Usually, the DO-loop is executed once since
2848! localDEcount=1.
2849!
2850 de_loop : DO localde=0,localdecount-1
2851 CALL esmf_fieldget (field, &
2852 & localde=localde, &
2853 & farrayptr=ptr2d, &
2854 & rc=rc)
2855 IF (esmf_logfounderror(rctocheck=rc, &
2856 & msg=esmf_logerr_passthru, &
2857 & line=__line__, &
2858 & file=myfile)) THEN
2859 RETURN
2860 END IF
2861 lbi=lbound(ptr2d,1)
2862 ubi=ubound(ptr2d,1)
2863 lbj=lbound(ptr2d,2)
2864 ubj=ubound(ptr2d,2)
2865!
2866! Initialize import field parameters. Set "scale" and "add_offset"
2867! values need to convert imported fields to COAMPS requirements.
2868!
2869 scale =models(iatmos)%ImportField(id)%scale_factor
2870 add_offset=models(iatmos)%ImportField(id)%add_offset
2871!
2872 myfmin= missing_dp
2873 myfmax=-missing_dp
2874!
2875! Load import data into COAMPS component variable.
2876!
2877 fieldname=adjustl(importnamelist(ifld))
2878!
2879 SELECT CASE (trim(fieldname))
2880!
2881! Sea surface temperature from OCN component (C).
2882!
2883 CASE ('sst', 'SST')
2884 IF (.not.allocated(ocn_sst)) THEN
2885 allocate ( ocn_sst(lbi:ubi,lbj:ubj) )
2886 ocn_sst=missing_dp
2887 END IF
2888 IF (.not.allocated(dat_sst)) THEN
2889 allocate ( dat_sst(lbi:ubi,lbj:ubj) )
2890 dat_sst=missing_dp
2891 END IF
2892 got_sst(1)=.true.
2893 ifield(1)=id
2894 fld_name(1)=trim(fieldname)
2895 DO j=jminp,jmaxp
2896 DO i=iminp,imaxp
2897 IF (((nint(adom(ng)%xland(i,j)).eq.seawater).or. &
2898 & (nint(adom(ng)%xland(i,j)).eq.seaice)).and. &
2899 & (abs(ptr2d(i,j)).lt.tol_dp)) THEN
2900 myfmin(1)=min(myfmin(1),ptr2d(i,j))
2901 myfmax(1)=max(myfmax(1),ptr2d(i,j))
2902 fval=scale*ptr2d(i,j)+add_offset
2903 myfmin(2)=min(myfmin(2),fval)
2904 myfmax(2)=max(myfmax(2),fval)
2905 ocn_sst(i,j)=fval
2906 END IF
2907 END DO
2908 END DO
2909!
2910! Sea surface temperature from DATA component (C). It is used to
2911! fill values in cells not covered by the OCN component.
2912!
2913 CASE ('dsst', 'dSST')
2914 IF (.not.allocated(ocn_sst)) THEN
2915 allocate ( ocn_sst(lbi:ubi,lbj:ubj) )
2916 ocn_sst=missing_dp
2917 END IF
2918 IF (.not.allocated(dat_sst)) THEN
2919 allocate ( dat_sst(lbi:ubi,lbj:ubj) )
2920 dat_sst=missing_dp
2921 END IF
2922 got_sst(2)=.true.
2923 ifield(2)=id
2924 fld_name(2)=trim(fieldname)
2925 DO j=jminp,jmaxp
2926 DO i=iminp,imaxp
2927 IF (((nint(adom(ng)%xland(i,j)).eq.seawater).or. &
2928 & (nint(adom(ng)%xland(i,j)).eq.seaice)).and. &
2929 & (abs(ptr2d(i,j)).lt.tol_dp)) THEN
2930 myfmin(1)=min(myfmin(1),ptr2d(i,j))
2931 myfmax(1)=max(myfmax(1),ptr2d(i,j))
2932 fval=scale*ptr2d(i,j)+add_offset
2933 myfmin(2)=min(myfmin(2),fval)
2934 myfmax(2)=max(myfmax(2),fval)
2935 dat_sst(i,j)=fval
2936 END IF
2937 END DO
2938 END DO
2939!
2940! Wave-induced Charnock parameter.
2941!
2942 CASE ('charno', 'Charnock')
2943 DO j=jminp,jmaxp
2944 DO i=iminp,imaxp
2945 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
2946 fval=scale*ptr2d(i,j)+add_offset
2947 ELSE
2948 fval=0.0_dp
2949 END IF
2950 myfmin(1)=min(myfmin(1),ptr2d(i,j))
2951 myfmax(1)=max(myfmax(1),ptr2d(i,j))
2952 myfmin(2)=min(myfmin(2),fval)
2953 myfmax(2)=max(myfmax(2),fval)
2954 adom(ng)%charnock(i,j)=fval
2955 END DO
2956 END DO
2957!
2958! Surface, wave-induced eastward stress.
2959!
2960 CASE ('Wustr')
2961 DO j=jminp,jmaxp
2962 DO i=iminp,imaxp
2963 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
2964 fval=scale*ptr2d(i,j)+add_offset
2965 ELSE
2966 fval=0.0_dp
2967 END IF
2968 myfmin(1)=min(myfmin(1),ptr2d(i,j))
2969 myfmax(1)=max(myfmax(1),ptr2d(i,j))
2970 myfmin(2)=min(myfmin(2),fval)
2971 myfmax(2)=max(myfmax(2),fval)
2972 adom(ng)%wvsu(i,j)=fval
2973 END DO
2974 END DO
2975!
2976! Surface, wave-induced eastward stress.
2977!
2978 CASE ('Wvstr')
2979 DO j=jminp,jmaxp
2980 DO i=iminp,imaxp
2981 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
2982 fval=scale*ptr2d(i,j)+add_offset
2983 ELSE
2984 fval=0.0_dp
2985 END IF
2986 myfmin(1)=min(myfmin(1),ptr2d(i,j))
2987 myfmax(1)=max(myfmax(1),ptr2d(i,j))
2988 myfmin(2)=min(myfmin(2),fval)
2989 myfmax(2)=max(myfmax(2),fval)
2990 adom(ng)%wvsv(i,j)=fval
2991 END DO
2992 END DO
2993!
2994! Surface, wave-induced stress magnitude.
2995!
2996 CASE ('Wstr')
2997 DO j=jminp,jmaxp
2998 DO i=iminp,imaxp
2999 IF (abs(ptr2d(i,j)).lt.tol_dp) THEN
3000 fval=scale*ptr2d(i,j)+add_offset
3001 ELSE
3002 fval=0.0_dp
3003 END IF
3004 myfmin(1)=min(myfmin(1),ptr2d(i,j))
3005 myfmax(1)=max(myfmax(1),ptr2d(i,j))
3006 myfmin(2)=min(myfmin(2),fval)
3007 myfmax(2)=max(myfmax(2),fval)
3008 adom(ng)%wvst(i,j)=fval
3009 END DO
3010 END DO
3011!
3012! Import field not found.
3013!
3014 CASE DEFAULT
3015 IF (localpet.eq.0) THEN
3016 WRITE (cplout,10) trim(importnamelist(ifld)), &
3017 & trim(cinpname)
3018 END IF
3019 rc=esmf_rc_not_found
3020 IF (esmf_logfounderror(rctocheck=rc, &
3021 & msg=esmf_logerr_passthru, &
3022 & line=__line__, &
3023 & file=myfile)) THEN
3024 RETURN
3025 END IF
3026 END SELECT
3027!
3028! Nullify pointer to make sure that it does not point on a random
3029! part in the memory.
3030!
3031 IF (associated(ptr2d)) nullify (ptr2d)
3032 END DO de_loop
3033!
3034! Get import field minimun and maximum values.
3035!
3036 CALL esmf_vmallreduce (vm, &
3037 & senddata=myfmin, &
3038 & recvdata=fmin, &
3039 & count=2, &
3040 & reduceflag=esmf_reduce_min, &
3041 & rc=rc)
3042 IF (esmf_logfounderror(rctocheck=rc, &
3043 & msg=esmf_logerr_passthru, &
3044 & line=__line__, &
3045 & file=myfile)) THEN
3046 RETURN
3047 END IF
3048!
3049 CALL esmf_vmallreduce (vm, &
3050 & senddata=myfmax, &
3051 & recvdata=fmax, &
3052 & count=2, &
3053 & reduceflag=esmf_reduce_max, &
3054 & rc=rc)
3055 IF (esmf_logfounderror(rctocheck=rc, &
3056 & msg=esmf_logerr_passthru, &
3057 & line=__line__, &
3058 & file=myfile)) THEN
3059 RETURN
3060 END IF
3061!
3062! Report import field information.
3063!
3064 IF ((debuglevel.ge.0).and.(localpet.eq.0)) THEN
3065 WRITE (cplout,20) trim(importnamelist(ifld)), &
3066 & trim(time_currentstring), ng, &
3067 & fmin(1), fmax(1)
3068 IF (scale.ne.1.0_dp) THEN
3069 WRITE (cplout,30) fmin(2), fmax(2), &
3070 & ' coampsScale = ', scale
3071 ELSE IF (add_offset.ne.0.0_dp) THEN
3072 WRITE (cplout,30) fmin(2), fmax(2), &
3073 & ' AddOffset = ', add_offset
3074 END IF
3075 END IF
3076!
3077! Debugging: write out import field into a NetCDF file.
3078!
3079 IF ((debuglevel.ge.3).and. &
3080 & models(iatmos)%ImportField(id)%debug_write) THEN
3081 WRITE (ofile,40) ng, trim(importnamelist(ifld)), &
3082 & year, month, day, hour, minutes, seconds
3083 CALL esmf_fieldwrite (field, &
3084 & trim(ofile), &
3085 & overwrite=.true., &
3086 & rc=rc)
3087 IF (esmf_logfounderror(rctocheck=rc, &
3088 & msg=esmf_logerr_passthru, &
3089 & line=__line__, &
3090 & file=myfile)) THEN
3091 RETURN
3092 END IF
3093 END IF
3094 END DO fld_loop
3095!
3096! Load or merge sea surface temperature into COAMPS structure variable:
3097! adom(ng)%tsea
3098!
3099 IF (any(got_sst)) THEN
3100 CALL coamps_processimport (ng, model, &
3101 & got_sst, ifield, fld_name, &
3102 & lbi, ubi, lbj, ubj, &
3103 & ocn_sst, dat_sst, &
3104 & rc)
3105 IF (esmf_logfounderror(rctocheck=rc, &
3106 & msg=esmf_logerr_passthru, &
3107 & line=__line__, &
3108 & file=myfile)) THEN
3109 RETURN
3110 END IF
3111 END IF
3112!
3113! Deallocate local arrays.
3114!
3115 IF (allocated(importnamelist)) deallocate (importnamelist)
3116 IF (allocated(ocn_sst)) deallocate (ocn_sst)
3117 IF (allocated(dat_sst)) deallocate (dat_sst)
3118!
3119! Update COAMPS import calls counter.
3120!
3121 IF (importcount.gt.0) THEN
3122 models(iatmos)%ImportCalls=models(iatmos)%ImportCalls+1
3123 END IF
3124!
3125 IF (esm_track) THEN
3126 WRITE (trac,'(a,a,i0)') '<== Exiting COAMPS_Import', &
3127 & ', PET', petrank
3128 FLUSH (trac)
3129 END IF
3130 IF (debuglevel.gt.0) FLUSH (cplout)
3131!
3132 10 FORMAT (/,2x,'COAMPS_Import - unable to find option to import: ', &
3133 & a,/,18x,'check ''Import(atmos)'' in input script: ', a)
3134 20 FORMAT (2x,'COAMPS_Import - ESMF: importing field ''',a,'''', &
3135 & t72,a,2x,'Grid ',i2.2,/, &
3136 & 19x,'(InpMin = ', 1p,e15.8,0p,' InpMax = ',1p,e15.8,0p, &
3137 & ')')
3138 30 FORMAT (19x,'(OutMin = ', 1p,e15.8,0p,' OutMax = ',1p,e15.8,0p, &
3139 & 1x,a,1p,e15.8,0p,')')
3140 40 FORMAT ('coamps_',i2.2,'_import_',a,'_',i4.4,2('-',i2.2),'_', &
3141 & i2.2,2('.',i2.2),'.nc')
3142
3143 RETURN
3144 END SUBROUTINE coamps_import
3145!
3146 SUBROUTINE coamps_processimport (ng, model, &
3147 & got, ifield, FieldName, &
3148 & LBi, UBi, LBj, UBj, Focn, Fdat, &
3149 & rc)
3150!
3151!=======================================================================
3152! !
3153! If both import fields Focn and Fdat are avaliable, it merges !
3154! its values. Otherwise, it loads available data into ouput field, !
3155! Fout. Only sea-water or sea-ice points are processed. It is !
3156! used when atmosphere and ocean grids are incongruent. The DATA !
3157! component provides values on those grid points not covered by !
3158! the OCEAN component. !
3159! !
3160! On Input: !
3161! !
3162! ng Nested grid number (integer) !
3163! model Gridded component object (TYPE ESMF_GridComp) !
3164! got Switches indicating source and availability of !
3165! import data (logical vector): !
3166! got(1) OCEAN component switch (T/F) !
3167! got(2) DATA component switch (T/F) !
3168! ifield Import field index (integer vector) !
3169! ifield(1) OCEAN component field index !
3170! ifield(2) DATA component field index !
3171! FieldName Field short name (string array) !
3172! LBi I-dimension lower bound (integer) !
3173! UBi I-dimension upper bound (integer) !
3174! LBj J-dimension lower bound (integer) !
3175! UBj J-dimension upper bound (integer) !
3176! Focn Import field from ocean component (2D real array) !
3177! Fdat Import field from data component (2D real array) !
3178! !
3179! On Output: !
3180! !
3181! rc Return code (integer) !
3182! !
3183!=======================================================================
3184!
3185 USE coamm_memm, ONLY : adom
3186 USE domdec, ONLY : iminf, imaxf, jminf, jmaxf, &
3187 & ndom, nlimx, nlimy
3188 USE strings_mod, ONLY : lowercase
3189!
3190! Imported variable declarations.
3191!
3192 logical, intent(in) :: got(2)
3193!
3194 integer, intent(in) :: ng, ifield(2)
3195 integer, intent(in) :: lbi, ubi, lbj, ubj
3196 integer, intent(out) :: rc
3197!
3198 real (dp), intent(in) :: focn(lbi:ubi,lbj:ubj)
3199 real (dp), intent(in) :: fdat(lbi:ubi,lbj:ubj)
3200!
3201 character (len=*), intent(in) :: fieldname(:)
3202!
3203 TYPE (esmf_gridcomp) :: model
3204!
3205! Local variable declarations.
3206!
3207 logical :: debugwrite(2) = (/ .false., .false. /)
3208!
3209 integer :: i, ic, is, j
3210 integer :: year, month, day, hour, minutes, seconds, sn, sd
3211 integer :: seaice, seawater
3212 integer :: localde, localdecount, localpet, petcount
3213 integer :: iminp, imaxp, jminp, jmaxp
3214!
3215 real (dp) :: fseconds, timeindays, time_current
3216
3217 real (dp) :: fval, myfmax(3), myfmin(3), fmin(3), fmax(3)
3218!
3219 real (dp), pointer :: ptr2d(:,:) => null()
3220!
3221 real (kind(adom(1)%tsea)), pointer :: fout(:,:) => null()
3222!
3223 character (len=22 ) :: time_currentstring
3224
3225 character (len=*), parameter :: myfile = &
3226 & __FILE__//", COAMPS_ProcessImport"
3227!
3228 character (ESMF_MAXSTR) :: cname, fld_string, ofile
3229!
3230 TYPE (esmf_arrayspec) :: arrayspec2d
3231 TYPE (esmf_clock) :: clock
3232 TYPE (esmf_field) :: fmerge
3233 TYPE (esmf_staggerloc) :: staggerloc
3234 TYPE (esmf_time) :: currenttime
3235 TYPE (esmf_vm) :: vm
3236!
3237!-----------------------------------------------------------------------
3238! Initialize return code flag to success state (no error).
3239!-----------------------------------------------------------------------
3240!
3241 IF (esm_track) THEN
3242 WRITE (trac,'(a,a,i0)') '==> Entering COAMPS_ProcessImport', &
3243 & ', PET', petrank
3244 FLUSH (trac)
3245 END IF
3246 rc=esmf_success
3247!
3248!-----------------------------------------------------------------------
3249! Get information about the gridded component.
3250!-----------------------------------------------------------------------
3251!
3252 CALL esmf_gridcompget (model, &
3253 & clock=clock, &
3254 & localpet=localpet, &
3255 & petcount=petcount, &
3256 & vm=vm, &
3257 & name=cname, &
3258 & rc=rc)
3259 IF (esmf_logfounderror(rctocheck=rc, &
3260 & msg=esmf_logerr_passthru, &
3261 & line=__line__, &
3262 & file=myfile)) THEN
3263 RETURN
3264 END IF
3265!
3266! Get number of local decomposition elements (DEs). Usually, a single
3267! DE is associated with each Persistent Execution Thread (PETs). Thus,
3268! localDEcount=1.
3269!
3270 CALL esmf_gridget (models(iatmos)%grid(ng), &
3271 & localdecount=localdecount, &
3272 & rc=rc)
3273 IF (esmf_logfounderror(rctocheck=rc, &
3274 & msg=esmf_logerr_passthru, &
3275 & line=__line__, &
3276 & file=myfile)) THEN
3277 RETURN
3278 END IF
3279!
3280! Get current time.
3281!
3282 CALL esmf_clockget (clock, &
3283 & currtime=currenttime, &
3284 & rc=rc)
3285 IF (esmf_logfounderror(rctocheck=rc, &
3286 & msg=esmf_logerr_passthru, &
3287 & line=__line__, &
3288 & file=myfile)) THEN
3289 RETURN
3290 END IF
3291!
3292 CALL esmf_timeget (currenttime, &
3293 & yy=year, &
3294 & mm=month, &
3295 & dd=day, &
3296 & h =hour, &
3297 & m =minutes, &
3298 & s =seconds, &
3299 & sn=sn, &
3300 & sd=sd, &
3301 & rc=rc)
3302 IF (esmf_logfounderror(rctocheck=rc, &
3303 & msg=esmf_logerr_passthru, &
3304 & line=__line__, &
3305 & file=myfile)) THEN
3306 RETURN
3307 END IF
3308!
3309 CALL esmf_timeget (currenttime, &
3310 & s_r8=time_current, &
3311 & timestring=time_currentstring, &
3312 & rc=rc)
3313 IF (esmf_logfounderror(rctocheck=rc, &
3314 & msg=esmf_logerr_passthru, &
3315 & line=__line__, &
3316 & file=myfile)) THEN
3317 RETURN
3318 END IF
3319 fseconds=real(seconds,dp)+real(sn,dp)/real(sd,dp)
3320 timeindays=time_current/86400.0_dp
3321 is=index(time_currentstring, 'T') ! remove 'T' in
3322 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
3323!
3324!-----------------------------------------------------------------------
3325! Create merged field.
3326!-----------------------------------------------------------------------
3327!
3328! Set a 2D floating-point array descriptor.
3329!
3330 CALL esmf_arrayspecset (arrayspec2d, &
3331 & typekind=esmf_typekind_r8, &
3332 & rank=2, &
3333 & rc=rc)
3334 IF (esmf_logfounderror(rctocheck=rc, &
3335 & msg=esmf_logerr_passthru, &
3336 & line=__line__, &
3337 & file=myfile)) THEN
3338 RETURN
3339 END IF
3340!
3341! Create 2D merge field from the Grid and arraySpec.
3342!
3343 IF (.not.got(2).and.got(1)) THEN
3344 debugwrite(1)=models(iatmos)%ImportField(ifield(1))%debug_write
3345 fld_string=trim(fieldname(1))
3346 ELSE IF (.not.got(1).and.got(2)) THEN
3347 debugwrite(2)=models(iatmos)%ImportField(ifield(2))%debug_write
3348 fld_string=trim(fieldname(2))
3349 ELSE IF (got(1).and.got(2)) THEN
3350 debugwrite(1)=models(iatmos)%ImportField(ifield(1))%debug_write
3351 debugwrite(2)=models(iatmos)%ImportField(ifield(2))%debug_write
3352 fld_string=trim(fieldname(1))//'-'//trim(fieldname(2))
3353 END IF
3354 staggerloc=esmf_staggerloc_center
3355!
3356 fmerge=esmf_fieldcreate(models(iatmos)%grid(ng), &
3357 & arrayspec2d, &
3358 & staggerloc=staggerloc, &
3359 & name=trim(fld_string), &
3360 & rc=rc)
3361 IF (esmf_logfounderror(rctocheck=rc, &
3362 & msg=esmf_logerr_passthru, &
3363 & line=__line__, &
3364 & file=myfile)) THEN
3365 RETURN
3366 END IF
3367!
3368! Get merge field pointer.
3369!
3370 CALL esmf_fieldget (fmerge, &
3371 & farrayptr=ptr2d, &
3372 & rc=rc)
3373 IF (esmf_logfounderror(rctocheck=rc, &
3374 & msg=esmf_logerr_passthru, &
3375 & line=__line__, &
3376 & file=myfile)) THEN
3377 RETURN
3378 END IF
3379 ptr2d=missing_dp
3380!
3381!-----------------------------------------------------------------------
3382! Create pointer to COAMPS export field target. Here, adom(ng)%tsea
3383! has surface surface temperature values in land and ocean points.
3384! Only the ocean points are updated.
3385!-----------------------------------------------------------------------
3386!
3387 SELECT CASE (lowercase(trim(fld_string)))
3388 CASE ('sst', 'dsst', 'sst-dsst', 'dsst-sst')
3389 fout => adom(ng)%tsea
3390 CASE DEFAULT
3391 IF (localpet.eq.0) THEN
3392 WRITE (cplout,10) trim(fld_string), trim(cinpname)
3393 END IF
3394 rc=esmf_rc_not_found
3395 IF (esmf_logfounderror(rctocheck=rc, &
3396 & msg=esmf_logerr_passthru, &
3397 & line=__line__, &
3398 & file=myfile)) THEN
3399 RETURN
3400 END IF
3401 END SELECT
3402!
3403! Set COAMPS lower and upper bounds (non-overlapping) for physical
3404! area per nested grid and tile.
3405!
3406 iminp=nlimx(ng)%bp(ndom)
3407 imaxp=nlimx(ng)%ep(ndom)
3408 jminp=nlimy(ng)%bp(ndom)
3409 jmaxp=nlimy(ng)%ep(ndom)
3410!
3411!-----------------------------------------------------------------------
3412! Set COAMPS mask value at seawater and seaice points:
3413!
3414! -1: inland lake 0: sea water 1: land 2: sea ice 3: land ice
3415!-----------------------------------------------------------------------
3416!
3417 seawater=0
3418 seaice=2
3419!
3420!-----------------------------------------------------------------------
3421! If only one field is available, load field into output array at
3422! seawater points. Notice that Fout has the same precision as the
3423! COAMPS variable. It can be single or double precision.
3424!-----------------------------------------------------------------------
3425!
3426 IF (.not.got(2).and.got(1)) THEN
3427 myfmin= missing_dp
3428 myfmax=-missing_dp
3429 DO j=jminp,jmaxp
3430 DO i=iminp,imaxp
3431 IF (((nint(adom(ng)%xland(i,j)).eq.seawater).or. &
3432 & (nint(adom(ng)%xland(i,j)).eq.seaice)).and. &
3433 & (abs(focn(i,j)).lt.tol_dp)) THEN
3434 fout(i,j)=real(focn(i,j), kind(adom(ng)%tsea))
3435 END IF
3436 ptr2d(i,j)=real(fout(i,j), dp)
3437 myfmin(1)=min(myfmin(1),fout(i,j))
3438 myfmax(1)=max(myfmax(1),fout(i,j))
3439 END DO
3440 END DO
3441 ELSE IF (.not.got(1).and.got(2)) THEN
3442 myfmin= missing_dp
3443 myfmax=-missing_dp
3444 DO j=jminp,jmaxp
3445 DO i=iminp,imaxp
3446 IF (((nint(adom(ng)%xland(i,j)).eq.seawater).or. &
3447 & (nint(adom(ng)%xland(i,j)).eq.seaice)).and. &
3448 & (abs(fdat(i,j)).lt.tol_dp)) THEN
3449 fout(i,j)=real(fdat(i,j), kind(adom(1)%tsea))
3450 END IF
3451 ptr2d(i,j)=real(fout(i,j), dp)
3452 myfmin(1)=min(myfmin(1),fout(i,j))
3453 myfmax(1)=max(myfmax(1),fout(i,j))
3454 END DO
3455 END DO
3456 END IF
3457!
3458!-----------------------------------------------------------------------
3459! Otherwise, merge imported fields.
3460!-----------------------------------------------------------------------
3461!
3462 IF (got(1).and.got(2)) THEN
3463!
3464! Merge Focn and Fdat at sea-water and sea-ice points. Notice that
3465! the ESMF regridding will not fill unbounded interpolation points.
3466! Such grid cells still have the pointer initialized value MISSING_dp.
3467! The TOL_dp is used to identify such values. The user has full
3468! control of how the merging is done from the weights coefficients
3469! provided from input NetCDF file specified in "WeightsFile(atmos)".
3470!
3471 myfmin= missing_dp
3472 myfmax=-missing_dp
3473 DO j=jminp,jmaxp
3474 DO i=iminp,imaxp
3475 IF ((nint(adom(ng)%xland(i,j)).eq.seawater).or. &
3476 & (nint(adom(ng)%xland(i,j)).eq.seaice)) THEN
3477 IF (abs(fdat(i,j)).lt.tol_dp) THEN
3478 myfmin(2)=min(myfmin(2),fdat(i,j))
3479 myfmax(2)=max(myfmax(2),fdat(i,j))
3480 fval=fdat(i,j) ! initialize with DATA
3481 IF (abs(focn(i,j)).lt.tol_dp) THEN
3482 myfmin(1)=min(myfmin(1),focn(i,j))
3483 myfmax(1)=max(myfmax(1),focn(i,j))
3484 fval=weights(iatmos)%Cdat(i,j)*fval+ &
3485 & weights(iatmos)%Cesm(i,j)*focn(i,j)
3486 END IF
3487 fout(i,j)=real(fval, kind(adom(ng)%tsea))
3488 ptr2d(i,j)=real(fval, dp)
3489 myfmin(3)=min(myfmin(3),fval)
3490 myfmax(3)=max(myfmax(3),fval)
3491 END IF
3492 ELSE
3493 ptr2d(i,j)=real(fout(i,j), dp) ! include land values
3494 END IF
3495 END DO
3496 END DO
3497 END IF
3498!
3499! Get merged fields minimun and maximum values.
3500!
3501 IF (got(1).and.got(2)) THEN
3502 ic=3
3503 ELSE
3504 ic=1
3505 END IF
3506 CALL esmf_vmallreduce (vm, &
3507 & senddata=myfmin, &
3508 & recvdata=fmin, &
3509 & count=ic, &
3510 & reduceflag=esmf_reduce_min, &
3511 & rc=rc)
3512 IF (esmf_logfounderror(rctocheck=rc, &
3513 & msg=esmf_logerr_passthru, &
3514 & line=__line__, &
3515 & file=myfile)) THEN
3516 RETURN
3517 END IF
3518!
3519 CALL esmf_vmallreduce (vm, &
3520 & senddata=myfmax, &
3521 & recvdata=fmax, &
3522 & count=ic, &
3523 & reduceflag=esmf_reduce_max, &
3524 & rc=rc)
3525 IF (esmf_logfounderror(rctocheck=rc, &
3526 & msg=esmf_logerr_passthru, &
3527 & line=__line__, &
3528 & file=myfile)) THEN
3529 RETURN
3530 END IF
3531!
3532! Report merged import field information.
3533!
3534 IF (got(1).and.got(2)) THEN
3535 IF ((debuglevel.ge.0).and.(localpet.eq.0)) THEN
3536 WRITE (cplout,20) trim(fld_string), &
3537 & trim(time_currentstring), ng, &
3538 & fmin(1), fmax(1), &
3539 & fmin(2), fmax(2), &
3540 & fmin(3), fmax(3)
3541 END IF
3542 ELSE
3543 IF ((debuglevel.ge.0).and.(localpet.eq.0)) THEN
3544 WRITE (cplout,30) fmin(1), fmax(1)
3545 END IF
3546 END IF
3547!
3548! Debugging: write out export field into a NetCDF file.
3549!
3550 IF ((debuglevel.ge.3).and.any(debugwrite)) THEN
3551 WRITE (ofile,40) ng, trim(fld_string), &
3552 & year, month, day, hour, minutes, seconds
3553 CALL esmf_fieldwrite (fmerge, &
3554 & trim(ofile), &
3555 & overwrite=.true., &
3556 & rc=rc)
3557 IF (esmf_logfounderror(rctocheck=rc, &
3558 & msg=esmf_logerr_passthru, &
3559 & line=__line__, &
3560 & file=myfile)) THEN
3561 RETURN
3562 END IF
3563 END IF
3564!
3565! Nullify pointer to make sure that it does not point on a random
3566! part in the memory.
3567!
3568 IF (associated(ptr2d)) nullify (ptr2d)
3569 IF (associated(fout )) nullify (fout)
3570!
3571! Destroy merged field.
3572!
3573 CALL esmf_fielddestroy (fmerge, &
3574 & nogarbage=.false., &
3575 & rc=rc)
3576 IF (esmf_logfounderror(rctocheck=rc, &
3577 & msg=esmf_logerr_passthru, &
3578 & line=__line__, &
3579 & file=myfile)) THEN
3580 RETURN
3581 END IF
3582!
3583 IF (esm_track) THEN
3584 WRITE (trac,'(a,a,i0)') '<== Exiting COAMPS_ProcessImport', &
3585 & ', PET', petrank
3586 FLUSH (trac)
3587 END IF
3588 IF (debuglevel.gt.0) FLUSH (cplout)
3589!
3590 10 FORMAT (/,5x,'COAMPS_ProcessImport - ', &
3591 & 'unable to find option to import: ',a, &
3592 & /,25x,'check ''Import(atmos)'' in input script: ',a)
3593 20 FORMAT (1x,' COAMPS_ProcessImport - ESMF merging field ''', &
3594 & a,'''',t72,a,2x,'Grid ',i2.2, &
3595 & /,19x,'(OcnMin = ', 1p,e15.8,0p, &
3596 & ' OcnMax = ', 1p,e15.8,0p,')', &
3597 & /,19x,'(DatMin = ', 1p,e15.8,0p, &
3598 & ' DatMax = ', 1p,e15.8,0p,')', &
3599 & /,19x,'(OutMin = ', 1p,e15.8,0p, &
3600 & ' OutMax = ', 1p,e15.8,0p,')')
3601 30 FORMAT (19x, '(OutMin = ', 1p,e15.8,0p, &
3602 & ' OutMax = ', 1p,e15.8,0p,') COAMPS_ProcessImport')
3603 40 FORMAT ('coamps_',i2.2,'_merged_',a,'_',i4.4,2('-',i2.2),'_', &
3604 & i2.2,2('.',i2.2),'.nc')
3605!
3606 RETURN
3607 END SUBROUTINE coamps_processimport
3608!
3609 SUBROUTINE coamps_export (ng, model, rc)
3610!
3611!=======================================================================
3612! !
3613! Exports COAMPS fields to other coupled gridded components. The !
3614! fields in COAMPS are time-averaged over the coupling interval. !
3615! !
3616! The time-averaging of exported surface fields is done in COAMPS !
3617! file: ROOT_DIR/coamps/src/atmos/libsrc/amlib/avg_mod.F !
3618! !
3619!=======================================================================
3620!
3621 USE avg_mod, ONLY : avg
3622 USE avg_mod, ONLY : ifld_airrhm, &
3623 & ifld_airshm, &
3624 & ifld_airtmp, &
3625 & ifld_heaflx, &
3626 & ifld_lahflx, &
3627 & ifld_lonflx, &
3628 & ifld_lwdown, &
3629 & ifld_mstflx, &
3630 & ifld_sehflx, &
3631 & ifld_slpres, &
3632 & ifld_solflx, &
3633 & ifld_stress_u_true, &
3634 & ifld_stress_v_true, &
3635 & ifld_swdown, &
3636 & ifld_ttlprr, &
3637 & ifld_u10_true, &
3638 & ifld_v10_true
3639 USE coamm_memm, ONLY : adom
3640 USE domdec, ONLY : iminf, imaxf, jminf, jmaxf
3641!
3642! Imported variable declarations.
3643!
3644 integer, intent(in) :: ng
3645 integer, intent(out) :: rc
3646!
3647 TYPE (esmf_gridcomp) :: model
3648!
3649! Local variable declarations.
3650!
3651 integer :: ifld, i, is, j
3652 integer :: istr, iend, jstr, jend
3653 integer :: year, month, day, hour, minutes, seconds, sn, sd
3654 integer :: exportcount
3655 integer :: localde, localdecount, localpet, petcount
3656!
3657 real (dp), parameter :: emiss = 0.97_dp ! IR emissivity
3658 real (dp), parameter :: stbolt = 5.67051e-8_dp ! Stefan-Boltzmann
3659 real (dp), parameter :: z1 = 3.0_dp ! layer thickness
3660!
3661 real (dp) :: fseconds, timeindays, time_current
3662 real (dp) :: cff1, cff2, f1, scale
3663
3664 real (dp) :: myfmax(1), myfmin(1), fmin(1), fmax(1), fval
3665!
3666 real (dp), pointer :: ptr2d(:,:) => null()
3667!
3668 character (len=22) :: time_currentstring
3669
3670 character (len=*), parameter :: myfile = &
3671 & __FILE__//", COAMPS_Export"
3672!
3673 character (ESMF_MAXSTR) :: cname, ofile
3674 character (ESMF_MAXSTR), allocatable :: exportnamelist(:)
3675!
3676 TYPE (esmf_clock) :: clock
3677 TYPE (esmf_field) :: field
3678 TYPE (esmf_state) :: exportstate
3679 TYPE (esmf_time) :: currenttime
3680 TYPE (esmf_vm) :: vm
3681!
3682!-----------------------------------------------------------------------
3683! Initialize return code flag to success state (no error).
3684!-----------------------------------------------------------------------
3685!
3686 IF (esm_track) THEN
3687 WRITE (trac,'(a,a,i0)') '==> Entering COAMPS_Export', &
3688 & ', PET', petrank
3689 FLUSH (trac)
3690 END IF
3691 rc=esmf_success
3692!
3693!-----------------------------------------------------------------------
3694! Get information about the gridded component.
3695!-----------------------------------------------------------------------
3696!
3697 CALL esmf_gridcompget (model, &
3698 & exportstate=exportstate, &
3699 & clock=clock, &
3700 & localpet=localpet, &
3701 & petcount=petcount, &
3702 & vm=vm, &
3703 & name=cname, &
3704 & rc=rc)
3705 IF (esmf_logfounderror(rctocheck=rc, &
3706 & msg=esmf_logerr_passthru, &
3707 & line=__line__, &
3708 & file=myfile)) THEN
3709 RETURN
3710 END IF
3711!
3712! Get number of local decomposition elements (DEs). Usually, a single
3713! DE is associated with each Persistent Execution Thread (PETs). Thus,
3714! localDEcount=1.
3715!
3716 CALL esmf_gridget (models(iatmos)%grid(ng), &
3717 & localdecount=localdecount, &
3718 & rc=rc)
3719 IF (esmf_logfounderror(rctocheck=rc, &
3720 & msg=esmf_logerr_passthru, &
3721 & line=__line__, &
3722 & file=myfile)) THEN
3723 RETURN
3724 END IF
3725!
3726!-----------------------------------------------------------------------
3727! Get current time.
3728!-----------------------------------------------------------------------
3729!
3730 CALL esmf_clockget (clock, &
3731 & currtime=currenttime, &
3732 & rc=rc)
3733 IF (esmf_logfounderror(rctocheck=rc, &
3734 & msg=esmf_logerr_passthru, &
3735 & line=__line__, &
3736 & file=myfile)) THEN
3737 RETURN
3738 END IF
3739!
3740 CALL esmf_timeget (currenttime, &
3741 & yy=year, &
3742 & mm=month, &
3743 & dd=day, &
3744 & h =hour, &
3745 & m =minutes, &
3746 & s =seconds, &
3747 & sn=sn, &
3748 & sd=sd, &
3749 & rc=rc)
3750 IF (esmf_logfounderror(rctocheck=rc, &
3751 & msg=esmf_logerr_passthru, &
3752 & line=__line__, &
3753 & file=myfile)) THEN
3754 RETURN
3755 END IF
3756!
3757 CALL esmf_timeget (currenttime, &
3758 & s_r8=time_current, &
3759 & timestring=time_currentstring, &
3760 & rc=rc)
3761 IF (esmf_logfounderror(rctocheck=rc, &
3762 & msg=esmf_logerr_passthru, &
3763 & line=__line__, &
3764 & file=myfile)) THEN
3765 RETURN
3766 END IF
3767 fseconds=real(seconds,dp)+real(sn,dp)/real(sd,dp)
3768 timeindays=time_current/86400.0_dp
3769 is=index(time_currentstring, 'T') ! remove 'T' in
3770 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
3771!
3772!-----------------------------------------------------------------------
3773! Get list of export fields.
3774!-----------------------------------------------------------------------
3775!
3776 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
3777 & itemcount=exportcount, &
3778 & rc=rc)
3779 IF (esmf_logfounderror(rctocheck=rc, &
3780 & msg=esmf_logerr_passthru, &
3781 & line=__line__, &
3782 & file=myfile)) THEN
3783 RETURN
3784 END IF
3785!
3786 IF (.not. allocated(exportnamelist)) THEN
3787 allocate ( exportnamelist(exportcount) )
3788 END IF
3789 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
3790 & itemnamelist=exportnamelist, &
3791 & rc=rc)
3792 IF (esmf_logfounderror(rctocheck=rc, &
3793 & msg=esmf_logerr_passthru, &
3794 & line=__line__, &
3795 & file=myfile)) THEN
3796 RETURN
3797 END IF
3798!
3799!-----------------------------------------------------------------------
3800! Load export fields.
3801!-----------------------------------------------------------------------
3802!
3803 fld_loop : DO ifld=1,exportcount
3804!
3805! Get field from export state.
3806!
3807 CALL esmf_stateget (models(iatmos)%ExportState(ng), &
3808 & trim(exportnamelist(ifld)), &
3809 & field, &
3810 & rc=rc)
3811 IF (esmf_logfounderror(rctocheck=rc, &
3812 & msg=esmf_logerr_passthru, &
3813 & line=__line__, &
3814 & file=myfile)) THEN
3815 RETURN
3816 END IF
3817!
3818! Get field pointer. Usually, the DO-loop is executed once since
3819! localDEcount=1.
3820!
3821 de_loop : DO localde=0,localdecount-1
3822 CALL esmf_fieldget (field, &
3823 & localde=localde, &
3824 & farrayptr=ptr2d, &
3825 & rc=rc)
3826 IF (esmf_logfounderror(rctocheck=rc, &
3827 & msg=esmf_logerr_passthru, &
3828 & line=__line__, &
3829 & file=myfile)) THEN
3830 RETURN
3831 END IF
3832 istr=lbound(ptr2d,1) ! iminf(ng)
3833 iend=ubound(ptr2d,1) ! imaxf(ng)
3834 jstr=lbound(ptr2d,2) ! jminf(ng)
3835 jend=ubound(ptr2d,2) ! jmaxf(ng)
3836!
3837! Initialize pointer.
3838!
3839 ptr2d=missing_dp
3840!
3841! Load field data into export state. Notice that all export fields
3842! are kept as computed by COAMPS. The imported component does the
3843! proper scaling, physical units conversion, and other manipulations.
3844! It is done to avoid applying such transformations twice.
3845!
3846 SELECT CASE (trim(adjustl(exportnamelist(ifld))))
3847!
3848! Sea level pressure (Pa).
3849!
3850 CASE ('psfc', 'Pair')
3851 myfmin(1)= missing_dp
3852 myfmax(1)=-missing_dp
3853 DO j=jstr,jend
3854 DO i=istr,iend
3855 fval=avg(ng)%fld(ifld_slpres)%p(i,j)
3856 myfmin(1)=min(myfmin(1),fval)
3857 myfmax(1)=max(myfmax(1),fval)
3858 ptr2d(i,j)=fval
3859 END DO
3860 END DO
3861!
3862! Surface (2m) air temperature (K).
3863!
3864 CASE ('tsfc', 'Tair')
3865 myfmin(1)= missing_dp
3866 myfmax(1)=-missing_dp
3867 DO j=jstr,jend
3868 DO i=istr,iend
3869 fval=avg(ng)%fld(ifld_airtmp)%p(i,j)
3870 myfmin(1)=min(myfmin(1),fval)
3871 myfmax(1)=max(myfmax(1),fval)
3872 ptr2d(i,j)=fval
3873 END DO
3874 END DO
3875!
3876! Surface (2m) specific humidity (kg/kg).
3877!
3878 CASE ('Hair')
3879 myfmin(1)= missing_dp
3880 myfmax(1)=-missing_dp
3881 DO j=jstr,jend
3882 DO i=istr,iend
3883 fval=avg(ng)%fld(ifld_airshm)%p(i,j)
3884 myfmin(1)=min(myfmin(1),fval)
3885 myfmax(1)=max(myfmax(1),fval)
3886 ptr2d(i,j)=fval
3887 END DO
3888 END DO
3889!
3890! Surface (2m) relative humidity (percentage).
3891!
3892 CASE ('qsfc', 'Qair')
3893 myfmin(1)= missing_dp
3894 myfmax(1)=-missing_dp
3895 DO j=jstr,jend
3896 DO i=istr,iend
3897 fval=avg(ng)%fld(ifld_airrhm)%p(i,j)
3898 myfmin(1)=min(myfmin(1),fval)
3899 myfmax(1)=max(myfmax(1),fval)
3900 ptr2d(i,j)=fval
3901 END DO
3902 END DO
3903!
3904! Net heat flux (W m-2) at the surface. Use shortwave, longwave,
3905! latent, sensible fluxes to compute net heat flux. Remove outgoing
3906! IR from ocean sea surface temperature (K) using infrared emissivity
3907! (unitless) and Stefan-Boltzmann constant (W m-2 K-4). As in COAMPS
3908! routine 'sst_skin_update', the f1 represents the shortwave flux
3909! mean absorption in the cool-skin layer (an approximation kludge).
3910! A formal approach is presented in Zeng and Beljaars (2005; GRL).
3911! Also, ROMS 'bulk_flux' routine shows a formal cool skin correction.
3912!
3913! The latent and sensible flux computed in COAMPS need to have the
3914! sign reversed because of COAMPS convention of positive to for
3915! upward flux and negative for downward flux. In the ocean is the
3916! opposite.
3917!
3918 CASE ('nflx', 'shflux')
3919 myfmin(1)= missing_dp
3920 myfmax(1)=-missing_dp
3921 f1=1.0_dp-0.27_dp*exp(-2.80_dp*z1)- &
3922 & 0.45_dp*exp(-0.07_dp*z1)
3923 DO j=jstr,jend
3924 DO i=istr,iend
3925 cff1=adom(ng)%tsea(i,j)*adom(ng)%tsea(i,j)* &
3926 & adom(ng)%tsea(i,j)*adom(ng)%tsea(i,j)
3927 cff2=emiss*stbolt*cff1
3928 fval=avg(ng)%fld(ifld_solflx)%p(i,j)*f1+ &
3929 & avg(ng)%fld(ifld_lwdown)%p(i,j)-cff2- &
3930 & avg(ng)%fld(ifld_lahflx)%p(i,j)- &
3931 & avg(ng)%fld(ifld_sehflx)%p(i,j)
3932 myfmin(1)=min(myfmin(1),fval)
3933 myfmax(1)=max(myfmax(1),fval)
3934 ptr2d(i,j)=fval
3935 END DO
3936 END DO
3937!
3938! Surface net longwave radiation flux (W m-2; positive upward).
3939!
3940 CASE ('lwrd', 'LWrad')
3941 myfmin(1)= missing_dp
3942 myfmax(1)=-missing_dp
3943 DO j=jstr,jend
3944 DO i=istr,iend
3945 fval=avg(ng)%fld(ifld_lonflx)%p(i,j)
3946 myfmin(1)=min(myfmin(1),fval)
3947 myfmax(1)=max(myfmax(1),fval)
3948 ptr2d(i,j)=fval
3949 END DO
3950 END DO
3951!
3952! Surface downward longwave radiation flux (W m-2).
3953!
3954 CASE ('dlwrd', 'dLWrad', 'lwrad_down')
3955 myfmin(1)= missing_dp
3956 myfmax(1)=-missing_dp
3957 DO j=jstr,jend
3958 DO i=istr,iend
3959 fval=avg(ng)%fld(ifld_lwdown)%p(i,j)
3960 myfmin(1)=min(myfmin(1),fval)
3961 myfmax(1)=max(myfmax(1),fval)
3962 ptr2d(i,j)=fval
3963 END DO
3964 END DO
3965!
3966! Surface net shortwave radiation (W m-2; positive into ocean).
3967!
3968 CASE ('swrd', 'SWrad')
3969 myfmin(1)= missing_dp
3970 myfmax(1)=-missing_dp
3971 DO j=jstr,jend
3972 DO i=istr,iend
3973 fval=avg(ng)%fld(ifld_solflx)%p(i,j)
3974 myfmin(1)=min(myfmin(1),fval)
3975 myfmax(1)=max(myfmax(1),fval)
3976 ptr2d(i,j)=fval
3977 END DO
3978 END DO
3979!
3980! Surface downward shortwave radiation flux (W m-2).
3981!
3982 CASE ('dswrd', 'dSWrad')
3983 myfmin(1)= missing_dp
3984 myfmax(1)=-missing_dp
3985 DO j=jstr,jend
3986 DO i=istr,iend
3987 fval=avg(ng)%fld(ifld_swdown)%p(i,j)
3988 myfmin(1)=min(myfmin(1),fval)
3989 myfmax(1)=max(myfmax(1),fval)
3990 ptr2d(i,j)=fval
3991 END DO
3992 END DO
3993!
3994! Surface latent heat flux (W m-2). In COAMPS, the latent heat flux
3995! is a positive upward flux. For the ocean, it is the reverse and
3996! needs to be switched to negative.
3997!
3998!
3999 CASE ('lhfx', 'LHfx')
4000 myfmin(1)= missing_dp
4001 myfmax(1)=-missing_dp
4002 DO j=jstr,jend
4003 DO i=istr,iend
4004 fval=-avg(ng)%fld(ifld_lahflx)%p(i,j)
4005 myfmin(1)=min(myfmin(1),fval)
4006 myfmax(1)=max(myfmax(1),fval)
4007 ptr2d(i,j)=fval
4008 END DO
4009 END DO
4010!
4011! Surface sensible heat flux (W m-2). In COAMPS, the sensible heat
4012! flux is a positive upward flux. For the ocean, it is the reverse and
4013! needs to be switched to negative.
4014!
4015 CASE ('shfx', 'SHfx')
4016 myfmin(1)= missing_dp
4017 myfmax(1)=-missing_dp
4018 DO j=jstr,jend
4019 DO i=istr,iend
4020 fval=-avg(ng)%fld(ifld_sehflx)%p(i,j)
4021 myfmin(1)=min(myfmin(1),fval)
4022 myfmax(1)=max(myfmax(1),fval)
4023 ptr2d(i,j)=fval
4024 END DO
4025 END DO
4026!
4027! Surface moisture (E-P) flux (kg m-2 s-1). In COAMPS, the evaporation
4028! is a positive upward flux. For the ocean, it is the reverse so the
4029! moisture flux needs to be switched to negative.
4030!
4031 CASE ('swflux')
4032 myfmin(1)= missing_dp
4033 myfmax(1)=-missing_dp
4034 DO j=jstr,jend
4035 DO i=istr,iend
4036 fval=-avg(ng)%fld(ifld_mstflx)%p(i,j)
4037 myfmin(1)=min(myfmin(1),fval)
4038 myfmax(1)=max(myfmax(1),fval)
4039 ptr2d(i,j)=fval
4040 END DO
4041 END DO
4042!
4043! Precipitation tendency rate (kg m-2 s-1). In COAMPS, precipitation
4044! is averaged with cm/s units.
4045!
4046 CASE ('rain')
4047 myfmin(1)= missing_dp
4048 myfmax(1)=-missing_dp
4049 scale=10.0_dp ! cm/s to kg m-2 s-1 (rhow=1000 km/m3)
4050 DO j=jstr,jend
4051 DO i=istr,iend
4052 fval=avg(ng)%fld(ifld_ttlprr)%p(i,j)*scale
4053 myfmin(1)=min(myfmin(1),fval)
4054 myfmax(1)=max(myfmax(1),fval)
4055 ptr2d(i,j)=fval
4056 END DO
4057 END DO
4058!
4059! Surface (10m) eastward wind stress component (millibar, mb).
4060!
4061 CASE ('taux', 'taux10', 'sustr')
4062 myfmin(1)= missing_dp
4063 myfmax(1)=-missing_dp
4064 DO j=jstr,jend
4065 DO i=istr,iend
4066 fval=avg(ng)%fld(ifld_stress_u_true)%p(i,j)
4067 myfmin(1)=min(myfmin(1),fval)
4068 myfmax(1)=max(myfmax(1),fval)
4069 ptr2d(i,j)=fval
4070 END DO
4071 END DO
4072!
4073! Surface (10m) northward wind stress component (Pa).
4074!
4075 CASE ('tauy', 'tauy10', 'svstr')
4076 myfmin(1)= missing_dp
4077 myfmax(1)=-missing_dp
4078 DO j=jstr,jend
4079 DO i=istr,iend
4080 fval=avg(ng)%fld(ifld_stress_v_true)%p(i,j)
4081 myfmin(1)=min(myfmin(1),fval)
4082 myfmax(1)=max(myfmax(1),fval)
4083 ptr2d(i,j)=fval
4084 END DO
4085 END DO
4086!
4087! Surface (10m) eastward wind component (m s-1).
4088!
4089 CASE ('Uwind', 'u10', 'wndu')
4090 myfmin(1)= missing_dp
4091 myfmax(1)=-missing_dp
4092 DO j=jstr,jend
4093 DO i=istr,iend
4094 fval=avg(ng)%fld(ifld_u10_true)%p(i,j)
4095 myfmin(1)=min(myfmin(1),fval)
4096 myfmax(1)=max(myfmax(1),fval)
4097 ptr2d(i,j)=fval
4098 END DO
4099 END DO
4100!
4101! Surface (10m) northward wind component (m s-1).
4102!
4103 CASE ('Vwind', 'v10', 'wndv')
4104 myfmin(1)= missing_dp
4105 myfmax(1)=-missing_dp
4106 DO j=jstr,jend
4107 DO i=istr,iend
4108 fval=avg(ng)%fld(ifld_v10_true)%p(i,j)
4109 myfmin(1)=min(myfmin(1),fval)
4110 myfmax(1)=max(myfmax(1),fval)
4111 ptr2d(i,j)=fval
4112 END DO
4113 END DO
4114!
4115! Export field not found.
4116!
4117 CASE DEFAULT
4118 IF (localpet.eq.0) THEN
4119 WRITE (cplout,10) trim(adjustl(exportnamelist(ifld))), &
4120 & trim(cinpname)
4121 END IF
4122 rc=esmf_rc_not_found
4123 IF (esmf_logfounderror(rctocheck=rc, &
4124 & msg=esmf_logerr_passthru, &
4125 & line=__line__, &
4126 & file=myfile)) THEN
4127 RETURN
4128 END IF
4129 END SELECT
4130!
4131! Nullify pointer to make sure that it does not point on a random
4132! part in the memory.
4133!
4134 IF (associated(ptr2d)) nullify (ptr2d)
4135 END DO de_loop
4136!
4137! Get export field minimun and maximum values.
4138!
4139 CALL esmf_vmallreduce (vm, &
4140 & senddata=myfmin, &
4141 & recvdata=fmin, &
4142 & count=1, &
4143 & reduceflag=esmf_reduce_min, &
4144 & rc=rc)
4145 IF (esmf_logfounderror(rctocheck=rc, &
4146 & msg=esmf_logerr_passthru, &
4147 & line=__line__, &
4148 & file=myfile)) THEN
4149 RETURN
4150 END IF
4151!
4152 CALL esmf_vmallreduce (vm, &
4153 & senddata=myfmax, &
4154 & recvdata=fmax, &
4155 & count=1, &
4156 & reduceflag=esmf_reduce_max, &
4157 & rc=rc)
4158 IF (esmf_logfounderror(rctocheck=rc, &
4159 & msg=esmf_logerr_passthru, &
4160 & line=__line__, &
4161 & file=myfile)) THEN
4162 RETURN
4163 END IF
4164!
4165! Report export field information.
4166!
4167 IF ((debuglevel.ge.0).and.(localpet.eq.0)) THEN
4168 WRITE (cplout,20) trim(exportnamelist(ifld)), &
4169 & trim(time_currentstring), ng, &
4170 & fmin(1), fmax(1)
4171 END IF
4172!
4173! Debugging: write out export field into a NetCDF file.
4174!
4175 IF ((debuglevel.ge.3).and. &
4176 & models(iatmos)%ExportField(ifld)%debug_write) THEN
4177 WRITE (ofile,30) ng, trim(exportnamelist(ifld)), &
4178 & year, month, day, hour, minutes, seconds
4179 CALL esmf_fieldwrite (field, &
4180 & trim(ofile), &
4181 & overwrite=.true., &
4182 & rc=rc)
4183 IF (esmf_logfounderror(rctocheck=rc, &
4184 & msg=esmf_logerr_passthru, &
4185 & line=__line__, &
4186 & file=myfile)) THEN
4187 RETURN
4188 END IF
4189 END IF
4190 END DO fld_loop
4191!
4192! Deallocate local arrays.
4193!
4194 IF (allocated(exportnamelist)) deallocate(exportnamelist)
4195!
4196! Update COAMPS export calls counter.
4197!
4198 IF (exportcount.gt.0) THEN
4199 models(iatmos)%ExportCalls=models(iatmos)%ExportCalls+1
4200 END IF
4201!
4202 IF (esm_track) THEN
4203 WRITE (trac,'(a,a,i0)') '<== Exiting COAMPS_Export', &
4204 & ', PET', petrank
4205 FLUSH (trac)
4206 END IF
4207 IF (debuglevel.gt.0) FLUSH (cplout)
4208!
4209 10 FORMAT (/,2x,'COAMPS_Export - unable to find option to export: ', &
4210 & a,/,18x,'check ''Export(atmos)'' in input script: ',a)
4211 20 FORMAT (2x,'COAMPS_Export - ESMF: exporting field ''',a,'''', &
4212 & t72,a,2x,'Grid ',i2.2,/, &
4213 & 19x,'(OutMin = ', 1p,e15.8,0p,' OutMax = ',1p,e15.8,0p, &
4214 & ')')
4215 30 FORMAT ('coamps_',i2.2,'_export_',a,'_',i4.4,2('-',i2.2),'_', &
4216 & i2.2,2('.',i2.2),'.nc')
4217
4218 RETURN
4219 END SUBROUTINE coamps_export
4220!
4221#endif
4222 END MODULE esmf_coamps_mod
esmf_coamps_mod
Definition esmf_atm_coamps.h:1
esmf_coamps_mod::coamps_modeladvance
subroutine, private coamps_modeladvance(model, rc)
Definition esmf_atm_coamps.h:2332
esmf_coamps_mod::coamps_setrunclock
subroutine, private coamps_setrunclock(model, rc)
Definition esmf_atm_coamps.h:1139
esmf_coamps_mod::coamps_setclock
subroutine, private coamps_setclock(model, rc)
Definition esmf_atm_coamps.h:804
esmf_coamps_mod::coamps_export
subroutine, private coamps_export(ng, model, rc)
Definition esmf_atm_coamps.h:3610
esmf_coamps_mod::coamps_processimport
subroutine, private coamps_processimport(ng, model, got, ifield, fieldname, lbi, ubi, lbj, ubj, focn, fdat, rc)
Definition esmf_atm_coamps.h:3150
esmf_coamps_mod::coamps_import
subroutine, private coamps_import(ng, model, rc)
Definition esmf_atm_coamps.h:2632
esmf_coamps_mod::coamps_datainit
subroutine, private coamps_datainit(model, rc)
Definition esmf_atm_coamps.h:713
esmf_coamps_mod::coamps_setgridarrays
subroutine, private coamps_setgridarrays(ng, model, localpet, rc)
Definition esmf_atm_coamps.h:1465
esmf_coamps_mod::coamps_setinitializep2
subroutine, private coamps_setinitializep2(model, importstate, exportstate, clock, rc)
Definition esmf_atm_coamps.h:437
esmf_coamps_mod::coamps_setinitializep1
subroutine, private coamps_setinitializep1(model, importstate, exportstate, clock, rc)
Definition esmf_atm_coamps.h:303
esmf_coamps_mod::coamps_checkimport
subroutine, private coamps_checkimport(model, rc)
Definition esmf_atm_coamps.h:1234
esmf_coamps_mod::coamps_setstates
subroutine, private coamps_setstates(ng, model, rc)
Definition esmf_atm_coamps.h:1930
esmf_coamps_mod::atm_setservices
subroutine, public atm_setservices(model, rc)
Definition esmf_atm_coamps.h:116
esmf_coamps_mod::coamps_setfinalize
subroutine, private coamps_setfinalize(model, importstate, exportstate, clock, rc)
Definition esmf_atm_coamps.h:2583
mod_esmf_esm
Definition mod_esmf_esm.F:2
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::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::ngridsa
integer ngridsa
Definition mod_esmf_esm.F:422
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::get_weights
subroutine, public get_weights(icomp, ix, iy, vm, rc)
Definition mod_esmf_esm.F:5039
mod_esmf_esm::couplingtype
integer couplingtype
Definition mod_esmf_esm.F:467
mod_esmf_esm::stopdate
integer, dimension(6) stopdate
Definition mod_esmf_esm.F:500
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::referencedate
integer, dimension(6) referencedate
Definition mod_esmf_esm.F:497
mod_esmf_esm::iatmos
integer iatmos
Definition mod_esmf_esm.F:434
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::idata
integer idata
Definition mod_esmf_esm.F:435
mod_esmf_esm::clockinfo
type(esm_clock), dimension(:), allocatable, target clockinfo
Definition mod_esmf_esm.F:396
mod_esmf_esm::startdate
integer, dimension(6) startdate
Definition mod_esmf_esm.F:499
mod_esmf_esm::nimport
integer, dimension(:), allocatable nimport
Definition mod_esmf_esm.F:450
mod_esmf_esm::weights
type(esm_meld), dimension(:), allocatable, target weights
Definition mod_esmf_esm.F:322
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::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
strings_mod
Definition strings.F:2
strings_mod::lowercase
character(len(sinp)) function, public lowercase(sinp)
Definition strings.F:531