From 24522e3870f50f10fdfd880c0dcf3eebe5ffb2e5 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 24 Jun 2022 16:38:57 -0600 Subject: [PATCH 01/92] changes for lightning coupling new file: cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 modified: cime_config/namelist_definition_drv_flds.xml modified: mediator/esmFldsExchange_cesm_mod.F90 modified: mediator/fd_cesm.yaml --- .../shr_lightning_coupling_mod.F90 | 104 ++++++++++++++++++ cime_config/namelist_definition_drv_flds.xml | 15 ++- mediator/esmFldsExchange_cesm_mod.F90 | 13 +++ mediator/fd_cesm.yaml | 6 +- 4 files changed, 136 insertions(+), 2 deletions(-) create mode 100644 cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 diff --git a/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 new file mode 100644 index 000000000..dc8be2e5e --- /dev/null +++ b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 @@ -0,0 +1,104 @@ +module shr_lightning_coupling_mod + + !======================================================================== + ! Module for handling namelist variables related to lightning coupling + !======================================================================== + + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS + use shr_sys_mod , only : shr_sys_abort + use shr_log_mod , only : s_logunit => shr_log_Unit + use shr_nl_mod , only : shr_nl_find_group_name + use shr_mpi_mod , only : shr_mpi_bcast + + implicit none + private + + ! !PUBLIC MEMBER FUNCTIONS + public shr_lightning_coupling_readnl ! Read namelist + + character(len=*), parameter :: & + u_FILE_u=__FILE__ + + !==================================================================================== +CONTAINS + !==================================================================================== + + subroutine shr_lightning_coupling_readnl(NLFilename, atm_lightning_flash_out) + + !======================================================================== + ! reads lightning_coupling_nl namelist and returns a variable specifying + ! if atmosphere model provides lightning flash frequency field to mediator + !======================================================================== + + ! input/output variables + character(len=*), intent(in) :: NLFilename ! Namelist filename + logical, intent(out) :: atm_lightning_flash_out ! if TRUE atm will provide lightning flash frequency + + !----- local ----- + logical :: atm_lightning_flash_freq + type(ESMF_VM) :: vm + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + integer :: rc + integer :: localpet + integer :: mpicom + + character(len=*), parameter :: atm_ozone_frequency_not_present = 'NOT_PRESENT' + character(len=*), parameter :: subname = '(shr_lightning_coupling_readnl) ' + ! ------------------------------------------------------------------ + + namelist /lightning_coupling_nl/ atm_lightning_flash_freq + + rc = ESMF_SUCCESS + + !--- Open and read namelist --- + if ( len_trim(NLFilename) == 0 ) then + call shr_sys_abort( subname//'ERROR: nlfilename not set' ) + end if + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm, localPet=localpet, mpiCommunicator=mpicom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (localpet==0) then + ! ------------------------------------------------------------------------ + ! Set default values in case namelist file doesn't exist, lightning_coupling_nl group + ! doesn't exist within the file, or a given variable isn't present in the namelist + ! group in the file. + ! ------------------------------------------------------------------------ + atm_lightning_flash_freq = .false. + + ! ------------------------------------------------------------------------ + ! Read namelist file + ! ------------------------------------------------------------------------ + inquire( file=trim(NLFileName), exist=exists) + if ( exists ) then + open(newunit=unitn, file=trim(NLFilename), status='old' ) + write(s_logunit,'(a)') subname,'Read in lightning_coupling_nl namelist from: ', trim(NLFilename) + call shr_nl_find_group_name(unitn, 'lightning_coupling_nl', ierr) + if (ierr == 0) then + ! Note that ierr /= 0 means no namelist is present. + read(unitn, lightning_coupling_nl, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort(subname//'problem reading lightning_coupling_nl') + end if + end if + close( unitn ) + end if + + atm_lightning_flash_out = atm_lightning_flash_freq + + end if + + ! ------------------------------------------------------------------------ + ! Broadcast values to all processors + ! ------------------------------------------------------------------------ + call shr_mpi_bcast(atm_lightning_flash_out, mpicom) + + end subroutine shr_lightning_coupling_readnl + +end module shr_lightning_coupling_mod diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index b8d96bcd6..119921118 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -142,7 +142,7 @@ - + @@ -157,4 +157,17 @@ + + + + + + logical + lightning_coupling + lightning_coupling_nl + + If TRUE atmosphere model will provide prognosed lightning flash frequency. + + + diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index ae3627491..4b9d46dfc 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -399,6 +399,19 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if ! --------------------------------------------------------------------- + ! to lnd: lightning flash frequency from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_lght') + call addfld(fldListTo(complnd)%flds, 'Sa_lght') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_lght', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_lght', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_lght', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sa_lght', mrg_from=compatm, mrg_fld='Sa_lght', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to lnd: temperature at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 648a4fed2..b29e01b8d 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -325,6 +325,10 @@ canonical_units: mol/mol description: atmosphere export - O3 in the lowest model layer (prognosed or prescribed) # + - standard_name: Sa_lght + canonical_units: /min + description: atmosphere export - lightning flash freqency + # - standard_name: Sa_topo alias: inst_surface_height canonical_units: m @@ -745,7 +749,7 @@ description: sea-ice export - ice thickness # - standard_name: Si_floediam - canonical_units: m + canonical_units: m description: sea-ice export - ice floe diameter # #----------------------------------- From 62c15cd757e9312b68442a4c4aa0e21d7878cece Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Wed, 13 Jul 2022 15:46:50 -0600 Subject: [PATCH 02/92] Changed "atm_lightning_flash_freq" to "atm_provides_lightning" modified: cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 modified: cime_config/namelist_definition_drv_flds.xml --- .../nuopc_cap_share/shr_lightning_coupling_mod.F90 | 14 +++++++------- cime_config/namelist_definition_drv_flds.xml | 4 ++-- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 index dc8be2e5e..06effa52a 100644 --- a/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 +++ b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 @@ -24,7 +24,7 @@ module shr_lightning_coupling_mod CONTAINS !==================================================================================== - subroutine shr_lightning_coupling_readnl(NLFilename, atm_lightning_flash_out) + subroutine shr_lightning_coupling_readnl(NLFilename, atm_provides_lightning_out) !======================================================================== ! reads lightning_coupling_nl namelist and returns a variable specifying @@ -33,10 +33,10 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_lightning_flash_out) ! input/output variables character(len=*), intent(in) :: NLFilename ! Namelist filename - logical, intent(out) :: atm_lightning_flash_out ! if TRUE atm will provide lightning flash frequency + logical, intent(out) :: atm_provides_lightning_out ! if TRUE atm will provide lightning flash frequency !----- local ----- - logical :: atm_lightning_flash_freq + logical :: atm_provides_lightning type(ESMF_VM) :: vm integer :: unitn ! namelist unit number integer :: ierr ! error code @@ -49,7 +49,7 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_lightning_flash_out) character(len=*), parameter :: subname = '(shr_lightning_coupling_readnl) ' ! ------------------------------------------------------------------ - namelist /lightning_coupling_nl/ atm_lightning_flash_freq + namelist /lightning_coupling_nl/ atm_provides_lightning rc = ESMF_SUCCESS @@ -70,7 +70,7 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_lightning_flash_out) ! doesn't exist within the file, or a given variable isn't present in the namelist ! group in the file. ! ------------------------------------------------------------------------ - atm_lightning_flash_freq = .false. + atm_provides_lightning = .false. ! ------------------------------------------------------------------------ ! Read namelist file @@ -90,14 +90,14 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_lightning_flash_out) close( unitn ) end if - atm_lightning_flash_out = atm_lightning_flash_freq + atm_provides_lightning_out = atm_provides_lightning end if ! ------------------------------------------------------------------------ ! Broadcast values to all processors ! ------------------------------------------------------------------------ - call shr_mpi_bcast(atm_lightning_flash_out, mpicom) + call shr_mpi_bcast(atm_provides_lightning_out, mpicom) end subroutine shr_lightning_coupling_readnl diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index 119921118..7b33564da 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -161,12 +161,12 @@ - + logical lightning_coupling lightning_coupling_nl - If TRUE atmosphere model will provide prognosed lightning flash frequency. + If TRUE atmosphere model will provide prognosed lightning flash frequency (flashes per minute). From 6712c8c6eb94b212800b3f8c7f41ad123f297ae2 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 22 Jul 2022 15:20:17 -0600 Subject: [PATCH 03/92] rename Sa_lght as Sa_lightning modified: cime_config/namelist_definition_drv_flds.xml modified: mediator/esmFldsExchange_cesm_mod.F90 modified: mediator/fd_cesm.yaml --- cime_config/namelist_definition_drv_flds.xml | 2 +- mediator/esmFldsExchange_cesm_mod.F90 | 12 ++++++------ mediator/fd_cesm.yaml | 2 +- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index 7b33564da..03b6b7c6d 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -158,7 +158,7 @@ - + diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 4b9d46dfc..2c2a3e4bd 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -402,13 +402,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: lightning flash frequency from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_lght') - call addfld(fldListTo(complnd)%flds, 'Sa_lght') + call addfld(fldListFr(compatm)%flds, 'Sa_lightning') + call addfld(fldListTo(complnd)%flds, 'Sa_lightning') else - if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_lght', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_lght', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_lght', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_lght', mrg_from=compatm, mrg_fld='Sa_lght', mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_lightning', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_lightning', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Sa_lightning', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg(fldListTo(complnd)%flds, 'Sa_lightning', mrg_from=compatm, mrg_fld='Sa_lightning', mrg_type='copy') end if end if ! --------------------------------------------------------------------- diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index b29e01b8d..fcaeab358 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -325,7 +325,7 @@ canonical_units: mol/mol description: atmosphere export - O3 in the lowest model layer (prognosed or prescribed) # - - standard_name: Sa_lght + - standard_name: Sa_lightning canonical_units: /min description: atmosphere export - lightning flash freqency # From c8ed0186457a7249a484e8b6945d3ad145f2317d Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 2 Feb 2023 22:18:12 -0700 Subject: [PATCH 04/92] update to cmeps0.14.10 --- cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 | 6 +++--- mediator/esmFldsExchange_cesm_mod.F90 | 10 +++++----- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 index 06effa52a..e84ccc661 100644 --- a/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 +++ b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 @@ -7,7 +7,7 @@ module shr_lightning_coupling_mod use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS use shr_sys_mod , only : shr_sys_abort - use shr_log_mod , only : s_logunit => shr_log_Unit + use shr_log_mod , only : shr_log_getLogUnit use shr_nl_mod , only : shr_nl_find_group_name use shr_mpi_mod , only : shr_mpi_bcast @@ -44,7 +44,7 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_provides_lightning_out) integer :: rc integer :: localpet integer :: mpicom - + integer :: s_logunit character(len=*), parameter :: atm_ozone_frequency_not_present = 'NOT_PRESENT' character(len=*), parameter :: subname = '(shr_lightning_coupling_readnl) ' ! ------------------------------------------------------------------ @@ -57,7 +57,7 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_provides_lightning_out) if ( len_trim(NLFilename) == 0 ) then call shr_sys_abort( subname//'ERROR: nlfilename not set' ) end if - + call shr_log_getLogUnit(s_logunit) call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 2c2a3e4bd..ac9eef39a 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -399,16 +399,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if ! --------------------------------------------------------------------- - ! to lnd: lightning flash frequency from atm + ! to lnd: cld to grnd lightning flash freq ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Sa_lightning') - call addfld(fldListTo(complnd)%flds, 'Sa_lightning') + call addfld_from(compatm, 'Sa_lightning') + call addfld_to(complnd, 'Sa_lightning') else if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_lightning', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_lightning', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Sa_lightning', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg(fldListTo(complnd)%flds, 'Sa_lightning', mrg_from=compatm, mrg_fld='Sa_lightning', mrg_type='copy') + call addmap_from(compatm, 'Sa_lightning', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_lightning', mrg_from=compatm, mrg_fld='Sa_lightning', mrg_type='copy') end if end if ! --------------------------------------------------------------------- From ac4d591489f2a0039521faa138002d942a2c7e15 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 7 Apr 2023 11:40:17 -0600 Subject: [PATCH 05/92] use updated error check and broadcast methods modified: cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 --- .../shr_lightning_coupling_mod.F90 | 22 +++++++++++++------ 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 index e84ccc661..3b4e260d8 100644 --- a/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 +++ b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 @@ -5,11 +5,12 @@ module shr_lightning_coupling_mod !======================================================================== use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet - use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS + use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS + use ESMF , only : ESMF_VMBroadCast, ESMF_Logical, assignment(=) use shr_sys_mod , only : shr_sys_abort use shr_log_mod , only : shr_log_getLogUnit use shr_nl_mod , only : shr_nl_find_group_name - use shr_mpi_mod , only : shr_mpi_bcast + use nuopc_shr_methods, only : chkerr implicit none private @@ -41,6 +42,7 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_provides_lightning_out) integer :: unitn ! namelist unit number integer :: ierr ! error code logical :: exists ! if file exists or not + type(ESMF_Logical):: ltmp(1) integer :: rc integer :: localpet integer :: mpicom @@ -53,16 +55,19 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_provides_lightning_out) rc = ESMF_SUCCESS + atm_provides_lightning_out = .false. + ltmp(1) = .false. + !--- Open and read namelist --- if ( len_trim(NLFilename) == 0 ) then call shr_sys_abort( subname//'ERROR: nlfilename not set' ) end if call shr_log_getLogUnit(s_logunit) call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=localpet, mpiCommunicator=mpicom, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (localpet==0) then ! ------------------------------------------------------------------------ @@ -90,14 +95,17 @@ subroutine shr_lightning_coupling_readnl(NLFilename, atm_provides_lightning_out) close( unitn ) end if - atm_provides_lightning_out = atm_provides_lightning + ltmp(1) = atm_provides_lightning end if ! ------------------------------------------------------------------------ - ! Broadcast values to all processors + ! Broadcast values to all tasks ! ------------------------------------------------------------------------ - call shr_mpi_bcast(atm_provides_lightning_out, mpicom) + call ESMF_VMBroadcast(vm, ltmp, count=1, rootPet=0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + atm_provides_lightning_out = ltmp(1) end subroutine shr_lightning_coupling_readnl From 4cf3e05eb4505c6944b137948f9a93f17e96bc7a Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 12 Apr 2023 14:31:14 -0400 Subject: [PATCH 06/92] Added Fwxx_taux and Fwxx_tauy, based on Foxx_taux and Foxx_tauy --- mediator/esmFldsExchange_cesm_mod.F90 | 35 +++++++++++++++++++++++++++ mediator/fd_cesm.yaml | 19 +++++++++++++++ 2 files changed, 54 insertions(+) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 149c7791d..f53d9e38b 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2963,6 +2963,41 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compwav, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') end if end if +!PSH begin + ! --------------------------------------------------------------------- + ! to wav: zonal and meridional wind stress + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_to(compwav , 'Fwxx_taux') + call addfld_from(compice , 'Fioi_taux') + call addfld_aoflux('Faox_taux') + else + if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + call addmap_from(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + end if + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + if (phase == 'advertise') then + call addfld_to(compwav , 'Fwxx_tauy') + call addfld_from(compice , 'Fioi_tauy') + call addfld_aoflux('Faox_tauy') + else + if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_tauy', rc=rc)) then + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then + call addmap_from(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compwav, 'Fwxx_tauy', & + mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') + end if + call addmrg_to(compwav, 'Fwxx_tauy', & + mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') + end if + end if +!PSH end !===================================================================== ! FIELDS TO RIVER (comprof) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 648a4fed2..d6a281249 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1172,6 +1172,25 @@ canonical_units: m2/s description: wave elevation spectrum +#PSH begin + # + #----------------------------------- + # section: wave import + #----------------------------------- + # + + # + - standard_name: Fwxx_taux + alias: mean_zonal_moment_flx + canonical_units: N m-2 + description: wave import - zonal surface stress + # + - standard_name: Fwxx_tauy + alias: mean_merid_moment_flx + canonical_units: N m-2 + description: wave import - meridional surface stress +#PSH end + #----------------------------------- # mediator fields #----------------------------------- From e68d9bc49bf080e36272944db49ac196ba0bf4f2 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 14 Apr 2023 13:14:41 -0400 Subject: [PATCH 07/92] Trying simpler form of sharing Foxx to compwav --- mediator/esmFldsExchange_cesm_mod.F90 | 56 +++++++++++++-------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index f53d9e38b..a9e556de6 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2968,34 +2968,34 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld_to(compwav , 'Fwxx_taux') - call addfld_from(compice , 'Fioi_taux') - call addfld_aoflux('Faox_taux') - else - if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then - if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - call addmap_from(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - end if - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - if (phase == 'advertise') then - call addfld_to(compwav , 'Fwxx_tauy') - call addfld_from(compice , 'Fioi_tauy') - call addfld_aoflux('Faox_tauy') - else - if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_tauy', rc=rc)) then - if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then - call addmap_from(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compwav, 'Fwxx_tauy', & - mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') - end if - call addmrg_to(compwav, 'Fwxx_tauy', & - mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') - end if + call addfld_to(compwav , 'Foxx_taux') +! call addfld_from(compice , 'Fioi_taux') +! call addfld_aoflux('Faox_taux') +! else +! if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_taux', rc=rc)) then +! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then +! call addmap_from(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') +! call addmrg_to(compwav, 'Foxx_taux', & +! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') +! end if +! call addmrg_to(compwav, 'Foxx_taux', & +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') +! end if + end if + if (phase == 'advertise') then + call addfld_to(compwav , 'Foxx_tauy') +! call addfld_from(compice , 'Fioi_tauy') +! call addfld_aoflux('Faox_tauy') +! else +! if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_tauy', rc=rc)) then +! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then +! call addmap_from(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') +! call addmrg_to(compwav, 'Fwxx_tauy', & +! mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') +! end if +! call addmrg_to(compwav, 'Fwxx_tauy', & +! mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') +! end if end if !PSH end From eb186945b14c3dba06c5056dd9f605dcb3aca7b6 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 14 Apr 2023 18:06:53 -0400 Subject: [PATCH 08/92] Turning off Foxx export to waves for testing --- mediator/esmFldsExchange_cesm_mod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index a9e556de6..881235573 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2967,8 +2967,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_to(compwav , 'Foxx_taux') +! if (phase == 'advertise') then +! call addfld_to(compwav , 'Foxx_taux') ! call addfld_from(compice , 'Fioi_taux') ! call addfld_aoflux('Faox_taux') ! else @@ -2981,9 +2981,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! call addmrg_to(compwav, 'Foxx_taux', & ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') ! end if - end if - if (phase == 'advertise') then - call addfld_to(compwav , 'Foxx_tauy') +! end if +! if (phase == 'advertise') then +! call addfld_to(compwav , 'Foxx_tauy') ! call addfld_from(compice , 'Fioi_tauy') ! call addfld_aoflux('Faox_tauy') ! else @@ -2996,7 +2996,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! call addmrg_to(compwav, 'Fwxx_tauy', & ! mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') ! end if - end if +! end if !PSH end !===================================================================== From c791efc7d85c130d1001af6f2f0db4ee5de12cf8 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Mon, 17 Apr 2023 12:25:07 -0400 Subject: [PATCH 09/92] Adding Fwxx_taux to get wind stress to pass to wave model --- mediator/esmFldsExchange_cesm_mod.F90 | 15 +++++++++++++++ mediator/fd_cesm.yaml | 10 +++++----- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 881235573..4ee196f5a 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2967,6 +2967,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_to(compwav , 'Fwxx_taux') + call addfld_from(compice , 'Fioi_taux') + call addfld_aoflux('Faox_taux') + else + if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + end if + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + end if + end if ! if (phase == 'advertise') then ! call addfld_to(compwav , 'Foxx_taux') ! call addfld_from(compice , 'Fioi_taux') diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index d6a281249..9d2d873bc 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1179,16 +1179,16 @@ #----------------------------------- # - # + # - standard_name: Fwxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 description: wave import - zonal surface stress # - - standard_name: Fwxx_tauy - alias: mean_merid_moment_flx - canonical_units: N m-2 - description: wave import - meridional surface stress +# - standard_name: Fwxx_tauy +# alias: mean_merid_moment_flx +# canonical_units: N m-2 +# description: wave import - meridional surface stress #PSH end #----------------------------------- From 8db24496210078ea9584aa970e731d5d2cd3eab8 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Mon, 17 Apr 2023 14:00:36 -0400 Subject: [PATCH 10/92] Adding Fwxx_taux, using Foxx_taux as a model --- mediator/med_phases_prep_wav_mod.F90 | 44 ++++++++++++++++++++++------ 1 file changed, 35 insertions(+), 9 deletions(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 4fdd630ea..578b2837f 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -13,12 +13,20 @@ module med_phases_prep_wav_mod use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose +!PSH begin + use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk + use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr +!PSH end use med_methods_mod , only : FB_accum => med_methods_FB_accum 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 : med_fldList_GetfldListTo - use med_internalstate_mod , only : compwav +!PSH begin +! use esmFlds , only : med_fldList_GetfldListTo +! use med_internalstate_mod , only : compwav + use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type + use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode +!PSH end use perf_mod , only : t_startf, t_stopf implicit none @@ -28,6 +36,10 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_accum ! called from run sequence public :: med_phases_prep_wav_avg ! called from run sequence +!PSH begin + private :: med_phases_prep_ocn_custom_cesm +!PSH end + character(*), parameter :: u_FILE_u = & __FILE__ @@ -82,6 +94,9 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n, ncnt +!PSH begin + type(med_fldlist_type), pointer :: fldList +!PSH end character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -96,14 +111,25 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - +!PSH begin + fldList => med_fldList_GetfldListTo(compwav) +!PSH end ! auto merges to wav - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compwav), & - is_local%wrap%FBExp(compwav), & - is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), & - med_fldList_GetfldListTo(compwav), rc=rc) +!PSH begin +! call med_merge_auto(& +! is_local%wrap%med_coupling_active(:,compwav), & +! is_local%wrap%FBExp(compwav), & +! is_local%wrap%FBFrac(compwav), & +! is_local%wrap%FBImp(:,compwav), & +! med_fldList_GetfldListTo(compwav), rc=rc) + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compwav), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + fldList, & + FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) +!PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return ! wave accumulator From a599c2f9844d1d6adf4a54e8a701756d08b0e0d9 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Mon, 17 Apr 2023 14:27:20 -0400 Subject: [PATCH 11/92] Comment out unnecessary line --- mediator/med_phases_prep_wav_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 578b2837f..3a99f295f 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -37,7 +37,7 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_avg ! called from run sequence !PSH begin - private :: med_phases_prep_ocn_custom_cesm +! private :: med_phases_prep_wav_custom_cesm !PSH end character(*), parameter :: u_FILE_u = & From 61cf3780a49850529e2882715cf147f1f24707bd Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 19 Apr 2023 09:50:24 -0600 Subject: [PATCH 12/92] fix issue with xgrid reproducibility --- mediator/med_phases_aofluxes_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 0b3d10901..9fbc472be 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -768,6 +768,7 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: xch_mesh real(r8), pointer :: dataptr(:) integer :: fieldcount + integer :: stp ! srcTermProcessing is declared inout and must have variable not constant type(ESMF_CoordSys_Flag) :: coordSys real(ESMF_KIND_R8) ,allocatable :: garea(:) character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' @@ -870,11 +871,12 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (trim(coupling_mode) == 'cesm') then + stp = 1 call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_bilinr, & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), rc=rc) + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_patch, & - regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), rc=rc) + regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if From f126b9f1c33dc8421a5520289ab3e515a4cd153c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 19 Apr 2023 16:32:24 -0600 Subject: [PATCH 13/92] update the minimum esmf version requirement --- cime_config/buildnml | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 6b76da004..9d06b0cae 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -620,14 +620,7 @@ def buildnml(case, caseroot, component): major = line[-2] if "MAJOR" in line else major minor = line[-2] if "MINOR" in line else minor logger.debug("ESMF version major {} minor {}".format(major, minor)) - expect(int(major) >= 8, "ESMF version should be 8.1 or newer") - if esmf_aware_threading: - expect( - int(minor) >= 2, - "ESMF version should be 8.2.0 or newer when using ESMF_AWARE_THREADING", - ) - else: - expect(int(minor) >= 1, "ESMF version should be 8.1.0 or newer") + expect(int(major) >= 8 and int(minor) >=4, "ESMF version should be 8.4.1 or newer") confdir = os.path.join(case.get_value("CASEBUILD"), "cplconf") if not os.path.isdir(confdir): From 263bebed62622f7bf9e115f5f51524471be7eadd Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 25 Apr 2023 11:31:35 +0200 Subject: [PATCH 14/92] added wav/ice coupling --- cime_config/buildnml | 8 ++------ cime_config/config_component_cesm.xml | 8 ++++++++ cime_config/namelist_definition_drv.xml | 5 ++++- mediator/esmFldsExchange_cesm_mod.F90 | 12 ++++++------ 4 files changed, 20 insertions(+), 13 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index fd5d73df0..e29d3eee6 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -101,17 +101,13 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): elif case.get_value('RUN_TYPE') == 'branch': config['run_type'] = 'branch' + config['wav_ice_coupling'] = config['COMP_WAV'] == 'ww3dev' and config['COMP_ICE'] == 'cice' + #---------------------------------------------------- # Initialize namelist defaults #---------------------------------------------------- nmlgen.init_defaults(infile, config, skip_default_for_groups=["modelio"]) - #-------------------------------- - # Set default wav-ice coupling (assumes cice6 as the ice component - #-------------------------------- - if (case.get_value("COMP_WAV") == 'ww3dev' and case.get_value("COMP_ICE") == 'cice'): - nmlgen.add_default('wavice_coupling', value='.true.') - #-------------------------------- # Overwrite: set brnch_retain_casename #-------------------------------- diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index cfcdc12ef..c1894ec4e 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -108,12 +108,15 @@ CO2A none CO2A + CO2A CO2A CO2A CO2A CO2A CO2C CO2C + CO2A + CO2A run_coupling env_run.xml @@ -232,6 +235,11 @@ 1 + + + + 24 + 48 run_coupling env_run.xml diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index e35ff537d..6f01cbe62 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2270,6 +2270,7 @@ 4 + 4 0 @@ -3798,7 +3799,7 @@ - + logical expdef ALLCOMP_attributes @@ -3807,6 +3808,8 @@ .false. + + diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 149c7791d..20509ed47 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -98,16 +98,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) integer :: n, ns character(len=CL) :: cvalue character(len=CS) :: name - logical :: wavice_coupling + logical :: wav_coupling_to_cice logical :: ocn2glc_coupling character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' !-------------------------------------- rc = ESMF_SUCCESS - call NUOPC_CompAttributeGet(gcomp, name='wavice_coupling', value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='wav_coupling_to_cice', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) wavice_coupling + read(cvalue,*) wav_coupling_to_cice call NUOPC_CompAttributeGet(gcomp, name='ocn2glc_coupling', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2809,7 +2809,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ice: wave elevation spectrum (field with ungridded dimensions) ! --------------------------------------------------------------------- - if (wavice_coupling) then + if (wav_coupling_to_cice) then if (phase == 'advertise') then call addfld_from(compwav, 'Sw_elevation_spectrum') call addfld_to(compice, 'Sw_elevation_spectrum') @@ -2844,7 +2844,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- ! to wav: ice thickness from ice !---------------------------------------------------------- - if (wavice_coupling) then + if (wav_coupling_to_cice) then if (phase == 'advertise') then call addfld_from(compice, 'Si_thick') call addfld_to(compwav, 'Si_thick') @@ -2859,7 +2859,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- ! to wav: ice floe diameter from ice !---------------------------------------------------------- - if (wavice_coupling) then + if (wav_coupling_to_cice) then if (phase == 'advertise') then call addfld_from(compice, 'Si_floediam') call addfld_to(compwav, 'Si_floediam') From 17fa9d5a97395d323b21675b7829b237f3f4a51c Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 10:37:02 -0400 Subject: [PATCH 15/92] Adding custom field subroutine for waves with cesm, based on equivalent routine for ocn component --- mediator/med_phases_prep_wav_mod.F90 | 307 ++++++++++++++++++++++++++- 1 file changed, 306 insertions(+), 1 deletion(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 3a99f295f..fa6e6617e 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -37,7 +37,7 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_avg ! called from run sequence !PSH begin -! private :: med_phases_prep_wav_custom_cesm + private :: med_phases_prep_wav_custom_cesm !PSH end character(*), parameter :: u_FILE_u = & @@ -131,6 +131,13 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) !PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return +!PSH begin + ! custom merges to ocean + if (trim(coupling_mode) == 'cesm') then + call med_phases_prep_wav_custom_cesm(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if +!PSH end ! wave accumulator call FB_accum(is_local%wrap%FBExpAccumWav, is_local%wrap%FBExp(compwav), rc=rc) @@ -216,4 +223,302 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_prep_wav_avg + !----------------------------------------------------------------------------- + subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) + + !--------------------------------------- + ! custom calculations for cesm + !--------------------------------------- + + use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_VMBroadCast + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_Field) :: lfield + real(R8), pointer :: ifrac(:) + real(R8), pointer :: ofrac(:) + real(R8), pointer :: ifracr(:) + real(R8), pointer :: ofracr(:) + real(R8), pointer :: avsdr(:) + real(R8), pointer :: avsdf(:) + real(R8), pointer :: anidr(:) + real(R8), pointer :: anidf(:) + real(R8), pointer :: Faxa_swvdf(:) + real(R8), pointer :: Faxa_swndf(:) + real(R8), pointer :: Faxa_swvdr(:) + real(R8), pointer :: Faxa_swndr(:) + real(R8), pointer :: Foxx_swnet(:) + real(R8), pointer :: Foxx_swnet_afracr(:) + real(R8), pointer :: Foxx_swnet_vdr(:) + real(R8), pointer :: Foxx_swnet_vdf(:) + real(R8), pointer :: Foxx_swnet_idr(:) + real(R8), pointer :: Foxx_swnet_idf(:) + real(R8), pointer :: Fioi_swpen_vdr(:) + real(R8), pointer :: Fioi_swpen_vdf(:) + real(R8), pointer :: Fioi_swpen_idr(:) + real(R8), pointer :: Fioi_swpen_idf(:) + real(R8), pointer :: Fioi_swpen(:) + real(R8), pointer :: dataptr(:) + real(R8), pointer :: dataptr_scalar_ocn(:,:) + real(R8) :: frac_sum + real(R8) :: ifrac_scaled, ofrac_scaled + real(R8) :: ifracr_scaled, ofracr_scaled + logical :: export_swnet_by_bands + logical :: import_swpen_by_bands + logical :: export_swnet_afracr + real(R8) :: precip_fact(1) + character(CS) :: cvalue + real(R8) :: fswabsv, fswabsi + integer :: scalar_id + integer :: n + integer :: lsize + real(R8) :: c1,c2,c3,c4 + character(len=64), allocatable :: fldnames(:) + character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if + call memcheck(subname, 5, mastertask) + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + +! !--------------------------------------- +! ! Compute netsw for ocean +! !--------------------------------------- +! ! netsw_for_ocn = downsw_from_atm * (1-ocn_albedo) * (1-ice_fraction) + pensw_from_ice * (ice_fraction) +! +! ! Input from atm +! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdr', Faxa_swvdr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndr', Faxa_swndr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdf', Faxa_swvdf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndf', Faxa_swndf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! lsize = size(Faxa_swvdr) +! +! ! Input from mediator, ocean albedos +! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdr' , avsdr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidr' , anidr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdf' , avsdf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidf' , anidf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! +! ! Output to ocean swnet total +! if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet', Foxx_swnet, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! else +! lsize = size(Faxa_swvdr) +! allocate(Foxx_swnet(lsize)) +! end if +! +! ! Output to ocean swnet by radiation bands +! if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc)) then +! export_swnet_by_bands = .true. +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', Foxx_swnet_vdr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', Foxx_swnet_vdf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', Foxx_swnet_idr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', Foxx_swnet_idf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! else +! export_swnet_by_bands = .false. +! end if +! +! ! ----------------------- +! ! If cice IS NOT PRESENT +! ! ----------------------- +! if (.not. is_local%wrap%comp_present(compice)) then +! ! Compute total swnet to ocean independent of swpen from sea-ice +! do n = 1,lsize +! fswabsv = Faxa_swvdr(n) * (1.0_R8 - avsdr(n)) + Faxa_swvdf(n) * (1.0_R8 - avsdf(n)) +! fswabsi = Faxa_swndr(n) * (1.0_R8 - anidr(n)) + Faxa_swndf(n) * (1.0_R8 - anidf(n)) +! Foxx_swnet(n) = fswabsv + fswabsi +! end do +! ! Compute sw export to ocean bands if required +! if (export_swnet_by_bands) then +! c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 +! Foxx_swnet_vdr(:) = c1 * Foxx_swnet(:) +! Foxx_swnet_vdf(:) = c2 * Foxx_swnet(:) +! Foxx_swnet_idr(:) = c3 * Foxx_swnet(:) +! Foxx_swnet_idf(:) = c4 * Foxx_swnet(:) +! end if +! end if +! +! ! ----------------------- +! ! If cice IS PRESENT +! ! ----------------------- +! if (is_local%wrap%comp_present(compice)) then +! +! ! Input from mediator, ice-covered ocean and open ocean fractions +! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrac' , ifrac, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrad' , ifracr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrad' , ofracr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! +! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! if (FB_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc)) then +! import_swpen_by_bands = .true. +! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdr', Fioi_swpen_vdr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdf', Fioi_swpen_vdf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idr', Fioi_swpen_idr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idf', Fioi_swpen_idf, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! else +! import_swpen_by_bands = .false. +! end if +! +! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr',rc=rc)) then +! ! Swnet without swpen from sea-ice +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr', Foxx_swnet_afracr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! export_swnet_afracr = .true. +! else +! export_swnet_afracr = .false. +! end if +! +! do n = 1,lsize +! ! Compute total swnet to ocean independent of swpen from sea-ice +! fswabsv = Faxa_swvdr(n) * (1.0_R8 - avsdr(n)) + Faxa_swvdf(n) * (1.0_R8 - avsdf(n)) +! fswabsi = Faxa_swndr(n) * (1.0_R8 - anidr(n)) + Faxa_swndf(n) * (1.0_R8 - anidf(n)) +! Foxx_swnet(n) = fswabsv + fswabsi +! +! ! Add swpen from sea ice +! ifrac_scaled = ifrac(n) +! ofrac_scaled = ofrac(n) +! frac_sum = ifrac(n) + ofrac(n) +! if (frac_sum /= 0._R8) then +! ifrac_scaled = ifrac(n) / (frac_sum) +! ofrac_scaled = ofrac(n) / (frac_sum) +! endif +! ifracr_scaled = ifracr(n) +! ofracr_scaled = ofracr(n) +! frac_sum = ifracr(n) + ofracr(n) +! if (frac_sum /= 0._R8) then +! ifracr_scaled = ifracr(n) / (frac_sum) +! ofracr_scaled = ofracr(n) / (frac_sum) +! endif +! Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) +! +! if (export_swnet_afracr) then +! Foxx_swnet_afracr(n) = ofracr_scaled*(fswabsv + fswabsi) +! end if +! +! ! Compute sw export to ocean bands if required +! if (export_swnet_by_bands) then +! if (import_swpen_by_bands) then +! ! use each individual band for swpen coming from the sea-ice +! Foxx_swnet_vdr(n) = Faxa_swvdr(n)*(1.0_R8-avsdr(n))*ofracr_scaled + Fioi_swpen_vdr(n)*ifrac_scaled +! Foxx_swnet_vdf(n) = Faxa_swvdf(n)*(1.0_R8-avsdf(n))*ofracr_scaled + Fioi_swpen_vdf(n)*ifrac_scaled +! Foxx_swnet_idr(n) = Faxa_swndr(n)*(1.0_R8-anidr(n))*ofracr_scaled + Fioi_swpen_idr(n)*ifrac_scaled +! Foxx_swnet_idf(n) = Faxa_swndf(n)*(1.0_R8-anidf(n))*ofracr_scaled + Fioi_swpen_idf(n)*ifrac_scaled +! else +! ! scale total Foxx_swnet to get contributions from each band +! c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 +! Foxx_swnet_vdr(n) = c1 * Foxx_swnet(n) +! Foxx_swnet_vdf(n) = c2 * Foxx_swnet(n) +! Foxx_swnet_idr(n) = c3 * Foxx_swnet(n) +! Foxx_swnet_idf(n) = c4 * Foxx_swnet(n) +! end if +! end if +! end do +! +! ! Output to ocean per ice thickness fraction and sw penetrating into ocean +! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afrac', rc=rc)) then +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afrac', fldptr1=dataptr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! dataptr(:) = ofrac(:) +! end if +! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afracr', rc=rc)) then +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afracr', fldptr1=dataptr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! dataptr(:) = ofracr(:) +! end if +! +! end if ! if sea-ice is present +! +! ! Deallocate Foxx_swnet if it was allocated in this subroutine +! if (.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then +! deallocate(Foxx_swnet) +! end if +! +! ! Apply precipitation factor from ocean (that scales atm rain and snow back to ocn ) if appropriate +! if (trim(coupling_mode) == 'cesm' .and. is_local%wrap%flds_scalar_index_precip_factor /= 0) then +! +! ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor +! ! is initialized to 0. +! ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, +! ! it is set to 0. +! if (mastertask) then +! call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & +! itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! call ESMF_FieldGet(lfield, farrayPtr=dataptr_scalar_ocn, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! scalar_id=is_local%wrap%flds_scalar_index_precip_factor +! precip_fact(1) = dataptr_scalar_ocn(scalar_id,1) +! if (precip_fact(1) /= 1._r8) then +! write(logunit,'(a,f21.13)')& +! '(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by non-unity precip_fact ',& +! precip_fact(1) +! end if +! end if +! call ESMF_VMBroadCast(is_local%wrap%vm, precip_fact, 1, 0, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! is_local%wrap%flds_scalar_precip_factor = precip_fact(1) +! if (dbug_flag > 5) then +! write(cvalue,*) precip_fact(1) +! call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) +! end if +! +! ! Scale rain and snow to ocn from atm by the precipitation factor received from the ocean +! allocate(fldnames(4)) +! fldnames = (/'Faxa_rain', 'Faxa_snow', 'Foxx_rofl', 'Foxx_rofi'/) +! do n = 1,size(fldnames) +! if (FB_fldchk(is_local%wrap%FBExp(compocn), trim(fldnames(n)), rc=rc)) then +! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), trim(fldnames(n)) , dataptr, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! dataptr(:) = dataptr(:) * is_local%wrap%flds_scalar_precip_factor +! end if +! end do +! deallocate(fldnames) +! end if +! +! if (dbug_flag > 20) then +! call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) +! end if +! call t_stopf('MED:'//subname) +! + end subroutine med_phases_prep_wav_custom_cesm + end module med_phases_prep_wav_mod From 5712122b396bde5d742d0402fd2823e369b7ee24 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 13:04:35 -0400 Subject: [PATCH 16/92] Passing So_ofrac to wav component --- mediator/esmFldsExchange_cesm_mod.F90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 4ee196f5a..566040563 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2964,6 +2964,22 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !PSH begin + if (phase == 'advertise') then + call addfld_from(compocn, 'So_ofrac') + call addfld_to(compwav, 'So_ofrac') + end if +! if (phase == 'advertise') then +! call addfld_from(compocn, 'So_ofrac') +! call addfld_to(compwav, 'So_ofrac') +! else +! if ( fldchk(is_local%wrap%FBexp(compwav) , 'So_ofrac', rc=rc) .and. & +! fldchk(is_local%wrap%FBImp(compice,compice ), 'So_ofrac', rc=rc)) then +! ! By default will be using a custom map - but if one is not available, use a generated bilinear instead +! call addmap_from(compice, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) +! call addmrg_to(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') +! end if +! end if + ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- From e6451a48903d5a1588a4b6e1e5288138e805992d Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 14:19:14 -0400 Subject: [PATCH 17/92] Changing merge to Fwxx_taux to copy --- mediator/esmFldsExchange_cesm_mod.F90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 566040563..897e942a3 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2985,17 +2985,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') - call addfld_from(compice , 'Fioi_taux') +! call addfld_from(compice , 'Fioi_taux') call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then - if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - end if +! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then +! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') +! call addmrg_to(compwav, 'Fwxx_taux', & +! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') +! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='copy') +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if ! if (phase == 'advertise') then From bdd726adc35eefc4cc26bf6185857fdaca004a1b Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 15:24:45 -0400 Subject: [PATCH 18/92] Fixed syntax of addmrg_to call for Fwxx_taux --- mediator/esmFldsExchange_cesm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 897e942a3..42bb327ee 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2995,7 +2995,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') ! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='copy') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if From dec4bfb7c43dfb43f46e6a41592b04aa25640b10 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 16:47:24 -0400 Subject: [PATCH 19/92] Reverted earlier modifications --- mediator/med_phases_prep_wav_mod.F90 | 202 +++++++++++++-------------- 1 file changed, 101 insertions(+), 101 deletions(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index fa6e6617e..eb89bde22 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -14,18 +14,18 @@ module med_phases_prep_wav_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose !PSH begin - use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk - use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr +! use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk +! use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr !PSH end use med_methods_mod , only : FB_accum => med_methods_FB_accum 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 !PSH begin -! use esmFlds , only : med_fldList_GetfldListTo -! use med_internalstate_mod , only : compwav - use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type - use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode + use esmFlds , only : med_fldList_GetfldListTo + use med_internalstate_mod , only : compwav +! use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type +! use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode !PSH end use perf_mod , only : t_startf, t_stopf @@ -37,7 +37,7 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_avg ! called from run sequence !PSH begin - private :: med_phases_prep_wav_custom_cesm +! private :: med_phases_prep_wav_custom_cesm !PSH end character(*), parameter :: u_FILE_u = & @@ -95,7 +95,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) type(InternalState) :: is_local integer :: n, ncnt !PSH begin - type(med_fldlist_type), pointer :: fldList +! type(med_fldlist_type), pointer :: fldList !PSH end character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -112,31 +112,31 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin - fldList => med_fldList_GetfldListTo(compwav) +! fldList => med_fldList_GetfldListTo(compwav) !PSH end ! auto merges to wav !PSH begin -! call med_merge_auto(& -! is_local%wrap%med_coupling_active(:,compwav), & -! is_local%wrap%FBExp(compwav), & -! is_local%wrap%FBFrac(compwav), & -! is_local%wrap%FBImp(:,compwav), & -! med_fldList_GetfldListTo(compwav), rc=rc) - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compwav), & - is_local%wrap%FBExp(compwav), & - is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), & - fldList, & - FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compwav), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + med_fldList_GetfldListTo(compwav), rc=rc) +! call med_merge_auto(& +! is_local%wrap%med_coupling_active(:,compwav), & +! is_local%wrap%FBExp(compwav), & +! is_local%wrap%FBFrac(compwav), & +! is_local%wrap%FBImp(:,compwav), & +! fldList, & +! FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) !PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin - ! custom merges to ocean - if (trim(coupling_mode) == 'cesm') then - call med_phases_prep_wav_custom_cesm(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if +! ! custom merges to ocean +! if (trim(coupling_mode) == 'cesm') then +! call med_phases_prep_wav_custom_cesm(gcomp, rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if !PSH end ! wave accumulator @@ -224,79 +224,79 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) end subroutine med_phases_prep_wav_avg !----------------------------------------------------------------------------- - subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) - - !--------------------------------------- - ! custom calculations for cesm - !--------------------------------------- - - use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_VMBroadCast - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(InternalState) :: is_local - type(ESMF_Field) :: lfield - real(R8), pointer :: ifrac(:) - real(R8), pointer :: ofrac(:) - real(R8), pointer :: ifracr(:) - real(R8), pointer :: ofracr(:) - real(R8), pointer :: avsdr(:) - real(R8), pointer :: avsdf(:) - real(R8), pointer :: anidr(:) - real(R8), pointer :: anidf(:) - real(R8), pointer :: Faxa_swvdf(:) - real(R8), pointer :: Faxa_swndf(:) - real(R8), pointer :: Faxa_swvdr(:) - real(R8), pointer :: Faxa_swndr(:) - real(R8), pointer :: Foxx_swnet(:) - real(R8), pointer :: Foxx_swnet_afracr(:) - real(R8), pointer :: Foxx_swnet_vdr(:) - real(R8), pointer :: Foxx_swnet_vdf(:) - real(R8), pointer :: Foxx_swnet_idr(:) - real(R8), pointer :: Foxx_swnet_idf(:) - real(R8), pointer :: Fioi_swpen_vdr(:) - real(R8), pointer :: Fioi_swpen_vdf(:) - real(R8), pointer :: Fioi_swpen_idr(:) - real(R8), pointer :: Fioi_swpen_idf(:) - real(R8), pointer :: Fioi_swpen(:) - real(R8), pointer :: dataptr(:) - real(R8), pointer :: dataptr_scalar_ocn(:,:) - real(R8) :: frac_sum - real(R8) :: ifrac_scaled, ofrac_scaled - real(R8) :: ifracr_scaled, ofracr_scaled - logical :: export_swnet_by_bands - logical :: import_swpen_by_bands - logical :: export_swnet_afracr - real(R8) :: precip_fact(1) - character(CS) :: cvalue - real(R8) :: fswabsv, fswabsi - integer :: scalar_id - integer :: n - integer :: lsize - real(R8) :: c1,c2,c3,c4 - character(len=64), allocatable :: fldnames(:) - character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' - !--------------------------------------- - - rc = ESMF_SUCCESS - - call t_startf('MED:'//subname) - if (dbug_flag > 20) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - end if - call memcheck(subname, 5, mastertask) - - ! Get the internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - +! subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) +! +! !--------------------------------------- +! ! custom calculations for cesm +! !--------------------------------------- +! +! use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet +! use ESMF , only : ESMF_VMBroadCast +! use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS +! use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR +! +! ! input/output variables +! type(ESMF_GridComp) :: gcomp +! integer, intent(out) :: rc +! +! ! local variables +! type(InternalState) :: is_local +! type(ESMF_Field) :: lfield +! real(R8), pointer :: ifrac(:) +! real(R8), pointer :: ofrac(:) +! real(R8), pointer :: ifracr(:) +! real(R8), pointer :: ofracr(:) +! real(R8), pointer :: avsdr(:) +! real(R8), pointer :: avsdf(:) +! real(R8), pointer :: anidr(:) +! real(R8), pointer :: anidf(:) +! real(R8), pointer :: Faxa_swvdf(:) +! real(R8), pointer :: Faxa_swndf(:) +! real(R8), pointer :: Faxa_swvdr(:) +! real(R8), pointer :: Faxa_swndr(:) +! real(R8), pointer :: Foxx_swnet(:) +! real(R8), pointer :: Foxx_swnet_afracr(:) +! real(R8), pointer :: Foxx_swnet_vdr(:) +! real(R8), pointer :: Foxx_swnet_vdf(:) +! real(R8), pointer :: Foxx_swnet_idr(:) +! real(R8), pointer :: Foxx_swnet_idf(:) +! real(R8), pointer :: Fioi_swpen_vdr(:) +! real(R8), pointer :: Fioi_swpen_vdf(:) +! real(R8), pointer :: Fioi_swpen_idr(:) +! real(R8), pointer :: Fioi_swpen_idf(:) +! real(R8), pointer :: Fioi_swpen(:) +! real(R8), pointer :: dataptr(:) +! real(R8), pointer :: dataptr_scalar_ocn(:,:) +! real(R8) :: frac_sum +! real(R8) :: ifrac_scaled, ofrac_scaled +! real(R8) :: ifracr_scaled, ofracr_scaled +! logical :: export_swnet_by_bands +! logical :: import_swpen_by_bands +! logical :: export_swnet_afracr +! real(R8) :: precip_fact(1) +! character(CS) :: cvalue +! real(R8) :: fswabsv, fswabsi +! integer :: scalar_id +! integer :: n +! integer :: lsize +! real(R8) :: c1,c2,c3,c4 +! character(len=64), allocatable :: fldnames(:) +! character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' +! !--------------------------------------- +! +! rc = ESMF_SUCCESS +! +! call t_startf('MED:'//subname) +! if (dbug_flag > 20) then +! call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) +! end if +! call memcheck(subname, 5, mastertask) +! +! ! Get the internal state +! nullify(is_local%wrap) +! call ESMF_GridCompGetInternalState(gcomp, is_local, rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! ! !--------------------------------------- ! ! Compute netsw for ocean ! !--------------------------------------- @@ -519,6 +519,6 @@ subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) ! end if ! call t_stopf('MED:'//subname) ! - end subroutine med_phases_prep_wav_custom_cesm +! end subroutine med_phases_prep_wav_custom_cesm end module med_phases_prep_wav_mod From d4b84412a4589038fa65b0aca9c555823676ab06 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 17:53:47 -0400 Subject: [PATCH 20/92] Substituting Foxx_taux for Faox_taux --- mediator/esmFldsExchange_cesm_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 42bb327ee..bf8fe952e 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2986,7 +2986,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') ! call addfld_from(compice , 'Fioi_taux') - call addfld_aoflux('Faox_taux') + call addfld_from(compocn, 'Foxx_taux') +! call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then ! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then @@ -2995,7 +2996,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') ! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') + mrg_from=compocn, mrg_fld='Foxx_taux', mrg_type='copy') +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if From d666f8340d473f956c41c641bd4b7cbfbb1ace53 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 23:31:25 -0400 Subject: [PATCH 21/92] Revert "Substituting Foxx_taux for Faox_taux" This reverts commit d4b84412a4589038fa65b0aca9c555823676ab06. --- mediator/esmFldsExchange_cesm_mod.F90 | 6 +- mediator/med_phases_prep_wav_mod.F90 | 202 +++++++++++++------------- 2 files changed, 103 insertions(+), 105 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index bf8fe952e..42bb327ee 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2986,8 +2986,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') ! call addfld_from(compice , 'Fioi_taux') - call addfld_from(compocn, 'Foxx_taux') -! call addfld_aoflux('Faox_taux') + call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then ! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then @@ -2996,8 +2995,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') ! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compocn, mrg_fld='Foxx_taux', mrg_type='copy') -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index eb89bde22..fa6e6617e 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -14,18 +14,18 @@ module med_phases_prep_wav_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose !PSH begin -! use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk -! use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr + use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk + use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr !PSH end use med_methods_mod , only : FB_accum => med_methods_FB_accum 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 !PSH begin - use esmFlds , only : med_fldList_GetfldListTo - use med_internalstate_mod , only : compwav -! use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type -! use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode +! use esmFlds , only : med_fldList_GetfldListTo +! use med_internalstate_mod , only : compwav + use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type + use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode !PSH end use perf_mod , only : t_startf, t_stopf @@ -37,7 +37,7 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_avg ! called from run sequence !PSH begin -! private :: med_phases_prep_wav_custom_cesm + private :: med_phases_prep_wav_custom_cesm !PSH end character(*), parameter :: u_FILE_u = & @@ -95,7 +95,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) type(InternalState) :: is_local integer :: n, ncnt !PSH begin -! type(med_fldlist_type), pointer :: fldList + type(med_fldlist_type), pointer :: fldList !PSH end character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -112,31 +112,31 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin -! fldList => med_fldList_GetfldListTo(compwav) + fldList => med_fldList_GetfldListTo(compwav) !PSH end ! auto merges to wav !PSH begin - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compwav), & - is_local%wrap%FBExp(compwav), & - is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), & - med_fldList_GetfldListTo(compwav), rc=rc) -! call med_merge_auto(& -! is_local%wrap%med_coupling_active(:,compwav), & -! is_local%wrap%FBExp(compwav), & -! is_local%wrap%FBFrac(compwav), & -! is_local%wrap%FBImp(:,compwav), & -! fldList, & -! FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) +! call med_merge_auto(& +! is_local%wrap%med_coupling_active(:,compwav), & +! is_local%wrap%FBExp(compwav), & +! is_local%wrap%FBFrac(compwav), & +! is_local%wrap%FBImp(:,compwav), & +! med_fldList_GetfldListTo(compwav), rc=rc) + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compwav), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + fldList, & + FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) !PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin -! ! custom merges to ocean -! if (trim(coupling_mode) == 'cesm') then -! call med_phases_prep_wav_custom_cesm(gcomp, rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if + ! custom merges to ocean + if (trim(coupling_mode) == 'cesm') then + call med_phases_prep_wav_custom_cesm(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if !PSH end ! wave accumulator @@ -224,79 +224,79 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) end subroutine med_phases_prep_wav_avg !----------------------------------------------------------------------------- -! subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) -! -! !--------------------------------------- -! ! custom calculations for cesm -! !--------------------------------------- -! -! use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet -! use ESMF , only : ESMF_VMBroadCast -! use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS -! use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR -! -! ! input/output variables -! type(ESMF_GridComp) :: gcomp -! integer, intent(out) :: rc -! -! ! local variables -! type(InternalState) :: is_local -! type(ESMF_Field) :: lfield -! real(R8), pointer :: ifrac(:) -! real(R8), pointer :: ofrac(:) -! real(R8), pointer :: ifracr(:) -! real(R8), pointer :: ofracr(:) -! real(R8), pointer :: avsdr(:) -! real(R8), pointer :: avsdf(:) -! real(R8), pointer :: anidr(:) -! real(R8), pointer :: anidf(:) -! real(R8), pointer :: Faxa_swvdf(:) -! real(R8), pointer :: Faxa_swndf(:) -! real(R8), pointer :: Faxa_swvdr(:) -! real(R8), pointer :: Faxa_swndr(:) -! real(R8), pointer :: Foxx_swnet(:) -! real(R8), pointer :: Foxx_swnet_afracr(:) -! real(R8), pointer :: Foxx_swnet_vdr(:) -! real(R8), pointer :: Foxx_swnet_vdf(:) -! real(R8), pointer :: Foxx_swnet_idr(:) -! real(R8), pointer :: Foxx_swnet_idf(:) -! real(R8), pointer :: Fioi_swpen_vdr(:) -! real(R8), pointer :: Fioi_swpen_vdf(:) -! real(R8), pointer :: Fioi_swpen_idr(:) -! real(R8), pointer :: Fioi_swpen_idf(:) -! real(R8), pointer :: Fioi_swpen(:) -! real(R8), pointer :: dataptr(:) -! real(R8), pointer :: dataptr_scalar_ocn(:,:) -! real(R8) :: frac_sum -! real(R8) :: ifrac_scaled, ofrac_scaled -! real(R8) :: ifracr_scaled, ofracr_scaled -! logical :: export_swnet_by_bands -! logical :: import_swpen_by_bands -! logical :: export_swnet_afracr -! real(R8) :: precip_fact(1) -! character(CS) :: cvalue -! real(R8) :: fswabsv, fswabsi -! integer :: scalar_id -! integer :: n -! integer :: lsize -! real(R8) :: c1,c2,c3,c4 -! character(len=64), allocatable :: fldnames(:) -! character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' -! !--------------------------------------- -! -! rc = ESMF_SUCCESS -! -! call t_startf('MED:'//subname) -! if (dbug_flag > 20) then -! call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) -! end if -! call memcheck(subname, 5, mastertask) -! -! ! Get the internal state -! nullify(is_local%wrap) -! call ESMF_GridCompGetInternalState(gcomp, is_local, rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! + subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) + + !--------------------------------------- + ! custom calculations for cesm + !--------------------------------------- + + use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_VMBroadCast + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_Field) :: lfield + real(R8), pointer :: ifrac(:) + real(R8), pointer :: ofrac(:) + real(R8), pointer :: ifracr(:) + real(R8), pointer :: ofracr(:) + real(R8), pointer :: avsdr(:) + real(R8), pointer :: avsdf(:) + real(R8), pointer :: anidr(:) + real(R8), pointer :: anidf(:) + real(R8), pointer :: Faxa_swvdf(:) + real(R8), pointer :: Faxa_swndf(:) + real(R8), pointer :: Faxa_swvdr(:) + real(R8), pointer :: Faxa_swndr(:) + real(R8), pointer :: Foxx_swnet(:) + real(R8), pointer :: Foxx_swnet_afracr(:) + real(R8), pointer :: Foxx_swnet_vdr(:) + real(R8), pointer :: Foxx_swnet_vdf(:) + real(R8), pointer :: Foxx_swnet_idr(:) + real(R8), pointer :: Foxx_swnet_idf(:) + real(R8), pointer :: Fioi_swpen_vdr(:) + real(R8), pointer :: Fioi_swpen_vdf(:) + real(R8), pointer :: Fioi_swpen_idr(:) + real(R8), pointer :: Fioi_swpen_idf(:) + real(R8), pointer :: Fioi_swpen(:) + real(R8), pointer :: dataptr(:) + real(R8), pointer :: dataptr_scalar_ocn(:,:) + real(R8) :: frac_sum + real(R8) :: ifrac_scaled, ofrac_scaled + real(R8) :: ifracr_scaled, ofracr_scaled + logical :: export_swnet_by_bands + logical :: import_swpen_by_bands + logical :: export_swnet_afracr + real(R8) :: precip_fact(1) + character(CS) :: cvalue + real(R8) :: fswabsv, fswabsi + integer :: scalar_id + integer :: n + integer :: lsize + real(R8) :: c1,c2,c3,c4 + character(len=64), allocatable :: fldnames(:) + character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if + call memcheck(subname, 5, mastertask) + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! !--------------------------------------- ! ! Compute netsw for ocean ! !--------------------------------------- @@ -519,6 +519,6 @@ end subroutine med_phases_prep_wav_avg ! end if ! call t_stopf('MED:'//subname) ! -! end subroutine med_phases_prep_wav_custom_cesm + end subroutine med_phases_prep_wav_custom_cesm end module med_phases_prep_wav_mod From 39257106ef55335081c88e14afea0525e7050cfb Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 25 Apr 2023 23:45:36 -0400 Subject: [PATCH 22/92] Removed export of So_ofrac to wav component (unnecessary), and other miscellaneous cleanup --- mediator/esmFldsExchange_cesm_mod.F90 | 38 +++------------------------ 1 file changed, 4 insertions(+), 34 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 42bb327ee..94028de1d 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2964,10 +2964,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if !PSH begin - if (phase == 'advertise') then - call addfld_from(compocn, 'So_ofrac') - call addfld_to(compwav, 'So_ofrac') - end if +! if (phase == 'advertise') then +! call addfld_from(compocn, 'So_ofrac') +! call addfld_to(compwav, 'So_ofrac') +! end if ! if (phase == 'advertise') then ! call addfld_from(compocn, 'So_ofrac') ! call addfld_to(compwav, 'So_ofrac') @@ -2999,36 +2999,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if -! if (phase == 'advertise') then -! call addfld_to(compwav , 'Foxx_taux') -! call addfld_from(compice , 'Fioi_taux') -! call addfld_aoflux('Faox_taux') -! else -! if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_taux', rc=rc)) then -! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then -! call addmap_from(compice, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') -! call addmrg_to(compwav, 'Foxx_taux', & -! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') -! end if -! call addmrg_to(compwav, 'Foxx_taux', & -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') -! end if -! end if -! if (phase == 'advertise') then -! call addfld_to(compwav , 'Foxx_tauy') -! call addfld_from(compice , 'Fioi_tauy') -! call addfld_aoflux('Faox_tauy') -! else -! if ( fldchk(is_local%wrap%FBexp(compwav), 'Foxx_tauy', rc=rc)) then -! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_tauy', rc=rc)) then -! call addmap_from(compice, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') -! call addmrg_to(compwav, 'Fwxx_tauy', & -! mrg_from=compice, mrg_fld='Fioi_tauy', mrg_type='merge', mrg_fracname='ifrac') -! end if -! call addmrg_to(compwav, 'Fwxx_tauy', & -! mrg_from=compmed, mrg_fld='Faox_tauy', mrg_type='merge', mrg_fracname='ofrac') -! end if -! end if !PSH end !===================================================================== From e142b2d44b0444b435f0442b2bd047c21d1fcf6e Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 00:35:57 -0400 Subject: [PATCH 23/92] Cleaning up earlier, temporary code --- mediator/med_phases_prep_wav_mod.F90 | 194 +++++++++++++-------------- 1 file changed, 97 insertions(+), 97 deletions(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index fa6e6617e..196ca724a 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -22,10 +22,10 @@ module med_phases_prep_wav_mod use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset !PSH begin -! use esmFlds , only : med_fldList_GetfldListTo -! use med_internalstate_mod , only : compwav - use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type - use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode + use esmFlds , only : med_fldList_GetfldListTo + use med_internalstate_mod , only : compwav +! use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type +! use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode !PSH end use perf_mod , only : t_startf, t_stopf @@ -37,7 +37,7 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_avg ! called from run sequence !PSH begin - private :: med_phases_prep_wav_custom_cesm +! private :: med_phases_prep_wav_custom_cesm !PSH end character(*), parameter :: u_FILE_u = & @@ -116,27 +116,27 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) !PSH end ! auto merges to wav !PSH begin -! call med_merge_auto(& -! is_local%wrap%med_coupling_active(:,compwav), & -! is_local%wrap%FBExp(compwav), & -! is_local%wrap%FBFrac(compwav), & -! is_local%wrap%FBImp(:,compwav), & -! med_fldList_GetfldListTo(compwav), rc=rc) - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compwav), & - is_local%wrap%FBExp(compwav), & - is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), & - fldList, & - FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compwav), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + med_fldList_GetfldListTo(compwav), rc=rc) +! call med_merge_auto(& +! is_local%wrap%med_coupling_active(:,compwav), & +! is_local%wrap%FBExp(compwav), & +! is_local%wrap%FBFrac(compwav), & +! is_local%wrap%FBImp(:,compwav), & +! fldList, & +! FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) !PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin - ! custom merges to ocean - if (trim(coupling_mode) == 'cesm') then - call med_phases_prep_wav_custom_cesm(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if +! ! custom merges to ocean +! if (trim(coupling_mode) == 'cesm') then +! call med_phases_prep_wav_custom_cesm(gcomp, rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if !PSH end ! wave accumulator @@ -224,79 +224,79 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) end subroutine med_phases_prep_wav_avg !----------------------------------------------------------------------------- - subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) - - !--------------------------------------- - ! custom calculations for cesm - !--------------------------------------- - - use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_VMBroadCast - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(InternalState) :: is_local - type(ESMF_Field) :: lfield - real(R8), pointer :: ifrac(:) - real(R8), pointer :: ofrac(:) - real(R8), pointer :: ifracr(:) - real(R8), pointer :: ofracr(:) - real(R8), pointer :: avsdr(:) - real(R8), pointer :: avsdf(:) - real(R8), pointer :: anidr(:) - real(R8), pointer :: anidf(:) - real(R8), pointer :: Faxa_swvdf(:) - real(R8), pointer :: Faxa_swndf(:) - real(R8), pointer :: Faxa_swvdr(:) - real(R8), pointer :: Faxa_swndr(:) - real(R8), pointer :: Foxx_swnet(:) - real(R8), pointer :: Foxx_swnet_afracr(:) - real(R8), pointer :: Foxx_swnet_vdr(:) - real(R8), pointer :: Foxx_swnet_vdf(:) - real(R8), pointer :: Foxx_swnet_idr(:) - real(R8), pointer :: Foxx_swnet_idf(:) - real(R8), pointer :: Fioi_swpen_vdr(:) - real(R8), pointer :: Fioi_swpen_vdf(:) - real(R8), pointer :: Fioi_swpen_idr(:) - real(R8), pointer :: Fioi_swpen_idf(:) - real(R8), pointer :: Fioi_swpen(:) - real(R8), pointer :: dataptr(:) - real(R8), pointer :: dataptr_scalar_ocn(:,:) - real(R8) :: frac_sum - real(R8) :: ifrac_scaled, ofrac_scaled - real(R8) :: ifracr_scaled, ofracr_scaled - logical :: export_swnet_by_bands - logical :: import_swpen_by_bands - logical :: export_swnet_afracr - real(R8) :: precip_fact(1) - character(CS) :: cvalue - real(R8) :: fswabsv, fswabsi - integer :: scalar_id - integer :: n - integer :: lsize - real(R8) :: c1,c2,c3,c4 - character(len=64), allocatable :: fldnames(:) - character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' - !--------------------------------------- - - rc = ESMF_SUCCESS - - call t_startf('MED:'//subname) - if (dbug_flag > 20) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - end if - call memcheck(subname, 5, mastertask) - - ! Get the internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - +! subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) +! +! !--------------------------------------- +! ! custom calculations for cesm +! !--------------------------------------- +! +! use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet +! use ESMF , only : ESMF_VMBroadCast +! use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS +! use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR +! +! ! input/output variables +! type(ESMF_GridComp) :: gcomp +! integer, intent(out) :: rc +! +! ! local variables +! type(InternalState) :: is_local +! type(ESMF_Field) :: lfield +! real(R8), pointer :: ifrac(:) +! real(R8), pointer :: ofrac(:) +! real(R8), pointer :: ifracr(:) +! real(R8), pointer :: ofracr(:) +! real(R8), pointer :: avsdr(:) +! real(R8), pointer :: avsdf(:) +! real(R8), pointer :: anidr(:) +! real(R8), pointer :: anidf(:) +! real(R8), pointer :: Faxa_swvdf(:) +! real(R8), pointer :: Faxa_swndf(:) +! real(R8), pointer :: Faxa_swvdr(:) +! real(R8), pointer :: Faxa_swndr(:) +! real(R8), pointer :: Foxx_swnet(:) +! real(R8), pointer :: Foxx_swnet_afracr(:) +! real(R8), pointer :: Foxx_swnet_vdr(:) +! real(R8), pointer :: Foxx_swnet_vdf(:) +! real(R8), pointer :: Foxx_swnet_idr(:) +! real(R8), pointer :: Foxx_swnet_idf(:) +! real(R8), pointer :: Fioi_swpen_vdr(:) +! real(R8), pointer :: Fioi_swpen_vdf(:) +! real(R8), pointer :: Fioi_swpen_idr(:) +! real(R8), pointer :: Fioi_swpen_idf(:) +! real(R8), pointer :: Fioi_swpen(:) +! real(R8), pointer :: dataptr(:) +! real(R8), pointer :: dataptr_scalar_ocn(:,:) +! real(R8) :: frac_sum +! real(R8) :: ifrac_scaled, ofrac_scaled +! real(R8) :: ifracr_scaled, ofracr_scaled +! logical :: export_swnet_by_bands +! logical :: import_swpen_by_bands +! logical :: export_swnet_afracr +! real(R8) :: precip_fact(1) +! character(CS) :: cvalue +! real(R8) :: fswabsv, fswabsi +! integer :: scalar_id +! integer :: n +! integer :: lsize +! real(R8) :: c1,c2,c3,c4 +! character(len=64), allocatable :: fldnames(:) +! character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' +! !--------------------------------------- +! +! rc = ESMF_SUCCESS +! +! call t_startf('MED:'//subname) +! if (dbug_flag > 20) then +! call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) +! end if +! call memcheck(subname, 5, mastertask) +! +! ! Get the internal state +! nullify(is_local%wrap) +! call ESMF_GridCompGetInternalState(gcomp, is_local, rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! ! !--------------------------------------- ! ! Compute netsw for ocean ! !--------------------------------------- @@ -519,6 +519,6 @@ subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) ! end if ! call t_stopf('MED:'//subname) ! - end subroutine med_phases_prep_wav_custom_cesm +! end subroutine med_phases_prep_wav_custom_cesm end module med_phases_prep_wav_mod From 14bd205d9234aac9504fb18e214a555363da6047 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 01:02:18 -0400 Subject: [PATCH 24/92] Removed unnecessary fldList variable --- mediator/med_phases_prep_wav_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 196ca724a..3ed57c00d 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -95,7 +95,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) type(InternalState) :: is_local integer :: n, ncnt !PSH begin - type(med_fldlist_type), pointer :: fldList +! type(med_fldlist_type), pointer :: fldList !PSH end character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -112,7 +112,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !PSH begin - fldList => med_fldList_GetfldListTo(compwav) +! fldList => med_fldList_GetfldListTo(compwav) !PSH end ! auto merges to wav !PSH begin From abc56586b0e478d2a1d8a6442115a2d6665a6605 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 07:00:36 -0400 Subject: [PATCH 25/92] Adding stress from ice to Fwxx_taux --- mediator/esmFldsExchange_cesm_mod.F90 | 32 ++++++++++++++++++++------- 1 file changed, 24 insertions(+), 8 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 94028de1d..ddf0570ce 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2983,20 +2983,36 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- +! if (phase == 'advertise') then +! call addfld_to(compwav , 'Fwxx_taux') +!! call addfld_from(compice , 'Fioi_taux') +! call addfld_aoflux('Faox_taux') +! else +! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then +!! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then +!! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') +!! call addmrg_to(compwav, 'Fwxx_taux', & +!! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') +!! end if +! call addmrg_to(compwav, 'Fwxx_taux', & +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') +!! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') +! end if +! end if +!! if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') -! call addfld_from(compice , 'Fioi_taux') + call addfld_from(compice , 'Fioi_taux') call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then -! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then -! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') -! call addmrg_to(compwav, 'Fwxx_taux', & -! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') -! end if + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if !PSH end From cb585c5852d3701d1eedfe9fe14b42fcf980e7a3 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 09:48:17 -0400 Subject: [PATCH 26/92] Removed mrg_fracname from Fwxx merges --- mediator/esmFldsExchange_cesm_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index ddf0570ce..b3b0f56c5 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3009,10 +3009,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge') +! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge') +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if !PSH end From 95c518851d7153e6311dfdc40a8bcf247b701681 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 11:28:03 -0400 Subject: [PATCH 27/92] Added ifrac and ofrac to FBFrac for wave component --- mediator/med_fraction_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 521ba0007..7cc5c0203 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -126,8 +126,10 @@ module med_fraction_mod character(len=6),parameter,dimension(1) :: fraclist_l = (/'lfrac '/) character(len=6),parameter,dimension(2) :: fraclist_g = (/'gfrac ','lfrac '/) character(len=6),parameter,dimension(2) :: fraclist_r = (/'rfrac ','lfrac '/) - character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) - +!PSH begin +! character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) + character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) +!PSH end !--- standard --- real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) character(*), parameter :: u_FILE_u = & From 5633ff2e4a3f3ce1c3781eec53eab2df520d4ed3 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 11:29:37 -0400 Subject: [PATCH 28/92] Using ifrac and ofrac weights for Fbww merge --- mediator/esmFldsExchange_cesm_mod.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index b3b0f56c5..ddf0570ce 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3009,12 +3009,10 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge') -! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge') -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if !PSH end From a3c13d2fe9a06f1c4db513ac60078a3c52950bb2 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 26 Apr 2023 14:33:20 -0400 Subject: [PATCH 29/92] Updated comments to include wave component --- mediator/med_fraction_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 7cc5c0203..c97fb8994 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -23,6 +23,7 @@ module med_fraction_mod ! character(*),parameter :: fraclist_l = 'lfrac' ! character(*),parameter :: fraclist_g = 'gfrac:lfrac' ! character(*),parameter :: fraclist_r = 'lfrac:rfrac' + ! character(*),parameter :: fraclist_w = 'ifrac:ofrac:wfrac' ! ! we assume ocean and ice are on the same grids, same masks ! we assume ocn2atm and ice2atm are masked maps From 51f760183678dd96e34de5733de202167bf7ee1f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 28 Apr 2023 10:37:25 +0200 Subject: [PATCH 30/92] updates to remove mct_mod and all other mct related files from share/ --- cesm/driver/esm.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index a98976f21..b5207955a 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -796,7 +796,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifndef NO_MPI2 use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif - use mct_mod , only : mct_world_init + use m_MCTWorld , only : mct_world_init => init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id From 962646ae8d45d94cb83cd27c7f08a4c190a260b8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 28 Apr 2023 13:07:30 -0600 Subject: [PATCH 31/92] improves the readability of salt budget --- cesm/driver/esm.F90 | 2 +- mediator/med_diag_mod.F90 | 8 +++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index a98976f21..b5207955a 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -796,7 +796,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifndef NO_MPI2 use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif - use mct_mod , only : mct_world_init + use m_MCTWorld , only : mct_world_init => init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 802334f6f..8ea6651ea 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -95,6 +95,8 @@ module med_diag_mod character(*), parameter :: FA1 = "(' ',a12,6f15.8)" character(*), parameter :: FA0r = "(' ',12x,8(6x,a8,1x))" character(*), parameter :: FA1r = "(' ',a12,8f15.8)" + character(*), parameter :: FA0s = "(' ',12x,8(7x,a8,2x))" + character(*), parameter :: FA1s = "(' ',a12,8g18.8)" ! --------------------------------- ! C for component @@ -2683,7 +2685,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,'NET SALT BUDGET (kg/m2s): period = ',& trim(budget_diags%periods(ip)%name), ': date = ',date,tod - write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' + write(diagunit,FA0s) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' do nf = f_salt_beg, f_salt_end net_salt_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) net_salt_lnd = data(nf, c_lnd_recv, ip) + data(nf, c_lnd_send, ip) @@ -2695,7 +2697,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) net_salt_tot = net_salt_atm + net_salt_lnd + net_salt_rof + net_salt_ocn + & net_salt_ice_nh + net_salt_ice_sh + net_salt_glc - write(diagunit,FA1r) budget_diags%fields(nf)%name,& + write(diagunit,FA1s) budget_diags%fields(nf)%name,& net_salt_atm, net_salt_lnd, net_salt_rof, net_salt_ocn, & net_salt_ice_nh, net_salt_ice_sh, net_salt_glc, net_salt_tot enddo @@ -2718,7 +2720,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) sum_net_salt_tot = sum_net_salt_atm + sum_net_salt_lnd + sum_net_salt_rof + sum_net_salt_ocn + & sum_net_salt_ice_nh + sum_net_salt_ice_sh + sum_net_salt_glc - write(diagunit,FA1r)' *SUM*',& + write(diagunit,FA1s)' *SUM*',& sum_net_salt_atm, sum_net_salt_lnd, sum_net_salt_rof, sum_net_salt_ocn, & sum_net_salt_ice_nh, sum_net_salt_ice_sh, sum_net_salt_glc, sum_net_salt_tot end if From f80e7d74337e52a7fb8d4164c78e34cdcdbae6f3 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 28 Apr 2023 13:08:34 -0600 Subject: [PATCH 32/92] undo accidental commit --- cesm/driver/esm.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index b5207955a..a98976f21 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -796,7 +796,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifndef NO_MPI2 use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif - use m_MCTWorld , only : mct_world_init => init + use mct_mod , only : mct_world_init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id From 68baf9f3999e48fc8afdcb8ca1f713aa908e9c0b Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 28 Apr 2023 15:33:46 -0400 Subject: [PATCH 33/92] Added new fractions (ifrac, ofrac) for wave component --- mediator/med_fraction_mod.F90 | 188 +++++++++++++++++++++++++++++++++- 1 file changed, 186 insertions(+), 2 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index c97fb8994..ed11d33f1 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -24,8 +24,10 @@ module med_fraction_mod ! character(*),parameter :: fraclist_g = 'gfrac:lfrac' ! character(*),parameter :: fraclist_r = 'lfrac:rfrac' ! character(*),parameter :: fraclist_w = 'ifrac:ofrac:wfrac' - ! - ! we assume ocean and ice are on the same grids, same masks +!PSH begin ! +! ! we assume ocean and ice are on the same grids, same masks + ! we assume ocean, ice, and waves are on the same grids, same masks +!PSH end ! we assume ocn2atm and ice2atm are masked maps ! we assume lnd2atm is a global map ! we assume that the ice fraction evolves in time but that @@ -587,6 +589,86 @@ subroutine med_fraction_init(gcomp, rc) endif endif +!PSH Begin - In progress... +! Note: started this section, based on setting ifrac and ofrac for compatm, but it is not +! clear to me that this approach is correct, since we can assume ocn, ice, wav are all on +! the same grid. Commenting out for now, can delete once I'm confident other approach +! works +! !--------------------------------------- +! ! Set 'ofrac' in FBFrac(compwav) +! !--------------------------------------- +! +! if ( is_local%wrap%comp_present(compocn) .and. & +! is_local%wrap%comp_present(compwav) .and. & +! is_local%wrap%med_coupling_active(compocn,compwav)) then +! +! ! Set 'ofrac' in FBFrac(compwav) - at this point this is the +! ! ocean mask mapped to the atm grid This is mapping the ocean mask to +! ! the wav grid +! +! if (med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then +! ! If ocn and atm are on the same mesh - a redist route handle has already been created +! maptype = mapfcopy +! else +! if (trim(coupling_mode) == 'nems_orig' ) then +! maptype = mapnstod_consd +! else +! maptype = mapconsd +! end if +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),maptype, rc=rc)) then +! call med_map_routehandles_init( compocn, compwav, & +! FBSrc=is_local%wrap%FBImp(compocn,compocn), & +! FBDst=is_local%wrap%FBImp(compocn,compwav), & +! mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! end if +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compocn), fieldname='ofrac', field=field_src, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), fieldname='ofrac', field=field_dst, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call med_map_field(field_src, field_dst, is_local%wrap%RH(compocn,compwav,:), maptype, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! +! end if +! +! !--------------------------------------- +! ! Set 'ifrac' in FBFrac(compwav) +! !--------------------------------------- +! +! if ( is_local%wrap%comp_present(compice) .and. & +! is_local%wrap%comp_present(compwav) .and. & +! is_local%wrap%med_coupling_active(compice,compwav)) then +! +! ! Set 'ifrac' in FBFrac(compwav) - at this point this is the ice mask mapped to the wav mesh +! ! This maps the ice mask (which is the same as the ocean mask) to the wav mesh +! if (med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then +! ! If ice and wav are on the same mesh - a redist route handle has already been created +! maptype = mapfcopy +! else +! if (trim(coupling_mode) == 'nems_orig' ) then +! maptype = mapnstod_consd +! else +! maptype = mapconsd +! end if +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),maptype, rc=rc)) then +! call med_map_routehandles_init( compice, compwav, & +! FBSrc=is_local%wrap%FBImp(compice,compice), & +! FBDst=is_local%wrap%FBImp(compice,compwav), & +! mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! end if +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', field=field_dst, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), maptype, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! +!PSH end + !--------------------------------------- ! Create route handles ocn<->ice if not created !--------------------------------------- @@ -622,6 +704,80 @@ subroutine med_fraction_init(gcomp, rc) end if end if +!PSH begin + !--------------------------------------- + ! Create route handles ocn<->wav if not created + !--------------------------------------- + + if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then + if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compocn,:),mapfcopy, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compocn))) then + call fldbun_init(is_local%wrap%FBImp(compwav,compocn), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compocn), & + STflds=is_local%wrap%NStateImp(compwav), & + name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compocn)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call med_map_routehandles_init(compwav, compocn, & + FBSrc=is_local%wrap%FBImp(compwav,compice), & + FBDst=is_local%wrap%FBImp(compwav,compice), & + mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compwav))) then + call fldbun_init(is_local%wrap%FBImp(compocn,compwav), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compwav), & + STflds=is_local%wrap%NStateImp(compocn), & + name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compwav)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call med_map_routehandles_init( compocn, compwav, & + FBSrc=is_local%wrap%FBImp(compocn,compocn), & + FBDst=is_local%wrap%FBImp(compocn,compwav), & + mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + !--------------------------------------- + ! Create route handles ice<->wav if not created + !--------------------------------------- + + if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compice)) then + if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compice,:),mapfcopy, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compice))) then + call fldbun_init(is_local%wrap%FBImp(compwav,compice), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compice), & + STflds=is_local%wrap%NStateImp(compwav), & + name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compice)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call med_map_routehandles_init(compwav, compice, & + FBSrc=is_local%wrap%FBImp(compwav,compice), & + FBDst=is_local%wrap%FBImp(compwav,compice), & + mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compwav))) then + call fldbun_init(is_local%wrap%FBImp(compice,compwav), is_local%wrap%flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compwav), & + STflds=is_local%wrap%NStateImp(compice), & + name='FBImp'//trim(compname(compice))//'_'//trim(compname(compwav)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call med_map_routehandles_init( compice, compwav, & + FBSrc=is_local%wrap%FBImp(compice,compice), & + FBDst=is_local%wrap%FBImp(compice,compwav), & + mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + +!PSH end + + !--------------------------------------- ! Diagnostic output !--------------------------------------- @@ -757,6 +913,34 @@ subroutine med_fraction_set(gcomp, rc) endif call t_stopf('MED:'//trim(subname)//' fbfrac(compocn)') +!PSH begin + ! ------------------------------------------- + ! Set FBfrac(compwav) + ! ------------------------------------------- + + ! The following is just a redistribution from FBFrac(compice) + + call t_startf('MED:'//trim(subname)//' fbfrac(compwav)') + if (is_local%wrap%comp_present(compwav)) then + ! Map 'ifrac' from FBfrac(compice) to FBfrac(compwav) + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', field=field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Map 'ofrac' from FBfrac(compice) to FBfrac(compwav) + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ofrac', field=field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ofrac', field=field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + call t_stopf('MED:'//trim(subname)//' fbfrac(compwav)') +!PSH end + ! ------------------------------------------- ! Set FBfrac(compatm) ! ------------------------------------------- From 04296bd52ca7af8e3fb57842b749075b4e1f980f Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 28 Apr 2023 15:53:56 -0400 Subject: [PATCH 34/92] Added compwav declaration to med_fraction_set subroutine --- mediator/med_fraction_mod.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index ed11d33f1..da379de13 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -808,6 +808,10 @@ subroutine med_fraction_set(gcomp, rc) use ESMF , only : ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS +!PSH Begin +! use med_internalstate_mod , only : compatm, compocn, compice, compname + use med_internalstate_mod , only : compatm, compocn, compice, compname, compwav +!PSH End use med_internalstate_mod , only : compatm, compocn, compice, compname use med_internalstate_mod , only : mapfcopy, mapconsd, mapnstod_consd use med_internalstate_mod , only : coupling_mode From 5bc4403e393ee9018cf6b2179516a23169d77ed9 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 28 Apr 2023 19:59:35 -0400 Subject: [PATCH 35/92] Corrected two typos where compice was being passed instead of compwav --- mediator/med_fraction_mod.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index da379de13..3a5ac5a26 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -719,8 +719,8 @@ subroutine med_fraction_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call med_map_routehandles_init(compwav, compocn, & - FBSrc=is_local%wrap%FBImp(compwav,compice), & - FBDst=is_local%wrap%FBImp(compwav,compice), & + FBSrc=is_local%wrap%FBImp(compwav,compocn), & + FBDst=is_local%wrap%FBImp(compwav,compocn), & mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -812,7 +812,6 @@ subroutine med_fraction_set(gcomp, rc) ! use med_internalstate_mod , only : compatm, compocn, compice, compname use med_internalstate_mod , only : compatm, compocn, compice, compname, compwav !PSH End - use med_internalstate_mod , only : compatm, compocn, compice, compname use med_internalstate_mod , only : mapfcopy, mapconsd, mapnstod_consd use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : InternalState From 69317cbe2fb6f0392997f3fa33f2b7867a5f6108 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 28 Apr 2023 21:13:15 -0400 Subject: [PATCH 36/92] Removing previous additions for wavcomp --- mediator/med_fraction_mod.F90 | 194 +++++++++++++++++----------------- 1 file changed, 97 insertions(+), 97 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 3a5ac5a26..2a410aace 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -130,8 +130,8 @@ module med_fraction_mod character(len=6),parameter,dimension(2) :: fraclist_g = (/'gfrac ','lfrac '/) character(len=6),parameter,dimension(2) :: fraclist_r = (/'rfrac ','lfrac '/) !PSH begin -! character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) - character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) + character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) +! character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) !PSH end !--- standard --- real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) @@ -705,76 +705,76 @@ subroutine med_fraction_init(gcomp, rc) end if !PSH begin - !--------------------------------------- - ! Create route handles ocn<->wav if not created - !--------------------------------------- - - if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then - if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compocn,:),mapfcopy, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compocn))) then - call fldbun_init(is_local%wrap%FBImp(compwav,compocn), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compocn), & - STflds=is_local%wrap%NStateImp(compwav), & - name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compocn)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call med_map_routehandles_init(compwav, compocn, & - FBSrc=is_local%wrap%FBImp(compwav,compocn), & - FBDst=is_local%wrap%FBImp(compwav,compocn), & - mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compwav))) then - call fldbun_init(is_local%wrap%FBImp(compocn,compwav), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compwav), & - STflds=is_local%wrap%NStateImp(compocn), & - name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compwav)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call med_map_routehandles_init( compocn, compwav, & - FBSrc=is_local%wrap%FBImp(compocn,compocn), & - FBDst=is_local%wrap%FBImp(compocn,compwav), & - mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if - - !--------------------------------------- - ! Create route handles ice<->wav if not created - !--------------------------------------- - - if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compice)) then - if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compice,:),mapfcopy, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compice))) then - call fldbun_init(is_local%wrap%FBImp(compwav,compice), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compice), & - STflds=is_local%wrap%NStateImp(compwav), & - name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compice)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call med_map_routehandles_init(compwav, compice, & - FBSrc=is_local%wrap%FBImp(compwav,compice), & - FBDst=is_local%wrap%FBImp(compwav,compice), & - mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then - if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compwav))) then - call fldbun_init(is_local%wrap%FBImp(compice,compwav), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compwav), & - STflds=is_local%wrap%NStateImp(compice), & - name='FBImp'//trim(compname(compice))//'_'//trim(compname(compwav)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call med_map_routehandles_init( compice, compwav, & - FBSrc=is_local%wrap%FBImp(compice,compice), & - FBDst=is_local%wrap%FBImp(compice,compwav), & - mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if - +! !--------------------------------------- +! ! Create route handles ocn<->wav if not created +! !--------------------------------------- +! +! if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compocn,:),mapfcopy, rc=rc)) then +! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compocn))) then +! call fldbun_init(is_local%wrap%FBImp(compwav,compocn), is_local%wrap%flds_scalar_name, & +! STgeom=is_local%wrap%NStateImp(compocn), & +! STflds=is_local%wrap%NStateImp(compwav), & +! name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compocn)), rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! call med_map_routehandles_init(compwav, compocn, & +! FBSrc=is_local%wrap%FBImp(compwav,compocn), & +! FBDst=is_local%wrap%FBImp(compwav,compocn), & +! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then +! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compwav))) then +! call fldbun_init(is_local%wrap%FBImp(compocn,compwav), is_local%wrap%flds_scalar_name, & +! STgeom=is_local%wrap%NStateImp(compwav), & +! STflds=is_local%wrap%NStateImp(compocn), & +! name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compwav)), rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! call med_map_routehandles_init( compocn, compwav, & +! FBSrc=is_local%wrap%FBImp(compocn,compocn), & +! FBDst=is_local%wrap%FBImp(compocn,compwav), & +! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! end if +! +! !--------------------------------------- +! ! Create route handles ice<->wav if not created +! !--------------------------------------- +! +! if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compice)) then +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compice,:),mapfcopy, rc=rc)) then +! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compice))) then +! call fldbun_init(is_local%wrap%FBImp(compwav,compice), is_local%wrap%flds_scalar_name, & +! STgeom=is_local%wrap%NStateImp(compice), & +! STflds=is_local%wrap%NStateImp(compwav), & +! name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compice)), rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! call med_map_routehandles_init(compwav, compice, & +! FBSrc=is_local%wrap%FBImp(compwav,compice), & +! FBDst=is_local%wrap%FBImp(compwav,compice), & +! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then +! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compwav))) then +! call fldbun_init(is_local%wrap%FBImp(compice,compwav), is_local%wrap%flds_scalar_name, & +! STgeom=is_local%wrap%NStateImp(compwav), & +! STflds=is_local%wrap%NStateImp(compice), & +! name='FBImp'//trim(compname(compice))//'_'//trim(compname(compwav)), rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! call med_map_routehandles_init( compice, compwav, & +! FBSrc=is_local%wrap%FBImp(compice,compice), & +! FBDst=is_local%wrap%FBImp(compice,compwav), & +! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! end if +! end if +! !PSH end @@ -917,31 +917,31 @@ subroutine med_fraction_set(gcomp, rc) call t_stopf('MED:'//trim(subname)//' fbfrac(compocn)') !PSH begin - ! ------------------------------------------- - ! Set FBfrac(compwav) - ! ------------------------------------------- - - ! The following is just a redistribution from FBFrac(compice) - - call t_startf('MED:'//trim(subname)//' fbfrac(compwav)') - if (is_local%wrap%comp_present(compwav)) then - ! Map 'ifrac' from FBfrac(compice) to FBfrac(compwav) - call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', field=field_dst, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Map 'ofrac' from FBfrac(compice) to FBfrac(compwav) - call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ofrac', field=field_src, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ofrac', field=field_dst, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif - call t_stopf('MED:'//trim(subname)//' fbfrac(compwav)') +! ! ------------------------------------------- +! ! Set FBfrac(compwav) +! ! ------------------------------------------- +! +! ! The following is just a redistribution from FBFrac(compice) +! +! call t_startf('MED:'//trim(subname)//' fbfrac(compwav)') +! if (is_local%wrap%comp_present(compwav)) then +! ! Map 'ifrac' from FBfrac(compice) to FBfrac(compwav) +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', field=field_dst, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! +! ! Map 'ofrac' from FBfrac(compice) to FBfrac(compwav) +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ofrac', field=field_src, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ofrac', field=field_dst, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! endif +! call t_stopf('MED:'//trim(subname)//' fbfrac(compwav)') !PSH end ! ------------------------------------------- From baaf12cfc7f6921358eded55f669dede8c2829fc Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Fri, 28 Apr 2023 21:30:48 -0400 Subject: [PATCH 37/92] Removing stress from compice from Fwxx_taux --- mediator/esmFldsExchange_cesm_mod.F90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index ddf0570ce..9146ee728 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3002,17 +3002,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !! if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') - call addfld_from(compice , 'Fioi_taux') +! call addfld_from(compice , 'Fioi_taux') call addfld_aoflux('Faox_taux') else if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then - if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - end if +! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then +! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') +! call addmrg_to(compwav, 'Fwxx_taux', & +! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') +! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if !PSH end From 24f419cd2d54ad57adeefc976d643a89e13a018b Mon Sep 17 00:00:00 2001 From: James Edwards Date: Sat, 29 Apr 2023 12:55:30 -0500 Subject: [PATCH 38/92] turn off HierarchyProtocol, not used in cesm this is a memory and initialization time saver --- cesm/driver/ensemble_driver.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index c79fade40..15bf0e1a7 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -340,6 +340,9 @@ subroutine SetModelServices(ensemble_driver, rc) else inst_suffix = '' endif + # CESM does not use this ESMF feature and at large processor counts it can be expensive to have it on. + call NUOPC_CompAttributeSet(driver, name="HierarchyProtocol", value="off", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set the driver instance attributes call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) From 9c43424704c8e9dc4d9cb683370190ca05e89f00 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 1 May 2023 10:31:15 -0600 Subject: [PATCH 39/92] correct comment delimiter --- cesm/driver/ensemble_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 15bf0e1a7..2656f10fc 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -340,7 +340,7 @@ subroutine SetModelServices(ensemble_driver, rc) else inst_suffix = '' endif - # CESM does not use this ESMF feature and at large processor counts it can be expensive to have it on. + ! CESM does not use this ESMF feature and at large processor counts it can be expensive to have it on. call NUOPC_CompAttributeSet(driver, name="HierarchyProtocol", value="off", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 16d7223015c663482118e8da6a11a036ab141979 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 14:40:35 +0200 Subject: [PATCH 40/92] removed unused variable --- mediator/esmFldsExchange_cesm_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index e7da536f6..69cd4391a 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -96,7 +96,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) type(InternalState) :: is_local integer :: n, ns character(len=CL) :: cvalue - character(len=CS) :: name logical :: wav_coupling_to_cice logical :: ocn2glc_coupling character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' From dbfb31a8c74df94e4e1f8883a083af16308200cc Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 14:53:13 +0200 Subject: [PATCH 41/92] removed unneeded xml variables --- .github/pull_request_template.md | 37 +-------------- cime_config/config_component.xml | 81 -------------------------------- 2 files changed, 2 insertions(+), 116 deletions(-) diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index 438a2f450..f3d2d933a 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -11,39 +11,6 @@ Are changes expected to change answers? (specify if bfb, different at roundoff, Any User Interface Changes (namelist or namelist defaults changes)? ### Testing performed +Please describe the tests along with the target model and machine(s) +If possible, please also added hashes that were used in the testing -Testing performed if application target is CESM: -- [ ] (recommended) CIME_DRIVER=nuopc scripts_regression_tests.py - - machines: - - details (e.g. failed tests): -- [ ] (recommended) CESM testlist_drv.xml - - machines and compilers: - - details (e.g. failed tests): -- [ ] (optional) CESM prealpha test - - machines and compilers - - details (e.g. failed tests): -- [ ] (other) please described in detail - - machines and compilers - - details (e.g. failed tests): - -Testing performed if application target is UFS-coupled: -- [ ] (recommended) UFS-coupled testing - - description: - - details (e.g. failed tests): - -Testing performed if application target is UFS-HAFS: -- [ ] (recommended) UFS-HAFS testing - - description: - - details (e.g. failed tests): - -### Hashes used for testing: - -- [ ] CESM: - - repository to check out: https://github.com/ESCOMP/CESM.git - - branch/hash: -- [ ] UFS-coupled, then umbrella repostiory to check out and associated hash: - - repository to check out: - - branch/hash: -- [ ] UFS-HAFS, then umbrella repostiory to check out and associated hash: - - repository to check out: - - branch/hash: diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 7f9bac96e..f986cfad2 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -1361,87 +1361,6 @@ - - - - char - idmap - run_domain - env_run.xml - atm2ocn flux mapping file - - - - char - idmap - run_domain - env_run.xml - atm2ocn state mapping file - - - - char - idmap - run_domain - env_run.xml - atm2ocn vector mapping file - - - - char - idmap - run_domain - env_run.xml - atm2lnd flux mapping file - - - - char - idmap - run_domain - env_run.xml - atm2lnd state mapping file - - - - char - idmap - run_domain - env_run.xml - atm2wav state mapping file - - - - char - idmap - run_domain - env_run.xml - ocn2atm flux mapping file - - - - char - idmap - run_domain - env_run.xml - ocn2atm state mapping file - - - - char - idmap - run_domain - env_run.xml - lnd2atm flux mapping file - - - - char - idmap - run_domain - env_run.xml - lnd2atm state mapping file - char From 7bb5053618aca5c4bf146b2e370d9af2a77c70bc Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 15:03:27 +0200 Subject: [PATCH 42/92] check for nans --- mediator/med_methods_mod.F90 | 108 +++++++++++++++++++++++++++ mediator/med_phases_prep_atm_mod.F90 | 5 ++ mediator/med_phases_prep_glc_mod.F90 | 7 ++ mediator/med_phases_prep_ice_mod.F90 | 5 ++ mediator/med_phases_prep_lnd_mod.F90 | 5 ++ mediator/med_phases_prep_ocn_mod.F90 | 5 ++ mediator/med_phases_prep_rof_mod.F90 | 5 ++ mediator/med_phases_prep_wav_mod.F90 | 5 ++ 8 files changed, 145 insertions(+) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index bd5b60793..710ba51c7 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -24,6 +24,11 @@ module med_methods_mod med_methods_FieldPtr_compare2 end interface + interface med_methods_check_for_nans + module procedure med_methods_check_for_nans_1d + module procedure med_methods_check_for_nans_2d + end interface med_methods_check_for_nans + ! used/reused in module logical :: isPresent @@ -49,6 +54,7 @@ module med_methods_mod public med_methods_FB_getdata2d public med_methods_FB_getdata1d public med_methods_FB_getmesh + public med_methods_FB_check_for_nans public med_methods_State_reset public med_methods_State_diagnose @@ -71,6 +77,8 @@ module med_methods_mod #ifdef DIAGNOSE private med_methods_Array_diagnose #endif + private med_methods_check_for_nans + !----------------------------------------------------------------------------- contains !----------------------------------------------------------------------------- @@ -2497,4 +2505,104 @@ subroutine med_methods_FB_getmesh(FB, mesh, rc) end subroutine med_methods_FB_getmesh + !----------------------------------------------------------------------------- + subroutine med_methods_FB_check_for_nans(FB, rc) + + use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet + + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + integer , intent(inout) :: rc + + ! local variables + type(ESMF_Field) :: field + integer :: index + integer :: fieldcount + integer :: fieldrank + character(len=CL) :: fieldname + real(r8) , pointer :: dataptr1d(:) + real(r8) , pointer :: dataptr2d(:,:) + ! ---------------------------------------------- + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + do index=1,fieldCount + call med_methods_FB_getNameN(FB, index, fieldname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(FB, fieldName=fieldname, field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, rank=fieldrank, name=fieldname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fieldrank == 1) then + call ESMF_FieldGet(field, farrayPtr=dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_FieldGet(field, farrayPtr=dataptr2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end do + + end subroutine med_methods_FB_check_for_nans + + !----------------------------------------------------------------------------- + subroutine med_methods_check_for_nans_1d(dataptr, name, rc) + ! input/output variables + real(r8) , intent(in) :: dataptr(:) + character(len=*) , intent(in) :: name + integer , intent(out) :: rc + + ! local variables + integer :: n + integer :: nancount + character(len=CS) :: nancount_char + character(len=*), parameter :: subname='(med_methods_check_for_nans_1d)' + ! ---------------------------------------------- + rc = ESMF_SUCCESS + + nancount = 0 + do n = 1,size(dataptr) + if (isnan(dataptr(n))) then + nancount = nancount + 1 + end if + end do + if (nancount > 0) then + write(nancount_char, '(i0)') nancount + call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & + ESMF_LOGMSG_ERROR) + return + endif + end subroutine med_methods_check_for_nans_1d + + subroutine med_methods_check_for_nans_2d(dataptr, name, rc) + ! input/output variables + real(r8) , intent(in) :: dataptr(:,:) + character(len=*) , intent(in) :: name + integer , intent(out) :: rc + + ! local variables + integer :: n,k + integer :: nancount + character(len=CS) :: nancount_char + character(len=*), parameter :: subname='(med_methods_check_for_nans_2d)' + ! ---------------------------------------------- + rc = ESMF_SUCCESS + + nancount = 0 + do k = 1,size(dataptr, dim=1) + do n = 1,size(dataptr, dim=2) + if (isnan(dataptr(k,n))) then + nancount = nancount + 1 + end if + end do + end do + if (nancount > 0) then + write(nancount_char, '(i0)') nancount + call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & + ESMF_LOGMSG_ERROR) + return + end if + end subroutine med_methods_check_for_nans_2d + end module med_methods_mod diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 9bb2b059f..bccf8e07c 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -14,6 +14,7 @@ module med_phases_prep_atm_mod use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk use med_methods_mod , only : FB_getfldptr=> med_methods_FB_GetFldPtr + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, maintask @@ -243,6 +244,10 @@ subroutine med_phases_prep_atm(gcomp, rc) end do end if + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compatm), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 311d91c8a..2861f3324 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -34,6 +34,7 @@ module med_phases_prep_glc_mod use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_init => med_methods_FB_init + use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_utils_mod , only : chkerr => med_utils_ChkErr @@ -706,6 +707,12 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) endif end if + ! Check for nans in fields export to atm + do ns = 1,is_local%wrap%num_icesheets + call fldbun_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 428f3afef..1e0496b3d 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -34,6 +34,7 @@ subroutine med_phases_prep_ice(gcomp, rc) use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_merge_mod , only : med_merge_auto use med_internalstate_mod , only : InternalState, logunit, maintask @@ -149,6 +150,10 @@ subroutine med_phases_prep_ice(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compice), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 0c0bad212..93780c254 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -29,6 +29,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND use esmFlds , only : med_fldList_GetFldListTo, med_fldList_type use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose + use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : complnd, compatm @@ -127,6 +128,10 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! Set first call logical to false first_call = .false. + ! Check for nans in fields export to atm + call fldbun_check_for_nans(is_local%wrap%FBExp(complnd), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 60e37a95e..de989ac49 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -19,6 +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 med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type use med_internalstate_mod , only : compocn, compatm, compice, coupling_mode use perf_mod , only : t_startf, t_stopf @@ -295,6 +296,10 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compocn), is_local%wrap%FBExpAccumOcn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compocn), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! zero accumulator is_local%wrap%ExpAccumOcnCnt = 0 call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 5d603a141..8d690124a 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -23,6 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_average => med_methods_FB_average use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d + use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans use perf_mod , only : t_startf, t_stopf implicit none @@ -376,6 +377,10 @@ subroutine med_phases_prep_rof(gcomp, rc) FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=fldList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Check for nans in fields export to atm + call fldbun_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then call fldbun_diagnose(is_local%wrap%FBExp(comprof), & string=trim(subname)//' FBexp(comprof) ', rc=rc) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 5fcb9ba7e..3028303bc 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -17,6 +17,7 @@ module med_phases_prep_wav_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 med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use esmFlds , only : med_fldList_GetfldListTo use med_internalstate_mod , only : compwav use perf_mod , only : t_startf, t_stopf @@ -176,6 +177,10 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compwav), is_local%wrap%FBExpAccumWav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! zero accumulator is_local%wrap%ExpAccumWavCnt = 0 call FB_reset(is_local%wrap%FBExpAccumWav, value=czero, rc=rc) From 9ee4d83648b2939273ee1091cb7d9a12524879ee Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 15:53:47 +0200 Subject: [PATCH 43/92] refactored logic --- mediator/med_methods_mod.F90 | 53 ++++++++++++++++-------------------- 1 file changed, 23 insertions(+), 30 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 710ba51c7..e9d545a99 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2522,12 +2522,17 @@ subroutine med_methods_FB_check_for_nans(FB, rc) character(len=CL) :: fieldname real(r8) , pointer :: dataptr1d(:) real(r8) , pointer :: dataptr2d(:,:) + integer :: nancount + character(len=CS) :: nancount_char + logical :: nanfound + character(len=*), parameter :: subname='(med_methods_FB_check_for_nans)' ! ---------------------------------------------- rc = ESMF_SUCCESS call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + nanfound = .false. do index=1,fieldCount call med_methods_FB_getNameN(FB, index, fieldname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -2538,57 +2543,51 @@ subroutine med_methods_FB_check_for_nans(FB, rc) if (fieldrank == 1) then call ESMF_FieldGet(field, farrayPtr=dataptr1d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_check_for_nans(dataptr1d, nancount) else call ESMF_FieldGet(field, farrayPtr=dataptr2d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_check_for_nans(dataptr2d, nancount) + end if + if (nancount > 0) then + write(nancount_char, '(i0)') nancount + call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(fieldname), & + ESMF_LOGMSG_WARNING) + nanfound = .true. end if end do + if (nanfound) then + call ESMF_LogWrite(trim(subname)//": ERROR nans found in export field bundle ",ESMF_LOGMSG_ERROR) + return + end if end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- - subroutine med_methods_check_for_nans_1d(dataptr, name, rc) + subroutine med_methods_check_for_nans_1d(dataptr, nancount) ! input/output variables - real(r8) , intent(in) :: dataptr(:) - character(len=*) , intent(in) :: name - integer , intent(out) :: rc + real(r8) , intent(in) :: dataptr(:) + integer , intent(out) :: nancount ! local variables integer :: n - integer :: nancount - character(len=CS) :: nancount_char - character(len=*), parameter :: subname='(med_methods_check_for_nans_1d)' ! ---------------------------------------------- - rc = ESMF_SUCCESS - nancount = 0 do n = 1,size(dataptr) if (isnan(dataptr(n))) then nancount = nancount + 1 end if end do - if (nancount > 0) then - write(nancount_char, '(i0)') nancount - call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & - ESMF_LOGMSG_ERROR) - return - endif end subroutine med_methods_check_for_nans_1d - subroutine med_methods_check_for_nans_2d(dataptr, name, rc) + subroutine med_methods_check_for_nans_2d(dataptr, nancount) ! input/output variables - real(r8) , intent(in) :: dataptr(:,:) - character(len=*) , intent(in) :: name - integer , intent(out) :: rc + real(r8) , intent(in) :: dataptr(:,:) + integer , intent(out) :: nancount ! local variables integer :: n,k - integer :: nancount - character(len=CS) :: nancount_char - character(len=*), parameter :: subname='(med_methods_check_for_nans_2d)' ! ---------------------------------------------- - rc = ESMF_SUCCESS - nancount = 0 do k = 1,size(dataptr, dim=1) do n = 1,size(dataptr, dim=2) @@ -2597,12 +2596,6 @@ subroutine med_methods_check_for_nans_2d(dataptr, name, rc) end if end do end do - if (nancount > 0) then - write(nancount_char, '(i0)') nancount - call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & - ESMF_LOGMSG_ERROR) - return - end if end subroutine med_methods_check_for_nans_2d end module med_methods_mod From 3ad7f1f7e9df8a236a3b2d6ab89b37711bab701f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 16:00:53 +0200 Subject: [PATCH 44/92] updated med_diag_mod with recent changes from escomp --- mediator/med_diag_mod.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 802334f6f..8ea6651ea 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -95,6 +95,8 @@ module med_diag_mod character(*), parameter :: FA1 = "(' ',a12,6f15.8)" character(*), parameter :: FA0r = "(' ',12x,8(6x,a8,1x))" character(*), parameter :: FA1r = "(' ',a12,8f15.8)" + character(*), parameter :: FA0s = "(' ',12x,8(7x,a8,2x))" + character(*), parameter :: FA1s = "(' ',a12,8g18.8)" ! --------------------------------- ! C for component @@ -2683,7 +2685,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,'NET SALT BUDGET (kg/m2s): period = ',& trim(budget_diags%periods(ip)%name), ': date = ',date,tod - write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' + write(diagunit,FA0s) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' do nf = f_salt_beg, f_salt_end net_salt_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) net_salt_lnd = data(nf, c_lnd_recv, ip) + data(nf, c_lnd_send, ip) @@ -2695,7 +2697,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) net_salt_tot = net_salt_atm + net_salt_lnd + net_salt_rof + net_salt_ocn + & net_salt_ice_nh + net_salt_ice_sh + net_salt_glc - write(diagunit,FA1r) budget_diags%fields(nf)%name,& + write(diagunit,FA1s) budget_diags%fields(nf)%name,& net_salt_atm, net_salt_lnd, net_salt_rof, net_salt_ocn, & net_salt_ice_nh, net_salt_ice_sh, net_salt_glc, net_salt_tot enddo @@ -2718,7 +2720,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) sum_net_salt_tot = sum_net_salt_atm + sum_net_salt_lnd + sum_net_salt_rof + sum_net_salt_ocn + & sum_net_salt_ice_nh + sum_net_salt_ice_sh + sum_net_salt_glc - write(diagunit,FA1r)' *SUM*',& + write(diagunit,FA1s)' *SUM*',& sum_net_salt_atm, sum_net_salt_lnd, sum_net_salt_rof, sum_net_salt_ocn, & sum_net_salt_ice_nh, sum_net_salt_ice_sh, sum_net_salt_glc, sum_net_salt_tot end if From 311582ca09f91feca75c7d411e620e3c28648019 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Sat, 6 May 2023 13:29:39 -0600 Subject: [PATCH 45/92] This fails to enable writing of 'daily' files from forecasts shorter than 24 hours --- cime_config/namelist_definition_drv.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index d403caad1..d62eacc57 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1526,7 +1526,7 @@ MED_attributes history option type - ndays + nhours @@ -1989,7 +1989,7 @@ MED_attributes history option type - ndays + nhours @@ -1998,7 +1998,7 @@ MED_attributes history option type - 1 + 6 From 83bba42b9671e2c76c73db654d884fcf2f2082b6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 13:51:06 +0200 Subject: [PATCH 46/92] updated counters for nans --- mediator/med_methods_mod.F90 | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index e9d545a99..5188ed9f2 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2515,16 +2515,17 @@ subroutine med_methods_FB_check_for_nans(FB, rc) integer , intent(inout) :: rc ! local variables - type(ESMF_Field) :: field - integer :: index - integer :: fieldcount - integer :: fieldrank - character(len=CL) :: fieldname - real(r8) , pointer :: dataptr1d(:) - real(r8) , pointer :: dataptr2d(:,:) - integer :: nancount - character(len=CS) :: nancount_char - logical :: nanfound + type(ESMF_Field) :: field + integer :: index + integer :: fieldcount + integer :: fieldrank + character(len=CL) :: fieldname + real(r8) , pointer :: dataptr1d(:) + real(r8) , pointer :: dataptr2d(:,:) + integer :: nancount + character(len=CS) :: nancount_char + character(len=CL) :: msg_error + logical :: nanfound character(len=*), parameter :: subname='(med_methods_FB_check_for_nans)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -2543,21 +2544,22 @@ subroutine med_methods_FB_check_for_nans(FB, rc) if (fieldrank == 1) then call ESMF_FieldGet(field, farrayPtr=dataptr1d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_check_for_nans(dataptr1d, nancount) + call med_methods_check_for_nans(dataptr1d, nancount) else call ESMF_FieldGet(field, farrayPtr=dataptr2d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_check_for_nans(dataptr2d, nancount) + call med_methods_check_for_nans(dataptr2d, nancount) end if if (nancount > 0) then write(nancount_char, '(i0)') nancount - call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(fieldname), & - ESMF_LOGMSG_WARNING) + msg_error = "ERROR: " // trim(nancount_char) //" nans found in "//trim(fieldname) + call ESMF_LogWrite(trim(msg_error), ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) nanfound = .true. end if end do if (nanfound) then - call ESMF_LogWrite(trim(subname)//": ERROR nans found in export field bundle ",ESMF_LOGMSG_ERROR) + call ESMF_LogWrite('ABORTING JOB', ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE return end if @@ -2565,6 +2567,7 @@ end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- subroutine med_methods_check_for_nans_1d(dataptr, nancount) + use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) ! input/output variables real(r8) , intent(in) :: dataptr(:) integer , intent(out) :: nancount @@ -2581,6 +2584,7 @@ subroutine med_methods_check_for_nans_1d(dataptr, nancount) end subroutine med_methods_check_for_nans_1d subroutine med_methods_check_for_nans_2d(dataptr, nancount) + use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) ! input/output variables real(r8) , intent(in) :: dataptr(:,:) integer , intent(out) :: nancount From 0b59db6514a76cf8369cdbeb5c829e58e44b9df5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 13:55:09 +0200 Subject: [PATCH 47/92] consistent alias of use statements for check_for_nans --- mediator/med_phases_prep_glc_mod.F90 | 4 ++-- mediator/med_phases_prep_lnd_mod.F90 | 4 ++-- mediator/med_phases_prep_rof_mod.F90 | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 2861f3324..97049d5b9 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -34,7 +34,7 @@ module med_phases_prep_glc_mod use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_init => med_methods_FB_init - use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_utils_mod , only : chkerr => med_utils_ChkErr @@ -709,7 +709,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) ! Check for nans in fields export to atm do ns = 1,is_local%wrap%num_icesheets - call fldbun_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 93780c254..b73412937 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -29,7 +29,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND use esmFlds , only : med_fldList_GetFldListTo, med_fldList_type use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose - use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : complnd, compatm @@ -129,7 +129,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) first_call = .false. ! Check for nans in fields export to atm - call fldbun_check_for_nans(is_local%wrap%FBExp(complnd), rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(complnd), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 8d690124a..cf0ad0f4e 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -23,7 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_average => med_methods_FB_average use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d - use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use perf_mod , only : t_startf, t_stopf implicit none @@ -378,7 +378,7 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call fldbun_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then From 64439f74578d01ece0f4a87b41f6c25897751321 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 14:03:16 +0200 Subject: [PATCH 48/92] fixed compilation bug --- mediator/med_methods_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 5188ed9f2..8c781e7c3 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2567,7 +2567,8 @@ end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- subroutine med_methods_check_for_nans_1d(dataptr, nancount) - use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) + use shr_infnan_mod, only: nan => isnan + ! input/output variables real(r8) , intent(in) :: dataptr(:) integer , intent(out) :: nancount @@ -2584,7 +2585,8 @@ subroutine med_methods_check_for_nans_1d(dataptr, nancount) end subroutine med_methods_check_for_nans_1d subroutine med_methods_check_for_nans_2d(dataptr, nancount) - use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) + use shr_infnan_mod, only: isnan + ! input/output variables real(r8) , intent(in) :: dataptr(:,:) integer , intent(out) :: nancount From 5e02def6328fc0352cae83e2f366604c712caf8b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 14:26:13 +0200 Subject: [PATCH 49/92] add ability to compile without needed shr_infnan - as is the case for UFS --- mediator/med_methods_mod.F90 | 45 ++++++++++++++++++++++++++++-------- 1 file changed, 35 insertions(+), 10 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 8c781e7c3..3d29fde6f 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2530,6 +2530,11 @@ subroutine med_methods_FB_check_for_nans(FB, rc) ! ---------------------------------------------- rc = ESMF_SUCCESS +#ifndef CESM_COUPLED + ! For now only CESM uses shr_infnan_isnan - so until other models provide this + RETURN +#endif + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2566,42 +2571,62 @@ subroutine med_methods_FB_check_for_nans(FB, rc) end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- - subroutine med_methods_check_for_nans_1d(dataptr, nancount) - use shr_infnan_mod, only: nan => isnan +#ifdef CESM_COUPLED + subroutine med_methods_check_for_nans_1d(dataptr, nancount) + use shr_infnan_mod, only: shr_infnan_isnan ! input/output variables real(r8) , intent(in) :: dataptr(:) integer , intent(out) :: nancount - ! local variables integer :: n - ! ---------------------------------------------- + nancount = 0 do n = 1,size(dataptr) - if (isnan(dataptr(n))) then + if (shr_infnan_isnan(dataptr(n))) then nancount = nancount + 1 end if end do end subroutine med_methods_check_for_nans_1d subroutine med_methods_check_for_nans_2d(dataptr, nancount) - use shr_infnan_mod, only: isnan - + use shr_infnan_mod, only: shr_infan_isnan ! input/output variables real(r8) , intent(in) :: dataptr(:,:) integer , intent(out) :: nancount - ! local variables integer :: n,k - ! ---------------------------------------------- + nancount = 0 do k = 1,size(dataptr, dim=1) do n = 1,size(dataptr, dim=2) - if (isnan(dataptr(k,n))) then + if (shr_infan_isnan(dataptr(k,n))) then nancount = nancount + 1 end if end do end do end subroutine med_methods_check_for_nans_2d +#else + + ! For now only CESM uses shr_infnan_isnan - so until other models provide this + ! nancount will just be set to zero + + subroutine med_methods_check_for_nans_1d(dataptr, nancount) + ! input/output variables + real(r8) , intent(in) :: dataptr(:) + integer , intent(out) :: nancount + + nancount = 0 + end subroutine med_methods_check_for_nans_1d + + subroutine med_methods_check_for_nans_2d(dataptr, nancount) + ! input/output variables + real(r8) , intent(in) :: dataptr(:,:) + integer , intent(out) :: nancount + + nancount = 0 + end subroutine med_methods_check_for_nans_2d +#endif + end module med_methods_mod From f1dedf5899b446b2fede15932eede85d5599b42d Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Tue, 9 May 2023 15:08:05 -0400 Subject: [PATCH 50/92] Changed Fwxx_taux merge to use 'wfrac' --- mediator/esmFldsExchange_cesm_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 9146ee728..068acb503 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3012,7 +3012,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') ! end if call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='wfrac') +! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if From 2685626c2c47d6801b72744c0ac90b98ace261a2 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 10 May 2023 12:58:00 -0400 Subject: [PATCH 51/92] Adding merge to wave component Fwxx_taux based on Foxx_taux --- mediator/esmFldsExchange_cesm_mod.F90 | 33 ++++++++++++--------------- 1 file changed, 15 insertions(+), 18 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 068acb503..87fdee38f 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2983,6 +2983,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_to(compwav , 'Fwxx_taux') + call addfld_from(compice , 'Fioi_taux') + call addfld_aoflux('Faox_taux') + else + if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then + if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') + call addmrg_to(compwav, 'Fwxx_taux', & + mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + end if + call addmrg_to(compocn, 'Fwxx_taux', & + mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + end if + end if ! if (phase == 'advertise') then ! call addfld_to(compwav , 'Fwxx_taux') !! call addfld_from(compice , 'Fioi_taux') @@ -2999,24 +3014,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') ! end if ! end if -!! - if (phase == 'advertise') then - call addfld_to(compwav , 'Fwxx_taux') -! call addfld_from(compice , 'Fioi_taux') - call addfld_aoflux('Faox_taux') - else - if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then -! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then -! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') -! call addmrg_to(compwav, 'Fwxx_taux', & -! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') -! end if - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='wfrac') -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') - end if - end if !PSH end !===================================================================== From 9d4e81c5169b0a8ca750a063e3340882ab6225d3 Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 10 May 2023 14:19:12 -0400 Subject: [PATCH 52/92] Fixed a compocn that should have been compwav --- mediator/esmFldsExchange_cesm_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 87fdee38f..397a92ba1 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2994,7 +2994,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compwav, 'Fwxx_taux', & mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') end if - call addmrg_to(compocn, 'Fwxx_taux', & + call addmrg_to(compwav, 'Fwxx_taux', & mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') end if end if From 3ca2795f9febd5422497a2c63f423e57e2cb4aaa Mon Sep 17 00:00:00 2001 From: Paul Hall <45795415+phall-brown@users.noreply.github.com> Date: Wed, 10 May 2023 15:21:48 -0400 Subject: [PATCH 53/92] Adding ifrac and ofrac to fraclist_w --- mediator/med_fraction_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 2a410aace..ded0e4e7d 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -130,8 +130,8 @@ module med_fraction_mod character(len=6),parameter,dimension(2) :: fraclist_g = (/'gfrac ','lfrac '/) character(len=6),parameter,dimension(2) :: fraclist_r = (/'rfrac ','lfrac '/) !PSH begin - character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) -! character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) +! character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) + character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) !PSH end !--- standard --- real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) From 7ac3ca9a8d331ee6e09e43458478ed29626293f2 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 10 May 2023 13:40:40 -0600 Subject: [PATCH 54/92] make history_n integer variables --- cime_config/namelist_definition_drv.xml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 0ade5db43..501d6896e 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1264,7 +1264,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1329,7 +1329,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1396,7 +1396,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1465,7 +1465,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1530,7 +1530,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1748,7 +1748,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1830,7 +1830,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1993,7 +1993,7 @@ - char + integer aux_hist MED_attributes history option type From b22ae222b571f7e5196052d581c74ce6d2611be0 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 10 May 2023 13:44:49 -0600 Subject: [PATCH 55/92] sames should be samples --- cime_config/namelist_definition_drv.xml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 501d6896e..5cbf78319 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1294,7 +1294,7 @@ integer aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 24 @@ -1350,7 +1350,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 24 @@ -1417,7 +1417,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 8 @@ -1486,7 +1486,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 8 @@ -1551,7 +1551,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 1 @@ -1769,7 +1769,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 1 @@ -1860,7 +1860,7 @@ integer aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 30 @@ -2014,7 +2014,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 1 From cca94e4b7bf6e39fa19ddfc865749da08f8dccaa Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 10 May 2023 16:09:27 -0600 Subject: [PATCH 56/92] wopen should return rc --- mediator/med_io_mod.F90 | 33 ++++++++++++++--------------- mediator/med_phases_history_mod.F90 | 18 ++++++++++------ mediator/med_phases_restart_mod.F90 | 3 ++- 3 files changed, 30 insertions(+), 24 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 97db9bcc0..38ae201f2 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -7,7 +7,7 @@ module med_io_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, I8=>SHR_KIND_I8, R8=>SHR_KIND_R8 use med_kind_mod , only : R4=>SHR_KIND_R4 use med_constants_mod , only : fillvalue => SHR_CONST_SPVAL - use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError + use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError, ESMF_LOGMSG_ERROR use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_END_ABORT, ESMF_LOGERR_PASSTHRU use ESMF , only : ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadCast, ESMF_Finalize use NUOPC , only : NUOPC_FieldDictionaryGetEntry @@ -198,7 +198,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. '64BIT_DATA') then pio_ioformat = PIO_64BIT_DATA else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_ioformat (CLASSIC|64BIT_OFFSET|64BIT_DATA)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_ioformat (CLASSIC|64BIT_OFFSET|64BIT_DATA)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -223,7 +223,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'NETCDF4P') then pio_iotype = PIO_IOTYPE_NETCDF4P else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_typename (NETCDF|PNETCDF|NETCDF4C|NETCDF4P)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_typename (NETCDF|PNETCDF|NETCDF4C|NETCDF4P)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -334,13 +334,13 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'SUBSET') then pio_rearranger = PIO_REARR_SUBSET else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearranger (BOX|SUBSET)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearranger (BOX|SUBSET)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if else - cvalue = 'BOX' - pio_rearranger = PIO_REARR_BOX + cvalue = 'SUBSET' + pio_rearranger = PIO_REARR_SUBSET end if if (localPet == 0) write(logunit,*) trim(subname), ' : pio_rearranger = ', trim(cvalue), pio_rearranger @@ -357,7 +357,7 @@ subroutine med_io_init(gcomp, rc) if (isPresent .and. isSet) then read(cvalue,*) pio_debug_level if (pio_debug_level < 0 .or. pio_debug_level > 6) then - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_debug_level (0-6)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_debug_level (0-6)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -381,7 +381,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'COLL') then pio_rearr_comm_type = PIO_REARR_COMM_COLL else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_type (P2P|COLL)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_type (P2P|COLL)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -406,7 +406,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. '2DDISABLE') then pio_rearr_comm_fcd = PIO_REARR_COMM_FC_2D_DISABLE else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_fcd (2DENABLE|IO2COMP|COMP2IO|2DDISABLE)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_fcd (2DENABLE|IO2COMP|COMP2IO|2DDISABLE)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -498,7 +498,7 @@ subroutine med_io_init(gcomp, rc) end subroutine med_io_init !=============================================================================== - subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) + subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) !--------------- ! open netcdf file @@ -512,16 +512,15 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) ! input/output arguments character(*), intent(in) :: filename type(ESMF_VM) :: vm + integer, intent(out) :: rc logical, optional, intent(in) :: clobber integer, optional, intent(in) :: file_ind character(CL), optional, intent(in) :: model_doi_url - ! local variables logical :: lclobber integer :: rcode integer :: nmode integer :: lfile_ind - integer :: rc integer :: iam character(CL) :: lversion character(CL) :: lmodel_doi_url @@ -539,10 +538,11 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - if (.not. pio_file_is_open(io_file(lfile_ind))) then + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (.not. pio_file_is_open(io_file(lfile_ind))) then ! filename not open wfilename(lfile_ind) = trim(filename) @@ -589,7 +589,7 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) end if - call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return @@ -848,7 +848,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif - rc = ESMF_Success return endif diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 2f7c9f062..00444b292 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -292,7 +292,8 @@ subroutine med_phases_history_write(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Loop over whead/wdata phases do m = 1,2 @@ -463,7 +464,8 @@ subroutine med_phases_history_write_med(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then @@ -596,7 +598,8 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data to history file do m = 1,2 @@ -749,7 +752,8 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then @@ -953,7 +957,8 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then @@ -1276,7 +1281,8 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! open file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(auxcomp%files(nf)%histfile, vm, file_ind=nf, clobber=.true.) + call med_io_wopen(auxcomp%files(nf)%histfile, vm, rc, file_ind=nf, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define time variables call ESMF_ClockGet(auxcomp%files(nf)%clock, calendar=calendar, rc=rc) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 6bf5f3466..3b276b08e 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -309,7 +309,8 @@ subroutine med_phases_restart_write(gcomp, rc) call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(restart_file, vm, clobber=.true.) + call med_io_wopen(restart_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 if (m == 2) then From a31664644ec8e90d3a53bcc11602fc5e3eb6774f Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 11 May 2023 10:23:32 -0600 Subject: [PATCH 57/92] major refactor of med_io_mod to handle multiple files --- mediator/med_io_mod.F90 | 345 +++++++++++----------------- mediator/med_phases_history_mod.F90 | 116 +++++----- mediator/med_phases_restart_mod.F90 | 53 ++--- 3 files changed, 227 insertions(+), 287 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 38ae201f2..9215777c0 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -77,8 +77,9 @@ module med_io_mod character(*),parameter :: version = "cmeps0" integer , parameter :: number_strlen = 8 integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now - character(CL) :: wfilename(0:file_desc_t_cnt) = '' - type(file_desc_t) :: io_file(0:file_desc_t_cnt) + +! character(CL) :: wfilename(0:file_desc_t_cnt) = '' + integer :: pio_iotype integer :: pio_ioformat type(iosystem_desc_t), pointer :: io_subsystem @@ -498,7 +499,7 @@ subroutine med_io_init(gcomp, rc) end subroutine med_io_init !=============================================================================== - subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) + subroutine med_io_wopen(filename, io_file, vm, rc, clobber, file_ind, model_doi_url) !--------------- ! open netcdf file @@ -511,6 +512,7 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) ! input/output arguments character(*), intent(in) :: filename + type(file_desc_t), intent(inout) :: io_file type(ESMF_VM) :: vm integer, intent(out) :: rc logical, optional, intent(in) :: clobber @@ -542,10 +544,10 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not. pio_file_is_open(io_file(lfile_ind))) then + if (.not. pio_file_is_open(io_file)) then ! filename not open - wfilename(lfile_ind) = trim(filename) +! wfilename(lfile_ind) = trim(filename) if (med_io_file_exists(vm, filename)) then if (lclobber) then @@ -554,20 +556,20 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then nmode = ior(nmode,pio_ioformat) endif - rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + rcode = pio_createfile(io_subsystem, io_file, pio_iotype, trim(filename), nmode) if(iam==0) write(logunit,'(a)') trim(subname)//' creating file '//trim(filename) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + rcode = pio_put_att(io_file,pio_global,"file_version",version) + rcode = pio_put_att(io_file,pio_global,"model_doi_url",lmodel_doi_url) else - rcode = pio_openfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), pio_write) + rcode = pio_openfile(io_subsystem, io_file, pio_iotype, trim(filename), pio_write) if (iam==0) write(logunit,'(a)') trim(subname)//' opening file '//trim(filename) - call pio_seterrorhandling(io_file(lfile_ind),PIO_BCAST_ERROR) - rcode = pio_get_att(io_file(lfile_ind),pio_global,"file_version",lversion) - call pio_seterrorhandling(io_file(lfile_ind),PIO_INTERNAL_ERROR) + call pio_seterrorhandling(io_file,PIO_BCAST_ERROR) + rcode = pio_get_att(io_file,pio_global,"file_version",lversion) + call pio_seterrorhandling(io_file,PIO_INTERNAL_ERROR) if (trim(lversion) /= trim(version)) then - rcode = pio_redef(io_file(lfile_ind)) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_enddef(io_file(lfile_ind)) + rcode = pio_redef(io_file) + rcode = pio_put_att(io_file,pio_global,"file_version",version) + rcode = pio_enddef(io_file) endif endif else @@ -577,21 +579,21 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) nmode = ior(nmode,pio_ioformat) endif - rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + rcode = pio_createfile(io_subsystem, io_file, pio_iotype, trim(filename), nmode) if (iam==0) write(logunit,'(a)') trim(subname) //' creating file '// trim(filename) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + rcode = pio_put_att(io_file,pio_global,"file_version",version) + rcode = pio_put_att(io_file,pio_global,"model_doi_url",lmodel_doi_url) endif - elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then +! elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then ! filename is open, better match open filename - if (iam==0) then - write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) - write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) - end if - call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return +! if (iam==0) then +! write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) +! write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) +! end if +! call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) +! rc = ESMF_FAILURE +! return else ! filename is already open, just return @@ -600,7 +602,7 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) end subroutine med_io_wopen !=============================================================================== - subroutine med_io_close(filename, vm, file_ind, rc) + subroutine med_io_close(io_file, rc) !--------------- ! close netcdf file @@ -609,85 +611,52 @@ subroutine med_io_close(filename, vm, file_ind, rc) use pio, only: pio_file_is_open, pio_closefile ! input/output variables - character(*) , intent(in) :: filename - type(ESMF_VM) , intent(in) :: vm - integer,optional , intent(in) :: file_ind + type(file_desc_t) :: io_file integer , intent(out) :: rc ! local variables - integer :: lfile_ind + integer :: iam character(*),parameter :: subName = '(med_io_close) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - - if (.not. pio_file_is_open(io_file(lfile_ind))) then - ! filename not open, just return - elseif (trim(wfilename(lfile_ind)) == trim(filename)) then - ! filename matches, close it - call pio_closefile(io_file(lfile_ind)) - !wfilename(lfile_ind) = '' - else - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! different filename is open, abort - if (iam==0) then - write(logunit,*) subname,' different wfilename and filename currently open, aborting ' - write(logunit,'(a)') 'filename = ',trim(filename) - write(logunit,'(a)') 'wfilename = ',trim(wfilename(lfile_ind)) - write(logunit,'(i6)')'lfile_ind = ',lfile_ind - end if - call ESMF_LogWrite(subname//'different file currently open, aborting '//trim(filename), ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if + if (pio_file_is_open(io_file)) then + call pio_closefile(io_file) endif end subroutine med_io_close !=============================================================================== - subroutine med_io_redef(filename,file_ind) + subroutine med_io_redef(io_file) use pio, only : pio_redef ! input/output variables - character(len=*), intent(in) :: filename - integer,optional,intent(in):: file_ind - + type(file_desc_t) :: io_file ! local variables - integer :: lfile_ind integer :: rcode !------------------------------------------------------------------------------- - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - rcode = pio_redef(io_file(lfile_ind)) + rcode = pio_redef(io_file) end subroutine med_io_redef !=============================================================================== - subroutine med_io_enddef(filename,file_ind) + subroutine med_io_enddef(io_file) use pio, only : pio_enddef ! input/output variables - character(len=*) , intent(in) :: filename - integer,optional , intent(in) :: file_ind + type(file_desc_t) :: io_file ! local variables - integer :: lfile_ind + integer :: rcode !------------------------------------------------------------------------------- - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - rcode = pio_enddef(io_file(lfile_ind)) + rcode = pio_enddef(io_file) end subroutine med_io_enddef @@ -746,8 +715,8 @@ character(len=8) function med_io_sec2hms (seconds, rc) end function med_io_sec2hms !=============================================================================== - subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & - fillval, pre, flds, tavg, use_float, file_ind, tilesize, rc) + subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & + fillval, pre, flds, tavg, use_float, tilesize, rc) !--------------- ! Write FB to netcdf file @@ -765,7 +734,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & use pio , only : pio_syncfile ! input/output variables - character(len=*) , intent(in) :: filename ! file + type(file_desc_t) :: io_file type(ESMF_FieldBundle) , intent(in) :: FB ! data to be written logical , intent(in) :: whead ! write header logical , intent(in) :: wdata ! write data @@ -777,7 +746,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & character(len=*), optional , intent(in) :: flds(:) ! specific fields to write out logical, optional , intent(in) :: tavg ! is this a tavg logical, optional , intent(in) :: use_float ! write output as float rather than double - integer, optional , intent(in) :: file_ind integer, optional , intent(in) :: tilesize ! if non-zero, write atm component on tiles integer , intent(out):: rc @@ -811,7 +779,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & integer, pointer :: maxIndexPTile(:,:) integer :: dimCount, tileCount integer, pointer :: Dof(:) - integer :: lfile_ind real(r8), pointer :: fldptr1(:) real(r8), pointer :: fldptr2(:,:) real(r8), allocatable :: ownedElemCoords(:), ownedElemCoords_x(:), ownedElemCoords_y(:) @@ -835,8 +802,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & if (present(pre)) lpre = trim(pre) luse_float = .false. if (present(use_float)) luse_float = use_float - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind + atmtiles = .false. if (present(tilesize)) then if (tilesize > 0) atmtiles = .true. @@ -953,22 +919,22 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & ! Write header if (whead) then if (atmtiles) then - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_nx', lnx, dimid3(1)) - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ny', lny, dimid3(2)) - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ntiles', ntiles, dimid3(3)) + rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid3(1)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid3(2)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ntiles', ntiles, dimid3(3)) if (present(nt)) then dimid4(1:3) = dimid3 - rcode = pio_inq_dimid(io_file(lfile_ind), 'time', dimid4(4)) + rcode = pio_inq_dimid(io_file, 'time', dimid4(4)) dimid => dimid4 else dimid => dimid3 endif else - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_nx', lnx, dimid2(1)) - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ny', lny, dimid2(2)) + rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid2(1)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid2(2)) if (present(nt)) then dimid3(1:2) = dimid2 - rcode = pio_inq_dimid(io_file(lfile_ind), 'time', dimid3(3)) + rcode = pio_inq_dimid(io_file, 'time', dimid3(3)) dimid => dimid3 else dimid => dimid2 @@ -1007,21 +973,21 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) call ESMF_LogWrite(trim(subname)//': defining '//trim(name1), ESMF_LOGMSG_INFO) if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid,"_FillValue",real(lfillvalue,r4)) + rcode = pio_def_var(io_file, trim(name1), PIO_REAL, dimid, varid) + rcode = pio_put_att(io_file, varid,"_FillValue",real(lfillvalue,r4)) else - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"_FillValue",lfillvalue) + rcode = pio_def_var(io_file, trim(name1), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file,varid,"_FillValue",lfillvalue) end if if (NUOPC_FieldDictionaryHasEntry(trim(itemc))) then call NUOPC_FieldDictionaryGetEntry(itemc, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind), varid, "units" , trim(cunit)) + rcode = pio_put_att(io_file, varid, "units" , trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + rcode = pio_put_att(io_file, varid, "standard_name", trim(name1)) if (present(tavg)) then if (tavg) then - rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + rcode = pio_put_att(io_file, varid, "cell_methods", "time: mean") endif endif end if @@ -1030,21 +996,21 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & name1 = trim(lpre)//'_'//trim(itemc) call ESMF_LogWrite(trim(subname)//':'//trim(itemc)//':'//trim(name1),ESMF_LOGMSG_INFO) if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, "_FillValue", real(lfillvalue, r4)) + rcode = pio_def_var(io_file, trim(name1), PIO_REAL, dimid, varid) + rcode = pio_put_att(io_file, varid, "_FillValue", real(lfillvalue, r4)) else - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, "_FillValue", lfillvalue) + rcode = pio_def_var(io_file, trim(name1), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file, varid, "_FillValue", lfillvalue) end if if (NUOPC_FieldDictionaryHasEntry(trim(itemc))) then call NUOPC_FieldDictionaryGetEntry(itemc, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(cunit)) + rcode = pio_put_att(io_file, varid, "units", trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + rcode = pio_put_att(io_file, varid, "standard_name", trim(name1)) if (present(tavg)) then if (tavg) then - rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + rcode = pio_put_att(io_file, varid, "cell_methods", "time: mean") endif end if end if @@ -1054,13 +1020,13 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & ! Add coordinate information to file do n = 1,ndims if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_REAL, dimid, varid) + rcode = pio_def_var(io_file, trim(coordvarnames(n)), PIO_REAL, dimid, varid) else - rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_DOUBLE, dimid, varid) + rcode = pio_def_var(io_file, trim(coordvarnames(n)), PIO_DOUBLE, dimid, varid) end if - rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", trim(coordnames(n))) - rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(coordunits(n))) - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(coordnames(n))) + rcode = pio_put_att(io_file, varid, "long_name", trim(coordnames(n))) + rcode = pio_put_att(io_file, varid, "units", trim(coordunits(n))) + rcode = pio_put_att(io_file, varid, "standard_name", trim(coordnames(n))) end do end if @@ -1106,38 +1072,38 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & do n = 1,ungriddedUBound(1) write(cnumber,'(i0)') n name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) - rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) + rcode = pio_inq_varid(io_file, trim(name1), varid) + call pio_setframe(io_file,varid,frame) if (gridToFieldMap(1) == 1) then - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) + call pio_write_darray(io_file, varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) else if (gridToFieldMap(1) == 2) then - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) + call pio_write_darray(io_file, varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) end if end do else if (rank == 1 .or. rank == 0) then name1 = trim(lpre)//'_'//trim(itemc) - rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) + rcode = pio_inq_varid(io_file, trim(name1), varid) + call pio_setframe(io_file,varid,frame) ! fix for writing data on exchange grid, which has no data in some PETs if (rank == 0) nullify(fldptr1) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr1, rcode, fillval=lfillvalue) + call pio_write_darray(io_file, varid, iodesc, fldptr1, rcode, fillval=lfillvalue) end if ! end if rank is 2 or 1 or 0 end if ! end if not "hgt" end do ! end loop over fields in FB ! Fill coordinate variables - why is this being done each time? - rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(1)), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) + rcode = pio_inq_varid(io_file, trim(coordvarnames(1)), varid) + call pio_setframe(io_file,varid,frame) + call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) - rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(2)), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) + rcode = pio_inq_varid(io_file, trim(coordvarnames(2)), varid) + call pio_setframe(io_file,varid,frame) + call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) - call pio_syncfile(io_file(lfile_ind)) - call pio_freedecomp(io_file(lfile_ind), iodesc) + call pio_syncfile(io_file) + call pio_freedecomp(io_file, iodesc) endif deallocate(ownedElemCoords, ownedElemCoords_x, ownedElemCoords_y) @@ -1148,7 +1114,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & end subroutine med_io_write_FB !=============================================================================== - subroutine med_io_write_int(filename, idata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_int(io_file, idata, dname, whead, wdata, rc) use pio, only : var_desc_t, pio_def_var, pio_put_att, pio_int, pio_inq_varid, pio_put_var @@ -1157,45 +1123,40 @@ subroutine med_io_write_int(filename, idata, dname, whead, wdata, file_ind, rc) !--------------- ! intput/output variables - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file integer ,intent(in) :: idata ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables integer :: rcode type(var_desc_t) :: varid character(CL) :: cunit ! var units - integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_int) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - if (whead) then if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_def_var(io_file,trim(dname),PIO_INT,varid) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) endif if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,idata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,idata) endif end subroutine med_io_write_int !=============================================================================== - subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_int1d(io_file, idata, dname, whead, wdata, file_ind, rc) !--------------- ! Write 1d integer array to netcdf file @@ -1206,7 +1167,7 @@ subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc use pio , only : pio_int, pio_def_var ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file integer ,intent(in) :: idata(:) ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header @@ -1233,21 +1194,21 @@ subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if lnx = size(idata) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname),lnx,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,dimid,varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_def_dim(io_file,trim(dname),lnx,dimid(1)) + rcode = pio_def_var(io_file,trim(dname),PIO_INT,dimid,varid) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) else if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,idata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,idata) endif end subroutine med_io_write_int1d !=============================================================================== - subroutine med_io_write_r8(filename, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_r8(io_file, rdata, dname, whead, wdata, rc) !--------------- ! Write scalar double to netcdf file @@ -1257,48 +1218,41 @@ subroutine med_io_write_r8(filename, rdata, dname, whead, wdata, file_ind, rc) use pio , only : pio_double, pio_noerr, pio_inq_varid, pio_put_var ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + type(file_desc_T) :: io_file real(r8) ,intent(in) :: rdata ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables integer :: rcode type(var_desc_t) :: varid character(CL) :: cunit ! var units - integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_r8) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(present(file_ind)) then - lfile_ind = file_ind - else - lfile_ind = 1 - endif if (whead) then - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,varid) + rcode = pio_def_var(io_file,trim(dname),PIO_DOUBLE,varid) if (rcode==PIO_NOERR) then if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) end if else if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,rdata) endif end subroutine med_io_write_r8 !=============================================================================== - subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_r81d(io_file, rdata, dname, whead, wdata, rc) !--------------- ! Write 1d double array to netcdf file @@ -1308,12 +1262,11 @@ subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) use pio , only : pio_inq_varid, pio_put_var, pio_double, pio_put_att ! !INPUT/OUTPUT PARAMETERS: - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file real(r8) ,intent(in) :: rdata(:) ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables @@ -1322,38 +1275,32 @@ subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) type(var_desc_t) :: varid character(CL) :: cunit ! var units integer :: lnx - integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_r81d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(present(file_ind)) then - lfile_ind = file_ind - else - lfile_ind = 1 - endif if (whead) then lnx = size(rdata) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,dimid,varid) + rcode = pio_def_dim(io_file,trim(dname)//'_nx',lnx,dimid(1)) + rcode = pio_def_var(io_file,trim(dname),PIO_DOUBLE,dimid,varid) if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) endif if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,rdata) endif end subroutine med_io_write_r81d !=============================================================================== - subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_char(io_file, rdata, dname, whead, wdata, rc) !--------------- ! Write char string to netcdf file @@ -1363,12 +1310,11 @@ subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) use pio , only : pio_char, pio_put_var ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file character(len=*) ,intent(in) :: rdata ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables @@ -1377,37 +1323,32 @@ subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) type(var_desc_t) :: varid character(CL) :: cunit ! var units integer :: lnx - integer :: lfile_ind character(CL) :: charvar ! buffer for string read/write character(*),parameter :: subName = '(med_io_write_char) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(present(file_ind)) then - lfile_ind = file_ind - else - lfile_ind = 1 - endif + if (whead) then lnx = len(charvar) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_len',lnx,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_CHAR,dimid,varid) + rcode = pio_def_dim(io_file,trim(dname)//'_len',lnx,dimid(1)) + rcode = pio_def_var(io_file,trim(dname),PIO_CHAR,dimid,varid) if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) else if (wdata) then charvar = '' charvar = trim(rdata) - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,charvar) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,charvar) endif end subroutine med_io_write_char !=============================================================================== - subroutine med_io_define_time(time_units, calendar, file_ind, rc) + subroutine med_io_define_time(io_file, time_units, calendar, rc) use ESMF, only : operator(==), operator(/=) use ESMF, only : ESMF_Calendar, ESMF_CalendarIsCreated @@ -1420,9 +1361,9 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) use pio , only : pio_inq_varid, pio_put_var ! input/output variables + type(file_desc_t) :: io_file character(len=*) , intent(in) :: time_units ! units of time type(ESMF_Calendar) , intent(in) :: calendar ! calendar - integer, optional , intent(in) :: file_ind integer , intent(out):: rc ! local variables @@ -1430,16 +1371,12 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) integer :: dimid(1) integer :: dimid2(2) type(var_desc_t) :: varid - integer :: lfile_ind character(CL) :: calname ! calendar name character(*),parameter :: subName = '(med_io_define_time) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - if (.not. ESMF_CalendarIsCreated(calendar)) then call ESMF_LogWrite(trim(subname)//' ERROR: calendar is not created ', & ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) @@ -1448,9 +1385,9 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) end if ! define time and add calendar attribute - rcode = pio_def_dim(io_file(lfile_ind), 'time', PIO_UNLIMITED, dimid(1)) - rcode = pio_def_var(io_file(lfile_ind), 'time', PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, 'units', trim(time_units)) + rcode = pio_def_dim(io_file, 'time', PIO_UNLIMITED, dimid(1)) + rcode = pio_def_var(io_file, 'time', PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file, varid, 'units', trim(time_units)) if (calendar == ESMF_CALKIND_360DAY) then calname = '360_day' else if (calendar == ESMF_CALKIND_GREGORIAN) then @@ -1466,18 +1403,18 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) else if (calendar == ESMF_CALKIND_NOLEAP) then calname = 'noleap' end if - rcode = pio_put_att(io_file(lfile_ind), varid, 'calendar', trim(calname)) + rcode = pio_put_att(io_file, varid, 'calendar', trim(calname)) ! define time bounds dimid2(2) = dimid(1) - rcode = pio_def_dim(io_file(lfile_ind), 'ntb', 2, dimid2(1)) - rcode = pio_def_var(io_file(lfile_ind), 'time_bnds', PIO_DOUBLE, dimid2, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, 'bounds', 'time_bnds') + rcode = pio_def_dim(io_file, 'ntb', 2, dimid2(1)) + rcode = pio_def_var(io_file, 'time_bnds', PIO_DOUBLE, dimid2, varid) + rcode = pio_put_att(io_file, varid, 'bounds', 'time_bnds') end subroutine med_io_define_time !=============================================================================== - subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) + subroutine med_io_write_time(io_file, time_val, tbnds, nt, rc) !--------------- ! Write time variable to netcdf file @@ -1486,15 +1423,14 @@ subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) use pio, only : pio_put_att, pio_inq_varid, pio_put_var ! input/output variables + type(file_desc_t) :: io_file real(r8) , intent(in) :: time_val ! data to be written real(r8) , intent(in) :: tbnds(2) ! time bounds integer , intent(in) :: nt - integer , optional, intent(in) :: file_ind integer , intent(out):: rc ! local variables integer :: rcode - integer :: lfile_ind integer :: varid integer :: start(2),count(2) character(*),parameter :: subName = '(med_io_write_time) ' @@ -1502,19 +1438,16 @@ subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - ! write time count = 1; start = nt - rcode = pio_inq_varid(io_file(lfile_ind), 'time', varid) - rcode = pio_put_var(io_file(lfile_ind), varid, start(1:1), count(1:1), (/time_val/)) + rcode = pio_inq_varid(io_file, 'time', varid) + rcode = pio_put_var(io_file, varid, start(1:1), count(1:1), (/time_val/)) ! write time bounds - rcode = pio_inq_varid(io_file(lfile_ind), 'time_bnds', varid) + rcode = pio_inq_varid(io_file, 'time_bnds', varid) start(1) = 1; start(2) = nt count(1) = 2; count(2) = 1 - rcode = pio_put_var(io_file(lfile_ind), varid, start(1:2), count(1:2), tbnds) + rcode = pio_put_var(io_file, varid, start(1:2), count(1:2), tbnds) end subroutine med_io_write_time @@ -1537,7 +1470,7 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) use pio , only : pio_read_darray, pio_offset_kind, pio_setframe ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + character(len=*) ,intent(in) :: filename type(ESMF_VM) ,intent(in) :: vm type(ESMF_FieldBundle) ,intent(in) :: FB ! data to be read character(len=*) ,optional ,intent(in) :: pre ! prefix to variable name diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 00444b292..e647dc647 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -24,7 +24,8 @@ module med_phases_history_mod use med_time_mod , only : med_time_alarmInit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf - + use pio , only : file_desc_t + implicit none private @@ -59,6 +60,7 @@ module med_phases_history_mod ! Instantaneous history files datatypes/variables per component ! ---------------------------- type, public :: instfile_type + type(file_desc_t) :: io_file logical :: write_inst character(CS) :: hist_option integer :: hist_n @@ -74,6 +76,7 @@ module med_phases_history_mod ! Time averaging history files ! ---------------------------- type, public :: avgfile_type + type(file_desc_t) :: io_file logical :: write_avg type(ESMF_FieldBundle) :: FBaccum_import ! field bundle for time averaging integer :: accumcnt_import ! field bundle accumulation counter @@ -93,6 +96,7 @@ module med_phases_history_mod ! Auxiliary history files ! ---------------------------- type, public :: auxfile_type + type(file_desc_t) :: io_file character(CS), allocatable :: flds(:) ! array of aux field names character(CS) :: auxname ! name for history file creation character(CL) :: histfile = '' ! current history file name @@ -155,6 +159,7 @@ subroutine med_phases_history_write(gcomp, rc) integer, intent(out) :: rc ! local variables + type(file_desc_t) :: io_file type(InternalState) :: is_local type(ESMF_Clock) :: mclock type(ESMF_Alarm) :: alarm @@ -292,23 +297,23 @@ subroutine med_phases_history_write(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Loop over whead/wdata phases do m = 1,2 if (m == 2) then - call med_io_enddef(hist_file) + call med_io_enddef(io_file) end if ! Write time values if (whead(m)) then call ESMF_ClockGet(mclock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_write_time(io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -316,49 +321,49 @@ subroutine med_phases_history_write(gcomp, rc) ! Write import and export field bundles if (is_local%wrap%comp_present(n)) then if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBexp(n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBexp(n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif end if ! Write mediator fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBFrac(n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBFrac(n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='Med_frac_'//trim(compname(n)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write component mediator area field bundles - call med_io_write(hist_file, is_local%wrap%FBArea(n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBArea(n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='MED_'//trim(compname(n)), rc=rc) end do ! Write atm/ocn fluxes and ocean albedoes if field bundles are created if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_alb_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_aoflux_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) end if end do ! end of loop over whead/wdata m index phases ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of write_now if-block @@ -464,44 +469,44 @@ subroutine med_phases_history_write_med(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, instfiles(compmed)%io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then call ESMF_ClockGet(instfiles(compmed)%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(instfiles(compmed)%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(instfiles(compmed)%io_file) + call med_io_write_time(instfiles(compmed)%io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write aoflux fields computed in mediator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_aoflux_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) end if ! If appropriate - write ocn albedos computed in mediator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_alb_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) end if end do ! end of loop over m ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(instfiles(compmed)%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of if-write_now block @@ -525,6 +530,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) integer , intent(out) :: rc ! local variables + type(file_desc_t) :: io_file type(InternalState) :: is_local type(ESMF_VM) :: vm type(ESMF_Clock) :: clock @@ -598,7 +604,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data to history file @@ -606,20 +612,20 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(io_file) + call med_io_write_time(io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call med_io_write(hist_file, fldbun, whead(m), wdata(m), is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & + call med_io_write(io_file, fldbun, whead(m), wdata(m), is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do ! end of loop over m ! Close history file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine med_phases_history_write_lnd2glc @@ -752,18 +758,18 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, instfile%io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then call ESMF_ClockGet(instfile%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(instfile%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(instfile%io_file) + call med_io_write_time(instfile%io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -771,19 +777,19 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ny = is_local%wrap%ny(compid) ! Define/write import field bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & + call med_io_write(instfile%io_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/write import export bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & + call med_io_write(instfile%io_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/Write mediator fractions if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(compid),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & + call med_io_write(instfile%io_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & nt=1, pre='Med_frac_'//trim(compname(compid)), tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -791,7 +797,7 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) end do ! end of loop over m ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(instfile%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -957,18 +963,18 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, avgfile%io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then call ESMF_ClockGet(avgfile%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(avgfile%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(avgfile%io_file) + call med_io_write_time(avgfile%io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -977,7 +983,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then - call med_io_write(hist_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & + call med_io_write(avgfile%io_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then @@ -986,7 +992,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) end if endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then - call med_io_write(hist_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & + call med_io_write(avgfile%io_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then @@ -998,7 +1004,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) end do ! end of loop over m ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(avgfile%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of write_now if-block @@ -1281,40 +1287,40 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! open file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(auxcomp%files(nf)%histfile, vm, rc, file_ind=nf, clobber=.true.) + call med_io_wopen(auxcomp%files(nf)%histfile, auxcomp%files(nf)%io_file, vm, rc, file_ind=nf, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define time variables call ESMF_ClockGet(auxcomp%files(nf)%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, file_ind=nf, rc=rc) + call med_io_define_time(auxcomp%files(nf)%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define data variables with a time dimension (include the nt argument below) - call med_io_write(auxcomp%files(nf)%histfile, is_local%wrap%FBimp(compid,compid), & + call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), & whead(1), wdata(1), nx, ny, nt=auxcomp%files(nf)%nt, & pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, & - file_ind=nf, use_float=.true., rc=rc) + use_float=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! end definition phase - call med_io_enddef(auxcomp%files(nf)%histfile, file_ind=nf) + call med_io_enddef(auxcomp%files(nf)%io_file) end if ! Write time variables for time nt - call med_io_write_time(time_val, time_bnds, nt=auxcomp%files(nf)%nt, file_ind=nf, rc=rc) + call med_io_write_time(auxcomp%files(nf)%io_file, time_val, time_bnds, nt=auxcomp%files(nf)%nt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data variables for time nt if (auxcomp%files(nf)%doavg) then - call med_io_write(auxcomp%files(nf)%histfile, auxcomp%files(nf)%FBaccum, whead(2), wdata(2), nx, ny, & - nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, file_ind=nf, rc=rc) + call med_io_write(auxcomp%files(nf)%io_file, auxcomp%files(nf)%FBaccum, whead(2), wdata(2), nx, ny, & + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(auxcomp%files(nf)%FBaccum, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write(auxcomp%files(nf)%histfile, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & - nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, file_ind=nf, rc=rc) + call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1322,7 +1328,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) if (auxcomp%files(nf)%nt == auxcomp%files(nf)%ntperfile) then call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_close(auxcomp%files(nf)%histfile, vm, file_ind=nf, rc=rc) + call med_io_close(auxcomp%files(nf)%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return auxcomp%files(nf)%nt = 0 end if diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 3b276b08e..a225ff97c 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -13,7 +13,7 @@ module med_phases_restart_mod use med_phases_prep_glc_mod , only : FBlndAccum2glc_l, lndAccum2glc_cnt use med_phases_prep_glc_mod , only : FBocnAccum2glc_o, ocnAccum2glc_cnt use med_phases_prep_rof_mod , only : FBlndAccum2rof_l, lndAccum2rof_cnt - + use pio , only : file_desc_t implicit none private @@ -143,6 +143,7 @@ subroutine med_phases_restart_write(gcomp, rc) integer, intent(out) :: rc ! local variables + type(file_desc_t) :: io_file type(ESMF_VM) :: vm type(ESMF_Clock) :: clock type(ESMF_Time) :: starttime @@ -309,12 +310,12 @@ subroutine med_phases_restart_write(gcomp, rc) call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(restart_file, vm, rc, clobber=.true.) + call med_io_wopen(restart_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 if (m == 2) then - call med_io_enddef(restart_file) + call med_io_enddef(io_file) end if tbnds = days_since @@ -322,23 +323,23 @@ subroutine med_phases_restart_write(gcomp, rc) if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write_time(days_since, tbnds=(/days_since,days_since/), nt=1, rc=rc) + call med_io_write_time(io_file, days_since, tbnds=(/days_since,days_since/), nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write out next ymd/tod in place of curr ymd/tod because the ! restart represents the time at end of the current timestep ! and that is where we want to start the next run. - call med_io_write(restart_file, start_ymd, 'start_ymd', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, start_ymd, 'start_ymd', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, start_tod, 'start_tod', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, start_tod, 'start_tod', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, next_ymd , 'curr_ymd' , whead(m), wdata(m), rc=rc) + call med_io_write(io_file, next_ymd , 'curr_ymd' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, next_tod , 'curr_tod' , whead(m), wdata(m), rc=rc) + call med_io_write(io_file, next_tod , 'curr_tod' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps @@ -347,19 +348,19 @@ subroutine med_phases_restart_write(gcomp, rc) ny = is_local%wrap%ny(n) ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_io_write(restart_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Write export field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - call med_io_write(restart_file, is_local%wrap%FBexp(n), whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBexp(n), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Write fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - call med_io_write(restart_file, is_local%wrap%FBfrac(n), whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBfrac(n), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(n))//'Frac', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -370,10 +371,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumOcn)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, is_local%wrap%FBExpAccumOcn, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBExpAccumOcn, whead(m), wdata(m), nx, ny, & nt=1, pre='ocnExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -381,10 +382,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumWav)) then nx = is_local%wrap%nx(compwav) ny = is_local%wrap%ny(compwav) - call med_io_write(restart_file, is_local%wrap%FBExpAccumWav, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBExpAccumWav, whead(m), wdata(m), nx, ny, & nt=1, pre='wavExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, is_local%wrap%ExpAccumWavCnt, 'wavExpAccum_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, is_local%wrap%ExpAccumWavCnt, 'wavExpAccum_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -392,10 +393,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBlndAccum2rof_l)) then nx = is_local%wrap%nx(complnd) ny = is_local%wrap%ny(complnd) - call med_io_write(restart_file, FBlndAccum2rof_l, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, FBlndAccum2rof_l, whead(m), wdata(m), nx, ny, & nt=1, pre='lndImpAccum2rof', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, lndAccum2rof_cnt, 'lndImpAccum2rof_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, lndAccum2rof_cnt, 'lndImpAccum2rof_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -403,10 +404,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBlndAccum2glc_l)) then nx = is_local%wrap%nx(complnd) ny = is_local%wrap%ny(complnd) - call med_io_write(restart_file, FBlndAccum2glc_l, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, FBlndAccum2glc_l, whead(m), wdata(m), nx, ny, & nt=1, pre='lndImpAccum2glc', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, lndAccum2glc_cnt, 'lndImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, lndAccum2glc_cnt, 'lndImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -414,10 +415,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBocnAccum2glc_o)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, FBocnAccum2glc_o, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, FBocnAccum2glc_o, whead(m), wdata(m), nx, ny, & nt=1, pre='ocnImpAccum2glc_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -425,7 +426,7 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), nx, ny, & nt=1, pre='MedOcnAlb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -438,11 +439,11 @@ subroutine med_phases_restart_write(gcomp, rc) if (auxcomp(nc)%files(nf)%doavg .and. auxcomp(nc)%files(nf)%accumcnt > 0) then nx = is_local%wrap%nx(nc) ny = is_local%wrap%ny(nc) - call med_io_write(restart_file, auxcomp(nc)%files(nf)%FBaccum, & + call med_io_write(io_file, auxcomp(nc)%files(nf)%FBaccum, & whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(nc))//trim(auxcomp(nc)%files(nf)%auxname), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, auxcomp(nc)%files(nf)%accumcnt, & + call med_io_write(io_file, auxcomp(nc)%files(nf)%accumcnt, & trim(compname(nc))//trim(auxcomp(nc)%files(nf)%auxname)//'_accumcnt', & whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -453,7 +454,7 @@ subroutine med_phases_restart_write(gcomp, rc) enddo ! end of whead/wdata loop ! Close file - call med_io_close(restart_file, vm, rc=rc) + call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif From 4490cffdc06f2664022c621034cbd24222ef535d Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 11 May 2023 10:25:37 -0600 Subject: [PATCH 58/92] ntperfile should be type integer --- cime_config/namelist_definition_drv.xml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 5cbf78319..f6e1d4442 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1347,7 +1347,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1414,7 +1414,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1483,7 +1483,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1548,7 +1548,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1766,7 +1766,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -2011,7 +2011,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. From 57e1970552fb68d88d7cdf4e3a84d511bd03f006 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 11 May 2023 11:27:08 -0600 Subject: [PATCH 59/92] remove unused variable --- mediator/med_io_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 9215777c0..3a8fb2d6f 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -616,7 +616,6 @@ subroutine med_io_close(io_file, rc) ! local variables - integer :: iam character(*),parameter :: subName = '(med_io_close) ' !------------------------------------------------------------------------------- From 5d7470d052b391d8fc7bbd57e5e5641a439abad2 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 11 May 2023 13:44:12 -0600 Subject: [PATCH 60/92] CESM_COUPLED should be CESMCOUPLED --- mediator/med_methods_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 3d29fde6f..faecf47a6 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2530,7 +2530,7 @@ subroutine med_methods_FB_check_for_nans(FB, rc) ! ---------------------------------------------- rc = ESMF_SUCCESS -#ifndef CESM_COUPLED +#ifndef CESMCOUPLED ! For now only CESM uses shr_infnan_isnan - so until other models provide this RETURN #endif @@ -2571,7 +2571,7 @@ subroutine med_methods_FB_check_for_nans(FB, rc) end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- -#ifdef CESM_COUPLED +#ifdef CESMCOUPLED subroutine med_methods_check_for_nans_1d(dataptr, nancount) use shr_infnan_mod, only: shr_infnan_isnan @@ -2590,7 +2590,7 @@ subroutine med_methods_check_for_nans_1d(dataptr, nancount) end subroutine med_methods_check_for_nans_1d subroutine med_methods_check_for_nans_2d(dataptr, nancount) - use shr_infnan_mod, only: shr_infan_isnan + use shr_infnan_mod, only: shr_infnan_isnan ! input/output variables real(r8) , intent(in) :: dataptr(:,:) integer , intent(out) :: nancount @@ -2600,7 +2600,7 @@ subroutine med_methods_check_for_nans_2d(dataptr, nancount) nancount = 0 do k = 1,size(dataptr, dim=1) do n = 1,size(dataptr, dim=2) - if (shr_infan_isnan(dataptr(k,n))) then + if (shr_infnan_isnan(dataptr(k,n))) then nancount = nancount + 1 end if end do From b60c9d7f6089de5ecb2e6784a21c84f6906a6d75 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Thu, 11 May 2023 13:58:56 -0600 Subject: [PATCH 61/92] Candidate fixes of descriptions and comments --- cime_config/namelist_definition_drv.xml | 44 ++++++++++++------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index f6e1d4442..bfe991383 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1235,7 +1235,7 @@ - + logical aux_hist @@ -1267,7 +1267,7 @@ integer aux_hist MED_attributes - history option type + history option span 1 @@ -1300,7 +1300,7 @@ - + logical aux_hist @@ -1332,7 +1332,7 @@ integer aux_hist MED_attributes - history option type + history option span 1 @@ -1365,7 +1365,7 @@ - + logical aux_hist @@ -1381,7 +1381,7 @@ char aux_hist MED_attributes - Auxiliary mediator atm2med precipitation history output every 3 hours + Auxiliary mediator atm2med precipitation fields history output every 3 hours Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl @@ -1399,7 +1399,7 @@ integer aux_hist MED_attributes - history option type + history option span 3 @@ -1432,13 +1432,13 @@ - + logical aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x dynamic, radiation, and precipitation history output every 3 hours .false. @@ -1449,7 +1449,7 @@ aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x dynamic, radiation, and precipitation fields history output every 3 hours Sa_z:Sa_topo:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_dens:Sa_pbot:Sa_pslv:Faxa_lwdn:Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Sa_co2diag:Sa_co2prog @@ -1468,7 +1468,7 @@ integer aux_hist MED_attributes - history option type + history option span 3 @@ -1501,12 +1501,12 @@ - + logical aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x aerosol and ghg history output daily or endofrun .false. @@ -1515,7 +1515,7 @@ char aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x aerosol and ghg history output daily or endofrun Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag @@ -1533,9 +1533,9 @@ integer aux_hist MED_attributes - history option type + history option span - 1 + 3 @@ -1553,7 +1553,7 @@ MED_attributes Number of time samples per file. - 1 + 2 @@ -1801,7 +1801,7 @@ - + logical aux_hist @@ -1978,7 +1978,7 @@ char aux_hist MED_attributes - Auxiliary mediator rof2med precipitation history output. + Auxiliary mediator rof2med precipitation fields history output. all @@ -1996,9 +1996,9 @@ integer aux_hist MED_attributes - history option type + history option span - 6 + 3 @@ -2016,7 +2016,7 @@ MED_attributes Number of time samples per file. - 1 + 2 From 42a5fd537fd166eea08a8a132cc159c25a471ec6 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 11 May 2023 15:39:03 -0600 Subject: [PATCH 62/92] remove dead code --- mediator/med_io_mod.F90 | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 3a8fb2d6f..d55ebc724 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -75,10 +75,6 @@ module med_io_mod character(*),parameter :: prefix = "med_io_" character(*),parameter :: modName = "(med_io_mod) " character(*),parameter :: version = "cmeps0" - integer , parameter :: number_strlen = 8 - integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now - -! character(CL) :: wfilename(0:file_desc_t_cnt) = '' integer :: pio_iotype integer :: pio_ioformat @@ -546,9 +542,6 @@ subroutine med_io_wopen(filename, io_file, vm, rc, clobber, file_ind, model_doi_ if (.not. pio_file_is_open(io_file)) then - ! filename not open -! wfilename(lfile_ind) = trim(filename) - if (med_io_file_exists(vm, filename)) then if (lclobber) then nmode = pio_clobber @@ -585,16 +578,6 @@ subroutine med_io_wopen(filename, io_file, vm, rc, clobber, file_ind, model_doi_ rcode = pio_put_att(io_file,pio_global,"model_doi_url",lmodel_doi_url) endif -! elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then - ! filename is open, better match open filename -! if (iam==0) then -! write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) -! write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) -! end if -! call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) -! rc = ESMF_FAILURE -! return - else ! filename is already open, just return endif From 96206b6366dca33da7fe20021c71a5f0db8ace7a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 12 May 2023 08:54:52 -0600 Subject: [PATCH 63/92] adjust indentation --- mediator/med_phases_history_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index e647dc647..5f150a4b7 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -60,7 +60,7 @@ module med_phases_history_mod ! Instantaneous history files datatypes/variables per component ! ---------------------------- type, public :: instfile_type - type(file_desc_t) :: io_file + type(file_desc_t):: io_file logical :: write_inst character(CS) :: hist_option integer :: hist_n @@ -76,7 +76,7 @@ module med_phases_history_mod ! Time averaging history files ! ---------------------------- type, public :: avgfile_type - type(file_desc_t) :: io_file + type(file_desc_t) :: io_file logical :: write_avg type(ESMF_FieldBundle) :: FBaccum_import ! field bundle for time averaging integer :: accumcnt_import ! field bundle accumulation counter @@ -96,7 +96,7 @@ module med_phases_history_mod ! Auxiliary history files ! ---------------------------- type, public :: auxfile_type - type(file_desc_t) :: io_file + type(file_desc_t) :: io_file character(CS), allocatable :: flds(:) ! array of aux field names character(CS) :: auxname ! name for history file creation character(CL) :: histfile = '' ! current history file name From a587023727e73bbdffec5b8daff5bcb93385e670 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 May 2023 14:20:46 -0600 Subject: [PATCH 64/92] updates for new stresses sent to wave --- mediator/esmFldsExchange_cesm_mod.F90 | 34 +-- mediator/med_phases_aofluxes_mod.F90 | 29 ++- mediator/med_phases_prep_wav_mod.F90 | 333 +------------------------- 3 files changed, 44 insertions(+), 352 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 397a92ba1..8ff5f95f4 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2983,28 +2983,28 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- - if (phase == 'advertise') then + if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') - call addfld_from(compice , 'Fioi_taux') - call addfld_aoflux('Faox_taux') - else - if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then - if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - end if - call addmrg_to(compwav, 'Fwxx_taux', & - mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') - end if + ! call addfld_from(compice , 'Fioi_taux') + ! call addfld_aoflux('Faox_taux') + else + ! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then + ! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then + ! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') + ! call addmrg_to(compwav, 'Fwxx_taux', & + ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') + ! end if + ! call addmrg_to(compwav, 'Fwxx_taux', & + ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') + ! end if end if -! if (phase == 'advertise') then +! if (phase == 'advertise') then ! call addfld_to(compwav , 'Fwxx_taux') !! call addfld_from(compice , 'Fioi_taux') ! call addfld_aoflux('Faox_taux') -! else -! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then -!! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then +! else +! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then +!! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then !! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') !! call addmrg_to(compwav, 'Fwxx_taux', & !! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index b3acbdeb4..608ad18b0 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -27,7 +27,7 @@ module med_phases_aofluxes_mod use ESMF , only : ESMF_XGridGet, ESMF_MeshCreate, ESMF_MeshWrite, ESMF_KIND_R8 use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_internalstate_mod , only : InternalState, mastertask, logunit - use med_internalstate_mod , only : compatm, compocn, coupling_mode, aoflux_code, mapconsd, mapconsf, mapfcopy + use med_internalstate_mod , only : compatm, compocn, compwav, coupling_mode, aoflux_code, mapconsd, mapconsf, mapfcopy use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_chkerr @@ -492,6 +492,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) use esmFlds , only : med_fldlist_GetaofluxfldList use esmFlds , only : med_fldList_type use med_map_mod , only : med_map_packed_field_create + use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk ! Arguments type(ESMF_GridComp) , intent(inout) :: gcomp @@ -509,6 +510,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: lmesh real(R8), pointer :: garea(:) => null() type(ESMF_CoordSys_Flag) :: coordSys + integer :: maptype character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' !----------------------------------------------------------------------- @@ -571,7 +573,6 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) if (is_local%wrap%aoflux_grid == 'ogrid') then if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o) .and. & ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a)) then - call med_map_packed_field_create(destcomp=compatm, & flds_scalar_name=is_local%wrap%flds_scalar_name, & fieldsSrc=fldListMed_aoflux, & @@ -579,7 +580,6 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) FBDst=is_local%wrap%FBMed_aoflux_a, & packed_data=is_local%wrap%packed_data_aoflux_o2a(:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if end if @@ -957,6 +957,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) use ESMF , only : ESMF_GridComp use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info, ESMF_SUCCESS use med_map_mod , only : med_map_field_packed, med_map_rh_is_created + use med_map_mod , only : med_map_routehandles_init + use med_methods_mod, only : FB_fldchk => med_methods_FB_fldchk + use med_methods_mod, only : FB_diagnose => med_methods_FB_diagnose #ifdef CESMCOUPLED use shr_flux_mod , only : flux_atmocn #else @@ -1129,6 +1132,26 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) end if + ! map aoflux fields to wav grid if stresses are needed on the wave grid + if ( FB_fldchk(is_local%wrap%FBExp(compwav), 'Fwxx_taux', rc=rc)) then + maptype = mapconsf + if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:), maptype, rc=rc)) then + call med_map_routehandles_init( compocn, compwav, & + FBSrc=is_local%wrap%FBImp(compocn,compocn), & + FBDst=is_local%wrap%FBImp(compwav,compwav), & + mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_o, 'Faox_taux', field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compwav), 'Fwxx_taux', field=field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegrid(field_src, field_dst, & + routehandle=is_local%wrap%RH(compocn, compwav, maptype), & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call t_stopf('MED:'//subname) end subroutine med_aofluxes_update diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 3ed57c00d..4fdd630ea 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -13,20 +13,12 @@ module med_phases_prep_wav_mod use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose -!PSH begin - use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk - use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr -!PSH end use med_methods_mod , only : FB_accum => med_methods_FB_accum 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 -!PSH begin use esmFlds , only : med_fldList_GetfldListTo use med_internalstate_mod , only : compwav -! use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type -! use med_internalstate_mod , only : compwav, compocn, compatm, compice, coupling_mode -!PSH end use perf_mod , only : t_startf, t_stopf implicit none @@ -36,10 +28,6 @@ module med_phases_prep_wav_mod public :: med_phases_prep_wav_accum ! called from run sequence public :: med_phases_prep_wav_avg ! called from run sequence -!PSH begin -! private :: med_phases_prep_wav_custom_cesm -!PSH end - character(*), parameter :: u_FILE_u = & __FILE__ @@ -94,9 +82,6 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n, ncnt -!PSH begin -! type(med_fldlist_type), pointer :: fldList -!PSH end character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -111,33 +96,15 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -!PSH begin -! fldList => med_fldList_GetfldListTo(compwav) -!PSH end + ! auto merges to wav -!PSH begin call med_merge_auto(& is_local%wrap%med_coupling_active(:,compwav), & is_local%wrap%FBExp(compwav), & is_local%wrap%FBFrac(compwav), & is_local%wrap%FBImp(:,compwav), & med_fldList_GetfldListTo(compwav), rc=rc) -! call med_merge_auto(& -! is_local%wrap%med_coupling_active(:,compwav), & -! is_local%wrap%FBExp(compwav), & -! is_local%wrap%FBFrac(compwav), & -! is_local%wrap%FBImp(:,compwav), & -! fldList, & -! FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) -!PSH end if (ChkErr(rc,__LINE__,u_FILE_u)) return -!PSH begin -! ! custom merges to ocean -! if (trim(coupling_mode) == 'cesm') then -! call med_phases_prep_wav_custom_cesm(gcomp, rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -!PSH end ! wave accumulator call FB_accum(is_local%wrap%FBExpAccumWav, is_local%wrap%FBExp(compwav), rc=rc) @@ -223,302 +190,4 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_prep_wav_avg - !----------------------------------------------------------------------------- -! subroutine med_phases_prep_wav_custom_cesm(gcomp, rc) -! -! !--------------------------------------- -! ! custom calculations for cesm -! !--------------------------------------- -! -! use ESMF , only : ESMF_GridComp, ESMF_StateGet, ESMF_Field, ESMF_FieldGet -! use ESMF , only : ESMF_VMBroadCast -! use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS -! use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR -! -! ! input/output variables -! type(ESMF_GridComp) :: gcomp -! integer, intent(out) :: rc -! -! ! local variables -! type(InternalState) :: is_local -! type(ESMF_Field) :: lfield -! real(R8), pointer :: ifrac(:) -! real(R8), pointer :: ofrac(:) -! real(R8), pointer :: ifracr(:) -! real(R8), pointer :: ofracr(:) -! real(R8), pointer :: avsdr(:) -! real(R8), pointer :: avsdf(:) -! real(R8), pointer :: anidr(:) -! real(R8), pointer :: anidf(:) -! real(R8), pointer :: Faxa_swvdf(:) -! real(R8), pointer :: Faxa_swndf(:) -! real(R8), pointer :: Faxa_swvdr(:) -! real(R8), pointer :: Faxa_swndr(:) -! real(R8), pointer :: Foxx_swnet(:) -! real(R8), pointer :: Foxx_swnet_afracr(:) -! real(R8), pointer :: Foxx_swnet_vdr(:) -! real(R8), pointer :: Foxx_swnet_vdf(:) -! real(R8), pointer :: Foxx_swnet_idr(:) -! real(R8), pointer :: Foxx_swnet_idf(:) -! real(R8), pointer :: Fioi_swpen_vdr(:) -! real(R8), pointer :: Fioi_swpen_vdf(:) -! real(R8), pointer :: Fioi_swpen_idr(:) -! real(R8), pointer :: Fioi_swpen_idf(:) -! real(R8), pointer :: Fioi_swpen(:) -! real(R8), pointer :: dataptr(:) -! real(R8), pointer :: dataptr_scalar_ocn(:,:) -! real(R8) :: frac_sum -! real(R8) :: ifrac_scaled, ofrac_scaled -! real(R8) :: ifracr_scaled, ofracr_scaled -! logical :: export_swnet_by_bands -! logical :: import_swpen_by_bands -! logical :: export_swnet_afracr -! real(R8) :: precip_fact(1) -! character(CS) :: cvalue -! real(R8) :: fswabsv, fswabsi -! integer :: scalar_id -! integer :: n -! integer :: lsize -! real(R8) :: c1,c2,c3,c4 -! character(len=64), allocatable :: fldnames(:) -! character(len=*), parameter :: subname='(med_phases_prep_wav_custom_cesm)' -! !--------------------------------------- -! -! rc = ESMF_SUCCESS -! -! call t_startf('MED:'//subname) -! if (dbug_flag > 20) then -! call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) -! end if -! call memcheck(subname, 5, mastertask) -! -! ! Get the internal state -! nullify(is_local%wrap) -! call ESMF_GridCompGetInternalState(gcomp, is_local, rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! !--------------------------------------- -! ! Compute netsw for ocean -! !--------------------------------------- -! ! netsw_for_ocn = downsw_from_atm * (1-ocn_albedo) * (1-ice_fraction) + pensw_from_ice * (ice_fraction) -! -! ! Input from atm -! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdr', Faxa_swvdr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndr', Faxa_swndr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdf', Faxa_swvdf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndf', Faxa_swndf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! lsize = size(Faxa_swvdr) -! -! ! Input from mediator, ocean albedos -! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdr' , avsdr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidr' , anidr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdf' , avsdf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidf' , anidf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! ! Output to ocean swnet total -! if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet', Foxx_swnet, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! else -! lsize = size(Faxa_swvdr) -! allocate(Foxx_swnet(lsize)) -! end if -! -! ! Output to ocean swnet by radiation bands -! if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc)) then -! export_swnet_by_bands = .true. -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', Foxx_swnet_vdr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', Foxx_swnet_vdf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', Foxx_swnet_idr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', Foxx_swnet_idf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! else -! export_swnet_by_bands = .false. -! end if -! -! ! ----------------------- -! ! If cice IS NOT PRESENT -! ! ----------------------- -! if (.not. is_local%wrap%comp_present(compice)) then -! ! Compute total swnet to ocean independent of swpen from sea-ice -! do n = 1,lsize -! fswabsv = Faxa_swvdr(n) * (1.0_R8 - avsdr(n)) + Faxa_swvdf(n) * (1.0_R8 - avsdf(n)) -! fswabsi = Faxa_swndr(n) * (1.0_R8 - anidr(n)) + Faxa_swndf(n) * (1.0_R8 - anidf(n)) -! Foxx_swnet(n) = fswabsv + fswabsi -! end do -! ! Compute sw export to ocean bands if required -! if (export_swnet_by_bands) then -! c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 -! Foxx_swnet_vdr(:) = c1 * Foxx_swnet(:) -! Foxx_swnet_vdf(:) = c2 * Foxx_swnet(:) -! Foxx_swnet_idr(:) = c3 * Foxx_swnet(:) -! Foxx_swnet_idf(:) = c4 * Foxx_swnet(:) -! end if -! end if -! -! ! ----------------------- -! ! If cice IS PRESENT -! ! ----------------------- -! if (is_local%wrap%comp_present(compice)) then -! -! ! Input from mediator, ice-covered ocean and open ocean fractions -! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrac' , ifrac, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrad' , ifracr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrad' , ofracr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! if (FB_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc)) then -! import_swpen_by_bands = .true. -! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdr', Fioi_swpen_vdr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdf', Fioi_swpen_vdf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idr', Fioi_swpen_idr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idf', Fioi_swpen_idf, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! else -! import_swpen_by_bands = .false. -! end if -! -! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr',rc=rc)) then -! ! Swnet without swpen from sea-ice -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr', Foxx_swnet_afracr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! export_swnet_afracr = .true. -! else -! export_swnet_afracr = .false. -! end if -! -! do n = 1,lsize -! ! Compute total swnet to ocean independent of swpen from sea-ice -! fswabsv = Faxa_swvdr(n) * (1.0_R8 - avsdr(n)) + Faxa_swvdf(n) * (1.0_R8 - avsdf(n)) -! fswabsi = Faxa_swndr(n) * (1.0_R8 - anidr(n)) + Faxa_swndf(n) * (1.0_R8 - anidf(n)) -! Foxx_swnet(n) = fswabsv + fswabsi -! -! ! Add swpen from sea ice -! ifrac_scaled = ifrac(n) -! ofrac_scaled = ofrac(n) -! frac_sum = ifrac(n) + ofrac(n) -! if (frac_sum /= 0._R8) then -! ifrac_scaled = ifrac(n) / (frac_sum) -! ofrac_scaled = ofrac(n) / (frac_sum) -! endif -! ifracr_scaled = ifracr(n) -! ofracr_scaled = ofracr(n) -! frac_sum = ifracr(n) + ofracr(n) -! if (frac_sum /= 0._R8) then -! ifracr_scaled = ifracr(n) / (frac_sum) -! ofracr_scaled = ofracr(n) / (frac_sum) -! endif -! Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) -! -! if (export_swnet_afracr) then -! Foxx_swnet_afracr(n) = ofracr_scaled*(fswabsv + fswabsi) -! end if -! -! ! Compute sw export to ocean bands if required -! if (export_swnet_by_bands) then -! if (import_swpen_by_bands) then -! ! use each individual band for swpen coming from the sea-ice -! Foxx_swnet_vdr(n) = Faxa_swvdr(n)*(1.0_R8-avsdr(n))*ofracr_scaled + Fioi_swpen_vdr(n)*ifrac_scaled -! Foxx_swnet_vdf(n) = Faxa_swvdf(n)*(1.0_R8-avsdf(n))*ofracr_scaled + Fioi_swpen_vdf(n)*ifrac_scaled -! Foxx_swnet_idr(n) = Faxa_swndr(n)*(1.0_R8-anidr(n))*ofracr_scaled + Fioi_swpen_idr(n)*ifrac_scaled -! Foxx_swnet_idf(n) = Faxa_swndf(n)*(1.0_R8-anidf(n))*ofracr_scaled + Fioi_swpen_idf(n)*ifrac_scaled -! else -! ! scale total Foxx_swnet to get contributions from each band -! c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 -! Foxx_swnet_vdr(n) = c1 * Foxx_swnet(n) -! Foxx_swnet_vdf(n) = c2 * Foxx_swnet(n) -! Foxx_swnet_idr(n) = c3 * Foxx_swnet(n) -! Foxx_swnet_idf(n) = c4 * Foxx_swnet(n) -! end if -! end if -! end do -! -! ! Output to ocean per ice thickness fraction and sw penetrating into ocean -! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afrac', rc=rc)) then -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afrac', fldptr1=dataptr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! dataptr(:) = ofrac(:) -! end if -! if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afracr', rc=rc)) then -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afracr', fldptr1=dataptr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! dataptr(:) = ofracr(:) -! end if -! -! end if ! if sea-ice is present -! -! ! Deallocate Foxx_swnet if it was allocated in this subroutine -! if (.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then -! deallocate(Foxx_swnet) -! end if -! -! ! Apply precipitation factor from ocean (that scales atm rain and snow back to ocn ) if appropriate -! if (trim(coupling_mode) == 'cesm' .and. is_local%wrap%flds_scalar_index_precip_factor /= 0) then -! -! ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor -! ! is initialized to 0. -! ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, -! ! it is set to 0. -! if (mastertask) then -! call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & -! itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return -! call ESMF_FieldGet(lfield, farrayPtr=dataptr_scalar_ocn, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return -! scalar_id=is_local%wrap%flds_scalar_index_precip_factor -! precip_fact(1) = dataptr_scalar_ocn(scalar_id,1) -! if (precip_fact(1) /= 1._r8) then -! write(logunit,'(a,f21.13)')& -! '(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by non-unity precip_fact ',& -! precip_fact(1) -! end if -! end if -! call ESMF_VMBroadCast(is_local%wrap%vm, precip_fact, 1, 0, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return -! is_local%wrap%flds_scalar_precip_factor = precip_fact(1) -! if (dbug_flag > 5) then -! write(cvalue,*) precip_fact(1) -! call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) -! end if -! -! ! Scale rain and snow to ocn from atm by the precipitation factor received from the ocean -! allocate(fldnames(4)) -! fldnames = (/'Faxa_rain', 'Faxa_snow', 'Foxx_rofl', 'Foxx_rofi'/) -! do n = 1,size(fldnames) -! if (FB_fldchk(is_local%wrap%FBExp(compocn), trim(fldnames(n)), rc=rc)) then -! call FB_GetFldPtr(is_local%wrap%FBExp(compocn), trim(fldnames(n)) , dataptr, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! dataptr(:) = dataptr(:) * is_local%wrap%flds_scalar_precip_factor -! end if -! end do -! deallocate(fldnames) -! end if -! -! if (dbug_flag > 20) then -! call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) -! end if -! call t_stopf('MED:'//subname) -! -! end subroutine med_phases_prep_wav_custom_cesm - end module med_phases_prep_wav_mod From ca8ca8bbf7517b130b8fddefd3849eec7f00a856 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 May 2023 14:40:36 -0600 Subject: [PATCH 65/92] udpates needed to pass taux and tauxy to wave --- mediator/esmFldsExchange_cesm_mod.F90 | 48 +------ mediator/fd_cesm.yaml | 18 +-- mediator/med_fraction_mod.F90 | 200 +------------------------- mediator/med_phases_aofluxes_mod.F90 | 15 +- 4 files changed, 26 insertions(+), 255 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 99f362f37..13811aec9 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2985,58 +2985,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compwav, 'Sa_tbot', mrg_from=compatm, mrg_fld='Sa_tbot', mrg_type='copy') end if end if -!PSH begin -! if (phase == 'advertise') then -! call addfld_from(compocn, 'So_ofrac') -! call addfld_to(compwav, 'So_ofrac') -! end if -! if (phase == 'advertise') then -! call addfld_from(compocn, 'So_ofrac') -! call addfld_to(compwav, 'So_ofrac') -! else -! if ( fldchk(is_local%wrap%FBexp(compwav) , 'So_ofrac', rc=rc) .and. & -! fldchk(is_local%wrap%FBImp(compice,compice ), 'So_ofrac', rc=rc)) then -! ! By default will be using a custom map - but if one is not available, use a generated bilinear instead -! call addmap_from(compice, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) -! call addmrg_to(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') -! end if -! end if ! --------------------------------------------------------------------- ! to wav: zonal and meridional wind stress ! --------------------------------------------------------------------- if (phase == 'advertise') then call addfld_to(compwav , 'Fwxx_taux') - ! call addfld_from(compice , 'Fioi_taux') - ! call addfld_aoflux('Faox_taux') - else - ! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then - ! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then - ! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') - ! call addmrg_to(compwav, 'Fwxx_taux', & - ! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') - ! end if - ! call addmrg_to(compwav, 'Fwxx_taux', & - ! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') - ! end if - end if -! if (phase == 'advertise') then -! call addfld_to(compwav , 'Fwxx_taux') -!! call addfld_from(compice , 'Fioi_taux') -! call addfld_aoflux('Faox_taux') -! else -! if ( fldchk(is_local%wrap%FBexp(compwav), 'Fwxx_taux', rc=rc)) then -!! if (fldchk(is_local%wrap%FBimp(compice,compice), 'Fioi_taux', rc=rc)) then -!! call addmap_from(compice, 'Fioi_taux', compwav, mapfcopy, 'unset', 'unset') -!! call addmrg_to(compwav, 'Fwxx_taux', & -!! mrg_from=compice, mrg_fld='Fioi_taux', mrg_type='merge', mrg_fracname='ifrac') -!! end if -! call addmrg_to(compwav, 'Fwxx_taux', & -! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='copy') -!! mrg_from=compmed, mrg_fld='Faox_taux', mrg_type='merge', mrg_fracname='ofrac') -! end if -! end if -!PSH end + call addfld_to(compwav , 'Fwxx_tauy') + end if !===================================================================== ! FIELDS TO RIVER (comprof) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 060015656..c09a63c58 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1176,24 +1176,20 @@ canonical_units: m2/s description: wave elevation spectrum -#PSH begin - # + # #----------------------------------- # section: wave import #----------------------------------- - # - - # + # - standard_name: Fwxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 description: wave import - zonal surface stress - # -# - standard_name: Fwxx_tauy -# alias: mean_merid_moment_flx -# canonical_units: N m-2 -# description: wave import - meridional surface stress -#PSH end + # + - standard_name: Fwxx_tauy + alias: mean_merid_moment_flx + canonical_units: N m-2 + description: wave import - meridional surface stress #----------------------------------- # mediator fields diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 5331a5452..2fd83972a 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -23,11 +23,8 @@ module med_fraction_mod ! character(*),parameter :: fraclist_l = 'lfrac' ! character(*),parameter :: fraclist_g = 'gfrac:lfrac' ! character(*),parameter :: fraclist_r = 'lfrac:rfrac' - ! character(*),parameter :: fraclist_w = 'ifrac:ofrac:wfrac' -!PSH begin ! -! ! we assume ocean and ice are on the same grids, same masks - ! we assume ocean, ice, and waves are on the same grids, same masks -!PSH end + ! + ! we assume ocean and ice are on the same grids, same masks ! we assume ocn2atm and ice2atm are masked maps ! we assume lnd2atm is a global map ! we assume that the ice fraction evolves in time but that @@ -129,10 +126,8 @@ module med_fraction_mod character(len=6),parameter,dimension(1) :: fraclist_l = (/'lfrac '/) character(len=6),parameter,dimension(2) :: fraclist_g = (/'gfrac ','lfrac '/) character(len=6),parameter,dimension(2) :: fraclist_r = (/'rfrac ','lfrac '/) -!PSH begin -! character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) - character(len=6),parameter,dimension(3) :: fraclist_w = (/'ifrac ','ofrac ','wfrac '/) -!PSH end + character(len=6),parameter,dimension(1) :: fraclist_w = (/'wfrac '/) + !--- standard --- real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) character(*), parameter :: u_FILE_u = & @@ -588,86 +583,6 @@ subroutine med_fraction_init(gcomp, rc) endif endif -!PSH Begin - In progress... -! Note: started this section, based on setting ifrac and ofrac for compatm, but it is not -! clear to me that this approach is correct, since we can assume ocn, ice, wav are all on -! the same grid. Commenting out for now, can delete once I'm confident other approach -! works -! !--------------------------------------- -! ! Set 'ofrac' in FBFrac(compwav) -! !--------------------------------------- -! -! if ( is_local%wrap%comp_present(compocn) .and. & -! is_local%wrap%comp_present(compwav) .and. & -! is_local%wrap%med_coupling_active(compocn,compwav)) then -! -! ! Set 'ofrac' in FBFrac(compwav) - at this point this is the -! ! ocean mask mapped to the atm grid This is mapping the ocean mask to -! ! the wav grid -! -! if (med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then -! ! If ocn and atm are on the same mesh - a redist route handle has already been created -! maptype = mapfcopy -! else -! if (trim(coupling_mode) == 'nems_orig' ) then -! maptype = mapnstod_consd -! else -! maptype = mapconsd -! end if -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),maptype, rc=rc)) then -! call med_map_routehandles_init( compocn, compwav, & -! FBSrc=is_local%wrap%FBImp(compocn,compocn), & -! FBDst=is_local%wrap%FBImp(compocn,compwav), & -! mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! end if -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compocn), fieldname='ofrac', field=field_src, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), fieldname='ofrac', field=field_dst, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call med_map_field(field_src, field_dst, is_local%wrap%RH(compocn,compwav,:), maptype, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return -! -! end if -! -! !--------------------------------------- -! ! Set 'ifrac' in FBFrac(compwav) -! !--------------------------------------- -! -! if ( is_local%wrap%comp_present(compice) .and. & -! is_local%wrap%comp_present(compwav) .and. & -! is_local%wrap%med_coupling_active(compice,compwav)) then -! -! ! Set 'ifrac' in FBFrac(compwav) - at this point this is the ice mask mapped to the wav mesh -! ! This maps the ice mask (which is the same as the ocean mask) to the wav mesh -! if (med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then -! ! If ice and wav are on the same mesh - a redist route handle has already been created -! maptype = mapfcopy -! else -! if (trim(coupling_mode) == 'nems_orig' ) then -! maptype = mapnstod_consd -! else -! maptype = mapconsd -! end if -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),maptype, rc=rc)) then -! call med_map_routehandles_init( compice, compwav, & -! FBSrc=is_local%wrap%FBImp(compice,compice), & -! FBDst=is_local%wrap%FBImp(compice,compwav), & -! mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! end if -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', field=field_dst, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), maptype, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! -!PSH end - !--------------------------------------- ! Create route handles ocn<->ice if not created !--------------------------------------- @@ -703,80 +618,6 @@ subroutine med_fraction_init(gcomp, rc) end if end if -!PSH begin -! !--------------------------------------- -! ! Create route handles ocn<->wav if not created -! !--------------------------------------- -! -! if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compocn,:),mapfcopy, rc=rc)) then -! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compocn))) then -! call fldbun_init(is_local%wrap%FBImp(compwav,compocn), is_local%wrap%flds_scalar_name, & -! STgeom=is_local%wrap%NStateImp(compocn), & -! STflds=is_local%wrap%NStateImp(compwav), & -! name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compocn)), rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! call med_map_routehandles_init(compwav, compocn, & -! FBSrc=is_local%wrap%FBImp(compwav,compocn), & -! FBDst=is_local%wrap%FBImp(compwav,compocn), & -! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:),mapfcopy, rc=rc)) then -! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compwav))) then -! call fldbun_init(is_local%wrap%FBImp(compocn,compwav), is_local%wrap%flds_scalar_name, & -! STgeom=is_local%wrap%NStateImp(compwav), & -! STflds=is_local%wrap%NStateImp(compocn), & -! name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compwav)), rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! call med_map_routehandles_init( compocn, compwav, & -! FBSrc=is_local%wrap%FBImp(compocn,compocn), & -! FBDst=is_local%wrap%FBImp(compocn,compwav), & -! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! end if -! -! !--------------------------------------- -! ! Create route handles ice<->wav if not created -! !--------------------------------------- -! -! if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compice)) then -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compwav,compice,:),mapfcopy, rc=rc)) then -! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compwav,compice))) then -! call fldbun_init(is_local%wrap%FBImp(compwav,compice), is_local%wrap%flds_scalar_name, & -! STgeom=is_local%wrap%NStateImp(compice), & -! STflds=is_local%wrap%NStateImp(compwav), & -! name='FBImp'//trim(compname(compwav))//'_'//trim(compname(compice)), rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! call med_map_routehandles_init(compwav, compice, & -! FBSrc=is_local%wrap%FBImp(compwav,compice), & -! FBDst=is_local%wrap%FBImp(compwav,compice), & -! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compwav,:),mapfcopy, rc=rc)) then -! if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compwav))) then -! call fldbun_init(is_local%wrap%FBImp(compice,compwav), is_local%wrap%flds_scalar_name, & -! STgeom=is_local%wrap%NStateImp(compwav), & -! STflds=is_local%wrap%NStateImp(compice), & -! name='FBImp'//trim(compname(compice))//'_'//trim(compname(compwav)), rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! call med_map_routehandles_init( compice, compwav, & -! FBSrc=is_local%wrap%FBImp(compice,compice), & -! FBDst=is_local%wrap%FBImp(compice,compwav), & -! mapindex=mapfcopy, RouteHandle=is_local%wrap%RH, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! end if -! end if -! -!PSH end - - !--------------------------------------- ! Diagnostic output !--------------------------------------- @@ -807,10 +648,7 @@ subroutine med_fraction_set(gcomp, rc) use ESMF , only : ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS -!PSH Begin -! use med_internalstate_mod , only : compatm, compocn, compice, compname - use med_internalstate_mod , only : compatm, compocn, compice, compname, compwav -!PSH End + use med_internalstate_mod , only : compatm, compocn, compice, compname use med_internalstate_mod , only : mapfcopy, mapconsd, mapnstod_consd use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : InternalState @@ -913,34 +751,6 @@ subroutine med_fraction_set(gcomp, rc) endif call t_stopf('MED:'//trim(subname)//' fbfrac(compocn)') -!PSH begin -! ! ------------------------------------------- -! ! Set FBfrac(compwav) -! ! ------------------------------------------- -! -! ! The following is just a redistribution from FBFrac(compice) -! -! call t_startf('MED:'//trim(subname)//' fbfrac(compwav)') -! if (is_local%wrap%comp_present(compwav)) then -! ! Map 'ifrac' from FBfrac(compice) to FBfrac(compwav) -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ifrac', field=field_src, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ifrac', field=field_dst, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! -! ! Map 'ofrac' from FBfrac(compice) to FBfrac(compwav) -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compice), 'ofrac', field=field_src, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call ESMF_FieldBundleGet(is_local%wrap%FBfrac(compwav), 'ofrac', field=field_dst, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compwav,:), mapfcopy, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! endif -! call t_stopf('MED:'//trim(subname)//' fbfrac(compwav)') -!PSH end - ! ------------------------------------------- ! Set FBfrac(compatm) ! ------------------------------------------- diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index ae38f995c..de3fd21a5 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -503,8 +503,8 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh real(R8), pointer :: garea(:) => null() - type(ESMF_CoordSys_Flag) :: coordSys integer :: maptype + type(ESMF_CoordSys_Flag) :: coordSys character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' !----------------------------------------------------------------------- @@ -1120,8 +1120,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) end if - ! map aoflux fields to wav grid if stresses are needed on the wave grid - if ( FB_fldchk(is_local%wrap%FBExp(compwav), 'Fwxx_taux', rc=rc)) then + ! map taux and tauy from ocean to wave grid if stresses are needed on the wave grid + if ( FB_fldchk(is_local%wrap%FBExp(compwav), 'Fwxx_taux', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compwav), 'Fwxx_tauy', rc=rc)) then maptype = mapconsf if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:), maptype, rc=rc)) then call med_map_routehandles_init( compocn, compwav, & @@ -1138,6 +1139,14 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) routehandle=is_local%wrap%RH(compocn, compwav, maptype), & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_o, 'Faox_tauy', field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compwav), 'Fwxx_tauy', field=field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegrid(field_src, field_dst, & + routehandle=is_local%wrap%RH(compocn, compwav, maptype), & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if call t_stopf('MED:'//subname) From d64ffe9bdf1be421a8bdb7b730355386b81e7cc7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 May 2023 15:06:49 -0600 Subject: [PATCH 66/92] fixed compile bugs --- mediator/med_phases_aofluxes_mod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index de3fd21a5..46c7c93f7 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -975,6 +975,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) real(r8), parameter :: p0 = 100000.0_r8 ! reference pressure in Pa real(r8), parameter :: rcp = 0.286_r8 ! gas constant of air / specific heat capacity at a constant pressure real(r8), parameter :: rdair = 287.058_r8 ! dry air gas constant in J/K/kg + integer :: maptype + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst character(*),parameter :: subName = '(med_aofluxes_update) ' !----------------------------------------------------------------------- From 488b8d9f1cd7f25a1c7344bd8b3268ccc2c5dffd Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 May 2023 15:28:07 -0600 Subject: [PATCH 67/92] fixed compile bugs --- mediator/med_phases_aofluxes_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 46c7c93f7..48055e92e 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -503,7 +503,6 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh real(R8), pointer :: garea(:) => null() - integer :: maptype type(ESMF_CoordSys_Flag) :: coordSys character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' !----------------------------------------------------------------------- From c3e57f4c027e622a53aacd39ebd449eeb551ae62 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 18 May 2023 16:01:59 -0600 Subject: [PATCH 68/92] make this an input that can be toggled in user_nl_cpl --- cime_config/namelist_definition_drv.xml | 11 +++++++++++ mediator/med_methods_mod.F90 | 21 +++++++++++++++++---- mediator/med_phases_prep_atm_mod.F90 | 2 +- mediator/med_phases_prep_glc_mod.F90 | 2 +- mediator/med_phases_prep_ice_mod.F90 | 2 +- mediator/med_phases_prep_lnd_mod.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 2 +- mediator/med_phases_prep_rof_mod.F90 | 2 +- mediator/med_phases_prep_wav_mod.F90 | 2 +- 9 files changed, 35 insertions(+), 11 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index bfe991383..43623b195 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -716,6 +716,17 @@ $ESMF_VERBOSITY_LEVEL + + logical + performance + MED_attributes + + Check for NaN values in fields returned from mediator to components + + + .false. + + integer control diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index faecf47a6..739db9b54 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2506,11 +2506,12 @@ subroutine med_methods_FB_getmesh(FB, mesh, rc) end subroutine med_methods_FB_getmesh !----------------------------------------------------------------------------- - subroutine med_methods_FB_check_for_nans(FB, rc) - - use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet + subroutine med_methods_FB_check_for_nans(gcomp, FB, rc) + use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_GridComp + use NUOPC, only : NUOPC_CompAttributeGet ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp type(ESMF_FieldBundle) , intent(in) :: FB integer , intent(inout) :: rc @@ -2526,11 +2527,23 @@ subroutine med_methods_FB_check_for_nans(FB, rc) character(len=CS) :: nancount_char character(len=CL) :: msg_error logical :: nanfound + logical, save :: checkfornans + logical, save :: firstcall=.true. + character(len=CL) :: cvalue character(len=*), parameter :: subname='(med_methods_FB_check_for_nans)' ! ---------------------------------------------- rc = ESMF_SUCCESS -#ifndef CESMCOUPLED +#ifdef CESMCOUPLED + if (firstcall) then + call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue, *) checkfornans + firstcall = .false. + endif + if(.not. checkfornans) return + +#else ! For now only CESM uses shr_infnan_isnan - so until other models provide this RETURN #endif diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index bccf8e07c..8de571d0d 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -245,7 +245,7 @@ subroutine med_phases_prep_atm(gcomp, rc) end if ! Check for nans in fields export to atm - call FB_check_for_nans(is_local%wrap%FBExp(compatm), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compatm), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 97049d5b9..cd09abc3d 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -709,7 +709,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) ! Check for nans in fields export to atm do ns = 1,is_local%wrap%num_icesheets - call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compglc(ns)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 1e0496b3d..e234eb987 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -151,7 +151,7 @@ subroutine med_phases_prep_ice(gcomp, rc) end if ! Check for nans in fields export to atm - call FB_check_for_nans(is_local%wrap%FBExp(compice), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compice), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index b73412937..26722b4f8 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -129,7 +129,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) first_call = .false. ! Check for nans in fields export to atm - call FB_check_for_nans(is_local%wrap%FBExp(complnd), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(complnd), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index de989ac49..7628bd61a 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -297,7 +297,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call FB_check_for_nans(is_local%wrap%FBExp(compocn), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compocn), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! zero accumulator diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index cf0ad0f4e..b866cc00b 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -378,7 +378,7 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call FB_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(comprof), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 3028303bc..526ecb204 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -178,7 +178,7 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call FB_check_for_nans(is_local%wrap%FBExp(compwav), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compwav), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! zero accumulator From d84c9b3151c25fe8c34059d84e29918bf5abc0ca Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 18 May 2023 16:05:48 -0600 Subject: [PATCH 69/92] expand description --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 43623b195..a676c49ba 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -721,7 +721,7 @@ performance MED_attributes - Check for NaN values in fields returned from mediator to components + Check for NaN values in fields returned from mediator to components. This has a small performance impact. .false. From a753571a110dcb59f3b16d28d4868599bc7ef3ad Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 08:39:08 -0600 Subject: [PATCH 70/92] make default .true. add log message --- cime_config/namelist_definition_drv.xml | 2 +- mediator/med_methods_mod.F90 | 15 +++++++++++---- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index a676c49ba..dec6868f1 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -724,7 +724,7 @@ Check for NaN values in fields returned from mediator to components. This has a small performance impact. - .false. + .true. diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 739db9b54..b4e9c2050 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2507,7 +2507,7 @@ end subroutine med_methods_FB_getmesh !----------------------------------------------------------------------------- subroutine med_methods_FB_check_for_nans(gcomp, FB, rc) - + use med_internalstate_mod, only : maintask, logunit use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_GridComp use NUOPC, only : NUOPC_CompAttributeGet ! input/output variables @@ -2538,16 +2538,23 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, rc) if (firstcall) then call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue, *) checkfornans + read(cvalue, *) checkfornans firstcall = .false. + if(maintask) then + write(logunit,*) ' check_for_nans is ',checkfornans + if(checkfornans) then + write(logunit,*) ' Fields will be checked for NaN values when passed from mediator to component' + else + write(logunit,*) ' Fields will NOT be checked for NaN values when passed from mediator to component' + endif + endif endif if(.not. checkfornans) return - #else ! For now only CESM uses shr_infnan_isnan - so until other models provide this RETURN #endif - + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 0ff2afeedb44c40c2e1b2d6ec2b3ff3f3c5b11ae Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 09:16:22 -0600 Subject: [PATCH 71/92] resolve circular dependancy --- mediator/med_methods_mod.F90 | 5 +++-- mediator/med_phases_prep_atm_mod.F90 | 4 ++-- mediator/med_phases_prep_glc_mod.F90 | 2 +- mediator/med_phases_prep_ice_mod.F90 | 2 +- mediator/med_phases_prep_lnd_mod.F90 | 4 ++-- mediator/med_phases_prep_ocn_mod.F90 | 2 +- mediator/med_phases_prep_rof_mod.F90 | 2 +- mediator/med_phases_prep_wav_mod.F90 | 2 +- 8 files changed, 12 insertions(+), 11 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index b4e9c2050..95c87d7b3 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2506,13 +2506,14 @@ subroutine med_methods_FB_getmesh(FB, mesh, rc) end subroutine med_methods_FB_getmesh !----------------------------------------------------------------------------- - subroutine med_methods_FB_check_for_nans(gcomp, FB, rc) - use med_internalstate_mod, only : maintask, logunit + subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_GridComp use NUOPC, only : NUOPC_CompAttributeGet ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp type(ESMF_FieldBundle) , intent(in) :: FB + logical , intent(in) :: maintask + integer , intent(in) :: logunit integer , intent(inout) :: rc ! local variables diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 8de571d0d..a58becf9a 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -17,7 +17,7 @@ module med_phases_prep_atm_mod use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, maintask + use med_internalstate_mod , only : InternalState, maintask, logunit use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode use esmFlds , only : med_fldlist_GetfldListTo, med_fldlist_type use perf_mod , only : t_startf, t_stopf @@ -245,7 +245,7 @@ subroutine med_phases_prep_atm(gcomp, rc) end if ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compatm), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compatm), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index cd09abc3d..4ee84448e 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -709,7 +709,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) ! Check for nans in fields export to atm do ns = 1,is_local%wrap%num_icesheets - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compglc(ns)), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compglc(ns)), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index e234eb987..da56458c7 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -151,7 +151,7 @@ subroutine med_phases_prep_ice(gcomp, rc) end if ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compice), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compice), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 26722b4f8..1bab6c794 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -33,7 +33,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : complnd, compatm - use med_internalstate_mod , only : InternalState, maintask + use med_internalstate_mod , only : InternalState, maintask, logunit use med_merge_mod , only : med_merge_auto use perf_mod , only : t_startf, t_stopf @@ -129,7 +129,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) first_call = .false. ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(complnd), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(complnd), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 7628bd61a..b9a3a485e 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -297,7 +297,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compocn), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compocn), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! zero accumulator diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index b866cc00b..e2853c51c 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -378,7 +378,7 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(comprof), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(comprof), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 526ecb204..200e4bc62 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -178,7 +178,7 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compwav), rc=rc) + call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compwav), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! zero accumulator From 689d674c2bb083a580bd2ffbe66d6b1200d00f86 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 09:20:26 -0600 Subject: [PATCH 72/92] remove CESMCOUPLED cppdef --- mediator/med_methods_mod.F90 | 30 +----------------------------- 1 file changed, 1 insertion(+), 29 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 95c87d7b3..452017932 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2535,7 +2535,6 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) ! ---------------------------------------------- rc = ESMF_SUCCESS -#ifdef CESMCOUPLED if (firstcall) then call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2551,11 +2550,7 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) endif endif if(.not. checkfornans) return -#else - ! For now only CESM uses shr_infnan_isnan - so until other models provide this - RETURN -#endif - + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2592,7 +2587,6 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- -#ifdef CESMCOUPLED subroutine med_methods_check_for_nans_1d(dataptr, nancount) use shr_infnan_mod, only: shr_infnan_isnan @@ -2628,26 +2622,4 @@ subroutine med_methods_check_for_nans_2d(dataptr, nancount) end do end subroutine med_methods_check_for_nans_2d -#else - - ! For now only CESM uses shr_infnan_isnan - so until other models provide this - ! nancount will just be set to zero - - subroutine med_methods_check_for_nans_1d(dataptr, nancount) - ! input/output variables - real(r8) , intent(in) :: dataptr(:) - integer , intent(out) :: nancount - - nancount = 0 - end subroutine med_methods_check_for_nans_1d - - subroutine med_methods_check_for_nans_2d(dataptr, nancount) - ! input/output variables - real(r8) , intent(in) :: dataptr(:,:) - integer , intent(out) :: nancount - - nancount = 0 - end subroutine med_methods_check_for_nans_2d -#endif - end module med_methods_mod From b6ba816c71ad2e1b8992c7cab3c93185a56b1bad Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 10:53:56 -0600 Subject: [PATCH 73/92] pass the strict ext build test --- .github/workflows/extbuild.yml | 4 ++-- mediator/med_methods_mod.F90 | 33 ++++++++++++++++++++++++++++++++- 2 files changed, 34 insertions(+), 3 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index fafc46f46..a659e4eb6 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -19,10 +19,10 @@ jobs: CXX: mpicxx CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.4.0 + ESMF_VERSION: v8.4.2 PNETCDF_VERSION: checkpoint.1.12.3 NETCDF_FORTRAN_VERSION: v4.6.0 - PIO_VERSION: pio2_5_10 + PIO_VERSION: pio2_6_0 steps: - uses: actions/checkout@v3 # Build the ESMF library, if the cache contains a previous build diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 452017932..5b5ec6bde 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2535,6 +2535,7 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) ! ---------------------------------------------- rc = ESMF_SUCCESS +#ifdef CESMCOUPLED if (firstcall) then call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2549,8 +2550,15 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) endif endif endif +#else + ! For now only CESM uses shr_infnan_isnan - so until other models provide this + cvalue = ".false." + checkfornans = .false. + if(firstcall) write(logunit,*) ' Fields will NOT be checked for NaN values when passed from mediator to component' + firstcall = .false. +#endif if(.not. checkfornans) return - + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2587,6 +2595,7 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- +#ifdef CESMCOUPLED subroutine med_methods_check_for_nans_1d(dataptr, nancount) use shr_infnan_mod, only: shr_infnan_isnan @@ -2622,4 +2631,26 @@ subroutine med_methods_check_for_nans_2d(dataptr, nancount) end do end subroutine med_methods_check_for_nans_2d +#else + + ! For now only CESM uses shr_infnan_isnan - so until other models provide this + ! nancount will just be set to zero + + subroutine med_methods_check_for_nans_1d(dataptr, nancount) + ! input/output variables + real(r8) , intent(in) :: dataptr(:) + integer , intent(out) :: nancount + + nancount = 0 + end subroutine med_methods_check_for_nans_1d + + subroutine med_methods_check_for_nans_2d(dataptr, nancount) + ! input/output variables + real(r8) , intent(in) :: dataptr(:,:) + integer , intent(out) :: nancount + + nancount = 0 + end subroutine med_methods_check_for_nans_2d +#endif + end module med_methods_mod From 79cf2082355dfd70dc92013cbd04dcdd2c810d59 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 16:49:26 -0600 Subject: [PATCH 74/92] rework based on pr review --- .github/workflows/extbuild.yml | 33 ++++++++++++++++++++++++-- mediator/med.F90 | 15 ++++++++++++ mediator/med_methods_mod.F90 | 35 +++++----------------------- mediator/med_phases_prep_atm_mod.F90 | 2 +- mediator/med_phases_prep_glc_mod.F90 | 4 ++-- mediator/med_phases_prep_ice_mod.F90 | 4 ++-- mediator/med_phases_prep_lnd_mod.F90 | 4 ++-- mediator/med_phases_prep_ocn_mod.F90 | 4 ++-- mediator/med_phases_prep_rof_mod.F90 | 4 ++-- mediator/med_phases_prep_wav_mod.F90 | 4 ++-- 10 files changed, 65 insertions(+), 44 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index a659e4eb6..d5f742588 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -18,11 +18,13 @@ jobs: FC: mpifort CXX: mpicxx CPPFLAGS: "-I/usr/include -I/usr/local/include" + # Versions of all dependencies can be updated here ESMF_VERSION: v8.4.2 PNETCDF_VERSION: checkpoint.1.12.3 NETCDF_FORTRAN_VERSION: v4.6.0 PIO_VERSION: pio2_6_0 + CDEPS_VERSION: cdeps1.0.15 steps: - uses: actions/checkout@v3 # Build the ESMF library, if the cache contains a previous build @@ -50,14 +52,14 @@ jobs: key: ${{ runner.os }}-${{ env.PIO_VERSION }}.pio - name: Build ParallelIO if: steps.cache-ParallelIO.outputs.cache-hit != 'true' - uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@9390e30e29d4ebbfbef0fc72162cacd9e8f25e4e + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@2_6_0 with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True install_prefix: $HOME/pio - name: Build ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildesmf@e06246b560d3132170bb1a5443fa3d65dfbd2040 + uses: ESCOMP/CDEPS/.github/actions/buildesmf@cdeps1.0.15 with: esmf_version: ${{ env.ESMF_VERSION }} esmf_bopt: g @@ -67,6 +69,29 @@ jobs: netcdf_fortran_path: /usr pnetcdf_path: /usr parallelio_path: $HOME/pio + - name: Cache CDEPS + id: cache-cdeps + uses: actions/cache@v3 + with: + path: $HOME/cdeps + key: ${{ runner.os }}-${{ env.CDEPS_VERSION }}.cdeps + + - name: checkout CDEPS + uses: actions/checkout@v3 + with: + repository: ESCOMP/CDEPS + path: cdeps-src + ref: ${{ env.CDEPS_VERSION }} + - name: Build CDEPS + if steps.cache-cdeps.outputs.cache-hit != 'true' + uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.15 + with: + esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk + pio_path: $HOME/pio + src_root: $HOME/cdeps-src + cmake_flags: " -Wno-dev -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ + -ffree-form -ffree-line-length-none -fallow-argument-mismatch \"" + - name: Build CMEPS run: | export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk @@ -76,3 +101,7 @@ jobs: cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Wall -Werror -ffree-form -ffree-line-length-none -Wno-unused-dummy-argument" ../ make VERBOSE=1 popd + + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 diff --git a/mediator/med.F90 b/mediator/med.F90 index e7c6da9d3..df0b13eca 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -661,6 +661,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use esmFlds, only : med_fldlist_init1, med_fld_GetFldInfo, med_fldList_entry_type use med_phases_history_mod, only : med_phases_history_init + use med_methods_mod , only : mediator_checkfornans ! input/output variables type(ESMF_GridComp) :: gcomp @@ -916,6 +917,20 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) end if end do ! end of ncomps loop + ! Should mediator check for NaNs? + call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue, *) mediator_checkfornans + if(maintask) then + write(logunit,*) ' check_for_nans is ',mediator_checkfornans + if(mediator_checkfornans) then + write(logunit,*) ' Fields will be checked for NaN values when passed from mediator to component' + else + write(logunit,*) ' Fields will NOT be checked for NaN values when passed from mediator to component' + endif + endif + + if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 5b5ec6bde..40e10bc72 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -30,7 +30,7 @@ module med_methods_mod end interface med_methods_check_for_nans ! used/reused in module - + logical, public :: mediator_checkfornans ! set in med.F90 AdvertiseFields logical :: isPresent character(len=1024) :: msgString type(ESMF_FieldStatus_Flag) :: status @@ -2506,11 +2506,9 @@ subroutine med_methods_FB_getmesh(FB, mesh, rc) end subroutine med_methods_FB_getmesh !----------------------------------------------------------------------------- - subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) - use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_GridComp - use NUOPC, only : NUOPC_CompAttributeGet + subroutine med_methods_FB_check_for_nans(FB, maintask, logunit, rc) + use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet ! input/output variables - type(ESMF_GridComp) , intent(in) :: gcomp type(ESMF_FieldBundle) , intent(in) :: FB logical , intent(in) :: maintask integer , intent(in) :: logunit @@ -2528,36 +2526,15 @@ subroutine med_methods_FB_check_for_nans(gcomp, FB, maintask, logunit, rc) character(len=CS) :: nancount_char character(len=CL) :: msg_error logical :: nanfound - logical, save :: checkfornans - logical, save :: firstcall=.true. - character(len=CL) :: cvalue character(len=*), parameter :: subname='(med_methods_FB_check_for_nans)' ! ---------------------------------------------- rc = ESMF_SUCCESS -#ifdef CESMCOUPLED - if (firstcall) then - call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue, *) checkfornans - firstcall = .false. - if(maintask) then - write(logunit,*) ' check_for_nans is ',checkfornans - if(checkfornans) then - write(logunit,*) ' Fields will be checked for NaN values when passed from mediator to component' - else - write(logunit,*) ' Fields will NOT be checked for NaN values when passed from mediator to component' - endif - endif - endif -#else +#ifndef CESMCOUPLED ! For now only CESM uses shr_infnan_isnan - so until other models provide this - cvalue = ".false." - checkfornans = .false. - if(firstcall) write(logunit,*) ' Fields will NOT be checked for NaN values when passed from mediator to component' - firstcall = .false. + mediator_checkfornans = .false. #endif - if(.not. checkfornans) return + if(.not. mediator_checkfornans) return call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index a58becf9a..98728a8a6 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -245,7 +245,7 @@ subroutine med_phases_prep_atm(gcomp, rc) end if ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compatm), maintask, logunit, rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(compatm), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 4ee84448e..920fb415e 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -707,9 +707,9 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) endif end if - ! Check for nans in fields export to atm + ! Check for nans in fields export to glc do ns = 1,is_local%wrap%num_icesheets - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compglc(ns)), maintask, logunit, rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index da56458c7..524313622 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -150,8 +150,8 @@ subroutine med_phases_prep_ice(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compice), maintask, logunit, rc=rc) + ! Check for nans in fields export to ice + call FB_check_for_nans(is_local%wrap%FBExp(compice), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 1bab6c794..4be8bb402 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -128,8 +128,8 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! Set first call logical to false first_call = .false. - ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(complnd), maintask, logunit, rc=rc) + ! Check for nans in fields export to lnd + call FB_check_for_nans(is_local%wrap%FBExp(complnd), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index b9a3a485e..59a87726c 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -296,8 +296,8 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compocn), is_local%wrap%FBExpAccumOcn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compocn), maintask, logunit, rc=rc) + ! Check for nans in fields export to ocn + call FB_check_for_nans(is_local%wrap%FBExp(compocn), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! zero accumulator diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index e2853c51c..55b2dae82 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -377,8 +377,8 @@ subroutine med_phases_prep_rof(gcomp, rc) FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=fldList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(comprof), maintask, logunit, rc=rc) + ! Check for nans in fields export to rof + call FB_check_for_nans(is_local%wrap%FBExp(comprof), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 200e4bc62..c690aa522 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -177,8 +177,8 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compwav), is_local%wrap%FBExpAccumWav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Check for nans in fields export to atm - call FB_check_for_nans(gcomp, is_local%wrap%FBExp(compwav), maintask, logunit, rc=rc) + ! Check for nans in fields export to wav + call FB_check_for_nans(is_local%wrap%FBExp(compwav), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! zero accumulator From 92ace685b61e48bd62ea41eeb5ea7768610d50ed Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 16:51:41 -0600 Subject: [PATCH 75/92] fix yaml syntax --- .github/workflows/extbuild.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index d5f742588..4b00101c7 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -83,7 +83,7 @@ jobs: path: cdeps-src ref: ${{ env.CDEPS_VERSION }} - name: Build CDEPS - if steps.cache-cdeps.outputs.cache-hit != 'true' + if: steps.cache-cdeps.outputs.cache-hit != 'true' uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.15 with: esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk From 60b9f1999890e6217b598f2011f0d55cf26f240d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 16:54:05 -0600 Subject: [PATCH 76/92] fix ext versions --- .github/workflows/extbuild.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 4b00101c7..15237f0db 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -52,14 +52,14 @@ jobs: key: ${{ runner.os }}-${{ env.PIO_VERSION }}.pio - name: Build ParallelIO if: steps.cache-ParallelIO.outputs.cache-hit != 'true' - uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@2_6_0 + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@${{ env.PIO_VERSION }} with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True install_prefix: $HOME/pio - name: Build ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildesmf@cdeps1.0.15 + uses: ESCOMP/CDEPS/.github/actions/buildesmf@${{ env.CDEPS_VERSION }} with: esmf_version: ${{ env.ESMF_VERSION }} esmf_bopt: g From 0b862b929ace490f06c56b87f200b4d890146505 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 19 May 2023 16:55:21 -0600 Subject: [PATCH 77/92] fix ext versions --- .github/workflows/extbuild.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 15237f0db..f968d0371 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -52,14 +52,14 @@ jobs: key: ${{ runner.os }}-${{ env.PIO_VERSION }}.pio - name: Build ParallelIO if: steps.cache-ParallelIO.outputs.cache-hit != 'true' - uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@${{ env.PIO_VERSION }} + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@pio2_6_0 with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True install_prefix: $HOME/pio - name: Build ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildesmf@${{ env.CDEPS_VERSION }} + uses: ESCOMP/CDEPS/.github/actions/buildesmf@cdeps1.0.15 with: esmf_version: ${{ env.ESMF_VERSION }} esmf_bopt: g From 5b26040ea42182724c5d24ec113f0221e78b51de Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 23 May 2023 10:53:19 -0600 Subject: [PATCH 78/92] add ispresent and isset --- mediator/med.F90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index df0b13eca..56fcb7621 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -918,9 +918,13 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) end do ! end of ncomps loop ! Should mediator check for NaNs? - call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue, *) mediator_checkfornans + if(isPresent .and. isSet) then + read(cvalue, *) mediator_checkfornans + else + mediator_checkfornans = .false. + endif if(maintask) then write(logunit,*) ' check_for_nans is ',mediator_checkfornans if(mediator_checkfornans) then From dabe6d3ae5592adc2520a1203b9d34c0d37df08d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 23 May 2023 14:56:23 -0600 Subject: [PATCH 79/92] make xgrid default (should have been in alpha12c) and fix sw flux to mom ocn --- cime_config/namelist_definition_drv.xml | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 6 +++++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index fdc53d43b..57baa9229 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -927,7 +927,7 @@ default: xgrid - ogrid + xgrid diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 60e37a95e..7d8950582 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -383,7 +383,11 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check that the necessary export field is present - if ( .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then + if ( .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc) .and. & + .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & + .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & + .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & + .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc)) then return end if From e94015a90bcee1cea45a6f30f78eab5e292dd6f6 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 23 May 2023 17:56:49 -0600 Subject: [PATCH 80/92] slight change in logic --- mediator/med_phases_prep_ocn_mod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 7d8950582..c19a4cf47 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -384,10 +384,10 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ! Check that the necessary export field is present if ( .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc) .and. & - .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & - .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & - .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & - .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc)) then + .not. (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc))) then return end if From f174edd579a62ec8278e0f70577d35faa155df91 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 24 May 2023 08:28:30 -0600 Subject: [PATCH 81/92] fix src path for cdeps --- .github/workflows/extbuild.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index f968d0371..581c27324 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -80,7 +80,7 @@ jobs: uses: actions/checkout@v3 with: repository: ESCOMP/CDEPS - path: cdeps-src + path: ${GITHUB_WORKSPACE}/cdeps-src ref: ${{ env.CDEPS_VERSION }} - name: Build CDEPS if: steps.cache-cdeps.outputs.cache-hit != 'true' @@ -88,7 +88,7 @@ jobs: with: esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk pio_path: $HOME/pio - src_root: $HOME/cdeps-src + src_root: ${GITHUB_WORKSPACE}/cdeps-src cmake_flags: " -Wno-dev -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ -ffree-form -ffree-line-length-none -fallow-argument-mismatch \"" From 9817b91c5ccf3c91891aefad891ab910a5c45ba3 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 24 May 2023 09:44:00 -0600 Subject: [PATCH 82/92] cdeps path again --- .github/workflows/extbuild.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 581c27324..2581a546d 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -80,7 +80,7 @@ jobs: uses: actions/checkout@v3 with: repository: ESCOMP/CDEPS - path: ${GITHUB_WORKSPACE}/cdeps-src + path: $HOME/cdeps-src ref: ${{ env.CDEPS_VERSION }} - name: Build CDEPS if: steps.cache-cdeps.outputs.cache-hit != 'true' @@ -88,7 +88,7 @@ jobs: with: esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk pio_path: $HOME/pio - src_root: ${GITHUB_WORKSPACE}/cdeps-src + src_root: $HOME/cdeps-src cmake_flags: " -Wno-dev -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ -ffree-form -ffree-line-length-none -fallow-argument-mismatch \"" From 371d7522c8f3eabad6027d85084808d978ad7acf Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 24 May 2023 09:49:50 -0600 Subject: [PATCH 83/92] cdeps path again --- .github/workflows/extbuild.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 2581a546d..a3b119392 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -80,7 +80,7 @@ jobs: uses: actions/checkout@v3 with: repository: ESCOMP/CDEPS - path: $HOME/cdeps-src + path: cdeps-src ref: ${{ env.CDEPS_VERSION }} - name: Build CDEPS if: steps.cache-cdeps.outputs.cache-hit != 'true' @@ -88,7 +88,7 @@ jobs: with: esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk pio_path: $HOME/pio - src_root: $HOME/cdeps-src + src_root: ${GITHUB_WORKSPACE}/cdeps-src cmake_flags: " -Wno-dev -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ -ffree-form -ffree-line-length-none -fallow-argument-mismatch \"" From 8f59dbaa6bb113141d26c81d23538d8f4779bfae Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 24 May 2023 10:04:39 -0600 Subject: [PATCH 84/92] try building ext with cdeps share --- .github/workflows/extbuild.yml | 2 +- mediator/med_methods_mod.F90 | 28 ---------------------------- 2 files changed, 1 insertion(+), 29 deletions(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index a3b119392..6e26b40a5 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -98,7 +98,7 @@ jobs: export PIO=$HOME/pio mkdir build-cmeps pushd build-cmeps - cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Wall -Werror -ffree-form -ffree-line-length-none -Wno-unused-dummy-argument" ../ + cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Wall -Werror -ffree-form -ffree-line-length-none -Wno-unused-dummy-argument -I /home/runner/work/CMEPS/CMEPS/build-cdeps/share" ../ make VERBOSE=1 popd diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 40e10bc72..54fe20ec1 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2530,10 +2530,6 @@ subroutine med_methods_FB_check_for_nans(FB, maintask, logunit, rc) ! ---------------------------------------------- rc = ESMF_SUCCESS -#ifndef CESMCOUPLED - ! For now only CESM uses shr_infnan_isnan - so until other models provide this - mediator_checkfornans = .false. -#endif if(.not. mediator_checkfornans) return call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) @@ -2572,8 +2568,6 @@ subroutine med_methods_FB_check_for_nans(FB, maintask, logunit, rc) end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- -#ifdef CESMCOUPLED - subroutine med_methods_check_for_nans_1d(dataptr, nancount) use shr_infnan_mod, only: shr_infnan_isnan ! input/output variables @@ -2608,26 +2602,4 @@ subroutine med_methods_check_for_nans_2d(dataptr, nancount) end do end subroutine med_methods_check_for_nans_2d -#else - - ! For now only CESM uses shr_infnan_isnan - so until other models provide this - ! nancount will just be set to zero - - subroutine med_methods_check_for_nans_1d(dataptr, nancount) - ! input/output variables - real(r8) , intent(in) :: dataptr(:) - integer , intent(out) :: nancount - - nancount = 0 - end subroutine med_methods_check_for_nans_1d - - subroutine med_methods_check_for_nans_2d(dataptr, nancount) - ! input/output variables - real(r8) , intent(in) :: dataptr(:,:) - integer , intent(out) :: nancount - - nancount = 0 - end subroutine med_methods_check_for_nans_2d -#endif - end module med_methods_mod From a7a6dcbf0ee1c500d197c7b9377e09e306cfedcf Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 26 May 2023 09:57:11 -0600 Subject: [PATCH 85/92] testing indicates we are not yet ready for xgrid --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index d9001cfb7..dec6868f1 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -938,7 +938,7 @@ default: ogrid - xgrid + ogrid From 5f27114bdd2808c281c7b884fa084977a098d81b Mon Sep 17 00:00:00 2001 From: James Edwards Date: Fri, 23 Jun 2023 15:27:58 -0600 Subject: [PATCH 86/92] both =0 is not an error --- mediator/med_methods_mod.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 54fe20ec1..649c9c511 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -1354,7 +1354,10 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) call med_methods_Field_GetFldPtr(lfield, fldptr1=dataptro1, fldptr2=dataptro2, rank=lranko, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (lranki == 1 .and. lranko == 1) then + if (lranki == 0 .and. lranko == 0) then + ! do nothing + call ESMF_LogWrite(trim(subname)//": Both ranki and ranko are 0", ESMF_LOGMSG_INFO) + elseif (lranki == 1 .and. lranko == 1) then if (.not.med_methods_FieldPtr_Compare(dataPtro1, dataPtri1, subname, rc)) then call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", ESMF_LOGMSG_ERROR) @@ -1397,7 +1400,7 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) else write(msgString,'(a,2i8)') trim(subname)//": ranki, ranko = ",lranki,lranko - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_ERROR) call ESMF_LogWrite(trim(subname)//": ERROR ranki ranko not supported "//trim(lfieldnamelist(n)), & ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE From 0dbe67ed6f32066d1929f751c1e92dcbc7c2aed5 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Fri, 28 Jul 2023 09:43:13 -0600 Subject: [PATCH 87/92] fix the x case --- mediator/med_internalstate_mod.F90 | 1 - mediator/med_map_mod.F90 | 22 +++++++++++----------- 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index c5497293f..66e2eb1db 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -262,7 +262,6 @@ subroutine med_internalstate_init(gcomp, rc) end do end if is_local%wrap%num_icesheets = num_icesheets - 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 diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 18752dc2f..9f514a4cb 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -111,7 +111,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun type(ESMF_Mesh) :: mesh_dst type(med_fldlist_type), pointer :: FldListFr type(med_fldlist_entry_type), pointer :: fldptr - character(len=*), parameter :: subname=' (module_med_map: RouteHandles_init) ' + character(len=*), parameter :: subname=' (med_map_mod: RouteHandles_init) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -304,7 +304,7 @@ subroutine med_map_routehandles_initfrom_fieldbundle(n1, n2, FBsrc, FBdst, mapin ! local variables type(ESMF_Field) :: fldsrc type(ESMF_Field) :: flddst - character(len=*), parameter :: subname=' (module_MED_map:med_map_routehandles_initfrom_fieldbundle) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_routehandles_initfrom_fieldbundle) ' !--------------------------------------------- rc = ESMF_SUCCESS @@ -653,7 +653,7 @@ logical function med_map_RH_is_created_RH3d(RHs,n1,n2,mapindex,rc) integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH3d) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_RH_is_created_RH3d) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -678,7 +678,7 @@ logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) ! local variables integer :: rc1, rc2 logical :: mapexists - character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH1d) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_RH_is_created_RH1d) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -718,7 +718,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & use ESMF use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds, med_fldList_type use esmFlds , only : med_fld_getFldInfo - use med_internalstate_mod , only : compname, mapnames + use med_internalstate_mod , only : compname, mapnames, rof_name use med_internalstate_mod , only : packed_data_type, nmappers ! input/output variables @@ -750,7 +750,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & character(CL), allocatable :: fieldNameList(:) character(CS) :: mapnorm_mapindex character(len=CX) :: tmpstr - character(len=*), parameter :: subname=' (module_MED_map:med_packed_field_create) ' + character(len=*), parameter :: subname=' (med_map_mod:med_packed_field_create) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -817,7 +817,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & //', mapnorm '//trim(mapnorm_mapindex) & //' '//trim(fieldnamelist(nf)) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - else + else if(rof_name .ne. 'xrof' .and. compname(destcomp) .ne. 'ocn') then if (mapnorm_mapindex /= packed_data(mapindex)%mapnorm) then write(tmpstr,*)'Map type '//trim(mapnames(mapindex)) & //', destcomp '//trim(compname(destcomp)) & @@ -953,7 +953,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d type(ESMF_Field), pointer :: fieldlist_dst(:) real(r8), pointer :: data_norm(:) real(r8), pointer :: data_dst(:,:) - character(len=*), parameter :: subname=' (module_MED_map:med_map_field_packed) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -1165,7 +1165,7 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: lsize_src integer :: lsize_dst - character(len=*), parameter :: subname=' (module_MED_map:med_map_field_normalized) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_field_normalized) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -1278,7 +1278,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r logical :: checkflag = .false. character(len=CS) :: lfldname real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 - character(len=*), parameter :: subname='(module_MED_map:med_map_field) ' + character(len=*), parameter :: subname='(med_map_mod:med_map_field) ' !--------------------------------------------------- rc = ESMF_SUCCESS @@ -1381,7 +1381,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) integer :: spatialDim real(r8), parameter :: deg2rad = shr_const_pi/180.0_R8 ! deg to rads logical :: first_time = .true. - character(len=*), parameter :: subname=' (module_MED_map:med_map_uv_cart3d) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_uv_cart3d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS From 9b2942ac728aad88054f6718d09024c69241fd70 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Mon, 31 Jul 2023 11:47:16 -0600 Subject: [PATCH 88/92] alternate solution for X case --- mediator/esmFldsExchange_cesm_mod.F90 | 4 ++-- mediator/med_map_mod.F90 | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 13811aec9..a2c4fe435 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2158,7 +2158,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! liquid from river and possibly flood from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' , rc=rc)) then if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofl', compocn, mapconsd, 'none', 'unset') + call addmap_from(comprof, 'Forr_rofl', compocn, mapconsd, 'one', 'unset') else call addmap_from(comprof, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if @@ -2182,7 +2182,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! ice from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi' , rc=rc)) then if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofi', compocn, mapconsd, 'none', 'unset') + call addmap_from(comprof, 'Forr_rofi', compocn, mapconsd, 'one', 'unset') else call addmap_from(comprof, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) end if diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 9f514a4cb..82544370d 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -817,7 +817,8 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & //', mapnorm '//trim(mapnorm_mapindex) & //' '//trim(fieldnamelist(nf)) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - else if(rof_name .ne. 'xrof' .and. compname(destcomp) .ne. 'ocn') then + else + !if(rof_name .ne. 'xrof' .and. compname(destcomp) .ne. 'ocn') then if (mapnorm_mapindex /= packed_data(mapindex)%mapnorm) then write(tmpstr,*)'Map type '//trim(mapnames(mapindex)) & //', destcomp '//trim(compname(destcomp)) & From 3d8e23331f18c90b8945013ac45711ac63f741c7 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 1 Aug 2023 09:16:27 -0600 Subject: [PATCH 89/92] update esmf and pio externals used in srt github workflow --- .github/workflows/srt.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 39526be99..e478c355a 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -26,8 +26,8 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include " LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.4.0 - PARALLELIO_VERSION: pio2_5_10 + ESMF_VERSION: v8.5.0 + PARALLELIO_VERSION: pio2_6_0 CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} From 896b6a15158637ee633c6b50ab4e5816b9d5cd00 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 1 Aug 2023 10:16:21 -0600 Subject: [PATCH 90/92] debug workflow --- .github/workflows/srt.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index e478c355a..4eb158870 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -175,6 +175,6 @@ jobs: popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 From 5945f786aa767d4d897053ce5239b47f28176929 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 1 Aug 2023 11:17:04 -0600 Subject: [PATCH 91/92] try adding SRCROOT env variable --- .github/workflows/srt.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 4eb158870..34252cb63 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -153,6 +153,7 @@ jobs: mkdir -p $HOME/cesm/scratch mkdir -p $HOME/cesm/inputdata pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests + export SRCROOT=$GITHUB_WORKSPACE/cesm/ export CIME_TEST_PLATFORM=ubuntu-latest export PIO_INCDIR=$HOME/pio/include export PIO_LIBDIR=$HOME/pio/lib From 8282ebc1791fd43c7896d9806cabaa62817bcbe5 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 1 Aug 2023 17:06:07 -0600 Subject: [PATCH 92/92] remove rof_name --- mediator/med_map_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 82544370d..3ab205bd6 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -718,7 +718,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & use ESMF use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds, med_fldList_type use esmFlds , only : med_fld_getFldInfo - use med_internalstate_mod , only : compname, mapnames, rof_name + use med_internalstate_mod , only : compname, mapnames use med_internalstate_mod , only : packed_data_type, nmappers ! input/output variables