From 30c5c5a4ee7f8ccdf321805fa18493ddef7bfb14 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Wed, 5 May 2021 00:17:23 -0500 Subject: [PATCH 1/7] initial work to bring ww3 --- mediator/esmFldsExchange_hafs_mod.F90 | 70 +++++++++++++++++++++++++++ mediator/med.F90 | 7 +++ mediator/med_methods_mod.F90 | 47 ++++++++++++++---- 3 files changed, 114 insertions(+), 10 deletions(-) diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 207bbc8d3..ec0b2d883 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -10,6 +10,7 @@ module esmFldsExchange_hafs_mod use esmflds, only : compmed use esmflds, only : compatm use esmflds, only : compocn + use esmflds, only : compwav use esmflds, only : compice use esmflds, only : ncomps use esmflds, only : fldListTo @@ -48,10 +49,14 @@ module esmFldsExchange_hafs_mod character(len=CX) :: atm2ocn_fmap='unset' character(len=CX) :: atm2ocn_smap='unset' character(len=CX) :: atm2ocn_vmap='unset' + character(len=CX) :: atm2wav_smap='unset' character(len=CX) :: ice2atm_fmap='unset' character(len=CX) :: ice2atm_smap='unset' + character(len=CX) :: ice2wav_smap='unset' character(len=CX) :: ocn2atm_fmap='unset' character(len=CX) :: ocn2atm_smap='unset' + character(len=CX) :: ocn2wav_smap='unset' + character(len=CX) :: wav2ocn_smap='unset' character(len=CS) :: mapnorm ='one' type(systemType) :: hafs_sysType=SYS_CDP end type @@ -412,6 +417,17 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) call addfld(fldListTo(compatm)%flds, trim(fldname)) end do deallocate(S_flds) + ! --------------------------------------------------------------------- + ! from atm to wav + ! --------------------------------------------------------------------- + allocate(S_flds(3)) + S_flds = (/'Sa_u ', 'Sa_v ', 'Sa_tbot'/) + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compwav)%flds, trim(fldname)) + end do + deallocate(S_flds) endif ! hafs_sysType call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -907,6 +923,24 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) end if end do deallocate(S_flds) + ! --------------------------------------------------------------------- + ! from atm to wav + ! --------------------------------------------------------------------- + ! state fields + allocate(S_flds(3)) + S_flds = (/'Sa_u ', 'Sa_v ', 'Sa_tbot'/) + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBexp(compwav),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname),rc=rc) & + ) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compwav, & + mapbilnr, 'one', hafs_attr%atm2wav_smap) + call addmrg(fldListTo(compwav)%flds, trim(fldname), & + mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) endif ! hafs_sysType call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -1074,6 +1108,42 @@ subroutine esmFldsExchange_hafs_attr(gcomp, hafs_attr, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! to wav + call NUOPC_CompAttributeGet(gcomp, name='atm2wav_smapname', & + isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='atm2wav_smapname', & + value=hafs_attr%atm2wav_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call NUOPC_CompAttributeGet(gcomp, name='ice2wav_smapname', & + isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='ice2wav_smapname', & + value=hafs_attr%ice2wav_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call NUOPC_CompAttributeGet(gcomp, name='ocn2wav_smapname', & + isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='ocn2wav_smapname', & + value=hafs_attr%ocn2wav_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! from wav + call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', & + isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', & + value=hafs_attr%wav2ocn_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + ! Log Attribute Settings if (btest(verbosity,16)) then write(cvalue,"(I0)") verbosity diff --git a/mediator/med.F90 b/mediator/med.F90 index 3dfd8031e..3ca56b8e5 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -2377,17 +2377,24 @@ subroutine DataInitialize(gcomp, rc) write(logunit,'(a)') trim(subname)//"Initialize-Data-Dependency allDone check Passed" end if do n1 = 1,ncomps + if (mastertask) then + write(logunit,*) + write(logunit,'(a)') trim(subname)//" "//trim(compname(n1)) + write(logunit,*) is_local%wrap%comp_present(n1), ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) + end if if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then call State_GetScalar(scalar_value=real_nx, & scalar_id=is_local%wrap%flds_scalar_index_nx, & state=is_local%wrap%NstateImp(n1), & flds_scalar_name=is_local%wrap%flds_scalar_name, & flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call State_GetScalar(scalar_value=real_ny, & scalar_id=is_local%wrap%flds_scalar_index_ny, & state=is_local%wrap%NstateImp(n1), & flds_scalar_name=is_local%wrap%flds_scalar_name, & flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return is_local%wrap%nx(n1) = nint(real_nx) is_local%wrap%ny(n1) = nint(real_ny) write(msgString,'(2i8,2l4)') is_local%wrap%nx(n1), is_local%wrap%ny(n1) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 9a88aba32..fc9e55e97 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2067,6 +2067,7 @@ subroutine med_methods_Grid_Print(grid, string, rc) use ESMF, only : ESMF_Grid, ESMF_DistGrid, ESMF_StaggerLoc use ESMF, only : ESMF_GridGet, ESMF_DistGridGet, ESMF_GridGetCoord use ESMF, only : ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER + use ESMF, only : ESMF_TypeKind_Flag, ESMF_TYPEKIND_R4, ESMF_TYPEKIND_R8 ! input/output variabes type(ESMF_Grid) , intent(in) :: grid @@ -2080,10 +2081,13 @@ subroutine med_methods_Grid_Print(grid, string, rc) integer :: dimCount, tileCount integer :: staggerlocCount, arbdimCount, rank type(ESMF_StaggerLoc) :: staggerloc + type(ESMF_TypeKind_Flag) :: coordTypeKind character(len=32) :: staggerstr integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) - real(R8), pointer :: fldptr1(:) => null() - real(R8), pointer :: fldptr2(:,:) => null() + real, pointer :: fldptrR41D(:) => null() + real, pointer :: fldptrR42D(:,:) => null() + real(R8), pointer :: fldptrR81D(:) => null() + real(R8), pointer :: fldptrR82D(:,:) => null() integer :: n1,n2,n3 character(len=*),parameter :: subname='(med_methods_Grid_Print)' ! ---------------------------------------------- @@ -2093,6 +2097,10 @@ subroutine med_methods_Grid_Print(grid, string, rc) endif rc = ESMF_SUCCESS + ! access grid coordinate type + call ESMF_GridGet(grid, coordTypeKind=coordTypeKind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! access localDeCount to show this is a real Grid call ESMF_GridGet(grid, localDeCount=localDeCount, distgrid=distgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -2150,16 +2158,35 @@ subroutine med_methods_Grid_Print(grid, string, rc) do n3 = 0,localDECount-1 do n2 = 1,dimCount if (rank == 1) then - call ESMF_GridGetCoord(grid,coordDim=n2,localDE=n3,staggerloc=staggerloc,farrayPtr=fldptr1,rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write (msgString,'(a,2i4,2f16.8)') trim(subname)//":"//trim(staggerstr)//" coord=",& - n2,n3,minval(fldptr1),maxval(fldptr1) + if (coordTypeKind == ESMF_TYPEKIND_R4) then + call ESMF_GridGetCoord(grid,coordDim=n2,localDE=n3,staggerloc=staggerloc,farrayPtr=fldptrR41D,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write (msgString,'(a,2i4,2f16.8)') trim(subname)//":"//trim(staggerstr)//" coord=",& + n2,n3,minval(fldptrR41D),maxval(fldptrR41D) + else if (coordTypeKind == ESMF_TYPEKIND_R8) then + call ESMF_GridGetCoord(grid,coordDim=n2,localDE=n3,staggerloc=staggerloc,farrayPtr=fldptrR81D,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write (msgString,'(a,2i4,2f16.8)') trim(subname)//":"//trim(staggerstr)//" coord=",& + n2,n3,minval(fldptrR81D),maxval(fldptrR81D) + else + write(msgString,*) trim(subname)//":"//" only R4 and R8 types are supported for grid coordinates (1D)!" + end if endif if (rank == 2) then - call ESMF_GridGetCoord(grid,coordDim=n2,localDE=n3,staggerloc=staggerloc,farrayPtr=fldptr2,rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write (msgString,'(a,2i4,2f16.8)') trim(subname)//":"//trim(staggerstr)//" coord=",& - n2,n3,minval(fldptr2),maxval(fldptr2) + if (coordTypeKind == ESMF_TYPEKIND_R4) then + call ESMF_GridGetCoord(grid,coordDim=n2,localDE=n3,staggerloc=staggerloc,farrayPtr=fldptrR42D,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write (msgString,'(a,2i4,2f16.8)') trim(subname)//":"//trim(staggerstr)//" coord=",& + n2,n3,minval(fldptrR42D),maxval(fldptrR42D) + else if (coordTypeKind == ESMF_TYPEKIND_R8) then + call ESMF_GridGetCoord(grid,coordDim=n2,localDE=n3,staggerloc=staggerloc,farrayPtr=fldptrR82D,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write (msgString,'(a,2i4,2f16.8)') trim(subname)//":"//trim(staggerstr)//" coord=",& + n2,n3,minval(fldptrR82D),maxval(fldptrR82D) + else + write(msgString,*) trim(subname)//":"//" only R4 and R8 types are supported for grid coordinates (2D)!" + end if + endif call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) enddo From 8a49daa6807667e3729a276f071f92787de66247 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Fri, 14 May 2021 17:15:15 -0500 Subject: [PATCH 2/7] more fix for HAFS wave coupling --- mediator/esmFldsExchange_hafs_mod.F90 | 49 ++++++++++++++++++++++++--- mediator/med.F90 | 8 +++-- mediator/med_map_mod.F90 | 42 +++++++++++++++-------- mediator/med_phases_post_wav_mod.F90 | 13 ++++++- 4 files changed, 89 insertions(+), 23 deletions(-) diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index ec0b2d883..95c63cc2e 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -57,6 +57,7 @@ module esmFldsExchange_hafs_mod character(len=CX) :: ocn2atm_smap='unset' character(len=CX) :: ocn2wav_smap='unset' character(len=CX) :: wav2ocn_smap='unset' + character(len=CX) :: wav2atm_smap='unset' character(len=CS) :: mapnorm ='one' type(systemType) :: hafs_sysType=SYS_CDP end type @@ -418,10 +419,22 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) end do deallocate(S_flds) ! --------------------------------------------------------------------- + ! from wav to atm + ! --------------------------------------------------------------------- + ! state fields + allocate(S_flds(1)) + S_flds = (/'Sw_zo'/) ! wave_z0_roughness_length + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld(fldListFr(compwav)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + end do + deallocate(S_flds) + ! --------------------------------------------------------------------- ! from atm to wav ! --------------------------------------------------------------------- - allocate(S_flds(3)) - S_flds = (/'Sa_u ', 'Sa_v ', 'Sa_tbot'/) + allocate(S_flds(2)) + S_flds = (/'Sa_u10m', 'Sa_v10m'/) do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld(fldListFr(compatm)%flds, trim(fldname)) @@ -906,6 +919,24 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) end do deallocate(F_flds) ! --------------------------------------------------------------------- + ! from wav to atm + ! --------------------------------------------------------------------- + ! state fields + allocate(S_flds(1)) + S_flds = (/'Sw_zo'/) ! wave_z0_roughness_length + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav,compwav),trim(fldname),rc=rc) & + ) then + call addmap(fldListFr(compwav)%flds, trim(fldname), compatm, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%wav2atm_smap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + ! --------------------------------------------------------------------- ! from ocn to atm ! --------------------------------------------------------------------- ! state fields @@ -927,15 +958,15 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) ! from atm to wav ! --------------------------------------------------------------------- ! state fields - allocate(S_flds(3)) - S_flds = (/'Sa_u ', 'Sa_v ', 'Sa_tbot'/) + allocate(S_flds(2)) + S_flds = (/'Sa_u10m', 'Sa_v10m'/) do n = 1,size(S_flds) fldname = trim(S_flds(n)) if (fldchk(is_local%wrap%FBexp(compwav),trim(fldname),rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname),rc=rc) & ) then call addmap(fldListFr(compatm)%flds, trim(fldname), compwav, & - mapbilnr, 'one', hafs_attr%atm2wav_smap) + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2wav_smap) call addmrg(fldListTo(compwav)%flds, trim(fldname), & mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if @@ -1135,6 +1166,14 @@ subroutine esmFldsExchange_hafs_attr(gcomp, hafs_attr, rc) end if ! from wav + call NUOPC_CompAttributeGet(gcomp, name='wav2atm_smapname', & + isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='wav2atm_smapname', & + value=hafs_attr%wav2atm_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', & isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med.F90 b/mediator/med.F90 index 3ca56b8e5..1c6312322 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1850,6 +1850,7 @@ subroutine DataInitialize(gcomp, rc) med_coupling_allowed(complnd,compatm) = .true. med_coupling_allowed(compice,compatm) = .true. med_coupling_allowed(compocn,compatm) = .true. + med_coupling_allowed(compwav,compatm) = .true. ! to land med_coupling_allowed(compatm,complnd) = .true. @@ -2138,11 +2139,15 @@ subroutine DataInitialize(gcomp, rc) ! Initialized packed field data structures !--------------------------------------- - call med_map_RouteHandles_init(gcomp, logunit, rc) + call ESMF_LogWrite("before med_map_RouteHandles_init", ESMF_LOGMSG_INFO) + call med_map_RouteHandles_init(gcomp, is_local%wrap%flds_scalar_name, logunit, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite("after med_map_RouteHandles_init", ESMF_LOGMSG_INFO) + call ESMF_LogWrite("before med_map_mapnorm_init", ESMF_LOGMSG_INFO) call med_map_mapnorm_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite("after med_map_mapnorm_init", ESMF_LOGMSG_INFO) do ndst = 1,ncomps do nsrc = 1,ncomps @@ -2380,7 +2385,6 @@ subroutine DataInitialize(gcomp, rc) if (mastertask) then write(logunit,*) write(logunit,'(a)') trim(subname)//" "//trim(compname(n1)) - write(logunit,*) is_local%wrap%comp_present(n1), ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) end if if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then call State_GetScalar(scalar_value=real_nx, & diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 25497f2bd..f63ea1b77 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -44,7 +44,7 @@ module med_map_mod contains !================================================================================ - subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, llogunit, rc) + subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogunit, rc) !--------------------------------------------- ! Initialize route handles in the mediator @@ -77,21 +77,23 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, llogunit, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_Field use esmFlds , only : fldListFr, ncomps, mapunset, compname - use med_methods_mod , only : med_methods_FB_getFieldN + use med_methods_mod , only : med_methods_FB_getFieldN, med_methods_FB_getNameN ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(in) :: llogunit - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp + character(len=*), intent(in) :: flds_scalar_name + integer, intent(in) :: llogunit + integer, intent(out) :: rc ! local variables - type(InternalState) :: is_local - type(ESMF_Field) :: fldsrc - type(ESMF_Field) :: flddst - integer :: n,n1,n2,m,nf - character(len=CX) :: mapfile - integer :: mapindex - logical :: mapexists = .false. + type(InternalState) :: is_local + type(ESMF_Field) :: fldsrc + type(ESMF_Field) :: flddst + integer :: n,n1,n2,m,nf,id + character(len=CX) :: mapfile + integer :: mapindex + logical :: mapexists = .false. + character(len=CX) :: fieldname character(len=*), parameter :: subname=' (module_med_map: RouteHandles_init) ' !----------------------------------------------------------- @@ -114,10 +116,15 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, llogunit, rc) do n2 = 1, ncomps if (n1 /= n2) then if (is_local%wrap%med_coupling_active(n1,n2)) then ! If coupling is active between n1 and n2 + ! Check name of first field. If it is ScalarFieldName and try with next field in the FB + id = 1 + call med_methods_FB_getNameN(is_local%wrap%FBImp(n1,n1), id, fieldname, rc) + if (trim(fieldname) == trim(flds_scalar_name)) id = id+1 + ! Get source and destination fields - call med_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n1), 1, fldsrc, rc) + call med_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n1), id, fldsrc, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n2), 1, flddst, rc) + call med_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n2), id, flddst, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Loop over fields @@ -220,7 +227,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, use esmFlds , only : mapunset, mapnames, nmappers use esmFlds , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd use esmFlds , only : mapfillv_bilnr, mapbilnr_nstod - use esmFlds , only : ncomps, compatm, compice, compocn, compname + use esmFlds , only : ncomps, compatm, compice, compocn, compwav, compname use esmFlds , only : coupling_mode, dststatus_print use esmFlds , only : atm_name use med_constants_mod , only : ispval_mask => med_constants_ispval_mask @@ -303,6 +310,11 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, elseif (n1 == compocn .and. n2 == compatm) then srcMaskValue = 0 dstMaskValue = ispval_mask + elseif (n1 == compatm .and. n2 == compwav) then + dstMaskValue = 1 + elseif (n1 == compwav .and. n2 == compatm) then + srcMaskValue = 1 + dstMaskValue = ispval_mask endif end if diff --git a/mediator/med_phases_post_wav_mod.F90 b/mediator/med_phases_post_wav_mod.F90 index 9e38eb32a..feb1c8515 100644 --- a/mediator/med_phases_post_wav_mod.F90 +++ b/mediator/med_phases_post_wav_mod.F90 @@ -22,7 +22,7 @@ subroutine med_phases_post_wav(gcomp, rc) use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask - use esmFlds , only : compwav, compocn, compice + use esmFlds , only : compwav, compatm, compocn, compice use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -46,6 +46,17 @@ subroutine med_phases_post_wav(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! map wav to atm + if (is_local%wrap%med_coupling_active(compwav,compatm)) then + call med_map_field_packed( & + FBSrc=is_local%wrap%FBImp(compwav,compwav), & + FBDst=is_local%wrap%FBImp(compwav,compatm), & + FBFracSrc=is_local%wrap%FBFrac(compwav), & + field_NormOne=is_local%wrap%field_normOne(compwav,compatm,:), & + packed_data=is_local%wrap%packed_data(compwav,compatm,:), & + routehandles=is_local%wrap%RH(compwav,compatm,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if ! map wav to ocn if (is_local%wrap%med_coupling_active(compwav,compocn)) then call med_map_field_packed( & From 69ea3a3b8015f0c1593e743683761834ac5677d3 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Mon, 24 May 2021 22:22:19 -0500 Subject: [PATCH 3/7] fix for one-way wave coupling --- mediator/med.F90 | 40 +++++++++++++++++++++++------ mediator/med_fraction_mod.F90 | 26 +++++++++++++++---- mediator/med_map_mod.F90 | 47 ++++++++++++++++++++++++++--------- 3 files changed, 89 insertions(+), 24 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 1c6312322..245f3a538 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1711,7 +1711,7 @@ subroutine DataInitialize(gcomp, rc) use ESMF , only : ESMF_State, ESMF_Time, ESMF_Field, ESMF_StateItem_Flag, ESMF_MAXSTR use ESMF , only : ESMF_GridCompGet, ESMF_AttributeGet, ESMF_ClockGet, ESMF_Success use ESMF , only : ESMF_StateIsCreated, ESMF_StateGet, ESMF_FieldBundleIsCreated, ESMF_LogFlush - use ESMF , only : ESMF_VM + use ESMF , only : ESMF_FieldBundleGet, ESMF_VM use NUOPC , only : NUOPC_CompAttributeSet, NUOPC_IsAtTime, NUOPC_SetAttribute use NUOPC , only : NUOPC_CompAttributeGet use med_fraction_mod , only : med_fraction_init, med_fraction_set @@ -1997,8 +1997,23 @@ subroutine DataInitialize(gcomp, rc) is_local%wrap%FBExpAccumCnt(n1) = 0 ! Create mesh info data - call med_meshinfo_create(is_local%wrap%FBImp(n1,n1), & - is_local%wrap%mesh_info(n1), rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n1), fieldCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (fieldCount == 0) then + if (mastertask) then + write(logunit,*) trim(subname)//' '//trim(compname(n1))//' import FB field count is = ', fieldCount + write(logunit,*) trim(subname)//' '//trim(compname(n1))//' trying to use export FB' + call ESMF_FieldBundleGet(is_local%wrap%FBExp(n1), fieldCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(logunit,*) trim(subname)//' '//trim(compname(n1))//' export FB field count is = ', fieldCount + end if + call med_meshinfo_create(is_local%wrap%FBExp(n1), & + is_local%wrap%mesh_info(n1), rc=rc) + else + call med_meshinfo_create(is_local%wrap%FBImp(n1,n1), & + is_local%wrap%mesh_info(n1), rc=rc) + end if if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -2016,10 +2031,21 @@ subroutine DataInitialize(gcomp, rc) trim(compname(n1))//'_'//trim(compname(n2)) end if - call FB_init(is_local%wrap%FBImp(n1,n2), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(n2), & - STflds=is_local%wrap%NStateImp(n1), & - name='FBImp'//trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) + ! Check import FB, if there is no field in it then use export FB + ! to provide mesh information + call State_GetNumFields(is_local%wrap%NStateImp(n2), fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fieldCount == 0) then + call FB_init(is_local%wrap%FBImp(n1,n2), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateExp(n2), & + STflds=is_local%wrap%NStateImp(n1), & + name='FBImp'//trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) + else + call FB_init(is_local%wrap%FBImp(n1,n2), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(n2), & + STflds=is_local%wrap%NStateImp(n1), & + name='FBImp'//trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) + end if if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_init(is_local%wrap%FBImpAccum(n1,n2), is_local%wrap%flds_scalar_name, & diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 018b4339c..44a495044 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -153,6 +153,7 @@ subroutine med_fraction_init(gcomp, rc) use esmFlds , only : comprof, compglc, compwav, compname use esmFlds , only : mapfcopy, mapconsd, mapnstod_consd use med_map_mod , only : med_map_routehandles_init, med_map_rh_is_created + use med_methods_mod , only : State_getNumFields => med_methods_State_getNumFields use med_internalstate_mod , only : InternalState, logunit, mastertask use perf_mod , only : t_startf, t_stopf @@ -177,6 +178,7 @@ subroutine med_fraction_init(gcomp, rc) real(R8), pointer :: So_omask(:) => null() integer :: i,j,n,n1,ns integer :: maptype + integer :: fieldCount logical, save :: first_call = .true. character(len=*),parameter :: subname=' (med_fraction_init)' !--------------------------------------- @@ -217,11 +219,25 @@ subroutine med_fraction_init(gcomp, rc) ! contain anything other than scalar data if the component is not prognostic do n1 = 1,ncomps if ( is_local%wrap%comp_present(n1) .and. & - ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then - ! create FBFrac and zero out FBfrac(n1) - call fldbun_init(is_local%wrap%FBfrac(n1), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(n1), fieldNameList=fraclist(:,n1), & - name='FBfrac'//trim(compname(n1)), rc=rc) + (ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) .or. & + ESMF_StateIsCreated(is_local%wrap%NStateExp(n1),rc=rc))) then + ! Check number of fields in the state + call State_GetNumFields(is_local%wrap%NStateImp(n1), fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create FBFrac + if (fieldCount == 0) then + call fldbun_init(is_local%wrap%FBfrac(n1), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateExp(n1), fieldNameList=fraclist(:,n1), & + name='FBfrac'//trim(compname(n1)), rc=rc) + else + call fldbun_init(is_local%wrap%FBfrac(n1), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(n1), fieldNameList=fraclist(:,n1), & + name='FBfrac'//trim(compname(n1)), rc=rc) + end if + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! zero out FBfrac(n1) call fldbun_reset(is_local%wrap%FBfrac(n1), value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index f63ea1b77..7ed257748 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -76,6 +76,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_Field + use ESMF , only : ESMF_FieldBundleGet use esmFlds , only : fldListFr, ncomps, mapunset, compname use med_methods_mod , only : med_methods_FB_getFieldN, med_methods_FB_getNameN @@ -89,7 +90,8 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun type(InternalState) :: is_local type(ESMF_Field) :: fldsrc type(ESMF_Field) :: flddst - integer :: n,n1,n2,m,nf,id + integer :: n,n1,n2,m,nf,id,nflds + integer :: fieldCount character(len=CX) :: mapfile integer :: mapindex logical :: mapexists = .false. @@ -116,15 +118,18 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun do n2 = 1, ncomps if (n1 /= n2) then if (is_local%wrap%med_coupling_active(n1,n2)) then ! If coupling is active between n1 and n2 - ! Check name of first field. If it is ScalarFieldName and try with next field in the FB - id = 1 - call med_methods_FB_getNameN(is_local%wrap%FBImp(n1,n1), id, fieldname, rc) - if (trim(fieldname) == trim(flds_scalar_name)) id = id+1 + ! Get source field + call med_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n1), 1, fldsrc, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Get source and destination fields - call med_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n1), id, fldsrc, rc) + ! Check number of fields in FB and get destination field + call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n2), fieldCount=fieldCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n2), id, flddst, rc) + if (fieldCount == 0) then + call med_methods_FB_getFieldN(is_local%wrap%FBExp(n2), 1, flddst, rc) + else + call med_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n2), 1, flddst, rc) + end if if (chkerr(rc,__LINE__,u_FILE_u)) return ! Loop over fields @@ -632,13 +637,31 @@ subroutine med_map_mapnorm_init(gcomp, rc) ! Create the destination normalization field do n1 = 1,ncomps - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(n1,n1))) then + ! Since coupling could be uni-directional, the import FB could be + ! available but number of fields could be zero, so it is better to + ! check export FB if this is the case + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(n1,n1)) .or. & + ESMF_FieldBundleIsCreated(is_local%wrap%FBExp(n1))) then ! Get source mesh call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n1), fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(fieldlist(fieldcount)) - call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n1), fieldlist=fieldlist, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (fieldCount == 0) then + if (mastertask) then + write(logunit,*) trim(subname)//' '//trim(compname(n1))//' import FB field count is = ', fieldCount + write(logunit,*) trim(subname)//' '//trim(compname(n1))//' trying to use export FB' + end if + call ESMF_FieldBundleGet(is_local%wrap%FBExp(n1), fieldCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldlist(fieldcount)) + call ESMF_FieldBundleGet(is_local%wrap%FBExp(n1), fieldlist=fieldlist, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + allocate(fieldlist(fieldcount)) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n1), fieldlist=fieldlist, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldGet(fieldlist(1), 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) From 951e3e163404567ce57597f2471720c29811c7c5 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Wed, 26 May 2021 00:09:14 -0500 Subject: [PATCH 4/7] update roughness length entry --- mediator/fd_nems.yaml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/mediator/fd_nems.yaml b/mediator/fd_nems.yaml index d8701873f..dcd691980 100644 --- a/mediator/fd_nems.yaml +++ b/mediator/fd_nems.yaml @@ -742,7 +742,8 @@ canonical_units: 1 description: ww3 export # - - standard_name: wave_z0_roughness_length + - standard_name: Sw_zo + alias: wave_z0_roughness_length canonical_units: 1 description: ww3 export # From cf8021c0a3b7e3768ba0924299c7b49be773135c Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Wed, 26 May 2021 16:52:09 -0500 Subject: [PATCH 5/7] fix minor issue and update nems field dictionary --- mediator/fd_nems.yaml | 4 ++++ mediator/med.F90 | 7 ++++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/mediator/fd_nems.yaml b/mediator/fd_nems.yaml index dcd691980..2c3fbc261 100644 --- a/mediator/fd_nems.yaml +++ b/mediator/fd_nems.yaml @@ -200,11 +200,15 @@ alias: inst_zonal_wind_height10m canonical_units: m s-1 description: atmosphere export - zonal wind height 10m + - standard_name: Sa_u10m + alias: eastward_wind_at_10m_height # - standard_name: Sa_v10m alias: inst_merid_wind_height10m canonical_units: m s-1 description: atmosphere export - meridional wind height 10m + - standard_name: Sa_v10m + alias: northward_wind_at_10m_height # - standard_name: Sa_t2m alias: inst_temp_height2m diff --git a/mediator/med.F90 b/mediator/med.F90 index 245f3a538..285190b6b 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -838,11 +838,16 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) glc_name = trim(cvalue) end if + call NUOPC_CompAttributeGet(gcomp, name='MED_model', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + med_name = trim(cvalue) + end if + call NUOPC_CompAttributeGet(gcomp, name='mediator_present', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then med_present = trim(cvalue) - med_name = trim(cvalue) end if call NUOPC_CompAttributeSet(gcomp, name="atm_present", value=atm_present, rc=rc) From cf77f348b0a48039267ab11a3f872ce110836576 Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Tue, 20 Jul 2021 16:17:53 -0500 Subject: [PATCH 6/7] add missing code for wave coupling --- mediator/esmFldsExchange_hafs_mod.F90 | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 65e62aad7..eb22b3396 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -162,6 +162,18 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) end do deallocate(S_flds) + ! --------------------------------------------------------------------- + ! to atm: surface roughness length + ! --------------------------------------------------------------------- + allocate(S_flds(1)) + S_flds = (/'Sw_zo'/) ! wave_z0_roughness_length + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld(fldListFr(compwav)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + end do + deallocate(S_flds) + !===================================================================== ! FIELDS TO OCEAN (compocn) !===================================================================== @@ -202,8 +214,12 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) end do deallocate(F_flds) + !===================================================================== + ! FIELDS TO WAVE (compwav) + !===================================================================== + ! --------------------------------------------------------------------- - ! from atm to wav + ! to wav: 10-m wind components ! --------------------------------------------------------------------- allocate(S_flds(2)) S_flds = (/'Sa_u10m', 'Sa_v10m'/) From d379e47c66336a3f4c3ba239e96f8e6f33eb152a Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Fri, 23 Jul 2021 00:21:33 -0500 Subject: [PATCH 7/7] fix for atm-wav configuration --- mediator/esmFldsExchange_hafs_mod.F90 | 340 +++++++++++++++----------- 1 file changed, 193 insertions(+), 147 deletions(-) diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index eb22b3396..e88da9261 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -31,16 +31,19 @@ module esmFldsExchange_hafs_mod __FILE__ type gcomp_attr - character(len=CX) :: atm2ocn_fmap='unset' - character(len=CX) :: atm2ocn_smap='unset' - character(len=CX) :: atm2ocn_vmap='unset' - character(len=CX) :: atm2wav_smap='unset' - character(len=CX) :: ocn2atm_fmap='unset' - character(len=CX) :: ocn2atm_smap='unset' - character(len=CX) :: ocn2wav_smap='unset' - character(len=CX) :: wav2ocn_smap='unset' - character(len=CX) :: wav2atm_smap='unset' - character(len=CS) :: mapnorm ='one' + character(len=CX) :: atm2ocn_fmap = 'unset' + character(len=CX) :: atm2ocn_smap = 'unset' + character(len=CX) :: atm2ocn_vmap = 'unset' + character(len=CX) :: atm2wav_smap = 'unset' + character(len=CX) :: ocn2atm_fmap = 'unset' + character(len=CX) :: ocn2atm_smap = 'unset' + character(len=CX) :: ocn2wav_smap = 'unset' + character(len=CX) :: wav2ocn_smap = 'unset' + character(len=CX) :: wav2atm_smap = 'unset' + character(len=CS) :: mapnorm = 'one' + logical :: atm_present = .false. + logical :: ocn_present = .false. + logical :: wav_present = .false. end type !=============================================================================== @@ -153,26 +156,30 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to atm: surface temperatures from ocn ! --------------------------------------------------------------------- - allocate(S_flds(1)) - S_flds = (/'So_t'/) ! sea_surface_temperature - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld(fldListFr(compocn)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - end do - deallocate(S_flds) + if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then + allocate(S_flds(1)) + S_flds = (/'So_t'/) ! sea_surface_temperature + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld(fldListFr(compocn)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + end do + deallocate(S_flds) + end if ! --------------------------------------------------------------------- ! to atm: surface roughness length ! --------------------------------------------------------------------- - allocate(S_flds(1)) - S_flds = (/'Sw_zo'/) ! wave_z0_roughness_length - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld(fldListFr(compwav)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - end do - deallocate(S_flds) + if (hafs_attr%atm_present .and. hafs_attr%wav_present) then + allocate(S_flds(1)) + S_flds = (/'Sw_zo'/) ! wave_z0_roughness_length + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld(fldListFr(compwav)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + end do + deallocate(S_flds) + end if !===================================================================== ! FIELDS TO OCEAN (compocn) @@ -181,38 +188,42 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ocn: state fields ! --------------------------------------------------------------------- - allocate(S_flds(6)) - S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m - 'Sa_v10m', & ! inst_merid_wind_height10m - 'Sa_t2m ', & ! inst_temp_height2m - 'Sa_q2m ', & ! inst_spec_humid_height2m - 'Sa_pslv', & ! inst_pres_height_surface - 'Sa_tskn' /) ! inst_temp_height_surface - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compocn)%flds, trim(fldname)) - end do - deallocate(S_flds) + if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then + allocate(S_flds(6)) + S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m + 'Sa_v10m', & ! inst_merid_wind_height10m + 'Sa_t2m ', & ! inst_temp_height2m + 'Sa_q2m ', & ! inst_spec_humid_height2m + 'Sa_pslv', & ! inst_pres_height_surface + 'Sa_tskn' /) ! inst_temp_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + end do + deallocate(S_flds) + end if ! --------------------------------------------------------------------- ! to ocn: flux fields ! --------------------------------------------------------------------- - allocate(F_flds(7,2)) - F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx - F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx - F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx - F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx - do n = 1,size(F_flds,1) - fldname1 = trim(F_flds(n,1)) - fldname2 = trim(F_flds(n,2)) - call addfld(fldListFr(compatm)%flds, trim(fldname1)) - call addfld(fldListTo(compocn)%flds, trim(fldname2)) - end do - deallocate(F_flds) + if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then + allocate(F_flds(7,2)) + F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm + F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm + F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate + F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx + F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx + F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx + F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + call addfld(fldListFr(compatm)%flds, trim(fldname1)) + call addfld(fldListTo(compocn)%flds, trim(fldname2)) + end do + deallocate(F_flds) + end if !===================================================================== ! FIELDS TO WAVE (compwav) @@ -221,14 +232,16 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: 10-m wind components ! --------------------------------------------------------------------- - allocate(S_flds(2)) - S_flds = (/'Sa_u10m', 'Sa_v10m'/) - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addfld(fldListTo(compwav)%flds, trim(fldname)) - end do - deallocate(S_flds) + if (hafs_attr%atm_present .and. hafs_attr%wav_present) then + allocate(S_flds(2)) + S_flds = (/'Sa_u10m', 'Sa_v10m'/) + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compwav)%flds, trim(fldname)) + end do + deallocate(S_flds) + end if call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -350,39 +363,42 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to atm: sea surface temperature ! --------------------------------------------------------------------- - allocate(S_flds(1)) - S_flds = (/'So_t'/) ! sea_surface_temperature - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compocn,compocn),trim(fldname),rc=rc) & - ) then - call addmap(fldListFr(compocn)%flds, trim(fldname), compatm, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%ocn2atm_smap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') - end if - end do - deallocate(S_flds) + if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then + allocate(S_flds(1)) + S_flds = (/'So_t'/) ! sea_surface_temperature + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn),trim(fldname),rc=rc) & + ) then + call addmap(fldListFr(compocn)%flds, trim(fldname), compatm, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%ocn2atm_smap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + end if ! --------------------------------------------------------------------- ! to atm: surface roughness length ! --------------------------------------------------------------------- - ! state fields - allocate(S_flds(1)) - S_flds = (/'Sw_zo'/) ! wave_z0_roughness_length - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav,compwav),trim(fldname),rc=rc) & - ) then - call addmap(fldListFr(compwav)%flds, trim(fldname), compatm, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%wav2atm_smap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') - end if - end do - deallocate(S_flds) + if (hafs_attr%atm_present .and. hafs_attr%wav_present) then + allocate(S_flds(1)) + S_flds = (/'Sw_zo'/) ! wave_z0_roughness_length + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav,compwav),trim(fldname),rc=rc) & + ) then + call addmap(fldListFr(compwav)%flds, trim(fldname), compatm, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%wav2atm_smap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + end if !===================================================================== ! FIELDS TO OCEAN (compocn) @@ -391,50 +407,54 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ocn: state fields ! --------------------------------------------------------------------- - allocate(S_flds(6)) - S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m - 'Sa_v10m', & ! inst_merid_wind_height10m - 'Sa_t2m ', & ! inst_temp_height2m - 'Sa_q2m ', & ! inst_spec_humid_height2m - 'Sa_pslv', & ! inst_pres_height_surface - 'Sa_tskn' /) ! inst_temp_height_surface - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname),rc=rc) & - ) then - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) - call addmrg(fldListTo(compocn)%flds, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') - end if - end do - deallocate(S_flds) + if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then + allocate(S_flds(6)) + S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m + 'Sa_v10m', & ! inst_merid_wind_height10m + 'Sa_t2m ', & ! inst_temp_height2m + 'Sa_q2m ', & ! inst_spec_humid_height2m + 'Sa_pslv', & ! inst_pres_height_surface + 'Sa_tskn' /) ! inst_temp_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname),rc=rc) & + ) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) + call addmrg(fldListTo(compocn)%flds, trim(fldname), & + mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + end if ! --------------------------------------------------------------------- ! to ocn: flux fields ! --------------------------------------------------------------------- - allocate(F_flds(7,2)) - F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx - F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx - F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx - F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx - do n = 1,size(F_flds,1) - fldname1 = trim(F_flds(n,1)) - fldname2 = trim(F_flds(n,2)) - if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname2),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname1),rc=rc) & - ) then - call addmap(fldListFr(compatm)%flds, trim(fldname1), compocn, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) - call addmrg(fldListTo(compocn)%flds, trim(fldname2), & - mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') - end if - end do - deallocate(F_flds) + if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then + allocate(F_flds(7,2)) + F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm + F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm + F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate + F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx + F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx + F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx + F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname2),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname1),rc=rc) & + ) then + call addmap(fldListFr(compatm)%flds, trim(fldname1), compocn, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) + call addmrg(fldListTo(compocn)%flds, trim(fldname2), & + mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') + end if + end do + deallocate(F_flds) + end if !===================================================================== ! FIELDS TO WAVE (compwav) @@ -443,21 +463,22 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: 10-m wind components ! --------------------------------------------------------------------- - ! state fields - allocate(S_flds(2)) - S_flds = (/'Sa_u10m', 'Sa_v10m'/) - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - if (fldchk(is_local%wrap%FBexp(compwav),trim(fldname),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname),rc=rc) & - ) then - call addmap(fldListFr(compatm)%flds, trim(fldname), compwav, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2wav_smap) - call addmrg(fldListTo(compwav)%flds, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') - end if - end do - deallocate(S_flds) + if (hafs_attr%atm_present .and. hafs_attr%wav_present) then + allocate(S_flds(2)) + S_flds = (/'Sa_u10m', 'Sa_v10m'/) + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBexp(compwav),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname),rc=rc) & + ) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compwav, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2wav_smap) + call addmrg(fldListTo(compwav)%flds, trim(fldname), & + mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + end if call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -476,7 +497,7 @@ subroutine esmFldsExchange_hafs_attr(gcomp, hafs_attr, rc) character(32) :: cname integer :: verbosity, diagnostic character(len=CL) :: cvalue - logical :: isPresent + logical :: isPresent, isSet character(len=*) , parameter :: subname='(esmFldsExchange_hafs_attr)' !-------------------------------------- @@ -488,6 +509,31 @@ subroutine esmFldsExchange_hafs_attr(gcomp, hafs_attr, rc) diagnostic=diagnostic, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + !---------------------------------------------------------- + ! Component active or not? + !---------------------------------------------------------- + + call NUOPC_CompAttributeGet(gcomp, name='ATM_model', & + value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(cvalue) /= 'satm') hafs_attr%atm_present = .true. + end if + + call NUOPC_CompAttributeGet(gcomp, name='OCN_model', & + value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(cvalue) /= 'socn') hafs_attr%ocn_present = .true. + end if + + call NUOPC_CompAttributeGet(gcomp, name='WAV_model', & + value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(cvalue) /= 'swav') hafs_attr%wav_present = .true. + end if + !---------------------------------------------------------- ! Normalization type !----------------------------------------------------------