Skip to content

Commit

Permalink
compiles now
Browse files Browse the repository at this point in the history
  • Loading branch information
@jedwards4b
jedwards4b committed Nov 20, 2022
1 parent fbb8ef5 commit 69f31b8
Show file tree
Hide file tree
Showing 10 changed files with 98 additions and 59 deletions.
26 changes: 26 additions & 0 deletions mediator/esmFlds.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
!-----------------------------------------------
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
29 changes: 15 additions & 14 deletions mediator/esmFldsExchange_cesm_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
4 changes: 3 additions & 1 deletion mediator/esmFldsExchange_nems_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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:
Expand Down
35 changes: 20 additions & 15 deletions mediator/med.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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) '
!-----------------------------------------------------------
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -958,15 +962,15 @@ 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
endif
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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand Down
Loading

0 comments on commit 69f31b8

Please sign in to comment.