-
Notifications
You must be signed in to change notification settings - Fork 571
/
Copy pathwav_comp_nuopc.F90
1764 lines (1539 loc) · 71.6 KB
/
wav_comp_nuopc.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
!> @file wav_comp_nuopc
!!
!> A NUOPC interface for WAVEWATCH III using the CMEPS mediator
!!
!> @details This module contains the base functionality of a mesh-based
!! NUOPC cap for WW3. It contains the only public entry point, SetServices
!! which registers all of the user-provided subroutines accessed by the NUOPC
!! layer. These include the user-routines to advertise the standard names of the
!! import and export fields (InitializeAdvertise), initialize the Wave model and
!! and realize the required fields within the import and export States on an
!! ESMF Mesh (InitializeRealize), fill the export State with initial values
!! (DataInitialize), advance the model one timestep (ModelAdvance), manage the
!! component clock (ModelSetRunClock), and finalize the component model at the
!! (ModelFinalize).
!!
!! The module wav_import_export includes the public routines to advertise and
!! realize the import and export fields called during the InitializeAdvertise and
!! InitializRealize phases, respectively and to fill the import and export states
!! during the ModelAdvance phase.
!!
!! The module wav_shr_mod contains public routines to access basic ESMF functions
!! and reduce code duplication.
!!
!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov
!> @date 01-05-2022
module wav_comp_nuopc
use ESMF
use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize
use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_IsUpdated, NUOPC_IsAtTime
use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise
use NUOPC , only : NUOPC_SetAttribute, NUOPC_CompAttributeGet, NUOPC_CompAttributeSet
use NUOPC_Model , only : model_routine_SS => SetServices
use NUOPC_Model , only : model_label_Advance => label_Advance
use NUOPC_Model , only : model_label_DataInitialize => label_DataInitialize
use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock
use NUOPC_Model , only : model_label_Finalize => label_Finalize
use NUOPC_Model , only : NUOPC_ModelGet, SetVM
use wav_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, i4=>shr_kind_i4
use wav_kind_mod , only : cl=>shr_kind_cl, cs=>shr_kind_cs
use wav_import_export , only : advertise_fields, realize_fields, nseal_cpl
use wav_shr_mod , only : state_diagnose, state_getfldptr, state_fldchk
use wav_shr_mod , only : chkerr, state_setscalar, state_getscalar, alarmInit, ymd2date
use wav_shr_mod , only : wav_coupling_to_cice, nwav_elev_spectrum
use wav_shr_mod , only : merge_import, dbug_flag
use w3odatmd , only : nds, iaproc, napout
use w3odatmd , only : runtype, user_histfname, user_restfname, verboselog
use w3odatmd , only : use_historync, use_restartnc, restart_from_binary, logfile_is_assigned
use w3odatmd , only : time_origin, calendar_name, elapsed_secs
use wav_shr_mod , only : casename, multigrid, inst_suffix, inst_index, unstr_mesh
use wav_wrapper_mod , only : ufs_settimer, ufs_logtimer, ufs_file_setlogunit, wtime
#ifndef W3_CESMCOUPLED
use wmwavemd , only : wmwave
use wmupdtmd , only : wmupd2
use wmmdatmd , only : mdse, mdst, nrgrd, improc, nmproc, wmsetm, stime, etime
use wmmdatmd , only : nmpscr
use w3updtmd , only : w3uini
use w3adatmd , only : flcold, fliwnd
#endif
use constants , only : is_esmf_component
implicit none
private ! except
public :: SetServices
public :: SetVM
private :: InitializeP0
private :: InitializeAdvertise
private :: InitializeRealize
private :: ModelSetRunClock
private :: ModelAdvance
private :: ModelFinalize
include "mpif.h"
!--------------------------------------------------------------------------
! Private module data
!--------------------------------------------------------------------------
character(len=CL) :: flds_scalar_name = '' !< the default scalar field name
integer :: flds_scalar_num = 0 !< the default number of scalar fields
integer :: flds_scalar_index_nx = 0 !< the default size of the scalar field nx
integer :: flds_scalar_index_ny = 0 !< the default size of the scalar field ny
logical :: profile_memory = .false. !< default logical to control use of ESMF
!! memory profiling
logical :: root_task = .false. !< logical to indicate root task
#ifdef W3_CESMCOUPLED
logical :: cesmcoupled = .true. !< logical to indicate CESM use case
#else
logical :: cesmcoupled = .false. !< logical to indicate non-CESM use case
#endif
integer, allocatable :: tend(:,:) !< the ending time of ModelAdvance when
!! run with multigrid=true
integer :: ymd !< current year-month-day
integer :: tod !< current time of day (sec)
integer :: time0(2) !< start time stored as yyyymmdd,hhmmss
integer :: timen(2) !< end time stored as yyyymmdd,hhmmss
integer :: nu_timer !< simple timer log, unused except by UFS
logical :: runtimelog = .false. !< logical flag for writing runtime log files
character(*), parameter :: modName = "(wav_comp_nuopc)" !< the name of this module
character(*), parameter :: u_FILE_u = & !< a character string for an ESMF log message
__FILE__
!===============================================================================
contains
!===============================================================================
!> The public entry point. The NUOPC SetService method registers all of the
!! user-provided subroutines in the module with the NUOPC layer
!!
!! @param[in] gcomp an ESMF_GridComp object
!! @param[out] rc return code
!!
!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov
!> @date 01-05-2022
subroutine SetServices(gcomp, rc)
type(ESMF_GridComp) :: gcomp
integer, intent(out) :: rc
character(len=*),parameter :: subname=trim(modName)//':(SetServices) '
rc = ESMF_SUCCESS
call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO)
! the NUOPC gcomp component will register the generic methods
call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
! switching to IPD versions
call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, &
userRoutine=InitializeP0, phase=0, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
! set entry point for methods that require specific implementation
call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, &
phaseLabelList=(/"IPDv01p1"/), userRoutine=InitializeAdvertise, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, &
phaseLabelList=(/"IPDv01p3"/), userRoutine=InitializeRealize, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
! attach specializing method(s)
call NUOPC_CompSpecialize(gcomp, specLabel=model_label_DataInitialize, &
specRoutine=DataInitialize, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, &
specRoutine=ModelAdvance, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, &
specRoutine=ModelSetRunClock, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, &
specRoutine=ModelFinalize, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO)
end subroutine SetServices
!===============================================================================
!> Switch to IPDv01 by filtering all other phaseMap entries
!!
!> @details Called by NUOPC to set the version of the Initialize Phase Definition
!! (IPD) to use.
!!
!! @param[in] gcomp an ESMF_GridComp object
!! @param[in] importState an ESMF_State object for import fields
!! @param[in] exportState an ESMF_State object for export fields
!! @param[in] clock an ESMF_Clock object
!! @param[out] rc return code
!!
!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov
!> @date 01-05-2022
subroutine InitializeP0(gcomp, importState, exportState, clock, rc)
type(ESMF_GridComp) :: gcomp
type(ESMF_State) :: importState, exportState
type(ESMF_Clock) :: clock
integer, intent(out) :: rc
!-------------------------------------------------------------------------------
rc = ESMF_SUCCESS
! Switch to IPDv01 by filtering all other phaseMap entries
call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv01p"/), rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end subroutine InitializeP0
!===============================================================================
!> Read configuration attributes and advertise the import/export fields
!> @details Called by NUOPC to read configuration attributes and to advertise the
!! import and export fields. The configuration attributes are used to control run
!! time settings, such as ESMF memory profiling, additional debug logging, multigrid
!! mode and character strings for specific use cases. A set of configuration attributes
!! is also read to describe any scalar fields to be added to a state. For coupling
!! with the wave model, only a scalar field for the dimensions of the wave model
!! is required. The scalar field is added to the export state to communicate to the
!! CMEPS mediator the domain dimensions of the wave model in order to write
!! mediator history and restart files. The attribute ScalarFieldName sets the name
!! of the scalar field in the export state, the ScalarFieldCount sets the
!! dimensionality of the scalar field and the ScalarFieldIdxGridNX (NY) set the
!! index of the NX or NY dimension in the scalar field.
!!
!! @param[in] gcomp an ESMF_GridComp object
!! @param[in] importState an ESMF_State object for import fields
!! @param[in] exportState an ESMF_State object for export fields
!! @param[in] clock an ESMF_Clock object
!! @param[out] rc return code
!!
!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov
!> @date 01-05-2022
subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
use wav_shr_flags, only : w3_pdlib_flag
! input/output arguments
type(ESMF_GridComp) :: gcomp
type(ESMF_State) :: importState, exportState
type(ESMF_Clock) :: clock
integer, intent(out) :: rc
! local variables
character(len=CL) :: logmsg
logical :: isPresent, isSet
character(len=CL) :: cvalue
character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) '
!-------------------------------------------------------------------------------
call ufs_settimer(wtime)
rc = ESMF_SUCCESS
call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO)
!----------------------------------------------------------------------------
! advertise fields
!----------------------------------------------------------------------------
call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
flds_scalar_name = trim(cvalue)
call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
else
call ESMF_LogWrite(trim(subname)//'Need to set attribute ScalarFieldName',&
ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u)
rc = ESMF_FAILURE
return
endif
call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(cvalue, *) flds_scalar_num
write(logmsg,*) flds_scalar_num
call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
else
call ESMF_LogWrite(trim(subname)//'Need to set attribute ScalarFieldCount',&
ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u)
rc = ESMF_FAILURE
return
endif
call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(cvalue,*) flds_scalar_index_nx
write(logmsg,*) flds_scalar_index_nx
call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
else
call ESMF_LogWrite(trim(subname)//'Need to set attribute ScalarFieldIdxGridNX',&
ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u)
rc = ESMF_FAILURE
return
endif
call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(cvalue,*) flds_scalar_index_ny
write(logmsg,*) flds_scalar_index_ny
call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
else
call ESMF_LogWrite(trim(subname)//'Need to set attribute ScalarFieldIdxGridNY',&
ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u)
rc = ESMF_FAILURE
return
endif
call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(cvalue,*) profile_memory
call ESMF_LogWrite(trim(subname)//': profile_memory = '//trim(cvalue), ESMF_LOGMSG_INFO)
end if
call NUOPC_CompAttributeGet(gcomp, name="merge_import", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
if (trim(cvalue) == '.true.') then
merge_import = .true.
end if
end if
if (merge_import) then
if (w3_pdlib_flag) then
call ESMF_LogWrite('Merge_import is not valid with PDLIB', ESMF_LOGMSG_INFO)
call ESMF_Finalize(endflag=ESMF_END_ABORT)
end if
end if
call NUOPC_CompAttributeGet(gcomp, name='dbug_flag', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(cvalue,*) dbug_flag
end if
write(logmsg,'(A,i6)') trim(subname)//': Wave cap dbug_flag is ',dbug_flag
call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO)
! Get casename
call NUOPC_CompAttributeGet(gcomp, name="case_name", value=casename, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
write(logmsg,'(A)') trim(subname)//': Wave casename setting : '//trim(casename)
call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO)
! Get component instance
call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
if (isPresent) then
call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
cvalue = inst_suffix(2:)
read(cvalue, *) inst_index
else
inst_suffix = ""
inst_index=1
endif
! Get Multigrid setting
multigrid = .false.
call NUOPC_CompAttributeGet(gcomp, name='multigrid', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
multigrid=(trim(cvalue)=="true")
end if
write(logmsg,'(A,l)') trim(subname)//': Wave multigrid setting is ',multigrid
call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO)
! Determine wave-ice coupling
wav_coupling_to_cice = .false.
call NUOPC_CompAttributeGet(gcomp, name='wav_coupling_to_cice', value=cvalue, isPresent=isPresent, &
isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(cvalue,*) wav_coupling_to_cice
end if
write(logmsg,'(A,l)') trim(subname)//': Wave wav_coupling_to_cice setting is ',wav_coupling_to_cice
call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO)
! Determine Runtime logging
call NUOPC_CompAttributeGet(gcomp, name="RunTimeLog", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) runtimelog=(trim(cvalue)=="true")
write(logmsg,*) runtimelog
call ESMF_LogWrite('WW3_cap:RunTimeLog = '//trim(logmsg), ESMF_LOGMSG_INFO)
if (runtimelog) then
call ufs_file_setLogUnit('./log.ww3.timer',nu_timer,runtimelog)
end if
! Determine verbose native WW3 logging
call NUOPC_CompAttributeGet(gcomp, name="verboselog", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) verboselog=(trim(cvalue)=="true")
write(logmsg,*) verboselog
call ESMF_LogWrite('WW3_cap: Verbose WW3 native logging is = '//trim(logmsg), ESMF_LOGMSG_INFO)
call advertise_fields(importState, exportState, flds_scalar_name, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO)
end subroutine InitializeAdvertise
!========================================================================
!> Realize the import and export fields.
!> @details Called by NUOPC to realize the import and export fields
!! for the wave model. After the wave model initializes, the global index
!! for all sea points is retrieved using the WW3 mapsf array. A global index
!! array is then constructed which contains both land and sea points, with
!! the land points at the end of the array. An ESMF Distgrid object is created
!! using this global index array. The distgrid is then transfered to the ESMF
!! Mesh provided for the wave model domain. If the provided Mesh does not contain
!! a grid mask, then the internal WW3 mask is transfered to the Mesh, otherwise
!! the mask provided with the mesh file will be used. This mask is used by
!! CMEPS to map to and from the wave model. Once the mesh has been created, the
!! advertised fields are realized on the mesh.
!!
!! @param[in] gcomp an ESMF_GridComp object
!! @param[in] importState an ESMF_State object for import fields
!! @param[in] exportState an ESMF_State object for export fields
!! @param[in] clock an ESMF_Clock object
!! @param[out] rc return code
!!
!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov
!> @date 01-05-2022
subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
use w3odatmd , only : w3nout, w3seto, naproc, naperr
use w3timemd , only : stme21
use w3adatmd , only : w3naux, w3seta
use w3idatmd , only : w3seti, w3ninp
use w3gdatmd , only : nk, nseal, nsea, nx, ny, mapsf, w3nmod, w3setg
use w3gdatmd , only : rlgtype, ungtype, gtype
use w3wdatmd , only : va, time, w3ndat, w3dimw, w3setw
use w3parall , only : init_get_isea
#ifndef W3_CESMCOUPLED
use wminitmd , only : wminit, wminitnml
use wmunitmd , only : wmuget, wmuset
#endif
use wav_shel_inp , only : set_shel_io
use wav_history_mod , only : wav_history_init
use wav_pio_mod , only : wav_pio_init
use wav_shr_mod , only : diagnose_mesh, write_meshdecomp, wav_loginit
#ifdef W3_PDLIB
use yowNodepool , only : ng
#endif
! input/output variables
type(ESMF_GridComp) :: gcomp
type(ESMF_State) :: importState
type(ESMF_State) :: exportState
type(ESMF_Clock) :: clock
integer, intent(out) :: rc
! local variables
type(ESMF_DistGrid) :: distGrid
type(ESMF_Mesh) :: Emesh
type(ESMF_Array) :: elemMaskArray
type(ESMF_VM) :: vm
type(ESMF_Time) :: esmfTime, startTime, currTime, stopTime
type(ESMF_TimeInterval) :: TimeOffset
type(ESMF_TimeInterval) :: TimeStep
type(ESMF_Calendar) :: calendar
type(ESMF_Info) :: info
character(CL) :: cvalue
integer :: shrlogunit
integer :: yy,mm,dd,hh,ss
integer :: start_ymd ! start date (yyyymmdd)
integer :: start_tod ! start time of day (sec)
integer :: stop_ymd ! stop date (yyyymmdd)
integer :: stop_tod ! stop time of day (sec)
integer :: ix, iy
character(CL) :: starttype
integer :: ntrace(2)
integer :: n, jsea,isea, ncnt
integer :: nlnd, nlnd_global, nlnd_local
integer :: my_lnd_start, my_lnd_end
integer, allocatable, target :: mask_global(:)
integer, allocatable, target :: mask_local(:)
integer, allocatable :: gindex_lnd(:)
integer, allocatable :: gindex_sea(:)
integer, allocatable :: gindex(:)
integer(i4) :: maskmin
integer(i4), pointer :: meshmask(:)
character(23) :: dtme21
integer :: iam, mpi_comm, num_threads
character(ESMF_MAXSTR) :: msgString
character(ESMF_MAXSTR) :: diro
character(CL) :: logfile
logical :: local
integer :: imod, idsi, idso, idss, idst, idse
integer :: mds(13) ! Note that nds is set to this in w3initmod
integer :: stdout
integer :: petcount
real(r8) :: toff
logical :: isPresent, isSet
character(ESMF_MAXSTR) :: preamb = './'
character(ESMF_MAXSTR) :: ifname = 'ww3_multi.inp'
character(len=*), parameter :: subname = '(wav_comp_nuopc:InitializeRealize)'
! -------------------------------------------------------------------
rc = ESMF_SUCCESS
if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO)
call ufs_settimer(wtime)
!--------------------------------------------------------------------
! Set up data structures
!--------------------------------------------------------------------
if (.not. multigrid) then
call w3nmod ( 1, 6, 6 )
call w3ndat ( 6, 6 )
call w3naux ( 6, 6 )
call w3nout ( 6, 6 )
call w3ninp ( 6, 6 )
call w3setg ( 1, 6, 6 )
call w3setw ( 1, 6, 6 )
call w3seta ( 1, 6, 6 )
call w3seto ( 1, 6, 6 )
call w3seti ( 1, 6, 6 )
end if
!----------------------------------------------------------------------------
! Generate local mpi comm
!----------------------------------------------------------------------------
call ESMF_GridCompGet(gcomp, vm=vm, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_VMGet(vm, mpiCommunicator=mpi_comm, peCount=petcount, localPet=iam, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_InfoGetFromHost(gcomp, info=info, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_InfoGet(info, key="/NUOPC/Hint/PePerPet/MaxCount", value=num_threads, default=1, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
#ifndef W3_CESMCOUPLED
nmproc = petcount
#else
naproc = petcount
#endif
! naproc,iproc, napout, naperr are not available until after wminit
#ifndef W3_CESMCOUPLED
improc = iam + 1
if (multigrid) then
nmpscr = 1
is_esmf_component = .true.
else
iaproc = iam + 1
naproc = nmproc
napout = 1
naperr = 1
end if
if (improc == 1) root_task = .true.
#else
iaproc = iam + 1
napout = 1
naperr = 1
if (iaproc == napout) root_task = .true.
#endif
!--------------------------------------------------------------------
! IO set-up
!--------------------------------------------------------------------
if (cesmcoupled) then
shrlogunit = 6
if ( root_task ) then
call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
open (newunit=stdout, file=trim(diro)//"/"//trim(logfile))
logfile_is_assigned = .true.
else
stdout = 6
endif
else
if ( root_task ) then
open (newunit=stdout, file='log.ww3')
logfile_is_assigned = .true.
else
stdout = 6
end if
end if
if (.not. multigrid) call set_shel_io(stdout,mds,ntrace)
if ( root_task ) then
write(stdout,'(a)')' *** WAVEWATCH III Program shell *** '
write(stdout,'(a)')'==============================================='
write(stdout,'(/)')
write(stdout,'(a,l)')' Wave wav_coupling_to_cice setting is ',wav_coupling_to_cice
end if
!--------------------------------------------------------------------
! Initialize run type
!--------------------------------------------------------------------
call NUOPC_CompAttributeGet(gcomp, name='start_type', value=starttype, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if ( trim(starttype) == trim('startup')) then
runtype = "initial"
else if (trim(starttype) == trim('continue') ) then
runtype = "continue"
else if (trim(starttype) == trim('branch')) then
runtype = "branch"
end if
if ( root_task ) then
write(stdout,'(a)') ' WW3 runtype is '//trim(runtype)
end if
call ESMF_LogWrite('WW3 runtype is '//trim(runtype), ESMF_LOGMSG_INFO)
!--------------------------------------------------------------------
! Time initialization
!--------------------------------------------------------------------
! TIME0 = from ESMF clock
! NOTE - are not setting TIMEN here
if ( root_task ) then
write(stdout,'(a)')' Time interval : '
write(stdout,'(a)')'--------------------------------------------------'
end if
call ESMF_ClockPrint(clock, options="startTime", preString="Model Start Time: ", &
unit=msgString, rc=rc)
call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO)
call ESMF_ClockPrint(clock, options="currTime", preString="Model Current Time: ", &
unit=msgString, rc=rc)
call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO)
call ESMF_ClockGet( clock, startTime=startTime, currTime=currTime, rc=rc)
TimeOffset = currTime - startTime
call ESMF_TimeIntervalGet(TimeOffset, h_r8=toff, rc=rc)
write(msgstring,'(a,g14.7)')'TimeOffset: CurrTime - StartTime = ',toff
call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO)
! Initial run or restart run
if ( runtype == "initial") then
call ESMF_ClockGet( clock, startTime=esmfTime, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
#ifndef W3_CESMCOUPLED
esmfTime = esmfTime + TimeOffset
#endif
else
call ESMF_ClockGet( clock, currTime=esmfTime, rc=rc )
if (ChkErr(rc,__LINE__,u_FILE_u)) return
endif
! Determine time attributes for history output
call ESMF_TimeGet( startTime, timeString=time_origin, calendar=calendar, rc=rc )
if (ChkErr(rc,__LINE__,u_FILE_u)) return
time_origin = 'seconds since '//time_origin(1:10)//' '//time_origin(12:19)
!call ESMF_ClockGet(clock, calendar=calendar)
if (calendar == ESMF_CALKIND_GREGORIAN) then
calendar_name = 'standard'
else if (calendar == ESMF_CALKIND_NOLEAP) then
calendar_name = 'noleap'
end if
call ESMF_TimeGet( esmfTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc )
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ymd2date(yy, mm, dd, start_ymd)
hh = start_tod/3600
mm = (start_tod - (hh * 3600))/60
ss = start_tod - (hh*3600) - (mm*60)
time0(1) = start_ymd
time0(2) = hh*10000 + mm*100 + ss
call ESMF_ClockGet( clock, stopTime=stopTime, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_TimeGet( stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc )
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ymd2date(yy, mm, dd, stop_ymd)
hh = stop_tod/3600
mm = (stop_tod - (hh * 3600))/60
ss = stop_tod - (hh*3600) - (mm*60)
timen(1) = stop_ymd
timen(2) = hh*10000 + mm*100 + ss
call stme21 ( time0 , dtme21 )
if ( root_task ) then
write (stdout,'(a)')' Starting time : '//trim(dtme21)
write (stdout,'(a,i8,2x,i8)') ' start_ymd, stop_ymd = ',start_ymd, stop_ymd
end if
#ifndef W3_CESMCOUPLED
stime = time0
etime = timen
#endif
!--------------------------------------------------------------------
! Initialize PIO. This needs to be done prior to the call to w3init
! in order to read the restart file. The filename strings must also
! be available
!--------------------------------------------------------------------
if (cesmcoupled) then
if (len_trim(inst_suffix) > 0) then
user_restfname = trim(casename)//'.ww3'//trim(inst_suffix)//'.r.'
user_histfname = trim(casename)//'.ww3'//trim(inst_suffix)//'.hi.'
else
user_restfname = trim(casename)//'.ww3.r.'
user_histfname = trim(casename)//'.ww3.hi.'
endif
! netcdf is used for CESM history and restart
use_historync = .true.
use_restartnc = .true.
else
call NUOPC_CompAttributeGet(gcomp, name='use_restartnc', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
use_restartnc=(trim(cvalue)=="true")
end if
if (root_task) write(stdout,'(a,l4)') trim(subname)//': Wave use_restartnc setting is ',use_restartnc
! user filenaming is required with netcdf restarts or restart_from_binary. If netcdf restarts are not used,
! only native WW3 file naming is possible
if (use_restartnc) then
user_restfname = trim(casename)//'.ww3.r.'
if (root_task) write(stdout,'(a)') trim(subname)//': Custom restart prefix is '//trim(user_restfname)
end if
call NUOPC_CompAttributeGet(gcomp, name='use_historync', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
use_historync=(trim(cvalue)=="true")
end if
if (root_task) write(stdout,'(a,l4)') trim(subname)//': Wave use_historync setting is ',use_historync
! user filenaming is optional with netcdf output. If netcdf history is not used, only native WW3
! naming is possible
if (use_historync) then
call NUOPC_CompAttributeGet(gcomp, name='user_histname', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (trim(cvalue)=="true") then
user_histfname = trim(casename)//'.ww3.hi.'
if (root_task) write(stdout,'(a)') trim(subname)//': Custom history prefix is '//trim(user_histfname)
else
user_histfname = ''
end if
end if
end if ! if (cesmcoupled)
! allow startup from binary restarts as special case
if (use_restartnc) then
call NUOPC_CompAttributeGet(gcomp, name='restart_from_binary', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
restart_from_binary=(trim(cvalue)=="true")
end if
if (root_task) write(stdout,'(a,l4)') trim(subname)//': Wave restart_from_binary setting is ',restart_from_binary
end if
if (use_restartnc .or. use_historync) then
call wav_pio_init(gcomp, mpi_comm, stdout, naproc/num_threads, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if
!--------------------------------------------------------------------
! Wave model initialization
!--------------------------------------------------------------------
#ifndef W3_CESMCOUPLED
if (multigrid) then
call ESMF_UtilIOUnitGet(idsi); open(unit=idsi, status='scratch')
call ESMF_UtilIOUnitGet(idso); open(unit=idso, status='scratch')
call ESMF_UtilIOUnitGet(idss); open(unit=idss, status='scratch')
call ESMF_UtilIOUnitGet(idst); open(unit=idst, status='scratch')
call ESMF_UtilIOUnitGet(idse); open(unit=idse, status='scratch')
close(idsi); close(idso); close(idss); close(idst); close(idse)
if ( trim(ifname) == 'ww3_multi.nml' ) then
call wminitnml ( idsi, idso, idss, idst, idse, trim(ifname), &
mpi_comm, preamb=preamb )
else
call wminit ( idsi, idso, idss, idst, idse, trim(ifname), &
mpi_comm, preamb=preamb )
endif
allocate(tend(2,nrgrd))
do imod = 1,nrgrd
tend(1,imod) = etime(1)
tend(2,imod) = etime(2)
end do
call ESMF_LogWrite(trim(subname)//' done = wminit', ESMF_LOGMSG_INFO)
else
call waveinit_ufs(gcomp, stdout, ntrace, mpi_comm, mds, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if
#else
time = time0
call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call waveinit_cesm(gcomp, ntrace, mpi_comm, mds, rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
#endif
!call mpi_barrier ( mpi_comm, ierr )
if ( root_task ) then
inquire(unit=stdout, name=logfile)
write(*,'(a)')'WW3 log written to '//trim(logfile)
end if
if (wav_coupling_to_cice) then
if (nwav_elev_spectrum .gt. nk) then
call ESMF_LogWrite('nwav_elev_spectrum is greater than nk ', ESMF_LOGMSG_INFO)
call ESMF_Finalize(endflag=ESMF_END_ABORT)
end if
end if
!--------------------------------------------------------------------
! Mesh initialization
!--------------------------------------------------------------------
if (gtype .eq. ungtype) then
unstr_mesh = .true.
else
unstr_mesh = .false.
end if
! Create a global index array for sea points.
!
! Note that nsea is the global number of sea points - and nseal is the local
! number of sea points. For the unstr mesh, the nsea points are on mesh nodes.
! We will use the gindex to set the element distgrid of a dual mesh. A dual mesh
! contains the mesh nodes at the center of each element. For the domain decomposition
! case (PDLIB), set a value of the local sea points on this processor minus the
! ghost points.
#ifdef W3_PDLIB
nseal_cpl = nseal - ng
#else
nseal_cpl = nseal
#endif
allocate(gindex_sea(nseal_cpl))
do jsea=1, nseal_cpl
call init_get_isea(isea, jsea)
ix = mapsf(isea,1)
iy = mapsf(isea,2)
gindex_sea(jsea) = ix + (iy-1)*nx
end do
if (unstr_mesh) then
! create distGrid from global index array of sea points with no ghost points
DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex_sea, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
else
! create a global index array for non-sea (i.e. land points)
allocate(mask_global(nx*ny), mask_local(nx*ny))
mask_local(:) = 0
mask_global(:) = 0
do jsea=1, nseal_cpl
call init_get_isea(isea, jsea)
ix = mapsf(isea,1)
iy = mapsf(isea,2)
mask_local(ix + (iy-1)*nx) = 1
end do
call ESMF_VMAllReduce(vm, sendData=mask_local, recvData=mask_global, count=nx*ny, &
reduceflag=ESMF_REDUCE_MAX, rc=rc)
nlnd_global = nx*ny - nsea
nlnd_local = nlnd_global / naproc
my_lnd_start = nlnd_local*iam + min(iam, mod(nlnd_global, naproc)) + 1
if (iam < mod(nlnd_global, naproc)) then
nlnd_local = nlnd_local + 1
end if
my_lnd_end = my_lnd_start + nlnd_local - 1
allocate(gindex_lnd(my_lnd_end - my_lnd_start + 1))
ncnt = 0
do n = 1,nx*ny
if (mask_global(n) == 0) then ! this is a land point
ncnt = ncnt + 1
if (ncnt >= my_lnd_start .and. ncnt <= my_lnd_end) then
gindex_lnd(ncnt - my_lnd_start + 1) = n
end if
end if
end do
deallocate(mask_global)
deallocate(mask_local)
! create a global index that includes both sea and land - but put land at the end
nlnd = (my_lnd_end - my_lnd_start + 1)
allocate(gindex(nlnd + nseal_cpl))
do ncnt = 1,nlnd + nseal
if (ncnt <= nseal_cpl) then
gindex(ncnt) = gindex_sea(ncnt)
else
gindex(ncnt) = gindex_lnd(ncnt-nseal_cpl)
end if
end do
! create distGrid from global index array
DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if
! get the mesh file name
call NUOPC_CompAttributeGet(gcomp, name='mesh_wav', value=cvalue, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
! read in the mesh with the the DistGrid
EMesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, &
elementDistgrid=Distgrid,rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (dbug_flag > 5) then
if (unstr_mesh) then
call diagnose_mesh(EMesh, size(gindex_sea), 'EMesh', rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
deallocate(gindex_sea)
else
call diagnose_mesh(EMesh, size(gindex), 'EMesh', rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
deallocate(gindex)
deallocate(gindex_sea)
deallocate(gindex_lnd)
end if
end if
if (.not. unstr_mesh) then
! obtain the mesh mask and find the minimum value across all PEs
call ESMF_MeshGet(EMesh, elementDistgrid=Distgrid, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_DistGridGet(Distgrid, localDe=0, elementCount=ncnt, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
allocate(meshmask(ncnt))
elemMaskArray = ESMF_ArrayCreate(Distgrid, farrayPtr=meshmask, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_MeshGet(Emesh, elemMaskArray=elemMaskArray, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_VMAllFullReduce(vm, sendData=meshmask, recvData=maskmin, count=ncnt, &
reduceflag=ESMF_REDUCE_MIN, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (maskmin == 1) then
! replace mesh mask with internal mask
meshmask(:) = 0
meshmask(1:nseal_cpl) = 1
call ESMF_MeshSet(mesh=EMesh, elementMask=meshmask, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
end if
if (dbug_flag > 5) then
call ESMF_ArrayWrite(elemMaskArray, 'meshmask.nc', variableName = 'mask', &
overwrite=.true., rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if
deallocate(meshmask)
end if
if (dbug_flag > 5) then
call write_meshdecomp(Emesh, 'emesh', rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if
!--------------------------------------------------------------------
! Realize the actively coupled fields
!--------------------------------------------------------------------
call realize_fields(gcomp, mesh=Emesh, flds_scalar_name=flds_scalar_name, &
flds_scalar_num=flds_scalar_num, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
#ifndef W3_CESMCOUPLED
!TODO: when is this required?
if (multigrid) then
do imod = 1,nrgrd
call w3setg ( imod, mdse, mdst )
call w3setw ( imod, mdse, mdst )
call w3seta ( imod, mdse, mdst )
call w3seti ( imod, mdse, mdst )
call w3seto ( imod, mdse, mdst )
call wmsetm ( imod, mdse, mdst )
local = iaproc .gt. 0 .and. iaproc .le. naproc
if ( local .and. flcold .and. fliwnd ) call w3uini( va )
enddo
end if
#endif
!--------------------------------------------------------------------
! Intialize the list of requested output variables for netCDF output.
! This needs to occur after mod_def has been read in w3init since
! some variables are available only if they are defined in the mod_def
!--------------------------------------------------------------------
if (use_historync) then
call wav_history_init(stdout)
end if
!--------------------------------------------------------------------
! Write the header string for WW3 native logging
!--------------------------------------------------------------------
if (root_task) then
if (verboselog) call wav_loginit(stdout)
end if
if (root_task) call ufs_logtimer(nu_timer,time,start_tod,'InitializeRealize time: ',runtimelog,wtime)
if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO)
end subroutine InitializeRealize
!===============================================================================
!> Initialize the field values in the export state
!!
!> @details Called by NUOPC to initialize the field values in the export state and
!! the values for the scalar field which describes the wave model global domain