forked from ESCOMP/CMEPS
-
Notifications
You must be signed in to change notification settings - Fork 0
/
med_phases_aofluxes_mod.F90
1792 lines (1537 loc) · 78.1 KB
/
med_phases_aofluxes_mod.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
module med_phases_aofluxes_mod
! --------------------------------------------------------------------------
! Determine atm/ocn flux calculation in mediator - for one of 3 cases:
! if aoflux grid is ocn
! - map atm attributes of aoflux_in to ocn and map aoflux_out back to atm
! if aoflux grid is atm
! - map ocn attributes of oaflux_in to atm and map aoflux_out back to ocn
! if aoflux grid is exchange
! - map both atm and ocn attributes of aoflux_in to xgrid and then
! map aoflux_out from xgrid to both atm and ocn grid
! --------------------------------------------------------------------------
use ESMF , only : operator(/=)
use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_CoordSys_Flag
use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldIsCreated, ESMF_FieldDestroy
use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldRegridGetArea
use ESMF , only : ESMF_FieldBundleCreate, ESMF_FieldBundleAdd
use ESMF , only : ESMF_RouteHandle, ESMF_FieldRegrid, ESMF_FieldRegridStore
use ESMF , only : ESMF_REGRIDMETHOD_CONSERVE_2ND, ESMF_REGRIDMETHOD_CONSERVE
use ESMF , only : ESMF_REGRIDMETHOD_PATCH, ESMF_REGRIDMETHOD_BILINEAR, ESMF_COORDSYS_CART
use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_REGION_TOTAL, ESMF_MESHLOC_ELEMENT, ESMF_MAXSTR
use ESMF , only : ESMF_XGRIDSIDE_B, ESMF_XGRIDSIDE_A, ESMF_END_ABORT, ESMF_LOGERR_PASSTHRU
use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_XGrid, ESMF_XGridCreate, ESMF_TYPEKIND_R8
use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LOGMSG_ERROR, ESMF_FAILURE
use ESMF , only : ESMF_Finalize, ESMF_LogFoundError
use ESMF , only : ESMF_XGridGet, ESMF_MeshCreate, ESMF_MeshWrite, ESMF_KIND_R8
use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8
use med_internalstate_mod , only : InternalState, maintask, logunit
use med_internalstate_mod , only : compatm, compocn, compwav, coupling_mode, aoflux_code, mapconsd, mapconsf, mapfcopy
use med_constants_mod , only : dbug_flag => med_constants_dbug_flag
use med_utils_mod , only : memcheck => med_memcheck
use med_utils_mod , only : chkerr => med_utils_chkerr
use perf_mod , only : t_startf, t_stopf
#ifndef CESMCOUPLED
use ufs_const_mod , only : rearth => SHR_CONST_REARTH
use ufs_const_mod , only : pi => SHR_CONST_PI
#else
use shr_const_mod , only : rearth => SHR_CONST_REARTH
use shr_const_mod , only : pi => SHR_CONST_PI
#endif
implicit none
private
!--------------------------------------------------------------------------
! Public routines
!--------------------------------------------------------------------------
public :: med_phases_aofluxes_init_fldbuns
public :: med_phases_aofluxes_run
public :: med_aofluxes_map_ogrid2agrid_output
public :: med_aofluxes_map_xgrid2agrid_output
public :: med_aofluxes_map_xgrid2ogrid_output
public :: med_aofluxes_map_agrid2ogrid_output
!--------------------------------------------------------------------------
! Private routines
!--------------------------------------------------------------------------
private :: med_aofluxes_init
private :: med_aofluxes_init_ogrid
private :: med_aofluxes_init_agrid
private :: med_aofluxes_init_xgrid
private :: med_aofluxes_map_ogrid2xgrid_input
private :: med_aofluxes_map_agrid2xgrid_input
private :: med_aofluxes_map_ogrid2agrid_input
private :: med_aofluxes_update
private :: set_aoflux_in_pointers
private :: set_aoflux_out_pointers
private :: fldbun_getfldptr
!--------------------------------------------------------------------------
! Private data
!--------------------------------------------------------------------------
logical :: flds_wiso ! use case
logical :: compute_atm_dens
logical :: compute_atm_thbot
integer :: ocn_surface_flux_scheme ! use case
logical :: add_gusts
character(len=CS), pointer :: fldnames_ocn_in(:)
character(len=CS), pointer :: fldnames_atm_in(:)
character(len=CS), pointer :: fldnames_aof_out(:)
! following is needed for atm/ocn fluxes on atm grid
type(ESMF_FieldBundle) :: FBocn_a ! ocean fields need for aoflux calc on atm grid
! following is needed for atm/ocn fluxes on the exchange grid
type(ESMF_FieldBundle) :: FBocn_x ! input ocn fields
type(ESMF_FieldBundle) :: FBatm_x ! input atm fields
type(ESMF_FieldBundle) :: FBaof_x ! output aoflux fields
type(ESMF_RouteHandle) :: rh_ogrid2xgrid ! ocn->xgrid mapping
type(ESMF_RouteHandle) :: rh_agrid2xgrid ! atm->xgrid mapping
type(ESMF_RouteHandle) :: rh_xgrid2ogrid ! xgrid->ocn mapping
type(ESMF_RouteHandle) :: rh_xgrid2agrid ! xgrid->atm mapping
type(ESMF_RouteHandle) :: rh_agrid2xgrid_2ndord ! atm->xgrid mapping 2nd order conservative
type(ESMF_RouteHandle) :: rh_agrid2xgrid_bilinr ! atm->xgrid mapping bilinear
type(ESMF_RouteHandle) :: rh_agrid2xgrid_patch ! atm->xgrid mapping patch
type(ESMF_XGrid) :: xgrid
type(ESMF_Field) :: field_o
type(ESMF_Field) :: field_x
type aoflux_in_type
! input: ocn
real(R8) , pointer :: uocn (:) => null() ! ocn velocity, zonal
real(R8) , pointer :: vocn (:) => null() ! ocn velocity, meridional
real(R8) , pointer :: tocn (:) => null() ! ocean temperature
real(R8) , pointer :: roce_16O (:) => null() ! ocn H2O ratio
real(R8) , pointer :: roce_HDO (:) => null() ! ocn HDO ratio
real(R8) , pointer :: roce_18O (:) => null() ! ocn H218O ratio
! input: atm
real(R8) , pointer :: zbot (:) => null() ! atm level height
real(R8) , pointer :: ubot (:) => null() ! atm velocity, zonal
real(R8) , pointer :: vbot (:) => null() ! atm velocity, meridional
real(R8) , pointer :: usfc (:) => null() ! atm surface velocity, zonal
real(R8) , pointer :: vsfc (:) => null() ! atm surface velocity, meridional
real(R8) , pointer :: thbot (:) => null() ! atm potential T
real(R8) , pointer :: shum (:) => null() ! atm specific humidity
real(R8) , pointer :: pbot (:) => null() ! atm bottom pressure
real(R8) , pointer :: psfc (:) => null() ! atm surface pressure
real(R8) , pointer :: dens (:) => null() ! atm bottom density
real(R8) , pointer :: tbot (:) => null() ! atm bottom surface T
real(R8) , pointer :: shum_16O (:) => null() ! atm H2O tracer
real(R8) , pointer :: shum_HDO (:) => null() ! atm HDO tracer
real(R8) , pointer :: shum_18O (:) => null() ! atm H218O tracer
real(R8) , pointer :: lwdn (:) => null() ! atm downward longwave heat flux
real(R8) , pointer :: rainc (:) => null() ! convective rain flux
! local size and computational mask and area: on aoflux grid
integer :: lsize ! local size
integer , pointer :: mask (:) => null() ! integer ocn domain mask: 0 <=> inactive cell
real(R8) , pointer :: rmask (:) => null() ! real ocn domain mask: 0 <=> inactive cell
real(R8) , pointer :: garea (:) => null() ! atm grid area
end type aoflux_in_type
type aoflux_out_type
real(R8) , pointer :: sen (:) => null() ! heat flux: sensible
real(R8) , pointer :: lat (:) => null() ! heat flux: latent
real(R8) , pointer :: lwup (:) => null() ! lwup over ocean
real(R8) , pointer :: evap (:) => null() ! water flux: evaporation
real(R8) , pointer :: evap_16O (:) => null() ! H2O flux: evaporation
real(R8) , pointer :: evap_HDO (:) => null() ! HDO flux: evaporation
real(R8) , pointer :: evap_18O (:) => null() ! H218O flux: evaporation
real(R8) , pointer :: taux (:) => null() ! wind stress, zonal
real(R8) , pointer :: tauy (:) => null() ! wind stress, meridional
real(R8) , pointer :: tref (:) => null() ! diagnostic: 2m ref T
real(R8) , pointer :: qref (:) => null() ! diagnostic: 2m ref Q
real(R8) , pointer :: u10 (:) => null() ! diagnostic: 10m wind speed
real(R8) , pointer :: duu10n (:) => null() ! diagnostic: 10m wind speed squared
real(R8) , pointer :: ugust_out (:) => null() ! diagnostic: gust wind added
real(R8) , pointer :: u10_withGust(:) => null() ! diagnostic: gust wind added
real(R8) , pointer :: u10res (:) => null() ! diagnostic: no gust wind added
real(R8) , pointer :: ustar (:) => null() ! saved ustar
real(R8) , pointer :: re (:) => null() ! saved re
real(R8) , pointer :: ssq (:) => null() ! saved sq
end type aoflux_out_type
character(*), parameter :: u_FILE_u = &
__FILE__
!================================================================================
contains
!================================================================================
subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc)
use ESMF , only : ESMF_FieldBundleIsCreated
use esmFlds , only : med_fldList_GetNumFlds
use esmFlds , only : med_fldList_GetFldNames
use esmFlds , only : med_fldList_GetaofluxfldList
use esmFlds , only : med_fldList_type
use med_methods_mod , only : FB_init => med_methods_FB_init
use med_internalstate_mod, only : compname
! input/output variables
type(ESMF_GridComp) :: gcomp
integer, intent(out) :: rc
! local variables
integer :: n
integer :: fieldcount
type(med_fldList_type), pointer :: fldListMed_aoflux
type(InternalState) :: is_local
character(len=*),parameter :: subname=' (med_phases_aofluxes_init_fldbuns) '
!---------------------------------------
! Create field bundles for mediator ocean/atmosphere flux computation
! This is needed regardless of the grid on which the atm/ocn flux computation is done on
fldListMed_aoflux => med_fldList_GetaofluxFldList()
! Get the internal state from the mediator Component.
nullify(is_local%wrap)
call ESMF_GridCompGetInternalState(gcomp, is_local, rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! Set module variable fldnames_aof_out
fieldCount = med_fldList_GetNumFlds(fldListMed_aoflux)
allocate(fldnames_aof_out(fieldCount))
call med_fldList_getfldnames(fldListMed_aoflux%fields, fldnames_aof_out, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
! Initialize FBMed_aoflux_a
call FB_init(is_local%wrap%FBMed_aoflux_a, is_local%wrap%flds_scalar_name, &
STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames_aof_out, name='FBMed_aoflux_a', rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (maintask) then
write(logunit,*)
write(logunit,'(a)') trim(subname)//' initialized FB FBMed_aoflux_a'
end if
! Initialize FBMed_aoflux_o
call FB_init(is_local%wrap%FBMed_aoflux_o, is_local%wrap%flds_scalar_name, &
STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames_aof_out, name='FBMed_aoflux_o', rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (maintask) then
write(logunit,'(a)') trim(subname)//' initialized FB FBMed_aoflux_o'
write(logunit,'(a)') trim(subname)//' following are the fields in FBMed_aoflux_o and FBMed_aoflux_a'
do n = 1,fieldcount
write(logunit,'(a)')' FBmed_aoflux fieldname = '//trim(fldnames_aof_out(n))
end do
end if
! Create required field bundles
if (is_local%wrap%aoflux_grid == 'ogrid' .or. is_local%wrap%aoflux_grid == 'agrid') then
! Create the field bundle is_local%wrap%FBImp(compatm,compocn) if needed
if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compatm,compocn), rc=rc)) then
if (maintask) then
write(logunit,'(a)') trim(subname)//' creating field bundle FBImp(compatm,compocn)'
end if
call FB_init(is_local%wrap%FBImp(compatm,compocn), is_local%wrap%flds_scalar_name, &
STgeom=is_local%wrap%NStateImp(compocn), STflds=is_local%wrap%NStateImp(compatm), &
name='FBImp'//trim(compname(compatm))//'_'//trim(compname(compocn)), rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if
if (maintask) then
write(logunit,'(a)') trim(subname)//' initializing FB for '// &
trim(compname(compatm))//'_'//trim(compname(compocn))
end if
! Create the field bundle is_local%wrap%FBImp(compocn,compatm) if needed
if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compatm), rc=rc)) then
if (maintask) then
write(logunit,'(a)') trim(subname)//' creating field bundle FBImp(compocn,compatm)'
end if
call FB_init(is_local%wrap%FBImp(compocn,compatm), is_local%wrap%flds_scalar_name, &
STgeom=is_local%wrap%NStateImp(compatm), STflds=is_local%wrap%NStateImp(compocn), &
name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compatm)), rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if
if (maintask) then
write(logunit,'(a)') trim(subname)//' initializing FB for '// &
trim(compname(compocn))//'_'//trim(compname(compatm))
end if
end if
end subroutine med_phases_aofluxes_init_fldbuns
!================================================================================
subroutine med_phases_aofluxes_run(gcomp, rc)
!-----------------------------------------------------------------------
! Compute atm/ocn fluxes
!-----------------------------------------------------------------------
use NUOPC , only : NUOPC_CompAttributeGet
use ESMF , only : ESMF_FieldBundleIsCreated
use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose
use med_phases_history_mod, only : med_phases_history_write_med
! input/output variables
type(ESMF_GridComp) :: gcomp
integer, intent(out) :: rc
! local variables
type(InternalState) :: is_local
type(aoflux_in_type) , save :: aoflux_in
type(aoflux_out_type) , save :: aoflux_out
logical , save :: aoflux_created
logical , save :: first_call = .true.
character(len=*),parameter :: subname=' (med_phases_aofluxes_run) '
!---------------------------------------
rc = ESMF_SUCCESS
! Get the internal state from the mediator Component.
nullify(is_local%wrap)
call ESMF_GridCompGetInternalState(gcomp, is_local, rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
if (first_call) then
! If field bundles have been created for the ocean/atmosphere flux computation
if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. &
ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then
! Allocate memroy for the aoflux module data type (mediator atm/ocn field bundle on the ocean grid)
call med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
aoflux_created = .true.
else
aoflux_created = .false.
end if
! Now set first_call to .false.
first_call = .false.
end if
! Return if there is no aoflux has not been created
if ( aoflux_created) then
! Start time timer
call t_startf('MED:'//subname)
if (dbug_flag > 5) then
call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO)
endif
call memcheck(subname, 5, maintask)
! Calculate atm/ocn fluxes on the destination grid
call med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! Write mediator aofluxes
call med_phases_history_write_med(gcomp, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (dbug_flag > 1) then
call FB_diagnose(is_local%wrap%FBMed_aoflux_o, &
string=trim(subname) //' FBAMed_aoflux_o' , rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
end if
call t_stopf('MED:'//subname)
end if
end subroutine med_phases_aofluxes_run
!================================================================================
subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc)
use NUOPC , only : NUOPC_CompAttributeGet
use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError
use ESMF , only : ESMF_SUCCESS, ESMF_LOGERR_PASSTHRU
use ESMF , only : ESMF_GridComp, ESMF_GridCompGet
use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldBundle
use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk
#ifdef CESMCOUPLED
use shr_flux_mod , only : shr_flux_adjust_constants
#else
use flux_atmocn_mod , only : flux_adjust_constants
#endif
!-----------------------------------------------------------------------
! Initialize pointers to the module variables
!-----------------------------------------------------------------------
! input/output variables
type(ESMF_GridComp) , intent(inout) :: gcomp
type(aoflux_in_type) , intent(inout) :: aoflux_in
type(aoflux_out_type) , intent(inout) :: aoflux_out
integer , intent(out) :: rc
! local variables
type(InternalState) :: is_local
character(CL) :: cvalue
real(R8) :: flux_convergence ! convergence criteria for implicit flux computation
integer :: flux_max_iteration ! maximum number of iterations for convergence
logical :: coldair_outbreak_mod ! cold air outbreak adjustment (Mahrt & Sun 1995,MWR)
logical :: isPresent, isSet
character(*),parameter :: subName = '(med_aofluxes_init) '
!-----------------------------------------------------------------------
if (dbug_flag > 5) then
call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO)
endif
rc = ESMF_SUCCESS
call memcheck(subname, 5, maintask)
call t_startf('MED:'//subname)
! Get the internal state from the mediator Component.
nullify(is_local%wrap)
call ESMF_GridCompGetInternalState(gcomp, is_local, rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
!----------------------------------
! Initialize module variables
!----------------------------------
call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(cvalue,*) flds_wiso
else
flds_wiso = .false.
end if
call NUOPC_CompAttributeGet(gcomp, name='ocn_surface_flux_scheme', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(cvalue,*) ocn_surface_flux_scheme
else
ocn_surface_flux_scheme = 0
end if
#ifdef CESMCOUPLED
if (maintask) then
write(logunit,*)
write(logunit,'(a)') trim(subname)//' ocn_surface_flux_scheme is '//trim(cvalue)
end if
#endif
call NUOPC_CompAttributeGet(gcomp, name='add_gusts', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(cvalue,*) add_gusts
else
add_gusts = .false.
end if
! bottom level potential temperature and/or botom level density
! will need to be computed if not received from the atm
if (FB_fldchk(is_local%Wrap%FBImp(Compatm,Compatm), 'Sa_ptem', rc=rc)) then
compute_atm_thbot = .false.
else
compute_atm_thbot = .true.
end if
if (FB_fldchk(is_local%Wrap%FBImp(Compatm,Compatm), 'Sa_dens', rc=rc)) then
compute_atm_dens = .false.
else
compute_atm_dens = .true.
end if
!----------------------------------
! Initialize aoflux
!----------------------------------
if (is_local%wrap%aoflux_grid == 'ogrid') then ! aoflux_grid is ocn
call med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
else if (is_local%wrap%aoflux_grid == 'agrid') then ! aoflux_grid is atm
call med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
else if (is_local%wrap%aoflux_grid == 'xgrid') then ! aoflux_grid is exchange grid
call med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
end if
!----------------------------------
! Initialize flux_adjust_constants
!----------------------------------
call NUOPC_CompAttributeGet(gcomp, name='coldair_outbreak_mod', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(cvalue,*) coldair_outbreak_mod
else
coldair_outbreak_mod = .false.
end if
call NUOPC_CompAttributeGet(gcomp, name='flux_max_iteration', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(cvalue,*) flux_max_iteration
else
flux_max_iteration = 1
end if
call NUOPC_CompAttributeGet(gcomp, name='flux_convergence', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(cvalue,*) flux_convergence
else
flux_convergence = 0.0_r8
end if
#ifdef CESMCOUPLED
call shr_flux_adjust_constants(&
flux_convergence_tolerance=flux_convergence, &
flux_convergence_max_iteration=flux_max_iteration, &
coldair_outbreak_mod=coldair_outbreak_mod)
#else
call flux_adjust_constants(&
flux_convergence_tolerance=flux_convergence, &
flux_convergence_max_iteration=flux_max_iteration, &
coldair_outbreak_mod=coldair_outbreak_mod)
#endif
if (dbug_flag > 5) then
call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO)
endif
call t_stopf('MED:'//subname)
end subroutine med_aofluxes_init
!===============================================================================
subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc)
! --------------------------------------------
! Initialize aoflux data type and compute mask
! for computations on ocn grid
! --------------------------------------------
use ESMF , only : ESMF_FieldBundleIsCreated
use esmFlds , only : med_fldlist_GetaofluxfldList
use esmFlds , only : med_fldList_type
use med_map_mod , only : med_map_packed_field_create
use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk
! Arguments
type(ESMF_GridComp) , intent(inout) :: gcomp
type(aoflux_in_type) , intent(inout) :: aoflux_in
type(aoflux_out_type) , intent(inout) :: aoflux_out
integer , intent(out) :: rc
!
! Local variables
type(med_fldList_type), pointer :: FldListMed_aoflux
type(InternalState) :: is_local
character(len=CX) :: tmpstr
integer :: lsize
type(ESMF_Field) :: lfield
type(ESMF_Mesh) :: lmesh
real(R8), pointer :: garea(:) => null()
type(ESMF_CoordSys_Flag) :: coordSys
character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) '
!-----------------------------------------------------------------------
rc = ESMF_SUCCESS
FldListMed_aoflux => med_fldlist_GetaofluxFldList()
! Get the internal state from the mediator Component.
nullify(is_local%wrap)
call ESMF_GridCompGetInternalState(gcomp, is_local, rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! ------------------------
! input fields from atm and ocn on aofluxgrid
! ------------------------
call set_aoflux_in_pointers(is_local%wrap%FBImp(compatm,compocn), is_local%wrap%FBImp(compocn,compocn), &
aoflux_in, lsize, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! ------------------------
! output fields from aoflux calculation
! ------------------------
call set_aoflux_out_pointers(is_local%wrap%FBMed_aoflux_o, lsize, aoflux_out, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! ------------------------
! set aoflux computational mask on ocn grid
! ------------------------
! default compute everywhere, then "turn off" gridcells
allocate(aoflux_in%mask(lsize))
aoflux_in%mask(:) = 1
write(tmpstr,'(i12,g22.12,i12)') lsize,sum(aoflux_in%rmask),sum(aoflux_in%mask)
call ESMF_LogWrite(trim(subname)//" : maskA= "//trim(tmpstr), ESMF_LOGMSG_INFO)
where (aoflux_in%rmask(:) == 0._R8) aoflux_in%mask(:) = 0 ! like nint
write(tmpstr,'(i12,g22.12,i12)') lsize,sum(aoflux_in%rmask),sum(aoflux_in%mask)
call ESMF_LogWrite(trim(subname)//" : maskB= "//trim(tmpstr), ESMF_LOGMSG_INFO)
! ------------------------
! setup grid area
! ------------------------
call ESMF_FieldBundleGet(is_local%wrap%FBArea(compocn), 'area', field=lfield, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
allocate(aoflux_in%garea(lsize))
call ESMF_FieldGet(lfield, farrayPtr=garea, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
is_local%wrap%aoflux_mesh = ESMF_MeshCreate(lmesh, rc=rc)
call ESMF_MeshGet(lmesh, coordSys=coordSys, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
if (coordSys /= ESMF_COORDSYS_CART) then
! Convert square radians to square meters
aoflux_in%garea(:) = garea(:)*(rearth**2)
else
aoflux_in%garea(:) = garea(:)
end if
! ------------------------
! create packed mapping from ocn->atm if aoflux_grid is ocn
! ------------------------
if (is_local%wrap%aoflux_grid == 'ogrid') then
if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o) .and. &
ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a)) then
call med_map_packed_field_create(destcomp=compatm, &
flds_scalar_name=is_local%wrap%flds_scalar_name, &
fieldsSrc=fldListMed_aoflux, &
FBSrc=is_local%wrap%FBMed_aoflux_o, &
FBDst=is_local%wrap%FBMed_aoflux_a, &
packed_data=is_local%wrap%packed_data_aoflux_o2a(:), rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if
end if
end subroutine med_aofluxes_init_ogrid
!===============================================================================
subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc)
! --------------------------------------------
! Initialize aoflux data type and compute mask for computations on atm grid
! - all aoflux fields are on the atm mesh
! - input atm aoflux attributes are just pointers into is_local%wrap%FBImp(compatm,compatm)
! - input ocn aoflux attributes are just pointers into is_local%wrap%FBImp(compocn,compatm)
! - output aoflux attributes are on the atm mesh
! --------------------------------------------
use med_methods_mod, only : FB_init => med_methods_FB_init
use med_map_mod , only : med_map_rh_is_created, med_map_field
! Arguments
type(ESMF_GridComp) , intent(inout) :: gcomp
type(aoflux_in_type) , intent(inout) :: aoflux_in
type(aoflux_out_type) , intent(inout) :: aoflux_out
integer , intent(out) :: rc
!
! Local variables
type(InternalState) :: is_local
integer :: lsize,n
type(ESMF_Field) :: field_src
type(ESMF_Field) :: field_dst
real(r8), pointer :: dataptr1d(:)
type(ESMF_Mesh) :: mesh_src
type(ESMF_Mesh) :: mesh_dst
integer :: maptype
type(ESMF_Field) :: lfield
type(ESMF_Mesh) :: lmesh
real(R8), pointer :: garea(:) => null()
type(ESMF_CoordSys_Flag) :: coordSys
character(len=*),parameter :: subname=' (med_aofluxes_init_atmgrid) '
!-----------------------------------------------------------------------
rc = ESMF_SUCCESS
nullify(is_local%wrap)
call ESMF_GridCompGetInternalState(gcomp, is_local, rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! ------------------------
! input fields from atm and ocn on atm grid
! ------------------------
if (flds_wiso) then
allocate(fldnames_ocn_in(5))
fldnames_ocn_in = (/'So_omask ','So_t ','So_u ','So_v ','So_roce_wiso' /)
else
allocate(fldnames_ocn_in(4))
fldnames_ocn_in = (/'So_omask','So_t ','So_u ','So_v '/)
end if
call FB_init(FBocn_a, is_local%wrap%flds_scalar_name, &
FBgeom=is_local%wrap%FBImp(compatm,compatm), fieldnamelist=fldnames_ocn_in, name='FBocn_a', rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call set_aoflux_in_pointers(is_local%wrap%FBImp(compatm,compatm), FBocn_a, aoflux_in, lsize, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! ------------------------
! output fields from aoflux calculation on atm grid
! ------------------------
call set_aoflux_out_pointers(is_local%wrap%FBMed_aoflux_a, lsize, aoflux_out, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! ------------------------
! Determine maptype for ocn->atm mapping
! ------------------------
if (med_map_RH_is_created(is_local%wrap%RH(compocn,compatm,:), mapfcopy, rc=rc)) then
maptype = mapfcopy
else if (med_map_RH_is_created(is_local%wrap%RH(compocn,compatm,:), mapconsd, rc=rc)) then
maptype = mapconsd
else
call ESMF_LogWrite(trim(subname)//&
": maptype for atm->ocn mapping of So_mask must be either mapfcopy or mapconsd", &
ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u)
rc = ESMF_FAILURE
return
end if
! ------------------------
! set aoflux computational mask on atm grid
! ------------------------
! Compute mask is the ocean mask mapped to atm grid (conservatively without fractions)
! This computes So_omask in FBocn_a - but the assumption is that it already is there
! Compute mask is the ocean mask mapped to atm grid (conservatively without fractions)
! This computes So_omask in FBocn_a - but the assumption is that it already is there
call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), 'So_omask', field=field_src, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldBundleGet(FBocn_a, 'So_omask', field=field_dst, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call med_map_field( field_src=field_src, field_dst=field_dst, &
routehandles=is_local%wrap%RH(compocn,compatm,:), maptype=maptype, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldGet(field_dst, farrayptr=dataptr1d, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
allocate(aoflux_in%mask(lsize))
do n = 1,lsize
if (dataptr1d(n) == 0._r8) then
aoflux_in%mask(n) = 0
else
aoflux_in%mask(n) = 1
end if
enddo
! ------------------------
! setup grid area
! ------------------------
call ESMF_FieldBundleGet(is_local%wrap%FBArea(compatm), 'area', field=lfield, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
allocate(aoflux_in%garea(lsize))
call ESMF_FieldGet(lfield, farrayPtr=garea, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
is_local%wrap%aoflux_mesh = ESMF_MeshCreate(lmesh, rc=rc)
call ESMF_MeshGet(lmesh, coordSys=coordSys, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
if (coordSys /= ESMF_COORDSYS_CART) then
! Convert square radians to square meters
aoflux_in%garea(:) = garea(:)*(rearth**2)
else
aoflux_in%garea(:) = garea(:)
end if
! ------------------------
! set one normalization for ocn-atm mapping if needed
! ------------------------
if (.not. ESMF_FieldIsCreated(is_local%wrap%field_NormOne(compocn,compatm,maptype))) then
! Get source mesh
call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), 'So_omask', field=field_src, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldGet(field_src, mesh=mesh_src, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
field_src = ESMF_FieldCreate(mesh_src, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldGet(field_src, farrayptr=dataPtr1d, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
dataptr1d(:) = 1.0_R8
! Create field is_local%wrap%field_NormOne(compocn,compatm,maptype) and fill in its values
call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compatm), 'So_omask', field=field_dst, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldGet(field_dst, mesh=mesh_dst, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
is_local%wrap%field_NormOne(compocn,compatm,maptype) = ESMF_FieldCreate(mesh_dst, &
ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc)
call med_map_field( field_src=field_src, field_dst=is_local%wrap%field_NormOne(compocn,compatm,maptype), &
routehandles=is_local%wrap%RH(compocn,compatm,:), maptype=maptype, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldDestroy(field_src, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
end if
end subroutine med_aofluxes_init_agrid
!===============================================================================
subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc)
! --------------------------------------------
! Initialize aoflux data type and compute mask
! for computations on exchange grid
! --------------------------------------------
! Arguments
type(ESMF_GridComp) , intent(inout) :: gcomp
type(aoflux_in_type) , intent(inout) :: aoflux_in
type(aoflux_out_type) , intent(inout) :: aoflux_out
integer , intent(out) :: rc
! Local variables
integer :: lsize
type(InternalState) :: is_local
type(ESMF_Field) :: field_a
type(ESMF_Field) :: field_o
type(ESMF_Field) :: lfield
type(ESMF_Mesh) :: lmesh
type(ESMF_Mesh) :: ocn_mesh
type(ESMF_Mesh) :: atm_mesh
type(ESMF_Mesh) :: xch_mesh
real(r8), pointer :: dataptr(:)
integer :: fieldcount
integer :: stp ! srcTermProcessing is declared inout and must have variable not constant
type(ESMF_CoordSys_Flag) :: coordSys
real(ESMF_KIND_R8) ,allocatable :: garea(:)
character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) '
!-----------------------------------------------------------------------
rc = ESMF_SUCCESS
! Get the internal state from the mediator Component.
nullify(is_local%wrap)
call ESMF_GridCompGetInternalState(gcomp, is_local, rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! ------------------------
! create the aoflux exchange grid
! ------------------------
! determine atm mesh
call ESMF_FieldBundleGet(is_local%wrap%FBImp(compatm,compatm), fieldname='Sa_z', field=lfield, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldGet(lfield, mesh=atm_mesh, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! determine ocn mesh
call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), fieldname='So_t', field=lfield, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldGet(lfield, mesh=ocn_mesh, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! create exchange grid - assume that atm mask is always 1
xgrid = ESMF_XGridCreate(sideBMesh=(/ocn_mesh/), sideAMesh=(/atm_mesh/), sideBMaskValues=(/0/), &
storeOverlay=.true., rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! write meshes for debug purpose
if (dbug_flag > 20) then
call ESMF_MeshWrite(atm_mesh, filename="atm_mesh", rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_MeshWrite(ocn_mesh, filename="ocn_mesh", rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_XGridGet(xgrid, mesh=xch_mesh, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_MeshWrite(xch_mesh, filename="xch_mesh", rc=rc)
end if
! create module field on exchange grid and set its initial value to 1
field_x = ESMF_FieldCreate(xgrid, typekind=ESMF_TYPEKIND_R8, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldGet(field_x, farrayptr=dataptr, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
dataptr(:) = 1.0_r8
! ------------------------
! input fields from atm and ocn on xgrid
! ------------------------
! Create FBatm_x and FBocn_x (module variables)
FBatm_x = ESMF_FieldBundleCreate(rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
FBocn_x = ESMF_FieldBundleCreate(rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call set_aoflux_in_pointers(FBatm_x, FBocn_x, aoflux_in, lsize, xgrid=xgrid, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldBundleGet(FBatm_x, fieldCount=fieldCount, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
allocate(fldnames_atm_in(fieldcount))
call ESMF_FieldBundleGet(FBatm_x, fieldnamelist=fldnames_atm_in, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldBundleGet(FBocn_x, fieldCount=fieldCount, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
allocate(fldnames_ocn_in(fieldcount))
call ESMF_FieldBundleGet(FBocn_x, fieldnamelist=fldnames_ocn_in, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
! ------------------------
! output fields from aoflux calculation on exchange grid
! ------------------------
FBaof_x = ESMF_FieldBundleCreate(rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call set_aoflux_out_pointers(FBaof_x, lsize, aoflux_out, xgrid=xgrid, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! ------------------------
! create the routehandles atm->xgrid and xgrid->atm
! ------------------------
! create temporary field
field_a = ESMF_FieldCreate(atm_mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldGet(field_a, farrayptr=dataptr, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
dataptr(:) = 1.0_r8
! create agrid->xgrid route handles
call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid_2ndord, &
regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
if (trim(coupling_mode) == 'cesm') then
stp = 1
call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_bilinr, &
regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_patch, &
regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
end if
! create xgrid->zgrid route handle
call ESMF_FieldRegridStore(xgrid, field_x, field_a, routehandle=rh_xgrid2agrid, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! destroy temporary field
call ESMF_FieldDestroy(field_a, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! ------------------------
! create the routehandles ocn->xgrid and xgrid->ocn
! ------------------------
! TODO: the second order conservative route handle below error out in its creation
field_o = ESMF_FieldCreate(ocn_mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldGet(field_o, farrayptr=dataptr, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
dataptr(:) = 1.0_r8
call ESMF_FieldRegridStore(xgrid, field_o, field_x, routehandle=rh_ogrid2xgrid, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldRegridStore(xgrid, field_x, field_o, routehandle=rh_xgrid2ogrid, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! call ESMF_FieldRegridStore(xgrid, field_o, field_x, routehandle=rh_ogrid2xgrid_2ndord, &
! regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc)
! if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldDestroy(field_o, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
! ------------------------
! setup the compute mask - default compute everywhere for exchange grid
! ------------------------
allocate(aoflux_in%mask(lsize))
aoflux_in%mask(:) = 1
! ------------------------
! setup grid area
! ------------------------
allocate(garea(lsize))
allocate(aoflux_in%garea(lsize))
call ESMF_XGridGet(xgrid, mesh=lmesh, coordSys=coordSys, area=garea, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
is_local%wrap%aoflux_mesh = ESMF_MeshCreate(lmesh, rc=rc)
if (coordSys /= ESMF_COORDSYS_CART) then
! Convert square radians to square meters
aoflux_in%garea(:) = garea(:)*(rearth**2)
else
aoflux_in%garea(:) = garea(:)
end if
deallocate(garea)
end subroutine med_aofluxes_init_xgrid
!===============================================================================
subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc)
!-----------------------------------------------------------------------
! Determine atm/ocn fluxes eother on atm, ocn or exchange grid
! The module arrays are set via pointers to the mediator internal states
! in med_ocnatm_init and are used below.
! 1) Create input on aoflux grid
! 2) Update atmosphere/ocean surface fluxes
! 3) Map aoflux output to relevant atm/ocn grid(s)
!-----------------------------------------------------------------------
use ESMF , only : ESMF_GridComp
use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info, ESMF_SUCCESS
use med_map_mod , only : med_map_field_packed, med_map_rh_is_created
use med_map_mod , only : med_map_routehandles_init
use med_methods_mod, only : FB_fldchk => med_methods_FB_fldchk
use med_methods_mod, only : FB_diagnose => med_methods_FB_diagnose
#ifdef CESMCOUPLED
use shr_flux_mod , only : flux_atmocn
#else
use flux_atmocn_mod, only : flux_atmocn
#endif
#ifdef UFS_AOFLUX
use flux_atmocn_ccpp_mod, only : flux_atmocn_ccpp
#endif
! Arguments
type(ESMF_GridComp) :: gcomp
type(aoflux_in_type) , intent(inout) :: aoflux_in
type(aoflux_out_type) , intent(inout) :: aoflux_out
integer , intent(out) :: rc
!
! Local variables
type(InternalState) :: is_local
integer :: n ! indices
real(r8), parameter :: qmin = 1.0e-8_r8
real(r8), parameter :: p0 = 100000.0_r8 ! reference pressure in Pa
real(r8), parameter :: rcp = 0.286_r8 ! gas constant of air / specific heat capacity at a constant pressure
real(r8), parameter :: rdair = 287.058_r8 ! dry air gas constant in J/K/kg
integer :: maptype
type(ESMF_Field) :: field_src
type(ESMF_Field) :: field_dst
character(*),parameter :: subName = '(med_aofluxes_update) '
!-----------------------------------------------------------------------
rc = ESMF_SUCCESS
call t_startf('MED:'//subname)
nullify(is_local%wrap)
call ESMF_GridCompGetInternalState(gcomp, is_local, rc)