ROMS
Loading...
Searching...
No Matches
esmf_ice_cice.h
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE esmf_roms_mod
3
4#if defined CICE_COUPLING && defined ESMF_LIB
5!
6!git $Id$
7!=======================================================================
8! Copyright (c) 2002-2025 The ROMS Group !
9! Licensed under a MIT/X style license Hernan G. Arango !
10! See License_ROMS.md Ufuk Utku Turuncoglu !
11!=======================================================================
12! !
13! This module sets CICE as the sea-ice model gridded component !
14! using the generic ESMF/NUOPC layer: !
15! !
16! ICE_SetServices Sets CICE component shared-object entry !
17! points using NUPOC generic methods for !
18! "initialize", "run", and "finalize". !
19! !
20! CICE_SetInitializeP1 CICE component phase 1 initialization: !
21! sets import and export fields long and !
22! short names into its respective state. !
23! !
24! CICE_SetInitializeP2 CICE component phase 2 initialization: !
25! Initializes component (CICE_Initialize), !
26! sets component grid (CICE_SetGridArrays), !
27! and adds fields into import and export !
28! into respective states (CICE_SetStates). !
29! !
30! CICE_DataInit Exports CICE component fields during !
31! initialization or restart. !
32! !
33! CICE_SetClock Sets CICE component date calendar, start !
34! and stop times, and coupling interval. !
35! !
36! CICE_CheckImport Checks if CICE component import field is !
37! at the correct time. !
38! !
39! CICE_SetGridArrays Sets CICE component horizontal grid !
40! arrays, grid area, and land/sea mask. !
41! !
42! CICE_SetStates Adds CICE component export and import !
43! fields into its respective state. !
44! !
45! CICE_ModelAdvance Advances CICE component for a coupling !
46! interval. It calls import and export !
47! routines. !
48! !
49! CICE_SetFinalize Finalizes CICE component execution. !
50! !
51! CICE_Import Imports fields into CICE from other !
52! gridded components. !
53! !
54! CICE_Export Exports CICE fields to other gridded !
55! components. !
56! !
57! ESMF: Earth System Modeling Framework (Version 7 or higher) !
58! https://www.earthsystemcog.org/projects/esmf !
59! !
60! NUOPC: National Unified Operational Prediction Capability !
61! https://www.earthsystemcog.org/projects/nuopc !
62! !
63! CICE: Los Alamos Sea Ice Model !
64! http://oceans11.lanl.gov/trac/CICE !
65! https://esgf.esrl.noaa.gov/projects/couplednems/cice_cap !
66! !
67!=======================================================================
68!
69 USE esmf
70 USE nuopc
71 USE nuopc_model, &
72 & nuopc_setservices => setservices, &
73 & nuopc_label_advance => label_advance, &
74 & nuopc_label_datainitialize => label_datainitialize, &
75 & nuopc_label_setclock => label_setclock
76!
77 USE mod_esmf_esm ! ESM coupling structures and variables
78!
79 USE cice_initmod, ONLY : cice_initialize
80 USE cice_runmod, ONLY : cice_run
81 USE cice_finalmod, ONLY : cice_finalize
82!
83 implicit none
84!
85 PUBLIC :: ice_setservices
86
87 PRIVATE :: cice_setinitializep1
88 PRIVATE :: cice_setinitializep2
89 PRIVATE :: cice_datainit
90 PRIVATE :: cice_setclock
91 PRIVATE :: cice_setgridarrays
92 PRIVATE :: cice_setstates
93 PRIVATE :: cice_modeladvance
94 PRIVATE :: cice_setfinalize
95 PRIVATE :: cice_import
96 PRIVATE :: cice_export
97!
98 CONTAINS
99!
100 SUBROUTINE ice_setservices (model, rc)
101!
102!=======================================================================
103! !
104! Sets CICE component shared-object entry points for "initialize", !
105! "run", and "finalize" by using NUOPC generic methods. !
106! !
107!=======================================================================
108!
109! Imported variable declarations.
110!
111 integer, intent(out) :: rc
112!
113 TYPE (esmf_gridcomp) :: model
114!
115! Local variable declarations.
116!
117 character (len=*), parameter :: myfile = &
118 & __FILE__//", ICE_SetServices"
119!
120!-----------------------------------------------------------------------
121! Initialize return code flag to success state (no error).
122!-----------------------------------------------------------------------
123!
124 IF (esm_track) THEN
125 WRITE (trac,'(a,a,i0)') '==> Entering ICE_SetServices', &
126 & ', PET', petrank
127 FLUSH (trac)
128 END IF
129 rc=esmf_success
130
131!-----------------------------------------------------------------------
132! Register NUOPC generic routines.
133!-----------------------------------------------------------------------
134!
135 CALL nuopc_compderive (model, &
136 & nuopc_setservices, &
137 & rc=rc)
138 IF (esmf_logfounderror(rctocheck=rc, &
139 & msg=esmf_logerr_passthru, &
140 & line=__line__, &
141 & file=myfile)) THEN
142 RETURN
143 END IF
144!
145!-----------------------------------------------------------------------
146! Register initialize routines.
147!-----------------------------------------------------------------------
148!
149! Set routine for Phase 1 initialization (import and export fields).
150!
151 CALL nuopc_compsetentrypoint (model, &
152 & methodflag=esmf_method_initialize, &
153 & phaselabellist=(/"IPDv00p1"/), &
154 & userroutine=cice_initializep1, &
155 & rc=rc)
156 IF (esmf_logfounderror(rctocheck=rc, &
157 & msg=esmf_logerr_passthru, &
158 & line=__line__, &
159 & file=myfile)) THEN
160 RETURN
161 END IF
162!
163! Set routine for Phase 2 initialization (exchange arrays).
164!
165 CALL nuopc_compsetentrypoint (model, &
166 & methodflag=esmf_method_initialize, &
167 & phaselabellist=(/"IPDv00p2"/), &
168 & userroutine=cice_initializep2, &
169 & rc=rc)
170 IF (esmf_logfounderror(rctocheck=rc, &
171 & msg=esmf_logerr_passthru, &
172 & line=__line__, &
173 & file=myfile)) THEN
174 RETURN
175 END IF
176!
177!-----------------------------------------------------------------------
178! Attach CICE component phase independent specializing methods.
179!-----------------------------------------------------------------------
180!
181! Set routine for export initial/restart fields.
182!
183 CALL nuopc_compspecialize (model, &
184 & speclabel=nuopc_label_datainitialize, &
185 & specroutine=cice_datainit, &
186 & rc=rc)
187 IF (esmf_logfounderror(rctocheck=rc, &
188 & msg=esmf_logerr_passthru, &
189 & line=__line__, &
190 & file=myfile)) THEN
191 RETURN
192 END IF
193!
194! Set routine for setting CICE clock.
195!
196 CALL nuopc_compspecialize (model, &
197 & speclabel=nuopc_label_setclock, &
198 & specroutine=cice_setclock, &
199 & rc=rc)
200 IF (esmf_logfounderror(rctocheck=rc, &
201 & msg=esmf_logerr_passthru, &
202 & line=__line__, &
203 & file=myfile)) THEN
204 RETURN
205 END IF
206!
207! Set routine for time-stepping CICE component.
208!
209 CALL nuopc_compspecialize (model, &
210 & speclabel=nuopc_label_advance, &
211 & specroutine=cice_modeladvance, &
212 & rc=rc)
213 IF (esmf_logfounderror(rctocheck=rc, &
214 & msg=esmf_logerr_passthru, &
215 & line=__line__, &
216 & file=myfile)) THEN
217 RETURN
218 END IF
219!
220!-----------------------------------------------------------------------
221! Register CICE finalize routine.
222!-----------------------------------------------------------------------
223!
224 CALL esmf_gridcompsetentrypoint (model, &
225 & methodflag=esmf_method_finalize, &
226 & userroutine=cice_setfinalize, &
227 & rc=rc)
228 IF (esmf_logfounderror(rctocheck=rc, &
229 & msg=esmf_logerr_passthru, &
230 & line=__line__, &
231 & file=myfile)) THEN
232 RETURN
233 END IF
234!
235 IF (esm_track) THEN
236 WRITE (trac,'(a,a,i0)') '<== Exiting ICE_SetServices', &
237 & ', PET', petrank
238 FLUSH (trac)
239 END IF
240!
241 RETURN
242 END SUBROUTINE ice_setservices
243!
244 SUBROUTINE cice_setinitializep1 (model, &
245 & ImportState, ExportState, &
246 & clock, rc)
247!
248!=======================================================================
249! !
250! CICE component Phase 1 initialization: sets import and export !
251! fields long and short names into its respective state. !
252! !
253!=======================================================================
254!
255! Imported variable declarations.
256!
257 integer, intent(out) :: rc
258!
259 TYPE (esmf_gridcomp) :: model
260 TYPE (esmf_state) :: importstate
261 TYPE (esmf_state) :: exportstate
262 TYPE (esmf_clock) :: clock
263!
264! Local variable declarations.
265!
266 integer :: i, ng
267!
268 character (len=100) :: coupledset, statelabel
269 character (len=240) :: standardname, shortname
270
271 character (len=*), parameter :: myfile = &
272 & __FILE__//", CICE_SetInitializeP1"
273!
274!-----------------------------------------------------------------------
275! Initialize return code flag to success state (no error).
276!-----------------------------------------------------------------------
277!
278 IF (esm_track) THEN
279 WRITE (trac,'(a,a,i0)') '==> Entering CICE_SetInitializeP1', &
280 & ', PET', petrank
281 FLUSH (trac)
282 END IF
283 rc=esmf_success
284!
285!-----------------------------------------------------------------------
286! Set CICE import state and fields.
287!-----------------------------------------------------------------------
288!
289! Add CICE import state(s). If nesting, each grid has its own import
290! state.
291!
292 importing : IF (nimport(iseaice).gt.0) THEN
293 DO ng=1,models(iseaice)%Ngrids
294 IF (any(coupled(iseaice)%LinkedGrid(ng,:))) THEN
295 coupledset=trim(coupled(iseaice)%SetLabel(ng))
296 statelabel=trim(coupled(iseaice)%ImpLabel(ng))
297 CALL nuopc_addnestedstate (importstate, &
298 & cplset=trim(coupledset), &
299 & nestedstatename=trim(statelabel),&
300 & nestedstate=models(iseaice)% &
301 & importstate(ng), &
302 rc=rc)
303 IF (esmf_logfounderror(rctocheck=rc, &
304 & msg=esmf_logerr_passthru, &
305 & line=__line__, &
306 & file=myfile)) THEN
307 RETURN
308 END IF
309!
310! Add fields import state.
311!
312 DO i=1,nimport(iseaice)
313 standardname=models(iseaice)%ImportField(i)%standard_name
314 shortname =models(iseaice)%ImportField(i)%short_name
315 CALL nuopc_advertise (models(iseaice)%ImportState(ng), &
316 & standardname=trim(standardname), &
317 & name=trim(shortname), &
318 & rc=rc)
319 IF (esmf_logfounderror(rctocheck=rc, &
320 & msg=esmf_logerr_passthru, &
321 & line=__line__, &
322 & file=myfile)) THEN
323 RETURN
324 END IF
325 END DO
326 END IF
327 END DO
328 END IF importing
329!
330!-----------------------------------------------------------------------
331! Set CICE export state and fields.
332!-----------------------------------------------------------------------
333!
334! Add CICE import state. If nesting, each grid has its own import
335! state.
336!
337 exporting : IF (nexport(iseaice).gt.0) THEN
338 DO ng=1,models(iseaice)%Ngrids
339 IF (any(coupled(iseaice)%LinkedGrid(ng,:))) THEN
340 coupledset=trim(coupled(iseaice)%SetLabel(ng))
341 statelabel=trim(coupled(iseaice)%ExpLabel(ng))
342 CALL nuopc_addnestedstate (exportstate, &
343 & cplset=trim(coupledset), &
344 & nestedstatename=trim(statelabel),&
345 & nestedstate=models(iseaice)% &
346 & exportstate(ng), &
347 rc=rc)
348 IF (esmf_logfounderror(rctocheck=rc, &
349 & msg=esmf_logerr_passthru, &
350 & line=__line__, &
351 & file=myfile)) THEN
352 RETURN
353 END IF
354!
355! Add fields to export state.
356!
357 DO i=1,nexport(iseaice)
358 standardname=models(iseaice)%ExportField(i)%standard_name
359 shortname =models(iseaice)%ExportField(i)%short_name
360 CALL nuopc_advertise (models(iseaice)%ExportState(ng), &
361 & standardname=trim(standardname), &
362 & name=trim(shortname), &
363 & rc=rc)
364 IF (esmf_logfounderror(rctocheck=rc, &
365 & msg=esmf_logerr_passthru, &
366 & line=__line__, &
367 & file=myfile)) THEN
368 RETURN
369 END IF
370 END DO
371 END IF
372 END DO
373 END IF exporting
374!
375 IF (esm_track) THEN
376 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_SetInitializeP1', &
377 & ', PET', petrank
378 FLUSH (trac)
379 END IF
380!
381 RETURN
382 END SUBROUTINE cice_setinitializep1
383!
384 SUBROUTINE cice_setinitializep2 (model, &
385 & ImportState, ExportState, &
386 & clock, rc)
387!
388!=======================================================================
389! !
390! CICE component Phase 2 initialization: Initializes CICE, sets !
391! component grid, and adds import and export fields to respective !
392! states. !
393! !
394!=======================================================================
395!
396! Imported variable declarations.
397!
398 integer, intent(out) :: rc
399!
400 TYPE (esmf_gridcomp) :: model
401 TYPE (esmf_state) :: importstate
402 TYPE (esmf_state) :: exportstate
403 TYPE (esmf_clock) :: clock
404!
405! Local variable declarations.
406!
407 integer :: mycomm, localpet, ng, petcount
408!
409 character (len=*), parameter :: myfile = &
410 & __FILE__//", CICE_SetInitializeP2"
411!
412 TYPE (esmf_time) :: currenttime, starttime
413 TYPE (esmf_vm) :: vm
414!
415!-----------------------------------------------------------------------
416! Initialize return code flag to success state (no error).
417!-----------------------------------------------------------------------
418!
419 IF (esm_track) THEN
420 WRITE (trac,'(a,a,i0)') '==> Entering CICE_SetInitializeP2', &
421 & ', PET', petrank
422 FLUSH (trac)
423 END IF
424 rc=esmf_success
425!
426!-----------------------------------------------------------------------
427! Querry the Virtual Machine (VM) parallel environmemt for the MPI
428! communicator handle and current node rank.
429!-----------------------------------------------------------------------
430!
431 CALL esmf_gridcompget (model, &
432 & vm=vm, &
433 & rc=rc)
434 IF (esmf_logfounderror(rctocheck=rc, &
435 & msg=esmf_logerr_passthru, &
436 & line=__line__, &
437 & file=myfile)) THEN
438 RETURN
439 END IF
440!
441 CALL esmf_vmget (vm, &
442 & localpet=localpet, &
443 & petcount=petcount, &
444 & mpicommunicator=mycomm, &
445 & rc=rc)
446 IF (esmf_logfounderror(rctocheck=rc, &
447 & msg=esmf_logerr_passthru, &
448 & line=__line__, &
449 & file=myfile)) THEN
450 RETURN
451 END IF
452!
453!-----------------------------------------------------------------------
454! Initialize CICE component.
455!-----------------------------------------------------------------------
456!
457 CALL cice_initialize (mycomm)
458!
459!-----------------------------------------------------------------------
460! Set-up grid and load coordinate data.
461!-----------------------------------------------------------------------
462!
463 DO ng=1,models(iseaice)%Ngrids
464 IF (any(coupled(iseaice)%LinkedGrid(ng,:))) THEN
465 CALL cice_setgridarrays (ng, model, rc)
466 IF (esqmf_logfounderror(rctocheck=rc, &
467 & msg=esmf_logerr_passthru, &
468 & line=__line__, &
469 & file=myfile)) THEN
470 RETURN
471 END IF
472 END IF
473 END DO
474!
475!-----------------------------------------------------------------------
476! Set-up fields and register to import/export states.
477!-----------------------------------------------------------------------
478!
479 DO ng=1,models(iseaice)%Ngrids
480 IF (any(coupled(iseaice)%LinkedGrid(ng,:))) THEN
481 CALL cice_setstates (ng, model, rc)
482 IF (esqmf_logfounderror(rctocheck=rc, &
483 & msg=esmf_logerr_passthru, &
484 & line=__line__, &
485 & file=myfile)) THEN
486 RETURN
487 END IF
488 END IF
489 END DO
490!
491 IF (esm_track) THEN
492 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_SetInitializeP2', &
493 & ', PET', petrank
494 FLUSH (trac)
495 END IF
496!
497 RETURN
498 END SUBROUTINE cice_setinitializep2
499!
500 SUBROUTINE cice_datainit (model, rc)
501!
502!=======================================================================
503! !
504! Exports CICE component fields during initialization or restart. !
505! !
506!=======================================================================
507!
508! Imported variable declarations.
509!
510 integer, intent(out) :: rc
511!
512 TYPE (esmf_gridcomp) :: model
513!
514! Local variable declarations.
515!
516 integer :: ng
517!
518 character (len=*), parameter :: myfile = &
519 & __FILE__//", CICE_DataInit"
520!
521 TYPE (esmf_time) :: currenttime
522!
523!-----------------------------------------------------------------------
524! Initialize return code flag to success state (no error).
525!-----------------------------------------------------------------------
526!
527 IF (esm_track) THEN
528 WRITE (trac,'(a,a,i0)') '==> Entering CICE_DataInit', &
529 & ', PET', petrank
530 FLUSH (trac)
531 END IF
532 rc=esmf_success
533!
534!-----------------------------------------------------------------------
535! Get gridded component clock current time.
536!-----------------------------------------------------------------------
537!
538 CALL esmf_clockget (clockinfo(iseaice)%Clock, &
539 & currtime=currenttime, &
540 & rc=rc)
541 IF (esmf_logfounderror(rctocheck=rc, &
542 & msg=esmf_logerr_passthru, &
543 & line=__line__, &
544 & file=myfile)) THEN
545 RETURN
546 END IF
547!
548!-----------------------------------------------------------------------
549! Export initialization or restart fields.
550!-----------------------------------------------------------------------
551!
552! Run CICE component only for one time-step to fill variables.
553!
554 CALL cice_run ()
555!
556! Put export fields.
557!
558 IF (nexport(iseaice).gt.0) THEN
559 DO ng=1,models(iseaice)%Ngrids
560 IF (any(coupled(iseaice)%LinkedGrid(ng,:))) THEN
561 CALL cice_export (ng, model, rc)
562 IF (esmf_logfounderror(rctocheck=rc, &
563 & msg=esmf_logerr_passthru, &
564 & line=__line__, &
565 & file=myfile)) THEN
566 RETURN
567 END IF
568 END IF
569 END DO
570 END IF
571!
572 IF (esm_track) THEN
573 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_DataInit', &
574 & ', PET', petrank
575 FLUSH (trac)
576 END IF
577!
578 RETURN
579 END SUBROUTINE cice_datainit
580!
581 SUBROUTINE cice_setclock (model, rc)
582!
583!=======================================================================
584! !
585! Sets CICE component date calendar, start and stop time, and !
586! coupling interval. !
587! !
588!=======================================================================
589!
590!! USE coamnl_mod, ONLY : ktaust ! starting time (hour, min, sec)
591!! USE coamnl_mod, ONLY : ktauf ! ending time (hour, min, sec)
592!
593! Imported variable declarations.
594!
595 integer, intent(out) :: rc
596!
597 TYPE (esmf_gridcomp) :: model
598!
599! Local variable declarations.
600!
601 integer :: petcount, localpet
602 integer :: timefrac, ig
603# ifdef REGRESS_STARTCLOCK
604 integer :: regressstartdate(7)
605# endif
606!
607# ifdef REGRESS_STARTCLOCK
608 character (len= 20) :: regressstartstring
609# endif
610 character (len= 20) :: calendar
611 character (len=160) :: message
612
613 character (len=*), parameter :: myfile = &
614 & __FILE__//", CICE_SetClock"
615!
616 TYPE (esmf_calkind_flag) :: caltype
617 TYPE (esmf_time) :: starttime
618 TYPE (esmf_vm) :: vm
619!
620!-----------------------------------------------------------------------
621! Initialize return code flag to success state (no error).
622!-----------------------------------------------------------------------
623!
624 IF (esm_track) THEN
625 WRITE (trac,'(a,a,i0)') '==> Entering CICE_SetClock', &
626 & ', PET', petrank
627 FLUSH (trac)
628 END IF
629 rc=esmf_success
630!
631!-----------------------------------------------------------------------
632! Querry the Virtual Machine (VM) parallel environmemt for the MPI
633! communicator handle and current node rank.
634!-----------------------------------------------------------------------
635!
636 CALL esmf_gridcompget (model, &
637 & localpet=localpet, &
638 & petcount=petcount, &
639 & vm=vm, &
640 & rc=rc)
641 IF (esmf_logfounderror(rctocheck=rc, &
642 & msg=esmf_logerr_passthru, &
643 & line=__line__, &
644 & file=myfile)) THEN
645 RETURN
646 END IF
647!
648!-----------------------------------------------------------------------
649! Create CICE component clock.
650!-----------------------------------------------------------------------
651!
652 calendar=trim(clockinfo(iseaice)%CalendarString)
653 IF (trim(calendar).eq.'gregorian') THEN
654 caltype=esmf_calkind_gregorian
655 ELSE
656 caltype=esmf_calkind_gregorian
657 END IF
658!
659 clockinfo(iseaice)%Calendar=esmf_calendarcreate(caltype, &
660 & name=trim(calendar), &
661 & rc=rc)
662 IF (esmf_logfounderror(rctocheck=rc, &
663 & msg=esmf_logerr_passthru, &
664 & line=__line__, &
665 & file=myfile)) THEN
666 RETURN
667 END IF
668!
669! Set reference time. Use driver configuration values.
670!
671 CALL esmf_timeset (clockinfo(iseaice)%ReferenceTime, &
672 & yy=referencedate(1), &
673 & mm=referencedate(2), &
674 & dd=referencedate(3), &
675 & h =referencedate(4), &
676 & m =referencedate(5), &
677 & s =referencedate(6), &
678 & calendar=clockinfo(iseaice)%Calendar, &
679 & rc=rc)
680 IF (esmf_logfounderror(rctocheck=rc, &
681 & msg=esmf_logerr_passthru, &
682 & line=__line__, &
683 & file=myfile)) THEN
684 RETURN
685 END IF
686
687# ifdef REGRESS_STARTCLOCK
688!
689! Use the same as driver. A coupling interval is substracted to the
690! driver clock to properly initialize all the ESM components.
691!
692 clockinfo(iseaice)%StartTime=clockinfo(idriver)%StartTime
693!
694 CALL esmf_timeget (clockinfo(iseaice)%StartTime, &
695 & yy=regressstartdate(1), &
696 & mm=regressstartdate(2), &
697 & dd=regressstartdate(3), &
698 & h= regressstartdate(4), &
699 & m= regressstartdate(5), &
700 & s= regressstartdate(6), &
701 & ms=regressstartdate(7), &
702 & timestring=regressstartstring, &
703 & rc=rc)
704 IF (esmf_logfounderror(rctocheck=rc, &
705 & msg=esmf_logerr_passthru, &
706 & line=__line__, &
707 & file=myfile)) THEN
708 RETURN
709 END IF
710# else
711!
712! Set start time. Use driver configuration values.
713!
714 CALL esmf_timeset (clockinfo(iseaice)%StartTime, &
715 yy=startdate(1), &
716 mm=startdate(2), &
717 dd=startdate(3), &
718 h =startdate(4), &
719 m =startdate(5), &
720 s =startdate(6), &
721 calendar=clockinfo(iseaice)%Calendar, &
722 rc=rc)
723 IF (esmf_logfounderror(rctocheck=rc, &
724 & msg=esmf_logerr_passthru, &
725 & line=__line__, &
726 & file=myfile)) THEN
727 RETURN
728 END IF
729# endif
730!
731! Set stop time. Use driver configuration values.
732!
733 CALL esmf_timeset (clockinfo(iseaice)%StopTime, &
734 & yy=stopdate(1), &
735 & mm=stopdate(2), &
736 & dd=stopdate(3), &
737 & h =stopdate(4), &
738 & m =stopdate(5), &
739 & s =stopdate(6), &
740 & calendar=clockinfo(iseaice)%Calendar, &
741 & rc=rc)
742 IF (esmf_logfounderror(rctocheck=rc, &
743 & msg=esmf_logerr_passthru, &
744 & line=__line__, &
745 & file=myfile)) THEN
746 RETURN
747 END IF
748!
749!-----------------------------------------------------------------------
750! Get component clock.
751!-----------------------------------------------------------------------
752!
753 CALL esmf_gridcompget (model, &
754 & clock=clockinfo(iseaice)%Clock, &
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 CALL esmf_clockget (clockinfo(iseaice)%Clock, &
764 & timestep=clockinfo(iseaice)%TimeStep, &
765 & currtime=clockinfo(iseaice)%CurrentTime, &
766 & rc=rc)
767 IF (esmf_logfounderror(rctocheck=rc, &
768 & msg=esmf_logerr_passthru, &
769 & line=__line__, &
770 & file=myfile)) THEN
771 RETURN
772 END IF
773!
774!-----------------------------------------------------------------------
775! Compare driver time against CICE component time.
776!-----------------------------------------------------------------------
777!
778 IF (clockinfo(idriver)%Restarted) THEN
779 starttime=clockinfo(idriver)%RestartTime
780 ELSE
781 starttime=clockinfo(idriver)%StartTime
782 END IF
783!
784 IF (clockinfo(iseaice)%StartTime.ne.starttime) THEN
785 CALL esmf_timeprint (clockinfo(iseaice)%StartTime, &
786 & options="string", &
787 & rc=rc)
788 IF (esmf_logfounderror(rctocheck=rc, &
789 & msg=esmf_logerr_passthru, &
790 & line=__line__, &
791 & file=myfile)) THEN
792 RETURN
793 END IF
794!
795 CALL esmf_timeprint (starttime, &
796 & options="string", &
797 & rc=rc)
798 IF (esmf_logfounderror(rctocheck=rc, &
799 & msg=esmf_logerr_passthru, &
800 & line=__line__, &
801 & file=myfile)) THEN
802 RETURN
803 END IF
804!
805 message='Driver and CICE start times do not match: '// &
806 & 'please check the config files.'
807 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
808 & msg=trim(message))
809 RETURN
810 END IF
811!
812 IF (clockinfo(iseaice)%StopTime.ne. &
813 & clockinfo(idriver)%StopTime) THEN
814 CALL esmf_timeprint (clockinfo(iseaice)%StopTime, &
815 & options="string", &
816 & rc=rc)
817 IF (esmf_logfounderror(rctocheck=rc, &
818 & msg=esmf_logerr_passthru, &
819 & line=__line__, &
820 & file=myfile)) THEN
821 RETURN
822 END IF
823!
824 CALL esmf_timeprint (clockinfo(idriver)%StopTime, &
825 & options="string", &
826 & rc=rc)
827 IF (esmf_logfounderror(rctocheck=rc, &
828 & msg=esmf_logerr_passthru, &
829 & line=__line__, &
830 & file=myfile)) THEN
831 RETURN
832 END IF
833!
834 message='Driver and CICE stop times do not match: '// &
835 & 'please check the config files.'
836 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
837 & msg=trim(message))
838 RETURN
839 END IF
840!
841 IF (clockinfo(iseaice)%Calendar.ne. &
842 & clockinfo(idriver)%Calendar) THEN
843 CALL esmf_calendarprint (clockinfo(iseaice)%Calendar, &
844 & options="calkindflag", &
845 & rc=rc)
846 IF (esmf_logfounderror(rctocheck=rc, &
847 & msg=esmf_logerr_passthru, &
848 & line=__line__, &
849 & file=myfile)) THEN
850 RETURN
851 END IF
852!
853 CALL esmf_calendarprint (clockinfo(idriver)%Calendar, &
854 & options="calkindflag", &
855 & rc=rc)
856 IF (esmf_logfounderror(rctocheck=rc, &
857 & msg=esmf_logerr_passthru, &
858 & line=__line__, &
859 & file=myfile)) THEN
860 RETURN
861 END IF
862!
863 message='Driver and CICE calendars do not match: '// &
864 & 'please check the config files.'
865 CALL esmf_logseterror (esmf_failure, rctoreturn=rc, &
866 & msg=trim(message))
867 RETURN
868 END IF
869!
870!-----------------------------------------------------------------------
871! Modify component clock time step.
872!-----------------------------------------------------------------------
873!
874 timefrac=0
875 DO ig=1,models(iseaice)%Ngrids
876 timefrac=max(timefrac, &
877 & maxval(models(iseaice)%TimeFrac(ig,:), &
878 & mask=models(:)%IsActive))
879 END DO
880 IF (timefrac.lt.1) THEN ! needs to be 1 or greater
881 rc=esmf_rc_not_set ! cannot be 0
882 IF (esmf_logfounderror(rctocheck=rc, &
883 & msg=esmf_logerr_passthru, &
884 & line=__line__, &
885 & file=myfile)) THEN
886 RETURN
887 END IF
888 END IF
889 clockinfo(iseaice)%TimeStep=clockinfo(idriver)%TimeStep/timefrac
890!
891 clockinfo(iseaice)%Name='CICE_clock'
892 CALL esmf_clockset (clockinfo(iseaice)%Clock, &
893 & name=trim(clockinfo(iseaice)%Name), &
894 & reftime =clockinfo(iseaice)%ReferenceTime, &
895 & timestep =clockinfo(iseaice)%TimeStep, &
896 & starttime=clockinfo(iseaice)%StartTime, &
897 & stoptime =clockinfo(iseaice)%StopTime, &
898 rc=rc)
899 IF (esmf_logfounderror(rctocheck=rc, &
900 & msg=esmf_logerr_passthru, &
901 & line=__line__, &
902 & file=myfile)) THEN
903 RETURN
904 END IF
905!
906 IF (esm_track) THEN
907 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_SetClock', &
908 & ', PET', petrank
909 FLUSH (trac)
910 END IF
911!
912 RETURN
913 END SUBROUTINE cice_setclock
914!
915 SUBROUTINE cice_setgridarrays (ng, model, rc)
916!
917!=======================================================================
918! !
919! Sets CICE component staggered, horizontal grids arrays, grid area, !
920! and land/sea mask. !
921! !
922!=======================================================================
923!
924 USE ice_blocks, ONLY : nblocks_tot
925 USE ice_blocks, ONLY : block
926 USE ice_blocks, ONLY : get_block, get_block_parameter
927 USE ice_constants, ONLY : rad_to_deg
928 USE ice_distribution, ONLY : ice_distributiongetblockloc
929 USE ice_domain, ONLY : nblocks, blocks_ice, distrb_info
930 USE ice_domain_size, ONLY : nx_global, ny_global
931 USE ice_grid, ONLY : tlat, tlon, ulat, ulon, tarea, &
932 & hm, uvm
933!
934! Imported variable declarations.
935!
936 integer, intent(in) :: ng
937 integer, intent(out) :: rc
938!
939 TYPE (esmf_gridcomp) :: model
940!
941! Local variable declarations.
942!
943 integer :: blk, i, ii, ilo, ihi, j, jj, jlo, jhi
944 integer :: gtype, ivar, localde, n
945 integer :: locid, peid
946 integer :: lbnd(2),ubnd(2)
947!
948 integer, pointer :: delabellist(:) => null()
949 integer, pointer :: deblocklist(:,:,:) => null()
950 integer, pointer :: i_glob(:) => null()
951 integer, pointer :: j_glob(:) => null()
952 integer, pointer :: petmap(:) => null()
953!
954 integer (i4b), pointer :: ptrm(:,:) => null()
955!
956 real (dp), pointer :: ptra(:,:) => null()
957 real (dp), pointer :: ptrx(:,:) => null()
958 real (dp), pointer :: ptry(:,:) => null()
959!
960 character (len=40) :: name
961
962 character (len=*), parameter :: myfile = &
963 & __FILE__//", CICE_SetGridArrays"
964!
965 TYPE (block) :: my_block
966 TYPE (esmf_delayout) :: delayout
967 TYPE (esmf_distgrid) :: distgrid
968 TYPE (esmf_staggerloc) :: staggerloc
969!
970 TYPE (esmf_distgridconnection), allocatable :: connectionlist(:)
971!
972!-----------------------------------------------------------------------
973! Initialize return code flag to success state (no error).
974!-----------------------------------------------------------------------
975!
976 IF (esm_track) THEN
977 WRITE (trac,'(a,a,i0)') '==> Entering CICE_SetGridArrays', &
978 & ', PET', petrank
979 FLUSH (trac)
980 END IF
981 rc=esmf_success
982!
983!-----------------------------------------------------------------------
984! Set upper and lower bounds for each decomposition element (DE),
985! create layout, and boundary conditions.
986!-----------------------------------------------------------------------
987!
988 allocate ( deblocklist(2,2,nblocks_tot) )
989 allocate ( delabellist(nblocks_tot) )
990 allocate ( petmap(nblocks_tot) )
991!
992 DO n=1,nblocks_tot
993 delabellist(i)=n
994 CALL get_block_parameter (n, ilo=ilo, ihi=ihi, &
995 & jlo=jlo, jhi=jhi, &
996 & i_glob=i_glob, j_glob=j_glob)
997 deblocklist(1,1,n)=i_glob(ilo)
998 deblocklist(1,2,n)=i_glob(ihi)
999 deblocklist(2,1,n)=j_glob(jlo)
1000 deblocklist(2,2,n)=j_glob(jhi)
1001 CALL ice_distributiongetblockloc (distrb_info, n, peid, locid)
1002 petmap(n)=peid-1
1003 END DO
1004!
1005! Create decomposition elements layout.
1006!
1007 delayout=esmf_delayoutcreate(petmap, &
1008 & rc=rc)
1009 IF (esmf_logfounderror(rctocheck=rc, &
1010 & msg=esmf_logerr_passthru, &
1011 & line=__line__, &
1012 & file=myfile)) THEN
1013 RETURN
1014 END IF
1015!
1016! Connection between tiles: bipolar boundary condition at top row
1017! (nyg).
1018!
1019 allocate (connectionlist(2))
1020!
1021 CALL esmf_distgridconnectionset (connectionlist(1),
1022 & tileindexa=1, &
1023 & tileindexb=1, &
1024 & positionvector=(/ nx_global+1, &
1025 & 2*ny_global+1/), &
1026 & orientationvector=(/-1, -2/), &
1027 & rc=rc)
1028 IF (esmf_logfounderror(rctocheck=rc, &
1029 & msg=esmf_logerr_passthru, &
1030 & line=__line__, &
1031 & file=myfile)) THEN
1032 RETURN
1033 END IF
1034!
1035! Connectivity between tiles: periodic boundary condition along first
1036! dimension.
1037!
1038 CALL esmf_distgridconnectionset (connectionlist(2), &
1039 & tileindexa=1, &
1040 & tileindexb=1, &
1041 & positionvector=(/nx_global, 0/), &
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 deallocate (connectionlist)
1050!
1051!-----------------------------------------------------------------------
1052! Create DistGrid based on model domain decomposition.
1053!-----------------------------------------------------------------------
1054!
1055 distgrid=esmf_distgridcreate(minindex=(/ 1, 1 /), &
1056 & maxindex=(/ nx_global, ny_global /), &
1057 & deblocklist=deblocklist, &
1058 & delayout=delayout, &
1059 & connectionlist=connectionlist, &
1060 & rc=rc)
1061 IF (esmf_logfounderror(rctocheck=rc, &
1062 & msg=esmf_logerr_passthru, &
1063 & line=__line__, &
1064 & file=myfile)) THEN
1065 RETURN
1066 END IF
1067!
1068 deallocate (delabellist)
1069 deallocate (deblocklist)
1070 deallocate (petmap)
1071!
1072!-----------------------------------------------------------------------
1073! Set component grid coordinates.
1074!-----------------------------------------------------------------------
1075!
1076! Define component grid location type: Arakawa B-grid.
1077!
1078 IF (.not.allocated(models(iseaice)%mesh)) THEN
1079 allocate ( models(iseaice)%mesh(2) )
1080 models(iseaice)%mesh(1)%gtype=icenter ! T-cell
1081 models(iseaice)%mesh(2)%gtype=icorner ! UV-cell
1082 END IF
1083!
1084! Create ESMF Grid.
1085!
1086 models(iseaice)%grid(ng)=esmf_gridcreate(distgrid=distgrid, &
1087 & coordsys=esmf_coordsys_sph_deg, &
1088 & gridedgelwidth=(/ 0, 0 /), &
1089 & gridedgeuwidth=(/ 0, 1 /), &
1090 & name="cice_grid", &
1091 & rc=rc)
1092 IF (esmf_logfounderror(rctocheck=rc, &
1093 & msg=esmf_logerr_passthru, &
1094 & line=__line__, &
1095 & file=myfile)) THEN
1096 RETURN
1097 END IF
1098!
1099! Get number of local decomposition elements (DEs). Usually, a single
1100! DE is associated with each Persistent Execution Thread (PETs). Thus,
1101! localDEcount=1.
1102!
1103 CALL esmf_gridget (models(iseaice)%grid(ng), &
1104 & localdecount=localdecount, &
1105 & rc=rc)
1106 IF (esmf_logfounderror(rctocheck=rc, &
1107 & msg=esmf_logerr_passthru, &
1108 & line=__line__, &
1109 & file=myfile)) THEN
1110 RETURN
1111 END IF
1112!
1113! Mesh coordinates for each variable type.
1114!
1115 mesh_loop : DO ivar=1,ubound(models(iseaice)%mesh, dim=1)
1116!
1117! Set staggering type, Arakawa B-grid.
1118!
1119 SELECT CASE (models(iseaice)%mesh(ivar)%gtype)
1120 CASE (icorner)
1121 staggerloc=esmf_staggerloc_corner
1122 CASE (icenter)
1123 staggerloc=esmf_staggerloc_center
1124!
1125! Allocate storage for masking.
1126!
1127 CALL esmf_gridadditem (models(iseaice)%grid(ng), &
1128 & staggerloc=staggerloc, &
1129 & itemflag=esmf_griditem_mask, &
1130 & rc=rc)
1131 IF (esmf_logfounderror(rctocheck=rc, &
1132 & msg=esmf_logerr_passthru, &
1133 & line=__line__, &
1134 & file=myfile)) THEN
1135 RETURN
1136 END IF
1137 models(iseaice)%LandValue=0
1138 models(iseaice)%SeaValue=1
1139!
1140! Allocate storage for grid area.
1141!
1142 CALL esmf_gridadditem (models(iseaice)%grid(ng), &
1143 & staggerloc=staggerloc, &
1144 & itemflag=esmf_griditem_area, &
1145 & rc=rc)
1146 IF (esmf_logfounderror(rctocheck=rc, &
1147 & msg=esmf_logerr_passthru, &
1148 & line=__line__, &
1149 & file=myfile)) THEN
1150 RETURN
1151 END IF
1152 END SELECT
1153!
1154! Allocate coordinate storage associated with staggered grid type.
1155! No coordinate values are set yet.
1156!
1157 CALL esmf_gridaddcoord (models(iseaice)%grid(ng), &
1158 & staggerloc=staggerloc, &
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! Get pointers and set coordinates for the grid using the block
1168! decomposition.
1169!
1170 block_loop : DO blk=1,nblocks
1171 localde=blk-1
1172 my_block=get_block(blocks_ice(blk), blk)
1173 ilo=my_block%ilo
1174 ihi=my_block%ihi
1175 jlo=my_block%jlo
1176 jhi=my_block%jhi
1177!
1178 CALL esmf_gridgetcoord (models(iseaice)%grid(ng), &
1179 & coorddim=1, &
1180 & localde=localde, &
1181 & staggerloc=staggerloc, &
1182 & computationallbound=lbnd, &
1183 & computationalubound=ubnd, &
1184 & farrayptr=ptrx, &
1185 & rc=rc)
1186 IF (esmf_logfounderror(rctocheck=rc, &
1187 & msg=esmf_logerr_passthru, &
1188 & line=__line__, &
1189 & file=myfile)) THEN
1190 RETURN
1191 END IF
1192!
1193 CALL esmf_gridgetcoord (models(iseaice)%grid(ng), &
1194 & coorddim=2, &
1195 & localde=localde, &
1196 & staggerloc=staggerloc, &
1197 & farrayptr=ptry, &
1198 & rc=rc)
1199 IF (esmf_logfounderror(rctocheck=rc, &
1200 & msg=esmf_logerr_passthru, &
1201 & line=__line__, &
1202 & file=myfile)) THEN
1203 RETURN
1204 END IF
1205!
1206 CALL esmf_gridgetitem (models(iseaice)%grid(ng), &
1207 & localde=localde, &
1208 & staggerloc=staggerloc, &
1209 & itemflag=esmf_griditem_mask, &
1210 & farrayptr=ptrm, &
1211 & rc=rc)
1212 IF (esmf_logfounderror(rctocheck=rc, &
1213 & msg=esmf_logerr_passthru, &
1214 & line=__line__, &
1215 & file=myfile)) THEN
1216 RETURN
1217 END IF
1218!
1219 CALL esmf_gridgetitem (models(iseaice)%grid(ng), &
1220 & localde=localde, &
1221 & staggerloc=staggerloc, &
1222 & itemflag=esmf_griditem_area, &
1223 & farrayptr=ptra, &
1224 & rc=rc)
1225 IF (esmf_logfounderror(rctocheck=rc, &
1226 & msg=esmf_logerr_passthru, &
1227 & line=__line__, &
1228 & file=myfile)) THEN
1229 RETURN
1230 END IF
1231!
1232! Fill grid pointers.
1233!
1234 SELECT CASE (models(iseaice)%mesh(ivar)%gtype)
1235 CASE (icorner)
1236 DO jj=lbnd(2),ubnd(2)
1237 j=jj+jlo-lbnd(2)
1238 DO ii=lbnd(1),ubnd(1)
1239 i=ii+ilo-lbnd(1)
1240 ptrx(ii,jj)=ulon(i-1,j-1,blk)*rad_to_deg
1241 ptry(ii,jj)=ulat(i-1,j-1,blk)*rad_to_deg
1242 ptrm(ii,jj)=nint(uvm(i,j,blk))
1243 ptra(ii,jj)=tarea(i,j,blk)
1244 END DO
1245 END DO
1246 CASE (icenter)
1247 DO jj=lbnd(2),ubnd(2)
1248 j=jj+jlo-lbnd(2)
1249 DO ii=lbnd(1),ubnd(1)
1250 i=ii+ilo-lbnd(1)
1251 ptrx(ii,jj)=tlon(i,j,blk)*rad_to_deg
1252 ptry(ii,jj)=tlat(i,j,blk)*rad_to_deg
1253 ptrm(ii,jj)=nint(hm(i,j,blk))
1254 ptra(ii,jj)=tarea(i,j,blk)
1255 END DO
1256 END DO
1257 END SELECT
1258!
1259! Nullify pointers.
1260!
1261 IF ( associated(ptrx) ) nullify (ptrx)
1262 IF ( associated(ptry) ) nullify (ptry)
1263 IF ( associated(ptrm) ) nullify (ptrm)
1264 IF ( associated(ptra) ) nullify (ptra)
1265 END DO block_loop
1266!
1267! Debugging: write out component grid in VTK format.
1268!
1269 IF (debuglevel.ge.4) THEN
1270 gtype=models(iseaice)%mesh(ivar)%gtype
1271 CALL esmf_gridwritevtk (models(iseaice)%grid(ng), &
1272 & filename="cice_"// &
1273 & trim(gridtype(gtype))// &
1274 & "_point", &
1275 & staggerloc=staggerloc, &
1276 & rc=rc)
1277 IF (esmf_logfounderror(rctocheck=rc, &
1278 & msg=esmf_logerr_passthru, &
1279 & line=__line__, &
1280 & file=myfile)) THEN
1281 RETURN
1282 END IF
1283 END IF
1284 END DO mesh_loop
1285!
1286! Assign grid to gridded component.
1287!
1288 CALL esmf_gridcompset (model, &
1289 & grid=models(iseaice)%grid(ng), &
1290 & rc=rc)
1291 IF (esmf_logfounderror(rctocheck=rc, &
1292 & msg=esmf_logerr_passthru, &
1293 & line=__line__, &
1294 & file=myfile)) THEN
1295 RETURN
1296 END IF
1297!
1298 IF (esm_track) THEN
1299 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_SetGridArrays', &
1300 & ', PET', petrank
1301 FLUSH (trac)
1302 END IF
1303!
1304 RETURN
1305 END SUBROUTINE cice_setgridarrays
1306!
1307 SUBROUTINE cice_setstates (ng, model, rc)
1308!
1309!=======================================================================
1310! !
1311! Adds CICE component export and import fields into its respective !
1312! state. !
1313! !
1314!=======================================================================
1315!
1316 USE ice_domain, ONLY : nblocks
1317 USE ice_domain_size, ONLY : max_blocks
1318!
1319! Imported variable declarations.
1320!
1321 integer, intent(in) :: ng
1322 integer, intent(out) :: rc
1323!
1324 TYPE (esmf_gridcomp) :: model
1325!
1326! Local variable declarations.
1327!
1328 integer :: i, id
1329 integer :: blk, localde
1330 integer :: localpet
1331 integer :: exportcount, importcount
1332!
1333 real (dp), pointer :: ptr3d(:,:,:) => null()
1334!
1335 character (len=*), parameter :: myfile = &
1336 & __FILE__//", CICE_SetStates"
1337
1338 character (ESMF_MAXSTR), allocatable :: exportnamelist(:)
1339 character (ESMF_MAXSTR), allocatable :: importnamelist(:)
1340!
1341 TYPE (esmf_arrayspec) :: arrayspec3d
1342 TYPE (esmf_field) :: field
1343 TYPE (esmf_staggerloc) :: staggerloc
1344 TYPE (esmf_vm) :: vm
1345!
1346!-----------------------------------------------------------------------
1347! Initialize return code flag to success state (no error).
1348!-----------------------------------------------------------------------
1349!
1350 IF (esm_track) THEN
1351 WRITE (trac,'(a,a,i0)') '==> Entering CICE_SetStates', &
1352 & ', PET', petrank
1353 FLUSH (trac)
1354 END IF
1355 rc=esmf_success
1356!
1357!-----------------------------------------------------------------------
1358! Query gridded component.
1359!-----------------------------------------------------------------------
1360!
1361! Get import and export states.
1362!
1363 CALL esmf_gridcompget (model, &
1364 & localpet=localpet, &
1365 & vm=vm, &
1366 & rc=rc)
1367 IF (esmf_logfounderror(rctocheck=rc, &
1368 & msg=esmf_logerr_passthru, &
1369 & line=__line__, &
1370 & file=myfile)) THEN
1371 RETURN
1372 END IF
1373!
1374!-----------------------------------------------------------------------
1375! Set a 3D floating-point array descriptor. CICE import and export
1376! fields are dimensioned (nx_global, ny_global, max_blocks).
1377!-----------------------------------------------------------------------
1378!
1379 CALL esmf_arrayspecset (arrayspec3d, &
1380 & typekind=esmf_typekind_r8, &
1381 & rank=3, &
1382 & rc=rc)
1383 IF (esmf_logfounderror(rctocheck=rc, &
1384 & msg=esmf_logerr_passthru, &
1385 & line=__line__, &
1386 & file=myfile)) THEN
1387 RETURN
1388 END IF
1389!
1390!-----------------------------------------------------------------------
1391! Add export fields into export state.
1392!-----------------------------------------------------------------------
1393!
1394 exporting : IF (nexport(iseaice).gt.0) THEN
1395!
1396! Get number of fields to export.
1397!
1398 CALL esmf_stateget (models(iseaice)%ExportState(ng), &
1399 & itemcount=exportcount, &
1400 & rc=rc)
1401 IF (esmf_logfounderror(rctocheck=rc, &
1402 & msg=esmf_logerr_passthru, &
1403 & line=__line__, &
1404 & file=myfile)) THEN
1405 RETURN
1406 END IF
1407!
1408! Get a list of export fields names.
1409!
1410 IF (.not.allocated(exportnamelist)) THEN
1411 allocate ( exportnamelist(exportcount) )
1412 END IF
1413 CALL esmf_stateget (models(iseaice)%ExportState(ng), &
1414 & itemnamelist=exportnamelist, &
1415 & rc=rc)
1416 IF (esmf_logfounderror(rctocheck=rc, &
1417 & msg=esmf_logerr_passthru, &
1418 & line=__line__, &
1419 & file=myfile)) THEN
1420 RETURN
1421 END IF
1422!
1423! Set export field(s).
1424!
1425 DO i=1,exportcount
1426 id=field_index(models(iseaice)%ExportField, exportnamelist(i))
1427!
1428 IF (nuopc_isconnected(models(iseaice)%ExportState(ng), &
1429 & fieldname=trim(exportnamelist(i)), &
1430 & rc=rc)) THEN
1431!
1432! Set staggering type.
1433!
1434 SELECT CASE (models(iseaice)%ExportField(id)%gtype)
1435 CASE (icenter)
1436 staggerloc=esmf_staggerloc_center
1437 CASE (icorner)
1438 staggerloc=esmf_staggerloc_corner
1439 END SELECT
1440!
1441! Create 2D field from the Grid and arraySpec.
1442!
1443 field=esmf_fieldcreate(models(iseaice)%grid(ng), &
1444 & arrayspec3d, &
1445 & indexflag=esmf_index_delocal, &
1446 & staggerloc=staggerloc, &
1447 & ungriddedlbound=(/1/), &
1448 & ungriddedubound=(/max_blocks/), &
1449 & name=trim(exportnamelist(i)), &
1450 & rc=rc)
1451 IF (esmf_logfounderror(rctocheck=rc, &
1452 & msg=esmf_logerr_passthru, &
1453 & line=__line__, &
1454 & file=myfile)) THEN
1455 RETURN
1456 END IF
1457!
1458! Put data into state. Use CICE block decomposition.
1459!
1460 DO blk=1,nblocks
1461 localde=blk-1
1462!
1463! Get pointer to DE-local memory allocation within field.
1464!
1465 CALL esmf_fieldget (field, &
1466 & localde=localde, &
1467 & farrayptr=ptr3d, &
1468 & rc=rc)
1469 IF (esmf_logfounderror(rctocheck=rc, &
1470 & msg=esmf_logerr_passthru, &
1471 & line=__line__, &
1472 & file=myfile)) THEN
1473 RETURN
1474 END IF
1475!
1476! Initialize pointer.
1477!
1478 ptr3d=missing_dp
1479!
1480! Nullify pointer to make sure that it does not point on a random part
1481! in the memory.
1482!
1483 IF ( associated(ptr3d) ) nullify (ptr3d)
1484 END DO
1485!
1486! Add field export state.
1487!
1488 CALL nuopc_realize (exportstate, &
1489 & field=field, &
1490 & rc=rc)
1491 IF (esmf_logfounderror(rctocheck=rc, &
1492 & msg=esmf_logerr_passthru, &
1493 & line=__line__, &
1494 & file=myfile)) THEN
1495 RETURN
1496 END IF
1497!
1498! Remove field from export state because it is not connected.
1499!
1500 ELSE
1501 IF (localpet.eq.0) THEN
1502 WRITE (cplout,10) trim(exportnamelist(i)), &
1503 & 'Export State: ', &
1504 & trim(coupled(iseaice)%ExpLabel(ng))
1505 END IF
1506 CALL esmf_stateremove (models(iseaice)%ExportState(ng), &
1507 & (/ trim(exportnamelist(i)) /), &
1508 & rc=rc)
1509 IF (esmf_logfounderror(rctocheck=rc, &
1510 & msg=esmf_logerr_passthru, &
1511 & line=__line__, &
1512 & file=myfile)) THEN
1513 RETURN
1514 END IF
1515 END IF
1516 END DO
1517!
1518! Deallocate arrays.
1519!
1520 IF ( allocated(exportnamelist) ) deallocate (exportnamelist)
1521!
1522 END IF exporting
1523!
1524!-----------------------------------------------------------------------
1525! Add import fields into import state.
1526!-----------------------------------------------------------------------
1527!
1528 importing : IF (nimport(iseaice).gt.0) THEN
1529!
1530! Get number of fields to import.
1531!
1532 CALL esmf_stateget (models(iseaice)%ImportState(ng), &
1533 & itemcount=importcount, &
1534 & rc=rc)
1535 IF (esmf_logfounderror(rctocheck=rc, &
1536 & msg=esmf_logerr_passthru, &
1537 & line=__line__, &
1538 & file=myfile)) THEN
1539 RETURN
1540 END IF
1541!
1542! Get a list of import fields names.
1543!
1544 IF (.not.allocated(importnamelist)) THEN
1545 allocate (importnamelist(importcount))
1546 END IF
1547 CALL esmf_stateget (models(iseaice)%ImportState(ng), &
1548 & itemnamelist=importnamelist, &
1549 & rc=rc)
1550 IF (esmf_logfounderror(rctocheck=rc, &
1551 & msg=esmf_logerr_passthru, &
1552 & line=__line__, &
1553 & file=myfile)) THEN
1554 RETURN
1555 END IF
1556!
1557! Set import field(s).
1558!
1559 DO i=1,importcount
1560 id=field_index(models(iseaice)%ImportField, importnamelist(i))
1561!
1562 IF (nuopc_isconnected(models(iseaice)%ImportState(ng), &
1563 & fieldname=trim(importnamelist(i)), &
1564 & rc=rc)) THEN
1565
1566!
1567! Set staggering type.
1568!
1569 SELECT CASE (models(iseaice)%ImportField(id)%gtype)
1570 CASE (icenter)
1571 staggerloc=esmf_staggerloc_center
1572 CASE (icorner)
1573 staggerloc=esmf_staggerloc_corner
1574 END SELECT
1575!
1576! Create field from the Grid, arraySpec.
1577!
1578 field=esmf_fieldcreate(models(iseaice)%grid(ng), &
1579 & arrayspec3d, &
1580 & indexflag=esmf_index_delocal, &
1581 & staggerloc=staggerloc, &
1582 & ungriddedlbound=(/1/), &
1583 & ungriddedubound=(/max_blocks/), &
1584 & name=trim(importnamelist(i)), &
1585 & rc=rc)
1586 IF (esmf_logfounderror(rctocheck=rc, &
1587 & msg=esmf_logerr_passthru, &
1588 & line=__line__, &
1589 & file=myfile)) THEN
1590 RETURN
1591 END IF
1592!
1593! Put data into state. Use CICE block decomposition.
1594!
1595 DO blk=1,nblocks
1596 localde=blk-1
1597!
1598! Get pointer to DE-local memory allocation within field.
1599!
1600 CALL esmf_fieldget (field, &
1601 & localde=localde, &
1602 & farrayptr=ptr3d, &
1603 & rc=rc)
1604 IF (esmf_logfounderror(rctocheck=rc, &
1605 & msg=esmf_logerr_passthru, &
1606 & line=__line__, &
1607 & file=myfile)) THEN
1608 RETURN
1609 END IF
1610!
1611! Initialize pointer.
1612!
1613 ptr3d=missing_dp
1614!
1615! Nullify pointer to make sure that it does not point on a random
1616! part in the memory.
1617!
1618 IF (associated(ptr3d)) nullify (ptr3d)
1619 END DO
1620!
1621! Add field import state.
1622!
1623 CALL nuopc_realize (models(iseaice)%ImportState(ng), &
1624 & field=field, &
1625 & rc=rc)
1626 IF (esmf_logfounderror(rctocheck=rc, &
1627 & msg=esmf_logerr_passthru, &
1628 & line=__line__, &
1629 & file=myfile)) THEN
1630 RETURN
1631 END IF
1632!
1633! Remove field from import state because it is not connected.
1634!
1635 ELSE
1636 IF (localpet.eq.0) THEN
1637 WRITE (cplout,10) trim(importnamelist(i)), &
1638 & 'Import State: ', &
1639 & trim(coupled(iseaice)%ImpLabel(ng))
1640 END IF
1641 CALL esmf_stateremove (models(iseaice)%ImportState(ng), &
1642 & trim(importnamelist(i)), &
1643 & rc=rc)
1644 IF (esmf_logfounderror(rctocheck=rc, &
1645 & msg=esmf_logerr_passthru, &
1646 & line=__line__, &
1647 & file=myfile)) THEN
1648 RETURN
1649 END IF
1650 END IF
1651 END DO
1652!
1653! Deallocate arrays.
1654!
1655 IF (allocated(importnamelist)) deallocate (importnamelist)
1656!
1657 END IF importing
1658!
1659 IF (esm_track) THEN
1660 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_SetStates', &
1661 & ', PET', petrank
1662 FLUSH (trac)
1663 END IF
1664!
1665 RETURN
1666 END SUBROUTINE cice_setstates
1667!
1668 SUBROUTINE cice_modeladvance (model, rc)
1669!
1670!=======================================================================
1671! !
1672! Advance CICE component for a coupling interval (seconds) using !
1673! "CICE_run". It also calls "CICE_Import" and "CICE_Export" to import !
1674! and export coupling fields, respectively. !
1675! !
1676!=======================================================================
1677!
1678!! USE mod_runparams, ONLY : ifrest, ktau, dtsrf
1679!
1680! Imported variable declarations.
1681!
1682 integer, intent(out) :: rc
1683!
1684 TYPE (esmf_gridcomp) :: model
1685!
1686! Local variable declarations.
1687!
1688 logical :: ladvance
1689 integer :: is, ng
1690 integer :: localpet, phase
1691!
1692 real (dp) :: couplinginterval, runinterval
1693 real (dp) :: tcurrentinseconds, tstopinseconds
1694!
1695 character (len=22) :: cinterval
1696 character (len=22) :: currtimestring, stoptimestring
1697
1698 character (len=*), parameter :: myfile = &
1699 & __FILE__//", CICE_ModelAdvance"
1700!
1701 TYPE (esmf_clock) :: clock
1702 TYPE (esmf_state) :: exportstate, importstate
1703 TYPE (esmf_time) :: referencetime
1704 TYPE (esmf_time) :: currenttime, stoptime
1705 TYPE (esmf_timeinterval) :: timestep
1706 TYPE (esmf_vm) :: vm
1707!
1708!-----------------------------------------------------------------------
1709! Initialize return code flag to success state (no error).
1710!-----------------------------------------------------------------------
1711!
1712 IF (esm_track) THEN
1713 WRITE (trac,'(a,a,i0)') '==> Entering CICE_ModelAdvance', &
1714 & ', PET', petrank
1715 FLUSH (trac)
1716 END IF
1717 rc=esmf_success
1718!
1719!-----------------------------------------------------------------------
1720! Get information about the gridded component.
1721!-----------------------------------------------------------------------
1722!
1723! Inquire about CICE component.
1724!
1725 CALL esmf_gridcompget (model, &
1726 & importstate=importstate, &
1727 & exportstate=exportstate, &
1728 & clock=clock, &
1729 & localpet=localpet, &
1730 & currentphase=phase, &
1731 & vm=vm, &
1732 & rc=rc)
1733 IF (esmf_logfounderror(rctocheck=rc, &
1734 & msg=esmf_logerr_passthru, &
1735 & line=__line__, &
1736 & file=myfile)) THEN
1737 RETURN
1738 END IF
1739!
1740! Get time step interval, stopping time, reference time, and current
1741! time.
1742!
1743 CALL esmf_clockget (clock, &
1744 & timestep=timestep, &
1745 & stoptime=stoptime, &
1746 & reftime=referencetime, &
1747 & currtime=clockinfo(iseaice)%CurrentTime, &
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! Current CICE time (seconds).
1757!
1758 CALL esmf_timeget (clockinfo(iseaice)%CurrentTime, &
1759 & s_r8=tcurrentinseconds, &
1760 & timestringisofrac=currtimestring, &
1761 & rc=rc)
1762 IF (esmf_logfounderror(rctocheck=rc, &
1763 & msg=esmf_logerr_passthru, &
1764 & line=__line__, &
1765 & file=myfile)) THEN
1766 RETURN
1767 END IF
1768 is=index(currtimestring, 'T') ! remove 'T' in
1769 IF (is.gt.0) currtimestring(is:is)=' ' ! ISO 8601 format
1770!
1771! CICE stop time (seconds) for this coupling window.
1772!
1773 CALL esmf_timeget (clockinfo(iseaice)%CurrentTime+timestep, &
1774 & s_r8=tstopinseconds, &
1775 & timestringisofrac=stoptimestring, &
1776 & rc=rc)
1777 IF (esmf_logfounderror(rctocheck=rc, &
1778 & msg=esmf_logerr_passthru, &
1779 & line=__line__, &
1780 & file=myfile)) THEN
1781 RETURN
1782 END IF
1783 is=index(stoptimestring, 'T') ! remove 'T' in
1784 IF (is.gt.0) stoptimestring(is:is)=' ' ! ISO 8601 form
1785!
1786! Get coupling time interval (seconds, double precision).
1787!
1788 CALL esmf_timeintervalget (timestep, &
1789 & s_r8=couplinginterval, &
1790 & rc=rc)
1791 IF (esmf_logfounderror(rctocheck=rc, &
1792 & msg=esmf_logerr_passthru, &
1793 & line=__line__, &
1794 & file=myfile)) THEN
1795 RETURN
1796 END IF
1797!
1798! Set CICE running interval (seconds) for the current coupling window.
1799!
1800 ladvance=.true.
1801 runinterval=couplinginterval
1802!
1803!-----------------------------------------------------------------------
1804! Report time information strings (YYYY-MM-DD hh:mm:ss).
1805!-----------------------------------------------------------------------
1806!
1807 IF (localpet.eq.0) THEN
1808 WRITE (cinterval,'(f15.2)') couplinginterval
1809 WRITE (cplout,10) trim(currtimestring), trim(stoptimestring), &
1810 & phase, trim(adjustl(cinterval))
1811 END IF
1812!
1813!-----------------------------------------------------------------------
1814! Get import fields from other ESM components.
1815!-----------------------------------------------------------------------
1816!
1817 IF ((nimport(iseaice).gt.0).and. &
1818 & (tcurrentinseconds.gt.clockinfo(idriver)%Time_Start)) THEN
1819 DO ng=1,models(iseaice)%Ngrids
1820 IF (any(coupled(iseaice)%LinkedGrid(ng,:))) THEN
1821 CALL cice_import (ng, model, rc)
1822 IF (esmf_logfounderror(rctocheck=rc, &
1823 & msg=esmf_logerr_passthru, &
1824 & line=__line__, &
1825 & file=myfile)) THEN
1826 RETURN
1827 END IF
1828 END IF
1829 END DO
1830 ELSE
1831 ladvance=.false.
1832 END IF
1833!
1834!-----------------------------------------------------------------------
1835! Run CICE component.
1836!-----------------------------------------------------------------------
1837!
1838 IF (ladvance)) THEN
1839 CALL cice_run
1840 END IF
1841!
1842!-----------------------------------------------------------------------
1843! Put export fields.
1844!-----------------------------------------------------------------------
1845!
1846 IF (nexport(iseaice).gt.0) THEN
1847 DO ng=1,models(iseaice)%Ngrids
1848 IF (any(coupled(iseaice)%LinkedGrid(ng,:))) THEN
1849 CALL cice_export (ng, model, rc)
1850 IF (esmf_logfounderror(rctocheck=rc, &
1851 & msg=esmf_logerr_passthru, &
1852 & line=__line__, &
1853 & file=myfile)) THEN
1854 RETURN
1855 END IF
1856 END IF
1857 END DO
1858 END IF
1859!
1860 IF (esm_track) THEN
1861 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_ModelAdvance', &
1862 & ', PET', petrank
1863 FLUSH (trac)
1864 END IF
1865!
1866 10 FORMAT (3x,'ModelAdvance - ESMF, Running CICE:',t42,a, &
1867 & ' => ',a,', Phase: ',i1,' [',a,' s]')
1868!
1869 RETURN
1870 END SUBROUTINE cice_modeladvance
1871!
1872 SUBROUTINE cice_setfinalize (model, &
1873 & ImportState, ExportState, &
1874 & clock, rc)
1875!
1876!=======================================================================
1877! !
1878! Finalize CICE component execution. It calls CICE_finalize. !
1879! !
1880!=======================================================================
1881!
1882! Imported variable declarations.
1883!
1884 integer, intent(out) :: rc
1885!
1886 TYPE (esmf_clock) :: clock
1887 TYPE (esmf_gridcomp) :: model
1888 TYPE (esmf_state) :: exportstate
1889 TYPE (esmf_state) :: importstate
1890!
1891! Local variable declarations.
1892!
1893 character (len=*), parameter :: myfile = &
1894 & __FILE__//", CICE_SetFinalize"
1895!
1896!-----------------------------------------------------------------------
1897! Initialize return code flag to success state (no error).
1898!-----------------------------------------------------------------------
1899!
1900 IF (esm_track) THEN
1901 WRITE (trac,'(a,a,i0)') '==> Entering CICE_SetFinalize', &
1902 & ', PET', petrank
1903 FLUSH (trac)
1904 END IF
1905 rc=esmf_success
1906!
1907!-----------------------------------------------------------------------
1908! Finalize CICE component.
1909!-----------------------------------------------------------------------
1910!
1911 CALL cice_finalize
1912 FLUSH (6) ! flush standard output buffer
1913!
1914 IF (esm_track) THEN
1915 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_SetFinalize', &
1916 & ', PET', petrank
1917 FLUSH (trac)
1918 END IF
1919!
1920 RETURN
1921 END SUBROUTINE cice_setfinalize
1922!
1923 SUBROUTINE cice_import (ng, model, rc)
1924!
1925!=======================================================================
1926! !
1927! Imports fields into CICE array structure from other coupled !
1928! gridded components. !
1929! !
1930!=======================================================================
1931!
1932 USE ice_blocks, ONLY : block
1933 USE ice_blocks, ONLY : get_block
1934 USE ice_domain, ONLY : nblocks, blocks_ice
1935 USE ice_domain_size, ONLY : max_blocks, nx_global, ny_global
1936 USE ice_grid, ONLY : anglet
1937 USE ice_flux
1938!
1939! Imported variable declarations.
1940!
1941 integer, intent(in) :: ng
1942 integer, intent(out) :: rc
1943!
1944 TYPE (esmf_gridcomp) :: model
1945!
1946! Local variable declarations.
1947!
1948 logical :: got_pair, got_tair
1949 logical :: got_current(2), got_swfx(4), got_wind(2), got_wstr(2)
1950!
1951 integer :: id, ifld
1952 integer :: blk, i, ii, j, jj
1953 integer :: iyear, iday, imonth, ihour
1954 integer :: importcount
1955 integer :: localpet
1956 integer :: year, month, day, hour, minutes, seconds, sn, sd
1957!
1958 real (dp) :: cicescale, scale, add_offset
1959 real (dp) :: timeindays, time_current, tmin, tmax, tstr, tend
1960 real (dp) :: sigma_c, sigma_l, sigma_r, slopex, slopey
1961!
1962 real (dp), dimension(nx_global,ny_global,max_blocks) :: pair
1963!
1964 real (dp), pointer :: ptr3d(:,:,:) => null()
1965!
1966 character (len=*), parameter :: myfile = &
1967 & __FILE__//", CICE_Import"
1968
1969 character (ESMF_MAXSTR) :: ofile
1970 character (ESMF_MAXSTR), allocatable :: importnamelist(:)
1971!
1972 TYPE (block) :: my_block
1973 TYPE (esmf_clock) :: clock
1974 TYPE (esmf_field) :: field
1975 TYPE (esmf_time) :: currenttime
1976 TYPE (esmf_vm) :: vm
1977!
1978!-----------------------------------------------------------------------
1979! Initialize return code flag to success state (no error).
1980!-----------------------------------------------------------------------
1981!
1982 IF (esm_track) THEN
1983 WRITE (trac,'(a,a,i0)') '==> Entering CICE_Import', &
1984 & ', PET', petrank
1985 FLUSH (trac)
1986 END IF
1987 rc=esmf_success
1988!
1989!-----------------------------------------------------------------------
1990! Get information about the gridded component.
1991!-----------------------------------------------------------------------
1992!
1993 CALL esmf_gridcompget (model, &
1994 & clock=clock, &
1995 & localpet=localpet, &
1996 & vm=vm, &
1997 & rc=rc)
1998 IF (esmf_logfounderror(rctocheck=rc, &
1999 & msg=esmf_logerr_passthru, &
2000 & line=__line__, &
2001 & file=myfile)) THEN
2002 RETURN
2003 END IF
2004!
2005!-----------------------------------------------------------------------
2006! Get current time.
2007!-----------------------------------------------------------------------
2008!
2009 CALL esmf_clockget (clock, &
2010 & currtime=currenttime, &
2011 & rc=rc)
2012 IF (esmf_logfounderror(rctocheck=rc, &
2013 & msg=esmf_logerr_passthru, &
2014 & line=__line__, &
2015 & file=myfile)) THEN
2016 RETURN
2017 END IF
2018!
2019 CALL esmf_timeget (currenttime, &
2020 & yy=year, &
2021 & mm=month, &
2022 & dd=day, &
2023 & h =hour, &
2024 & m =minutes, &
2025 & s =seconds, &
2026 & sn=sn, &
2027 & sd=sd, &
2028 & rc=rc)
2029 IF (esmf_logfounderror(rctocheck=rc, &
2030 & msg=esmf_logerr_passthru, &
2031 & line=__line__, &
2032 & file=myfile)) THEN
2033 RETURN
2034 END IF
2035!
2036 CALL esmf_timeget (currenttime, &
2037 & s_r8=time_current, &
2038 & timestring=time_currentstring, &
2039 & rc=rc)
2040 IF (esmf_logfounderror(rctocheck=rc, &
2041 & msg=esmf_logerr_passthru, &
2042 & line=__line__, &
2043 & file=myfile)) THEN
2044 RETURN
2045 END IF
2046 timeindays=time_current/86400.0_dp
2047 is=index(time_currentstring, 'T') ! remove 'T' in
2048 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
2049!
2050!-----------------------------------------------------------------------
2051! Get list of import fields.
2052!-----------------------------------------------------------------------
2053!
2054 CALL esmf_stateget (models(iseaice)%ImportState(ng), &
2055 & itemcount=importcount, &
2056 & rc=rc)
2057 IF (esmf_logfounderror(rctocheck=rc, &
2058 & msg=esmf_logerr_passthru, &
2059 & line=__line__, &
2060 & file=myfile)) THEN
2061 RETURN
2062 END IF
2063!
2064 IF (.not.allocated(importnamelist)) THEN
2065 allocate ( importnamelist(importcount) )
2066 END IF
2067 CALL esmf_stateget (models(iseaice)%ImportState(ng), &
2068 & itemnamelist=importnamelist, &
2069 & rc=rc)
2070 IF (esmf_logfounderror(rctocheck=rc, &
2071 & msg=esmf_logerr_passthru, &
2072 & line=__line__, &
2073 & file=myfile)) THEN
2074 RETURN
2075 END IF
2076!
2077!-----------------------------------------------------------------------
2078! Get import fields.
2079!-----------------------------------------------------------------------
2080!
2081 got_pair=.false.
2082 got_tair=.false.
2083 got_current(1:2)=.false.
2084 got_swfx(1:4)=.false.
2085 got_wind(1:2)=.false.
2086 got_wstr(1:2)=.false.
2087!
2088 fld_loop : DO ifld=1,importcount
2089 id=field_index(models(iseaice)%ImportField,importnamelist(ifld))
2090!
2091! Get field from import state.
2092!
2093 CALL esmf_stateget (models(iseaice)%ImportState(ng), &
2094 & trim(importnamelist(ifld)), &
2095 & field, &
2096 & rc=rc)
2097 IF (esmf_logfounderror(rctocheck=rc, &
2098 & msg=esmf_logerr_passthru, &
2099 & line=__line__, &
2100 & file=myfile)) THEN
2101 RETURN
2102 END IF
2103!
2104! Get field pointer.
2105!
2106 CALL esmf_fieldget (field, &
2107 & farrayptr=ptr3d, &
2108 & rc=rc)
2109 IF (esmf_logfounderror(rctocheck=rc, &
2110 & msg=esmf_logerr_passthru, &
2111 & line=__line__, &
2112 & file=myfile)) THEN
2113 RETURN
2114 END IF
2115!
2116! Load import data into CICE component variable.
2117!
2118 scale=models(iseaice)%ImportField(id)%scale_factor
2119 add_offset=models(iseaice)%ImportField(id)%add_offset
2120!
2121 myfmin(1)= missing_dp
2122 myfmax(1)=-missing_dp
2123 myfmin(2)= missing_dp
2124 myfmax(2)=-missing_dp
2125!
2126 SELECT CASE (trim(adjustl(itemnamelist(ifld))))
2127!
2128! Atmospheric height of the lowest level (m), from ATM.
2129!
2130 CASE ('zlvl', 'inst_height_lowest')
2131 DO blk=1,nblocks
2132 my_block=get_block(blocks_ice(blk), blk)
2133 DO j=my_block%jlo,my_block%jhi
2134 jj=j-my_block%jlo+1
2135 DO i=my_block%ilo,my_block%ihi
2136 ii=i-my_block%ilo+1
2137 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2138 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2139 fval=scale*ptr3d(ii,jj,blk)+add_offset
2140 myfmin(2)=min(myfmin(2),fval)
2141 myfmax(2)=max(myfmax(2),fval)
2142 zlvl(i,j,blk)=fval
2143 END DO
2144 END DO
2145 END DO
2146!
2147! Air density (kg m-3) at surface defined by inst_height_lowest (near
2148! surface; maybe lowest level), from ATM.
2149!
2150 CASE ('rhoa', 'air_density_height_lowest')
2151 DO blk=1,nblocks
2152 my_block=get_block(blocks_ice(blk), blk)
2153 DO j=my_block%jlo,my_block%jhi
2154 jj=j-my_block%jlo+1
2155 DO i=my_block%ilo,my_block%ihi
2156 ii=i-my_block%ilo+1
2157 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2158 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2159 fval=scale*ptr3d(ii,jj,blk)+add_offset
2160 myfmin(2)=min(myfmin(2),fval)
2161 myfmax(2)=max(myfmax(2),fval)
2162 rhoa(i,j,blk)=fval
2163 END DO
2164 END DO
2165 END DO
2166!
2167! Air pressure (N m-2) at surface defined by inst_height_lowest (near
2168! surface; maybe lowest level), from ATM.
2169!
2170 CASE ('Pair', 'ips', 'inst_pres_height_lowest')
2171 DO blk=1,nblocks
2172 my_block=get_block(blocks_ice(blk), blk)
2173 DO j=my_block%jlo,my_block%jhi
2174 jj=j-my_block%jlo+1
2175 DO i=my_block%ilo,my_block%ihi
2176 ii=i-my_block%ilo+1
2177 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2178 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2179 fval=scale*ptr3d(ii,jj,blk)+add_offset
2180 myfmin(2)=min(myfmin(2),fval)
2181 myfmax(2)=max(myfmax(2),fval)
2182 pair(i,j,blk)=fval
2183 END DO
2184 END DO
2185 END DO
2186 got_pair=.true.
2187!
2188! Air temperature (K) at surface defined by inst_height_lowest (near
2189! surface; maybe lowest level), from ATM.
2190!
2191 CASE ('Tair', 'its', 'inst_temp_height_lowest')
2192 DO blk=1,nblocks
2193 my_block=get_block(blocks_ice(blk), blk)
2194 DO j=my_block%jlo,my_block%jhi
2195 jj=j-my_block%jlo+1
2196 DO i=my_block%ilo,my_block%ihi
2197 ii=i-my_block%ilo+1
2198 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2199 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2200 fval=scale*ptr3d(ii,jj,blk)+add_offset
2201 myfmin(2)=min(myfmin(2),fval)
2202 myfmax(2)=max(myfmax(2),fval)
2203 tair(i,j,blk)=fval
2204 END DO
2205 END DO
2206 END DO
2207 got_tair=.true.
2208!
2209! Air humidity (kg kg-1), at surface defined by inst_height_lowest
2210! (near surface; maybe lowest level), from ATM.
2211!
2212 CASE ('Qair', 'Qa', 'ishh', 'inst_spec_humid_height_lowest')
2213 DO blk=1,nblocks
2214 my_block=get_block(blocks_ice(blk), blk)
2215 DO j=my_block%jlo,my_block%jhi
2216 jj=j-my_block%jlo+1
2217 DO i=my_block%ilo,my_block%ihi
2218 ii=i-my_block%ilo+1
2219 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2220 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2221 fval=scale*ptr3d(ii,jj,blk)+add_offset
2222 myfmin(2)=min(myfmin(2),fval)
2223 myfmax(2)=max(myfmax(2),fval)
2224 qa(i,j,blk)=fval
2225 END DO
2226 END DO
2227 END DO
2228!
2229! Downwelling longwave flux (W m-2), averaged over coupling interval,
2230! from ATM.
2231!
2232 CASE ('flw', 'mdlwfx', 'mean_down_lw_flx')
2233 DO blk=1,nblocks
2234 my_block=get_block(blocks_ice(blk), blk)
2235 DO j=my_block%jlo,my_block%jhi
2236 jj=j-my_block%jlo+1
2237 DO i=my_block%ilo,my_block%ihi
2238 ii=i-my_block%ilo+1
2239 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2240 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2241 fval=scale*ptr3d(ii,jj,blk)+add_offset
2242 myfmin(2)=min(myfmin(2),fval)
2243 myfmax(2)=max(myfmax(2),fval)
2244 flw(i,j,blk)=fval
2245 END DO
2246 END DO
2247 END DO
2248!
2249! Visible direct band of downward shortwave flux (W m-2), averaged
2250! over the coupling interval, from ATM.
2251!
2252 CASE ('swvdr', 'sw_flux_vis_dir', 'mean_down_sw_vis_dir_flx')
2253 DO blk=1,nblocks
2254 my_block=get_block(blocks_ice(blk), blk)
2255 DO j=my_block%jlo,my_block%jhi
2256 jj=j-my_block%jlo+1
2257 DO i=my_block%ilo,my_block%ihi
2258 ii=i-my_block%ilo+1
2259 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2260 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2261 fval=scale*ptr3d(ii,jj,blk)+add_offset
2262 myfmin(2)=min(myfmin(2),fval)
2263 myfmax(2)=max(myfmax(2),fval)
2264 swvdr(i,j,blk)=fval
2265 END DO
2266 END DO
2267 END DO
2268 got_swfx(1)=.true.
2269!
2270! Visible diffusive band of downward shortwave flux (W m-2), averaged
2271! over the coupling interval, from ATM.
2272!
2273 CASE ('swvdf', 'sw_flux_vis_dif', 'mean_down_sw_vis_dif_flx')
2274 DO blk=1,nblocks
2275 my_block=get_block(blocks_ice(blk), blk)
2276 DO j=my_block%jlo,my_block%jhi
2277 jj=j-my_block%jlo+1
2278 DO i=my_block%ilo,my_block%ihi
2279 ii=i-my_block%ilo+1
2280 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2281 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2282 fval=scale*ptr3d(ii,jj,blk)+add_offset
2283 myfmin(2)=min(myfmin(2),fval)
2284 myfmax(2)=max(myfmax(2),fval)
2285 swvdf(i,j,blk)=fval
2286 END DO
2287 END DO
2288 END DO
2289 got_swfx(2)=.true.
2290!
2291! Infrared direct band of downward shortwave flux (W m-2), averaged
2292! over the coupling interval, from ATM.
2293!
2294 CASE ('swidr', 'sw_flux_nir_dir', 'mean_down_sw_ir_dir_flx')
2295 DO blk=1,nblocks
2296 my_block=get_block(blocks_ice(blk), blk)
2297 DO j=my_block%jlo,my_block%jhi
2298 jj=j-my_block%jlo+1
2299 DO i=my_block%ilo,my_block%ihi
2300 ii=i-my_block%ilo+1
2301 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2302 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2303 fval=scale*ptr3d(ii,jj,blk)+add_offset
2304 myfmin(2)=min(myfmin(2),fval)
2305 myfmax(2)=max(myfmax(2),fval)
2306 swidr(i,j,blk)=fval
2307 END DO
2308 END DO
2309 END DO
2310 got_swfx(3)=.true.
2311!
2312! Infrared diffusive band of downward shortwave flux (W m-2), averaged
2313! over the coupling interval, from ATM.
2314!
2315 CASE ('swidf', 'sw_flux_nir_dif', 'mean_down_sw_ir_dif_flx')
2316 DO blk=1,nblocks
2317 my_block=get_block(blocks_ice(blk), blk)
2318 DO j=my_block%jlo,my_block%jhi
2319 jj=j-my_block%jlo+1
2320 DO i=my_block%ilo,my_block%ihi
2321 ii=i-my_block%ilo+1
2322 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2323 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2324 fval=scale*ptr3d(ii,jj,blk)+add_offset
2325 myfmin(2)=min(myfmin(2),fval)
2326 myfmax(2)=max(myfmax(2),fval)
2327 swidf(i,j,blk)=fval
2328 END DO
2329 END DO
2330 END DO
2331 got_swfx(4)=.true.
2332!
2333! Near surface (maybe lowest level) U-wind component (m s-1), from ATM.
2334! Needs to be rotated from east/north to i,j coordinates after it is
2335! loaded.
2336!
2337 CASE ('Uwind', 'uatm', 'inst_zonal_wind_height_lowest')
2338 DO blk=1,nblocks
2339 my_block=get_block(blocks_ice(blk), blk)
2340 DO j=my_block%jlo,my_block%jhi
2341 jj=j-my_block%jlo+1
2342 DO i=my_block%ilo,my_block%ihi
2343 ii=i-my_block%ilo+1
2344 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2345 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2346 fval=scale*ptr3d(ii,jj,blk)+add_offset
2347 myfmin(2)=min(myfmin(2),fval)
2348 myfmax(2)=max(myfmax(2),fval)
2349 uatm(i,j,blk)=fval
2350 END DO
2351 END DO
2352 END DO
2353 got_wind(1)=.true.
2354!
2355! Near surface (maybe lowest level) V-wind component (m s-1), from ATM.
2356! Needs to be rotated from east/north to i,j coordinates after it is
2357! loaded.
2358!
2359 CASE ('Vwind', 'vatm', 'inst_merid_wind_height_lowest')
2360 DO blk=1,nblocks
2361 my_block=get_block(blocks_ice(blk), blk)
2362 DO j=my_block%jlo,my_block%jhi
2363 jj=j-my_block%jlo+1
2364 DO i=my_block%ilo,my_block%ihi
2365 ii=i-my_block%ilo+1
2366 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2367 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2368 fval=scale*ptr3d(ii,jj,blk)+add_offset
2369 myfmin(2)=min(myfmin(2),fval)
2370 myfmax(2)=max(myfmax(2),fval)
2371 vatm(i,j,blk)=fval
2372 END DO
2373 END DO
2374 END DO
2375 got_wind(2)=.true.
2376!
2377! Near surface (maybe lowest level) U-wind stress component (N m-2),
2378! averaged over the coupling interval, from ATM. Needs to be rotated
2379! from east/north to i,j coordinates after it is loaded.
2380!
2381 CASE ('Ustr', 'strax', 'mzmfx', 'mean_zonal_moment_flx')
2382 DO blk=1,nblocks
2383 my_block=get_block(blocks_ice(blk), blk)
2384 DO j=my_block%jlo,my_block%jhi
2385 jj=j-my_block%jlo+1
2386 DO i=my_block%ilo,my_block%ihi
2387 ii=i-my_block%ilo+1
2388 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2389 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2390 fval=scale*ptr3d(ii,jj,blk)+add_offset
2391 myfmin(2)=min(myfmin(2),fval)
2392 myfmax(2)=max(myfmax(2),fval)
2393 strax(i,j,blk)=fval
2394 END DO
2395 END DO
2396 END DO
2397 got_wstr(1)=.true.
2398!
2399! Near surface (maybe lowest level) V-wind stress component (N m-2)),
2400! averaged over the coupling interval, from ATM. Needs to be rotated
2401! from east/north to i,j coordinates after it is loaded.
2402!
2403 CASE ('Vstr', 'stray', 'mmmfx', 'mean_merid_momentum_flx')
2404 DO blk=1,nblocks
2405 my_block=get_block(blocks_ice(blk), blk)
2406 DO j=my_block%jlo,my_block%jhi
2407 jj=j-my_block%jlo+1
2408 DO i=my_block%ilo,my_block%ihi
2409 ii=i-my_block%ilo+1
2410 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2411 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2412 fval=scale*ptr3d(ii,jj,blk)+add_offset
2413 myfmin(2)=min(myfmin(2),fval)
2414 myfmax(2)=max(myfmax(2),fval)
2415 stray(i,j,blk)=fval
2416 END DO
2417 END DO
2418 END DO
2419 got_wstr(2)=.true.
2420!
2421! Liquid precipitation rate (kg m-2 s-1), averaged over the coupling
2422! interval, from ATM.
2423!
2424 CASE ('frain', 'lprec', 'mean_prec_rate')
2425 DO blk=1,nblocks
2426 my_block=get_block(blocks_ice(blk), blk)
2427 DO j=my_block%jlo,my_block%jhi
2428 jj=j-my_block%jlo+1
2429 DO i=my_block%ilo,my_block%ihi
2430 ii=i-my_block%ilo+1
2431 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2432 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2433 fval=scale*ptr3d(ii,jj,blk)+add_offset
2434 myfmin(2)=min(myfmin(2),fval)
2435 myfmax(2)=max(myfmax(2),fval)
2436 frain(i,j,blk)=fval
2437 END DO
2438 END DO
2439 END DO
2440!
2441! Frozen/snow precipitation rate (kg m-2 s-1), averaged over the coupling
2442! interval, from ATM.
2443!
2444 CASE ('fsnow', 'fprec', 'mean_fprec_rate')
2445 DO blk=1,nblocks
2446 my_block=get_block(blocks_ice(blk), blk)
2447 DO j=my_block%jlo,my_block%jhi
2448 jj=j-my_block%jlo+1
2449 DO i=my_block%ilo,my_block%ihi
2450 ii=i-my_block%ilo+1
2451 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2452 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2453 fval=scale*ptr3d(ii,jj,blk)+add_offset
2454 myfmin(2)=min(myfmin(2),fval)
2455 myfmax(2)=max(myfmax(2),fval)
2456 fsnow(i,j,blk)=fval
2457 END DO
2458 END DO
2459 END DO
2460!
2461! Sea surface heigh (m), from OCN.
2462!
2463 CASE ('ssh', 'sea_lev')
2464 DO blk=1,nblocks
2465 my_block=get_block(blocks_ice(blk), blk)
2466 DO j=my_block%jlo,my_block%jhi
2467 jj=j-my_block%jlo+1
2468 DO i=my_block%ilo,my_block%ihi
2469 ii=i-my_block%ilo+1
2470! zonal sea surface slope
2471!
2472 sigma_r=0.5_dp*(ptr3d(ii+1,jj+1,blk)- &
2473 & ptr3d(ii ,jj+1,blk)+ &
2474 & ptr3d(ii+1,jj ,blk)- &
2475 & ptr3d(ii ,jj ,blk))/dxt(i,j,blk)
2476 sigma_l=0.5_dp*(ptr3d(ii ,jj+1,blk)- &
2477 & ptr3d(ii-1,jj+1,blk)+ &
2478 & ptr3d(ii ,jj ,blk)- &
2479 & ptr3d(ii-1,jj ,blk))/dxt(i,j,blk)
2480 sigma_c=0.5_dp*(sigma_r+sigma_l)
2481 IF ((sigma_r*sigma_l).gt.0.0_dp) THEN
2482 slopex=sign(min(2.0_dp*min(abs(sigma_l), &
2483 & abs(sigma_r)), &
2484 & abs(sigma_c)), &
2485 & sigma_c)
2486 ELSE
2487 slopex=0.0_dp
2488 ENDIF
2489! meridional sea surface slope
2490!
2491 sigma_r=0.5_dp*(ptr3d(ii+1,jj+1,blk)- &
2492 & ptr3d(ii+1,jj ,blk)+ &
2493 & ptr3d(ii ,jj+1,blk)- &
2494 & ptr3d(ii ,jj ,blk))/dyt(i,j,blk)
2495 sigma_l=0.5_dp*(ptr3d(ii+1,jj ,blk)- &
2496 & ptr3d(ii+1,jj-1,blk)+ &
2497 & ptr3d(ii ,jj ,blk)- &
2498 & ptr3d(ii ,jj-1,blk))/dyt(i,j,blk)
2499 sigma_c=0.5_dp*(sigma_r+sigma_l)
2500 IF ((sigma_r*sigma_l).gt.0.0_dp) THEN
2501 slopey=sign(min(2.0_dp*min(abs(sigma_l), &
2502 & abs(sigma_r)), &
2503 & abs(sigma_c)), &
2504 & sigma_c)
2505 ELSE
2506 slopey(i,j,blk)=0.0_dp
2507 ENDIF
2508! rotate onto local basis vectors
2509!
2510 ss_tltx(i,j,blk)= slopex*cos(anglet(i,j,blk))+ &
2511 & slopey*sin(anglet(i,j,blk))
2512 ss_tlty(i,j,blk)=-slopex*sin(anglet(i,j,blk))+ &
2513 & slopey*cos(anglet(i,j,blk))
2514!
2515 CALL t2ugrid_vector (ss_tltx)
2516 CALL t2ugrid_vector (ss_tlty)
2517 END DO
2518 END DO
2519 END DO
2520!
2521! Ocean mixed layer depth (m), from OCN.
2522!
2523 CASE ('hmix', 'mixed_layer_depth')
2524 DO blk=1,nblocks
2525 my_block=get_block(blocks_ice(blk), blk)
2526 DO j=my_block%jlo,my_block%jhi
2527 jj=j-my_block%jlo+1
2528 DO i=my_block%ilo,my_block%ihi
2529 ii=i-my_block%ilo+1
2530 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2531 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2532 fval=scale*ptr3d(ii,jj,blk)+add_offset
2533 myfmin(2)=min(myfmin(2),fval)
2534 myfmax(2)=max(myfmax(2),fval)
2535 hmix(i,j,blk)=fval
2536 END DO
2537 END DO
2538 END DO
2539!
2540! Freezing/Melting potential (W m-2), from OCN.
2541!
2542 CASE ('frzmlt', 'freezing_melting_potential')
2543 DO blk=1,nblocks
2544 my_block=get_block(blocks_ice(blk), blk)
2545 DO j=my_block%jlo,my_block%jhi
2546 jj=j-my_block%jlo+1
2547 DO i=my_block%ilo,my_block%ihi
2548 ii=i-my_block%ilo+1
2549 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2550 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2551 fval=scale*ptr3d(ii,jj,blk)+add_offset
2552 myfmin(2)=min(myfmin(2),fval)
2553 myfmax(2)=max(myfmax(2),fval)
2554 frzmlt(i,j,blk)=fval
2555 END DO
2556 END DO
2557 END DO
2558!
2559! Sea surface temperature (Celsius), maybe not needed, from OCN.
2560!
2561 CASE ('sst', 'sea_surface_temperature')
2562 DO blk=1,nblocks
2563 my_block=get_block(blocks_ice(blk), blk)
2564 DO j=my_block%jlo,my_block%jhi
2565 jj=j-my_block%jlo+1
2566 DO i=my_block%ilo,my_block%ihi
2567 ii=i-my_block%ilo+1
2568 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2569 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2570 fval=scale*ptr3d(ii,jj,blk)+add_offset
2571 myfmin(2)=min(myfmin(2),fval)
2572 myfmax(2)=max(myfmax(2),fval)
2573 sst(i,j,blk)=fval
2574 END DO
2575 END DO
2576 END DO
2577!
2578! Sea surface salinity (maybe for mushy layer), from OCN.
2579!
2580 CASE ('sss', 's_surf', 's_surf_ppt')
2581 DO blk=1,nblocks
2582 my_block=get_block(blocks_ice(blk), blk)
2583 DO j=my_block%jlo,my_block%jhi
2584 jj=j-my_block%jlo+1
2585 DO i=my_block%ilo,my_block%ihi
2586 ii=i-my_block%ilo+1
2587 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2588 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2589 fval=scale*ptr3d(ii,jj,blk)+add_offset
2590 myfmin(2)=min(myfmin(2),fval)
2591 myfmax(2)=max(myfmax(2),fval)
2592 sss(i,j,blk)=fval
2593 END DO
2594 END DO
2595 END DO
2596!
2597! Zonal surface ocean current (m s-1), from OCN. Needs to be
2598! rotated from east/north to i,j after it is loaded.
2599!
2600 CASE ('Usur', 'uocn', 'ocn_current_zonal')
2601 DO blk=1,nblocks
2602 my_block=get_block(blocks_ice(blk), blk)
2603 DO j=my_block%jlo,my_block%jhi
2604 jj=j-my_block%jlo+1
2605 DO i=my_block%ilo,my_block%ihi
2606 ii=i-my_block%ilo+1
2607 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2608 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2609 fval=scale*ptr3d(ii,jj,blk)+add_offset
2610 myfmin(2)=min(myfmin(2),fval)
2611 myfmax(2)=max(myfmax(2),fval)
2612 uocn(i,j,blk)=fval
2613 END DO
2614 END DO
2615 END DO
2616 got_current(1)=.true.
2617!
2618! Meridional surface ocean current (m s-1), from OCN. Needs to be
2619! rotated from east/north to i,j after it is loaded.
2620!
2621 CASE ('Vsur', 'vocn', 'ocn_current_merid')
2622 DO blk=1,nblocks
2623 my_block=get_block(blocks_ice(blk), blk)
2624 DO j=my_block%jlo,my_block%jhi
2625 jj=j-my_block%jlo+1
2626 DO i=my_block%ilo,my_block%ihi
2627 ii=i-my_block%ilo+1
2628 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
2629 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
2630 fval=scale*ptr3d(ii,jj,blk)+add_offset
2631 myfmin(2)=min(myfmin(2),fval)
2632 myfmax(2)=max(myfmax(2),fval)
2633 uocn(i,j,blk)=fval
2634 END DO
2635 END DO
2636 END DO
2637 got_current(2)=.true.
2638!
2639! Import field not found.
2640!
2641 CASE DEFAULT
2642 IF (localpet.eq.0) THEN
2643 WRITE (cplout,10) trim(importnamelist(ifld)), &
2644 & trim(time_currentstring), &
2645 & trim(cinpname)
2646 END IF
2647 IF (founderror(exit_flag, noerror, __line__, &
2648 & myfile)) THEN
2649 rc=esmf_rc_not_found
2650 RETURN
2651 END IF
2652 END SELECT
2653!
2654! Print pointer information.
2655!
2656 IF (debuglevel.eq.4) THEN
2657 WRITE (cplout,20) localpet &
2658 & lbound(ptr3d, dim=1), ubound(ptr3d, dim=1), &
2659 & lbound(ptr3d, dim=2), ubound(ptr3d, dim=2), &
2660 & lbound(ptr3d, dim=3), ubound(ptr3d, dim=3)
2661 END IF
2662!
2663! Nullify pointer to make sure that it does not point on a random
2664! part in the memory.
2665!
2666 IF (associated(ptr3d)) nullify (ptr3d)
2667!
2668! Get import field minimun and maximum values.
2669!
2670 CALL esmf_vmallreduce (vm, &
2671 & senddata=myfmin, &
2672 & recvdata=fmin, &
2673 & count=2, &
2674 & reduceflag=esmf_reduce_min, &
2675 & rc=rc)
2676 IF (esmf_logfounderror(rctocheck=rc, &
2677 & msg=esmf_logerr_passthru, &
2678 & line=__line__, &
2679 & file=myfile)) THEN
2680 RETURN
2681 END IF
2682!
2683 CALL esmf_vmallreduce (vm, &
2684 & senddata=myfmax, &
2685 & recvdata=fmax, &
2686 & count=2, &
2687 & reduceflag=esmf_reduce_max, &
2688 & rc=rc)
2689 IF (esmf_logfounderror(rctocheck=rc, &
2690 & msg=esmf_logerr_passthru, &
2691 & line=__line__, &
2692 & file=myfile)) THEN
2693 RETURN
2694 END IF
2695!
2696! Write out import field information.
2697!
2698 IF ((debuglevel.ge.0).and.(localpet.eq.0)) THEN
2699 WRITE (cplout,30) trim(importnamelist(ifld)), &
2700 & trim(time_currentstring), ng, &
2701 & fmin(1), fmax(1)
2702 IF (cicescale.ne.1.0_dp) THEN
2703 WRITE (cplout,40) fmin(2), fmax(2), &
2704 & ' ciceScale = ', cicescale
2705 ELSE IF (add_offset.ne.0.0_dp) THEN
2706 WRITE (cplout,40) fmin(2), fmax(2), &
2707 & ' AddOffset = ', add_offset
2708 END IF
2709 END IF
2710!
2711! Debugging: write out import field into NetCDF file.
2712!
2713 IF ((debuglevel.ge.3).and. &
2714 & models(iseaice)%ImportField(id)%debug_write) THEN
2715 WRITE (ofile,50) ng, trim(importnamelist(ifld)), &
2716 & year, month, day, hour, minutes, seconds
2717 CALL esmf_fieldwrite (field, &
2718 & trim(ofile), &
2719 & overwrite=.true., &
2720 & rc=rc)
2721 IF (esmf_logfounderror(rctocheck=rc, &
2722 & msg=esmf_logerr_passthru, &
2723 & line=__line__, &
2724 & file=myfile)) THEN
2725 RETURN
2726 END IF
2727 END IF
2728
2729 END DO fld_loop
2730!
2731! Deallocate local arrays.
2732!
2733 IF (allocated(importnamelist)) deallocate (importnamelist)
2734!
2735! Update ROMS import calls counter.
2736!
2737 IF (importcount.gt.0) THEN
2738 models(iseaice)%ImportCalls=models(iseaice)%ImportCalls+1
2739 END IF
2740!
2741! Rotate wind components from east/north to i,j coordinates and compute
2742! wind magnitude.
2743!
2744 IF (all(got_wind)) THEN
2745 DO blk=1,nblocks
2746 my_block=get_block(blocks_ice(blk), blk)
2747 DO j=my_block%jlo,my_block%jhi
2748 DO i=my_block%ilo,my_block%ihi
2749 uvel=uatm(i,j,blk)
2750 vvel=vatm(i,j,blk)
2751 uatm(i,j,blk)= uvel*cos(anglet(i,j,blk))+ &
2752 & vvel*sin(anglet(i,j,blk))
2753 vatm(i,j,blk)=-uvel*sin(anglet(i,j,blk))+ &
2754 & vvel*cos(anglet(i,j,blk))
2755 wind(i,j,blk)=sqrt(uvel*uvel+vvel*vvel)
2756 END DO
2757 END DO
2758 END DO
2759 END IF
2760!
2761! Rotate wind stress components from east/north to i,j coordinates.
2762!
2763 IF (all(got_wind)) THEN
2764 DO blk=1,nblocks
2765 my_block=get_block(blocks_ice(blk), blk)
2766 DO j=my_block%jlo,my_block%jhi
2767 DO i=my_block%ilo,my_block%ihi
2768 uvel=strax(i,j,blk)
2769 vvel=stray(i,j,blk)
2770 strax(i,j,blk)= uvel*cos(anglet(i,j,blk))+ &
2771 & vvel*sin(anglet(i,j,blk))
2772 stray(i,j,blk)=-uvel*sin(anglet(i,j,blk))+ &
2773 & vvel*cos(anglet(i,j,blk))
2774 END DO
2775 END DO
2776 END DO
2777 END IF
2778!
2779! Rotate ocean current components from east/north to i,j coordinates.
2780!
2781 IF (all(got_current)) THEN
2782 DO blk=1,nblocks
2783 my_block=get_block(blocks_ice(blk), blk)
2784 DO j=my_block%jlo,my_block%jhi
2785 DO i=my_block%ilo,my_block%ihi
2786 uvel=uocn(i,j,blk)
2787 vvel=vocn(i,j,blk)
2788 uocn(i,j,blk)= uvel*cos(anglet(i,j,blk))+ &
2789 & vvel*sin(anglet(i,j,blk))
2790 vocn(i,j,blk)=-uvel*sin(anglet(i,j,blk))+ &
2791 & vvel*cos(anglet(i,j,blk))
2792 END DO
2793 END DO
2794 END DO
2795 END IF
2796!
2797! Compute potential air temperature (K).
2798!
2799 IF (got_pair.and.got_tair) THEN
2800 DO blk=1,nblocks
2801 my_block=get_block(blocks_ice(blk), blk)
2802 DO j=my_block%jlo,my_block%jhi
2803 DO i=my_block%ilo,my_block%ihi
2804 pott(i,j,blk)=tair(i,j,blk)* &
2805 & (100000.0_dp/pair(i,j,blk))**0.286_dp
2806 END DO
2807 END DO
2808 END DO
2809 END IF
2810!
2811! Compute net incomming shortwave radiation (W m-2).
2812
2813 IF (all(got_swfx)) THEN
2814 DO blk=1,nblocks
2815 my_block=get_block(blocks_ice(blk), blk)
2816 DO j=my_block%jlo,my_block%jhi
2817 DO i=my_block%ilo,my_block%ihi
2818 fsw(i,j,blk)=swvdr(i,j,blk)+ &
2819 & swvdf(i,j,blk)+ &
2820 & swidr(i,j,blk)+ &
2821 & swidf(i,j,blk)
2822 END DO
2823 END DO
2824 END DO
2825 END IF
2826!
2827! Deallocate arrays.
2828!
2829 IF (allocated(importnamelist)) deallocate (importnamelist)
2830!
2831 IF (esm_track) THEN
2832 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_Import', &
2833 & ', PET', petrank
2834 FLUSH (trac)
2835 END IF
2836 IF (debuglevel.gt.0) FLUSH (cplout)
2837!
2838 10 FORMAT (/,3x,' CICE_Import - unable to find option to import: ', &
2839 & a,t68,a,/,18x,'check ''Import(roms)'' in input script: ', &
2840 & a)
2841 20 FORMAT (18x,'PET [',i3.3,'], Pointer Size: ',6i8)
2842 30 FORMAT (3x,' CICE_Import - ESMF: importing field ''',a,'''', &
2843 & t72,a,2x,'Grid ',i2.2, &
2844 & /,19x,'(Dmin = ', 1p,e15.8,0p,' Dmax = ',1p,e15.8,0p,')')
2845 40 FORMAT (19x,'(Cmin = ', 1p,e15.8,0p,' Cmax = ',1p,e15.8,0p, &
2846 & a,1p,e15.8,0p,')')
2847 50 FORMAT ('cice_',i2.2,'_import_',a,'_',i4.4,2('-',i2.2),'_', &
2848 & i2.2,2('.',i2.2),'.nc')
2849
2850 RETURN
2851 END SUBROUTINE cice_import
2852!
2853 SUBROUTINE cice_export (ng, model, rc)
2854!
2855!=======================================================================
2856! !
2857! Exports CICE fields to other coupled gridded components. !
2858! !
2859!=======================================================================
2860!
2861 USE ice_blocks, ONLY : block
2862 USE ice_blocks, ONLY : get_block
2863 USE ice_constants, ONLY : tffresh
2864 USE ice_domain, ONLY : nblocks, blocks_ice
2865 USE ice_grid, ONLY : hm, anglet
2866 USE ice_flux
2867!
2868! Imported variable declarations.
2869!
2870 integer, intent(in) :: ng
2871 integer, intent(out) :: rc
2872!
2873 TYPE (esmf_gridcomp) :: model
2874!
2875! Local variable declarations.
2876!
2877 integer :: id, ifld
2878 integer :: blk, i, ii, j, jj
2879 integer :: exportcount
2880 integer :: localpet
2881 integer :: year, month, day, hour, minutes, seconds, sn, sd
2882!
2883 real (dp) :: fmin(1), fmax(1), fval, myfmin(1), myfmax(1)
2884 real (dp) :: wdir
2885!
2886 real (dp), pointer :: ptr3d(:,:,:) => null()
2887!
2888 character (len=22) :: time_currentstring
2889
2890 character (len=*), parameter :: myfile = &
2891 & __FILE__//", CICE_Export"
2892
2893 character (ESMF_MAXSTR) :: cname, ofile
2894 character (ESMF_MAXSTR), allocatable :: exportnamelist(:)
2895!
2896 TYPE (block) :: my_block
2897 TYPE (esmf_field) :: field
2898 TYPE (esmf_time) :: currenttime
2899 TYPE (esmf_vm) :: vm
2900!
2901!-----------------------------------------------------------------------
2902! Initialize return code flag to success state (no error).
2903!-----------------------------------------------------------------------
2904!
2905 IF (esm_track) THEN
2906 WRITE (trac,'(a,a,i0)') '==> Entering CICE_Export', &
2907 & ', PET', petrank
2908 FLUSH (trac)
2909 END IF
2910 rc=esmf_success
2911!
2912!-----------------------------------------------------------------------
2913! Get information about the gridded component.
2914!-----------------------------------------------------------------------
2915!
2916 CALL esmf_gridcompget (model, &
2917 & localpet=localpet, &
2918 & vm=vm, &
2919 & name=cname, &
2920 & rc=rc)
2921 IF (esmf_logfounderror(rctocheck=rc, &
2922 & msg=esmf_logerr_passthru, &
2923 & line=__line__, &
2924 & file=myfile)) THEN
2925 RETURN
2926 END IF
2927!
2928!-----------------------------------------------------------------------
2929! Get current time.
2930!-----------------------------------------------------------------------
2931!
2932 CALL esmf_clockget (clockinfo(iseaice)%Clock, &
2933 & currtime=currenttime, &
2934 & rc=rc)
2935 IF (esmf_logfounderror(rctocheck=rc, &
2936 & msg=esmf_logerr_passthru, &
2937 & line=__line__, &
2938 & file=myfile)) THEN
2939 RETURN
2940 END IF
2941!
2942 CALL esmf_timeget (currenttime, &
2943 & yy=year, &
2944 & mm=month, &
2945 & dd=day, &
2946 & h =hour, &
2947 & m =minutes, &
2948 & s =seconds, &
2949 & sn=sn, &
2950 & sd=sd, &
2951 & timestring=time_currentstring, &
2952 & rc=rc)
2953 IF (esmf_logfounderror(rctocheck=rc, &
2954 & msg=esmf_logerr_passthru, &
2955 & line=__line__, &
2956 & file=myfile)) THEN
2957 RETURN
2958 END IF
2959 is=index(time_currentstring, 'T') ! remove 'T' in
2960 IF (is.gt.0) time_currentstring(is:is)=' ' ! ISO 8601 format
2961!
2962!-----------------------------------------------------------------------
2963! Get list of export fields.
2964!-----------------------------------------------------------------------
2965!
2966 CALL esmf_stateget (models(iseaice)%ExportState(ng), &
2967 & itemcount=exportcount, &
2968 & rc=rc)
2969 IF (esmf_logfounderror(rctocheck=rc, &
2970 & msg=esmf_logerr_passthru, &
2971 & line=__line__, &
2972 & file=myfile)) THEN
2973 RETURN
2974 END IF
2975!
2976 IF (.not. allocated(exportnamelist)) THEN
2977 allocate ( exportnamelist(exportcount) )
2978 END IF
2979!
2980 CALL esmf_stateget (models(iseaice)%ExportState(ng), &
2981 & itemnamelist=exportnamelist, &
2982 & rc=rc)
2983 IF (esmf_logfounderror(rctocheck=rc, &
2984 & msg=esmf_logerr_passthru, &
2985 & line=__line__, &
2986 & file=myfile)) THEN
2987 RETURN
2988 END IF
2989!
2990!-----------------------------------------------------------------------
2991! Load export fields.
2992!-----------------------------------------------------------------------
2993!
2994 fld_loop : DO ifld=1,exportcount
2995!
2996! Get field from export state.
2997!
2998 CALL esmf_stateget (models(iseaice)%ExportState(ng), &
2999 & trim(exportnamelist(ifld)), &
3000 & field, &
3001 & rc=rc)
3002 IF (esmf_logfounderror(rctocheck=rc, &
3003 & msg=esmf_logerr_passthru, &
3004 & line=__line__, &
3005 & file=myfile)) THEN
3006 RETURN
3007 END IF
3008!
3009! Get field pointer.
3010!
3011 CALL esmf_fieldget (field, &
3012 & farrayptr=ptr3d, &
3013 & rc=rc)
3014 IF (esmf_logfounderror(rctocheck=rc, &
3015 & msg=esmf_logerr_passthru, &
3016 & line=__line__, &
3017 & file=myfile)) THEN
3018 RETURN
3019 END IF
3020!
3021! Initialize pointer to missing value.
3022!
3023 ptr3d=missing_dp
3024 fmin(1)= missing_dp
3025 tmax(1)=-missing_dp
3026!
3027! Load field data into export state.
3028!
3029 SELECT CASE (trim(adjustl(exportnamelist(ifld))))
3030!
3031! Ice mask at cell center (T-cell), computed from land-boundary mask.
3032!
3033 CASE ('mask', 'hm', 'ice_mask')
3034 DO blk=1,nblocks
3035 my_block=get_block(blocks_ice(blk), blk)
3036 DO j=my_block%jlo,my_block%jhi
3037 jj=j-my_block%jlo+1
3038 DO i=my_block%ilo,my_block%ihi
3039 ii=i-my_block%ilo+1
3040 IF (hm(i,j,blk).gt.0.5_dp) THEN
3041 ptr3d(ii,jj,blk)=1.0_dp
3042 ELSE
3043 ptr3d(ii,jj,blk)=0.0_dp
3044 END IF
3045 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3046 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3047 END DO
3048 END DO
3049 END DO
3050!
3051! Fractional ice area (nondimensional; 0.0 - 1.0).
3052!
3053 CASE ('ifrac', 'ice_fraction')
3054 DO blk=1,nblocks
3055 my_block=get_block(blocks_ice(blk), blk)
3056 DO j=my_block%jlo,my_block%jhi
3057 jj=j-my_block%jlo+1
3058 DO i=my_block%ilo,my_block%ihi
3059 ii=i-my_block%ilo+1
3060 ptr3d(ii,jj,blk)=aice(i,j,blk)
3061 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3062 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3063 END DO
3064 END DO
3065 END DO
3066!
3067! Surface temperature of ice/snow covered portion (K), to ATM.
3068!
3069 CASE ('sit', 'sea_ice_temperature')
3070 DO blk=1,nblocks
3071 my_block=get_block(blocks_ice(blk), blk)
3072 DO j=my_block%jlo,my_block%jhi
3073 jj=j-my_block%jlo+1
3074 DO i=my_block%ilo,my_block%ihi
3075 ii=i-my_block%ilo+1
3076 IF (aice(i,j,blk).gt.0.0_dp) THEN
3077 ptr3d(ii,jj,blk)=tffresh+trcr(i,j,1,blk)
3078 ELSE
3079 ptr3d(ii,jj,blk)=0.0_dp
3080 END IF
3081 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3082 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3083 END DO
3084 END DO
3085 END DO
3086!
3087! Fraction of visible band, direct albedo aggregated over ice
3088! categories (nondimesional), to ATM.
3089!
3090 CASE ('alvdr', 'inst_ice_vis_dir_albedo')
3091 DO blk=1,nblocks
3092 my_block=get_block(blocks_ice(blk), blk)
3093 DO j=my_block%jlo,my_block%jhi
3094 jj=j-my_block%jlo+1
3095 DO i=my_block%ilo,my_block%ihi
3096 ii=i-my_block%ilo+1
3097 ptr3d(ii,jj,blk)=alvdr(i,j,blk)
3098 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3099 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3100 END DO
3101 END DO
3102 END DO
3103!
3104! Fraction of visible band, diffusive albedo aggregated over ice
3105! categories (nondimesional), to ATM.
3106!
3107 CASE ('alvdf', 'inst_ice_vis_dif_albedo')
3108 DO blk=1,nblocks
3109 my_block=get_block(blocks_ice(blk), blk)
3110 DO j=my_block%jlo,my_block%jhi
3111 jj=j-my_block%jlo+1
3112 DO i=my_block%ilo,my_block%ihi
3113 ii=i-my_block%ilo+1
3114 ptr3d(ii,jj,blk)=alvdf(i,j,blk)
3115 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3116 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3117 END DO
3118 END DO
3119 END DO
3120!
3121! Fraction of near-infrared band, direct albedo aggregated over
3122! ice categories (nondimesional), to ATM.
3123!
3124 CASE ('alidr', 'inst_ice_ir_dir_albedo')
3125 DO blk=1,nblocks
3126 my_block=get_block(blocks_ice(blk), blk)
3127 DO j=my_block%jlo,my_block%jhi
3128 jj=j-my_block%jlo+1
3129 DO i=my_block%ilo,my_block%ihi
3130 ii=i-my_block%ilo+1
3131 ptr3d(ii,jj,blk)=alidr(i,j,blk)
3132 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3133 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3134 END DO
3135 END DO
3136 END DO
3137!
3138! Fraction of near-infrared band, diffusive albedo aggregated over
3139! ice categories (nondimesional), to ATM.
3140!
3141 CASE ('alidf', 'inst_ice_ir_dif_albedo')
3142 DO blk=1,nblocks
3143 my_block=get_block(blocks_ice(blk), blk)
3144 DO j=my_block%jlo,my_block%jhi
3145 jj=j-my_block%jlo+1
3146 DO i=my_block%ilo,my_block%ihi
3147 ii=i-my_block%ilo+1
3148 ptr3d(ii,jj,blk)=alidf(i,j,blk)
3149 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3150 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3151 END DO
3152 END DO
3153 END DO
3154!
3155! Shortwave flux penetrating through ice to ocean (W m-2), to OCN.
3156!
3157 CASE ('fswthru', 'sw_pen_to_ocean')
3158 DO blk=1,nblocks
3159 my_block=get_block(blocks_ice(blk), blk)
3160 DO j=my_block%jlo,my_block%jhi
3161 jj=j-my_block%jlo+1
3162 DO i=my_block%ilo,my_block%ihi
3163 ii=i-my_block%ilo+1
3164 ptr3d(ii,jj,blk)=fswthru(i,j,blk)
3165 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3166 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3167 END DO
3168 END DO
3169 END DO
3170!
3171! Visible direct band of net shortwave flux penetrating through
3172! ice to ocean (W m-2), to OCN.
3173!
3174 CASE ('fswthruvdr', 'net_sw_vis_dir_flx')
3175 DO blk=1,nblocks
3176 my_block=get_block(blocks_ice(blk), blk)
3177 DO j=my_block%jlo,my_block%jhi
3178 jj=j-my_block%jlo+1
3179 DO i=my_block%ilo,my_block%ihi
3180 ii=i-my_block%ilo+1
3181 ptr3d(ii,jj,blk)=fswthruvdr(i,j,blk)
3182 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3183 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3184 END DO
3185 END DO
3186 END DO
3187!
3188! Visible diffusive band of net shortwave flux penetrating through
3189! ice to ocean (W m-2), to OCN.
3190!
3191 CASE ('fswthruvdf', 'net_sw_vis_dif_flx')
3192 DO blk=1,nblocks
3193 my_block=get_block(blocks_ice(blk), blk)
3194 DO j=my_block%jlo,my_block%jhi
3195 jj=j-my_block%jlo+1
3196 DO i=my_block%ilo,my_block%ihi
3197 ii=i-my_block%ilo+1
3198 ptr3d(ii,jj,blk)=fswthruvdf(i,j,blk)
3199 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3200 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3201 END DO
3202 END DO
3203 END DO
3204!
3205! Infrared direct band of net shortwave flux penetrating through
3206! ice to ocean (W m-2), to OCN.
3207!
3208 CASE ('fswthruidr', 'net_sw_ir_dir_flx')
3209 DO blk=1,nblocks
3210 my_block=get_block(blocks_ice(blk), blk)
3211 DO j=my_block%jlo,my_block%jhi
3212 jj=j-my_block%jlo+1
3213 DO i=my_block%ilo,my_block%ihi
3214 ii=i-my_block%ilo+1
3215 ptr3d(ii,jj,blk)=fswthruidr(i,j,blk)
3216 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3217 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3218 END DO
3219 END DO
3220 END DO
3221!
3222! Infrared diffusive band of net shortwave flux penetrating through
3223! ice to ocean (W m-2), to OCN.
3224!
3225 CASE ('fswthruidf', 'net_sw_ir_dif_flx')
3226 DO blk=1,nblocks
3227 my_block=get_block(blocks_ice(blk), blk)
3228 DO j=my_block%jlo,my_block%jhi
3229 jj=j-my_block%jlo+1
3230 DO i=my_block%ilo,my_block%ihi
3231 ii=i-my_block%ilo+1
3232 ptr3d(ii,jj,blk)=fswthruidf(i,j,blk)
3233 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3234 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3235 END DO
3236 END DO
3237 END DO
3238!
3239! Outgoing upward longwave ratiation (W m-2), averaged over ice
3240! fraction only, to ATM.
3241!
3242 CASE ('flwout', 'mean_up_lw_flx_ice')
3243 DO blk=1,nblocks
3244 my_block=get_block(blocks_ice(blk), blk)
3245 DO j=my_block%jlo,my_block%jhi
3246 jj=j-my_block%jlo+1
3247 DO i=my_block%ilo,my_block%ihi
3248 ii=i-my_block%ilo+1
3249 ptr3d(ii,jj,blk)=flwout(i,j,blk)
3250 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3251 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3252 END DO
3253 END DO
3254 END DO
3255!
3256! Ice sensible heat flux (W m-2), to ATM.
3257!
3258 CASE ('fsens', 'mean_sensi_heat_flx_atm_into_ice')
3259 DO blk=1,nblocks
3260 my_block=get_block(blocks_ice(blk), blk)
3261 DO j=my_block%jlo,my_block%jhi
3262 jj=j-my_block%jlo+1
3263 DO i=my_block%ilo,my_block%ihi
3264 ii=i-my_block%ilo+1
3265 ptr3d(ii,jj,blk)=fsens(i,j,blk)
3266 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3267 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3268 END DO
3269 END DO
3270 END DO
3271!
3272! Ice latent heat flux (W m-2), to ATM.
3273!
3274 CASE ('flat', 'mean_laten_heat_flx_atm_into_ice')
3275 DO blk=1,nblocks
3276 my_block=get_block(blocks_ice(blk), blk)
3277 DO j=my_block%jlo,my_block%jhi
3278 jj=j-my_block%jlo+1
3279 DO i=my_block%ilo,my_block%ihi
3280 ii=i-my_block%ilo+1
3281 ptr3d(ii,jj,blk)=flat(i,j,blk)
3282 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3283 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3284 END DO
3285 END DO
3286 END DO
3287!
3288! Evaporative water flux (kg m-2 s-1), to ATM.
3289!
3290 CASE ('evap', 'mean_evap_rate_atm_into_ice')
3291 DO blk=1,nblocks
3292 my_block=get_block(blocks_ice(blk), blk)
3293 DO j=my_block%jlo,my_block%jhi
3294 jj=j-my_block%jlo+1
3295 DO i=my_block%ilo,my_block%ihi
3296 ii=i-my_block%ilo+1
3297 ptr3d(ii,jj,blk)=evap(i,j,blk)
3298 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3299 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3300 END DO
3301 END DO
3302 END DO
3303!
3304! Net heat flux to ocean (W m-2), to OCN.
3305!
3306 CASE ('fhocn', 'net_heat_flx_to_ocn')
3307 DO blk=1,nblocks
3308 my_block=get_block(blocks_ice(blk), blk)
3309 DO j=my_block%jlo,my_block%jhi
3310 jj=j-my_block%jlo+1
3311 DO i=my_block%ilo,my_block%ihi
3312 ii=i-my_block%ilo+1
3313 ptr3d(ii,jj,blk)=fhocn(i,j,blk)
3314 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3315 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3316 END DO
3317 END DO
3318 END DO
3319!
3320! Fresh water flux to ocean (kg m-2 s-1), to OCN.
3321!
3322 CASE ('fresh', 'fresh_water_flx_to_ocean')
3323 DO blk=1,nblocks
3324 my_block=get_block(blocks_ice(blk), blk)
3325 DO j=my_block%jlo,my_block%jhi
3326 jj=j-my_block%jlo+1
3327 DO i=my_block%ilo,my_block%ihi
3328 ii=i-my_block%ilo+1
3329 ptr3d(ii,jj,blk)=fresh(i,j,blk)
3330 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3331 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3332 END DO
3333 END DO
3334 END DO
3335!
3336! Salt flux to ocean (kg m-2 s-1), to OCN.
3337!
3338 CASE ('fsalt', 'salt_flx_to_ocean')
3339 DO blk=1,nblocks
3340 my_block=get_block(blocks_ice(blk), blk)
3341 DO j=my_block%jlo,my_block%jhi
3342 jj=j-my_block%jlo+1
3343 DO i=my_block%ilo,my_block%ihi
3344 ii=i-my_block%ilo+1
3345 ptr3d(ii,jj,blk)=fsalt(i,j,blk)
3346 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3347 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3348 END DO
3349 END DO
3350 END DO
3351!
3352! Ice volume per unit area (m).
3353!
3354 CASE ('vice', 'mean_ice_volume')
3355 DO blk=1,nblocks
3356 my_block=get_block(blocks_ice(blk), blk)
3357 DO j=my_block%jlo,my_block%jhi
3358 jj=j-my_block%jlo+1
3359 DO i=my_block%ilo,my_block%ihi
3360 ii=i-my_block%ilo+1
3361 ptr3d(ii,jj,blk)=vice(i,j,blk)
3362 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3363 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3364 END DO
3365 END DO
3366 END DO
3367!
3368! Snow volume per unit area (m).
3369!
3370 CASE ('vsno', 'mean_snow_volume')
3371 DO blk=1,nblocks
3372 my_block=get_block(blocks_ice(blk), blk)
3373 DO j=my_block%jlo,my_block%jhi
3374 jj=j-my_block%jlo+1
3375 DO i=my_block%ilo,my_block%ihi
3376 ii=i-my_block%ilo+1
3377 ptr3d(ii,jj,blk)=vsno(i,j,blk)
3378 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3379 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3380 END DO
3381 END DO
3382 END DO
3383!
3384! Zonal stress on ice by air (N m-2), to ATM.
3385!
3386 CASE ('strairxT', 'stress_on_air_ice_zonal')
3387 DO blk=1,nblocks
3388 my_block=get_block(blocks_ice(blk), blk)
3389 DO j=my_block%jlo,my_block%jhi
3390 jj=j-my_block%jlo+1
3391 DO i=my_block%ilo,my_block%ihi
3392 ii=i-my_block%ilo+1
3393 ui=strairxt(i,j,blk)
3394 vj=strairyt(i,j,blk)
3395 ptr3d(ii,jj,blk)=ui*cos(anglet(i,j,blk))- &
3396 & vj*sin(anglet(i,j,blk))
3397 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3398 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3399 END DO
3400 END DO
3401 END DO
3402!
3403! Meridional stress on ice by air (N m-2), to ATM.
3404!
3405 CASE ('strairyT', 'stress_on_air_ice_merid')
3406 DO blk=1,nblocks
3407 my_block=get_block(blocks_ice(blk), blk)
3408 DO j=my_block%jlo,my_block%jhi
3409 jj=j-my_block%jlo+1
3410 DO i=my_block%ilo,my_block%ihi
3411 ii=i-my_block%ilo+1
3412 ui=strairxt(i,j,blk)
3413 vj=strairyt(i,j,blk)
3414 ptr3d(ii,jj,blk)=ui*sin(anglet(i,j,blk))+ &
3415 & vj*cos(anglet(i,j,blk))
3416 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3417 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3418 END DO
3419 END DO
3420 END DO
3421!
3422! Zonal stress on ice by ocean (N m-2), to OCN.
3423!
3424 CASE ('strocnxT', 'stress_on_ocn_ice_zonal')
3425 DO blk=1,nblocks
3426 my_block=get_block(blocks_ice(blk), blk)
3427 DO j=my_block%jlo,my_block%jhi
3428 jj=j-my_block%jlo+1
3429 DO i=my_block%ilo,my_block%ihi
3430 ii=i-my_block%ilo+1
3431 ui=-strocnxt(i,j,blk)
3432 vj=-strocnyt(i,j,blk)
3433 ptr3d(ii,jj,blk)=ui*cos(anglet(i,j,blk))- &
3434 & vj*sin(anglet(i,j,blk))
3435 myfmin(1)=min(myfmin(1),ptr3d(ii,jj,blk))
3436 myfmax(1)=max(myfmax(1),ptr3d(ii,jj,blk))
3437 END DO
3438 END DO
3439 END DO
3440!
3441! Meridional stress on ice by ocean (N m-2), to OCN.
3442!
3443 CASE ('strocnyT', 'stress_on_ocn_ice_merid')
3444 DO blk=1,nblocks
3445 my_block=get_block(blocks_ice(blk), blk)
3446 DO j=my_block%jlo,my_block%jhi
3447 jj=j-my_block%jlo+1
3448 DO i=my_block%ilo,my_block%ihi
3449 ii=i-my_block%ilo+1
3450 ui=-strocnxt(i,j,blk)
3451 vj=-strocnyt(i,j,blk)
3452 ptr(ii,jj,blk)=ui*sin(anglet(i,j,blk))+ &
3453 & vj*cos(anglet(i,j,blk))
3454 END DO
3455 END DO
3456 END DO
3457!
3458! Export field not found.
3459!
3460 CASE DEFAULT
3461 IF (localpet.eq.0) THEN
3462 WRITE (cplout,10) trim(adjustl(exportnamelist(ifld))), &
3463 & trim(cinpname)
3464 END IF
3465 rc=esmf_rc_not_found
3466 IF (esmf_logfounderror(rctocheck=rc, &
3467 & msg=esmf_logerr_passthru, &
3468 & line=__line__, &
3469 & file=myfile)) THEN
3470 RETURN
3471 END IF
3472 END SELECT
3473!
3474! Nullify pointer to make sure that it does not point on a random
3475! part in the memory.
3476!
3477 IF (associated(ptr3d)) nullify (ptr3d)
3478 END DO de_loop
3479!
3480! Get export field minimun and maximum values.
3481!
3482 CALL esmf_vmallreduce (vm, &
3483 & senddata=myfmin, &
3484 & recvdata=fmin, &
3485 & count=1, &
3486 & reduceflag=esmf_reduce_min, &
3487 & rc=rc)
3488 IF (esmf_logfounderror(rctocheck=rc, &
3489 & msg=esmf_logerr_passthru, &
3490 & line=__line__, &
3491 & file=myfile)) THEN
3492 RETURN
3493 END IF
3494!
3495 CALL esmf_vmallreduce (vm, &
3496 & senddata=myfmax, &
3497 & recvdata=fmax, &
3498 & count=1, &
3499 & reduceflag=esmf_reduce_max, &
3500 & rc=rc)
3501 IF (esmf_logfounderror(rctocheck=rc, &
3502 & msg=esmf_logerr_passthru, &
3503 & line=__line__, &
3504 & file=myfile)) THEN
3505 RETURN
3506 END IF
3507!
3508 IF (localpet.eq.0) THEN
3509 WRITE (cplout,20) trim(exportnamelist(ifld)), &
3510 & trim(time_currentstring), ng, &
3511 & fmin(1), fmax(1)
3512 END IF
3513!
3514! Debugging: write out field into a NetCDF file.
3515!
3516 IF ((debuglevel.ge.3).and. &
3517 & models(iseaice)%ExportField(ifld)%debug_write) THEN
3518 WRITE (ofile,10) ng, trim(exportnamelist(ifld)), &
3519 & year, month, day, hour, minutes, seconds
3520 CALL esmf_fieldwrite (field, &
3521 & trim(ofile), &
3522 & overwrite=.true., &
3523 & rc=rc)
3524 IF (esmf_logfounderror(rctocheck=rc, &
3525 & msg=esmf_logerr_passthru, &
3526 & line=__line__, &
3527 & file=myfile)) THEN
3528 RETURN
3529 END IF
3530 END IF
3531 END DO fld_loop
3532!
3533! Deallocate local arrays.
3534!
3535 IF (allocated(exportnamelist)) deallocate (exportnamelist)
3536!
3537! Update CICE export calls counter.
3538!
3539 IF (exportcount.gt.0) THEN
3540 models(iseaice)%ExportCalls=models(iseaice)%ExportCalls+1
3541 END IF
3542!
3543 IF (esm_track) THEN
3544 WRITE (trac,'(a,a,i0)') '<== Exiting CICE_Export', &
3545 & ', PET', petrank
3546 FLUSH (trac)
3547 END IF
3548 FLUSH (cplout)
3549!
3550 10 FORMAT (/,3x,' CICE_Export - unable to find option to export: ', &
3551 & a,/,18x,'check ''Export(cice)'' in input script: ',a)
3552 20 FORMAT (3x,' CICE_Export - ESMF: exporting field ''',a,'''', &
3553 & t72,a,2x,'Grid ',i2.2,/, &
3554 & 18x,'(Cmin = ', 1p,e15.8,0p,' Cmax = ',1p,e15.8,0p,')')
3555 30 FORMAT ('cice_',i2.2,'_export_',a,'_',i4.4,2('-',i2.2),'_', &
3556 & i2.2,2('.',i2.2),'.nc')
3557
3558 RETURN
3559 END SUBROUTINE cice_export
3560!
3561#endif
3562 END MODULE esmf_cice_mod
esmf_roms_mod
Definition esmf_ice_cice.h:2
esmf_roms_mod::cice_export
subroutine, private cice_export(ng, model, rc)
Definition esmf_ice_cice.h:2854
esmf_roms_mod::cice_import
subroutine, private cice_import(ng, model, rc)
Definition esmf_ice_cice.h:1924
esmf_roms_mod::cice_datainit
subroutine, private cice_datainit(model, rc)
Definition esmf_ice_cice.h:501
esmf_roms_mod::cice_setinitializep2
subroutine, private cice_setinitializep2(model, importstate, exportstate, clock, rc)
Definition esmf_ice_cice.h:387
esmf_roms_mod::cice_setgridarrays
subroutine, private cice_setgridarrays(ng, model, rc)
Definition esmf_ice_cice.h:916
esmf_roms_mod::cice_setinitializep1
subroutine, private cice_setinitializep1(model, importstate, exportstate, clock, rc)
Definition esmf_ice_cice.h:247
esmf_roms_mod::cice_modeladvance
subroutine, private cice_modeladvance(model, rc)
Definition esmf_ice_cice.h:1669
esmf_roms_mod::cice_setstates
subroutine, private cice_setstates(ng, model, rc)
Definition esmf_ice_cice.h:1308
esmf_roms_mod::cice_setclock
subroutine, private cice_setclock(model, rc)
Definition esmf_ice_cice.h:582
esmf_roms_mod::cice_setfinalize
subroutine, private cice_setfinalize(model, importstate, exportstate, clock, rc)
Definition esmf_ice_cice.h:1875
esmf_roms_mod::ice_setservices
subroutine, public ice_setservices(model, rc)
Definition esmf_ice_cice.h:101
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::debuglevel
integer debuglevel
Definition mod_esmf_esm.F:527
mod_esmf_esm::stopdate
integer, dimension(6) stopdate
Definition mod_esmf_esm.F:500
mod_esmf_esm::missing_dp
real(dp), parameter missing_dp
Definition mod_esmf_esm.F:675
mod_esmf_esm::cplout
integer cplout
Definition mod_esmf_esm.F:656
mod_esmf_esm::gridtype
character(len=6), dimension(0:4) gridtype
Definition mod_esmf_esm.F:566
mod_esmf_esm::referencedate
integer, dimension(6) referencedate
Definition mod_esmf_esm.F:497
mod_esmf_esm::iseaice
integer iseaice
Definition mod_esmf_esm.F:436
mod_esmf_esm::esm_track
logical esm_track
Definition mod_esmf_esm.F:542
mod_esmf_esm::idriver
integer idriver
Definition mod_esmf_esm.F:432
mod_esmf_esm::field_index
integer function, public field_index(fnames, fvalue)
Definition mod_esmf_esm.F:1083
mod_esmf_esm::coupled
type(esm_cplset), dimension(:), allocatable, target coupled
Definition mod_esmf_esm.F:151
mod_esmf_esm::clockinfo
type(esm_clock), dimension(:), allocatable, target clockinfo
Definition mod_esmf_esm.F:396
mod_esmf_esm::startdate
integer, dimension(6) startdate
Definition mod_esmf_esm.F:499
mod_esmf_esm::nimport
integer, dimension(:), allocatable nimport
Definition mod_esmf_esm.F:450
mod_esmf_esm::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