ROMS
Loading...
Searching...
No Matches
esmf_esm.F
Go to the documentation of this file.
1#include "cppdefs.h"
3
4#if defined MODEL_COUPLING && defined ESMF_LIB && !defined CMEPS
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 the Earth System Model (ESM) coupled gridded !
14! components interface routines using the ESMF/NUOPC layer: !
15! !
16! ESM_SetServices Sets components shared-object entry !
17! points using NUOPC generic methods !
18! !
19! ESM_SetModelServices Sets shared-object entry points for each !
20! coupled component, its connectors, and !
21! coupled system internal clock !
22! !
23! ESM_SetRunSequence Sets connectors (explicit or implicit) !
24! dependencies between ESM components !
25! !
26! The coupled components are attached to the driver via connectors. !
27! !
28! ESMF: Earth System Modeling Framework (Version 7 or higher) !
29! https://www.earthsystemcog.org/projects/esmf !
30! !
31! NUOPC: National Unified Operational Prediction Capability !
32! https://www.earthsystemcog.org/projects/nuopc !
33! !
34!=======================================================================
35!
36 USE esmf
37 USE nuopc
38 USE nuopc_driver, &
39 & nuopc_setservices => setservices, &
40 & nuopc_label_setmodelservices => label_setmodelservices, &
41 & nuopc_label_setrunsequence => label_setrunsequence
42!
43 USE mod_esmf_esm ! ESM coupling structures and variables
44!
45# ifdef ATM_COUPLING
46# if defined COAMPS_COUPLING
48# elif defined REGCM_COUPLING
50# elif defined WRF_COUPLING
52# else
54# endif
55# endif
57# ifdef DATA_COUPLING
59# endif
60# ifdef ICE_COUPLING
61# if defined CICE_COUPLING
62 USE esmf_cice_mod, ONLY: ice_setservices
63# else
65# endif
66# endif
67# ifdef CMEPS
69# else
71# endif
72# ifdef WAV_COUPLING
73# if defined WAM_COUPLING
75# else
77# endif
78# endif
79!
80 implicit none
81!
82 PUBLIC :: esm_setservices
83 PRIVATE :: esm_setmodelservices
84 PRIVATE :: esm_setrunsequence
85!
86 CONTAINS
87!
88 SUBROUTINE esm_setservices (driver, rc)
89!
90!=======================================================================
91! !
92! Sets the gridded component shared-object entry points using NUOPC !
93! generic methods followed by the appropriate specializations for !
94! "component services" and "run sequence". !
95! !
96!=======================================================================
97!
98! Imported variable declarations.
99!
100 integer, intent(out) :: rc
101!
102 TYPE(esmf_gridcomp) :: driver
103 TYPE(esmf_config) :: config
104!
105! Local variable declarations.
106!
107 character (len=*), parameter :: myfile = &
108 & __FILE__//", ESM_SetServices"
109!
110!-----------------------------------------------------------------------
111! Initialize return code flag to success state (no error).
112!-----------------------------------------------------------------------
113!
114 IF (esm_track) THEN
115 WRITE (trac,'(a,a,i0)') '==> Entering ESM_SetServices', &
116 & ', PET', petrank
117 FLUSH (trac)
118 END IF
119 rc=esmf_success
120!
121!-----------------------------------------------------------------------
122! Register generic methods.
123!-----------------------------------------------------------------------
124!
125 CALL nuopc_compderive (driver, &
126 & nuopc_setservices, &
127 & rc=rc)
128 IF (esmf_logfounderror(rctocheck=rc, &
129 & msg=esmf_logerr_passthru, &
130 & line=__line__, &
131 & file=myfile)) THEN
132 RETURN
133 END IF
134!
135!-----------------------------------------------------------------------
136! Attach ESM specializing methods.
137!-----------------------------------------------------------------------
138!
139! Set gridded component services shared-object entry point.
140!
141 CALL nuopc_compspecialize (driver, &
142 & speclabel=nuopc_label_setmodelservices,&
143 & specroutine=esm_setmodelservices, &
144 & rc=rc)
145 IF (esmf_logfounderror(rctocheck=rc, &
146 & msg=esmf_logerr_passthru, &
147 & line=__line__, &
148 & file=myfile)) THEN
149 RETURN
150 END IF
151!
152! Set component run sequence shared-object entry point.
153!
154 CALL nuopc_compspecialize (driver, &
155 & speclabel=nuopc_label_setrunsequence, &
156 & specroutine=esm_setrunsequence, &
157 & rc=rc)
158 IF (esmf_logfounderror(rctocheck=rc, &
159 & msg=esmf_logerr_passthru, &
160 & line=__line__, &
161 & file=myfile)) THEN
162 RETURN
163 END IF
164!
165!-----------------------------------------------------------------------
166! Create, open, and set ESM configuration. The ESM application run
167! sequence is read from the input configuration file.
168!-----------------------------------------------------------------------
169!
170! Create configuration object.
171!
172 config = esmf_configcreate(rc=rc)
173 IF (esmf_logfounderror(rctocheck=rc, &
174 & msg=esmf_logerr_passthru, &
175 & line=__line__, &
176 & file=myfile)) THEN
177 RETURN
178 END IF
179!
180! Read in ESN application configuration file.
181!
182 CALL esmf_configloadfile(config, &
183 & trim(confname), &
184 & rc=rc)
185 IF (esmf_logfounderror(rctocheck=rc, &
186 & msg=esmf_logerr_passthru, &
187 & line=__line__, &
188 & file=myfile)) THEN
189 RETURN
190 END IF
191!
192! Set configuration object in ESM driver.
193!
194 CALL esmf_gridcompset(driver, &
195 & config=config, &
196 & rc=rc)
197 IF (esmf_logfounderror(rctocheck=rc, &
198 & msg=esmf_logerr_passthru, &
199 & line=__line__, &
200 & file=myfile)) THEN
201 RETURN
202 END IF
203!
204 IF (esm_track) THEN
205 WRITE (trac,'(a,a,i0)') '<== Exiting ESM_SetServices', &
206 & ', PET', petrank
207 FLUSH (trac)
208 END IF
209!
210 END SUBROUTINE esm_setservices
211!
212 SUBROUTINE esm_setmodelservices (driver, rc)
213!
214!=======================================================================
215! !
216! Sets shared-object entry point for each active coupled component !
217! services. Then, set the "connectors" between active coupled !
218! component and internal clocks. !
219! !
220!=======================================================================
221!
222! Imported variable declarations.
223!
224 integer, intent(out) :: rc
225!
226 TYPE (esmf_gridcomp) :: driver
227!
228! Local variable declarations.
229!
230 integer :: i, j
231!
232 character (len=*), parameter :: myfile = &
233 & __FILE__//", ESM_SetModelServices"
234!
235 TYPE (esmf_gridcomp) :: model
236 TYPE (esmf_clock) :: clock
237 TYPE (esmf_cplcomp) :: connector
238!
239!-----------------------------------------------------------------------
240! Initialize return code flag to success state (no error).
241!-----------------------------------------------------------------------
242!
243 IF (esm_track) THEN
244 WRITE (trac,'(a,a,i0)') '==> Entering ESM_SetModelServices', &
245 & ', PET', petrank
246 FLUSH (trac)
247 END IF
248 rc=esmf_success
249!
250!-----------------------------------------------------------------------
251! Set services for ESM active coupled components.
252!-----------------------------------------------------------------------
253!
254 DO i=1,nmodels
255 IF (models(i)%IsActive) THEN
256 SELECT CASE (trim(clabel(i)))
257 CASE ('OCN')
258 CALL nuopc_driveraddcomp (driver, &
259 & trim(models(i)%name), &
261 & petlist=models(i)%PETlist(:), &
262 & comp=model, &
263 & rc=rc)
264 IF (esmf_logfounderror(rctocheck=rc, &
265 & msg=esmf_logerr_passthru, &
266 & line=__line__, &
267 & file=myfile)) THEN
268 RETURN
269 END IF
270# ifdef ATM_COUPLING
271 CASE ('ATM')
272 CALL nuopc_driveraddcomp (driver, &
273 & trim(models(i)%name), &
274 & atm_setservices, &
275 & petlist=models(i)%PETlist(:), &
276 & comp=model, &
277 & rc=rc)
278 IF (esmf_logfounderror(rctocheck=rc, &
279 & msg=esmf_logerr_passthru, &
280 & line=__line__, &
281 & file=myfile)) THEN
282 RETURN
283 END IF
284# endif
285# ifdef ICE_COUPLING
286 CASE ('ICE')
287 CALL nuopc_driveraddcomp (driver, &
288 & trim(models(i)%name), &
289 & ice_setservices, &
290 & petlist=models(i)%PETlist(:), &
291 & comp=model, &
292 & rc=rc)
293 IF (esmf_logfounderror(rctocheck=rc, &
294 & msg=esmf_logerr_passthru, &
295 & line=__line__, &
296 & file=myfile)) THEN
297 RETURN
298 END IF
299# endif
300# ifdef WAV_COUPLING
301 CASE ('WAV')
302 CALL nuopc_driveraddcomp (driver, &
303 & trim(models(i)%name), &
304 & wav_setservices, &
305 & petlist=models(i)%PETlist(:), &
306 & comp=model, &
307 & rc=rc)
308 IF (esmf_logfounderror(rctocheck=rc, &
309 & msg=esmf_logerr_passthru, &
310 & line=__line__, &
311 & file=myfile)) THEN
312 RETURN
313 END IF
314# endif
315# ifdef DATA_COUPLING
316 CASE ('DAT')
317 CALL nuopc_driveraddcomp (driver, &
318 & trim(models(i)%name), &
320 & petlist=models(i)%PETlist(:), &
321 & comp=model, &
322 & rc=rc)
323 IF (esmf_logfounderror(rctocheck=rc, &
324 & msg=esmf_logerr_passthru, &
325 & line=__line__, &
326 & file=myfile)) THEN
327 RETURN
328 END IF
329# endif
330 END SELECT
331!
332! Set debugging flag.
333!
334 IF (debuglevel.gt.0) THEN
335 CALL esmf_attributeset (model, &
336 & name="Verbosity", &
337 & value="high", &
338 & rc=rc)
339 IF (esmf_logfounderror(rctocheck=rc, &
340 & msg=esmf_logerr_passthru, &
341 & line=__line__, &
342 & file=myfile)) THEN
343 RETURN
344 END IF
345 END IF
346 END IF
347 END DO
348!
349!-----------------------------------------------------------------------
350! Set services for ESM active connector components.
351!-----------------------------------------------------------------------
352!
353 DO i=1,nmodels
354 DO j=1,nmodels
355 IF (connectors(i,j)%IsActive) THEN
356 CALL nuopc_driveraddcomp (driver, &
357 & srccomplabel=trim(models(i)%name), &
358 & dstcomplabel=trim(models(j)%name), &
359 & compsetservicesroutine=coupler_setservices, &
360 & comp=connector, &
361 & rc=rc)
362 IF (esmf_logfounderror(rctocheck=rc, &
363 & msg=esmf_logerr_passthru, &
364 & line=__line__, &
365 & file=myfile)) THEN
366 RETURN
367 END IF
368 IF (debuglevel.gt.0) THEN
369 CALL esmf_attributeset (connector, &
370 & name="Verbosity", &
371 & value="high", &
372 & rc=rc)
373 IF (esmf_logfounderror(rctocheck=rc, &
374 & msg=esmf_logerr_passthru, &
375 & line=__line__, &
376 & file=myfile)) THEN
377 RETURN
378 END IF
379 END IF
380 END IF
381 END DO
382 END DO
383!
384!-----------------------------------------------------------------------
385! Set internal clock for application: coupling starting and stopping
386! times.
387!-----------------------------------------------------------------------
388!
389 IF (clockinfo(idriver)%StartTime.ne. &
390 & clockinfo(idriver)%RestartTime) THEN
391 clockinfo(idriver)%Restarted=.true.
392 clock=esmf_clockcreate(clockinfo(idriver)%TimeStep, &
393 & clockinfo(idriver)%RestartTime, &
394 & stoptime=clockinfo(idriver)%StopTime, &
395!! & refTime=ClockInfo(Idriver)%ReferenceTime,&
396 & name='ESM_clock', &
397 & rc=rc)
398 IF (esmf_logfounderror(rctocheck=rc, &
399 & msg=esmf_logerr_passthru, &
400 & line=__line__, &
401 & file=myfile)) THEN
402 RETURN
403 END IF
404 ELSE
405 clockinfo(idriver)%Restarted=.false.
406 clock=esmf_clockcreate(clockinfo(idriver)%TimeStep, &
407 & clockinfo(idriver)%StartTime, &
408 & stoptime=clockinfo(idriver)%StopTime, &
409!! & refTime=ClockInfo(Idriver)%ReferenceTime,&
410 & name='ESM_clock', &
411 & rc=rc)
412 IF (esmf_logfounderror(rctocheck=rc, &
413 & msg=esmf_logerr_passthru, &
414 & line=__line__, &
415 & file=myfile)) THEN
416 RETURN
417 END IF
418 END IF
419 clockinfo(idriver)%Clock=clock
420!
421 CALL esmf_gridcompset (driver, &
422 & clock=clockinfo(idriver)%Clock, &
423 & rc=rc)
424 IF (esmf_logfounderror(rctocheck=rc, &
425 & msg=esmf_logerr_passthru, &
426 & line=__line__, &
427 & file=myfile)) THEN
428 RETURN
429 END IF
430!
431 IF (esm_track) THEN
432 WRITE (trac,'(a,a,i0)') '<== Exiting ESM_SetModelServices', &
433 & ', PET', petrank
434 FLUSH (trac)
435 END IF
436!
437 RETURN
438 END SUBROUTINE esm_setmodelservices
439!
440 SUBROUTINE esm_setrunsequence (driver, rc)
441!
442!=======================================================================
443! !
444! Sets the gridded component shared-object entry points using NUOPC !
445! generic methods followed by the appropriate specializations for !
446! "component services" and "run sequence". !
447! !
448!=======================================================================
449!
450! Imported variable declarations.
451!
452 integer, intent(out) :: rc
453!
454 TYPE (esmf_gridcomp) :: driver
455!
456! Local variable declarations.
457!
458 integer :: localpet
459!
460 real(r8) :: time_step
461!
462 character (len=100) :: name
463
464 character (len=*), parameter :: myfile = &
465 & __FILE__//", ESM_SetRunSequence"
466!
467 TYPE (esmf_clock) :: clock
468 TYPE (esmf_config) :: config
469 TYPE (esmf_timeinterval) :: timestep
470 TYPE (nuopc_freeformat) :: runseqff
471!
472!-----------------------------------------------------------------------
473! Initialize return code flag to success state (no error).
474!-----------------------------------------------------------------------
475!
476 IF (esm_track) THEN
477 WRITE (trac,'(a,a,i0)') '==> Entering ESM_SetRunSequence', &
478 & ', PET', petrank
479 FLUSH (trac)
480 END IF
481 rc=esmf_success
482!
483!-----------------------------------------------------------------------
484! Set run sequence from input configuration file.
485!-----------------------------------------------------------------------
486!
487! Query driver for information.
488!
489 CALL esmf_gridcompget (driver, &
490 & name=name, &
491 & localpet=localpet, &
492 & rc=rc)
493 IF (esmf_logfounderror(rctocheck=rc, &
494 & msg=esmf_logerr_passthru, &
495 & line=__line__, &
496 & file=myfile)) THEN
497 RETURN
498 END IF
499!
500! Read in free-format run sequence from configuration object.
501!
502 CALL esmf_gridcompget (driver, &
503 & config=config, &
504 & rc=rc)
505 IF (esmf_logfounderror(rctocheck=rc, &
506 & msg=esmf_logerr_passthru, &
507 & line=__line__, &
508 & file=myfile)) THEN
509 RETURN
510 END IF
511!
512 runseqff = nuopc_freeformatcreate(config, &
513 & label='runSeq::', &
514 & rc=rc)
515 IF (esmf_logfounderror(rctocheck=rc, &
516 & msg=esmf_logerr_passthru, &
517 & line=__line__, &
518 & file=myfile)) THEN
519 RETURN
520 END IF
521!
522! Ingest free-format run sequence.
523!
524 CALL nuopc_driveringestrunsequence (driver, &
525 & runseqff, &
526 & rc=rc)
527 IF (esmf_logfounderror(rctocheck=rc, &
528 & msg=esmf_logerr_passthru, &
529 & line=__line__, &
530 & file=myfile)) THEN
531 IF (localpet.eq.0) THEN
532 WRITE (cplout,10) trim(confname)
533 END IF
534 RETURN
535 END IF
536!
537! Get driver clock object.
538!
539 CALL esmf_gridcompget (driver, &
540 & clock=clock, &
541 & rc=rc)
542 IF (esmf_logfounderror(rctocheck=rc, &
543 & msg=esmf_logerr_passthru, &
544 & line=__line__, &
545 & file=myfile)) THEN
546 RETURN
547 END IF
548!
549! Inquire clock for the coupling time step set in ingested run
550! sequence.
551!
552 CALL esmf_clockget (clock, &
553 & timestep=timestep, &
554 & rc=rc)
555 IF (esmf_logfounderror(rctocheck=rc, &
556 & msg=esmf_logerr_passthru, &
557 & line=__line__, &
558 & file=myfile)) THEN
559 RETURN
560 END IF
561!
562 CALL esmf_timeintervalget (timestep, &
563 & s_r8=time_step, &
564 & rc=rc)
565 IF (esmf_logfounderror(rctocheck=rc, &
566 & msg=esmf_logerr_passthru, &
567 & line=__line__, &
568 & file=myfile)) THEN
569 RETURN
570 END IF
571!
572! Check ingested coupling time step value to the one provided in the
573! standard input script. Both values need to be the same.
574!
575 IF (time_step.ne.clockinfo(idriver)%Time_Step) THEN
576 IF (localpet.eq.0) THEN
577 WRITE (cplout,20) clockinfo(idriver)%Time_Step, &
578 & trim(cinpname), &
579 & time_step, &
580 & trim(confname)
581 END IF
582 rc=esmf_rc_val_wrong
583 RETURN
584 END IF
585!
586! Report internal driver information.
587!
588 IF (debuglevel.ge.2) THEN
589 CALL nuopc_driverprint (driver, &
590 & orderflag=.true., &
591 & rc=rc)
592 IF (esmf_logfounderror(rctocheck=rc, &
593 & msg=esmf_logerr_passthru, &
594 & line=__line__, &
595 & file=myfile)) THEN
596 RETURN
597 END IF
598 FLUSH (6) ! flush standard output unit
599 END IF
600!
601! Destroy free format object. All internal memory is deallocated.
602!
603 CALL nuopc_freeformatdestroy (runseqff, &
604 & rc=rc)
605 IF (esmf_logfounderror(rctocheck=rc, &
606 & msg=esmf_logerr_passthru, &
607 & line=__line__, &
608 & file=myfile)) THEN
609 RETURN
610 END IF
611!
612 IF (esm_track) THEN
613 WRITE (trac,'(a,a,i0)') '<== Exiting ESM_SetRunSequence', &
614 & ', PET', petrank
615 FLUSH (trac)
616 END IF
617!
618 10 FORMAT (/,' ESM_SetRunSequence - Error while ingesting', &
619 & ' RunSequence configuration file:',/,22x,a, &
620 & /,22x,'Check if connections (->) between components ' &
621 & ' are needed or not.')
622 20 FORMAT (/,' ESM_SetRunSequence - Inconsistent coupling time', &
623 & ' step (seconds) from ingested RunSequence:', &
624 & /,22x,'TimeStep = ',f15.8,2x,'(in ',a,')', &
625 & /,22x,'TimeStep = ',f15.8,2x,'(in ',a,')', &
626 & /,22x,'Correct either input file to the desired value.', &
627 & /,22x,'The value needs to be the same in both files!')
628!
629 RETURN
630 END SUBROUTINE esm_setrunsequence
631#endif
632 END MODULE esmf_esm_mod
integer petrank
Definition cmeps_roms.h:336
integer, parameter nmodels
Definition cmeps_roms.h:303
integer, parameter idriver
Definition cmeps_roms.h:304
logical esm_track
Definition cmeps_roms.h:299
integer debuglevel
Definition cmeps_roms.h:346
subroutine, public roms_setservices(model, rc)
Definition cmeps_roms.h:490
type(esm_model), dimension(:), allocatable, target models
Definition cmeps_roms.h:290
type(esm_clock), dimension(:), allocatable, target clockinfo
Definition cmeps_roms.h:195
subroutine, public atm_setservices(model, rc)
subroutine, public coupler_setservices(coupler, rc)
subroutine, public data_setservices(model, rc)
Definition esmf_data.F:133
subroutine, public esm_setservices(driver, rc)
Definition esmf_esm.F:89
subroutine, private esm_setmodelservices(driver, rc)
Definition esmf_esm.F:213
subroutine, private esm_setrunsequence(driver, rc)
Definition esmf_esm.F:441
subroutine, public ice_setservices(model, rc)
subroutine, public ice_setservices(model, rc)
subroutine, public wav_setservices(model, rc)
subroutine, public wav_setservices(model, rc)
character(len=256) cinpname
type(esm_conn), dimension(:,:), allocatable, target connectors
integer, dimension(6) timestep
character(len=256) confname
character(len=3), dimension(:), allocatable clabel