Skip to content

Commit 77e1c10

Browse files
jedwards4bjedwards4b
authored
Merge pull request #552 from DeniseWorthen/feature/addRHuv3dmapping
Add explicit RH creation for uv3d mapping
2 parents b807d19 + 80cdb4a commit 77e1c10

File tree

3 files changed

+138
-89
lines changed

3 files changed

+138
-89
lines changed

‎mediator/med_internalstate_mod.F90

+4-2
Original file line numberDiff line numberDiff line change
@@ -77,7 +77,8 @@ module med_internalstate_mod
7777
integer , public, parameter :: mapfillv_bilnr = 15 ! fill value followed by bilinear
7878
integer , public, parameter :: mapbilnr_nstod = 16 ! bilinear with nstod extrapolation
7979
integer , public, parameter :: mapconsf_aofrac = 17 ! conservative with aofrac normalization (ufs only)
80-
integer , public, parameter :: nmappers = 17
80+
integer , public, parameter :: mapconsf_uv3d = 18 ! conservative with uv3d mapping
81+
integer , public, parameter :: nmappers = 18
8182
character(len=*) , public, parameter :: mapnames(nmappers) = &
8283
(/'bilnr ',&
8384
'consf ',&
@@ -95,7 +96,8 @@ module med_internalstate_mod
9596
'glc2ocn_liq ',&
9697
'fillv_bilnr ',&
9798
'bilnr_nstod ',&
98-
'consf_aofrac'/)
99+
'consf_aofrac',&
100+
'consf_uv3d '/)
99101

100102
type, public :: packed_data_type
101103
integer, allocatable :: fldindex(:) ! size of number of packed fields

‎mediator/med_map_mod.F90

+133-86
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ module med_map_mod
1010
use med_utils_mod , only : chkerr => med_utils_ChkErr
1111
use perf_mod , only : t_startf, t_stopf
1212
use shr_log_mod , only : shr_log_error
13-
13+
1414
implicit none
1515
private
1616

@@ -299,7 +299,7 @@ end subroutine med_map_RouteHandles_initfrom_esmflds
299299
subroutine med_map_routehandles_initfrom_fieldbundle(n1, n2, FBsrc, FBdst, mapindex, RouteHandle, rc)
300300

301301
use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush
302-
use ESMF , only : ESMf_Field, ESMF_FieldBundle, ESMF_RouteHandle
302+
use ESMF , only : ESMF_Field, ESMF_FieldBundle, ESMF_RouteHandle
303303
use med_methods_mod , only : med_methods_FB_getFieldN
304304

305305
!---------------------------------------------
@@ -361,7 +361,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex,
361361
use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_uv3d, mapfcopy
362362
use med_internalstate_mod , only : mapunset, mapnames, nmappers
363363
use med_internalstate_mod , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd
364-
use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac
364+
use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac, mapconsf_uv3d
365365
use med_internalstate_mod , only : compocn, compwav, complnd, compname, compatm
366366
use med_internalstate_mod , only : coupling_mode
367367
use med_internalstate_mod , only : defaultMasks
@@ -467,121 +467,147 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex,
467467
ignoreUnmatchedIndices=.true., &
468468
srcTermProcessing=srcTermProcessing_Value, rc=rc)
469469
if (chkerr(rc,__LINE__,u_FILE_u)) return
470-
else if (mapindex == mapbilnr .or. mapindex == mapbilnr_uv3d) then
471-
if (.not. ESMF_RouteHandleIsCreated(routehandles(mapbilnr))) then
470+
else if (mapindex == mapbilnr ) then
472471
if (maintask) then
473472
write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string)
474473
end if
475474
call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapbilnr), &
476-
srcMaskValues=(/srcMaskValue/), &
477-
dstMaskValues=(/dstMaskValue/), &
478-
regridmethod=ESMF_REGRIDMETHOD_BILINEAR, &
479-
polemethod=polemethod, &
475+
srcMaskValues=(/srcMaskValue/), &
476+
dstMaskValues=(/dstMaskValue/), &
477+
regridmethod=ESMF_REGRIDMETHOD_BILINEAR, &
478+
polemethod=polemethod, &
480479
srcTermProcessing=srcTermProcessing_Value, &
481-
ignoreDegenerate=.true., &
482-
dstStatusField=lfield, &
480+
ignoreDegenerate=.true., &
481+
dstStatusField=lfield, &
483482
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc)
484483
if (chkerr(rc,__LINE__,u_FILE_u)) return
484+
else if (mapindex == mapbilnr_uv3d ) then
485+
if (maintask) then
486+
write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string)
485487
end if
488+
call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapbilnr_uv3d), &
489+
srcMaskValues=(/srcMaskValue/), &
490+
dstMaskValues=(/dstMaskValue/), &
491+
regridmethod=ESMF_REGRIDMETHOD_BILINEAR, &
492+
polemethod=polemethod, &
493+
srcTermProcessing=srcTermProcessing_Value, &
494+
ignoreDegenerate=.true., &
495+
dstStatusField=lfield, &
496+
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc)
497+
if (chkerr(rc,__LINE__,u_FILE_u)) return
486498
else if (mapindex == mapfillv_bilnr) then
487499
if (maintask) then
488500
write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string)
489501
end if
490502
call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapfillv_bilnr), &
491-
srcMaskValues=(/srcMaskValue/), &
492-
dstMaskValues=(/dstMaskValue/), &
493-
regridmethod=ESMF_REGRIDMETHOD_BILINEAR, &
494-
polemethod=polemethod, &
503+
srcMaskValues=(/srcMaskValue/), &
504+
dstMaskValues=(/dstMaskValue/), &
505+
regridmethod=ESMF_REGRIDMETHOD_BILINEAR, &
506+
polemethod=polemethod, &
495507
srcTermProcessing=srcTermProcessing_Value, &
496-
ignoreDegenerate=.true., &
497-
dstStatusField=lfield, &
508+
ignoreDegenerate=.true., &
509+
dstStatusField=lfield, &
498510
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc)
499511
if (chkerr(rc,__LINE__,u_FILE_u)) return
500512
else if (mapindex == mapbilnr_nstod) then
501513
if (maintask) then
502514
write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string)
503515
end if
504516
call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapbilnr_nstod), &
505-
srcMaskValues=(/srcMaskValue/), &
506-
dstMaskValues=(/dstMaskValue/), &
507-
regridmethod=ESMF_REGRIDMETHOD_BILINEAR, &
517+
srcMaskValues=(/srcMaskValue/), &
518+
dstMaskValues=(/dstMaskValue/), &
519+
regridmethod=ESMF_REGRIDMETHOD_BILINEAR, &
508520
extrapMethod=ESMF_EXTRAPMETHOD_NEAREST_STOD, &
509-
polemethod=polemethod, &
510-
srcTermProcessing=srcTermProcessing_Value, &
511-
ignoreDegenerate=.true., &
512-
dstStatusField=lfield, &
521+
polemethod=polemethod, &
522+
srcTermProcessing=srcTermProcessing_Value, &
523+
ignoreDegenerate=.true., &
524+
dstStatusField=lfield, &
513525
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc)
514526
if (chkerr(rc,__LINE__,u_FILE_u)) return
515527
else if (mapindex == mapconsf .or. mapindex == mapnstod_consf) then
516528
if (maintask) then
517529
write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string)
518530
end if
519531
call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf), &
520-
srcMaskValues=(/srcMaskValue/), &
521-
dstMaskValues=(/dstMaskValue/), &
522-
regridmethod=ESMF_REGRIDMETHOD_CONSERVE, &
523-
normType=ESMF_NORMTYPE_FRACAREA, &
532+
srcMaskValues=(/srcMaskValue/), &
533+
dstMaskValues=(/dstMaskValue/), &
534+
regridmethod=ESMF_REGRIDMETHOD_CONSERVE, &
535+
normType=ESMF_NORMTYPE_FRACAREA, &
524536
srcTermProcessing=srcTermProcessing_Value, &
525-
ignoreDegenerate=.true., &
526-
dstStatusField=lfield, &
527-
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, &
528-
rc=rc)
537+
ignoreDegenerate=.true., &
538+
dstStatusField=lfield, &
539+
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc)
529540
if (chkerr(rc,__LINE__,u_FILE_u)) return
530541
else if (mapindex == mapconsf_aofrac) then
531-
if (.not. ESMF_RouteHandleIsCreated(routehandles(mapconsf))) then
532-
if (maintask) then
533-
write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string)
534-
end if
535-
call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf_aofrac), &
536-
srcMaskValues=(/srcMaskValue/), &
537-
dstMaskValues=(/dstMaskValue/), &
538-
regridmethod=ESMF_REGRIDMETHOD_CONSERVE, &
539-
normType=ESMF_NORMTYPE_FRACAREA, &
540-
srcTermProcessing=srcTermProcessing_Value, &
541-
ignoreDegenerate=.true., &
542-
dstStatusField=lfield, &
543-
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, &
544-
rc=rc)
545-
if (chkerr(rc,__LINE__,u_FILE_u)) return
546-
else
547-
! Copy existing consf RH
548-
if (maintask) then
549-
write(logunit,'(A)') trim(subname)//' copying RH(mapconsf) to '//trim(mapname)//' for '//trim(string)
550-
end if
551-
routehandles(mapconsf_aofrac) = ESMF_RouteHandleCreate(routehandles(mapconsf), rc=rc)
552-
if (chkerr(rc,__LINE__,u_FILE_u)) return
542+
if (maintask) then
543+
write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string)
553544
end if
545+
call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf_aofrac), &
546+
srcMaskValues=(/srcMaskValue/), &
547+
dstMaskValues=(/dstMaskValue/), &
548+
regridmethod=ESMF_REGRIDMETHOD_CONSERVE, &
549+
normType=ESMF_NORMTYPE_FRACAREA, &
550+
srcTermProcessing=srcTermProcessing_Value, &
551+
ignoreDegenerate=.true., &
552+
dstStatusField=lfield, &
553+
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc)
554+
if (chkerr(rc,__LINE__,u_FILE_u)) return
555+
else if (mapindex == mapconsf_uv3d) then
556+
if (maintask) then
557+
write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string)
558+
end if
559+
call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf_uv3d), &
560+
srcMaskValues=(/srcMaskValue/), &
561+
dstMaskValues=(/dstMaskValue/), &
562+
regridmethod=ESMF_REGRIDMETHOD_CONSERVE, &
563+
normType=ESMF_NORMTYPE_FRACAREA, &
564+
srcTermProcessing=srcTermProcessing_Value, &
565+
ignoreDegenerate=.true., &
566+
dstStatusField=lfield, &
567+
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc)
568+
if (chkerr(rc,__LINE__,u_FILE_u)) return
554569
else if (mapindex == mapconsd .or. mapindex == mapnstod_consd) then
555570
if (maintask) then
556571
write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string)
557572
end if
558573
call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsd), &
559-
srcMaskValues=(/srcMaskValue/), &
560-
dstMaskValues=(/dstMaskValue/), &
561-
regridmethod=ESMF_REGRIDMETHOD_CONSERVE, &
562-
normType=ESMF_NORMTYPE_DSTAREA, &
574+
srcMaskValues=(/srcMaskValue/), &
575+
dstMaskValues=(/dstMaskValue/), &
576+
regridmethod=ESMF_REGRIDMETHOD_CONSERVE, &
577+
normType=ESMF_NORMTYPE_DSTAREA, &
563578
srcTermProcessing=srcTermProcessing_Value, &
564-
ignoreDegenerate=.true., &
565-
dstStatusField=lfield, &
566-
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, &
567-
rc=rc)
579+
ignoreDegenerate=.true., &
580+
dstStatusField=lfield, &
581+
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc)
568582
if (chkerr(rc,__LINE__,u_FILE_u)) return
569-
else if (mapindex == mappatch .or. mapindex == mappatch_uv3d) then
570-
if (.not. ESMF_RouteHandleIsCreated(routehandles(mappatch))) then
571-
if (maintask) then
572-
write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string)
573-
end if
574-
call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mappatch), &
575-
srcMaskValues=(/srcMaskValue/), &
576-
dstMaskValues=(/dstMaskValue/), &
577-
regridmethod=ESMF_REGRIDMETHOD_PATCH, &
578-
polemethod=polemethod, &
579-
srcTermProcessing=srcTermProcessing_Value, &
580-
ignoreDegenerate=.true., &
581-
dstStatusField=lfield, &
582-
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc)
583-
if (chkerr(rc,__LINE__,u_FILE_u)) return
583+
else if (mapindex == mappatch ) then
584+
if (maintask) then
585+
write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string)
584586
end if
587+
call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mappatch), &
588+
srcMaskValues=(/srcMaskValue/), &
589+
dstMaskValues=(/dstMaskValue/), &
590+
regridmethod=ESMF_REGRIDMETHOD_PATCH, &
591+
polemethod=polemethod, &
592+
srcTermProcessing=srcTermProcessing_Value, &
593+
ignoreDegenerate=.true., &
594+
dstStatusField=lfield, &
595+
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc)
596+
if (chkerr(rc,__LINE__,u_FILE_u)) return
597+
else if (mapindex == mappatch_uv3d ) then
598+
if (maintask) then
599+
write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string)
600+
end if
601+
call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mappatch_uv3d), &
602+
srcMaskValues=(/srcMaskValue/), &
603+
dstMaskValues=(/dstMaskValue/), &
604+
regridmethod=ESMF_REGRIDMETHOD_PATCH, &
605+
polemethod=polemethod, &
606+
srcTermProcessing=srcTermProcessing_Value, &
607+
ignoreDegenerate=.true., &
608+
dstStatusField=lfield, &
609+
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc)
610+
if (chkerr(rc,__LINE__,u_FILE_u)) return
585611
else
586612
call shr_log_error(trim(subname)//' mapindex '//trim(mapname)//' not supported for '//trim(string), &
587613
line=__LINE__, file=u_FILE_u, rc=rc)
@@ -922,7 +948,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_
922948
use ESMF , only : ESMF_KIND_R8
923949
use ESMF , only : ESMF_Region_Flag, ESMF_REGION_SELECT, ESMF_REGION_TOTAL
924950
use med_internalstate_mod , only : nmappers, mapfcopy
925-
use med_internalstate_mod , only : mappatch_uv3d, mappatch, mapbilnr_uv3d, mapbilnr
951+
use med_internalstate_mod , only : mappatch_uv3d, mappatch, mapbilnr_uv3d, mapconsf_uv3d, mapbilnr
926952
use med_internalstate_mod , only : packed_data_type
927953
use med_methods_mod , only : Field_diagnose => med_methods_Field_diagnose
928954

@@ -1005,15 +1031,18 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_
10051031
if (mapindex == mappatch_uv3d) then
10061032

10071033
! For mappatch_uv3d do not use packed field bundles
1008-
call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mappatch, rc=rc)
1034+
call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mappatch_uv3d, rc=rc)
10091035
if (chkerr(rc,__LINE__,u_FILE_u)) return
10101036

10111037
else if (mapindex == mapbilnr_uv3d) then
10121038

10131039
! For mapbilnr_uv3d do not use packed field bundles
1014-
call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapbilnr, rc=rc)
1040+
call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapbilnr_uv3d, rc=rc)
10151041
if (chkerr(rc,__LINE__,u_FILE_u)) return
10161042

1043+
! For mapconsf_uv3d do not use packed field bundles
1044+
call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapconsf_uv3d, map_stress=.true., rc=rc)
1045+
if (chkerr(rc,__LINE__,u_FILE_u)) return
10171046
else
10181047

10191048
! -----------------------------------
@@ -1454,7 +1483,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, z
14541483
end subroutine med_map_field
14551484

14561485
!================================================================================
1457-
subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc)
1486+
subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, map_stress, rc)
14581487

14591488
use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8
14601489
use ESMF , only : ESMF_Field, ESMF_FieldCreate, ESMF_FieldGet
@@ -1467,6 +1496,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc)
14671496
type(ESMF_FieldBundle) , intent(inout) :: FBdst
14681497
type(ESMF_RouteHandle) , intent(inout) :: routehandles(:)
14691498
integer , intent(in) :: mapindex
1499+
logical, optional , intent(in) :: map_stress
14701500
integer , intent(out) :: rc
14711501

14721502
! local variables
@@ -1493,22 +1523,39 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc)
14931523
integer :: spatialDim
14941524
real(r8), parameter :: deg2rad = shr_const_pi/180.0_R8 ! deg to rads
14951525
logical :: first_time = .true.
1526+
logical :: lmap_stress
1527+
character(len=CS) :: uname, vname
14961528
character(len=*), parameter :: subname=' (med_map_mod:med_map_uv_cart3d) '
14971529
!-------------------------------------------------------------------------------
14981530

14991531
rc = ESMF_SUCCESS
15001532

1533+
lmap_stress = .false.
1534+
if (present(map_stress)) then
1535+
lmap_stress = map_stress
1536+
end if
1537+
1538+
if (lmap_stress) then
1539+
! Get fields for atm zonal and merid stresses
1540+
uname = 'Faxa_taux'
1541+
vname = 'Faxa_tauy'
1542+
else
1543+
! Get fields for atm u,v velocities
1544+
uname = 'Sa_u'
1545+
vname = 'Sa_v'
1546+
end if
1547+
15011548
! Get fields for atm u,v velocities
1502-
call ESMF_FieldBundleGet(FBSrc, fieldName='Sa_u', field=usrc, rc=rc)
1549+
call ESMF_FieldBundleGet(FBSrc, fieldName=trim(uname), field=usrc, rc=rc)
15031550
if (chkerr(rc,__LINE__,u_FILE_u)) return
1504-
call ESMF_FieldBundleGet(FBDst, fieldName='Sa_u', field=udst, rc=rc)
1551+
call ESMF_FieldBundleGet(FBDst, fieldName=trim(uname), field=udst, rc=rc)
15051552
if (chkerr(rc,__LINE__,u_FILE_u)) return
1506-
call ESMF_FieldBundleGet(FBSrc, fieldName='Sa_v', field=vsrc, rc=rc)
1553+
call ESMF_FieldBundleGet(FBSrc, fieldName=trim(vname), field=vsrc, rc=rc)
15071554
if (chkerr(rc,__LINE__,u_FILE_u)) return
1508-
call ESMF_FieldBundleGet(FBDst, fieldName='Sa_v', field=vdst, rc=rc)
1555+
call ESMF_FieldBundleGet(FBDst, fieldName=trim(vname), field=vdst, rc=rc)
15091556
if (chkerr(rc,__LINE__,u_FILE_u)) return
15101557

1511-
! GET pointer to input u and v data source field data
1558+
! Get pointer to input u and v data source field data
15121559
call ESMF_FieldGet(usrc, farrayPtr=data_u_src, rc=rc)
15131560
if (chkerr(rc,__LINE__,u_FILE_u)) return
15141561
call ESMF_FieldGet(vsrc, farrayPtr=data_v_src, rc=rc)

‎mediator/med_phases_ocnalb_mod.F90

+1-1
Original file line numberDiff line numberDiff line change
@@ -519,7 +519,7 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, maintask, rc)
519519

520520
use ESMF , only : ESMF_GridComp, ESMF_GridCompGet
521521
use ESMF , only : ESMF_LogWrite, ESMF_LogFoundError, ESMF_LogSetError
522-
use ESMF , only : ESMf_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO, ESMF_RC_NOT_VALID
522+
use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO, ESMF_RC_NOT_VALID
523523
use NUOPC , only : NUOPC_CompAttributeGet
524524

525525
! input/output variables

0 commit comments

Comments
 (0)