From 69f31b84bbbc76174a24e911be3a582345412fd7 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Sun, 20 Nov 2022 07:53:02 -0700 Subject: [PATCH] compiles now --- mediator/esmFlds.F90 | 26 ++++++++++++++++++++ mediator/esmFldsExchange_cesm_mod.F90 | 29 +++++++++++----------- mediator/esmFldsExchange_nems_mod.F90 | 4 ++- mediator/med.F90 | 35 +++++++++++++++------------ mediator/med_map_mod.F90 | 20 ++++++++------- mediator/med_phases_aofluxes_mod.F90 | 16 +++++++----- mediator/med_phases_post_glc_mod.F90 | 1 - mediator/med_phases_prep_atm_mod.F90 | 6 ++--- mediator/med_phases_prep_ocn_mod.F90 | 6 ++--- mediator/med_phases_prep_rof_mod.F90 | 14 +++++------ 10 files changed, 98 insertions(+), 59 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 01c148b9a..018f164c7 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -21,6 +21,7 @@ module esmflds public :: med_fldList_AddMrgTo public :: med_fldList_AddOcnalbFld + public :: med_fldList_AddocnalbMap public :: med_fldList_AddaofluxFld public :: med_fldList_AddaofluxMap @@ -37,6 +38,8 @@ module esmflds public :: med_fldList_Document_Merging public :: med_fldList_GetFldListFr public :: med_fldList_GetFldListTo + public :: med_fldList_GetaofluxFldList + public :: med_fldList_GetocnalbFldList !----------------------------------------------- ! Types and instantiations that determine fields, mappings, mergings !----------------------------------------------- @@ -89,6 +92,18 @@ subroutine med_fldlist_init1() allocate(fldlistFr(ncomps)) end subroutine med_fldlist_init1 + function med_fldList_GetaofluxFldList() result(fldList) + type(med_fldList_type), pointer :: fldList + + fldList => fldListMed_aoflux + end function Med_FldList_GetaofluxFldList + + function med_fldList_GetocnalbFldList() result(fldList) + type(med_fldList_type), pointer :: fldList + + fldList => fldListMed_ocnalb + end function Med_FldList_GetocnalbFldList + function med_fldList_GetFldListFr(index) result(fldList) integer, intent(in) :: index type(med_fldList_type), pointer :: fldList @@ -341,6 +356,17 @@ subroutine med_fldList_AddaofluxMap(fldname, destcomp, maptype, mapnorm, mapfile end subroutine med_fldList_AddaofluxMap + subroutine med_fldList_AddocnalbMap(fldname, destcomp, maptype, mapnorm, mapfile) + character(len=*) , intent(in) :: fldname + integer , intent(in) :: destcomp + integer , intent(in) :: maptype + character(len=*) , intent(in) :: mapnorm + character(len=*), optional , intent(in) :: mapfile + + call med_fldList_AddMap(fldlistmed_ocnalb%fields, fldname, destcomp, maptype, mapnorm, mapfile) + + end subroutine med_fldList_AddocnalbMap + subroutine med_fldList_AddMap(fields, fldname, destcomp, maptype, mapnorm, mapfile) use ESMF, only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_LogWrite, ESMF_LOGMSG_INFO diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 652946ad0..e957ea699 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -81,6 +81,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use esmFlds , only : addocnalbfld => med_fldList_AddocnalbFld use esmFlds , only : addaofluxfld => med_fldList_AddaofluxFld use esmFlds , only : addaofluxMap => med_fldList_AddaofluxMap + use esmFlds , only : addocnalbMap => med_fldList_AddocnalbMap use esmFlds , only : addfldTo => med_fldList_AddFldTo use esmFlds , only : addfldFrom => med_fldList_AddFldFrom @@ -803,7 +804,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compice, mrg_fld='Si_avsdr', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_avsdr', rc=rc)) then - call addocnalpmap( 'So_avsdr', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addocnalbmap( 'So_avsdr', compatm, mapconsf, 'ofrac', ocn2atm_map) call addmrgTo(compatm, 'Sx_avsdr', & mrg_from=compmed, mrg_fld='So_avsdr', mrg_type='merge', mrg_fracname='ofrac') end if @@ -830,7 +831,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compice, mrg_fld='Si_avsdf', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_avsdf', rc=rc)) then - call addocnalpmap( 'So_avsdf', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addocnalbmap( 'So_avsdf', compatm, mapconsf, 'ofrac', ocn2atm_map) call addmrgTo(compatm, 'Sx_avsdf', & mrg_from=compmed, mrg_fld='So_avsdf', mrg_type='merge', mrg_fracname='ofrac') end if @@ -857,7 +858,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compice, mrg_fld='Si_anidr', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_anidr', rc=rc)) then - call addocnalpmap( 'So_anidr', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addocnalbmap( 'So_anidr', compatm, mapconsf, 'ofrac', ocn2atm_map) call addmrgTo(compatm, 'Sx_anidr', & mrg_from=compmed, mrg_fld='So_anidr', mrg_type='merge', mrg_fracname='ofrac') end if @@ -884,7 +885,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compice, mrg_fld='Si_anidf', mrg_type='merge', mrg_fracname='ifrac') end if if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_anidf', rc=rc)) then - call addocnalpmap( 'So_anidf', compatm, mapconsf, 'ofrac', ocn2atm_map) + call addocnalbmap( 'So_anidf', compatm, mapconsf, 'ofrac', ocn2atm_map) call addmrgTo(compatm, 'Sx_anidf', & mrg_from=compmed, mrg_fld='So_anidf', mrg_type='merge', mrg_fracname='ofrac') end if @@ -1163,7 +1164,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfldTo(compatm, 'Faxx_tauy') call addFldFrom(complnd, 'Fall_tauy') call addfldFrom(compice, 'Faii_tauy') - call addaoflusFld( 'Faox_tauy') + call addaofluxFld( 'Faox_tauy') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_tauy', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_tauy', rc=rc)) then @@ -1190,7 +1191,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfldTo(compatm, 'Faxx_lat') call addFldFrom(complnd, 'Fall_lat') call addfldFrom(compice, 'Faii_lat') - call addaoflusFld( 'Faox_lat') + call addaofluxFld( 'Faox_lat') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lat', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lat', rc=rc)) then @@ -1217,7 +1218,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfldTo(compatm, 'Faxx_sen') call addFldFrom(complnd, 'Fall_sen') call addfldFrom(compice, 'Faii_sen') - call addaoflusFld( 'Faox_sen') + call addaofluxFld( 'Faox_sen') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_sen', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen', rc=rc)) then @@ -1244,7 +1245,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfldTo(compatm, 'Faxx_evap') call addFldFrom(complnd, 'Fall_evap') call addfldFrom(compice, 'Faii_evap') - call addaoflusFld( 'Faox_evap') + call addaofluxFld( 'Faox_evap') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap', rc=rc)) then @@ -1271,7 +1272,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfldTo(compatm, 'Faxx_lwup') call addFldFrom(complnd, 'Fall_lwup') call addfldFrom(compice, 'Faii_lwup') - call addaoflusFld( 'Faox_lwup') + call addaofluxFld( 'Faox_lwup') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_lwup', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_lwup', rc=rc)) then @@ -1299,7 +1300,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfldTo(compatm, 'Faxx_evap_wiso') call addFldFrom(complnd, 'Fall_evap_wiso') call addfldFrom(compice, 'Faii_evap_wiso') - call addaoflusFld( 'Faox_evap_wiso') + call addaofluxFld( 'Faox_evap_wiso') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap_wiso', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap_wiso', rc=rc)) then @@ -1848,8 +1849,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- if (phase == 'advertise') then call addFldFrom(compatm, 'Faxa_lat' ) - call addaoflusFld( 'Faox_lat' ) - call addaoflusFld( 'Faox_evap') + call addaofluxFld( 'Faox_lat' ) + call addaofluxFld( 'Faox_evap') call addFldTo(compocn, 'Foxx_lat' ) call addFldTo(compocn, 'Foxx_evap') else @@ -1865,7 +1866,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (flds_wiso) then if (phase == 'advertise') then - call addaoflusFld( 'Faox_lat_wiso' ) + call addaofluxFld( 'Faox_lat_wiso' ) call addFldTo(compocn, 'Foxx_lat_wiso' ) else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat_wiso', rc=rc)) then @@ -1882,7 +1883,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! If the aoflux grid is ogrid - then nothing needs to be done to send to the ocean ! All other mappings are set in med_phases_aoflux_mod.F90 if (phase == 'advertise') then - call addaoflusFld( 'So_duu10n') + call addaofluxFld( 'So_duu10n') call addFldTo(compocn, 'So_duu10n') else if (fldchk(is_local%wrap%FBExp(compocn), 'So_duu10n', rc=rc)) then diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index a17461592..8095d1494 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -39,7 +39,9 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use esmFlds , only : addfldFrom => med_fldList_AddFldFrom use esmFlds , only : addmapFrom => med_fldList_AddMapFrom use esmFlds , only : addmrgFrom => med_fldList_AddMrgFrom - + use esmFlds , only : addaofluxFld => med_fldList_addaofluxFld + use esmFlds , only : addaofluxMap => med_fldList_addaofluxMap + use med_internalstate_mod , only : InternalState, mastertask, logunit ! input/output parameters: diff --git a/mediator/med.F90 b/mediator/med.F90 index 25b16aa0a..bc61d8ff3 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -44,10 +44,10 @@ module MED use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc use med_internalstate_mod , only : coupling_mode, aoflux_code, aoflux_ccpp_suite - use esmFlds , only : fldListMed_ocnalb + use esmFlds , only : med_fldList_GetocnalbfldList, med_fldList_type use esmFlds , only : med_fldList_GetNumFlds, med_fldList_GetFldNames, med_fldList_GetFldInfo use esmFlds , only : med_fldList_Document_Mapping, med_fldList_Document_Merging - use esmFlds , only : fldListFr, fldListTo, med_fldList_Realize + use esmFlds , only : med_fldList_GetfldListFr, med_fldList_GetfldListTo, med_fldList_Realize use esmFldsExchange_nems_mod , only : esmFldsExchange_nems use esmFldsExchange_cesm_mod , only : esmFldsExchange_cesm use esmFldsExchange_hafs_mod , only : esmFldsExchange_hafs @@ -676,6 +676,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) character(len=CS) :: cvalue character(len=8) :: cnum type(InternalState) :: is_local + type(med_fldlist_type), pointer :: fldListFr, fldListTo integer :: stat character(len=*),parameter :: subname=' (Advertise Fields) ' !----------------------------------------------------------- @@ -872,9 +873,10 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) do ncomp = 1,ncomps if (ncomp /= compmed) then if (mastertask) write(logunit,*) - nflds = med_fldList_GetNumFlds(fldListFr(ncomp)) - do n = 1,nflds - call med_fldList_GetFldInfo(fldListFr(ncomp), n, stdname=stdname, shortname=shortname) + fldListFr => med_fldList_GetFldListFr(ncomp) + nflds = med_fldList_GetNumFlds(fldListFr) + do n=1,nflds + call med_fldList_GetFldInfo(fldListFr, n, stdname=stdname, shortname=shortname) if (mastertask) then write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) end if @@ -889,9 +891,11 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) end do - nflds = med_fldList_GetNumFlds(fldListTo(ncomp)) + + fldListTo => med_fldList_GetFldListTo(ncomp) + nflds = med_fldList_GetNumFlds(fldListTo) do n = 1,nflds - call med_fldList_GetFldInfo(fldListTo(ncomp), n, stdname=stdname, shortname=shortname) + call med_fldList_GetFldInfo(fldListTo, n, stdname=stdname, shortname=shortname) if (mastertask) then write(logunit,'(a)') trim(subname)//':To_'//trim(compname(ncomp))//': '//trim(shortname) end if @@ -958,7 +962,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) if (ESMF_StateIsCreated(is_local%wrap%NStateImp(n), rc=rc)) then call ESMF_StateSet(is_local%wrap%NStateImp(n), stateIntent=ESMF_StateIntent_Import, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_fldList_Realize(is_local%wrap%NStateImp(n), fldListFr(n), & + call med_fldList_Realize(is_local%wrap%NStateImp(n), med_fldList_GetfldListFr(n), & is_local%wrap%flds_scalar_name, is_local%wrap%flds_scalar_num, & tag=subname//':Fr_'//trim(compname(n)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -966,7 +970,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n), rc=rc)) then call ESMF_StateSet(is_local%wrap%NStateExp(n), stateIntent=ESMF_StateIntent_Export, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_fldList_Realize(is_local%wrap%NStateExp(n), fldListTo(n), & + call med_fldList_Realize(is_local%wrap%NStateExp(n), med_fldList_getfldListTo(n), & is_local%wrap%flds_scalar_name, is_local%wrap%flds_scalar_num, & tag=subname//':To_'//trim(compname(n)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1564,7 +1568,7 @@ subroutine DataInitialize(gcomp, rc) use med_diag_mod , only : med_diag_zero, med_diag_init use med_map_mod , only : med_map_routehandles_init, med_map_packed_field_create use med_io_mod , only : med_io_init - use esmFlds , only : fldListMed_aoflux + use esmFlds , only : med_fldList_GetaofluxfldList ! input/output variables type(ESMF_GridComp) :: gcomp @@ -1578,6 +1582,7 @@ subroutine DataInitialize(gcomp, rc) type(ESMF_Time) :: time type(ESMF_Field) :: field type(ESMF_StateItem_Flag) :: itemType + type(med_fldList_type), pointer :: fldListMed_ocnalb logical :: atCorrectTime, connected integer :: n1,n2,n,ns integer :: nsrc,ndst @@ -1723,10 +1728,11 @@ subroutine DataInitialize(gcomp, rc) if ( is_local%wrap%med_coupling_active(compocn,compatm) .or. is_local%wrap%med_coupling_active(compatm,compocn)) then ! Create field bundles for mediator ocean albedo computation + fldListMed_ocnalb => med_fldlist_getocnalbFldList() fieldCount = med_fldList_GetNumFlds(fldListMed_ocnalb) if (fieldCount > 0) then allocate(fldnames(fieldCount)) - call med_fldList_getfldnames(fldListMed_ocnalb%flds, fldnames, rc=rc) + call med_fldList_getfldnames(fldListMed_ocnalb%fields, fldnames, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_init(is_local%wrap%FBMed_ocnalb_a, is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_ocnalb_a', rc=rc) @@ -1751,8 +1757,7 @@ subroutine DataInitialize(gcomp, rc) ! NOTE: this section must be done BEFORE the second call to esmFldsExchange ! Create field bundles for mediator ocean albedo computation - - fieldCount = med_fldList_GetNumFlds(fldListMed_aoflux) + fieldCount = med_fldList_GetNumFlds(med_fldList_getaofluxfldList()) if ( fieldCount > 0 ) then if ( is_local%wrap%med_coupling_active(compocn,compatm) .or. & is_local%wrap%med_coupling_active(compatm,compocn)) then @@ -1807,7 +1812,7 @@ subroutine DataInitialize(gcomp, rc) if (is_local%wrap%med_coupling_active(nsrc,ndst)) then call med_map_packed_field_create(ndst, & is_local%wrap%flds_scalar_name, & - fldsSrc=fldListFr(nsrc)%flds, & + fieldsSrc=med_fldList_GetfldListFr(nsrc), & FBSrc=is_local%wrap%FBImp(nsrc,nsrc), & FBDst=is_local%wrap%FBImp(nsrc,ndst), & packed_data=is_local%wrap%packed_data(nsrc,ndst,:), rc=rc) @@ -1819,7 +1824,7 @@ subroutine DataInitialize(gcomp, rc) ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a)) then call med_map_packed_field_create(compatm, & is_local%wrap%flds_scalar_name, & - fldsSrc=fldListMed_ocnalb%flds, & + fieldsSrc=med_fldList_getocnalbfldList(), & FBSrc=is_local%wrap%FBMed_ocnalb_o, & FBDst=is_local%wrap%FBMed_ocnalb_a, & packed_data=is_local%wrap%packed_data_ocnalb_o2a(:), rc=rc) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index d2e5b3057..5ecf488ad 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -716,7 +716,8 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & fieldsSrc, FBSrc, FBDst, packed_data, rc) use ESMF - use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds + use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds, med_fldList_type + use esmFlds , only : med_fldList_getFldInfo use med_internalstate_mod , only : nmappers use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compname, mapnames use med_internalstate_mod , only : packed_data_type @@ -724,7 +725,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & ! input/output variables integer , intent(in) :: destcomp character(len=*) , intent(in) :: flds_scalar_name - type(med_fldList_entry_type) , target :: fieldsSrc ! mapping types top of LL + type(med_fldList_type) , intent(in) :: fieldsSrc ! mapping types top of LL type(ESMF_FieldBundle) , intent(in) :: FBSrc type(ESMF_FieldBundle) , intent(inout) :: FBDst type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types @@ -746,6 +747,8 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & integer :: numFlds type(ESMF_Field), pointer :: fieldlist_src(:) type(ESMF_Field), pointer :: fieldlist_dst(:) + character(CL) :: shortname + integer :: destindex character(CL), allocatable :: fieldNameList(:) character(CS) :: mapnorm_mapindex character(len=CX) :: tmpstr @@ -794,13 +797,12 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & ! Determine the normalization type for each packed_data mapping element ! Loop over mapping types + numflds = med_fldlist_GetNumFlds(fieldsSrc) do mapindex = 1,nmappers mapnorm_mapindex = 'not_set' ! Loop over source field bundle do nf = 1, fieldCount ! Loop over the fldsSrc types - - numflds = med_fldlist_GetNumFlds(fieldsSrc) do ns = 1,numflds ! Note that fieldnamelist is an array of names for the source fields ! The assumption is that there is only one mapping normalization @@ -809,7 +811,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & if ( destindex == mapindex .and. & trim(shortname) == trim(fieldnamelist(nf))) then ! Set the normalization to the input - call med_FldList_GetFldInfo(fieldsSrc, ns, compsrc=destcomp, mapnorm=packed_data(mapindex)%mapnorm=mapnorm) + call med_FldList_GetFldInfo(fieldsSrc, ns, compsrc=destcomp, mapnorm=packed_data(mapindex)%mapnorm) if (mapnorm_mapindex == 'not_set') then mapnorm_mapindex = packed_data(mapindex)%mapnorm write(tmpstr,*)'Map type '//trim(mapnames(mapindex)) & @@ -850,10 +852,10 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & do nf = 1, fieldCount ! Loop over the fldsSrc types - do ns = 1,size(fldsSrc) - - if ( fldsSrc(ns)%mapindex(destcomp) == mapindex .and. & - trim(fldsSrc(ns)%shortname) == trim(fieldnamelist(nf))) then + do ns = 1,numFlds + call med_fldList_GetFldInfo(fieldsSrc, ns, compsrc=destcomp, shortname=shortname, mapindex=destIndex) + if ( destIndex == mapindex .and. & + trim(shortname) == trim(fieldnamelist(nf))) then ! Determine mapping of indices into packed field bundle ! Get source field diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index c0c442a7f..fcbf27a08 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -166,7 +166,8 @@ 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 : fldListMed_aoflux + 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 @@ -177,13 +178,14 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, 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) @@ -192,7 +194,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) ! Set module variable fldnames_aof_out fieldCount = med_fldList_GetNumFlds(fldListMed_aoflux) allocate(fldnames_aof_out(fieldCount)) - call med_fldList_getfldnames(fldListMed_aoflux%flds, fldnames_aof_out, rc=rc) + call med_fldList_getfldnames(fldListMed_aoflux%fields, fldnames_aof_out, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Initialize FBMed_aoflux_a @@ -487,7 +489,8 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) ! -------------------------------------------- use ESMF , only : ESMF_FieldBundleIsCreated - use esmFlds , only : fldListMed_aoflux + use esmFlds , only : med_fldlist_GetaofluxfldList + use esmFlds , only : med_fldList_type use med_map_mod , only : med_map_packed_field_create ! Arguments @@ -497,6 +500,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) integer , intent(out) :: rc ! ! Local variables + type(med_fldList_type), pointer :: FldListMed_aoflux type(InternalState) :: is_local character(len=CX) :: tmpstr integer :: lsize @@ -509,7 +513,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) !----------------------------------------------------------------------- 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) @@ -570,7 +574,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) call med_map_packed_field_create(destcomp=compatm, & flds_scalar_name=is_local%wrap%flds_scalar_name, & - fldsSrc=fldListMed_aoflux%flds, & + 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) diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index 14610e710..891ee5ddb 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -17,7 +17,6 @@ module med_phases_post_glc_mod use med_internalstate_mod , only : compatm, compice, complnd, comprof, compocn, compname, compglc use med_internalstate_mod , only : mapbilnr, mapconsd, compname use med_internalstate_mod , only : InternalState, mastertask, logunit - use esmFlds , only : fldListTo use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_fldchk => med_methods_FB_fldchk use med_methods_mod , only : fldbun_getmesh => med_methods_FB_getmesh diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 8d41adbb8..caa9f4851 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -18,7 +18,7 @@ module med_phases_prep_atm_mod use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, mastertask use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode - use esmFlds , only : fldListTo, fldListMed_aoflux + use esmFlds , only : med_fldlist_GetfldListTo use perf_mod , only : t_startf, t_stopf use med_phases_aofluxes_mod, only : med_aofluxes_map_xgrid2agrid_output use med_phases_aofluxes_mod, only : med_aofluxes_map_ogrid2agrid_output @@ -139,7 +139,7 @@ subroutine med_phases_prep_atm(gcomp, rc) is_local%wrap%FBExp(compatm), & is_local%wrap%FBFrac(compatm), & is_local%wrap%FBImp(:,compatm), & - fldListTo(compatm), & + med_fldList_GetfldListTo(compatm), & FBMed1=is_local%wrap%FBMed_ocnalb_a, & FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -151,7 +151,7 @@ subroutine med_phases_prep_atm(gcomp, rc) is_local%wrap%FBExp(compatm), & is_local%wrap%FBFrac(compatm), & is_local%wrap%FBImp(:,compatm), & - fldListTo(compatm), rc=rc) + med_fldList_GetfldListTo(compatm), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 35208a109..d2e1e4ffe 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -19,7 +19,7 @@ module med_phases_prep_ocn_mod use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset - use esmFlds , only : fldListTo + use esmFlds , only : med_fldList_GetfldListTo use med_internalstate_mod , only : compocn, compatm, compice, coupling_mode use perf_mod , only : t_startf, t_stopf @@ -124,7 +124,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) is_local%wrap%FBExp(compocn), & is_local%wrap%FBFrac(compocn), & is_local%wrap%FBImp(:,compocn), & - fldListTo(compocn), & + med_fldList_GetfldListTo(compocn), & FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac' .or. & @@ -135,7 +135,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) is_local%wrap%FBExp(compocn), & is_local%wrap%FBFrac(compocn), & is_local%wrap%FBImp(:,compocn), & - fldListTo(compocn), rc=rc) + med_fldList_GetfldListTo(compocn), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 47430d685..a30d67c6f 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -94,7 +94,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) type(ESMF_Mesh) :: mesh_l type(ESMF_Mesh) :: mesh_r type(ESMF_Field) :: lfield - type(med_fldList_type), pointer :: fldListTo + type(med_fldList_type), pointer :: fldList character(len=CS), allocatable :: fldnames_temp(:) character(len=*),parameter :: subname=' (med_phases_prep_rof_init) ' !--------------------------------------- @@ -108,11 +108,11 @@ subroutine med_phases_prep_rof_init(gcomp, rc) ! Determine lnd2rof_flds (module variable) - note that fldListTo is set in esmFldsExchange_cesm.F90 ! Remove scalar field from lnd2rof_flds - fldListTo => med_fldList_GetfldlistTo(comprof) - nflds = med_fldlist_getnumflds(fldListTo) + fldList => med_fldList_GetfldlistTo(comprof) + nflds = med_fldlist_getnumflds(fldList) allocate(fldnames_temp(nflds)) do n = 1,nflds - call med_fldList_GetFldInfo(fldListTo, n, stdname=fldnames_temp(n)) + call med_fldList_GetFldInfo(fldList, n, stdname=fldnames_temp(n)) end do do n = 1,nflds if (trim(fldnames_temp(n)) == trim(is_local%wrap%flds_scalar_name)) then @@ -164,7 +164,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) ! Create packed mapping from rof->lnd call med_map_packed_field_create(destcomp=comprof, & flds_scalar_name=is_local%wrap%flds_scalar_name, & - fldsSrc=fldList, & + fieldsSrc=fldList, & FBSrc=FBLndAccum2rof_l, FBDst=FBLndAccum2rof_r, & packed_data=is_local%wrap%packed_data(complnd,comprof,:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -262,7 +262,7 @@ subroutine med_phases_prep_rof(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use esmFlds , only : fldListTo + use esmFlds , only : med_fldList_GetfldListTo use med_map_mod , only : med_map_field_packed use med_merge_mod , only : med_merge_auto use med_constants_mod , only : czero => med_constants_czero @@ -374,7 +374,7 @@ subroutine med_phases_prep_rof(gcomp, rc) end if call med_merge_auto(compsrc=complnd, FBout=is_local%wrap%FBExp(comprof), & - FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=fldListTo(comprof), rc=rc) + FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=med_fldList_GetfldListTo(comprof), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then