ROMS
Loading...
Searching...
No Matches
esmf_wav_wam.h
Go to the documentation of this file.
1 MODULE esmf_wam_mod
2
3#if defined WAM_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 Ufuk Utku Turuncoglu !
10!=======================================================================
11! !
12! This module sets WAM as the wave model gridded component using !
13! the generic ESMF/NUOPC layer: !
14! !
15! WAV_SetServices Sets WAV component shared-object entry !
16! points using NUPOC generic methods for !
17! "initialize", "run", and "finalize". !
18! !
19! WAM_SetInitializeP1 WAM component phase 1 initialization: !
20! sets import and export fields long and !
21! short names into its respective state. !
22! !
23! WAM_SetInitializeP2 WAM component phase 2 initialization: !
24! Initializes component (WAM_Initialize), !
25! sets component grid (WAM_SetGridArrays), !
26! and adds fields into import and export !
27! into respective states (WAM_SetStates). !
28! !
29! WAM_DataInit Exports WAM component fields during !
30! initialization or restart. !
31! !
32! WAM_SetClock Sets WAM component date calendar, start !
33! and stop times, and coupling interval. !
34! !
35! WAM_CheckImport Checks if WAM component import field is !
36! at the correct time. !
37! !
38! WAM_SetGridArrays Sets WAM component horizontal grid !
39! arrays, grid area, and land/sea mask. !
40! !
41! WAM_SetStates Adds WAM component export and import !
42! fields into its respective state. !
43! !
44! WAM_ModelAdvance Advances WAM component for a coupling !
45! interval. It calls import and export !
46! routines. !
47! !
48! WAM_SetFinalize Finalizes WAM component execution. !
49! !
50! WAM_import Imports fields into WAM from other !
51! gridded components. !
52! !
53! WAM_Export Exports WAM fields to other gridded !
54! components. !
55! !
56! WAM_Unpack Unpacks WAM component export field by !
57! collecting data from each MPI node. !
58! !
59! ESMF: Earth System Modeling Framework (Version 7 or higher) !
60! https://www.earthsystemcog.org/projects/esmf !
61! !
62! NUOPC: National Unified Operational Prediction Capability !
63! https://www.earthsystemcog.org/projects/nuopc !
64! !
65! WAM: ECMWF Wave Model (WAM), Cycle_4.5.3_MPI modified by RegESM !
66! https://github.com/uturuncoglu/RegESM !
67! !
68!=======================================================================
69!
70 USE esmf
71 USE nuopc
72 USE nuopc_model, &
73 & nuopc_setservices => setservices, &
74 & nuopc_label_advance => label_advance, &
75 & nuopc_label_datainitialize => label_datainitialize, &
76 & nuopc_label_setclock => label_setclock, &
77 & nuopc_label_checkimport => label_checkimport
78!
79 USE mod_esmf_esm ! ESM coupling structures and variables
80!
81 USE wam_user_interface, ONLY : wam_initialize => wam_init, &
82 & wam_run, &
83 & wam_finalize
84!
85 implicit none
86!
87 PUBLIC :: wav_setservices
88
89 PRIVATE :: wam_setinitializep1
90 PRIVATE :: wam_setinitializep2
91 PRIVATE :: wam_datainit
92 PRIVATE :: wam_setclock
93 PRIVATE :: wam_checkimport
94 PRIVATE :: wam_setgridarrays
95 PRIVATE :: wam_setstates
96 PRIVATE :: wam_modeladvance
97 PRIVATE :: wam_setfinalize
98 PRIVATE :: wam_import
99 PRIVATE :: wam_export
100 PRIVATE :: wam_unpack
101!
102 CONTAINS
103!
104 SUBROUTINE wav_setservices (model, rc)
105!
106!=======================================================================
107! !
108! Sets WAM component shared-object entry points for "initialize", !
109! "run", and "finalize" by using NUOPC generic methods. !
110! !
111!=======================================================================
112!
113! Imported variable declarations.
114!
115 integer, intent(out) :: rc
116!
117 TYPE (esmf_gridcomp) :: model
118!
119! Local variable declarations.
120!
121 character (len=*), parameter :: myfile = &
122 & __FILE__//", WAV_SetServices"
123!
124!-----------------------------------------------------------------------
125! Initialize return code flag to success state (no error).
126!-----------------------------------------------------------------------
127!
128 IF (esm_track) THEN
129 WRITE (trac,'(a,a,i0)') '==> Entering WAV_SetServices', &
130 & ', PET', petrank
131 FLUSH (trac)
132 END IF
133 rc=esmf_success
134!
135!-----------------------------------------------------------------------
136! Register NUOPC generic routines.
137!-----------------------------------------------------------------------
138!
139 CALL nuopc_compderive (model, &
140 & nuopc_setservices, &
141 & rc=rc)
142 IF (esmf_logfounderror(rctocheck=rc, &
143 & msg=esmf_logerr_passthru, &
144 & line=__line__, &
145 & file=myfile)) THEN
146 RETURN
147 END IF
148!
149!-----------------------------------------------------------------------
150! Register initialize routines.
151!-----------------------------------------------------------------------
152!
153! Set routine for Phase 1 initialization (import and export fields).
154!
155 CALL nuopc_compsetentrypoint (model, &
156 & methodflag=esmf_method_initialize, &
157 & phaselabellist=(/"IPDv00p1"/), &
158 & userroutine=wam_setinitializep1, &
159 & rc=rc)
160 IF (esmf_logfounderror(rctocheck=rc, &
161 & msg=esmf_logerr_passthru, &
162 & line=__line__, &
163 & file=myfile)) THEN
164 RETURN
165 END IF
166!
167! Set routine for Phase 2 initialization (exchange arrays).
168!
169 CALL nuopc_compsetentrypoint (model, &
170 & methodflag=esmf_method_initialize, &
171 & phaselabellist=(/"IPDv00p2"/), &
172 & userroutine=wam_setinitializep2, &
173 & rc=rc)
174 IF (esmf_logfounderror(rctocheck=rc, &
175 & msg=esmf_logerr_passthru, &
176 & line=__line__, &
177 & file=myfile)) THEN
178 RETURN
179 END IF
180!
181!-----------------------------------------------------------------------
182! Attach WAM component phase independent specializing methods.
183!-----------------------------------------------------------------------
184!
185! Set routine for export initial/restart fields.
186!
187 CALL nuopc_compspecialize (model, &
188 & speclabel=nuopc_label_datainitialize, &
189 & specroutine=wam_datainit, &
190 & rc=rc)
191 IF (esmf_logfounderror(rctocheck=rc, &
192 & msg=esmf_logerr_passthru, &
193 & line=__line__, &
194 & file=myfile)) THEN
195 RETURN
196 END IF
197!
198! Set routine for setting WAM clock.
199!
200 CALL nuopc_compspecialize (model, &
201 & speclabel=nuopc_label_setclock, &
202 & specroutine=wam_setclock, &
203 & rc=rc)
204 IF (esmf_logfounderror(rctocheck=rc, &
205 & msg=esmf_logerr_passthru, &
206 & line=__line__, &
207 & file=myfile)) THEN
208 RETURN
209 END IF
210!
211! Set routine for checking import state.
212!
213 CALL nuopc_compspecialize (model, &
214 & speclabel=nuopc_label_checkimport, &
215 & specphaselabel="RunPhase1", &
216 & specroutine=wam_checkimport, &
217 & rc=rc)
218 IF (esmf_logfounderror(rctocheck=rc, &
219 & msg=esmf_logerr_passthru, &
220 & line=__line__, &
221 & file=myfile)) THEN
222 RETURN
223 END IF
224!
225! Set routine for time-stepping WAM component.
226!
227 CALL nuopc_compspecialize (model, &
228 & speclabel=nuopc_label_advance, &
229 & specroutine=wam_modeladvance, &
230 & rc=rc)
231 IF (esmf_logfounderror(rctocheck=rc, &
232 & msg=esmf_logerr_passthru, &
233 & line=__line__, &
234 & file=myfile)) THEN
235 RETURN
236 END IF
237!
238!-----------------------------------------------------------------------
239! Register WAM finalize routine.
240!-----------------------------------------------------------------------
241!
242 CALL esmf_gridcompsetentrypoint (model, &
243 & methodflag=esmf_method_finalize, &
244 & userroutine=wam_setfinalize, &
245 & rc=rc)
246 IF (esmf_logfounderror(rctocheck=rc, &
247 & msg=esmf_logerr_passthru, &
248 & line=__line__, &
249 & file=myfile)) THEN
250 RETURN
251 END IF
252!
253 IF (esm_track) THEN
254 WRITE (trac,'(a,a,i0)') '<== Exiting WAV_SetServices', &
255 & ', PET', petrank
256 FLUSH (trac)
257 END IF
258!
259 RETURN
260 END SUBROUTINE wam_setservices
261!
262 SUBROUTINE wam_setinitializep1 (model, &
263 & ImportState, ExportState, &
264 & clock, rc)
265!
266!=======================================================================
267! !
268! WAM component Phase 1 initialization: sets import and export !
269! fields long and short names into its respective state. !
270! !
271!=======================================================================
272!
273! Imported variable declarations.
274!
275 integer, intent(out) :: rc
276!
277 TYPE (esmf_gridcomp) :: model
278 TYPE (esmf_state) :: importstate
279 TYPE (esmf_state) :: exportstate
280 TYPE (esmf_clock) :: clock
281!
282! Local variable declarations.
283!
284 integer :: i, ng
285!
286 character (len=100) :: coupledset, statelabel
287 character (len=240) :: standardname, shortname
288
289 character (len=*), parameter :: myfile = &
290 & __FILE__//", WAM_SetInitializeP1"
291!
292!-----------------------------------------------------------------------
293! Initialize return code flag to success state (no error).
294!-----------------------------------------------------------------------
295!
296 IF (esm_track) THEN
297 WRITE (trac,'(a,a,i0)') '==> Entering WAM_SetInitializeP1', &
298 & ', PET', petrank
299 FLUSH (trac)
300 END IF
301 rc=esmf_success
302!
303!-----------------------------------------------------------------------
304! Set WAM import state and fields.
305!-----------------------------------------------------------------------
306!
307! Add WAM import state(s). If nesting, each grid has its own import
308! state.
309!
310 importing : IF (nimport(iwave).gt.0) THEN
311 DO ng=1,models(iwave)%Ngrids
312 IF (any(coupled(iwave)%LinkedGrid(ng,:))) THEN
313 coupledset=trim(coupled(iwave)%SetLabel(ng))
314 statelabel=trim(coupled(iwave)%ImpLabel(ng))
315 CALL nuopc_addnestedstate (importstate, &
316 & cplset=trim(coupledset), &
317 & nestedstatename=trim(statelabel),&
318 & nestedstate=models(iwave)% &
319 & importstate(ng), &
320 rc=rc)
321 IF (esmf_logfounderror(rctocheck=rc, &
322 & msg=esmf_logerr_passthru, &
323 & line=__line__, &
324 & file=myfile)) THEN
325 RETURN
326 END IF
327!
328! Add fields import state.
329!
330 DO i=1,nimport(iwave)
331 standardname=models(iwave)%ImportField(i)%standard_name
332 shortname =models(iwave)%ImportField(i)%short_name
333 CALL nuopc_advertise (models(iwave)%ImportState(ng), &
334 & standardname=trim(standardname), &
335 & name=trim(shortname), &
336 & rc=rc)
337 IF (esmf_logfounderror(rctocheck=rc, &
338 & msg=esmf_logerr_passthru, &
339 & line=__line__, &
340 & file=myfile)) THEN
341 RETURN
342 END IF
343 END DO
344 END IF
345 END DO
346 END IF importing
347!
348!-----------------------------------------------------------------------
349! Set WAM export state and fields.
350!-----------------------------------------------------------------------
351!
352! Add WAM import state. If nesting, each grid has its own import
353! state.
354!
355 exporting : IF (nexport(iwave).gt.0) THEN
356 DO ng=1,models(iwave)%Ngrids
357 IF (any(coupled(iwave)%LinkedGrid(ng,:))) THEN
358 coupledset=trim(coupled(iwave)%SetLabel(ng))
359 statelabel=trim(coupled(iwave)%ExpLabel(ng))
360 CALL nuopc_addnestedstate (exportstate, &
361 & cplset=trim(coupledset), &
362 & nestedstatename=trim(statelabel),&
363 & nestedstate=models(iwave)% &
364 & exportstate(ng), &
365 rc=rc)
366 IF (esmf_logfounderror(rctocheck=rc, &
367 & msg=esmf_logerr_passthru, &
368 & line=__line__, &
369 & file=myfile)) THEN
370 RETURN
371 END IF
372!
373! Add fields to export state.
374!
375 DO i=1,nexport(iwave)
376 standardname=models(iwave)%ExportField(i)%standard_name
377 shortname =models(iwave)%ExportField(i)%short_name
378 CALL nuopc_advertise (models(iwave)%ExportState(ng), &
379 & standardname=trim(standardname), &
380 & name=trim(shortname), &
381 & rc=rc)
382 IF (esmf_logfounderror(rctocheck=rc, &
383 & msg=esmf_logerr_passthru, &
384 & line=__line__, &
385 & file=myfile)) THEN
386 RETURN
387 END IF
388 END DO
389 END IF
390 END DO
391 END IF exporting
392!
393 IF (esm_track) THEN
394 WRITE (trac,'(a,a,i0)') '<== Exiting WAM_SetInitializeP1', &
395 & ', PET', petrank
396 FLUSH (trac)
397 END IF
398!
399 RETURN
400 END SUBROUTINE wam_setinitializep1
401!
402 SUBROUTINE wam_setinitializep2 (model, &
403 & ImportState, ExportState, &
404 & clock, rc)
405!
406!=======================================================================
407! !
408! WAM component Phase 2 initialization: Initializes WAM, sets !
409! component grid, and adds import and export fields to respective !
410! states. !
411! !
412!=======================================================================
413!
414! Imported variable declarations.
415!
416 integer, intent(out) :: rc
417!
418 TYPE (esmf_gridcomp) :: model
419 TYPE (esmf_state) :: importstate
420 TYPE (esmf_state) :: exportstate
421 TYPE (esmf_clock) :: clock
422!
423! Local variable declarations.
424!
425 integer :: mycomm, localpet, ng, petcount
426!
427 character (len=*), parameter :: myfile = &
428 & __FILE__//", WAM_SetInitializeP2"
429!
430 TYPE (esmf_vm) :: vm
431!
432!-----------------------------------------------------------------------
433! Initialize return code flag to success state (no error).
434!-----------------------------------------------------------------------
435!
436 IF (esm_track) THEN
437 WRITE (trac,'(a,a,i0)') '==> Entering WAM_SetInitializeP2', &
438 & ', PET', petrank
439 FLUSH (trac)
440 END IF
441 rc=esmf_success
442!
443!-----------------------------------------------------------------------
444! Querry the Virtual Machine (VM) parallel environmemt for the MPI
445! communicator handle and current node rank.
446!-----------------------------------------------------------------------
447!
448 CALL esmf_gridcompget (model, &
449 & vm=vm, &
450 & rc=rc)
451 IF (esmf_logfounderror(rctocheck=rc, &
452 & msg=esmf_logerr_passthru, &
453 & line=__line__, &
454 & file=myfile)) THEN
455 RETURN
456 END IF
457!
458 CALL esmf_vmget (vm, &
459 & localpet=localpet, &
460 & petcount=petcount, &
461 & mpicommunicator=mycomm, &
462 & rc=rc)
463 IF (esmf_logfounderror(rctocheck=rc, &
464 & msg=esmf_logerr_passthru, &
465 & line=__line__, &
466 & file=myfile)) THEN
467 RETURN
468 END IF
469!
470!-----------------------------------------------------------------------
471! Initialize WAM component.
472!-----------------------------------------------------------------------
473!
474 CALL wam_initialize (mycomm)
475!
476!-----------------------------------------------------------------------
477! Set-up grid and load coordinate data.
478!-----------------------------------------------------------------------
479!
480 DO ng=1,models(iwave)%Ngrids
481 IF (any(coupled(iwave)%LinkedGrid(ng,:))) THEN
482 CALL wam_setgridarrays (ng, model, localpet, rc)
483 IF (esqmf_logfounderror(rctocheck=rc, &
484 & msg=esmf_logerr_passthru, &
485 & line=__line__, &
486 & file=myfile)) THEN
487 RETURN
488 END IF
489 END IF
490 END DO
491!
492!-----------------------------------------------------------------------
493! Set-up fields and register to import/export states.
494!-----------------------------------------------------------------------
495!
496 DO ng=1,models(iwave)%Ngrids
497 IF (any(coupled(iwave)%LinkedGrid(ng,:))) THEN
498 CALL wam_setstates (ng, model, rc)
499 IF (esqmf_logfounderror(rctocheck=rc, &
500 & msg=esmf_logerr_passthru, &
501 & line=__line__, &
502 & file=myfile)) THEN
503 RETURN
504 END IF
505 END IF
506 END DO
507!
508 IF (esm_track) THEN
509 WRITE (trac,'(a,a,i0)') '<== Exiting WAM_SetInitializeP2', &
510 & ', PET', petrank
511 FLUSH (trac)
512 END IF
513!
514 RETURN
515 END SUBROUTINE wam_setinitializep2
516!
517 SUBROUTINE wam_datainit (model, rc)
518!
519!=======================================================================
520! !
521! Exports WAM component fields during initialization or restart. !
522! !
523!=======================================================================
524!
525! Imported variable declarations.
526!
527 integer, intent(out) :: rc
528!
529 TYPE (esmf_gridcomp) :: model
530!
531! Local variable declarations.
532!
533 integer :: ng
534!
535 character (len=*), parameter :: myfile = &
536 & __FILE__//", WAM_DataInit"
537!
538 TYPE (esmf_time) :: currenttime
539!
540!-----------------------------------------------------------------------
541! Initialize return code flag to success state (no error).
542!-----------------------------------------------------------------------
543!
544 IF (esm_track) THEN
545 WRITE (trac,'(a,a,i0)') '==> Entering WAM_DataInit', &
546 & ', PET', petrank
547 FLUSH (trac)
548 END IF
549 rc=esmf_success
550!
551!-----------------------------------------------------------------------
552! Get gridded component clock current time.
553!-----------------------------------------------------------------------
554!
555 CALL esmf_clockget (clockinfo(iwave)%Clock, &
556 & currtime=currenttime, &
557 & rc=rc)
558 IF (esmf_logfounderror(rctocheck=rc, &
559 & msg=esmf_logerr_passthru, &
560 & line=__line__, &
561 & file=myfile)) THEN
562 RETURN
563 END IF
564!
565!-----------------------------------------------------------------------
566! Export initialization or restart fields.
567!-----------------------------------------------------------------------
568!
569 IF (nexport(iwave).gt.0) THEN
570 DO ng=1,models(iwave)%Ngrids
571 IF (any(coupled(iwave)%LinkedGrid(ng,:))) THEN
572 CALL wam_export (ng, model, rc=rc)
573 IF (esmf_logfounderror(rctocheck=rc, &
574 & msg=esmf_logerr_passthru, &
575 & line=__line__, &
576 & file=myfile)) THEN
577 RETURN
578 END IF
579 END IF
580 END DO
581 END IF
582!
583 IF (esm_track) THEN
584 WRITE (trac,'(a,a,i0)') '<== Exiting WAM_DataInit', &
585 & ', PET', petrank
586 FLUSH (trac)
587 END IF
588!
589 RETURN
590 END SUBROUTINE wam_datainit
591!
592 SUBROUTINE wam_setclock (model, rc)
593!
594!=======================================================================
595! !
596! Sets WAM component date calendar, start and stop time, and coupling !
597! interval. !
598! !
599!=======================================================================
600!
601 USE wam_timopt_module, ONLY : cdatea, cdatee, coldstart
602!
603! Imported variable declarations.
604!
605 integer, intent(out) :: rc
606!
607 TYPE (esmf_gridcomp) :: model
608!
609! Local variable declarations.
610!
611 integer :: ref_year, start_year, stop_year
612 integer :: ref_month, start_month, stop_month
613 integer :: ref_day, start_day, stop_day
614 integer :: ref_hour, start_hour, stop_hour
615 integer :: ref_minute, start_minute, stop_minute
616 integer :: ref_second, start_second, stop_second
617 integer :: localpet, petcount
618 integer :: timefrac, ig
619!
620 real(r8) :: hour, minute, yday
621!
622 character (len= 80) :: calendar
623 character (len=160) :: message
624
625 character (len=*), parameter :: myfile = &
626 & __FILE__//", WAM_SetClock"
627!
628 TYPE (esmf_calkind_flag) :: caltype
629 TYPE (esmf_time) :: currenttime, starttime
630 TYPE (esmf_timeinterval) :: timestep
631 TYPE (esmf_vm) :: vm
632!
633!-----------------------------------------------------------------------
634! Initialize return code flag to success state (no error).
635!-----------------------------------------------------------------------
636!
637 IF (esm_track) THEN
638 WRITE (trac,'(a,a,i0)') '==> Entering WAM_SetClock',
639 & ', PET', petrank
640 FLUSH (trac)
641 END IF
642 rc=esmf_success
643!
644!-----------------------------------------------------------------------
645! Querry the Virtual Machine (VM) parallel environmemt for the MPI
646! communicator handle and current node rank.
647!-----------------------------------------------------------------------
648!
649 CALL esmf_gridcompget (model, &
650 & localpet=localpet, &
651 & petcount=petcount, &
652 & vm=vm, &
653 & rc=rc)
654 IF (esmf_logfounderror(rctocheck=rc, &
655 & msg=esmf_logerr_passthru, &
656 & line=__line__, &
657 & file=myfile)) THEN
658 RETURN
659 END IF
660!
661!-----------------------------------------------------------------------
662! Create WAM component clock.
663!-----------------------------------------------------------------------
664!
665! Set calendar.
666!
667 calendar=trim(clockinfo(iwave)%CalendarString)
668 IF (trim(calendar).eq.'gregorian') THEN
669 caltype=esmf_calkind_gregorian
670 ELSE
671 caltype=esmf_calkind_gregorian
672 END IF
673 clockinfo(iwave)%Calendar=esmf_calendarcreate(caltype, &
674 & name=trim(calendar),&
675 & rc=rc)
676 IF (esmf_logfounderror(rctocheck=rc, &
677 & msg=esmf_logerr_passthru, &
678 & line=__line__, &
679 & file=myfile)) THEN
680 RETURN
681 END IF
682!
683! Set reference time.
684!
685 IF (coldstart) THEN
686 READ (cdatea,'(i4,5i2)') ref_year, ref_month, ref_day, &
687 & ref_hour, ref_minute, ref_second
688!
689 CALL esmf_timeset(clockinfo(iwave)%ReferenceTime, &
690 & yy=ref_year, &
691 & mm=ref_month, &
692 & dd=ref_day, &
693 & h=ref_hour, &
694 & m=ref_minute, &
695 & s=ref_second, &
696 & calendar=clockinfo(iwave)%Calendar, &
697 & rc=rc)
698 IF (esmf_logfounderror(rctocheck=rc, &
699 & msg=esmf_logerr_passthru, &
700 & line=__line__, &
701 & file=myfile)) THEN
702 RETURN
703 END IF
704 END IF
705!
706! Set start time.
707!
708 READ (cdatea,'(i4,5i2)') start_year, start_month, start_day, &
709 & start_hour, start_minute, start_second
710!
711 CALL esmf_timeset (clockinfo(iwave)%StartTime, &
712 yy=start_year, &
713 mm=start_month, &
714 dd=start_day, &
715 h=start_hour, &
716 m=start_minute, &
717 s=start_second, &
718 calendar=clockinfo(iwave)%Calendar, &
719 rc=rc)
720 IF (esmf_logfounderror(rctocheck=rc, &
721 & msg=esmf_logerr_passthru, &
722 & line=__line__, &
723 & file=myfile)) THEN
724 RETURN
725 END IF
726!
727! Set stop time.
728!
729 READ (cdatee,'(i4,5i2)') stop_year, stop_month, stop_day, &
730 & stop_hour, stop_minute, stop_second
731!
732 CALL esmf_timeset (clockinfo(iwave)%StopTime, &
733 & yy=stop_year, &
734 & mm=stop_month, &
735 & dd=stop_day, &
736 & h=stop_hour, &
737 & m=stop_minute, &
738 & s=stop_second, &
739 & calendar=clockinfo(iwave)%Calendar, &
740 & rc=rc)
741 IF (esmf_logfounderror(rctocheck=rc, &
742 & msg=esmf_logerr_passthru, &
743 & line=__line__, &
744 & file=myfile)) THEN
745 RETURN
746 END IF
747!
748!-----------------------------------------------------------------------
749! Get component clock.
750!-----------------------------------------------------------------------
751!
752 CALL esmf_gridcompget (model, &
753 & clock=clockinfo(iwave)%Clock, &
754 & rc=rc)
755 IF (esmf_logfounderror(rctocheck=rc, &
756 & msg=esmf_logerr_passthru, &
757 & line=__line__, &
758 & file=myfile)) THEN
759 RETURN
760 END IF
761!
762 CALL esmf_clockget (clockinfo(iwave)%Clock, &
763 & timestep=clockinfo(iwave)%TimeStep, &
764 & currtime=clockinfo(iwave)%CurrentTime, &
765 & rc=rc)
766 IF (esmf_logfounderror(rctocheck=rc, &
767 & msg=esmf_logerr_passthru, &
768 & line=__line__, &
769 & file=myfile)) THEN
770 RETURN
771 END IF
772!
773!-----------------------------------------------------------------------
774! Compare driver time against WAM component time.
775!-----------------------------------------------------------------------
776!
777 IF (clockinfo(idriver)%Restarted) THEN
778 starttime=clockinfo(idriver)%RestartTime
779 ELSE
780 starttime=clockinfo(idriver)%StartTime
781 END IF
782!
783 IF (clockinfo(iwave)%StartTime.ne.starttime) THEN
784 CALL esmf_timeprint (clockinfo(iwave)%StartTime, &
785 & options="string", &
786 & rc=rc)
787 IF (esmf_logfounderror(rctocheck=rc, &
788 & msg=esmf_logerr_passthru, &
789 & line=__line__, &
790 & file=myfile)) THEN
791 RETURN
792 END IF
793!
794 CALL esmf_timeprint (starttime, &
795 & options="string", &
796 & rc=rc)
797 IF (esmf_logfounderror(rctocheck=rc, &
798 & msg=esmf_logerr_passthru, &
799 & line=__line__, &
800 & file=myfile)) THEN
801 RETURN
802 END IF
803!
804 message='Driver and WAM start times do not match: '// &
805 & 'please check the config files.'
806 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
807 & msg=trim(message))
808 RETURN
809 END IF
810!
811 IF (clockinfo(iwave )%StopTime.ne. &
812 & clockinfo(idriver)%StopTime) THEN
813 CALL esmf_timeprint (clockinfo(iwave)%StopTime, &
814 & options="string", &
815 & rc=rc)
816 IF (esmf_logfounderror(rctocheck=rc,
817 & msg=esmf_logerr_passthru, &
818 & line=__line__, &
819 & file=myfile)) THEN
820 RETURN
821 END IF
822!
823 CALL esmf_timeprint (clockinfo(idriver)%StopTime, &
824 & options="string", &
825 & rc=rc)
826 IF (esmf_logfounderror(rctocheck=rc, &
827 & msg=esmf_logerr_passthru, &
828 & line=__line__, &
829 & file=myfile)) THEN
830 RETURN
831 END IF
832!
833 message='Driver and WAM stop times do not match: '// &
834 & 'please check the config files.'
835 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
836 & msg=trim(message))
837 RETURN
838 END IF
839!
840 IF (clockinfo(iwave )%Calendar.ne. &
841 & clockinfo(idriver)%Calendar) THEN
842 CALL esmf_calendarprint (clockinfo(iwave)%Calendar, &
843 & options="calkindflag", &
844 & rc=rc)
845 IF (esmf_logfounderror(rctocheck=rc, &
846 & msg=esmf_logerr_passthru, &
847 & line=__line__, &
848 & file=myfile)) THEN
849 RETURN
850 END IF
851!
852 CALL esmf_calendarprint (clockinfo(idriver)%Calendar, &
853 & options="calkindflag", &
854 & rc=rc)
855 IF (esmf_logfounderror(rctocheck=rc, &
856 & msg=esmf_logerr_passthru, &
857 & line=__line__, &
858 & file=myfile)) THEN
859 RETURN
860 END IF
861!
862 message='Driver and WAM calendars do not match: '// &
863 & 'please check the config files.'
864 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
865 & msg=trim(message))
866 RETURN
867 END IF
868!
869!-----------------------------------------------------------------------
870! Modify component clock time step.
871!-----------------------------------------------------------------------
872!
873 timefrac=0
874 DO ig=1,models(iwave)%Ngrids
875 timefrac=max(timefrac, &
876 & maxval(models(iwave)%TimeFrac(ig,:), &
877 & mask=models(:)%IsActive))
878 END DO
879 IF (timefrac.lt.1) THEN ! needs to be 1 or greater
880 rc=esmf_rc_not_set ! cannot be 0
881 IF (esmf_logfounderror(rctocheck=rc, &
882 & msg=esmf_logerr_passthru, &
883 & line=__line__, &
884 & file=myfile)) THEN
885 RETURN
886 END IF
887 END IF
888 clockinfo(iwave)%TimeStep=clockinfo(idriver)%TimeStep/timefrac
889!
890 IF (coldstart) THEN
891 CALL esmf_clockset (clockinfo(iwave)%Clock, &
892 & name=trim(clockinfo(iwave)%Name), &
893 & reftime =clockinfo(iwave)%ReferenceTime, &
894 & timestep =clockinfo(iwave)%TimeStep, &
895 & starttime=clockinfo(iwave)%StartTime, &
896 & stoptime =clockinfo(iwave)%StopTime, &
897 rc=rc)
898 IF (esmf_logfounderror(rctocheck=rc, &
899 & msg=esmf_logerr_passthru, &
900 & line=__line__, &
901 & file=myfile)) THEN
902 RETURN
903 END IF
904 ELSE
905 CALL esmf_clockset (clockinfo(iwave)%Clock, &
906 & name=trim(clockinfo(iwave)%Name), &
907 & timestep =clockinfo(iwave)%TimeStep, &
908 & starttime=clockinfo(iwave)%StartTime, &
909 & stoptime =clockinfo(iwave)%StopTime, &
910 & rc=rc)
911 IF (esmf_logfounderror(rctocheck=rc, &
912 & msg=esmf_logerr_passthru, &
913 & line=__line__, &
914 & file=myfile)) THEN
915 RETURN
916 END IF
917 END IF
918!
919 IF (esm_track) THEN
920 WRITE (trac,'(a,a,i0)') '<== Exiting WAM_SetClock', &
921 & ', PET', petrank
922 FLUSH (trac)
923 END IF
924!
925 RETURN
926 END SUBROUTINE wam_setclock
927!
928 SUBROUTINE wam_checkimport (model, rc)
929!
930!=======================================================================
931! !
932! Checks if WAM component import field is at the correct time. !
933! !
934!=======================================================================
935!
936! Imported variable declarations.
937!
938 integer, intent(out) :: rc
939!
940 TYPE (esmf_gridcomp) :: model
941!
942! Local variable declarations.
943!
944 logical :: atcorrecttime
945!
946 integer :: importcount, localpet
947!
948 character(ESMF_MAXSTR), allocatable :: importnamelist(:)
949
950 character (len=*), parameter :: myfile = &
951 & __FILE__//", WAM_CheckImport"
952!
953 TYPE (esmf_clock) :: driverclock
954 TYPE (esmf_field) :: field
955 TYPE (esmf_state) :: importstate
956 TYPE (esmf_time) :: starttime, currenttime
957 TYPE (esmf_timeinterval) :: timestep
958 TYPE (esmf_vm) :: vm
959!
960!-----------------------------------------------------------------------
961! Initialize return code flag to success state (no error).
962!-----------------------------------------------------------------------
963!
964 IF (esm_track) THEN
965 WRITE (trac,'(a,a,i0)') '==> Entering WAM_CheckImport', &
966 & ', PET', petrank
967 FLUSH (trac)
968 END IF
969 rc=esmf_success
970!
971!-----------------------------------------------------------------------
972! Query component for the driver clock.
973!-----------------------------------------------------------------------
974!
975 CALL nuopc_modelget (model, &
976 & driverclock=driverclock, &
977 & rc=rc)
978 IF (esmf_logfounderror(rctocheck=rc, &
979 & msg=esmf_logerr_passthru, &
980 & line=__line__, &
981 & file=myfile)) THEN
982 RETURN
983 END IF
984!
985 CALL esmf_gridcompget (model, &
986 & vm=vm, &
987 & rc=rc)
988 IF (esmf_logfounderror(rctocheck=rc, &
989 & msg=esmf_logerr_passthru, &
990 & line=__line__, &
991 & file=myfile)) THEN
992 RETURN
993 END IF
994!
995 CALL esmf_vmget (vm, &
996 & localpet=localpet, &
997 & rc=rc)
998 IF (esmf_logfounderror(rctocheck=rc, &
999 & msg=esmf_logerr_passthru, &
1000 & line=__line__, &
1001 & file=myfile)) THEN
1002 RETURN
1003 END IF
1004!
1005!-----------------------------------------------------------------------
1006! Get the start time and current time from driver clock.
1007!-----------------------------------------------------------------------
1008!
1009 CALL esmf_clockget (driverclock, &
1010 & starttime=starttime, &
1011 & currtime=currenttime, &
1012 & timestep=timestep, &
1013 & rc=rc)
1014 IF (esmf_logfounderror(rctocheck=rc, &
1015 & msg=esmf_logerr_passthru, &
1016 & line=__line__, &
1017 & file=myfile)) THEN
1018 RETURN
1019 END IF
1020!
1021!-----------------------------------------------------------------------
1022! Query WAM component for its import state.
1023!-----------------------------------------------------------------------
1024!
1025 CALL esmf_gridcompget (model, &
1026 & importstate=importstate, &
1027 & rc=rc)
1028 IF (esmf_logfounderror(rctocheck=rc, &
1029 & msg=esmf_logerr_passthru, &
1030 & line=__line__, &
1031 & file=myfile)) THEN
1032 RETURN
1033 END IF
1034!
1035!-----------------------------------------------------------------------
1036! Get list of import fields.
1037!-----------------------------------------------------------------------
1038!
1039 CALL esmf_stateget (models(iwave)%ImportState(ng), &
1040 & itemcount=importcount, &
1041 & rc=rc)
1042 IF (esmf_logfounderror(rctocheck=rc, &
1043 & msg=esmf_logerr_passthru, &
1044 & line=__line__, &
1045 & file=myfile)) THEN
1046 RETURN
1047 END IF
1048!
1049 IF (.not.allocated(importnamelist)) THEN
1050 allocate ( importnamelist(importcount) )
1051 END IF
1052!
1053 CALL esmf_stateget (models(iwave)%ImportState(ng), &
1054 & itemnamelist=importnamelist, &
1055 & rc=rc)
1056 IF (esmf_logfounderror(rctocheck=rc, &
1057 & msg=esmf_logerr_passthru, &
1058 & line=__line__, &
1059 & file=myfile)) THEN
1060 RETURN
1061 END IF
1062!
1063!-----------------------------------------------------------------------
1064! Check fields in the ImportState object.
1065!-----------------------------------------------------------------------
1066!
1067 IF (importcount.gt.0) THEN
1068 CALL esmf_stateget (models(iwave)%ImportState(ng), &
1069 & itemname=trim(importnamelist(1)), &
1070 & field=field, &
1071 & rc=rc)
1072 IF (esmf_logfounderror(rctocheck=rc, &
1073 & msg=esmf_logerr_passthru, &
1074 & line=__line__, &
1075 & file=myfile)) THEN
1076 RETURN
1077 END IF
1078!
1079! Check if import field is at the correct time.
1080!
1081 atcorrecttime=nuopc_isattime(field, &
1082 & currenttime, &
1083 & rc=rc)
1084 IF (esmf_logfounderror(rctocheck=rc, &
1085 & msg=esmf_logerr_passthru, &
1086 & line=__line__, &
1087 & file=myfile)) THEN
1088 RETURN
1089 END IF
1090
1091 CALL report_timestamp (field, currenttime, &
1092 & localpet, "WAM", rc)
1093 IF (esmf_logfounderror(rctocheck=rc, &
1094 & msg=esmf_logerr_passthru, &
1095 & line=__line__, &
1096 & file=myfile)) THEN
1097 RETURN
1098 END IF
1099!
1100 IF (.not.atcorrecttime) THEN
1101 CALL esmf_logseterror(esmf_rc_arg_bad, &
1102 & msg="NUOPC INCOMPATIBILITY DETECTED:"// &
1103 & " Import Fields not at correct time", &
1104 & line=__line__, &
1105 & file=myfile, &
1106 & rctoreturn=rc)
1107 RETURN
1108 END IF
1109 END IF
1110!
1111 IF (esm_track) THEN
1112 WRITE (trac,'(a,a,i0)') '<== Exiting WAM_CheckImport', &
1113 & ', PET', petrank
1114 FLUSH (trac)
1115 END IF
1116!
1117 RETURN
1118 END SUBROUTINE wam_checkimport
1119!
1120 SUBROUTINE wam_setgridarrays (ng, model, localPET, rc)
1121!
1122!=======================================================================
1123! !
1124! Sets WAM component staggered, horizontal grids arrays, grid area, !
1125! and land/sea mask, if any. !
1126! !
1127!=======================================================================
1128!
1129 USE wam_grid_module, ONLY : nx, amowep, amoeap, xdello
1130 USE wam_grid_module, ONLY : ny, amosop, amonop, xdella, l_s_mask
1131 USE wam_mpi_module , ONLY : petotal, irank, nstart, nend
1132!
1133! Imported variable declarations.
1134!
1135 integer, intent(in) :: ng, localpet
1136 integer, intent(out) :: rc
1137!
1138 TYPE (esmf_gridcomp), intent(inout) :: model
1139!
1140! Local variable declarations.
1141!
1142 integer :: i, ivar, j, localdecount, tile
1143 integer :: imin, imax, jmin, jmax
1144!
1145 integer, allocatable :: deblocklist(:,:,:)
1146!
1147 integer (i4b), pointer :: ptrm(:,:) => null()
1148!
1149 real (r8), pointer :: ptrx(:,:) => null()
1150 real (r8), pointer :: ptry(:,:) => null()
1151!
1152 character (ESMF_MAXSTR) :: name
1153
1154 character (len=*), parameter :: myfile = &
1155 & __FILE__//", WAM_SetGridArrays"
1156!
1157 TYPE (esmf_distgrid) :: distgrid1, distgrid2
1158 TYPE (esmf_staggerloc) :: staggerloc
1159 TYPE (esmf_vm) :: vm
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 WAM_SetGridArrays', &
1167 & ', PET', petrank
1168 FLUSH (trac)
1169 END IF
1170 rc=esmf_success
1171!
1172!-----------------------------------------------------------------------
1173! Get limits of the grid arrays (based on PET and nest level)
1174!-----------------------------------------------------------------------
1175!
1176 IF (.not. allocated(deblocklist)) THEN
1177 allocate ( deblocklist(1,2,petotal) )
1178 END IF
1179!
1180 DO tile=1,petotal
1181 deblocklist(1,1,tile)=nstart(tile)
1182 deblocklist(1,2,tile)=nend(tile)
1183 END DO
1184!
1185!-----------------------------------------------------------------------
1186! Create ESMF DistGrid based on model domain decomposition.
1187!-----------------------------------------------------------------------
1188!
1189 distgrid1=esmf_distgridcreate(minindex=(/ 1 /), &
1190 & maxindex=(/ nend(petotal) /), &
1191 & deblocklist=deblocklist, &
1192 & rc=rc)
1193 IF (esmf_logfounderror(rctocheck=rc, &
1194 & msg=esmf_logerr_passthru, &
1195 & line=__line__, &
1196 & file=myfile)) THEN
1197 RETURN
1198 END IF
1199!
1200 distgrid2=esmf_distgridcreate(minindex=(/ 1, 1 /), &
1201 & maxindex=(/ nx, ny /), &
1202 & rc=rc)
1203 IF (esmf_logfounderror(rctocheck=rc, &
1204 & msg=esmf_logerr_passthru, &
1205 & line=__line__, &
1206 & file=myfile)) THEN
1207 RETURN
1208 END IF
1209!
1210!-----------------------------------------------------------------------
1211! Set component grid coordinates.
1212!-----------------------------------------------------------------------
1213!
1214! Define component grid location type.
1215!
1216 IF (.not.allocated(models(iwave)%mesh)) THEN
1217 allocate ( models(iwave)%mesh(1) )
1218 models(iwave)%mesh(1)%gtype = icenter
1219 END IF
1220!
1221! Create ESMF Grid. The array indices are global.
1222!
1223 models(iwave)%grid(ng)=esmf_gridcreate(distgrid=distgrid2, &
1224 & indexflag=esmf_index_global, &
1225 & name="wam_grid", &
1226 & rc=rc)
1227 IF (esmf_logfounderror(rctocheck=rc, &
1228 & msg=esmf_logerr_passthru, &
1229 & line=__line__, &
1230 & file=myfile)) THEN
1231 RETURN
1232 END IF
1233!
1234! Get number of local decomposition elements (DEs). Usually, a single
1235! DE is associated with each Persistent Execution Thread (PETs). Thus,
1236! localDEcount=1.
1237!
1238 CALL esmf_gridget (models(iwave)%grid(ng), &
1239 & localdecount=localdecount, &
1240 & rc=rc)
1241 IF (esmf_logfounderror(rctocheck=rc, &
1242 & msg=esmf_logerr_passthru, &
1243 & line=__line__, &
1244 & file=myfile)) THEN
1245 RETURN
1246 END IF
1247!
1248! Mesh coordinates for each variable type.
1249!
1250 mesh_loop : DO ivar=1,ubound(models(iwave)%mesh, dim=1)
1251!
1252 SELECT CASE (models(iwave)%mesh(ivar)%gtype)
1253 CASE (icenter)
1254 staggerloc=esmf_staggerloc_center
1255 END SELECT
1256!
1257! Allocate coordinate storage associated with staggered grid type.
1258! No coordinate values are set yet.
1259!
1260 CALL esmf_gridaddcoord (models(iwave)%grid(ng), &
1261 & staggerloc=staggerloc &
1262 & rc=rc)
1263 IF (esmf_logfounderror(rctocheck=rc, &
1264 & msg=esmf_logerr_passthru, &
1265 & line=__line__, &
1266 & file=myfile)) THEN
1267 RETURN
1268 END IF
1269!
1270! Allocate storage for land/sea masking.
1271!
1272 CALL esmf_gridadditem (models(iwave)%grid(ng), &
1273 & staggerloc=staggerloc, &
1274 & itemflag=esmf_griditem_mask, &
1275 & rc=rc)
1276 IF (esmf_logfounderror(rctocheck=rc, &
1277 & msg=esmf_logerr_passthru, &
1278 & line=__line__, &
1279 & file=myfile)) THEN
1280 RETURN
1281 END IF
1282 models(iwave)%LandValue=0
1283 models(iwave)%SeaValue=1
1284!
1285! Get pointers and set coordinates for the grid. Usually, the DO-loop
1286! is executed once since localDEcount=1.
1287!
1288 de_loop : DO localde=0,localdecount-1
1289 CALL esmf_gridgetcoord (models(iwave)%grid(ng), &
1290 & localde=localde, &
1291 & staggerloc=staggerloc, &
1292 & coorddim=1, &
1293 & farrayptr=ptrx, &
1294 & rc=rc)
1295 IF (esmf_logfounderror(rctocheck=rc, &
1296 & msg=esmf_logerr_passthru, &
1297 & line=__line__, &
1298 & file=myfile)) THEN
1299 RETURN
1300 END IF
1301!
1302 CALL esmf_gridgetcoord (models(iwave)%grid(ng), &
1303 & localde=localde, &
1304 & staggerloc=staggerloc, &
1305 & coorddim=2, &
1306 & farrayptr=ptry, &
1307 & rc=rc)
1308 IF (esmf_logfounderror(rctocheck=rc, &
1309 & msg=esmf_logerr_passthru, &
1310 & line=__line__, &
1311 & file=myfile)) THEN
1312 RETURN
1313 END IF
1314!
1315 CALL esmf_gridgetitem (models(iwave)%grid(ng), &
1316 & localde=localde, &
1317 & staggerloc=staggerloc, &
1318 & itemflag=esmf_griditem_mask, &
1319 & farrayptr=ptrm, &
1320 & rc=rc)
1321 IF (esmf_logfounderror(rctocheck=rc, &
1322 & msg=esmf_logerr_passthru, &
1323 & line=__line__, &
1324 & file=myfile)) THEN
1325 RETURN
1326 END IF
1327!
1328! Fill the pointers.
1329!
1330 imin=lbound(ptrx, dim=1)
1331 imax=ubound(ptrx, dim=1)
1332 jmin=lbound(ptrx, dim=2)
1333 jmax=ubound(ptrx, dim=2)
1334!
1335 SELECT CASE (models(iwave)%mesh(ivar)%gtype)
1336 CASE (icenter)
1337 DO i=imin,imax
1338 ptrx(i,jmin:jmax)=real(i-1,r8)*xdello+amowep
1339 END DO
1340 DO j=jmin,jmax
1341 ptry(imin:imax,j)=real(j-1,r8)*xdella+amosop
1342 END DO
1343 DO i=imin,imax
1344 DO j=jmin,jmax
1345 IF (l_s_mask(i,j)) THEN
1346 ptrm(i,j)=models(iwave)%SeaValue
1347 ELSE
1348 ptrm(i,j)=models(iwave)%LandValue
1349 END IF
1350 END DO
1351 END DO
1352 END SELECT
1353!
1354! Nullify pointers.
1355!
1356 IF (associated(ptrx)) nullify (ptrx)
1357 IF (associated(ptry)) nullify (ptry)
1358 IF (associated(ptrm)) nullify (ptrm)
1359 END DO de_loop
1360!
1361! Debugging: write out component grid in VTK format.
1362!
1363 IF (debuglevel.ge.4) THEN
1364 gtype=models(iwave)%mesh(ivar)%gtype)
1365 CALL esmf_gridwritevtk (models(iwave)%grid(ng), &
1366 & filename="wam_"// &
1367 & trim(gridtype(gtype)// &
1368 & "_point", &
1369 & staggerloc=staggerloc, &
1370 & rc=rc)
1371 IF (esmf_logfounderror(rctocheck=rc, &
1372 & msg=esmf_logerr_passthru, &
1373 & line=__line__, &
1374 & file=myfile)) THEN
1375 RETURN
1376 END IF
1377 END IF
1378 END DO mesh_loop
1379!
1380! Assign grid to gridded component.
1381!
1382 CALL esmf_gridcompset (model, &
1383 & grid=models(iwave)%grid(ng), &
1384 & rc=rc)
1385 IF (esmf_logfounderror(rctocheck=rc, &
1386 & msg=esmf_logerr_passthru, &
1387 & line=__line__, &
1388 & file=myfile)) THEN
1389 RETURN
1390 END IF
1391!
1392 IF (esm_track) THEN
1393 WRITE (trac,'(a,a,i0)') '<== Exiting WAM_SetGridArrays', &
1394 & ', PET', petrank
1395 FLUSH (trac)
1396 END IF
1397!
1398 RETURN
1399 END SUBROUTINE wam_setgridarrays
1400!
1401 SUBROUTINE wam_setstates (ng, model, rc)
1402!
1403!=======================================================================
1404! !
1405! Adds WAM component export and import fields into its respective !
1406! state. !
1407! !
1408!=======================================================================
1409!
1410! Imported variable declarations.
1411!
1412 integer, intent(in) :: ng
1413 integer, intent(out) :: rc
1414!
1415 TYPE (esmf_gridcomp) :: model
1416!
1417! Local variable declarations.
1418!
1419 integer :: i, id
1420 integer :: localde, localdecount
1421 integer :: exportcount, importcount
1422!
1423 real (dp), pointer :: ptr2d(:,:) => null()
1424!
1425 character (ESMF_MAXSTR), allocatable :: exportnamelist(:)
1426 character (ESMF_MAXSTR), allocatable :: importnamelist(:)
1427
1428 character (len=*), parameter :: myfile = &
1429 & __FILE__//", WAM_SetStates"
1430!
1431 TYPE (esmf_arrayspec) :: arrayspec
1432 TYPE (esmf_field) :: field
1433 TYPE (esmf_staggerloc) :: staggerloc
1434 TYPE (esmf_vm) :: vm
1435!
1436!-----------------------------------------------------------------------
1437! Initialize return code flag to success state (no error).
1438!-----------------------------------------------------------------------
1439!
1440 IF (esm_track) THEN
1441 WRITE (trac,'(a,a,i0)') '==> Entering WAM_SetStates', &
1442 & ', PET', petrank
1443 FLUSH (trac)
1444 END IF
1445 rc=esmf_success
1446!
1447!-----------------------------------------------------------------------
1448! Query gridded component.
1449!-----------------------------------------------------------------------
1450!
1451! Get import and export states.
1452!
1453 CALL esmf_gridcompget (model, &
1454 & localpet=localpet, &
1455 & vm=vm, &
1456 & rc=rc)
1457 IF (esmf_logfounderror(rctocheck=rc, &
1458 & msg=esmf_logerr_passthru, &
1459 & line=__line__, &
1460 & file=myfile)) THEN
1461 RETURN
1462 END IF
1463!
1464! Get number of local decomposition elements (DEs). Usually, a single
1465! Decomposition Element (DE) is associated with each Persistent
1466! Execution Thread (PETs). Thus, localDEcount=1.
1467!
1468 CALL esmf_gridget (models(iwave)%grid(ng), &
1469 & localdecount=localdecount, &
1470 & rc=rc)
1471 IF (esmf_logfounderror(rctocheck=rc, &
1472 & msg=esmf_logerr_passthru, &
1473 & line=__line__, &
1474 & file=myfile)) THEN
1475 RETURN
1476 END IF
1477!
1478!-----------------------------------------------------------------------
1479! Set a 2D floating-point array descriptor.
1480!-----------------------------------------------------------------------
1481!
1482 CALL esmf_arrayspecset (arrayspec, &
1483 & typekind=esmf_typekind_r8, &
1484 & rank=2, &
1485 & rc=rc)
1486 IF (esmf_logfounderror(rctocheck=rc, &
1487 & msg=esmf_logerr_passthru, &
1488 & line=__line__, &
1489 & file=myfile)) THEN
1490 RETURN
1491 END IF
1492!
1493!-----------------------------------------------------------------------
1494! Add export fields into export state.
1495!-----------------------------------------------------------------------
1496!
1497 exporting : IF (nexport(iwave).gt.0) THEN
1498!
1499! Get number of fields to export.
1500!
1501 CALL esmf_stateget (models(iwave)%ExportState(ng), &
1502 & itemcount=exportcount, &
1503 & rc=rc)
1504 IF (esmf_logfounderror(rctocheck=rc, &
1505 & msg=esmf_logerr_passthru, &
1506 & line=__line__, &
1507 & file=myfile)) THEN
1508 RETURN
1509 END IF
1510!
1511! Get a list of export fields names.
1512!
1513 IF (.not.allocated(exportnamelist)) THEN
1514 allocate ( exportnamelist(exportcount) )
1515 END IF
1516 CALL esmf_stateget (models(iwave)%ExportState(ng), &
1517 & itemnamelist=exportnamelist, &
1518 & rc=rc)
1519 IF (esmf_logfounderror(rctocheck=rc, &
1520 & msg=esmf_logerr_passthru, &
1521 & line=__line__, &
1522 & file=myfile)) THEN
1523 RETURN
1524 END IF
1525!
1526! Set export field(s).
1527!
1528 DO i=1,exportcount
1529 id=field_index(models(iwave)%ExportField, exportnamelist(i))
1530!
1531 IF (nuopc_isconnected(models(iwave)%ExportState(ng), &
1532 & fieldname=trim(exportnamelist(i)), &
1533 & rc=rc)) THEN
1534!
1535! Set staggering type.
1536!
1537 SELECT CASE (models(iwave)%ExportField(id)%gtype)
1538 CASE (icenter)
1539 staggerloc=esmf_staggerloc_center
1540 END SELECT
1541!
1542! Create 2D field from the Grid and arraySpec.
1543!
1544 field=esmf_fieldcreate(models(iwave)%grid(ng), &
1545 & arrayspec, &
1546 & staggerloc=staggerloc, &
1547 & name=trim(exportnamelist(i)), &
1548 & rc=rc)
1549 IF (esmf_logfounderror(rctocheck=rc, &
1550 & msg=esmf_logerr_passthru, &
1551 & line=__line__, &
1552 & file=myfile)) THEN
1553 RETURN
1554 END IF
1555!
1556! Put data into state. Usually, the DO-loop is executed once since
1557! localDEcount=1.
1558!
1559 DO localde=0,localdecount-1
1560!
1561! Get pointer to DE-local memory allocation within field.
1562!
1563 CALL esmf_fieldget (field, &
1564 & localde=localde, &
1565 & farrayptr=ptr2d, &
1566 & rc=rc)
1567 IF (esmf_logfounderror(rctocheck=rc, &
1568 & msg=esmf_logerr_passthru, &
1569 & line=__line__, &
1570 & file=myfile)) THEN
1571 RETURN
1572 END IF
1573!
1574! Initialize pointer.
1575!
1576 ptr2d=missing_dp
1577!
1578! Nullify pointer to make sure that it does not point on a random part
1579! in the memory.
1580!
1581 IF ( associated(ptr2d) ) nullify (ptr2d)
1582 END DO
1583!
1584! Add field export state.
1585!
1586 CALL nuopc_realize (exportstate, &
1587 & field=field, &
1588 & rc=rc)
1589 IF (esmf_logfounderror(rctocheck=rc, &
1590 & msg=esmf_logerr_passthru, &
1591 & line=__line__, &
1592 & file=myfile)) THEN
1593 RETURN
1594 END IF
1595!
1596! Remove field from export state because it is not connected.
1597!
1598 ELSE
1599 IF (localpet.eq.0) THEN
1600 WRITE (cplout,10) trim(exportnamelist(i)), &
1601 & 'Export State: ', &
1602 & trim(coupled(iwave)%ExpLabel(ng))
1603 END IF
1604 CALL esmf_stateremove (models(iwave)%ExportState(ng), &
1605 & (/ trim(exportnamelist(i)) /), &
1606 & rc=rc)
1607 IF (esmf_logfounderror(rctocheck=rc, &
1608 & msg=esmf_logerr_passthru, &
1609 & line=__line__, &
1610 & file=myfile)) THEN
1611 RETURN
1612 END IF
1613 END IF
1614 END DO
1615!
1616! Deallocate arrays.
1617!
1618 IF ( allocated(exportnamelist) ) deallocate (exportnamelist)
1619!
1620 END IF exporting
1621!
1622!-----------------------------------------------------------------------
1623! Add import fields into import state.
1624!-----------------------------------------------------------------------
1625!
1626 importing : IF (nimport(iwave).gt.0) THEN
1627!
1628! Get number of fields to import.
1629!
1630 CALL esmf_stateget (models(iwave)%ImportState(ng), &
1631 & itemcount=importcount, &
1632 & rc=rc)
1633 IF (esmf_logfounderror(rctocheck=rc, &
1634 & msg=esmf_logerr_passthru, &
1635 & line=__line__, &
1636 & file=myfile)) THEN
1637 RETURN
1638 END IF
1639!
1640! Get a list of import fields names.
1641!
1642 IF (.not.allocated(importnamelist)) THEN
1643 allocate (importnamelist(importcount))
1644 END IF
1645 CALL esmf_stateget (models(iwave)%ImportState(ng), &
1646 & itemnamelist=importnamelist, &
1647 & rc=rc)
1648 IF (esmf_logfounderror(rctocheck=rc, &
1649 & msg=esmf_logerr_passthru, &
1650 & line=__line__, &
1651 & file=myfile)) THEN
1652 RETURN
1653 END IF
1654!
1655! Set import field(s).
1656!
1657 DO i=1,importcount
1658 id=field_index(models(iwave)%ImportField, importnamelist(i))
1659!
1660 IF (nuopc_isconnected(models(iwave)%ImportState(ng), &
1661 & fieldname=trim(importnamelist(i)), &
1662 & rc=rc)) THEN
1663
1664!
1665! Set staggering type.
1666!
1667 SELECT CASE (models(iwave)%ImportField(id)%gtype)
1668 CASE (icenter)
1669 staggerloc=esmf_staggerloc_center
1670 END SELECT
1671!
1672! Create 2D field from the Grid, arraySpec. The array indices are
1673! global.
1674!
1675 field=esmf_fieldcreate(models(iwave)%grid(ng), &
1676 & arrayspec, &
1677 & staggerloc=staggerloc, &
1678 & indexflag=esmf_index_global, &
1679 & name=trim(importnamelist(i)), &
1680 & rc=rc)
1681 IF (esmf_logfounderror(rctocheck=rc, &
1682 & msg=esmf_logerr_passthru, &
1683 & line=__line__, &
1684 & file=myfile)) THEN
1685 RETURN
1686 END IF
1687!
1688! Put data into state. Usually, the DO-loop is executed once since
1689! localDEcount=1.
1690!
1691 DO localde=0,localdecount-1
1692!
1693! Get pointer to DE-local memory allocation within field.
1694!
1695 CALL esmf_fieldget (field, &
1696 & localde=localde, &
1697 & farrayptr=ptr2d, &
1698 & rc=rc)
1699 IF (esmf_logfounderror(rctocheck=rc, &
1700 & msg=esmf_logerr_passthru, &
1701 & line=__line__, &
1702 & file=myfile)) THEN
1703 RETURN
1704 END IF
1705!
1706! Initialize pointer.
1707!
1708 ptr2d=missing_dp
1709!
1710! Nullify pointer to make sure that it does not point on a random
1711! part in the memory.
1712!
1713 IF (associated(ptr2d)) nullify (ptr2d)
1714 END DO
1715!
1716! Add field import state.
1717!
1718 CALL nuopc_realize (models(iwave)%ImportState(ng), &
1719 & field=field, &
1720 & rc=rc)
1721 IF (esmf_logfounderror(rctocheck=rc, &
1722 & msg=esmf_logerr_passthru, &
1723 & line=__line__, &
1724 & file=myfile)) THEN
1725 RETURN
1726 END IF
1727!
1728! Remove field from import state because it is not connected.
1729!
1730 ELSE
1731 IF (localpet.eq.0) THEN
1732 WRITE (cplout,10) trim(importnamelist(i)), &
1733 & 'Import State: ', &
1734 & trim(coupled(iwave)%ImpLabel(ng))
1735 END IF
1736 CALL esmf_stateremove (models(iwave)%ImportState(ng), &
1737 & trim(importnamelist(i)), &
1738 & rc=rc)
1739 IF (esmf_logfounderror(rctocheck=rc, &
1740 & msg=esmf_logerr_passthru, &
1741 & line=__line__, &
1742 & file=myfile)) THEN
1743 RETURN
1744 END IF
1745 END IF
1746 END DO
1747!
1748! Deallocate arrays.
1749!
1750 IF (allocated(importnamelist)) deallocate (importnamelist)
1751!
1752 END IF importing
1753!
1754 IF (esm_track) THEN
1755 WRITE (trac,'(a,a,i0)') '<== Exiting WAM_SetStates', &
1756 & ', PET', petrank
1757 FLUSH (trac)
1758 END IF
1759!
1760 RETURN
1761 END SUBROUTINE wam_setstates
1762!
1763 SUBROUTINE wam_modeladvance (model, rc)
1764!
1765!=======================================================================
1766! !
1767! Advance WAM component for a coupling interval (seconds) using !
1768! "WAM_Run". It also calls "WAM_Import" and "WAM_Export" to !
1769! import and export coupling fields, respectively. !
1770! !
1771!=======================================================================
1772!
1773! Imported variable declarations.
1774!
1775 integer, intent(out) :: rc
1776!
1777 TYPE (esmf_gridcomp) :: model
1778!
1779! Local variable declarations.
1780!
1781 integer :: localpet, petcount, phase
1782!
1783 real (r8) :: trun
1784!
1785 character (ESMF_MAXSTR) :: str1, str2
1786
1787 character (len=*), parameter :: myfile = &
1788 & __FILE__//", WAM_ModelAdvance"
1789!
1790 TYPE (esmf_clock) :: clock
1791 TYPE (esmf_state) :: exportstate, importstate
1792 TYPE (esmf_time) :: referencetime
1793 TYPE (esmf_time) :: currenttime, stoptime
1794 TYPE (esmf_timeinterval) :: timestep
1795 TYPE (esmf_vm) :: vm
1796!
1797!-----------------------------------------------------------------------
1798! Initialize return code flag to success state (no error).
1799!-----------------------------------------------------------------------
1800!
1801 IF (esm_track) THEN
1802 WRITE (trac,'(a,a,i0)') '==> Entering WAM_ModelAdvance', &
1803 & ', PET', petrank
1804 FLUSH (trac)
1805 END IF
1806 rc=esmf_success
1807!
1808!-----------------------------------------------------------------------
1809! Get information about the gridded component.
1810!-----------------------------------------------------------------------
1811!
1812 CALL esmf_gridcompget (model, &
1813 & clock=clock, &
1814 & importstate=importstate, &
1815 & exportstate=exportstate, &
1816 & currentphase=phase, &
1817 & vm=vm, &
1818 & rc=rc)
1819 IF (esmf_logfounderror(rctocheck=rc, &
1820 & msg=esmf_logerr_passthru, &
1821 & line=__line__, &
1822 & file=myfile)) THEN
1823 RETURN
1824 END IF
1825!
1826! Get ID for local PET and number of PETs.
1827!
1828 CALL esmf_vmget (vm, &
1829 & localpet=localpet, &
1830 & petcount=petcount, &
1831 & rc=rc)
1832 IF (esmf_logfounderror(rctocheck=rc, &
1833 & msg=esmf_logerr_passthru, &
1834 & line=__line__, &
1835 & file=myfile)) THEN
1836 RETURN
1837 END IF
1838!
1839!-----------------------------------------------------------------------
1840! Get driver time step interval, stopping time, reference time, and
1841! current time.
1842!-----------------------------------------------------------------------
1843!
1844 CALL esmf_clockget (clock, &
1845 & timestep=timestep, &
1846 & stoptime=stoptime, &
1847 & reftime=reftime, &
1848 & currtime=currenttime, &
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!-----------------------------------------------------------------------
1858! Get time interval (seconds, double precision).
1859!-----------------------------------------------------------------------
1860!
1861 CALL esmf_timeintervalget (timestep, &
1862 & s_r8=trun, &
1863 & rc=rc)
1864 IF (esmf_logfounderror(rctocheck=rc, &
1865 & msg=esmf_logerr_passthru, &
1866 & line=__line__, &
1867 & file=myfile)) THEN
1868 RETURN
1869 END IF
1870!
1871!-----------------------------------------------------------------------
1872! Debugging: report time information string (YYYY-MM-DD hh:mm:ss).
1873!-----------------------------------------------------------------------
1874!
1875 IF ((debuglevel.ge.0).and.(localpet.eq.0)) THEN
1876!
1877! Current driver time.
1878!
1879 CALL esmf_timeget (currenttime, &
1880 & timestringisofrac=str1, &
1881 & rc=rc)
1882 IF (esmf_logfounderror(rctocheck=rc, &
1883 & msg=esmf_logerr_passthru, &
1884 & line=__line__, &
1885 & file=myfile)) THEN
1886 RETURN
1887 END IF
1888!
1889! Next driver coupling time.
1890!
1891 CALL esmf_timeget (currenttime+timestep, &
1892 & timestringisofrac=str2, &
1893 & rc=rc)
1894 IF (esmf_logfounderror(rctocheck=rc, &
1895 & msg=esmf_logerr_passthru, &
1896 & line=__line__, &
1897 & file=myfile)) THEN
1898 RETURN
1899 END IF
1900!
1901 IF (debuglevel.eq.0) THEN
1902 WRITE (cplout,10) trim(str1), trim(str2), phase
1903 ELSE
1904 WRITE (cplout,20) trim(str1), trim(str2), phase, trun
1905 END IF
1906 END IF
1907!
1908!-----------------------------------------------------------------------
1909! Get import fields.
1910!-----------------------------------------------------------------------
1911!
1912 IF ((nimport(iwave).gt.0).and. &
1913 & (currenttime.ne.reftime).or.restarted)) THEN
1914 DO ng=1,models(iwave)%Ngrids
1915 IF (any(coupled(iwave)%LinkedGrid(ng,:))) THEN
1916 CALL wam_import (ng, model, rc=rc)
1917 IF (esmf_logfounderror(rctocheck=rc, &
1918 & msg=esmf_logerr_passthru, &
1919 & line=__line__, &
1920 & file=myfile)) THEN
1921 RETURN
1922 END IF
1923 END IF
1924 END DO
1925 END IF
1926!
1927!-----------------------------------------------------------------------
1928! Run WAM component.
1929!-----------------------------------------------------------------------
1930!
1931 CALL wam_run ()
1932!
1933!-----------------------------------------------------------------------
1934! Put export fields.
1935!-----------------------------------------------------------------------
1936!
1937 IF (nexport(iwave).gt.0) THEN
1938 DO ng=1,models(iwave)%Ngrids
1939 IF (any(coupled(iwave)%LinkedGrid(ng,:))) THEN
1940 CALL wam_export (ng, model, rc)
1941 IF (esmf_logfounderror(rctocheck=rc, &
1942 & msg=esmf_logerr_passthru, &
1943 & line=__line__, &
1944 & file=myfile)) THEN
1945 RETURN
1946 END IF
1947 END IF
1948 END DO
1949 END IF
1950!
1951 IF (esm_track) THEN
1952 WRITE (trac,'(a,a,i0)') '<== Exiting WAM_ModelAdvance', &
1953 & ', PET', petrank
1954 FLUSH (trac)
1955 END IF
1956 FLUSH (cplout)
1957!
1958 10 FORMAT (/,' ESMF, Running WAM: ',a,' --> ',a,' Phase: ',i1)
1959 20 FORMAT (/,' ESMF, Running WAV: ',a,' --> ',a,' Phase: ',i1, &
1960 & ' [', f15.2, ' s]')
1961
1962 RETURN
1963 END SUBROUTINE wam_modeladvance
1964!
1965 SUBROUTINE wam_setfinalize (model, &
1966 & ImportState, ExportState, &
1967 & clock, rc)
1968!
1969!=======================================================================
1970! !
1971! Finalize WAM component execution. It calls WAM_finalize. !
1972! !
1973!=======================================================================
1974!
1975! Imported variable declarations.
1976!
1977 integer, intent(out) :: rc
1978!
1979 TYPE (esmf_clock) :: clock
1980 TYPE (esmf_gridcomp) :: model
1981 TYPE (esmf_state) :: exportstate
1982 TYPE (esmf_state) :: importstate
1983!
1984! Local variable declarations.
1985!
1986 character (len=*), parameter :: myfile = &
1987 & __FILE__//", WAM_SetFinalize"
1988!
1989!-----------------------------------------------------------------------
1990! Initialize return code flag to success state (no error).
1991!-----------------------------------------------------------------------
1992!
1993 IF (esm_track) THEN
1994 WRITE (trac,'(a,a,i0)') '==> Entering WAM_SetFinalize', &
1995 & ', PET', petrank
1996 FLUSH (trac)
1997 END IF
1998 rc=esmf_success
1999!
2000!-----------------------------------------------------------------------
2001! Finalize WAM component.
2002!-----------------------------------------------------------------------
2003!
2004 CALL wam_finalize ()
2005 FLUSH (6) ! flush standard output buffer
2006!
2007 IF (esm_track) THEN
2008 WRITE (trac,'(a,a,i0)') '<== Exiting WAM_SetFinalize', &
2009 & ', PET', petrank
2010 FLUSH (trac)
2011 END IF
2012!
2013 RETURN
2014 END SUBROUTINE wam_setfinalize
2015!
2016 SUBROUTINE wam_import (ng, model, rc)
2017!
2018!=======================================================================
2019! !
2020! Imports fields into WAM array structures. The fields aew loaded !
2021! into the snapshot storage arrays to allow time interpolation in !
2022! WAM kernel. !
2023! !
2024!=======================================================================
2025!
2026 USE wam_grid_module, ONLY : nx, ny, nsea, l_s_mask
2027 USE wam_user_interface, ONLY : us_esmf, vs_esmf
2028!
2029! Imported variable declarations.
2030!
2031 integer, intent(in) :: ng
2032 integer, intent(out) :: rc
2033!
2034 TYPE (esmf_gridcomp) :: model
2035!
2036! Local variable declarations.
2037!
2038 integer :: id, ifld, tile
2039 integer :: iyear, iday, imonth, ihour
2040 integer :: localpet
2041!
2042 real (dp) :: add_offset, scale
2043!
2044 real (dp), allocatable :: arr2d(:,:)
2045!
2046 character (ESMF_MAXSTR) :: ofile
2047 character (ESMF_MAXSTR), allocatable :: importnamelist(:)
2048
2049 character (len=*), parameter :: myfile = &
2050 & __FILE__//", WAM_Import"
2051!
2052 TYPE (esmf_clock) :: clock
2053 TYPE (esmf_field) :: field
2054 TYPE (esmf_time) :: currenttime
2055 TYPE (esmf_vm) :: vm
2056!
2057!-----------------------------------------------------------------------
2058! Initialize return code flag to success state (no error).
2059!-----------------------------------------------------------------------
2060!
2061 IF (esm_track) THEN
2062 WRITE (trac,'(a,a,i0)') '==> Entering WAM_Import', &
2063 & ', PET', petrank
2064 FLUSH (trac)
2065 END IF
2066 rc=esmf_success
2067!
2068!-----------------------------------------------------------------------
2069! Get information about the gridded component.
2070!-----------------------------------------------------------------------
2071!
2072 CALL esmf_gridcompget (model, &
2073 & clock=clock, &
2074 & localpet=localpet, &
2075 & vm=vm, &
2076 & rc=rc)
2077 IF (esmf_logfounderror(rctocheck=rc, &
2078 & msg=esmf_logerr_passthru, &
2079 & line=__line__, &
2080 & file=myfile)) THEN
2081 RETURN
2082 END IF
2083!
2084!-----------------------------------------------------------------------
2085! Get current time.
2086!-----------------------------------------------------------------------
2087!
2088 CALL esmf_clockget (clock, &
2089 & currtime=currenttime, &
2090 & rc=rc)
2091 IF (esmf_logfounderror(rctocheck=rc, &
2092 & msg=esmf_logerr_passthru, &
2093 & line=__line__, &
2094 & file=myfile)) THEN
2095 RETURN
2096 END IF
2097!
2098 CALL esmf_timeget (currenttime, &
2099 & yy=iyear, &
2100 & mm=imonth, &
2101 & dd=iday, &
2102 & h=ihour, &
2103 & rc=rc)
2104 IF (esmf_logfounderror(rctocheck=rc, &
2105 & msg=esmf_logerr_passthru, &
2106 & line=__line__, &
2107 & file=myfile)) THEN
2108 RETURN
2109 END IF
2110!
2111!-----------------------------------------------------------------------
2112! Get list of import fields.
2113!-----------------------------------------------------------------------
2114!
2115 CALL esmf_stateget (models(iwave)%ImportState(ng), &
2116 & itemcount=importcount, &
2117 & rc=rc)
2118 IF (esmf_logfounderror(rctocheck=rc, &
2119 & msg=esmf_logerr_passthru, &
2120 & line=__line__, &
2121 & file=myfile)) THEN
2122 RETURN
2123 END IF
2124!
2125 IF (.not.allocated(importnamelist)) THEN
2126 allocate ( importnamelist(importcount) )
2127 END IF
2128 CALL esmf_stateget (models(iwave)%ImportState(ng), &
2129 & itemnamelist=importnamelist, &
2130 & rc=rc)
2131 IF (esmf_logfounderror(rctocheck=rc, &
2132 & msg=esmf_logerr_passthru, &
2133 & line=__line__, &
2134 & file=myfile)) THEN
2135 RETURN
2136 END IF
2137!
2138!-----------------------------------------------------------------------
2139! Get import fields.
2140!-----------------------------------------------------------------------
2141!
2142 fld_loop : DO ifld=1,importcount
2143 id=field_index(models(iwave)%ImportField, importnamelist(ifld))
2144!
2145! Get field from import state.
2146!
2147 CALL esmf_stateget (models(iwave)%ImportState(ng), &
2148 & trim(importnamelist(ifld)), &
2149 & field, &
2150 & rc=rc)
2151 IF (esmf_logfounderror(rctocheck=rc, &
2152 & msg=esmf_logerr_passthru, &
2153 & line=__line__, &
2154 & file=myfile)) THEN
2155 RETURN
2156 END IF
2157!
2158! Collect field from all PETs.
2159!
2160 IF (.not. allocated(arr2d)) THEN
2161 allocate ( arr2d(nx,ny) )
2162 END IF
2163!
2164 DO tile=0,petcount-1
2165 CALL esmf_fieldgather (field, &
2166 & arr2d, &
2167 & rootpet=tile, &
2168 & vm=vm, &
2169 & rc=rc)
2170 IF (esmf_logfounderror(rctocheck=rc, &
2171 & msg=esmf_logerr_passthru, &
2172 & line=__line__, &
2173 & file=myfile)) THEN
2174 RETURN
2175 END IF
2176 END DO
2177!
2178! Debugging: write size of pointer.
2179!
2180 IF (debuglevel.gt.1) THEN
2181 WRITE (cplout,10) localpet, tile, &
2182 & adjustl("IND/WAV/IMP/"//importnamelist(ifld)), &
2183 & 1, nx, 1, ny
2184 END IF
2185!
2186! Load import data into WAM component variable.
2187! (HGA: It is kind of weird that everything is loaded into us_esmf
2188! and vs_esmf)
2189!
2190 scale=models(iwave)%ImportField(id)%scale_factor
2191 add_offset=models(iwave)%ImportField(id)%add_offset
2192!
2193 SELECT CASE (trim(adjustl(importnamelist(ifld))))
2194!
2195! Surface eastward wind component (m s-1).
2196!
2197 CASE ('wndu')
2198 us_esmf(1:nsea)=pack(arr2d, l_s_mask)
2199 us_esmf(1:nsea)=(us_esmf(1:nsea)*scale)+add_offset
2200!
2201! Surface northward wind component (m s-1).
2202!
2203 CASE ('wndv')
2204 vs_esmf(1:nsea)=pack(arr2d, l_s_mask)
2205 vs_esmf(1:nsea)=(vs_esmf(1:nsea)*scale)+add_offset
2206!
2207! Friction velocity (m s-1).
2208!
2209 CASE ('ustr')
2210 us_esmf(1:nsea)=pack(arr2d, l_s_mask)
2211 us_esmf(1:nsea)=(us_esmf(1:nsea)*scale)+add_offset
2212!
2213! Direction. (HGA: ???)
2214!
2215 CASE ('wdir')
2216 vs_esmf(1:nsea)=pack(arr2d, l_s_mask)
2217 vs_esmf(1:nsea)=(vs_esmf(1:nsea)*scale)+add_offset
2218 END SELECT
2219!
2220! Debugging: write field into a NetCDF file.
2221!
2222 IF ((debuglevel.ge.3).and. &
2223 & models(iwave)%ImportField(id)%debug_write) THEN
2224 WRITE (ofile,20) 'wam_import', trim(importnamelist(ifld)), &
2225 & iyear, imonth, iday, ihour
2226 CALL esmf_fieldwrite (field, &
2227 & trim(ofile), &
2228 & overwrite=.true., &
2229 & rc=rc)
2230 IF (esmf_logfounderror(rctocheck=rc, &
2231 & msg=esmf_logerr_passthru, &
2232 & line=__line__, &
2233 & file=myfile)) THEN
2234 RETURN
2235 END IF
2236 END IF
2237 END DO fld_loop
2238!
2239!-----------------------------------------------------------------------
2240! Deallocate arrays
2241!-----------------------------------------------------------------------
2242!
2243 IF (allocated(importnamelist)) deallocate (importnamelist)
2244 IF (allocated(arr2d)) deallocate (arr2d)
2245!
2246 IF (esm_track) THEN
2247 WRITE (trac,'(a,a,i0)') '<== Exiting WAM_Import', &
2248 & ', PET', petrank
2249 FLUSH (trac)
2250 END IF
2251 IF (debuglevel.gt.0) FLUSH (cplout)
2252!
2253 10 FORMAT (' PET(',i3,') - tile(',i2,') - ', a20, ' : ', 4i8)
2254 20 FORMAT (a,'_',a,'_',i4.4,3('-',i2.2),'.nc')
2255
2256 RETURN
2257 END SUBROUTINE wam_import
2258!
2259 SUBROUTINE wam_export (ng, model, rc)
2260!
2261!=======================================================================
2262! !
2263! Exports WAM fields to other coupled gridded components. !
2264! !
2265!=======================================================================
2266!
2267 USE wam_model_module, ONLY : z0, ustar, tauw
2268!
2269! Imported variable declarations.
2270!
2271 integer, intent(out) :: rc
2272!
2273 TYPE (esmf_gridcomp) :: model
2274!
2275! Local variable declarations.
2276!
2277 integer :: ifld, imin, imax, jmin, jmax
2278 integer :: iyear, iday, imonth, ihour
2279 integer :: exportcount
2280 integer :: localde, localdecount, localpet, petcount
2281!
2282 real (r8), pointer :: ptr(:,:) => null()
2283!
2284 character (ESMF_MAXSTR) :: ofile
2285 character (ESMF_MAXSTR), allocatable :: importnamelist(:)
2286
2287 character (len=*), parameter :: myfile = &
2288 & __FILE__//", WAM_Export"
2289!
2290 TYPE (esmf_clock) :: clock
2291 TYPE (esmf_field) :: field
2292 TYPE (esmf_state) :: exportstate
2293 TYPE (esmf_time) :: currenttime
2294 TYPE (esmf_vm) :: vm
2295!
2296!-----------------------------------------------------------------------
2297! Initialize return code flag to success state (no error).
2298!-----------------------------------------------------------------------
2299!
2300 IF (esm_track) THEN
2301 WRITE (trac,'(a,a,i0)') '==> Entering WAM_Export', &
2302 & ', PET', petrank
2303 FLUSH (trac)
2304 END IF
2305 rc=esmf_success
2306!
2307!-----------------------------------------------------------------------
2308! Get information about the gridded component.
2309!-----------------------------------------------------------------------
2310!
2311 CALL esmf_gridcompget (model, &
2312 & clock=clock, &
2313 & vm=vm, &
2314 & rc=rc)
2315 IF (esmf_logfounderror(rctocheck=rc, &
2316 & msg=esmf_logerr_passthru, &
2317 & line=__line__, &
2318 & file=myfile)) THEN
2319 RETURN
2320 END IF
2321!
2322! Get ID for local PET and number of PETs.
2323!
2324 CALL esmf_vmget (vm, &
2325 & localpet=localpet, &
2326 & petcount=petcount, &
2327 & rc=rc)
2328 IF (esmf_logfounderror(rctocheck=rc, &
2329 & msg=esmf_logerr_passthru, &
2330 & line=__line__, &
2331 & file=myfile)) THEN
2332 RETURN
2333 END IF
2334!
2335! Get number of local decomposition elements (DEs). Usually, a single
2336! DE is associated with each Persistent Execution Thread (PETs). Thus,
2337! localDEcount=1.
2338!
2339 CALL esmf_gridget (models(iwave)%grid(ng), &
2340 & localdecount=localdecount, &
2341 & rc=rc)
2342 IF (esmf_logfounderror(rctocheck=rc, &
2343 & msg=esmf_logerr_passthru, &
2344 & line=__line__, &
2345 & file=myfile)) THEN
2346 RETURN
2347 END IF
2348!
2349!-----------------------------------------------------------------------
2350! Get current time.
2351!-----------------------------------------------------------------------
2352!
2353 CALL esmf_clockget (clock, &
2354 & currtime=currenttime, &
2355 & rc=rc)
2356 IF (esmf_logfounderror(rctocheck=rc, &
2357 & msg=esmf_logerr_passthru, &
2358 & line=__line__, &
2359 & file=myfile)) THEN
2360 RETURN
2361 END IF
2362!
2363 CALL esmf_timeget (currenttime, &
2364 & yy=iyear, &
2365 & mm=imonth, &
2366 & dd=iday, &
2367 & h=ihour, &
2368 & rc=rc)
2369 IF (esmf_logfounderror(rctocheck=rc, &
2370 & msg=esmf_logerr_passthru, &
2371 & line=__line__, &
2372 & file=myfile)) THEN
2373 RETURN
2374 END IF
2375!
2376!-----------------------------------------------------------------------
2377! Get list of export fields.
2378!-----------------------------------------------------------------------
2379!
2380 CALL esmf_stateget (models(iwave)%ExportState(ng), &
2381 & itemcount=exportcount, &
2382 & rc=rc)
2383 IF (esmf_logfounderror(rctocheck=rc, &
2384 & msg=esmf_logerr_passthru, &
2385 & line=__line__, &
2386 & file=myfile)) THEN
2387 RETURN
2388 END IF
2389!
2390 IF (.not. allocated(exportnamelist)) THEN
2391 allocate ( exportnamelist(exportcount) )
2392 END IF
2393!
2394 CALL esmf_stateget (models(iwave)%ExportState(ng), &
2395 & itemnamelist=exportnamelist, &
2396 & rc=rc)
2397 IF (esmf_logfounderror(rctocheck=rc, &
2398 & msg=esmf_logerr_passthru, &
2399 & line=__line__, &
2400 & file=myfile)) THEN
2401 RETURN
2402 END IF
2403!
2404!-----------------------------------------------------------------------
2405! Load export fields.
2406!-----------------------------------------------------------------------
2407!
2408 fld_loop : DO ifld=1,exportcount
2409!
2410! Get field from export field.
2411!
2412 CALL esmf_stateget (models(iwave)%ExportState(ng), &
2413 & trim(exportnamelist(ifld)), &
2414 & field, &
2415 & rc=rc)
2416 IF (esmf_logfounderror(rctocheck=rc, &
2417 & msg=esmf_logerr_passthru, &
2418 & line=__line__, &
2419 & file=myfile)) THEN
2420 RETURN
2421 END IF
2422!
2423! Get field pointer. Usually, the DO-loop is executed once since
2424! localDEcount=1.
2425!
2426 de_loop : DO localde=0,localdecount-1
2427 CALL esmf_fieldget (field, &
2428 & localde=localde, &
2429 & farrayptr=ptr, &
2430 & rc=rc)
2431 IF (esmf_logfounderror(rctocheck=rc, &
2432 & msg=esmf_logerr_passthru, &
2433 & line=__line__, &
2434 & file=myfile)) THEN
2435 RETURN
2436 END IF
2437!
2438! Initialize pointer to missing value.
2439!
2440 ptr=missing_r8
2441!
2442! Load field data into export state.
2443!
2444 imin=lbound(ptr, dim=1)
2445 imax=ubound(ptr, dim=1)
2446 jmin=lbound(ptr, dim=2)
2447 jmax=ubound(ptr, dim=2)
2448!
2449 SELECT CASE (trim(adjustl(exportnamelist(ifld))))
2450!
2451! Surface roughness length scale (m).
2452!
2453 CASE ('zo', 'Zo')
2454 CALL wam_unpack (vm, ptr, imin, imax, jmin, jmax, &
2455 & z0, rc)
2456 IF (esmf_logfounderror(rctocheck=rc, &
2457 & msg=esmf_logerr_passthru, &
2458 & line=__line__, &
2459 & file=myfile)) THEN
2460 RETURN
2461 END IF
2462!
2463! Friction velocity (m s-1).
2464!
2465 CASE ('ustar')
2466 CALL wam_unpack (vm, ptr, imin, imax, jmin, jmax, &
2467 & ustar, rc)
2468 IF (esmf_logfounderror(rctocheck=rc, &
2469 & msg=esmf_logerr_passthru, &
2470 & line=__line__, &
2471 & file=myfile)) THEN
2472 RETURN
2473 END IF
2474!
2475!
2476 CASE ('tauw')
2477 CALL wam_unpack (vm, ptr, imin, imax, jmin, jmax, &
2478 & tauw, rc)
2479 IF (esmf_logfounderror(rctocheck=rc, &
2480 & msg=esmf_logerr_passthru, &
2481 & line=__line__, &
2482 & file=myfile)) THEN
2483 RETURN
2484 END IF
2485 END SELECT
2486!
2487! Nullify pointer to make sure that it does not point on a random
2488! part in the memory.
2489!
2490 IF (associated(ptr)) nullify (ptr)
2491 END DO de_loop
2492!
2493! Debugging: write out field into a netCDF format
2494!
2495 IF ((debuglevel.ge.3).and. &
2496 & models(iwave)%ExportField(ifld)%debug_write) THEN
2497 WRITE (ofile,10) ng, trim(exportnamelist(ifld)), &
2498 & iyear, imonth, iday, ihour
2499 CALL esmf_fieldwrite (field, &
2500 & trim(ofile), &
2501 & overwrite=.true., &
2502 & rc=rc)
2503 IF (esmf_logfounderror(rctocheck=rc, &
2504 & msg=esmf_logerr_passthru, &
2505 & line=__line__, &
2506 & file=myfile)) THEN
2507 RETURN
2508 END IF
2509 END IF
2510 END DO fld_loop
2511!
2512! Deallocate array.
2513!
2514 IF (allocated(exportnamelist)) deallocate (exportnamelist)
2515!
2516 IF (esm_track) THEN
2517 WRITE (trac,'(a,a,i0)') '<== Exitinh WAM_Export', &
2518 & ', PET', petrank
2519 FLUSH (trac)
2520 END IF
2521!
2522 10 FORMAT ('wam_',i2.2,'_export_',a,'_',i4.4,3('-',i2.2),'.nc')
2523
2524 RETURN
2525 END SUBROUTINE wam_export
2526!
2527 SUBROUTINE wam_unpack (vm, ptr, imin, imax, jmin, jmax, var, rc)
2528!
2529!=======================================================================
2530! !
2531! Unpacks WAM component export variable and load it into pointer !
2532! after collecting data from all MPI nodes. !
2533! !
2534!=======================================================================
2535!
2536 USE wam_mpi_module, ONLY : nstart, nend, pelocal, irank
2537 USE wam_grid_module, ONLY : nx, ny, nsea, l_s_mask
2538!
2539! Imported variable declarations.
2540!
2541 integer, intent(in) :: imin, imax, jmin, jmax
2542 integer, intent(inout) :: rc
2543!
2544 real (r4), intent(in) :: var(1:nsea)
2545 real (r8), intent(inout) :: ptr(imin:imax,jmin:jmax)
2546!
2547 TYPE (esmf_vm), intent(in) :: vm
2548!
2549! Local variable declarations.
2550!
2551 integer :: localpet, petcount
2552 integer :: i, j, k, ii, jj, ijs, ijl
2553!
2554 integer (i4b), allocatable :: offsets_recv(:)
2555 integer (i4b), allocatable :: blocksize(:)
2556!
2557 real (r4), allocatable :: work1(:), work2(:,:)
2558!
2559 character (len=*), parameter :: myfile = &
2560 & __FILE__//", WAM_Unpack"
2561!
2562!-----------------------------------------------------------------------
2563! Initialize return code flag to success state (no error).
2564!-----------------------------------------------------------------------
2565!
2566 IF (esm_track) THEN
2567 WRITE (trac,'(a,a,i0)') '==> Entering WAM_Unpack', &
2568 & ', PET', petrank
2569 FLUSH (trac)
2570 END IF
2571 rc=esmf_success
2572!
2573!-----------------------------------------------------------------------
2574! Querry the Virtual Machine (VM) parallel environmemt for the MPI
2575! current node rank and number of nodes.
2576!-----------------------------------------------------------------------
2577!
2578 CALL esmf_vmget (vm, &
2579 & localpet=localpet, &
2580 & petcount=petcount, &
2581 & rc=rc)
2582 IF (esmf_logfounderror(rctocheck=rc, &
2583 & msg=esmf_logerr_passthru, &
2584 & line=__line__, &
2585 & file=myfile)) THEN
2586 RETURN
2587 END IF
2588!
2589!-----------------------------------------------------------------------
2590! Allocate local work arrays.
2591!-----------------------------------------------------------------------
2592!
2593 IF (.not.allocated(work1)) THEN
2594 allocate ( work1(1:nsea) )
2595 work1=0.0_r4
2596 end if
2597 IF (.not. allocated(work2)) THEN
2598 allocate ( work2(nx,ny) )
2599 work2=0.0_r4
2600 END IF
2601!
2602 IF (.not. allocated(blocksize)) THEN
2603 allocate ( blocksize(petcount) )
2604 blocksize=0_i4b
2605 END IF
2606 IF (.not.allocated(offsets_recv)) THEN
2607 allocate ( offsets_recv(petcount) )
2608 offsets_recv=0_i4b
2609 END IF
2610!
2611!-----------------------------------------------------------------------
2612! Collect block size from each PET.
2613!-----------------------------------------------------------------------
2614!
2615 ijs=nstart(irank)
2616 ijl=nend(irank)
2617!
2618 CALL esmf_vmallgatherv (vm,
2619 & senddata=(/ ijl-ijs+1 /), &
2620 & sendcount=1, &
2621 & recvdata=blocksize, &
2622 & recvcounts=(/ (1, k=0,petcount-1) /), &
2623 & recvoffsets=(/ (k, k=0,petcount-1) /), &
2624 & rc=rc)
2625 IF (esmf_logfounderror(rctocheck=rc, &
2626 & msg=esmf_logerr_passthru, &
2627 & line=__line__, &
2628 & file=myfile)) THEN
2629 RETURN
2630 END IF
2631!
2632 CALL esmf_vmallgatherv (vm,
2633 & senddata= (/ ijs-1 /), &
2634 & sendcount=1, &
2635 & recvdata=offsets_recv, &
2636 & recvcounts=(/ (1, k=0,petcount-1) /), &
2637 & recvoffsets=(/ (k, k=0,petcount-1) /), &
2638 & rc=rc)
2639 IF (esmf_logfounderror(rctocheck=rc, &
2640 & msg=esmf_logerr_passthru, &
2641 & line=__line__, &
2642 & file=myfile)) THEN
2643 RETURN
2644 END IF
2645!
2646!-----------------------------------------------------------------------
2647! Collect data from each PET.
2648!-----------------------------------------------------------------------
2649!
2650 CALL esmf_vmallgatherv (vm, &
2651 & senddata=var(1:blocksize(irank)), &
2652 & sendcount=blocksize(irank), &
2653 & recvdata=work1, &
2654 & recvcounts=blocksize, &
2655 & recvoffsets=offsets_recv, &
2656 & rc=rc)
2657 IF (esmf_logfounderror(rctocheck=rc, &
2658 & msg=esmf_logerr_passthru, &
2659 & line=__line__, &
2660 & file=myfile)) THEN
2661 RETURN
2662 END IF
2663!
2664!-----------------------------------------------------------------------
2665! Unpack data and fill pointer.
2666!-----------------------------------------------------------------------
2667!
2668 work2=unpack(work1, l_s_mask, missing_r4)
2669!
2670 DO j =jmin,jmax
2671 DO i=imin,imax
2672 IF (work2(i,j).lt.tol_r4) THEN
2673 ptr(i,j)=work2(i,j)
2674 END IF
2675 END DO
2676 END DO
2677!
2678!-----------------------------------------------------------------------
2679! Deallocate local work arrays.
2680!-----------------------------------------------------------------------
2681!
2682 IF (allocated(work1)) deallocate (work1)
2683 IF (allocated(work2)) deallocate (work2)
2684 IF (allocated(blocksize)) deallocate (blocksize)
2685 IF (allocated(offsets_recv)) deallocate (offsets_recv)
2686!
2687 IF (esm_track) THEN
2688 WRITE (trac,'(a,a,i0)') '<== Exiting WAM_Unpack', &
2689 & ', PET', petrank
2690 FLUSH (trac)
2691 END IF
2692!
2693 RETURN
2694 END SUBROUTINE wam_unpack
2695!
2696#endif
2697 END MODULE esmf_wam_mod
esmf_wam_mod
Definition esmf_wav_wam.h:1
esmf_wam_mod::wam_setinitializep1
subroutine, private wam_setinitializep1(model, importstate, exportstate, clock, rc)
Definition esmf_wav_wam.h:265
esmf_wam_mod::wam_checkimport
subroutine, private wam_checkimport(model, rc)
Definition esmf_wav_wam.h:929
esmf_wam_mod::wam_setstates
subroutine, private wam_setstates(ng, model, rc)
Definition esmf_wav_wam.h:1402
esmf_wam_mod::wav_setservices
subroutine, public wav_setservices(model, rc)
Definition esmf_wav_wam.h:105
esmf_wam_mod::wam_import
subroutine, private wam_import(ng, model, rc)
Definition esmf_wav_wam.h:2017
esmf_wam_mod::wam_unpack
subroutine, private wam_unpack(vm, ptr, imin, imax, jmin, jmax, var, rc)
Definition esmf_wav_wam.h:2528
esmf_wam_mod::wam_datainit
subroutine, private wam_datainit(model, rc)
Definition esmf_wav_wam.h:518
esmf_wam_mod::wam_setgridarrays
subroutine, private wam_setgridarrays(ng, model, localpet, rc)
Definition esmf_wav_wam.h:1121
esmf_wam_mod::wam_setfinalize
subroutine, private wam_setfinalize(model, importstate, exportstate, clock, rc)
Definition esmf_wav_wam.h:1968
esmf_wam_mod::wam_setclock
subroutine, private wam_setclock(model, rc)
Definition esmf_wav_wam.h:593
esmf_wam_mod::wam_setinitializep2
subroutine, private wam_setinitializep2(model, importstate, exportstate, clock, rc)
Definition esmf_wav_wam.h:405
esmf_wam_mod::wam_export
subroutine, private wam_export(ng, model, rc)
Definition esmf_wav_wam.h:2260
esmf_wam_mod::wam_modeladvance
subroutine, private wam_modeladvance(model, rc)
Definition esmf_wav_wam.h:1764
mod_esmf_esm
Definition mod_esmf_esm.F:2
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::debuglevel
integer debuglevel
Definition mod_esmf_esm.F:527
mod_esmf_esm::iwave
integer iwave
Definition mod_esmf_esm.F:437
mod_esmf_esm::missing_r8
real(r8), parameter missing_r8
Definition mod_esmf_esm.F:677
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::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::tol_r4
real(r4), parameter tol_r4
Definition mod_esmf_esm.F:680
mod_esmf_esm::clockinfo
type(esm_clock), dimension(:), allocatable, target clockinfo
Definition mod_esmf_esm.F:396
mod_esmf_esm::nimport
integer, dimension(:), allocatable nimport
Definition mod_esmf_esm.F:450
mod_esmf_esm::petrank
integer petrank
Definition mod_esmf_esm.F:481
mod_esmf_esm::missing_r4
real(r4), parameter missing_r4
Definition mod_esmf_esm.F:676
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