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