From 6e43394c995061580168ee89fed11bc5b2eb88ee Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 25 Mar 2021 17:19:14 -0600 Subject: [PATCH 01/54] addition of tests to testlist_drv.xml for cime testlists --- cime_config/testdefs/testlist_drv.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index 80b28a301..10ff0b7fc 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -376,7 +376,7 @@ - + @@ -391,7 +391,7 @@ - + @@ -400,7 +400,7 @@ - + From 19a4f9ccc2f887b4526c2636c773abf5d9fe01b9 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 28 Mar 2021 11:51:04 -0600 Subject: [PATCH 02/54] bug fix for co2_ppmv for C1850ECO --- cime_config/config_component_cesm.xml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index bf75e52ba..05ada3c77 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -499,7 +499,8 @@ 284.7 367.0 - 284.7 + 284.317 + 284.7 run_co2 env_run.xml From b58b78e72794cc32a201e12e04daed9bfac39f9e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 19 Feb 2021 14:43:23 -0700 Subject: [PATCH 03/54] incorporation of ocean precipitation factor and bug fixes --- cime_config/namelist_definition_drv.xml | 6 +-- mediator/med_internalstate_mod.F90 | 1 + mediator/med_io_mod.F90 | 3 +- mediator/med_phases_prep_ice_mod.F90 | 45 +++++++------------ mediator/med_phases_prep_ocn_mod.F90 | 57 ++++++++++++++++--------- 5 files changed, 58 insertions(+), 54 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 249683e8e..117d80077 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1666,7 +1666,7 @@ total number of scalars in the scalar coupling field - 5 + 4 @@ -1714,8 +1714,8 @@ index of scalar containing epbal precipitation factor from ocn (only for POP) - 0 - 5 + 4 + 0 diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 83558c9d1..be6191931 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -62,6 +62,7 @@ module med_internalstate_mod integer :: flds_scalar_index_ny = 0 integer :: flds_scalar_index_nextsw_cday = 0 integer :: flds_scalar_index_precip_factor = 0 + real(r8) :: flds_scalar_precip_factor = 1._r8 ! actual value of precip factor from ocn ! Import/export States and field bundles (the field bundles have the scalar fields removed) type(ESMF_State) :: NStateImp(ncomps) ! Import data from various component, on their grid diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index d4f767d6e..d894f54e6 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -1053,7 +1053,8 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & do k = 1,nf call FB_getNameN(FB, k, itemc, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + write(6,*)'DEBUG: k,itemc= ',k,trim(itemc) + call FB_getFldPtr(FB, itemc, & fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 7ec38e877..bbfdc7a5b 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -29,10 +29,11 @@ subroutine med_phases_prep_ice(gcomp, rc) use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_Field use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE use ESMF , only : ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND - use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_methods_mod , only : fldchk => med_methods_FB_FldChk - use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_utils_mod , only : chkerr => med_utils_ChkErr + 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_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_merge_mod , only : med_merge_auto use med_internalstate_mod , only : InternalState, logunit, mastertask use esmFlds , only : compatm, compice, compocn, comprof, compglc, ncomps, compname @@ -87,33 +88,17 @@ subroutine med_phases_prep_ice(gcomp, rc) fldListTo(compice), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! apply precipitation factor from ocean - ! TODO (mvertens, 2019-03-18): precip_fact here is not valid if - ! the component does not send it - hardwire it to 1 until this is resolved - if (trim(coupling_mode) == 'cesm') then - precip_fact = 1.0_R8 - if (precip_fact /= 1.0_R8) then - if (first_precip_fact_call .and. mastertask) then - write(logunit,'(a)')'(merge_to_ice): Scaling rain, snow, liquid and ice runoff by precip_fact ' - first_precip_fact_call = .false. + ! apply precipitation factor from ocean if appropriate + if (trim(coupling_mode) == 'cesm' .and. is_local%wrap%flds_scalar_index_precip_factor /= 0) then + fldnames = (/'Faxa_rain', 'Faxa_snow', 'Fixx_rofi'/) + do n = 1,size(fldnames) + if (FB_fldchk(is_local%wrap%FBExp(compice), trim(fldnames(n)), rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), trim(fldnames(n)), dataptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr1d(:) = dataptr1d(:) * is_local%wrap%flds_scalar_precip_factor end if - write(cvalue,*) precip_fact - call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) - - allocate(fldnames(3)) - fldnames = (/'Faxa_rain', 'Faxa_snow', 'Fixx_rofi'/) - do n = 1,size(fldnames) - if (fldchk(is_local%wrap%FBExp(compice), trim(fldnames(n)), rc=rc)) then - call ESMF_FieldBundleGet(is_local%wrap%FBExp(compice), fieldname=trim(fldnames(n)), & - field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayptr=dataptr1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr1d(:) = dataptr1d(:) * precip_fact - end if - end do - deallocate(fldnames) - end if + end do + deallocate(fldnames) end if ! obtain nextsw_cday from atm if it is in the import state and send it to ice diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index e924058f8..e850f802f 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -69,7 +69,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! auto merges to ocn - if (trim(coupling_mode) == 'cesm' .or. & + if ( trim(coupling_mode) == 'cesm' .or. & trim(coupling_mode) == 'nems_orig_data' .or. & trim(coupling_mode) == 'hafs') then call med_merge_auto(compocn, & @@ -193,7 +193,8 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ! custom calculations for cesm !--------------------------------------- - use ESMF , only : ESMF_GridComp + 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 @@ -203,6 +204,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ! local variables type(InternalState) :: is_local + type(ESMF_Field) :: lfield real(R8), pointer :: ifrac(:) => null() real(R8), pointer :: ofrac(:) => null() real(R8), pointer :: ifracr(:) => null() @@ -227,20 +229,21 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) real(R8), pointer :: Fioi_swpen_idf(:) => null() real(R8), pointer :: Fioi_swpen(:) => null() real(R8), pointer :: dataptr(:) => null() - real(R8), pointer :: dataptr_o(:) => null() + real(R8), pointer :: dataptr_scalar_ocn(:,:) => null() 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 - logical :: first_precip_fact_call = .true. - real(R8) :: precip_fact + 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 + logical :: first_call = .true. character(len=64), allocatable :: fldnames(:) character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_cesm)' !--------------------------------------- @@ -359,8 +362,8 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) import_swpen_by_bands = .false. end if - ! Swnet without swpen from sea-ice 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. @@ -416,14 +419,14 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ! 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_o, rc=rc) + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afrac', fldptr1=dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr_o(:) = ofrac(:) + 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_o, rc=rc) + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afracr', fldptr1=dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr_o(:) = ofracr(:) + dataptr(:) = ofracr(:) end if end if ! if sea-ice is present @@ -436,22 +439,36 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) !--------------------------------------- ! application of precipitation factor from ocean !--------------------------------------- - precip_fact = 1.0_R8 - if (precip_fact /= 1.0_R8) then - if (first_precip_fact_call .and. mastertask) then - write(logunit,'(a)')'(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by precip_fact ' - first_precip_fact_call = .false. + if (is_local%wrap%flds_scalar_index_precip_factor /= 0) then + 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 (first_call) then + write(logunit,'(a)')'(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by precip_fact ' + first_call = .false. + end if + write(logunit,'(a,f13.5)')'(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by precip_fact ',& + precip_fact(1) + 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 - write(cvalue,*) precip_fact - call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) - allocate(fldnames(4)) - fldnames = (/'Faxa_rain','Faxa_snow', 'Foxx_rofl', 'Foxx_rofi'/) + 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(:) * precip_fact + dataptr(:) = dataptr(:) * is_local%wrap%flds_scalar_precip_factor end if end do deallocate(fldnames) From be4ca24dea0de0356a2b95b8d3ec414bbfb98c09 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 25 Feb 2021 14:30:20 -0700 Subject: [PATCH 04/54] minor cleanup updates --- cime_config/namelist_definition_drv.xml | 29 +++++++++++++++++++++++++ mediator/med_io_mod.F90 | 1 - 2 files changed, 29 insertions(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 117d80077..70c9458ac 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1076,6 +1076,35 @@ + + char + mapping + ALLCOMP_attributes + + DOMAIN file needed for single column model + A nearest neighbor search is done to match the PTS_LAT and PTS_LON + to the closest point in the domain file. This file is ONLY used in + single column mode. The mask in this file is the land mask that will be used. + The ocean mask is just 1 minus the land mask. + + + $ATM_DOMAIN_PATH/$ATM_DOMAIN_FILE + + + + + char + mapping + LND_attributes + + DOMAIN description of lnd grid - this will be depracated + only here for backwards compatibility + + + $LND_DOMAIN_PATH/$LND_DOMAIN_FILE + + + char mapping diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index d894f54e6..bb156258e 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -1053,7 +1053,6 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & do k = 1,nf call FB_getNameN(FB, k, itemc, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(6,*)'DEBUG: k,itemc= ',k,trim(itemc) call FB_getFldPtr(FB, itemc, & fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) From 67d02d732c04b1b994a729b12d0c5555d6e77bdb Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 28 Mar 2021 18:07:36 -0600 Subject: [PATCH 05/54] backed out changes in namelist_definition_drv.xml --- cime_config/namelist_definition_drv.xml | 29 ------------------------- 1 file changed, 29 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 70c9458ac..117d80077 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1076,35 +1076,6 @@ - - char - mapping - ALLCOMP_attributes - - DOMAIN file needed for single column model - A nearest neighbor search is done to match the PTS_LAT and PTS_LON - to the closest point in the domain file. This file is ONLY used in - single column mode. The mask in this file is the land mask that will be used. - The ocean mask is just 1 minus the land mask. - - - $ATM_DOMAIN_PATH/$ATM_DOMAIN_FILE - - - - - char - mapping - LND_attributes - - DOMAIN description of lnd grid - this will be depracated - only here for backwards compatibility - - - $LND_DOMAIN_PATH/$LND_DOMAIN_FILE - - - char mapping From 09b453f5cdeabd6048eefd715b3a26461b57c24a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 28 Mar 2021 21:07:10 -0600 Subject: [PATCH 06/54] updates for precipitation factors from pop --- cime_config/namelist_definition_drv.xml | 2 +- mediator/med.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 6 ++++++ 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 117d80077..269551bae 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1643,7 +1643,7 @@ - + diff --git a/mediator/med.F90 b/mediator/med.F90 index 3dfd8031e..be746e71a 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -905,7 +905,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) if (isPresent .and. isSet) then read(cvalue,*) is_local%wrap%flds_scalar_index_precip_factor else - is_local%wrap%flds_scalar_index_precip_factor = spval + is_local%wrap%flds_scalar_index_precip_factor = 0 end if !------------------ diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index e850f802f..c958e29a3 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -440,6 +440,10 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ! application of precipitation factor from ocean !--------------------------------------- if (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) @@ -462,6 +466,8 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) write(cvalue,*) precip_fact(1) call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) end if + + ! Scale rain and snow 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) From a33c34e26289ed5642a8dcdfe0d5efcdc3ec8e78 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 29 Mar 2021 15:19:29 -0600 Subject: [PATCH 07/54] changes to get precipation factors from pop and scale rain and snow back to pop and cice --- mediator/med_constants_mod.F90 | 2 +- mediator/med_phases_prep_ice_mod.F90 | 46 ++++++++++++++++++++++++---- mediator/med_phases_prep_ocn_mod.F90 | 18 ++++++----- 3 files changed, 51 insertions(+), 15 deletions(-) diff --git a/mediator/med_constants_mod.F90 b/mediator/med_constants_mod.F90 index 4cc96f4f7..6c6d5f69e 100644 --- a/mediator/med_constants_mod.F90 +++ b/mediator/med_constants_mod.F90 @@ -11,6 +11,6 @@ module med_constants_mod real(R8), parameter :: med_constants_czero = 0.0_R8 ! spval integer, parameter :: med_constants_ispval_mask = -987987 ! spval for RH mask values integer, parameter :: med_constants_SecPerDay = 86400 ! Seconds per day - integer :: med_constants_dbug_flag = 0 + integer :: med_constants_dbug_flag = 15 end module med_constants_mod diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index bbfdc7a5b..db35cd1f1 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -29,6 +29,7 @@ subroutine med_phases_prep_ice(gcomp, rc) use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_Field use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE use ESMF , only : ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND + use ESMF , only : ESMF_VMBroadCast use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose @@ -46,12 +47,12 @@ subroutine med_phases_prep_ice(gcomp, rc) integer, intent(out) :: rc ! local variables - type(ESMF_StateItem_Flag) :: itemType type(InternalState) :: is_local type(ESMF_Field) :: lfield integer :: i,n - real(R8), pointer :: dataptr1d(:) => null() - real(R8) :: precip_fact + real(R8), pointer :: dataptr(:) => null() + real(R8), pointer :: dataptr_scalar_ocn(:,:) => null() + real(R8) :: precip_fact(1) character(len=CS) :: cvalue character(len=64), allocatable :: fldnames(:) real(r8) :: nextsw_cday @@ -88,14 +89,47 @@ subroutine med_phases_prep_ice(gcomp, rc) fldListTo(compice), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! apply precipitation factor from ocean if appropriate + ! Apply precipitation factor from ocean (that scales atm rain and snow to ice) 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 (first_call) then + write(logunit,'(a)')'(merge_to_ice): Scaling rain, snow, liquid and ice runoff by precip_fact from ocn' + first_call = .false. + end if + if (precip_fact(1) /= 1._r8) then + write(logunit,'(a,f21.13)')& + '(merge_to_ice): 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 ice from atm by the precipitation factor received from the ocean + allocate(fldnames(3)) fldnames = (/'Faxa_rain', 'Faxa_snow', 'Fixx_rofi'/) do n = 1,size(fldnames) if (FB_fldchk(is_local%wrap%FBExp(compice), trim(fldnames(n)), rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), trim(fldnames(n)), dataptr1d, rc=rc) + call FB_GetFldPtr(is_local%wrap%FBExp(compice), trim(fldnames(n)), dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr1d(:) = dataptr1d(:) * is_local%wrap%flds_scalar_precip_factor + dataptr(:) = dataptr(:) * is_local%wrap%flds_scalar_precip_factor end if end do deallocate(fldnames) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index c958e29a3..7b25b0a99 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -436,10 +436,9 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) deallocate(Foxx_swnet) end if - !--------------------------------------- - ! application of precipitation factor from ocean - !--------------------------------------- - if (is_local%wrap%flds_scalar_index_precip_factor /= 0) then + ! 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, @@ -453,11 +452,14 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) scalar_id=is_local%wrap%flds_scalar_index_precip_factor precip_fact(1) = dataptr_scalar_ocn(scalar_id,1) if (first_call) then - write(logunit,'(a)')'(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by precip_fact ' + write(logunit,'(a)')'(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by precip_fact from ocn' first_call = .false. end if - write(logunit,'(a,f13.5)')'(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by precip_fact ',& - precip_fact(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 @@ -467,7 +469,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) end if - ! Scale rain and snow from atm by the precipitation factor received from the ocean + ! 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) From abd3ef2c440fb4727a6b4478adbed20c91d60cbc Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 30 Mar 2021 12:29:51 -0600 Subject: [PATCH 08/54] turned debug flag back to 0 --- mediator/med_constants_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_constants_mod.F90 b/mediator/med_constants_mod.F90 index 6c6d5f69e..4cc96f4f7 100644 --- a/mediator/med_constants_mod.F90 +++ b/mediator/med_constants_mod.F90 @@ -11,6 +11,6 @@ module med_constants_mod real(R8), parameter :: med_constants_czero = 0.0_R8 ! spval integer, parameter :: med_constants_ispval_mask = -987987 ! spval for RH mask values integer, parameter :: med_constants_SecPerDay = 86400 ! Seconds per day - integer :: med_constants_dbug_flag = 15 + integer :: med_constants_dbug_flag = 0 end module med_constants_mod From 6dad8e48f5fa7e9d68b3601879cf8c81f489975f Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 1 Dec 2020 13:42:12 -0700 Subject: [PATCH 09/54] enable esmf aware threading --- drivers/cime/esm.F90 | 38 +++++++++++++++++++++++++------------- mediator/med.F90 | 6 +++--- 2 files changed, 28 insertions(+), 16 deletions(-) diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index 44dc74a51..e0a9973dd 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -802,8 +802,9 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM, ESMF_VMGet use ESMF , only : ESMF_LogWrite, ESMF_SUCCESS, ESMF_LOGMSG_INFO, ESMF_Config use ESMF , only : ESMF_ConfigGetLen, ESMF_LogFoundAllocError, ESMF_ConfigGetAttribute - use ESMF , only : ESMF_RC_NOT_VALID, ESMF_LogSetError + use ESMF , only : ESMF_RC_NOT_VALID, ESMF_LogSetError, ESMF_Info, ESMF_InfoSet use ESMF , only : ESMF_GridCompIsPetLocal, ESMF_MethodAdd, ESMF_UtilStringLowerCase + use ESMF , only : ESMF_InfoCreate, ESMF_InfoDestroy use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Driver , only : NUOPC_DriverAddComp use mpi , only : MPI_COMM_NULL @@ -812,28 +813,28 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifdef MED_PRESENT use med_internalstate_mod , only : med_id - use med , only : MedSetServices => SetServices + use med , only : MedSetServices => SetServices, MEDSetVM => SetVM #endif #ifdef ATM_PRESENT - use atm_comp_nuopc , only : ATMSetServices => SetServices + use atm_comp_nuopc , only : ATMSetServices => SetServices, ATMSetVM => SetVM #endif #ifdef ICE_PRESENT - use ice_comp_nuopc , only : ICESetServices => SetServices + use ice_comp_nuopc , only : ICESetServices => SetServices, ICESetVM => SetVM #endif #ifdef LND_PRESENT - use lnd_comp_nuopc , only : LNDSetServices => SetServices + use lnd_comp_nuopc , only : LNDSetServices => SetServices, LNDSetVM => SetVM #endif #ifdef OCN_PRESENT use ocn_comp_nuopc , only : OCNSetServices => SetServices #endif #ifdef WAV_PRESENT - use wav_comp_nuopc , only : WAVSetServices => SetServices + use wav_comp_nuopc , only : WAVSetServices => SetServices, WAVSetVM => SetVM #endif #ifdef ROF_PRESENT - use rof_comp_nuopc , only : ROFSetServices => SetServices + use rof_comp_nuopc , only : ROFSetServices => SetServices, ROFSetVM => SetVM #endif #ifdef GLC_PRESENT - use glc_comp_nuopc , only : GLCSetServices => SetServices + use glc_comp_nuopc , only : GLCSetServices => SetServices, GLCSetVM => SetVM #endif ! input/output variables @@ -845,6 +846,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) type(ESMF_GridComp) :: child type(ESMF_VM) :: vm type(ESMF_Config) :: config + type(ESMF_Info) :: info integer :: componentcount integer :: PetCount integer :: LocalPet @@ -928,6 +930,12 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) if(nthrds > maxthreads) maxthreads = nthrds + info = ESMF_InfoCreate(rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_InfoSet(info, key="/NUOPC/Instance/maxPeCountPerPet", value=nthrds, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_rootpe', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) rootpe @@ -958,29 +966,30 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) endif endif if(.not. allocated(petlist)) then - allocate(petlist(ntasks)) + allocate(petlist(ntasks*nthrds)) endif cnt = 1 - do ntask = rootpe, (rootpe+ntasks*stride)-1, stride + do ntask = rootpe, rootpe+nthrds*ntasks*stride-1, stride petlist(cnt) = ntask cnt = cnt + 1 enddo comps(i+1) = i+1 - found_comp = .false. #ifdef MED_PRESENT if (trim(compLabels(i)) == 'MED') then med_id = i + 1 - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, petList=petlist, comp=child, rc=rc) + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, MEDSetVM, & + petList=petlist, comp=child, info=info, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef ATM_PRESENT if (trim(compLabels(i)) .eq. 'ATM') then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, petList=petlist, comp=child, rc=rc) + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, ATMSetVM, & + petList=petlist, comp=child, info=info, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if @@ -1060,6 +1069,9 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) comms(i+1) = MPI_COMM_NULL comp_iamin(i) = .false. endif + call ESMF_InfoDestroy(info, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo ! Initialize MCT (this is needed for data models and cice prescribed capability) diff --git a/mediator/med.F90 b/mediator/med.F90 index be746e71a..9db3d320d 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -3,8 +3,8 @@ module MED !----------------------------------------------------------------------------- ! Mediator Component. !----------------------------------------------------------------------------- - use ESMF , only : ESMF_VMLogMemInfo + use NUOPC_Model , only : SetVM use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : spval_init => med_constants_spval_init @@ -48,7 +48,7 @@ module MED private public SetServices - + public SetVM private InitializeP0 private InitializeIPDv03p1 ! advertise fields private InitializeIPDv03p3 ! realize connected Fields with transfer action "provide" @@ -279,7 +279,7 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & specPhaselabel="med_phases_post_ocn", specRoutine=NUOPC_NoOp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - + !------------------ ! prep and post routines for ice !------------------ From 9df8c1166826cf48990912eb746d5157ad69f881 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 4 Dec 2020 07:41:17 -0700 Subject: [PATCH 10/54] allow esmf aware threading --- drivers/cime/esm.F90 | 123 +++++++++++++++++++++++++++++----------- drivers/cime/esmApp.F90 | 22 +++++-- 2 files changed, 107 insertions(+), 38 deletions(-) diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index e0a9973dd..c5fab6f45 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -807,7 +807,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use ESMF , only : ESMF_InfoCreate, ESMF_InfoDestroy use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Driver , only : NUOPC_DriverAddComp - use mpi , only : MPI_COMM_NULL + use mpi , only : MPI_COMM_NULL, mpi_comm_size use mct_mod , only : mct_world_init use shr_pio_mod , only : shr_pio_init2 @@ -825,7 +825,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use lnd_comp_nuopc , only : LNDSetServices => SetServices, LNDSetVM => SetVM #endif #ifdef OCN_PRESENT - use ocn_comp_nuopc , only : OCNSetServices => SetServices + use ocn_comp_nuopc , only : OCNSetServices => SetServices, OCNSetVM => SetVM #endif #ifdef WAV_PRESENT use wav_comp_nuopc , only : WAVSetServices => SetServices, WAVSetVM => SetVM @@ -866,13 +866,13 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) character(len=5) :: inst_suffix character(CL) :: cvalue logical :: found_comp + integer :: rank, nprocs, ierr character(len=*), parameter :: subname = "(esm_pelayout.F90:esm_init_pelayout)" !--------------------------------------- rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - maxthreads = 1 call ESMF_GridCompGet(driver, vm=vm, config=config, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -909,9 +909,21 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) allocate(comms(componentCount+1), comps(componentCount+1)) comps(1) = 1 + comms = MPI_COMM_NULL comms(1) = Global_Comm + + maxthreads = 1 do i=1,componentCount + namestr = ESMF_UtilStringLowerCase(compLabels(i)) + if (namestr == 'med') namestr = 'cpl' + call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_nthreads', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) nthrds + if(nthrds > maxthreads) maxthreads = nthrds + enddo + + do i=1,componentCount namestr = ESMF_UtilStringLowerCase(compLabels(i)) if (namestr == 'med') namestr = 'cpl' call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_ntasks', value=cvalue, rc=rc) @@ -928,8 +940,6 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) nthrds - if(nthrds > maxthreads) maxthreads = nthrds - info = ESMF_InfoCreate(rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -969,69 +979,114 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) allocate(petlist(ntasks*nthrds)) endif - cnt = 1 - do ntask = rootpe, rootpe+nthrds*ntasks*stride-1, stride - petlist(cnt) = ntask - cnt = cnt + 1 + do ntask = 1, size(petlist) + petlist(ntask) = rootpe + (ntask-1)*stride enddo comps(i+1) = i+1 found_comp = .false. +! If maxthreads == 1 then no threading is used and we do not need the SetVM in calls to NUOPC_DriverAddComp #ifdef MED_PRESENT if (trim(compLabels(i)) == 'MED') then med_id = i + 1 - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, MEDSetVM, & - petList=petlist, comp=child, info=info, rc=rc) + if(maxthreads > 1) then + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, MEDSetVM, & + petList=petlist, comp=child, info=info, rc=rc) + else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, & + petList=petlist, comp=child, rc=rc) + endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef ATM_PRESENT if (trim(compLabels(i)) .eq. 'ATM') then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, ATMSetVM, & - petList=petlist, comp=child, info=info, rc=rc) + if(maxthreads > 1) then + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, ATMSetVM, & + petList=petlist, comp=child, info=info, rc=rc) + else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, & + petList=petlist, comp=child, rc=rc) + endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef LND_PRESENT if (trim(compLabels(i)) .eq. 'LND') then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), LNDSetServices, PetList=petlist, comp=child, rc=rc) + if(maxthreads > 1) then + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), LNDSetServices, LNDSetVM, & + PetList=petlist, comp=child, info=info, rc=rc) + else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), LNDSetServices, & + PetList=petlist, comp=child, rc=rc) + endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef OCN_PRESENT if (trim(compLabels(i)) .eq. 'OCN') then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), OCNSetServices, PetList=petlist, comp=child, rc=rc) + if(maxthreads > 1) then + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), OCNSetServices, OCNSetVM, & + PetList=petlist, comp=child, info=info, rc=rc) + else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), OCNSetServices, & + PetList=petlist, comp=child, rc=rc) + endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef ICE_PRESENT if (trim(compLabels(i)) .eq. 'ICE') then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ICESetServices, PetList=petlist, comp=child, rc=rc) + if(maxthreads > 1) then + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ICESetServices, ICESetVM, & + PetList=petlist, comp=child, info=info, rc=rc) + else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ICESetServices, & + PetList=petlist, comp=child, rc=rc) + endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef GLC_PRESENT if (trim(compLabels(i)) .eq. 'GLC') then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), GLCSetServices, PetList=petlist, comp=child, rc=rc) + if(maxthreads > 1) then + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), GLCSetServices, GLCSetVM, & + PetList=petlist, comp=child, info=info, rc=rc) + else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), GLCSetServices, & + PetList=petlist, comp=child, rc=rc) + endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef ROF_PRESENT if (trim(compLabels(i)) .eq. 'ROF') then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ROFSetServices, PetList=petlist, comp=child, rc=rc) + if(maxthreads > 1) then + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ROFSetServices, ROFSetVM, & + PetList=petlist, comp=child, info=info, rc=rc) + else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ROFSetServices, & + PetList=petlist, comp=child, rc=rc) + endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef WAV_PRESENT if (trim(compLabels(i)) .eq. 'WAV') then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), WAVSetServices, PetList=petlist, comp=child, rc=rc) + if(maxthreads > 1) then + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), WAVSetServices, WAVSetVM, & + PetList=petlist, comp=child, info=info, rc=rc) + else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), WAVSetServices, & + PetList=petlist, comp=child, rc=rc) + endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if @@ -1048,27 +1103,31 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return endif + comp_iamin(i) = .false. if (ESMF_GridCompIsPetLocal(child, rc=rc)) then - call ESMF_GridCompGet(child, vm=vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=comms(i+1), localPet=comp_comm_iam(i), rc=rc) + call ESMF_GridCompGet(child, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call AddAttributes(child, driver, config, i+1, trim(compLabels(i)), inst_suffix, rc=rc) + call ESMF_VMGet(vm, mpiCommunicator=comms(i+1), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! This code is not supported, we need an optional arg to NUOPC_DriverAddComp to include the - ! per component thread count. #3614572 in esmf_support - ! call ESMF_GridCompSetVMMaxPEs(child, maxPeCountPerPet=nthrds, rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - - comp_iamin(i) = .true. - else - comms(i+1) = MPI_COMM_NULL - comp_iamin(i) = .false. + if (comms(i+1) .ne. MPI_COMM_NULL) then + call ESMF_VMGet(vm, localPet=comp_comm_iam(i), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + comp_iamin(i) = .true. + call MPI_Comm_size(comms(i+1), nprocs, ierr) + call MPI_Comm_rank(comms(i+1), rank, ierr) + if(nprocs /= ntasks) then + write(msgstr,*) 'Component ',trim(compLabels(i)),' has mpi task mismatch, do threads align with nodes?' + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + endif endif + call ESMF_InfoDestroy(info, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/drivers/cime/esmApp.F90 b/drivers/cime/esmApp.F90 index 186e0b699..b44a1b848 100644 --- a/drivers/cime/esmApp.F90 +++ b/drivers/cime/esmApp.F90 @@ -10,6 +10,8 @@ program esmApp use ESMF, only : ESMF_GridCompDestroy, ESMF_LOGMSG_INFO, ESMF_GridComp, ESMF_GridCompRun use ESMF, only : ESMF_GridCompFinalize, ESMF_GridCompCreate, ESMF_GridCompInitialize use ESMF, only : ESMF_LOGKIND_MULTI_ON_ERROR, ESMF_LogKind_Flag + use ESMF, only : ESMF_VMGet, ESMF_VM, ESMF_InitializePreMPI + #ifdef USE_MPI2 use mpi, only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_BCAST, MPI_COMM_RANK #else @@ -18,7 +20,7 @@ program esmApp use NUOPC, only : NUOPC_FieldDictionarySetup use ensemble_driver, only : SetServices use shr_pio_mod, only : shr_pio_init1 - use shr_sys_mod, only : shr_sys_abort + use shr_sys_mod, only : shr_sys_abort implicit none @@ -30,14 +32,17 @@ program esmApp logical :: create_esmf_pet_files = .false. integer :: iam, ier integer :: fileunit + integer :: provided + type(ESMF_VM) :: vm - namelist /debug_inparm / create_esmf_pet_files + namelist /debug_inparm / create_esmf_pet_files !----------------------------------------------------------------------------- ! Initiallize MPI !----------------------------------------------------------------------------- - call MPI_init(rc) + call ESMF_InitializePreMPI() + call MPI_init_thread(MPI_THREAD_SERIALIZED, provided, rc) COMP_COMM = MPI_COMM_WORLD !----------------------------------------------------------------------------- @@ -57,7 +62,6 @@ program esmApp ! by default, ESMF_LOGKIND_MULTI_ON_ERROR does not create files PET[N*].ESMF_LogFile unless there is an error ! if want those files, comment out the following line and uncomment the line logkindflag = ESMF_LOGKIND_MULTI - call mpi_comm_rank(COMP_COMM, iam, ier) if (iam==0) then open(newunit=fileunit, status="old", file="drv_in") @@ -74,9 +78,15 @@ program esmApp else logkindflag = ESMF_LOGKIND_MULTI_ON_ERROR end if - call ESMF_Initialize(mpiCommunicator=COMP_COMM, logkindflag=logkindflag, logappendflag=.false., & - defaultCalkind=ESMF_CALKIND_GREGORIAN, ioUnitLBound=5001, ioUnitUBound=5101, rc=rc) + defaultCalkind=ESMF_CALKIND_GREGORIAN, ioUnitLBound=5001, ioUnitUBound=5101, vm=vm, rc=rc) + + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_VMGet(vm, mpiCommunicator=COMP_COMM, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & From c3a25fab99ab3c7a1700faf75f1a60e7e8bdb83e Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 7 Dec 2020 07:14:21 -0700 Subject: [PATCH 11/54] dont use SetVM unless nthrds > 1 --- drivers/cime/esm.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index c5fab6f45..12331ea2d 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -989,7 +989,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifdef MED_PRESENT if (trim(compLabels(i)) == 'MED') then med_id = i + 1 - if(maxthreads > 1) then + if(nthrds > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, MEDSetVM, & petList=petlist, comp=child, info=info, rc=rc) else @@ -1002,7 +1002,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #endif #ifdef ATM_PRESENT if (trim(compLabels(i)) .eq. 'ATM') then - if(maxthreads > 1) then + if(nthrds > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, ATMSetVM, & petList=petlist, comp=child, info=info, rc=rc) else @@ -1015,7 +1015,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #endif #ifdef LND_PRESENT if (trim(compLabels(i)) .eq. 'LND') then - if(maxthreads > 1) then + if(nthrds > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), LNDSetServices, LNDSetVM, & PetList=petlist, comp=child, info=info, rc=rc) else @@ -1028,7 +1028,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #endif #ifdef OCN_PRESENT if (trim(compLabels(i)) .eq. 'OCN') then - if(maxthreads > 1) then + if(nthrds > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), OCNSetServices, OCNSetVM, & PetList=petlist, comp=child, info=info, rc=rc) else @@ -1041,7 +1041,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #endif #ifdef ICE_PRESENT if (trim(compLabels(i)) .eq. 'ICE') then - if(maxthreads > 1) then + if(nthrds > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ICESetServices, ICESetVM, & PetList=petlist, comp=child, info=info, rc=rc) else @@ -1054,7 +1054,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #endif #ifdef GLC_PRESENT if (trim(compLabels(i)) .eq. 'GLC') then - if(maxthreads > 1) then + if(nthrds > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), GLCSetServices, GLCSetVM, & PetList=petlist, comp=child, info=info, rc=rc) else @@ -1067,7 +1067,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #endif #ifdef ROF_PRESENT if (trim(compLabels(i)) .eq. 'ROF') then - if(maxthreads > 1) then + if(nthrds > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ROFSetServices, ROFSetVM, & PetList=petlist, comp=child, info=info, rc=rc) else @@ -1080,7 +1080,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #endif #ifdef WAV_PRESENT if (trim(compLabels(i)) .eq. 'WAV') then - if(maxthreads > 1) then + if(nthrds > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), WAVSetServices, WAVSetVM, & PetList=petlist, comp=child, info=info, rc=rc) else From 432d8ad1745555e947877aace3c9bfeb4cb1ef0e Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 7 Dec 2020 11:12:11 -0700 Subject: [PATCH 12/54] fix issues with cpp macros --- drivers/cime/esm.F90 | 6 +++++- drivers/cime/esmApp.F90 | 10 +++++++--- drivers/cime/esm_utils_mod.F90 | 4 ++-- mediator/med_utils_mod.F90 | 4 ++-- 4 files changed, 16 insertions(+), 8 deletions(-) diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index 12331ea2d..0850843b9 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -807,7 +807,9 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use ESMF , only : ESMF_InfoCreate, ESMF_InfoDestroy use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Driver , only : NUOPC_DriverAddComp +#ifndef NO_MPI2 use mpi , only : MPI_COMM_NULL, mpi_comm_size +#endif use mct_mod , only : mct_world_init use shr_pio_mod , only : shr_pio_init2 @@ -836,7 +838,9 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifdef GLC_PRESENT use glc_comp_nuopc , only : GLCSetServices => SetServices, GLCSetVM => SetVM #endif - +#ifdef NO_MPI2 + include 'mpif.h' +#endif ! input/output variables type(ESMF_GridComp) :: driver integer, intent(out) :: maxthreads ! maximum number of threads any component diff --git a/drivers/cime/esmApp.F90 b/drivers/cime/esmApp.F90 index b44a1b848..dff27adb5 100644 --- a/drivers/cime/esmApp.F90 +++ b/drivers/cime/esmApp.F90 @@ -12,8 +12,9 @@ program esmApp use ESMF, only : ESMF_LOGKIND_MULTI_ON_ERROR, ESMF_LogKind_Flag use ESMF, only : ESMF_VMGet, ESMF_VM, ESMF_InitializePreMPI -#ifdef USE_MPI2 - use mpi, only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE, MPI_BCAST, MPI_COMM_RANK +#ifndef NO_MPI2 + use mpi, only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init_thread, MPI_FINALIZE, MPI_BCAST + use mpi, only : MPI_COMM_RANK, MPI_THREAD_SERIALIZED, MPI_LOGICAL #else use mpi #endif @@ -40,9 +41,12 @@ program esmApp !----------------------------------------------------------------------------- ! Initiallize MPI !----------------------------------------------------------------------------- - +#ifndef NO_MPI2 call ESMF_InitializePreMPI() call MPI_init_thread(MPI_THREAD_SERIALIZED, provided, rc) +#else + call MPI_init(rc) +#endif COMP_COMM = MPI_COMM_WORLD !----------------------------------------------------------------------------- diff --git a/drivers/cime/esm_utils_mod.F90 b/drivers/cime/esm_utils_mod.F90 index dec3c593a..f6a4aeb40 100644 --- a/drivers/cime/esm_utils_mod.F90 +++ b/drivers/cime/esm_utils_mod.F90 @@ -15,7 +15,7 @@ module esm_utils_mod !=============================================================================== logical function ChkErr(rc, line, file, mpierr) -#ifdef USE_MPI2 +#ifndef NO_MPI2 use mpi, only : MPI_ERROR_STRING, MPI_MAX_ERROR_STRING, MPI_SUCCESS #else use mpi, only : MPI_SUCCESS @@ -28,7 +28,7 @@ logical function ChkErr(rc, line, file, mpierr) character(len=*), intent(in) :: file logical, optional, intent(in) :: mpierr -#ifndef USE_MPI2 +#ifdef NO_MPI2 integer, parameter :: MPI_MAX_ERROR_STRING=80 #endif character(MPI_MAX_ERROR_STRING) :: lstring diff --git a/mediator/med_utils_mod.F90 b/mediator/med_utils_mod.F90 index 6c3b59638..9e34d1d40 100644 --- a/mediator/med_utils_mod.F90 +++ b/mediator/med_utils_mod.F90 @@ -33,7 +33,7 @@ end subroutine med_memcheck !=============================================================================== logical function med_utils_ChkErr(rc, line, file, mpierr) -#ifdef USE_MPI2 +#ifndef NO_MPI2 use mpi , only : MPI_ERROR_STRING, MPI_MAX_ERROR_STRING, MPI_SUCCESS #else use mpi, only : MPI_SUCCESS @@ -46,7 +46,7 @@ logical function med_utils_ChkErr(rc, line, file, mpierr) character(len=*), intent(in) :: file logical, optional, intent(in) :: mpierr -#ifndef USE_MPI2 +#ifdef NO_MPI2 integer, parameter :: MPI_MAX_ERROR_STRING=80 #endif character(MPI_MAX_ERROR_STRING) :: lstring From 906a48343f80abb08565eaf16a99920f40f6745a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 14 Dec 2020 10:13:36 -0700 Subject: [PATCH 13/54] always use vm for all components if threaded --- drivers/cime/esm.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index 0850843b9..e93ae4fca 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -993,7 +993,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifdef MED_PRESENT if (trim(compLabels(i)) == 'MED') then med_id = i + 1 - if(nthrds > 1) then + if(maxthreads > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, MEDSetVM, & petList=petlist, comp=child, info=info, rc=rc) else @@ -1006,7 +1006,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #endif #ifdef ATM_PRESENT if (trim(compLabels(i)) .eq. 'ATM') then - if(nthrds > 1) then + if(maxthreads > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, ATMSetVM, & petList=petlist, comp=child, info=info, rc=rc) else @@ -1019,7 +1019,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #endif #ifdef LND_PRESENT if (trim(compLabels(i)) .eq. 'LND') then - if(nthrds > 1) then + if(maxthreads > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), LNDSetServices, LNDSetVM, & PetList=petlist, comp=child, info=info, rc=rc) else @@ -1032,7 +1032,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #endif #ifdef OCN_PRESENT if (trim(compLabels(i)) .eq. 'OCN') then - if(nthrds > 1) then + if(maxthreads > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), OCNSetServices, OCNSetVM, & PetList=petlist, comp=child, info=info, rc=rc) else @@ -1045,7 +1045,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #endif #ifdef ICE_PRESENT if (trim(compLabels(i)) .eq. 'ICE') then - if(nthrds > 1) then + if(maxthreads > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ICESetServices, ICESetVM, & PetList=petlist, comp=child, info=info, rc=rc) else @@ -1058,7 +1058,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #endif #ifdef GLC_PRESENT if (trim(compLabels(i)) .eq. 'GLC') then - if(nthrds > 1) then + if(maxthreads > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), GLCSetServices, GLCSetVM, & PetList=petlist, comp=child, info=info, rc=rc) else @@ -1071,7 +1071,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #endif #ifdef ROF_PRESENT if (trim(compLabels(i)) .eq. 'ROF') then - if(nthrds > 1) then + if(maxthreads > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ROFSetServices, ROFSetVM, & PetList=petlist, comp=child, info=info, rc=rc) else @@ -1084,7 +1084,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #endif #ifdef WAV_PRESENT if (trim(compLabels(i)) .eq. 'WAV') then - if(nthrds > 1) then + if(maxthreads > 1) then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), WAVSetServices, WAVSetVM, & PetList=petlist, comp=child, info=info, rc=rc) else From eb6221302d632b4aeb642d04cf934bf516dd24c2 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 13 Jan 2021 09:36:12 -0700 Subject: [PATCH 14/54] latest changes --- drivers/cime/esm.F90 | 20 +++++++++++++++++--- drivers/cime/esmApp.F90 | 5 +++-- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index e93ae4fca..89c17b4fb 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -613,7 +613,7 @@ end subroutine CheckAttributes !=============================================================================== - subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, rc) + subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, nthrds, rc) ! Add specific set of attributes to components from driver attributes @@ -628,6 +628,7 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, r integer , intent(in) :: compid character(len=*) , intent(in) :: compname character(len=*) , intent(in) :: inst_suffix + integer , intent(in) :: nthrds integer , intent(inout) :: rc ! local variables @@ -712,6 +713,12 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, r call NUOPC_CompAttributeSet(gcomp, name='inst_suffix', value=inst_suffix, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! Add the nthreads attribute + call NUOPC_CompAttributeAdd(gcomp, attrList=(/'nthreads'/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(cvalue, *) nthrds + call NUOPC_CompAttributeSet(gcomp, name='nthreads', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !------ ! Add single column and single point attributes @@ -947,9 +954,13 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) info = ESMF_InfoCreate(rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_InfoSet(info, key="/NUOPC/Instance/maxPeCountPerPet", value=nthrds, rc=rc) + call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/MaxCount", value=nthrds, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nthrds == 1) then + call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/OpenMpHandling", value='none', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_rootpe', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) rootpe @@ -1109,6 +1120,9 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) endif comp_iamin(i) = .false. + call AddAttributes(child, driver, config, i+1, trim(compLabels(i)), inst_suffix, nthrds, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (ESMF_GridCompIsPetLocal(child, rc=rc)) then call ESMF_GridCompGet(child, vm=vm, rc=rc) @@ -1465,7 +1479,7 @@ subroutine esm_finalize(driver, rc) call t_prf(trim(timing_dir)//'/model_timing'//trim(inst_suffix), mpicom=mpicomm) call t_finalizef() - + print *,__FILE__,__LINE__ end subroutine esm_finalize diff --git a/drivers/cime/esmApp.F90 b/drivers/cime/esmApp.F90 index dff27adb5..e382efe25 100644 --- a/drivers/cime/esmApp.F90 +++ b/drivers/cime/esmApp.F90 @@ -169,12 +169,13 @@ program esmApp ! Call Finalize for the ensemble driver ! Destroy the ensemble driver !----------------------------------------------------------------------------- - + print *,__FILE__,__LINE__ call ESMF_GridCompFinalize(ensemble_driver_comp, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) + print *,__FILE__,__LINE__ if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -199,7 +200,7 @@ program esmApp line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) - + print *,__FILE__,__LINE__ call ESMF_Finalize() end program From 1eb6e6c6aeb387f07b41bc96fc9a0869d5ddc106 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 20 Jan 2021 07:48:20 -0700 Subject: [PATCH 15/54] always use setvm --- drivers/cime/esm.F90 | 80 ++++++++++++-------------------------------- 1 file changed, 21 insertions(+), 59 deletions(-) diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index 89c17b4fb..6f0be7c60 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -954,6 +954,9 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) info = ESMF_InfoCreate(rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return +! call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/MinStackSize",value=400000000, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/MaxCount", value=nthrds, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -978,9 +981,9 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_pestride', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stride - if (stride < 1 .or. rootpe+ntasks*stride > PetCount) then + if (stride < 1 .or. rootpe+(ntasks-1)*stride > PetCount) then write (msgstr, *) "Invalid pestride value specified for component: ",namestr,& - ' rootpe: ',rootpe, ' pestride: ', stride + ' rootpe: ',rootpe, ' pestride: ', stride, ' ntasks: ',ntasks, ' PetCount: ', PetCount call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -1000,108 +1003,67 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) comps(i+1) = i+1 found_comp = .false. -! If maxthreads == 1 then no threading is used and we do not need the SetVM in calls to NUOPC_DriverAddComp #ifdef MED_PRESENT if (trim(compLabels(i)) == 'MED') then med_id = i + 1 - if(maxthreads > 1) then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, MEDSetVM, & - petList=petlist, comp=child, info=info, rc=rc) - else - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, & - petList=petlist, comp=child, rc=rc) - endif + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, MEDSetVM, & + petList=petlist, comp=child, info=info, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef ATM_PRESENT if (trim(compLabels(i)) .eq. 'ATM') then - if(maxthreads > 1) then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, ATMSetVM, & - petList=petlist, comp=child, info=info, rc=rc) - else - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, & - petList=petlist, comp=child, rc=rc) - endif + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, ATMSetVM, & + petList=petlist, comp=child, info=info, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef LND_PRESENT if (trim(compLabels(i)) .eq. 'LND') then - if(maxthreads > 1) then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), LNDSetServices, LNDSetVM, & - PetList=petlist, comp=child, info=info, rc=rc) - else - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), LNDSetServices, & - PetList=petlist, comp=child, rc=rc) - endif + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), LNDSetServices, LNDSetVM, & + PetList=petlist, comp=child, info=info, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef OCN_PRESENT if (trim(compLabels(i)) .eq. 'OCN') then - if(maxthreads > 1) then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), OCNSetServices, OCNSetVM, & - PetList=petlist, comp=child, info=info, rc=rc) - else - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), OCNSetServices, & - PetList=petlist, comp=child, rc=rc) - endif + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), OCNSetServices, OCNSetVM, & + PetList=petlist, comp=child, info=info, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef ICE_PRESENT if (trim(compLabels(i)) .eq. 'ICE') then - if(maxthreads > 1) then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ICESetServices, ICESetVM, & - PetList=petlist, comp=child, info=info, rc=rc) - else - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ICESetServices, & - PetList=petlist, comp=child, rc=rc) - endif + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ICESetServices, ICESetVM, & + PetList=petlist, comp=child, info=info, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef GLC_PRESENT if (trim(compLabels(i)) .eq. 'GLC') then - if(maxthreads > 1) then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), GLCSetServices, GLCSetVM, & - PetList=petlist, comp=child, info=info, rc=rc) - else - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), GLCSetServices, & - PetList=petlist, comp=child, rc=rc) - endif + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), GLCSetServices, GLCSetVM, & + PetList=petlist, comp=child, info=info, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef ROF_PRESENT if (trim(compLabels(i)) .eq. 'ROF') then - if(maxthreads > 1) then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ROFSetServices, ROFSetVM, & - PetList=petlist, comp=child, info=info, rc=rc) - else - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ROFSetServices, & - PetList=petlist, comp=child, rc=rc) - endif + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ROFSetServices, ROFSetVM, & + PetList=petlist, comp=child, info=info, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef WAV_PRESENT if (trim(compLabels(i)) .eq. 'WAV') then - if(maxthreads > 1) then - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), WAVSetServices, WAVSetVM, & - PetList=petlist, comp=child, info=info, rc=rc) - else - call NUOPC_DriverAddComp(driver, trim(compLabels(i)), WAVSetServices, & - PetList=petlist, comp=child, rc=rc) - endif + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), WAVSetServices, WAVSetVM, & + PetList=petlist, comp=child, info=info, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if From 564dd00603328de162af69eef4a637f6ae0f949d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 11 Feb 2021 08:07:49 -0700 Subject: [PATCH 16/54] minor changes --- cime_config/testdefs/testlist_drv.xml | 11 +++++++++++ drivers/cime/esm.F90 | 1 - drivers/cime/esmApp.F90 | 3 --- 3 files changed, 11 insertions(+), 4 deletions(-) diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index 10ff0b7fc..3829304dc 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -166,6 +166,17 @@ + + + + + + + + + + + diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index 6f0be7c60..350275d5e 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -1441,7 +1441,6 @@ subroutine esm_finalize(driver, rc) call t_prf(trim(timing_dir)//'/model_timing'//trim(inst_suffix), mpicom=mpicomm) call t_finalizef() - print *,__FILE__,__LINE__ end subroutine esm_finalize diff --git a/drivers/cime/esmApp.F90 b/drivers/cime/esmApp.F90 index e382efe25..ba06842c5 100644 --- a/drivers/cime/esmApp.F90 +++ b/drivers/cime/esmApp.F90 @@ -169,13 +169,11 @@ program esmApp ! Call Finalize for the ensemble driver ! Destroy the ensemble driver !----------------------------------------------------------------------------- - print *,__FILE__,__LINE__ call ESMF_GridCompFinalize(ensemble_driver_comp, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) - print *,__FILE__,__LINE__ if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -200,7 +198,6 @@ program esmApp line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) - print *,__FILE__,__LINE__ call ESMF_Finalize() end program From 12459834cc6169eba47424ca8328be0febaee508 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 26 Mar 2021 13:15:59 -0600 Subject: [PATCH 17/54] add ESMF_AWARE_THREADING --- cime_config/buildexe | 8 +++ cime_config/config_component.xml | 9 +++ drivers/cime/esm.F90 | 94 ++++++++++++++++++++++++++++---- 3 files changed, 100 insertions(+), 11 deletions(-) diff --git a/cime_config/buildexe b/cime_config/buildexe index ed5b04459..476bee765 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -39,6 +39,7 @@ def _main_func(): ocn_model = case.get_value("COMP_OCN") atm_model = case.get_value("COMP_ATM") gmake_args = get_standard_makefile_args(case) + esmf_aware_threading = case.get_value("ESMF_AWARE_THREADING") # Determine valid components valid_comps = [] @@ -73,6 +74,8 @@ def _main_func(): gmake_args += " {}_PRESENT=FALSE".format(comp) if skip_mediator: gmake_args += " MED_PRESENT=FALSE" + if esmf_aware_threading: + gmake_args += " USER_CPPDEFS=-DESMF_AWARE_THREADING" gmake_args += " IAC_PRESENT=FALSE" expect((num_esp is None) or (int(num_esp) == 1), "ESP component restricted to one instance") @@ -93,6 +96,11 @@ def _main_func(): makefile = os.path.join(casetools, "Makefile") exename = os.path.join(exeroot, cime_model + ".exe") + # always rebuild file esm.F90 this is because cpp macros in that file may have changed + esm = os.path.join(bld_root,"esm.o") + if os.path.isfile(esm): + os.remove(esm) + # always relink if os.path.isfile(exename): os.remove(exename) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 4c1686b7b..f69aa441e 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -798,6 +798,15 @@ TRUE implies that at least one of the components is built threaded (DO NOT EDIT) + + logical + TRUE,FALSE + FALSE + mach_pes + env_mach_pes.xml + TRUE indicates that the ESMF Aware threading method is used + + logical TRUE,FALSE diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index 350275d5e..0149a24c6 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -822,28 +822,52 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifdef MED_PRESENT use med_internalstate_mod , only : med_id - use med , only : MedSetServices => SetServices, MEDSetVM => SetVM + use med , only : MedSetServices => SetServices +#ifdef ESMF_AWARE_THREADING + use med , only : MEDSetVM => SetVM +#endif #endif #ifdef ATM_PRESENT - use atm_comp_nuopc , only : ATMSetServices => SetServices, ATMSetVM => SetVM + use atm_comp_nuopc , only : ATMSetServices => SetServices +#ifdef ESMF_AWARE_THREADING + use atm_comp_nuopc , only : ATMSetVM => SetVM +#endif #endif #ifdef ICE_PRESENT - use ice_comp_nuopc , only : ICESetServices => SetServices, ICESetVM => SetVM + use ice_comp_nuopc , only : ICESetServices => SetServices +#ifdef ESMF_AWARE_THREADING + use ice_comp_nuopc , only : ICESetVM => SetVM +#endif #endif #ifdef LND_PRESENT - use lnd_comp_nuopc , only : LNDSetServices => SetServices, LNDSetVM => SetVM + use lnd_comp_nuopc , only : LNDSetServices => SetServices +#ifdef ESMF_AWARE_THREADING + use lnd_comp_nuopc , only : LNDSetVM => SetVM +#endif #endif #ifdef OCN_PRESENT - use ocn_comp_nuopc , only : OCNSetServices => SetServices, OCNSetVM => SetVM + use ocn_comp_nuopc , only : OCNSetServices => SetServices +#ifdef ESMF_AWARE_THREADING + use ocn_comp_nuopc , only : OCNSetVM => SetVM +#endif #endif #ifdef WAV_PRESENT - use wav_comp_nuopc , only : WAVSetServices => SetServices, WAVSetVM => SetVM + use wav_comp_nuopc , only : WAVSetServices => SetServices +#ifdef ESMF_AWARE_THREADING + use wav_comp_nuopc , only : WAVSetVM => SetVM +#endif #endif #ifdef ROF_PRESENT - use rof_comp_nuopc , only : ROFSetServices => SetServices, ROFSetVM => SetVM + use rof_comp_nuopc , only : ROFSetServices => SetServices +#ifdef ESMF_AWARE_THREADING + use rof_comp_nuopc , only : ROFSetVM => SetVM +#endif #endif #ifdef GLC_PRESENT - use glc_comp_nuopc , only : GLCSetServices => SetServices, GLCSetVM => SetVM + use glc_comp_nuopc , only : GLCSetServices => SetServices +#ifdef ESMF_AWARE_THREADING + use glc_comp_nuopc , only : GLCSetVM => SetVM +#endif #endif #ifdef NO_MPI2 include 'mpif.h' @@ -954,12 +978,12 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) info = ESMF_InfoCreate(rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return -! call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/MinStackSize",value=400000000, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/MaxCount", value=nthrds, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return +! call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/MinStackSize", value='40MiB', rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nthrds == 1) then call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/OpenMpHandling", value='none', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -989,12 +1013,20 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) endif if (allocated(petlist)) then +#ifdef ESMF_AWARE_THREADING + if(size(petlist) .ne. ntasks*nthrds) then +#else if(size(petlist) .ne. ntasks) then +#endif deallocate(petlist) endif endif if(.not. allocated(petlist)) then +#ifdef ESMF_AWARE_THREADING allocate(petlist(ntasks*nthrds)) +#else + allocate(petlist(ntasks)) +#endif endif do ntask = 1, size(petlist) @@ -1006,64 +1038,104 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifdef MED_PRESENT if (trim(compLabels(i)) == 'MED') then med_id = i + 1 +#ifdef ESMF_AWARE_THREADING call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, MEDSetVM, & petList=petlist, comp=child, info=info, rc=rc) +#else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, & + petList=petlist, comp=child, rc=rc) +#endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef ATM_PRESENT if (trim(compLabels(i)) .eq. 'ATM') then +#ifdef ESMF_AWARE_THREADING call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, ATMSetVM, & petList=petlist, comp=child, info=info, rc=rc) +#else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, & + petList=petlist, comp=child, rc=rc) +#endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef LND_PRESENT if (trim(compLabels(i)) .eq. 'LND') then +#ifdef ESMF_AWARE_THREADING call NUOPC_DriverAddComp(driver, trim(compLabels(i)), LNDSetServices, LNDSetVM, & PetList=petlist, comp=child, info=info, rc=rc) +#else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), LNDSetServices, & + PetList=petlist, comp=child, rc=rc) +#endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef OCN_PRESENT if (trim(compLabels(i)) .eq. 'OCN') then +#ifdef ESMF_AWARE_THREADING call NUOPC_DriverAddComp(driver, trim(compLabels(i)), OCNSetServices, OCNSetVM, & PetList=petlist, comp=child, info=info, rc=rc) +#else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), OCNSetServices, & + PetList=petlist, comp=child, rc=rc) +#endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef ICE_PRESENT if (trim(compLabels(i)) .eq. 'ICE') then +#ifdef ESMF_AWARE_THREADING call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ICESetServices, ICESetVM, & PetList=petlist, comp=child, info=info, rc=rc) +#else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ICESetServices, & + PetList=petlist, comp=child, rc=rc) +#endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef GLC_PRESENT if (trim(compLabels(i)) .eq. 'GLC') then +#ifdef ESMF_AWARE_THREADING call NUOPC_DriverAddComp(driver, trim(compLabels(i)), GLCSetServices, GLCSetVM, & PetList=petlist, comp=child, info=info, rc=rc) +#else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), GLCSetServices, & + PetList=petlist, comp=child, rc=rc) +#endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef ROF_PRESENT if (trim(compLabels(i)) .eq. 'ROF') then +#ifdef ESMF_AWARE_THREADING call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ROFSetServices, ROFSetVM, & PetList=petlist, comp=child, info=info, rc=rc) +#else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ROFSetServices, & + PetList=petlist, comp=child, rc=rc) +#endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if #endif #ifdef WAV_PRESENT if (trim(compLabels(i)) .eq. 'WAV') then +#ifdef ESMF_AWARE_THREADING call NUOPC_DriverAddComp(driver, trim(compLabels(i)), WAVSetServices, WAVSetVM, & PetList=petlist, comp=child, info=info, rc=rc) +#else + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), WAVSetServices, & + PetList=petlist, comp=child, rc=rc) +#endif if (chkerr(rc,__LINE__,u_FILE_u)) return found_comp = .true. end if From 9e88547ebe50ce91971b692df6b59b1326a73b83 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 29 Mar 2021 10:52:06 -0600 Subject: [PATCH 18/54] drv_threading variable not used --- cime_config/config_component_cesm.xml | 12 +------ cime_config/config_component_ufs.xml | 10 ------ cime_config/namelist_definition_drv.xml | 43 ++++++------------------- 3 files changed, 10 insertions(+), 55 deletions(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 05ada3c77..49ed73ed7 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -35,16 +35,6 @@ run DOI - - logical - TRUE,FALSE - FALSE - run_flags - env_run.xml - Turns on component varying thread control in the driver. - Used to set the driver namelist variable "drv_threading". - - logical TRUE,FALSE @@ -541,7 +531,7 @@ TRUE + feedbacks for a TG compset, this will give us additional diagnostics --> TRUE run_glc diff --git a/cime_config/config_component_ufs.xml b/cime_config/config_component_ufs.xml index b4901ea3b..1516f97b0 100644 --- a/cime_config/config_component_ufs.xml +++ b/cime_config/config_component_ufs.xml @@ -35,16 +35,6 @@ run DOI - - logical - TRUE,FALSE - FALSE - run_flags - env_run.xml - Turns on component varying thread control in the driver. - Used to set the driver namelist variable "drv_threading". - - logical TRUE,FALSE diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 269551bae..448ac2a6a 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -178,31 +178,6 @@ - - - - - - - - - - - - - - logical - performance - DRIVER_attributes - - turn on run time control of threading per pe per component by the driver - default: false - - - $DRV_THREADING - - - logical performance @@ -732,7 +707,7 @@ single_column ALLCOMP_attributes - DOMAIN file needed for single column model IF and only if + DOMAIN file needed for single column model IF and only if a nearest neighbor search is done to match the PTS_LAT and PTS_LON to the closest point in the domain file. This file is ONLY used in single column mode. @@ -1072,7 +1047,7 @@ $MASK_MESH - null + null @@ -1085,7 +1060,7 @@ $ATM_DOMAIN_MESH - null + null @@ -1098,7 +1073,7 @@ $LND_DOMAIN_MESH - null + null @@ -1111,7 +1086,7 @@ $OCN_DOMAIN_MESH - null + null @@ -1124,7 +1099,7 @@ $ICE_DOMAIN_MESH - null + null @@ -1137,7 +1112,7 @@ $ROF_DOMAIN_MESH - null + null @@ -1150,7 +1125,7 @@ $GLC_DOMAIN_MESH - null + null @@ -1163,7 +1138,7 @@ $WAV_DOMAIN_MESH - null + null From c12465b90657bd2ab72b67506f860954d9d10148 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 1 Dec 2020 13:42:12 -0700 Subject: [PATCH 19/54] enable esmf aware threading --- drivers/cime/esm.F90 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index 0149a24c6..186f40d2f 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -988,6 +988,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/OpenMpHandling", value='none', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif + call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_rootpe', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) rootpe @@ -1029,9 +1030,17 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #endif endif +#ifdef ESMF_AWARE_THREADING + cnt = 1 + do ntask = rootpe, rootpe+nthrds*ntasks*stride-1, stride + petlist(cnt) = ntask + cnt = cnt + 1 + enddo +#else do ntask = 1, size(petlist) petlist(ntask) = rootpe + (ntask-1)*stride enddo +#endif comps(i+1) = i+1 found_comp = .false. From 7ed414098aabeacd7ddfc0a440a5bf556dd04920 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 4 Dec 2020 07:41:17 -0700 Subject: [PATCH 20/54] allow esmf aware threading --- drivers/cime/esm.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index 186f40d2f..96bcbb53d 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -1044,6 +1044,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) comps(i+1) = i+1 found_comp = .false. +! If maxthreads == 1 then no threading is used and we do not need the SetVM in calls to NUOPC_DriverAddComp #ifdef MED_PRESENT if (trim(compLabels(i)) == 'MED') then med_id = i + 1 From 22a8bd825bfde7e1f6e1f7d8694f0531104bbd93 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 13 Jan 2021 09:36:12 -0700 Subject: [PATCH 21/54] latest changes --- drivers/cime/esmApp.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/drivers/cime/esmApp.F90 b/drivers/cime/esmApp.F90 index ba06842c5..6841c2fbb 100644 --- a/drivers/cime/esmApp.F90 +++ b/drivers/cime/esmApp.F90 @@ -169,11 +169,13 @@ program esmApp ! Call Finalize for the ensemble driver ! Destroy the ensemble driver !----------------------------------------------------------------------------- + call ESMF_GridCompFinalize(ensemble_driver_comp, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) + print *,__FILE__,__LINE__ if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & From ab7c14c3b259a8af11e31ef24de62cea8840d1a5 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 20 Jan 2021 07:48:20 -0700 Subject: [PATCH 22/54] always use setvm --- drivers/cime/esm.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index 96bcbb53d..e3737c1c0 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -978,6 +978,9 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) info = ESMF_InfoCreate(rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return +! call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/MinStackSize",value=400000000, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/MaxCount", value=nthrds, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1044,7 +1047,6 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) comps(i+1) = i+1 found_comp = .false. -! If maxthreads == 1 then no threading is used and we do not need the SetVM in calls to NUOPC_DriverAddComp #ifdef MED_PRESENT if (trim(compLabels(i)) == 'MED') then med_id = i + 1 From 03bd49f74bab43fbd8c1a319f8d3c04453776873 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 11 Feb 2021 08:07:49 -0700 Subject: [PATCH 23/54] minor changes --- drivers/cime/esmApp.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/drivers/cime/esmApp.F90 b/drivers/cime/esmApp.F90 index 6841c2fbb..523e2cec1 100644 --- a/drivers/cime/esmApp.F90 +++ b/drivers/cime/esmApp.F90 @@ -175,7 +175,6 @@ program esmApp line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) - print *,__FILE__,__LINE__ if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & From 4ced2ca91c7c8216a0ecd3cbd7d8d0585269ff7a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 26 Mar 2021 13:15:59 -0600 Subject: [PATCH 24/54] add ESMF_AWARE_THREADING --- drivers/cime/esm.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index e3737c1c0..186f40d2f 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -978,9 +978,6 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) info = ESMF_InfoCreate(rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return -! call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/MinStackSize",value=400000000, rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/MaxCount", value=nthrds, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From 6f460c71aa14ccc4c7f4f5cd42f01412f87da392 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 5 Apr 2021 16:34:53 -0600 Subject: [PATCH 25/54] add a test --- cime_config/testdefs/testlist_drv.xml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index 3829304dc..d255baa18 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -397,6 +397,15 @@ + + + + + + + + + From 8c91c626d3dd9e2f0dae9adf462684afd5d54700 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 6 Apr 2021 09:42:26 -0600 Subject: [PATCH 26/54] update workflow file --- .github/workflows/extbuild.yml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index f3563cbad..69ad954a3 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -35,7 +35,9 @@ jobs: path: ~/ESMF key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF - id: load-env - run: sudo apt-get install gfortran wget openmpi-bin netcdf-bin libopenmpi-dev libnetcdf-dev + run: | + sudo apt-get update + sudo apt-get install gfortran wget openmpi-bin netcdf-bin libopenmpi-dev libnetcdf-dev - id: build-ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' run: | From b4a304fcc329b6430128c6ea18edea9c25aeb3e5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 21 Apr 2021 13:44:53 -0600 Subject: [PATCH 27/54] fix setting of scol_spval for single column functionality --- drivers/cime/esm.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index 186f40d2f..ecf6d931d 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -1266,6 +1266,8 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) read(cvalue,*) scol_lat call NUOPC_CompAttributeGet(gcomp, name='single_column_lnd_domainfile', value=single_column_lnd_domainfile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeAdd(gcomp, attrList=(/'scol_spval'/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return if ( (scol_lon < scol_spval .and. scol_lat > scol_spval) .or. & (scol_lon > scol_spval .and. scol_lat < scol_spval)) then @@ -1307,8 +1309,7 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) 'scol_lndmask', & 'scol_lndfrac', & 'scol_ocnmask', & - 'scol_ocnfrac', & - 'scol_spval '/), rc=rc) + 'scol_ocnfrac'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (trim(single_column_lnd_domainfile) /= 'UNSET') then From d1a0af2975a6140ce4e3183823ed36d10939f1d2 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 27 Apr 2021 14:51:01 -0600 Subject: [PATCH 28/54] some corrections to the med diag calculations --- mediator/med_diag_mod.F90 | 137 +++++++++++++++++++------------------- 1 file changed, 69 insertions(+), 68 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 72295a5ac..730012b7b 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -195,11 +195,11 @@ module med_diag_mod ! P for period ! --------------------------------- - integer :: period_inst - integer :: period_day - integer :: period_mon - integer :: period_ann - integer :: period_inf + integer :: period_inst=0 + integer :: period_day=0 + integer :: period_mon=0 + integer :: period_ann=0 + integer :: period_inf=0 ! --------------------------------- ! local constants @@ -337,22 +337,6 @@ subroutine med_diag_init(gcomp, rc) isof(:) = (/ f_16O_end, f_18O_end, f_hdO_end /) isoname(:) = (/ 'H216O', 'H218O', ' HDO' /) - ! period types - call add_to_budget_diag(budget_diags%periods, period_inst,' inst') - call add_to_budget_diag(budget_diags%periods, period_day ,' daily') - call add_to_budget_diag(budget_diags%periods, period_mon ,' monthly') - call add_to_budget_diag(budget_diags%periods, period_ann ,' annual') - call add_to_budget_diag(budget_diags%periods, period_inf ,'all_time') - - ! allocate module budget arrays - c_size = size(budget_diags%comps) - f_size = size(budget_diags%fields) - p_size = size(budget_diags%periods) - - allocate(budget_local (f_size , c_size , p_size)) ! local sum, valid on all pes - allocate(budget_global (f_size , c_size , p_size)) ! global sum, valid only on root pe - allocate(budget_counter (f_size , c_size , p_size)) ! counter, valid only on root pe - allocate(budget_global_1d(f_size * c_size * p_size)) ! needed for ESMF_VMReduce call !------------------------------------------------------------------------------- ! Get config variables !------------------------------------------------------------------------------- @@ -369,6 +353,24 @@ subroutine med_diag_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return budget_print_ltend = get_diag_attribute(gcomp, 'budget_ltend', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! period types + call add_to_budget_diag(budget_diags%periods, period_inst,' inst') + if(budget_print_daily) call add_to_budget_diag(budget_diags%periods, period_day ,' daily') + if(budget_print_month) call add_to_budget_diag(budget_diags%periods, period_mon ,' monthly') + if(budget_print_ann) call add_to_budget_diag(budget_diags%periods, period_ann ,' annual') + call add_to_budget_diag(budget_diags%periods, period_inf ,'all_time') + + ! allocate module budget arrays + c_size = size(budget_diags%comps) + f_size = size(budget_diags%fields) + p_size = size(budget_diags%periods) + + allocate(budget_local (f_size , c_size , p_size)) ! local sum, valid on all pes + allocate(budget_global (f_size , c_size , p_size)) ! global sum, valid only on root pe + allocate(budget_counter (f_size , c_size , p_size)) ! counter, valid only on root pe + allocate(budget_global_1d(f_size * c_size * p_size)) ! needed for ESMF_VMReduce call + if (budget_print_inst + budget_print_daily + budget_print_month + budget_print_ann + budget_print_ltann + budget_print_ltend > 0) then ! Set stop alarm (needed for budgets) call NUOPC_CompAttributeGet(gcomp, name="stop_option", value=stop_option, rc=rc) @@ -526,6 +528,7 @@ subroutine med_phases_diag_accum(gcomp, rc) budget_local(:,:,ip) = budget_local(:,:,ip) + budget_local(:,:,period_inst) enddo budget_counter(:,:,:) = budget_counter(:,:,:) + 1.0_r8 + call t_stopf('MED:'//subname) end subroutine med_phases_diag_accum @@ -562,11 +565,11 @@ subroutine med_diag_sum_master(gcomp, rc) count = size(budget_global) budget_global_1d(:) = 0.0_r8 - call ESMF_VMReduce(vm, reshape(budget_local,(/count/)) , budget_global_1d, count, ESMF_REDUCE_SUM, 0, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return budget_global = reshape(budget_global_1d,(/f_size,c_size,p_size/)) - budget_local(:,:,:) = 0.0_r8 + + budget_local(:,:,period_inst) = 0.0_r8 call t_stopf('MED:'//subname) @@ -1901,62 +1904,60 @@ subroutine med_phases_diag_print(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif - if (output_level > 0) exit - enddo ! ip = 1, period_types + ! Currently output_level is limited to levels of 0,1,2, 3 ! (see comment for print options at top) - if (output_level > 0) then - if (.not. sumdone) then - ! Some budgets will be printed for this period type - ! Determine sums if not already done - call med_diag_sum_master(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - sumdone = .true. - end if + if (output_level > 0) then + if (.not. sumdone) then + ! Some budgets will be printed for this period type + ! Determine sums if not already done + call med_diag_sum_master(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - c_size = size(budget_diags%comps) - f_size = size(budget_diags%fields) - p_size = size(budget_diags%periods) - allocate(datagpr(f_size, c_size, p_size)) - datagpr(:,:,:) = budget_global(:,:,:) - - ! budget normalizations (global area and 1e6 for water) - datagpr = datagpr/(4.0_r8*shr_const_pi) - datagpr(f_watr_beg:f_watr_end,:,:) = datagpr(f_watr_beg:f_watr_end,:,:) * 1.0e6_r8 - if ( flds_wiso ) then - datagpr(iso0(1):isof(nisotopes),:,:) = datagpr(iso0(1):isof(nisotopes),:,:) * 1.0e6_r8 + sumdone = .true. end if - datagpr(:,:,:) = datagpr(:,:,:)/budget_counter(:,:,:) - ! Write diagnostic tables to logunit (mastertask only) - if (output_level >= 3) then - ! detail atm budgets and breakdown into components --- - call med_diag_print_atm(datagpr, ip, cdate, curr_tod) - end if - if (output_level >= 2) then - ! detail lnd/ocn/ice component budgets ---- - call med_diag_print_lnd_ice_ocn(datagpr, ip, cdate, curr_tod) - end if - if (output_level >= 1) then - ! net summary budgets - call med_diag_print_summary(datagpr, ip, cdate, curr_tod) - endif - write(logunit,*) ' ' - - deallocate(datagpr) - endif ! output_level > 0 and mastertask - end if ! if mastertask + if (mastertask) then + c_size = size(budget_diags%comps) + f_size = size(budget_diags%fields) + p_size = size(budget_diags%periods) + allocate(datagpr(f_size, c_size, p_size)) + datagpr(:,:,:) = budget_global(:,:,:) + + ! budget normalizations (global area and 1e6 for water) + datagpr = datagpr/(4.0_r8*shr_const_pi) + datagpr(f_watr_beg:f_watr_end,:,:) = datagpr(f_watr_beg:f_watr_end,:,:) * 1.0e6_r8 + if ( flds_wiso ) then + datagpr(iso0(1):isof(nisotopes),:,:) = datagpr(iso0(1):isof(nisotopes),:,:) * 1.0e6_r8 + end if + datagpr(:,:,:) = datagpr(:,:,:)/budget_counter(:,:,:) + + ! Write diagnostic tables to logunit (mastertask only) + if (output_level >= 3) then + ! detail atm budgets and breakdown into components --- + call med_diag_print_atm(datagpr, ip, cdate, curr_tod) + end if + if (output_level >= 2) then + ! detail lnd/ocn/ice component budgets ---- + call med_diag_print_lnd_ice_ocn(datagpr, ip, cdate, curr_tod) + end if + if (output_level >= 1) then + ! net summary budgets + call med_diag_print_summary(datagpr, ip, cdate, curr_tod) + endif + write(logunit,*) ' ' + deallocate(datagpr) + endif ! output_level > 0 and mastertask + end if ! if mastertask + enddo ! ip = 1, period_types !------------------------------------------------------------------------------- ! Zero budget data !------------------------------------------------------------------------------- - call med_diag_zero(gcomp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_diag_zero(gcomp, rc=rc) end subroutine med_phases_diag_print @@ -2500,7 +2501,7 @@ subroutine add_to_budget_diag(entries, index, name) ! create new entry if fldname is not in original list if (.not. found) then - + if(mastertask) write(logunit,*) ' Add ',trim(name),' to budgets with index ',index ! 1) allocate newfld to be size (one element larger than input flds) allocate(new_entries(index)) From ae76bae7c60502cc172ebd56010c6823fb27b75a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 27 Apr 2021 15:24:17 -0600 Subject: [PATCH 29/54] fix for gnu --- mediator/med_diag_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 730012b7b..504dcd2d2 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -356,9 +356,9 @@ subroutine med_diag_init(gcomp, rc) ! period types call add_to_budget_diag(budget_diags%periods, period_inst,' inst') - if(budget_print_daily) call add_to_budget_diag(budget_diags%periods, period_day ,' daily') - if(budget_print_month) call add_to_budget_diag(budget_diags%periods, period_mon ,' monthly') - if(budget_print_ann) call add_to_budget_diag(budget_diags%periods, period_ann ,' annual') + if(budget_print_daily > 0) call add_to_budget_diag(budget_diags%periods, period_day ,' daily') + if(budget_print_month > 0) call add_to_budget_diag(budget_diags%periods, period_mon ,' monthly') + if(budget_print_ann > 0) call add_to_budget_diag(budget_diags%periods, period_ann ,' annual') call add_to_budget_diag(budget_diags%periods, period_inf ,'all_time') ! allocate module budget arrays From a2e809105ca11ce1360e35fa2317b3dd8c17ce74 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 28 Apr 2021 13:28:16 -0600 Subject: [PATCH 30/54] fixes for multiple ice sheets to be greater than 1 --- cime_config/namelist_definition_drv.xml | 12 ++++ mediator/esmFlds.F90 | 12 ++-- mediator/med.F90 | 80 ++++++++++++++----------- 3 files changed, 64 insertions(+), 40 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 448ac2a6a..94a821d79 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1694,6 +1694,18 @@ + + integer + expdef + ALLCOMP_attributes + + number of glc ice sheets + + + 1 + + + logical mapping diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 185d52096..13ed53c14 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -17,7 +17,8 @@ module esmflds integer, public, parameter :: comprof = 6 integer, public, parameter :: compwav = 7 integer, public, parameter :: compglc1 = 8 - integer, public, parameter :: ncomps = 8 + integer, public, parameter :: compglc2 = 9 + integer, public, parameter :: ncomps = 9 character(len=*), public, parameter :: compname(ncomps) = & (/'med ',& @@ -27,11 +28,12 @@ module esmflds 'ice ',& 'rof ',& 'wav ',& - 'glc '/) + 'glc1',& + 'glc2'/) - integer, public, parameter :: max_icesheets = 1 - integer, public :: compglc(max_icesheets) = (/compglc1/) - integer, public :: num_icesheets = 1 + integer, public, parameter :: max_icesheets = 2 + integer, public :: compglc(max_icesheets) = (/compglc1,compglc2/) + integer, public :: num_icesheets ! obtained from attribute logical, public :: ocn2glc_coupling ! obtained from attribute logical, public :: dststatus_print = .false. diff --git a/mediator/med.F90 b/mediator/med.F90 index 9db3d320d..de57de886 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -731,6 +731,14 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) nestedState=is_local%wrap%NStateExp(compwav), rc=rc) ! Only create nested states for active ice sheets + call NUOPC_CompAttributeGet(gcomp, name='num_icesheets', value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) num_icesheets + else + num_icesheets = 0 + end if do ns = 1,num_icesheets write(cnum,'(i0)') ns call NUOPC_AddNestedState(importState, CplSet="GLC"//trim(cnum), & @@ -915,41 +923,43 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) do ncomp = 1,ncomps if (ncomp /= compmed) then if (mastertask) write(logunit,*) - nflds = med_fldList_GetNumFlds(fldListFr(ncomp)) - do n = 1,nflds - call med_fldList_GetFldInfo(fldListFr(ncomp), n, stdname, shortname) - if (mastertask) then - write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) - end if - if (trim(shortname) == is_local%wrap%flds_scalar_name) then - transferOffer = 'will provide' - else - transferOffer = 'cannot provide' - end if - call NUOPC_Advertise(is_local%wrap%NStateImp(ncomp), standardName=stdname, shortname=shortname, name=shortname, & - TransferOfferGeomObject=transferOffer, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) - end do - - nflds = med_fldList_GetNumFlds(fldListTo(ncomp)) - do n = 1,nflds - call med_fldList_GetFldInfo(fldListTo(ncomp), n, stdname, shortname) - if (mastertask) then - write(logunit,'(a)') trim(subname)//':To_'//trim(compname(ncomp))//': '//trim(shortname) - end if - if (trim(shortname) == is_local%wrap%flds_scalar_name) then - transferOffer = 'will provide' - else - transferOffer = 'cannot provide' - end if - call NUOPC_Advertise(is_local%wrap%NStateExp(ncomp), standardName=stdname, shortname=shortname, name=shortname, & - TransferOfferGeomObject=transferOffer, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//':To_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) - end do - end if - end do ! end of ncomps loop + if (ESMF_StateIsCreated(is_local%wrap%NStateImp(ncomp))) then + nflds = med_fldList_GetNumFlds(fldListFr(ncomp)) + do n = 1,nflds + call med_fldList_GetFldInfo(fldListFr(ncomp), n, stdname, shortname) + if (mastertask) then + write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) + end if + if (trim(shortname) == is_local%wrap%flds_scalar_name) then + transferOffer = 'will provide' + else + transferOffer = 'cannot provide' + end if + call NUOPC_Advertise(is_local%wrap%NStateImp(ncomp), standardName=stdname, shortname=shortname, name=shortname, & + TransferOfferGeomObject=transferOffer, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) + end do + end if + if (ESMF_StateIsCreated(is_local%wrap%NStateExp(ncomp))) then + nflds = med_fldList_GetNumFlds(fldListTo(ncomp)) + do n = 1,nflds + call med_fldList_GetFldInfo(fldListTo(ncomp), n, stdname, shortname) + if (mastertask) then + write(logunit,'(a)') trim(subname)//':To_'//trim(compname(ncomp))//': '//trim(shortname) + end if + if (trim(shortname) == is_local%wrap%flds_scalar_name) then + transferOffer = 'will provide' + else + transferOffer = 'cannot provide' + end if + call NUOPC_Advertise(is_local%wrap%NStateExp(ncomp), standardName=stdname, shortname=shortname, name=shortname, & + TransferOfferGeomObject=transferOffer, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//':To_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) + end do + end if + end do ! end of ncomps loop if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) From 89ba50099052eaf6b21283334554896d6cb2305a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 1 May 2021 17:36:22 -0600 Subject: [PATCH 31/54] fixed compile bug --- mediator/med.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index de57de886..62a975a11 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -651,6 +651,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) ! TransferOfferGeomObject Attribute. use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_SUCCESS, ESMF_LogFoundAllocError + use ESMF , only : ESMF_StateIsCreated use ESMF , only : ESMF_LogMsg_Info, ESMF_LogWrite use ESMF , only : ESMF_END_ABORT, ESMF_Finalize use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise, NUOPC_AddNestedState @@ -959,7 +960,8 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//':To_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) end do end if - end do ! end of ncomps loop + end if + end do ! end of ncomps loop if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) From 1c2af56481ab6452ac02effe641eac2085babd9d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 4 May 2021 11:05:03 -0600 Subject: [PATCH 32/54] write diags to a seperate file --- mediator/med.F90 | 17 +++- mediator/med_diag_mod.F90 | 120 ++++++++++++++--------------- mediator/med_internalstate_mod.F90 | 1 + 3 files changed, 76 insertions(+), 62 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 9db3d320d..28d2de36c 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -556,9 +556,9 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_AttributeGet, ESMF_AttributeSet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet - use med_internalstate_mod, only : mastertask, logunit + use med_internalstate_mod, only : mastertask, logunit, diagunit use esmFlds, only : dststatus_print - + type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -568,10 +568,13 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) type(ESMF_VM) :: vm character(len=CL) :: cvalue integer :: localPet + integer :: i logical :: isPresent, isSet character(len=CX) :: msgString character(len=CX) :: diro character(len=CX) :: logfile + character(len=CX) :: diagfile + character(len=CX) :: do_budgets character(len=*),parameter :: subname=' (module_MED:InitializeP0) ' !----------------------------------------------------------- @@ -597,6 +600,16 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) logfile = 'mediator.log' end if open(newunit=logunit, file=trim(diro)//"/"//trim(logfile)) + + call NUOPC_CompAttributeGet(gcomp, name="do_budgets", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.true.') then + i = index(logfile, '.log') + diagfile = "diags"//logfile(i:) + open(newunit=diagunit, file=trim(diro)//"/"//trim(diagfile)) + endif + end if else logUnit = 6 endif diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 504dcd2d2..9844d815b 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -27,7 +27,7 @@ module med_diag_mod use shr_const_mod , only : shr_const_rearth, shr_const_pi, shr_const_latice use shr_const_mod , only : shr_const_ice_ref_sal, shr_const_ocn_ref_sal, shr_const_isspval 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, logunit, mastertask + use med_internalstate_mod , only : InternalState, logunit, mastertask, diagunit use med_methods_mod , only : fldbun_getdata2d => med_methods_FB_getdata2d use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d use med_methods_mod , only : fldbun_fldChk => med_methods_FB_FldChk @@ -1947,7 +1947,7 @@ subroutine med_phases_diag_print(gcomp, rc) ! net summary budgets call med_diag_print_summary(datagpr, ip, cdate, curr_tod) endif - write(logunit,*) ' ' + write(diagunit,*) ' ' deallocate(datagpr) endif ! output_level > 0 and mastertask @@ -1999,16 +1999,16 @@ subroutine med_diag_print_atm(data, ip, cdate, curr_tod) str = "CPL_TO_ATM" endif - write(logunit,*) ' ' - write(logunit,FAH) subname,trim(str)//' AREA BUDGET (m2/m2): period = ', & + write(diagunit,*) ' ' + write(diagunit,FAH) subname,trim(str)//' AREA BUDGET (m2/m2): period = ', & trim(budget_diags%periods(ip)%name), ': date = ', cdate, curr_tod - write(logunit,FA0) & + write(diagunit,FA0) & budget_diags%comps(ica)%name,& budget_diags%comps(icl)%name,& budget_diags%comps(icn)%name,& budget_diags%comps(ics)%name,& budget_diags%comps(ico)%name,' *SUM* ' - write(logunit,FA1) budget_diags%fields(f_area)%name,& + write(diagunit,FA1) budget_diags%fields(f_area)%name,& data(f_area,ica,ip), & data(f_area,icl,ip), & data(f_area,icn,ip), & @@ -2017,17 +2017,17 @@ subroutine med_diag_print_atm(data, ip, cdate, curr_tod) data(f_area,ica,ip) + data(f_area,icl,ip) + & data(f_area,icn,ip) + data(f_area,ics,ip) + data(f_area,ico,ip) - write(logunit,*) ' ' - write(logunit,FAH) subname,trim(str)//' HEAT BUDGET (W/m2): period = ',& + write(diagunit,*) ' ' + write(diagunit,FAH) subname,trim(str)//' HEAT BUDGET (W/m2): period = ',& trim(budget_diags%periods(ip)%name),': date = ',cdate,curr_tod - write(logunit,FA0) & + write(diagunit,FA0) & budget_diags%comps(ica)%name,& budget_diags%comps(icl)%name,& budget_diags%comps(icn)%name,& budget_diags%comps(ics)%name,& budget_diags%comps(ico)%name,' *SUM* ' do nf = f_heat_beg, f_heat_end - write(logunit,FA1) budget_diags%fields(nf)%name,& + write(diagunit,FA1) budget_diags%fields(nf)%name,& data(nf,ica,ip), & data(nf,icl,ip), & data(nf,icn,ip), & @@ -2035,7 +2035,7 @@ subroutine med_diag_print_atm(data, ip, cdate, curr_tod) data(nf,ico,ip), & data(nf,ica,ip) + data(nf,icl,ip) + data(nf,icn,ip) + data(nf,ics,ip) + data(nf,ico,ip) enddo - write(logunit,FA1) ' *SUM*' ,& + write(diagunit,FA1) ' *SUM*' ,& sum(data(f_heat_beg:f_heat_end,ica,ip)), & sum(data(f_heat_beg:f_heat_end,icl,ip)), & sum(data(f_heat_beg:f_heat_end,icn,ip)), & @@ -2045,17 +2045,17 @@ subroutine med_diag_print_atm(data, ip, cdate, curr_tod) sum(data(f_heat_beg:f_heat_end,icn,ip)) + sum(data(f_heat_beg:f_heat_end,ics,ip)) + & sum(data(f_heat_beg:f_heat_end,ico,ip)) - write(logunit,*) ' ' - write(logunit,FAH) subname,trim(str)//' WATER BUDGET (kg/m2s*1e6): period = ',& + write(diagunit,*) ' ' + write(diagunit,FAH) subname,trim(str)//' WATER BUDGET (kg/m2s*1e6): period = ',& trim(budget_diags%periods(ip)%name),': date = ',cdate,curr_tod - write(logunit,FA0) & + write(diagunit,FA0) & budget_diags%comps(ica)%name,& budget_diags%comps(icl)%name,& budget_diags%comps(icn)%name,& budget_diags%comps(ics)%name,& budget_diags%comps(ico)%name,' *SUM* ' do nf = f_watr_beg, f_watr_end - write(logunit,FA1) budget_diags%fields(nf)%name,& + write(diagunit,FA1) budget_diags%fields(nf)%name,& data(nf,ica,ip), & data(nf,icl,ip), & data(nf,icn,ip), & @@ -2063,7 +2063,7 @@ subroutine med_diag_print_atm(data, ip, cdate, curr_tod) data(nf,ico,ip), & data(nf,ica,ip) + data(nf,icl,ip) + data(nf,icn,ip) + data(nf,ics,ip) + data(nf,ico,ip) enddo - write(logunit,FA1) ' *SUM*' ,& + write(diagunit,FA1) ' *SUM*' ,& sum(data(f_watr_beg:f_watr_end,ica,ip)), & sum(data(f_watr_beg:f_watr_end,icl,ip)), & sum(data(f_watr_beg:f_watr_end,icn,ip)), & @@ -2075,17 +2075,17 @@ subroutine med_diag_print_atm(data, ip, cdate, curr_tod) if ( flds_wiso ) then do is = 1, nisotopes - write(logunit,*) ' ' - write(logunit,FAH) subname,trim(str)//' '//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ', & + write(diagunit,*) ' ' + write(diagunit,FAH) subname,trim(str)//' '//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ', & trim(budget_diags%periods(ip)%name),': date = ',cdate,curr_tod - write(logunit,FA0) & + write(diagunit,FA0) & budget_diags%comps(ica)%name,& budget_diags%comps(icl)%name,& budget_diags%comps(icn)%name,& budget_diags%comps(ics)%name,& budget_diags%comps(ico)%name,' *SUM* ' do nf = iso0(is), isof(is) - write(logunit,FA1) budget_diags%fields(nf)%name,& + write(diagunit,FA1) budget_diags%fields(nf)%name,& data(nf,ica,ip), & data(nf,icl,ip), & data(nf,icn,ip), & @@ -2093,7 +2093,7 @@ subroutine med_diag_print_atm(data, ip, cdate, curr_tod) data(nf,ico,ip), & data(nf,ica,ip) + data(nf,icl,ip) + data(nf,icn,ip) + data(nf,ics,ip) + data(nf,ico,ip) enddo - write(logunit,FA1) ' *SUM*', & + write(diagunit,FA1) ' *SUM*', & sum(data(iso0(is):isof(is),ica,ip)), & sum(data(iso0(is):isof(is),icl,ip)), & sum(data(iso0(is):isof(is),icn,ip)), & @@ -2160,22 +2160,22 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, cdate, curr_tod) ! heat budgets atm<->lnd, atm<->ocn, atm<->ice_nh, atm<->ice_sh, - write(logunit,*) ' ' - write(logunit,FAH) subname,trim(str)//' HEAT BUDGET (W/m2): period = ',& + write(diagunit,*) ' ' + write(diagunit,FAH) subname,trim(str)//' HEAT BUDGET (W/m2): period = ',& trim(budget_diags%periods(ip)%name),': date = ',cdate,curr_tod - write(logunit,FA0) budget_diags%comps(icar)%name,& + write(diagunit,FA0) budget_diags%comps(icar)%name,& budget_diags%comps(icxs)%name,& budget_diags%comps(icxr)%name,& budget_diags%comps(icas)%name,' *SUM* ' do nf = f_heat_beg, f_heat_end - write(logunit,FA1) budget_diags%fields(nf)%name,& + write(diagunit,FA1) budget_diags%fields(nf)%name,& -data(nf,icar,ip), & data(nf,icxs,ip), & data(nf,icxr,ip), & -data(nf,icas,ip), & -data(nf,icar,ip) + data(nf,icxs,ip) + data(nf,icxr,ip) - data(nf,icas,ip) enddo - write(logunit,FA1)' *SUM*',& + write(diagunit,FA1)' *SUM*',& -sum(data(f_heat_beg:f_heat_end,icar,ip)), & sum(data(f_heat_beg:f_heat_end,icxs,ip)), & sum(data(f_heat_beg:f_heat_end,icxr,ip)), & @@ -2185,23 +2185,23 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, cdate, curr_tod) ! water budgets atm<->lnd, atm<->ocn, atm<->ice_nh, atm<->ice_sh, - write(logunit,*) ' ' - write(logunit,FAH) subname,trim(str)//' WATER BUDGET (kg/m2s*1e6): period = ',& + write(diagunit,*) ' ' + write(diagunit,FAH) subname,trim(str)//' WATER BUDGET (kg/m2s*1e6): period = ',& trim(budget_diags%periods(ip)%name),': date = ',cdate,curr_tod - write(logunit,FA0) & + write(diagunit,FA0) & budget_diags%comps(icar)%name,& budget_diags%comps(icxs)%name,& budget_diags%comps(icxr)%name,& budget_diags%comps(icas)%name,' *SUM* ' do nf = f_watr_beg, f_watr_end - write(logunit,FA1) budget_diags%fields(nf)%name,& + write(diagunit,FA1) budget_diags%fields(nf)%name,& -data(nf,icar,ip),& data(nf,icxs,ip), & data(nf,icxr,ip),& -data(nf,icas,ip), & -data(nf,icar,ip) + data(nf,icxs,ip) + data(nf,icxr,ip) - data(nf,icas,ip) enddo - write(logunit,FA1) ' *SUM*',& + write(diagunit,FA1) ' *SUM*',& -sum(data(f_watr_beg:f_watr_end,icar,ip)), & sum(data(f_watr_beg:f_watr_end,icxs,ip)), & sum(data(f_watr_beg:f_watr_end,icxr,ip)), & @@ -2214,24 +2214,24 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, cdate, curr_tod) ! heat budgets atm<->lnd, atm<->ocn, atm<->ice_nh, atm<->ice_sh for water isotopes - write(logunit,*) ' ' - write(logunit,FAH) subname,trim(str)//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ',& + write(diagunit,*) ' ' + write(diagunit,FAH) subname,trim(str)//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ',& trim(budget_diags%periods(ip)%name), & ': date = ',cdate,curr_tod - write(logunit,FA0) & + write(diagunit,FA0) & budget_diags%comps(icar)%name,& budget_diags%comps(icxs)%name,& budget_diags%comps(icxr)%name,& budget_diags%comps(icas)%name,' *SUM* ' do nf = iso0(is), isof(is) - write(logunit,FA1) budget_diags%fields(nf)%name,& + write(diagunit,FA1) budget_diags%fields(nf)%name,& -data(nf,icar,ip), & data(nf,icxs,ip), & data(nf,icxr,ip), & -data(nf,icas,ip), & -data(nf,icar,ip) + data(nf,icxs,ip) + data(nf,icxr,ip) - data(nf,icas,ip) enddo - write(logunit,FA1) ' *SUM*',& + write(diagunit,FA1) ' *SUM*',& -sum(data(iso0(is):isof(is),icar,ip)),& sum(data(iso0(is):isof(is),icxs,ip)), & sum(data(iso0(is):isof(is),icxr,ip)), & @@ -2241,24 +2241,24 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, cdate, curr_tod) ! water budgets atm<->lnd, atm<->ocn, atm<->ice_nh, atm<->ice_sh for water isotopes - write(logunit,*) ' ' - write(logunit,FAH) subname,trim(str)//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ',& + write(diagunit,*) ' ' + write(diagunit,FAH) subname,trim(str)//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ',& trim(budget_diags%periods(ip)%name),& ': date = ',cdate,curr_tod - write(logunit,FA0) & + write(diagunit,FA0) & budget_diags%comps(icar)%name,& budget_diags%comps(icxs)%name,& budget_diags%comps(icxr)%name,& budget_diags%comps(icas)%name,' *SUM* ' do nf = iso0(is), isof(is) - write(logunit,FA1) budget_diags%fields(nf)%name,& + write(diagunit,FA1) budget_diags%fields(nf)%name,& -data(nf,icar,ip), & data(nf,icxs,ip), & data(nf,icxr,ip), & -data(nf,icas,ip), & -data(nf,icar,ip) + data(nf,icxs,ip) + data(nf,icxr,ip) - data(nf,icas,ip) enddo - write(logunit,FA1) ' *SUM*', & + write(diagunit,FA1) ' *SUM*', & -sum(data(iso0(is):isof(is), icar, ip)), & sum(data(iso0(is):isof(is), icxs, ip)), & sum(data(iso0(is):isof(is), icxr, ip)), & @@ -2312,25 +2312,25 @@ subroutine med_diag_print_summary(data, ip, cdate, curr_tod) call t_startf('MED:'//subname) ! write out areas - write(logunit,*) ' ' - write(logunit,FAH) subname,'NET AREA BUDGET (m2/m2): period = ',& + write(diagunit,*) ' ' + write(diagunit,FAH) subname,'NET AREA BUDGET (m2/m2): period = ',& trim(budget_diags%periods(ip)%name),& ': date = ',cdate,curr_tod - write(logunit,FA0) ' atm',' lnd',' ocn',' ice nh',' ice sh',' *SUM* ' + write(diagunit,FA0) ' atm',' lnd',' ocn',' ice nh',' ice sh',' *SUM* ' atm_area = data(f_area,c_atm_recv,ip) lnd_area = data(f_area,c_lnd_recv,ip) ocn_area = data(f_area,c_ocn_recv,ip) ice_area_nh = data(f_area,c_inh_recv,ip) ice_area_sh = data(f_area,c_ish_recv,ip) sum_area = atm_area + lnd_area + ocn_area + ice_area_nh + ice_area_sh - write(logunit,FA1) budget_diags%fields(f_area)%name, atm_area, lnd_area, ocn_area, ice_area_nh, ice_area_sh, sum_area + write(diagunit,FA1) budget_diags%fields(f_area)%name, atm_area, lnd_area, ocn_area, ice_area_nh, ice_area_sh, sum_area ! write out net heat budgets - write(logunit,*) ' ' - write(logunit,FAH) subname,'NET HEAT BUDGET (W/m2): period = ',& + write(diagunit,*) ' ' + write(diagunit,FAH) subname,'NET HEAT BUDGET (W/m2): period = ',& trim(budget_diags%periods(ip)%name), ': date = ',cdate,curr_tod - write(logunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' + write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' do nf = f_heat_beg, f_heat_end net_heat_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) net_heat_lnd = data(nf, c_lnd_recv, ip) + data(nf, c_lnd_send, ip) @@ -2342,7 +2342,7 @@ subroutine med_diag_print_summary(data, ip, cdate, curr_tod) net_heat_tot = net_heat_atm + net_heat_lnd + net_heat_rof + net_heat_ocn + & net_heat_ice_nh + net_heat_ice_sh + net_heat_glc - write(logunit,FA1r) budget_diags%fields(nf)%name,& + write(diagunit,FA1r) budget_diags%fields(nf)%name,& net_heat_atm, net_heat_lnd, net_heat_rof, net_heat_ocn, & net_heat_ice_nh, net_heat_ice_sh, net_heat_glc, net_heat_tot end do @@ -2366,16 +2366,16 @@ subroutine med_diag_print_summary(data, ip, cdate, curr_tod) sum_net_heat_tot = sum_net_heat_atm + sum_net_heat_lnd + sum_net_heat_rof + sum_net_heat_ocn + & sum_net_heat_ice_nh + sum_net_heat_ice_sh + sum_net_heat_glc - write(logunit,FA1r)' *SUM*',& + write(diagunit,FA1r)' *SUM*',& sum_net_heat_atm, sum_net_heat_lnd, sum_net_heat_rof, sum_net_heat_ocn, & sum_net_heat_ice_nh, sum_net_heat_ice_sh, sum_net_heat_glc, sum_net_heat_tot ! write out net water budgets - write(logunit,*) ' ' - write(logunit,FAH) subname,'NET WATER BUDGET (kg/m2s*1e6): period = ',& + write(diagunit,*) ' ' + write(diagunit,FAH) subname,'NET WATER BUDGET (kg/m2s*1e6): period = ',& trim(budget_diags%periods(ip)%name), ': date = ',cdate,curr_tod - write(logunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' + write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' do nf = f_watr_beg, f_watr_end net_water_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) net_water_lnd = data(nf, c_lnd_recv, ip) + data(nf, c_lnd_send, ip) @@ -2387,7 +2387,7 @@ subroutine med_diag_print_summary(data, ip, cdate, curr_tod) net_water_tot = net_water_atm + net_water_lnd + net_water_rof + net_water_ocn + & net_water_ice_nh + net_water_ice_sh + net_water_glc - write(logunit,FA1r) budget_diags%fields(nf)%name,& + write(diagunit,FA1r) budget_diags%fields(nf)%name,& net_water_atm, net_water_lnd, net_water_rof, net_water_ocn, & net_water_ice_nh, net_water_ice_sh, net_water_glc, net_water_tot enddo @@ -2411,7 +2411,7 @@ subroutine med_diag_print_summary(data, ip, cdate, curr_tod) sum_net_water_tot = sum_net_water_atm + sum_net_water_lnd + sum_net_water_rof + sum_net_water_ocn + & sum_net_water_ice_nh + sum_net_water_ice_sh + sum_net_water_glc - write(logunit,FA1r)' *SUM*',& + write(diagunit,FA1r)' *SUM*',& sum_net_water_atm, sum_net_water_lnd, sum_net_water_rof, sum_net_water_ocn, & sum_net_water_ice_nh, sum_net_water_ice_sh, sum_net_water_glc, sum_net_water_tot @@ -2420,10 +2420,10 @@ subroutine med_diag_print_summary(data, ip, cdate, curr_tod) if ( flds_wiso ) then do is = 1, nisotopes - write(logunit,*) ' ' - write(logunit,FAH) subname,'NET '//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ', & + write(diagunit,*) ' ' + write(diagunit,FAH) subname,'NET '//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ', & trim(budget_diags%periods(ip)%name),': date = ',cdate,curr_tod - write(logunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' + write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' do nf = iso0(is), isof(is) net_water_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) net_water_lnd = data(nf, c_lnd_recv, ip) + data(nf, c_lnd_send, ip) @@ -2435,7 +2435,7 @@ subroutine med_diag_print_summary(data, ip, cdate, curr_tod) net_water_tot = net_water_atm + net_water_lnd + net_water_rof + net_water_ocn + & net_water_ice_nh + net_water_ice_sh + net_water_glc - write(logunit,FA1r) budget_diags%fields(nf)%name,& + write(diagunit,FA1r) budget_diags%fields(nf)%name,& net_water_atm, net_water_lnd, net_water_rof, net_water_ocn, & net_water_ice_nh, net_water_ice_sh, net_water_glc, net_water_tot enddo @@ -2458,7 +2458,7 @@ subroutine med_diag_print_summary(data, ip, cdate, curr_tod) sum_net_water_ocn + sum_net_water_ice_nh + sum_net_water_ice_sh + & sum_net_water_glc - write(logunit,FA1r)' *SUM*',& + write(diagunit,FA1r)' *SUM*',& sum_net_water_atm, sum_net_water_lnd, sum_net_water_rof, sum_net_water_ocn, & sum_net_water_ice_nh, sum_net_water_ice_sh, sum_net_water_glc, sum_net_water_tot end do diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index be6191931..7ca821d3c 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -13,6 +13,7 @@ module med_internalstate_mod private integer, public :: logunit ! logunit for mediator log output + integer, public :: diagunit ! diagunit for budget output (med master only) integer, public :: loglevel ! loglevel for mediator log output logical, public :: mastertask=.false. ! is this the mastertask integer, public :: med_id ! needed currently in med_io_mod and set in esm.F90 From 9c48146734a74443f761a6dcd9988b1a943dcf27 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 4 May 2021 11:11:09 -0600 Subject: [PATCH 33/54] update pr template --- .github/pull_request_template.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index 5f1fbbdd9..36cc6403f 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -9,7 +9,7 @@ CMEPS Issues Fixed (include github issue #): Are changes expected to change answers? - [ ] bit for bit - [ ] different at roundoff level - - [ ] more substantial + - [ ] more substantial Any User Interface Changes (namelist or namelist defaults changes)? - [ ] Yes @@ -42,7 +42,7 @@ Testing performed if application target is UFS-HAFS: Hashes used for testing: - [ ] CESM: - repository to check out: https://github.com/ESCOMP/CESM.git - - branch: nuopc_dev + - branch: - hash: - [ ] UFS-coupled, then umbrella repostiory to check out and associated hash: - repository to check out: From 3700e71a317e2241e0506dde54d87f7a47957ebb Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 5 May 2021 15:23:58 -0600 Subject: [PATCH 34/54] fixes to land ice runoff in budget table --- mediator/med_diag_mod.F90 | 16 +++++++++++----- mediator/med_phases_prep_ice_mod.F90 | 8 -------- mediator/med_phases_prep_ocn_mod.F90 | 5 ----- 3 files changed, 11 insertions(+), 18 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 72295a5ac..4ecf4443a 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -281,6 +281,8 @@ subroutine med_diag_init(gcomp, rc) call add_to_budget_diag(budget_diags%comps, c_ocn_arecv, 'a2c_ocn' ) ! comp index: ocn, on atm grid call add_to_budget_diag(budget_diags%fields, f_area ,'area' ) ! field area (wrt to unit sphere) + + ! Note that this order is important here to determine f_heat_beg and f_heat_end call add_to_budget_diag(budget_diags%fields, f_heat_frz ,'hfreeze' ) ! field heat : latent, freezing call add_to_budget_diag(budget_diags%fields, f_heat_melt ,'hmelt' ) ! field heat : latent, melting call add_to_budget_diag(budget_diags%fields, f_heat_swnet ,'hnetsw' ) ! field heat : short wave, net @@ -290,6 +292,8 @@ subroutine med_diag_init(gcomp, rc) call add_to_budget_diag(budget_diags%fields, f_heat_latf ,'hlatfus' ) ! field heat : latent, fusion, snow call add_to_budget_diag(budget_diags%fields, f_heat_ioff ,'hiroff' ) ! field heat : latent, fusion, frozen runoff call add_to_budget_diag(budget_diags%fields, f_heat_sen ,'hsen' ) ! field heat : sensible + + ! Note that this order is important here to determine f_watr_beg and f_watr_end call add_to_budget_diag(budget_diags%fields, f_watr_frz ,'wfreeze' ) ! field water: freezing call add_to_budget_diag(budget_diags%fields, f_watr_melt ,'wmelt' ) ! field water: melting call add_to_budget_diag(budget_diags%fields, f_watr_rain ,'wrain' ) ! field water: precip, liquid @@ -298,6 +302,7 @@ subroutine med_diag_init(gcomp, rc) call add_to_budget_diag(budget_diags%fields, f_watr_salt ,'weqsaltf' ) ! field water: water equivalent of salt flux call add_to_budget_diag(budget_diags%fields, f_watr_roff ,'wrunoff' ) ! field water: runoff/flood call add_to_budget_diag(budget_diags%fields, f_watr_ioff ,'wfrzrof' ) ! field water: frozen runoff + call add_to_budget_diag(budget_diags%fields, f_watr_frz_16O ,'wfreeze_16O' ) ! field water isotope: freezing call add_to_budget_diag(budget_diags%fields, f_watr_melt_16O ,'wmelt_16O' ) ! field water isotope: melting call add_to_budget_diag(budget_diags%fields, f_watr_rain_16O ,'wrain_16O' ) ! field water isotope: precip, liquid @@ -949,7 +954,7 @@ subroutine med_phases_diag_lnd( gcomp, rc) call diag_lnd(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen' , f_heat_sen , ic, areas, lfrac, budget_local, rc=rc) call diag_lnd(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap' , f_watr_evap , ic, areas, lfrac, budget_local, rc=rc) - call diag_lnd(is_local%wrap%FBImp(complnd,complnd), 'Flrl_rofsur', f_watr_roff, ic, & + call diag_lnd(is_local%wrap%FBImp(complnd,complnd), 'Flrl_rofsur', f_watr_roff, ic,& areas, lfrac, budget_local, minus=.true., rc=rc) call diag_lnd(is_local%wrap%FBImp(complnd,complnd), 'Flrl_rofgwl', f_watr_roff, ic,& areas, lfrac, budget_local, minus=.true., rc=rc) @@ -969,6 +974,8 @@ subroutine med_phases_diag_lnd( gcomp, rc) call diag_lnd_wiso(is_local%wrap%FBImp(complnd,complnd), 'Flrl_rofi_wiso', & f_watr_ioff_16O, f_watr_ioff_18O, f_watr_ioff_HDO, ic, areas, lfrac, budget_local, rc=rc) + budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice + !------------------------------- ! to land from mediator !------------------------------- @@ -997,7 +1004,6 @@ subroutine med_phases_diag_lnd( gcomp, rc) call diag_lnd_wiso(is_local%wrap%FBExp(complnd), 'Flrl_flood_wiso', & f_watr_roff_16O, f_watr_roff_18O, f_watr_roff_HDO, ic, areas, lfrac, budget_local, minus=.true., rc=rc) - budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice call t_stopf('MED:'//subname) @@ -1108,7 +1114,7 @@ subroutine med_phases_diag_rof( gcomp, rc) ! from river to mediator !------------------------------- - ic = c_rof_send + ic = c_rof_recv ip = period_inst call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Flrr_flood', f_watr_roff, ic, areas, budget_local, rc=rc) @@ -1129,7 +1135,7 @@ subroutine med_phases_diag_rof( gcomp, rc) ! to river from mediator !------------------------------- - ic = c_rof_recv + ic = c_rof_send ip = period_inst call diag_rof(is_local%wrap%FBExp(comprof), 'Flrl_rofsur', f_watr_roff, ic, areas, budget_local, rc=rc) @@ -1254,7 +1260,7 @@ subroutine med_phases_diag_glc( gcomp, rc) !------------------------------- ! TODO: this will not be correct if there is more than 1 ice sheet - ic = c_glc_send + ic = c_glc_recv ip = period_inst do ns = 1,num_icesheets diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index db35cd1f1..4f12f97ad 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -58,7 +58,6 @@ subroutine med_phases_prep_ice(gcomp, rc) real(r8) :: nextsw_cday integer :: scalar_id real(r8) :: tmp(1) - logical :: first_call = .true. logical :: first_precip_fact_call = .true. character(len=*),parameter :: subname='(med_phases_prep_ice)' !--------------------------------------- @@ -104,10 +103,6 @@ subroutine med_phases_prep_ice(gcomp, 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 (first_call) then - write(logunit,'(a)')'(merge_to_ice): Scaling rain, snow, liquid and ice runoff by precip_fact from ocn' - first_call = .false. - end if if (precip_fact(1) /= 1._r8) then write(logunit,'(a,f21.13)')& '(merge_to_ice): Scaling rain, snow, liquid and ice runoff by non-unity precip_fact ',& @@ -156,9 +151,6 @@ subroutine med_phases_prep_ice(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - ! Set first call logical to false - first_call = .false. - if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 7b25b0a99..705d8a595 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -243,7 +243,6 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) integer :: n integer :: lsize real(R8) :: c1,c2,c3,c4 - logical :: first_call = .true. character(len=64), allocatable :: fldnames(:) character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_cesm)' !--------------------------------------- @@ -451,10 +450,6 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, 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 (first_call) then - write(logunit,'(a)')'(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by precip_fact from ocn' - first_call = .false. - end if 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 ',& From cec9ed1ae4681af885177970b64f1e6c8d78d0f8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 6 May 2021 08:01:11 -0600 Subject: [PATCH 35/54] update to use annotated tags and cmeps prefix --- .github/workflows/bumpversion.yml | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/.github/workflows/bumpversion.yml b/.github/workflows/bumpversion.yml index c682973c4..0e6ab26da 100644 --- a/.github/workflows/bumpversion.yml +++ b/.github/workflows/bumpversion.yml @@ -8,13 +8,12 @@ jobs: runs-on: ubuntu-latest steps: - uses: actions/checkout@v2 - with: - fetch-depth: '0' - name: Bump version and push tag - uses: anothrNick/github-tag-action@1.26.0 - env: - GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} - WITH_V: true - DEFAULT_BUMP: minor - RELEASE_BRANCHES: master - DRY_RUN: False + id: tag_version + uses: mathieudutour/github-tag-action@v5.5 + with: + github_token: ${{ secrets.GITHUB_TOKEN }} + create_annotated_tag: true + default_bump: patch + dry_run: true + tag_prefix: cmeps From a203f5e836980fa48b1b6b31ef10f166d06ea3b8 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 6 May 2021 08:15:52 -0600 Subject: [PATCH 36/54] bump version --- .github/workflows/bumpversion.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bumpversion.yml b/.github/workflows/bumpversion.yml index 0e6ab26da..7364cb8d8 100644 --- a/.github/workflows/bumpversion.yml +++ b/.github/workflows/bumpversion.yml @@ -15,5 +15,5 @@ jobs: github_token: ${{ secrets.GITHUB_TOKEN }} create_annotated_tag: true default_bump: patch - dry_run: true + dry_run: false tag_prefix: cmeps From ea047bbafea2d7fc308b0b328e67e0e44844cd25 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 9 May 2021 11:25:34 -0600 Subject: [PATCH 37/54] use nexttime rather than currtime to trigger budget output --- mediator/med.F90 | 2 +- mediator/med_diag_mod.F90 | 253 ++++++++++++++++++++------------------ 2 files changed, 133 insertions(+), 122 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 2ced7ad41..d5acfb28d 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -2435,7 +2435,7 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- call med_diag_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_diag_zero(gcomp, mode='all', rc=rc) + call med_diag_zero('all', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index b2a76f552..971084835 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -21,7 +21,7 @@ module med_diag_mod use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time use ESMF , only : ESMF_VM, ESMF_VMReduce, ESMF_REDUCE_SUM - use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockGetNextTime use ESMF , only : ESMF_Alarm, ESMF_ClockGetAlarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff use ESMF , only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldGet use shr_const_mod , only : shr_const_rearth, shr_const_pi, shr_const_latice @@ -66,6 +66,11 @@ module med_diag_mod end type budget_diag_indices type(budget_diag_indices) :: budget_diags + interface med_diag_zero + module procedure med_diag_zero_mode + module procedure med_diag_zero_select + end interface + ! --------------------------------- ! print options (obtained from mediator config input) ! --------------------------------- @@ -421,95 +426,96 @@ end function get_diag_attribute end subroutine med_diag_init !=============================================================================== - subroutine med_diag_zero( gcomp, mode, rc) + subroutine med_diag_zero_mode(mode, rc ) ! ------------------------------------------------------------------ ! Zero out global budget diagnostic data. ! ------------------------------------------------------------------ ! input/output variables - type(ESMF_GridComp) :: gcomp - character(len=*), intent(in),optional :: mode - integer, intent(out) :: rc + character(len=*) , intent(in) :: mode + integer , intent(out) :: rc ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: currTime - integer :: ip - integer :: curr_year, curr_mon, curr_day, curr_tod character(*), parameter :: subName = '(med_diag_zero) ' ! ------------------------------------------------------------------ - call t_startf('MED:'//subname) - if (present(mode)) then - - if (trim(mode) == 'inst') then - budget_local(:,:,period_inst) = 0.0_r8 - budget_global(:,:,period_inst) = 0.0_r8 - budget_counter(:,:,period_inst) = 0.0_r8 - elseif (trim(mode) == 'day') then - budget_local(:,:,period_day) = 0.0_r8 - budget_global(:,:,period_day) = 0.0_r8 - budget_counter(:,:,period_day) = 0.0_r8 - elseif (trim(mode) == 'mon') then - budget_local(:,:,period_mon) = 0.0_r8 - budget_global(:,:,period_mon) = 0.0_r8 - budget_counter(:,:,period_mon) = 0.0_r8 - elseif (trim(mode) == 'ann') then - budget_local(:,:,period_ann) = 0.0_r8 - budget_global(:,:,period_ann) = 0.0_r8 - budget_counter(:,:,period_ann) = 0.0_r8 - elseif (trim(mode) == 'inf') then - budget_local(:,:,period_inf) = 0.0_r8 - budget_global(:,:,period_inf) = 0.0_r8 - budget_counter(:,:,period_inf) = 0.0_r8 - elseif (trim(mode) == 'all') then - budget_local(:,:,:) = 0.0_r8 - budget_global(:,:,:) = 0.0_r8 - budget_counter(:,:,:) = 0.0_r8 - else - call ESMF_LogWrite(trim(subname)//' mode '//trim(mode)//& - ' not recognized', & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif + rc = ESMF_SUCCESS + if (trim(mode) == 'inst') then + budget_local(:,:,period_inst) = 0.0_r8 + budget_global(:,:,period_inst) = 0.0_r8 + budget_counter(:,:,period_inst) = 0.0_r8 + elseif (trim(mode) == 'day') then + budget_local(:,:,period_day) = 0.0_r8 + budget_global(:,:,period_day) = 0.0_r8 + budget_counter(:,:,period_day) = 0.0_r8 + elseif (trim(mode) == 'mon') then + budget_local(:,:,period_mon) = 0.0_r8 + budget_global(:,:,period_mon) = 0.0_r8 + budget_counter(:,:,period_mon) = 0.0_r8 + elseif (trim(mode) == 'ann') then + budget_local(:,:,period_ann) = 0.0_r8 + budget_global(:,:,period_ann) = 0.0_r8 + budget_counter(:,:,period_ann) = 0.0_r8 + elseif (trim(mode) == 'inf') then + budget_local(:,:,period_inf) = 0.0_r8 + budget_global(:,:,period_inf) = 0.0_r8 + budget_counter(:,:,period_inf) = 0.0_r8 + elseif (trim(mode) == 'all') then + budget_local(:,:,:) = 0.0_r8 + budget_global(:,:,:) = 0.0_r8 + budget_counter(:,:,:) = 0.0_r8 else - call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//' mode '//trim(mode)//& + ' not recognized', & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + end subroutine med_diag_zero_mode - call ESMF_ClockGet( clock, currTime=currTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !=============================================================================== + subroutine med_diag_zero_select(year, mon, day, tod) - call ESMF_TimeGet( currTime, yy=curr_year, mm=curr_mon, dd=curr_day, s=curr_tod, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! ------------------------------------------------------------------ + ! Zero out global budget diagnostic data. + ! ------------------------------------------------------------------ - do ip = 1,size(budget_diags%periods) - if (ip == period_inst) then - budget_local(:,:,ip) = 0.0_r8 - budget_global(:,:,ip) = 0.0_r8 - budget_counter(:,:,ip) = 0.0_r8 - endif - if (ip==period_day .and. curr_tod==0) then - budget_local(:,:,ip) = 0.0_r8 - budget_global(:,:,ip) = 0.0_r8 - budget_counter(:,:,ip) = 0.0_r8 - endif - if (ip==period_mon .and. curr_day==1 .and. curr_tod==0) then - budget_local(:,:,ip) = 0.0_r8 - budget_global(:,:,ip) = 0.0_r8 - budget_counter(:,:,ip) = 0.0_r8 - endif - if (ip==period_ann .and. curr_mon==1 .and. curr_day==1 .and. curr_tod==0) then - budget_local(:,:,ip) = 0.0_r8 - budget_global(:,:,ip) = 0.0_r8 - budget_counter(:,:,ip) = 0.0_r8 - endif - enddo - end if - call t_stopf('MED:'//subname) - end subroutine med_diag_zero + ! input/output variables + integer, intent(in) :: year + integer, intent(in) :: mon + integer, intent(in) :: day + integer, intent(in) :: tod + + ! local variables + integer :: ip + character(*), parameter :: subName = '(med_diag_zero_select) ' + ! ------------------------------------------------------------------ + + do ip = 1,size(budget_diags%periods) + if (ip == period_inst) then + budget_local(:,:,ip) = 0.0_r8 + budget_global(:,:,ip) = 0.0_r8 + budget_counter(:,:,ip) = 0.0_r8 + endif + if (ip==period_day .and. tod==0) then + budget_local(:,:,ip) = 0.0_r8 + budget_global(:,:,ip) = 0.0_r8 + budget_counter(:,:,ip) = 0.0_r8 + endif + if (ip==period_mon .and. day==1 .and. tod==0) then + budget_local(:,:,ip) = 0.0_r8 + budget_global(:,:,ip) = 0.0_r8 + budget_counter(:,:,ip) = 0.0_r8 + endif + if (ip==period_ann .and. mon==1 .and. day==1 .and. tod==0) then + budget_local(:,:,ip) = 0.0_r8 + budget_global(:,:,ip) = 0.0_r8 + budget_counter(:,:,ip) = 0.0_r8 + endif + enddo + end subroutine med_diag_zero_select !=============================================================================== subroutine med_phases_diag_accum(gcomp, rc) @@ -1834,12 +1840,12 @@ subroutine med_phases_diag_print(gcomp, rc) ! local variables type(ESMF_Clock) :: clock type(ESMF_Alarm) :: stop_alarm - type(ESMF_Time) :: currTime - integer :: cdate ! coded date, seconds - integer :: curr_year - integer :: curr_mon - integer :: curr_day - integer :: curr_tod + type(ESMF_Time) :: nextTime + integer :: date ! coded date, seconds + integer :: year + integer :: mon + integer :: day + integer :: tod integer :: output_level ! print level logical :: sumdone ! has a sum been computed yet character(CS) :: cvalue @@ -1848,10 +1854,8 @@ subroutine med_phases_diag_print(gcomp, rc) integer :: f_size ! number of fields integer :: p_size ! number of period types real(r8), allocatable :: datagpr(:,:,:) - character(len=20) :: name + character(len=64) :: timestr logical, save :: firstcall = .true. - integer :: yr,mon,day,sec ! time units - character(len=64) :: currtimestr character(*), parameter :: subName = '(med_phases_diag_print) ' ! ------------------------------------------------------------------ @@ -1862,17 +1866,23 @@ subroutine med_phases_diag_print(gcomp, rc) !------------------------------------------------------------------------------- ! Get clock and alarm info - call ESMF_GridCompGet(gcomp, clock=clock, name=name, rc=rc) + call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet( clock, currTime=currTime, rc=rc) + + ! NOTE - we are using the next time to ensure that budgets are + ! written at the end of the run correctly This duplicates the + ! behavior in the restart and history file output in that the time + ! stamp is the next time and not the actual current time + call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet( currTime, yy=curr_year, mm=curr_mon, dd=curr_day, s=curr_tod, rc=rc) + call ESMF_TimeGet( nextTime, yy=year, mm=mon, dd=day, s=tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - cdate = curr_year*10000 + curr_mon*100 + curr_day + date = year*10000 + mon*100 + day + #ifdef DEBUG if(mastertask) then - write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') curr_year,'-',curr_mon,'-',curr_day,'-',curr_tod - write(logunit,' (a)') trim(subname)//": currtime = "//trim(currtimestr) + write(timestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') year,'-',mon,'-',day,'-',tod + write(logunit,' (a)') trim(subname)//": time = "//trim(timestr) endif #endif @@ -1889,16 +1899,16 @@ subroutine med_phases_diag_print(gcomp, rc) if (ip == period_inst) then output_level = max(output_level, budget_print_inst) end if - if (ip == period_day .and. curr_tod == 0) then + if (ip == period_day .and. tod == 0) then output_level = max(output_level, budget_print_daily) end if - if (ip == period_mon .and. curr_day == 1 .and. curr_tod == 0) then + if (ip == period_mon .and. day == 1 .and. tod == 0) then output_level = max(output_level, budget_print_month) end if - if (ip == period_ann .and. curr_mon == 1 .and. curr_day == 1 .and. curr_tod == 0) then + if (ip == period_ann .and. mon == 1 .and. day == 1 .and. tod == 0) then output_level = max(output_level, budget_print_ann) end if - if (ip == period_inf .and. curr_mon == 1 .and. curr_day == 1 .and. curr_tod == 0) then + if (ip == period_inf .and. mon == 1 .and. day == 1 .and. tod == 0) then output_level = max(output_level, budget_print_ltann) end if if (ip == period_inf) then @@ -1911,9 +1921,8 @@ subroutine med_phases_diag_print(gcomp, rc) endif endif - - ! Currently output_level is limited to levels of 0,1,2, 3 - ! (see comment for print options at top) + ! Currently output_level is limited to levels of 0,1,2, 3 + ! (see comment for print options at top) if (output_level > 0) then if (.not. sumdone) then @@ -1943,32 +1952,34 @@ subroutine med_phases_diag_print(gcomp, rc) ! Write diagnostic tables to logunit (mastertask only) if (output_level >= 3) then ! detail atm budgets and breakdown into components --- - call med_diag_print_atm(datagpr, ip, cdate, curr_tod) + call med_diag_print_atm(datagpr, ip, date, tod) end if if (output_level >= 2) then ! detail lnd/ocn/ice component budgets ---- - call med_diag_print_lnd_ice_ocn(datagpr, ip, cdate, curr_tod) + call med_diag_print_lnd_ice_ocn(datagpr, ip, date, tod) end if if (output_level >= 1) then ! net summary budgets - call med_diag_print_summary(datagpr, ip, cdate, curr_tod) + call med_diag_print_summary(datagpr, ip, date, tod) endif write(diagunit,*) ' ' deallocate(datagpr) + endif ! output_level > 0 and mastertask end if ! if mastertask enddo ! ip = 1, period_types + !------------------------------------------------------------------------------- ! Zero budget data !------------------------------------------------------------------------------- - call med_diag_zero(gcomp, rc=rc) + call med_diag_zero(year, mon, day, tod) end subroutine med_phases_diag_print !=============================================================================== - subroutine med_diag_print_atm(data, ip, cdate, curr_tod) + subroutine med_diag_print_atm(data, ip, date, tod) ! --------------------------------------------------------- ! detail atm budgets and breakdown into components @@ -1977,8 +1988,8 @@ subroutine med_diag_print_atm(data, ip, cdate, curr_tod) ! intput/output variables real(r8), intent(in) :: data(:,:,:) ! values to print, scaled and such integer , intent(in) :: ip ! period index - integer , intent(in) :: cdate - integer , intent(in) :: curr_tod + integer , intent(in) :: date + integer , intent(in) :: tod ! local variables integer :: ic,nf,is ! data array indicies @@ -2007,7 +2018,7 @@ subroutine med_diag_print_atm(data, ip, cdate, curr_tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,trim(str)//' AREA BUDGET (m2/m2): period = ', & - trim(budget_diags%periods(ip)%name), ': date = ', cdate, curr_tod + trim(budget_diags%periods(ip)%name), ': date = ', date, tod write(diagunit,FA0) & budget_diags%comps(ica)%name,& budget_diags%comps(icl)%name,& @@ -2025,7 +2036,7 @@ subroutine med_diag_print_atm(data, ip, cdate, curr_tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,trim(str)//' HEAT BUDGET (W/m2): period = ',& - trim(budget_diags%periods(ip)%name),': date = ',cdate,curr_tod + trim(budget_diags%periods(ip)%name),': date = ',date,tod write(diagunit,FA0) & budget_diags%comps(ica)%name,& budget_diags%comps(icl)%name,& @@ -2053,7 +2064,7 @@ subroutine med_diag_print_atm(data, ip, cdate, curr_tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,trim(str)//' WATER BUDGET (kg/m2s*1e6): period = ',& - trim(budget_diags%periods(ip)%name),': date = ',cdate,curr_tod + trim(budget_diags%periods(ip)%name),': date = ',date,tod write(diagunit,FA0) & budget_diags%comps(ica)%name,& budget_diags%comps(icl)%name,& @@ -2083,7 +2094,7 @@ subroutine med_diag_print_atm(data, ip, cdate, curr_tod) do is = 1, nisotopes write(diagunit,*) ' ' write(diagunit,FAH) subname,trim(str)//' '//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ', & - trim(budget_diags%periods(ip)%name),': date = ',cdate,curr_tod + trim(budget_diags%periods(ip)%name),': date = ',date,tod write(diagunit,FA0) & budget_diags%comps(ica)%name,& budget_diags%comps(icl)%name,& @@ -2116,7 +2127,7 @@ subroutine med_diag_print_atm(data, ip, cdate, curr_tod) end subroutine med_diag_print_atm !=============================================================================== - subroutine med_diag_print_lnd_ice_ocn(data, ip, cdate, curr_tod) + subroutine med_diag_print_lnd_ice_ocn(data, ip, date, tod) ! --------------------------------------------------------- ! detail lnd/ocn/ice component budgets @@ -2125,8 +2136,8 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, cdate, curr_tod) ! intput/output variables real(r8), intent(in) :: data(:,:,:) ! values to print, scaled and such integer , intent(in) :: ip - integer , intent(in) :: cdate - integer , intent(in) :: curr_tod + integer , intent(in) :: date + integer , intent(in) :: tod ! local variables integer :: ic,nf,is ! data array indicies @@ -2168,7 +2179,7 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, cdate, curr_tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,trim(str)//' HEAT BUDGET (W/m2): period = ',& - trim(budget_diags%periods(ip)%name),': date = ',cdate,curr_tod + trim(budget_diags%periods(ip)%name),': date = ',date,tod write(diagunit,FA0) budget_diags%comps(icar)%name,& budget_diags%comps(icxs)%name,& budget_diags%comps(icxr)%name,& @@ -2193,7 +2204,7 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, cdate, curr_tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,trim(str)//' WATER BUDGET (kg/m2s*1e6): period = ',& - trim(budget_diags%periods(ip)%name),': date = ',cdate,curr_tod + trim(budget_diags%periods(ip)%name),': date = ',date,tod write(diagunit,FA0) & budget_diags%comps(icar)%name,& budget_diags%comps(icxs)%name,& @@ -2223,7 +2234,7 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, cdate, curr_tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,trim(str)//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ',& trim(budget_diags%periods(ip)%name), & - ': date = ',cdate,curr_tod + ': date = ',date,tod write(diagunit,FA0) & budget_diags%comps(icar)%name,& budget_diags%comps(icxs)%name,& @@ -2250,7 +2261,7 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, cdate, curr_tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,trim(str)//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ',& trim(budget_diags%periods(ip)%name),& - ': date = ',cdate,curr_tod + ': date = ',date,tod write(diagunit,FA0) & budget_diags%comps(icar)%name,& budget_diags%comps(icxs)%name,& @@ -2278,7 +2289,7 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, cdate, curr_tod) end subroutine med_diag_print_lnd_ice_ocn !=============================================================================== - subroutine med_diag_print_summary(data, ip, cdate, curr_tod) + subroutine med_diag_print_summary(data, ip, date, tod) ! --------------------------------------------------------- ! net summary budgets @@ -2287,8 +2298,8 @@ subroutine med_diag_print_summary(data, ip, cdate, curr_tod) ! intput/output variables real(r8), intent(in) :: data(:,:,:) ! values to print, scaled and such integer , intent(in) :: ip - integer , intent(in) :: cdate - integer , intent(in) :: curr_tod + integer , intent(in) :: date + integer , intent(in) :: tod ! local variables integer :: ic,nf,is ! data array indicies @@ -2321,7 +2332,7 @@ subroutine med_diag_print_summary(data, ip, cdate, curr_tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,'NET AREA BUDGET (m2/m2): period = ',& trim(budget_diags%periods(ip)%name),& - ': date = ',cdate,curr_tod + ': date = ',date,tod write(diagunit,FA0) ' atm',' lnd',' ocn',' ice nh',' ice sh',' *SUM* ' atm_area = data(f_area,c_atm_recv,ip) lnd_area = data(f_area,c_lnd_recv,ip) @@ -2335,7 +2346,7 @@ subroutine med_diag_print_summary(data, ip, cdate, curr_tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,'NET HEAT BUDGET (W/m2): period = ',& - trim(budget_diags%periods(ip)%name), ': date = ',cdate,curr_tod + trim(budget_diags%periods(ip)%name), ': date = ',date,tod write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' do nf = f_heat_beg, f_heat_end net_heat_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) @@ -2380,7 +2391,7 @@ subroutine med_diag_print_summary(data, ip, cdate, curr_tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,'NET WATER BUDGET (kg/m2s*1e6): period = ',& - trim(budget_diags%periods(ip)%name), ': date = ',cdate,curr_tod + trim(budget_diags%periods(ip)%name), ': date = ',date,tod write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' do nf = f_watr_beg, f_watr_end net_water_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) @@ -2428,7 +2439,7 @@ subroutine med_diag_print_summary(data, ip, cdate, curr_tod) do is = 1, nisotopes write(diagunit,*) ' ' write(diagunit,FAH) subname,'NET '//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ', & - trim(budget_diags%periods(ip)%name),': date = ',cdate,curr_tod + trim(budget_diags%periods(ip)%name),': date = ',date,tod write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' do nf = iso0(is), isof(is) net_water_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) From d227909acdf79c28c03b31cdba81959a3a84d81a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 9 May 2021 19:04:03 -0600 Subject: [PATCH 38/54] fixed issue in PR --- mediator/med_diag_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 971084835..ef765604e 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -426,7 +426,7 @@ end function get_diag_attribute end subroutine med_diag_init !=============================================================================== - subroutine med_diag_zero_mode(mode, rc ) + subroutine med_diag_zero_mode(mode, rc) ! ------------------------------------------------------------------ ! Zero out global budget diagnostic data. From 275b1a4ef65e95b6c893adeeb6f3a0599768bce7 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 11 May 2021 16:45:51 -0600 Subject: [PATCH 39/54] fix initial diag counter --- mediator/med.F90 | 7 ++++--- mediator/med_diag_mod.F90 | 4 +++- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index d5acfb28d..f382c0521 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -664,7 +664,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) ! TransferOfferGeomObject Attribute. use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_SUCCESS, ESMF_LogFoundAllocError - use ESMF , only : ESMF_StateIsCreated + use ESMF , only : ESMF_StateIsCreated use ESMF , only : ESMF_LogMsg_Info, ESMF_LogWrite use ESMF , only : ESMF_END_ABORT, ESMF_Finalize use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise, NUOPC_AddNestedState @@ -2435,7 +2435,8 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- call med_diag_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_diag_zero('all', rc=rc) + call med_diag_zero(mode='all', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- @@ -2492,7 +2493,7 @@ subroutine DataInitialize(gcomp, rc) end if call med_phases_profile(gcomp, rc) - + if (ChkErr(rc,__LINE__,u_FILE_u)) return else ! Not all done call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index ef765604e..d672f0036 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -465,7 +465,8 @@ subroutine med_diag_zero_mode(mode, rc) elseif (trim(mode) == 'all') then budget_local(:,:,:) = 0.0_r8 budget_global(:,:,:) = 0.0_r8 - budget_counter(:,:,:) = 0.0_r8 + budget_counter(:,:,period_inst) = 0.0_r8 + budget_counter(:,:,period_inst+1:) = 1.0_r8 else call ESMF_LogWrite(trim(subname)//' mode '//trim(mode)//& ' not recognized', & @@ -2341,6 +2342,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) ice_area_sh = data(f_area,c_ish_recv,ip) sum_area = atm_area + lnd_area + ocn_area + ice_area_nh + ice_area_sh write(diagunit,FA1) budget_diags%fields(f_area)%name, atm_area, lnd_area, ocn_area, ice_area_nh, ice_area_sh, sum_area + write(diagUnit,*) 'counter: ',budget_counter(f_area, c_atm_recv, ip) ! write out net heat budgets From d8651060e67961e2144e769429eb3807bee7aa4c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 14 May 2021 14:15:44 -0600 Subject: [PATCH 40/54] add support for stop_option date --- drivers/cime/esm_time_mod.F90 | 50 +++++++++++++++++++++-------------- mediator/med_time_mod.F90 | 45 ++++++++++++++++++++++++++----- 2 files changed, 68 insertions(+), 27 deletions(-) diff --git a/drivers/cime/esm_time_mod.F90 b/drivers/cime/esm_time_mod.F90 index 55b269cde..49c0226bb 100644 --- a/drivers/cime/esm_time_mod.F90 +++ b/drivers/cime/esm_time_mod.F90 @@ -9,7 +9,7 @@ module esm_time_mod use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_LOGMSG_ERROR use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE use ESMF , only : operator(<), operator(/=), operator(+) @@ -150,7 +150,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert if (ierr < 0) then rc = ESMF_FAILURE call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & - ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) return end if read(unitn,'(a)', iostat=ierr) restart_file @@ -162,7 +162,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert end if close(unitn) call ESMF_LogWrite(trim(subname)//" read driver restart from file = "//trim(restart_file), & - ESMF_LOGMSG_INFO) + ESMF_LOGMSG_ERROR) call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -419,17 +419,18 @@ subroutine esm_time_alarmInit( clock, alarm, option, & endif ! Get calendar from clock - call ESMF_ClockGet(clock, calendar=cal) + call ESMF_ClockGet(clock, calendar=cal, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Error checks if (trim(option) == optdate) then if (.not. present(opt_ymd)) then - call ESMF_LogWrite(trim(subname)//trim(option)//' requires opt_ymd', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//trim(option)//' requires opt_ymd', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if if (lymd < 0 .or. ltod < 0) then - call ESMF_LogWrite(subname//trim(option)//'opt_ymd, opt_tod invalid', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//trim(option)//'opt_ymd, opt_tod invalid', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -441,12 +442,12 @@ subroutine esm_time_alarmInit( clock, alarm, option, & trim(option) == optNMonths .or. & trim(option) == optNYears) then if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -462,6 +463,15 @@ subroutine esm_time_alarmInit( clock, alarm, option, & if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .false. + case (optDate) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call esm_time_date2ymd(opt_ymd, cyy, cmm, cdd) + + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=cdd, s=ltod, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + case (optNever) call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -525,7 +535,7 @@ subroutine esm_time_alarmInit( clock, alarm, option, & update_nextalarm = .true. case default - call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return @@ -585,7 +595,7 @@ subroutine esm_time_timeInit( Time, ymd, cal, tod, desc, logunit ) write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & 'time-of-day out of bounds', ymd, ltod end if - call ESMF_LogWrite( subname//'ERROR: Bad input' , ESMF_LOGMSG_INFO) + call ESMF_LogWrite( subname//'ERROR: Bad input' , ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -646,66 +656,66 @@ subroutine esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, c rc = ESMF_SUCCESS status = nf90_open(restart_file, NF90_NOWRITE, ncid) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_open: '//trim(restart_file), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_open: '//trim(restart_file), ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif status = nf90_inq_varid(ncid, 'start_ymd', varid) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_ymd', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_ymd', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if status = nf90_get_var(ncid, varid, start_ymd) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var start_ymd', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var start_ymd', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if status = nf90_inq_varid(ncid, 'start_tod', varid) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_tod', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_tod', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if status = nf90_get_var(ncid, varid, start_tod) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var start_tod', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var start_tod', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if status = nf90_inq_varid(ncid, 'curr_ymd', varid) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_ymd', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_ymd', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if status = nf90_get_var(ncid, varid, curr_ymd) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var curr_ymd', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var curr_ymd', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if status = nf90_inq_varid(ncid, 'curr_tod', varid) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_tod', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_tod', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if status = nf90_get_var(ncid, varid, curr_tod) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var curr_tod', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var curr_tod', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if status = nf90_close(ncid) if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_close', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_close', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 99d19cc4c..09dbaffb9 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -9,9 +9,9 @@ module med_time_mod use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_FAILURE use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast - use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_LOGMSG_ERROR use ESMF , only : operator(<), operator(/=), operator(+) use ESMF , only : operator(-), operator(*) , operator(>=) use ESMF , only : operator(<=), operator(>), operator(==) @@ -116,12 +116,12 @@ subroutine med_time_alarmInit( clock, alarm, option, & ! Error checks if (trim(option) == optdate) then if (.not. present(opt_ymd)) then - call ESMF_LogWrite(trim(subname)//trim(option)//' requires opt_ymd', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//trim(option)//' requires opt_ymd', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if if (lymd < 0 .or. ltod < 0) then - call ESMF_LogWrite(subname//trim(option)//'opt_ymd, opt_tod invalid', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//trim(option)//'opt_ymd, opt_tod invalid', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -133,12 +133,12 @@ subroutine med_time_alarmInit( clock, alarm, option, & trim(option) == optNMonths .or. & trim(option) == optNYears) then if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -154,6 +154,15 @@ subroutine med_time_alarmInit( clock, alarm, option, & if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .false. + case (optDate) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_time_date2ymd(opt_ymd, cyy, cmm, cdd) + + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=cdd, s=ltod, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + case (optNever) call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -217,7 +226,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & update_nextalarm = .true. case default - call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return @@ -243,4 +252,26 @@ subroutine med_time_alarmInit( clock, alarm, option, & end subroutine med_time_alarmInit + subroutine med_time_date2ymd (date, year, month, day) + + ! input/output variables + integer, intent(in) :: date ! coded-date (yyyymmdd) + integer, intent(out) :: year,month,day ! calendar year,month,day + + ! local variables + integer :: tdate ! temporary date + character(*),parameter :: subName = "(med_time_date2ymd)" + !------------------------------------------------------------------------------- + + tdate = abs(date) + year = int(tdate/10000) + if (date < 0) then + year = -year + end if + month = int( mod(tdate,10000)/ 100) + day = mod(tdate, 100) + + end subroutine med_time_date2ymd + + !=============================================================================== end module med_time_mod From 801724f8d1c261aa177f8f692070ff4bc9648442 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 16 May 2021 15:12:45 -0600 Subject: [PATCH 41/54] updated run sequence to fix diag problem for wmelt --- cime_config/runseq/runseq_general.py | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/cime_config/runseq/runseq_general.py b/cime_config/runseq/runseq_general.py index 3bc307488..db323b3c2 100644 --- a/cime_config/runseq/runseq_general.py +++ b/cime_config/runseq/runseq_general.py @@ -100,7 +100,6 @@ def gen_runseq(case, coupling_times): runseq.add_action("MED med_phases_prep_ice" , med_to_ice) runseq.add_action("MED -> ICE :remapMethod=redist" , med_to_ice) - runseq.add_action("MED med_phases_diag_ice_med2ice" , run_ice and diag_mode) runseq.add_action("MED med_phases_prep_wav" , med_to_wav) runseq.add_action("MED -> WAV :remapMethod=redist" , med_to_wav) @@ -132,9 +131,12 @@ def gen_runseq(case, coupling_times): runseq.add_action("LND -> MED :remapMethod=redist" , run_lnd) runseq.add_action("MED med_phases_post_lnd" , run_lnd) + runseq.add_action("MED med_phases_diag_lnd" , run_lnd and diag_mode) + runseq.add_action("MED med_phases_diag_rof" , run_rof and diag_mode) + runseq.add_action("MED med_phases_diag_ice_ice2med" , run_ice and diag_mode) + runseq.add_action("MED med_phases_diag_glc" , run_glc and diag_mode) runseq.add_action("ICE -> MED :remapMethod=redist" , run_ice) - runseq.add_action("MED med_phases_diag_ice_ice2med" , run_ice and diag_mode) runseq.add_action("MED med_phases_post_ice" , run_ice) runseq.add_action("MED med_phases_prep_atm" , med_to_atm) @@ -142,6 +144,8 @@ def gen_runseq(case, coupling_times): runseq.add_action("ATM" , run_atm) runseq.add_action("ATM -> MED :remapMethod=redist" , run_atm) runseq.add_action("MED med_phases_post_atm" , run_atm) + runseq.add_action("MED med_phases_diag_atm" , run_atm and diag_mode) + runseq.add_action("MED med_phases_diag_ice_med2ice" , run_ice and diag_mode) runseq.add_action("WAV -> MED :remapMethod=redist", run_wav) runseq.add_action("MED med_phases_post_wav" , run_wav) @@ -149,10 +153,6 @@ def gen_runseq(case, coupling_times): runseq.add_action("ROF -> MED :remapMethod=redist", run_rof and not rof_outer_loop) runseq.add_action("MED med_phases_post_rof" , run_rof and not rof_outer_loop) - runseq.add_action("MED med_phases_diag_atm" , run_atm and diag_mode) - runseq.add_action("MED med_phases_diag_lnd" , run_lnd and diag_mode) - runseq.add_action("MED med_phases_diag_rof" , run_rof and diag_mode) - runseq.add_action("MED med_phases_diag_glc" , run_glc and diag_mode) runseq.add_action("MED med_phases_diag_accum" , diag_mode) runseq.add_action("MED med_phases_diag_print" , diag_mode) From 75a5051f3e85737a6b0df904e900a7e2eceabf6e Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 4 May 2021 11:51:33 -0600 Subject: [PATCH 42/54] Remove unneeded glc_nx and glc_ny drv namelist variables These don't appear to be needed in the drv, and trying to support them will be tricky with multiple ice sheets. --- cime_config/config_component.xml | 5 +++-- cime_config/namelist_definition_drv.xml | 22 ---------------------- 2 files changed, 3 insertions(+), 24 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index f69aa441e..716db3ab8 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -1192,6 +1192,9 @@ glacier (glc) grid - DO NOT EDIT (for experts only) + integer 0 @@ -1199,7 +1202,6 @@ env_build.xml number of glc cells in i direction - DO NOT EDIT (for experts only) - integer 0 @@ -1208,7 +1210,6 @@ number of glc cells in j direction - DO NOT EDIT (for experts only) - char UNSET diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 94a821d79..399de8551 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -869,28 +869,6 @@ $ICE_NY - - integer - control - MED_attributes - - number of glc cells in i direction - - - $GLC_NX - - - - integer - control - MED_attributes - - number of glc cells in j direction - - - $GLC_NY - - integer control From cb3425bfffc68a454285b3fcc28a29f8c99961a9 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 27 May 2021 16:34:39 -0600 Subject: [PATCH 43/54] Remove unused mapping file variables There were some remnants of the lnd2glc and glc2lnd mapping file variables that weren't actually referenced in the code. This commit removes them. Note that we *do* still need these maps, but with changes Mariana Vertenstein put in place a few months ago, it is assumed that these maps are always generated at runtime. (If we later want to go back to supporting these maps being provided as pre-generated files, this commit should be reverted and some other code should be added back in to actually use the relevant variables.) --- cime_config/config_component.xml | 32 --------------- cime_config/namelist_definition_drv.xml | 52 ------------------------- mediator/esmFldsExchange_cesm_mod.F90 | 16 -------- 3 files changed, 100 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 716db3ab8..6b549a9ae 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -1433,22 +1433,6 @@ lnd2atm state mapping file - - char - idmap - run_domain - env_run.xml - lnd2glc flux mapping file - - - - char - idmap - run_domain - env_run.xml - lnd2glc state mapping file - - char idmap @@ -1489,22 +1473,6 @@ rof2ocn runoff mapping file - - char - idmap - run_domain - env_run.xml - glc2lnd flux mapping file - - - - char - idmap - run_domain - env_run.xml - glc2lnd state mapping file - - char idmap diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 399de8551..243e84404 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2005,58 +2005,6 @@ - - char - mapping - abs - MED_attributes - - land to glc mapping file for fluxes - - - $LND2GLC_FMAPNAME - - - - - char - mapping - abs - MED_attributes - - land to glc mapping file for states - - - $LND2GLC_SMAPNAME - - - - - char - mapping - abs - MED_attributes - - glc to land mapping file for fluxes - - - $GLC2LND_FMAPNAME - - - - - char - mapping - abs - MED_attributes - - glc to land mapping file for states - - - $GLC2LND_SMAPNAME - - - char mapping diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 8253fe951..740497122 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -30,14 +30,12 @@ module esmFldsExchange_cesm_mod character(len=CX) :: atm2ice_fmap='unset', atm2ice_smap='unset', atm2ice_vmap='unset' character(len=CX) :: atm2ocn_fmap='unset', atm2ocn_smap='unset', atm2ocn_vmap='unset' character(len=CX) :: atm2lnd_fmap='unset', atm2lnd_smap='unset' - character(len=CX) :: glc2lnd_smap='unset', glc2lnd_fmap='unset' character(len=CX) :: glc2ice_rmap='unset' character(len=CX) :: glc2ocn_liq_rmap='unset' character(len=CX) :: glc2ocn_ice_rmap='unset' character(len=CX) :: ice2atm_fmap='unset', ice2atm_smap='unset' character(len=CX) :: ocn2atm_fmap='unset', ocn2atm_smap='unset' character(len=CX) :: lnd2atm_fmap='unset', lnd2atm_smap='unset' - character(len=CX) :: lnd2glc_fmap='unset', lnd2glc_smap='unset' character(len=CX) :: lnd2rof_fmap='unset' character(len=CX) :: rof2lnd_fmap='unset' character(len=CX) :: rof2ocn_fmap='unset', rof2ocn_ice_rmap='unset', rof2ocn_liq_rmap='unset' @@ -140,12 +138,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call NUOPC_CompAttributeGet(gcomp, name='rof2lnd_fmapname', value=rof2lnd_fmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mastertask) write(logunit, '(a)') trim(subname)//'rof2lnd_fmapname = '// trim(rof2lnd_fmap) - call NUOPC_CompAttributeGet(gcomp, name='glc2lnd_fmapname', value=glc2lnd_fmap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'glc2lnd_smapname = '// trim(glc2lnd_fmap) - call NUOPC_CompAttributeGet(gcomp, name='glc2lnd_smapname', value=glc2lnd_smap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'glc2lnd_smapname = '// trim(glc2lnd_smap) ! mapping to ice call NUOPC_CompAttributeGet(gcomp, name='atm2ice_fmapname', value=atm2ice_fmap, rc=rc) @@ -206,14 +198,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mastertask) write(logunit, '(a)') trim(subname)//'lnd2rof_fmapname = '// trim(lnd2rof_fmap) - ! mapping to glc - call NUOPC_CompAttributeGet(gcomp, name='lnd2glc_fmapname', value=lnd2glc_fmap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'lnd2glc_fmapname = '// trim(lnd2glc_fmap) - call NUOPC_CompAttributeGet(gcomp, name='lnd2glc_smapname', value=lnd2glc_smap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'lnd2glc_smapname = '// trim(lnd2glc_smap) - ! mapping to wav call NUOPC_CompAttributeGet(gcomp, name='atm2wav_smapname', value=atm2wav_smap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return From f5a4123b66621a7c64c6ee3f64bdf1e4731eeea0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 31 May 2021 19:18:55 -0600 Subject: [PATCH 44/54] fixes for memory leak --- mediator/med_diag_mod.F90 | 1205 ++++++++++++++++++------------------- 1 file changed, 594 insertions(+), 611 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index d672f0036..9f9d37877 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -397,33 +397,31 @@ subroutine med_diag_init(gcomp, rc) alarmname='alarm_stop', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + end subroutine med_diag_init - contains - integer function get_diag_attribute(gcomp, name, rc) - type(ESMF_GridComp) , intent(inout) :: gcomp - character(len=*), intent(in) :: name - integer, intent(out) :: rc - - character(CS) :: cvalue - logical :: isPresent - - rc = ESMF_SUCCESS - get_diag_attribute = 0 - call NUOPC_CompAttributeGet(gcomp, name=name, isPresent=isPresent, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - call NUOPC_CompAttributeGet(gcomp, name=name, value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) get_diag_attribute - else - call NUOPC_CompAttributeAdd(gcomp, (/name/), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name=name, value='0', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif - end function get_diag_attribute - - end subroutine med_diag_init + integer function get_diag_attribute(gcomp, name, rc) + type(ESMF_GridComp) , intent(inout) :: gcomp + character(len=*), intent(in) :: name + integer, intent(out) :: rc + + character(CS) :: cvalue + logical :: isPresent + + rc = ESMF_SUCCESS + get_diag_attribute = 0 + call NUOPC_CompAttributeGet(gcomp, name=name, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name=name, value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) get_diag_attribute + else + call NUOPC_CompAttributeAdd(gcomp, (/name/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name=name, value='0', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + end function get_diag_attribute !=============================================================================== subroutine med_diag_zero_mode(mode, rc) @@ -721,197 +719,195 @@ subroutine med_phases_diag_atm(gcomp, rc) f_watr_evap_16O, f_watr_evap_18O, f_watr_evap_HDO, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + deallocate(afrac) call t_stopf('MED:'//subname) + end subroutine med_phases_diag_atm - contains - - subroutine diag_atm_recv(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: afrac(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(in) :: ofrac(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1,size(data) - budget(nf,c_atm_recv,ip) = budget(nf,c_atm_recv,ip) - areas(n)*data(n)*afrac(n) - budget(nf,c_lnd_arecv,ip) = budget(nf,c_lnd_arecv,ip) + areas(n)*data(n)*lfrac(n) - budget(nf,c_ocn_arecv,ip) = budget(nf,c_ocn_arecv,ip) + areas(n)*data(n)*ofrac(n) - if (lats(n) > 0.0_r8) then - budget(nf,c_inh_arecv,ip) = budget(nf,c_inh_arecv,ip) + areas(n)*data(n)*ifrac(n) - else - budget(nf,c_ish_arecv,ip) = budget(nf,c_ish_arecv,ip) + areas(n)*data(n)*ifrac(n) - end if - end do - end if - end subroutine diag_atm_recv - - subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: afrac(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(in) :: ofrac(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1,size(data) - budget(nf,c_atm_send,ip) = budget(nf,c_atm_send,ip) - areas(n)*data(n)*afrac(n) - budget(nf,c_lnd_asend,ip) = budget(nf,c_lnd_asend,ip) + areas(n)*data(n)*lfrac(n) - budget(nf,c_ocn_asend,ip) = budget(nf,c_ocn_asend,ip) + areas(n)*data(n)*ofrac(n) - if (lats(n) > 0.0_r8) then - budget(nf,c_inh_asend,ip) = budget(nf,c_inh_asend,ip) + areas(n)*data(n)*ifrac(n) - else - budget(nf,c_ish_asend,ip) = budget(nf,c_ish_asend,ip) + areas(n)*data(n)*ifrac(n) - end if - end do - end if - end subroutine diag_atm_send - - subroutine diag_atm_wiso_recv(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & - afrac, lfrac, ofrac, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: afrac(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(in) :: ofrac(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_Field) :: lfield - real(r8), pointer :: data(:,:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1,size(data, dim=2) - budget(nf_16O,c_atm_recv,ip) = budget(nf_16O,c_atm_recv,ip) - areas(n)*afrac(n)*data(1,n) - budget(nf_16O,c_lnd_arecv,ip) = budget(nf_16O,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(1,n) - budget(nf_16O,c_ocn_arecv,ip) = budget(nf_16O,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(1,n) - if (lats(n) > 0.0_r8) then - budget(nf_16O,c_inh_arecv,ip) = budget(nf_16O,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(1,n) - else - budget(nf_16O,c_ish_arecv,ip) = budget(nf_16O,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(1,n) - end if - - budget(nf_18O,c_atm_recv,ip) = budget(nf_18O,c_atm_recv,ip) - areas(n)*afrac(n)*data(2,n) - budget(nf_18O,c_lnd_arecv,ip) = budget(nf_18O,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(2,n) - budget(nf_18O,c_ocn_arecv,ip) = budget(nf_18O,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(2,n) - if (lats(n) > 0.0_r8) then - budget(nf_18O,c_inh_arecv,ip) = budget(nf_18O,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(2,n) - else - budget(nf_18O,c_ish_arecv,ip) = budget(nf_18O,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(2,n) - end if - - budget(nf_HDO,c_atm_recv,ip) = budget(nf_HDO,c_atm_recv,ip) - areas(n)*afrac(n)*data(3,n) - budget(nf_HDO,c_lnd_arecv,ip) = budget(nf_HDO,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(3,n) - budget(nf_HDO,c_ocn_arecv,ip) = budget(nf_HDO,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(3,n) - if (lats(n) > 0.0_r8) then - budget(nf_HDO,c_inh_arecv,ip) = budget(nf_HDO,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(3,n) - else - budget(nf_HDO,c_ish_arecv,ip) = budget(nf_HDO,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_atm_wiso_recv - - subroutine diag_atm_wiso_send(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & - afrac, lfrac, ofrac, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: afrac(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(in) :: ofrac(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_Field) :: lfield - real(r8), pointer :: data(:,:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1,size(data, dim=2) - budget(nf_16O,c_atm_send,ip) = budget(nf_16O,c_atm_send,ip) - areas(n)*afrac(n)*data(1,n) - budget(nf_16O,c_lnd_asend,ip) = budget(nf_16O,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(1,n) - budget(nf_16O,c_ocn_asend,ip) = budget(nf_16O,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(1,n) - if (lats(n) > 0.0_r8) then - budget(nf_16O,c_inh_asend,ip) = budget(nf_16O,c_inh_asend,ip) + areas(n)*ifrac(n)*data(1,n) - else - budget(nf_16O,c_ish_asend,ip) = budget(nf_16O,c_ish_asend,ip) + areas(n)*ifrac(n)*data(1,n) - end if - - budget(nf_18O,c_atm_send,ip) = budget(nf_18O,c_atm_send,ip) - areas(n)*afrac(n)*data(2,n) - budget(nf_18O,c_lnd_asend,ip) = budget(nf_18O,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(2,n) - budget(nf_18O,c_ocn_asend,ip) = budget(nf_18O,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(2,n) - if (lats(n) > 0.0_r8) then - budget(nf_18O,c_inh_asend,ip) = budget(nf_18O,c_inh_asend,ip) + areas(n)*ifrac(n)*data(2,n) - else - budget(nf_18O,c_ish_asend,ip) = budget(nf_18O,c_ish_asend,ip) + areas(n)*ifrac(n)*data(2,n) - end if - - budget(nf_HDO,c_atm_send,ip) = budget(nf_HDO,c_atm_send,ip) - areas(n)*afrac(n)*data(3,n) - budget(nf_HDO,c_lnd_asend,ip) = budget(nf_HDO,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(3,n) - budget(nf_HDO,c_ocn_asend,ip) = budget(nf_HDO,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(3,n) - if (lats(n) > 0.0_r8) then - budget(nf_HDO,c_inh_asend,ip) = budget(nf_HDO,c_inh_asend,ip) + areas(n)*ifrac(n)*data(3,n) - else - budget(nf_HDO,c_ish_asend,ip) = budget(nf_HDO,c_ish_asend,ip) + areas(n)*ifrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_atm_wiso_send + subroutine diag_atm_recv(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: afrac(:) + real(r8) , intent(in) :: lfrac(:) + real(r8) , intent(in) :: ofrac(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1,size(data) + budget(nf,c_atm_recv,ip) = budget(nf,c_atm_recv,ip) - areas(n)*data(n)*afrac(n) + budget(nf,c_lnd_arecv,ip) = budget(nf,c_lnd_arecv,ip) + areas(n)*data(n)*lfrac(n) + budget(nf,c_ocn_arecv,ip) = budget(nf,c_ocn_arecv,ip) + areas(n)*data(n)*ofrac(n) + if (lats(n) > 0.0_r8) then + budget(nf,c_inh_arecv,ip) = budget(nf,c_inh_arecv,ip) + areas(n)*data(n)*ifrac(n) + else + budget(nf,c_ish_arecv,ip) = budget(nf,c_ish_arecv,ip) + areas(n)*data(n)*ifrac(n) + end if + end do + end if + end subroutine diag_atm_recv - end subroutine med_phases_diag_atm + subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: afrac(:) + real(r8) , intent(in) :: lfrac(:) + real(r8) , intent(in) :: ofrac(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1,size(data) + budget(nf,c_atm_send,ip) = budget(nf,c_atm_send,ip) - areas(n)*data(n)*afrac(n) + budget(nf,c_lnd_asend,ip) = budget(nf,c_lnd_asend,ip) + areas(n)*data(n)*lfrac(n) + budget(nf,c_ocn_asend,ip) = budget(nf,c_ocn_asend,ip) + areas(n)*data(n)*ofrac(n) + if (lats(n) > 0.0_r8) then + budget(nf,c_inh_asend,ip) = budget(nf,c_inh_asend,ip) + areas(n)*data(n)*ifrac(n) + else + budget(nf,c_ish_asend,ip) = budget(nf,c_ish_asend,ip) + areas(n)*data(n)*ifrac(n) + end if + end do + end if + end subroutine diag_atm_send + + subroutine diag_atm_wiso_recv(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & + afrac, lfrac, ofrac, ifrac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf_16O + integer , intent(in) :: nf_18O + integer , intent(in) :: nf_HDO + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: afrac(:) + real(r8) , intent(in) :: lfrac(:) + real(r8) , intent(in) :: ofrac(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_Field) :: lfield + real(r8), pointer :: data(:,:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1,size(data, dim=2) + budget(nf_16O,c_atm_recv,ip) = budget(nf_16O,c_atm_recv,ip) - areas(n)*afrac(n)*data(1,n) + budget(nf_16O,c_lnd_arecv,ip) = budget(nf_16O,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(1,n) + budget(nf_16O,c_ocn_arecv,ip) = budget(nf_16O,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(1,n) + if (lats(n) > 0.0_r8) then + budget(nf_16O,c_inh_arecv,ip) = budget(nf_16O,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(1,n) + else + budget(nf_16O,c_ish_arecv,ip) = budget(nf_16O,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(1,n) + end if + + budget(nf_18O,c_atm_recv,ip) = budget(nf_18O,c_atm_recv,ip) - areas(n)*afrac(n)*data(2,n) + budget(nf_18O,c_lnd_arecv,ip) = budget(nf_18O,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(2,n) + budget(nf_18O,c_ocn_arecv,ip) = budget(nf_18O,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(2,n) + if (lats(n) > 0.0_r8) then + budget(nf_18O,c_inh_arecv,ip) = budget(nf_18O,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(2,n) + else + budget(nf_18O,c_ish_arecv,ip) = budget(nf_18O,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(2,n) + end if + + budget(nf_HDO,c_atm_recv,ip) = budget(nf_HDO,c_atm_recv,ip) - areas(n)*afrac(n)*data(3,n) + budget(nf_HDO,c_lnd_arecv,ip) = budget(nf_HDO,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(3,n) + budget(nf_HDO,c_ocn_arecv,ip) = budget(nf_HDO,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(3,n) + if (lats(n) > 0.0_r8) then + budget(nf_HDO,c_inh_arecv,ip) = budget(nf_HDO,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(3,n) + else + budget(nf_HDO,c_ish_arecv,ip) = budget(nf_HDO,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(3,n) + end if + end do + end if + end subroutine diag_atm_wiso_recv + + subroutine diag_atm_wiso_send(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & + afrac, lfrac, ofrac, ifrac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf_16O + integer , intent(in) :: nf_18O + integer , intent(in) :: nf_HDO + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: afrac(:) + real(r8) , intent(in) :: lfrac(:) + real(r8) , intent(in) :: ofrac(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_Field) :: lfield + real(r8), pointer :: data(:,:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1,size(data, dim=2) + budget(nf_16O,c_atm_send,ip) = budget(nf_16O,c_atm_send,ip) - areas(n)*afrac(n)*data(1,n) + budget(nf_16O,c_lnd_asend,ip) = budget(nf_16O,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(1,n) + budget(nf_16O,c_ocn_asend,ip) = budget(nf_16O,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(1,n) + if (lats(n) > 0.0_r8) then + budget(nf_16O,c_inh_asend,ip) = budget(nf_16O,c_inh_asend,ip) + areas(n)*ifrac(n)*data(1,n) + else + budget(nf_16O,c_ish_asend,ip) = budget(nf_16O,c_ish_asend,ip) + areas(n)*ifrac(n)*data(1,n) + end if + + budget(nf_18O,c_atm_send,ip) = budget(nf_18O,c_atm_send,ip) - areas(n)*afrac(n)*data(2,n) + budget(nf_18O,c_lnd_asend,ip) = budget(nf_18O,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(2,n) + budget(nf_18O,c_ocn_asend,ip) = budget(nf_18O,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(2,n) + if (lats(n) > 0.0_r8) then + budget(nf_18O,c_inh_asend,ip) = budget(nf_18O,c_inh_asend,ip) + areas(n)*ifrac(n)*data(2,n) + else + budget(nf_18O,c_ish_asend,ip) = budget(nf_18O,c_ish_asend,ip) + areas(n)*ifrac(n)*data(2,n) + end if + + budget(nf_HDO,c_atm_send,ip) = budget(nf_HDO,c_atm_send,ip) - areas(n)*afrac(n)*data(3,n) + budget(nf_HDO,c_lnd_asend,ip) = budget(nf_HDO,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(3,n) + budget(nf_HDO,c_ocn_asend,ip) = budget(nf_HDO,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(3,n) + if (lats(n) > 0.0_r8) then + budget(nf_HDO,c_inh_asend,ip) = budget(nf_HDO,c_inh_asend,ip) + areas(n)*ifrac(n)*data(3,n) + else + budget(nf_HDO,c_ish_asend,ip) = budget(nf_HDO,c_ish_asend,ip) + areas(n)*ifrac(n)*data(3,n) + end if + end do + end if + end subroutine diag_atm_wiso_send !=============================================================================== subroutine med_phases_diag_lnd( gcomp, rc) @@ -1017,79 +1013,77 @@ subroutine med_phases_diag_lnd( gcomp, rc) budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice call t_stopf('MED:'//subname) + end subroutine med_phases_diag_lnd - contains - subroutine diag_lnd(FB, fldname, nf, ic, areas, lfrac, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data) - if (present(minus)) then - budget(nf,ic,ip) = budget(nf,ic,ip) - areas(n)*lfrac(n)*data(n) - else - budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*lfrac(n)*data(n) - end if - end do - end if - end subroutine diag_lnd - - subroutine diag_lnd_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, lfrac, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:,:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (present(minus)) then - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*lfrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*lfrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*lfrac(n)*data(3,n) - else - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*lfrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*lfrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*lfrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_lnd_wiso + subroutine diag_lnd(FB, fldname, nf, ic, areas, lfrac, budget, minus, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + integer , intent(in) :: ic + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lfrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + logical, optional , intent(in) :: minus + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS - end subroutine med_phases_diag_lnd + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data) + if (present(minus)) then + budget(nf,ic,ip) = budget(nf,ic,ip) - areas(n)*lfrac(n)*data(n) + else + budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*lfrac(n)*data(n) + end if + end do + end if + end subroutine diag_lnd + + subroutine diag_lnd_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, lfrac, budget, minus, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf_16O + integer , intent(in) :: nf_18O + integer , intent(in) :: nf_HDO + integer , intent(in) :: ic + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lfrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + logical, optional , intent(in) :: minus + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:,:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data, dim=2) + if (present(minus)) then + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*lfrac(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*lfrac(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*lfrac(n)*data(3,n) + else + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*lfrac(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*lfrac(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*lfrac(n)*data(3,n) + end if + end do + end if + end subroutine diag_lnd_wiso !=============================================================================== subroutine med_phases_diag_rof( gcomp, rc) @@ -1163,79 +1157,77 @@ subroutine med_phases_diag_rof( gcomp, rc) budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice call t_stopf('MED:'//subname) + end subroutine med_phases_diag_rof - contains - subroutine diag_rof(FB, fldname, nf, ic, areas, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data) - if (present(minus)) then - budget(nf,ic,ip) = budget(nf,ic,ip) - areas(n)*data(n) - else - budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*data(n) - end if - end do - end if - end subroutine diag_rof - - subroutine diag_rof_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:,:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (present(minus)) then - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*data(3,n) - else - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*data(3,n) - end if - end do - end if - end subroutine diag_rof_wiso + subroutine diag_rof(FB, fldname, nf, ic, areas, budget, minus, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + integer , intent(in) :: ic + real(r8) , intent(in) :: areas(:) + real(r8) , intent(inout) :: budget(:,:,:) + logical, optional , intent(in) :: minus + integer , intent(out) :: rc - end subroutine med_phases_diag_rof + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data) + if (present(minus)) then + budget(nf,ic,ip) = budget(nf,ic,ip) - areas(n)*data(n) + else + budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*data(n) + end if + end do + end if + end subroutine diag_rof + + subroutine diag_rof_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, budget, minus, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf_16O + integer , intent(in) :: nf_18O + integer , intent(in) :: nf_HDO + integer , intent(in) :: ic + real(r8) , intent(in) :: areas(:) + real(r8) , intent(inout) :: budget(:,:,:) + logical, optional , intent(in) :: minus + integer , intent(out) :: rc + + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:,:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data, dim=2) + if (present(minus)) then + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*data(3,n) + else + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*data(3,n) + end if + end do + end if + end subroutine diag_rof_wiso !=============================================================================== subroutine med_phases_diag_glc( gcomp, rc) @@ -1283,40 +1275,38 @@ subroutine med_phases_diag_glc( gcomp, rc) budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice call t_stopf('MED:'//subname) - - contains - subroutine diag_glc(FB, fldname, nf, ic, areas, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data) - if (present(minus)) then - budget(nf,ic,ip) = budget(nf,ic,ip) - areas(n)*data(n) - else - budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*data(n) - end if - end do - end if - end subroutine diag_glc - end subroutine med_phases_diag_glc + subroutine diag_glc(FB, fldname, nf, ic, areas, budget, minus, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + integer , intent(in) :: ic + real(r8) , intent(in) :: areas(:) + real(r8) , intent(inout) :: budget(:,:,:) + logical, optional , intent(in) :: minus + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data) + if (present(minus)) then + budget(nf,ic,ip) = budget(nf,ic,ip) - areas(n)*data(n) + else + budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*data(n) + end if + end do + end if + end subroutine diag_glc + !=============================================================================== subroutine med_phases_diag_ocn( gcomp, rc) @@ -1431,74 +1421,73 @@ subroutine med_phases_diag_ocn( gcomp, rc) budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice + deallocate(sfrac) call t_stopf('MED:'//subname) - contains - - subroutine diag_ocn(FB, fldname, nf, ic, areas, frac, budget, scale, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: frac(:) - real(r8) , intent(inout) :: budget(:,:,:) - real(r8), optional , intent(in) :: scale - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data) - if (present(scale)) then - budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*frac(n)*data(n)*scale - else - budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*frac(n)*data(n) - end if - end do - end if - end subroutine diag_ocn - - subroutine diag_ocn_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, frac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: frac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:,:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*frac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*frac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*frac(n)*data(3,n) - end do - end if - end subroutine diag_ocn_wiso - end subroutine med_phases_diag_ocn + subroutine diag_ocn(FB, fldname, nf, ic, areas, frac, budget, scale, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + integer , intent(in) :: ic + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: frac(:) + real(r8) , intent(inout) :: budget(:,:,:) + real(r8), optional , intent(in) :: scale + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data) + if (present(scale)) then + budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*frac(n)*data(n)*scale + else + budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*frac(n)*data(n) + end if + end do + end if + end subroutine diag_ocn + + subroutine diag_ocn_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, frac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf_16O + integer , intent(in) :: nf_18O + integer , intent(in) :: nf_HDO + integer , intent(in) :: ic + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: frac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc + + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:,:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data, dim=2) + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*frac(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*frac(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*frac(n)*data(3,n) + end do + end if + end subroutine diag_ocn_wiso + !=============================================================================== subroutine med_phases_diag_ice_ice2med( gcomp, rc) @@ -1574,98 +1563,95 @@ subroutine med_phases_diag_ice_ice2med( gcomp, rc) f_watr_evap_16O, f_watr_evap_18O, f_watr_evap_HDO, areas, lats, ifrac, budget_local, rc=rc) call t_stopf('MED:'//subname) + end subroutine med_phases_diag_ice_ice2med + + subroutine diag_ice_recv(FB, fldname, nf, areas, lats, ifrac, budget, minus, scale, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + logical, optional , intent(in) :: minus + real(r8), optional , intent(in) :: scale + integer , intent(out) :: rc + ! local variables + integer :: n, ic, ip + type(ESMF_Field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1,size(data) + if (lats(n) > 0.0_r8) then + ic = c_inh_recv + else + ic = c_ish_recv + endif + if (present(minus)) then + if (present(scale)) then + budget(nf ,ic,ip) = budget(nf ,ic,ip) - areas(n)*ifrac(n)*data(n)*scale + else + budget(nf ,ic,ip) = budget(nf ,ic,ip) - areas(n)*ifrac(n)*data(n) + end if + else + if (present(scale)) then + budget(nf ,ic,ip) = budget(nf ,ic,ip) + areas(n)*ifrac(n)*data(n)*scale + else + budget(nf ,ic,ip) = budget(nf ,ic,ip) + areas(n)*ifrac(n)*data(n) + end if + end if + end do + end if + end subroutine diag_ice_recv - contains - - subroutine diag_ice_recv(FB, fldname, nf, areas, lats, ifrac, budget, minus, scale, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - real(r8), optional , intent(in) :: scale - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_Field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1,size(data) - if (lats(n) > 0.0_r8) then - ic = c_inh_recv - else - ic = c_ish_recv - endif - if (present(minus)) then - if (present(scale)) then - budget(nf ,ic,ip) = budget(nf ,ic,ip) - areas(n)*ifrac(n)*data(n)*scale - else - budget(nf ,ic,ip) = budget(nf ,ic,ip) - areas(n)*ifrac(n)*data(n) - end if - else - if (present(scale)) then - budget(nf ,ic,ip) = budget(nf ,ic,ip) + areas(n)*ifrac(n)*data(n)*scale - else - budget(nf ,ic,ip) = budget(nf ,ic,ip) + areas(n)*ifrac(n)*data(n) - end if - end if - end do - end if - end subroutine diag_ice_recv - - subroutine diag_ice_recv_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_Field) :: lfield - real(r8), pointer :: data(:,:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (lats(n) > 0.0_r8) then - ic = c_inh_recv - else - ic = c_ish_recv - endif - if (present(minus)) then - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*ifrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*ifrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*ifrac(n)*data(3,n) - else - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*ifrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*ifrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*ifrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_ice_recv_wiso + subroutine diag_ice_recv_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, minus, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf_16O + integer , intent(in) :: nf_18O + integer , intent(in) :: nf_HDO + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + logical, optional , intent(in) :: minus + integer , intent(out) :: rc + ! local variables + integer :: n, ic, ip + type(ESMF_Field) :: lfield + real(r8), pointer :: data(:,:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS - end subroutine med_phases_diag_ice_ice2med + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data, dim=2) + if (lats(n) > 0.0_r8) then + ic = c_inh_recv + else + ic = c_ish_recv + endif + if (present(minus)) then + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*ifrac(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*ifrac(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*ifrac(n)*data(3,n) + else + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*ifrac(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*ifrac(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*ifrac(n)*data(3,n) + end if + end do + end if + end subroutine diag_ice_recv_wiso !=============================================================================== subroutine med_phases_diag_ice_med2ice( gcomp, rc) @@ -1755,77 +1741,74 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) f_watr_snow_16O, f_watr_snow_18O, f_watr_snow_HDO, areas, lats, ifrac, budget_local, rc=rc) call t_stopf('MED:'//subname) + end subroutine med_phases_diag_ice_med2ice + + subroutine diag_ice_send(FB, fldname, nf, areas, lats, ifrac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc + ! local variables + integer :: n, ic, ip + type(ESMF_Field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + ip = period_inst + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(data) + if (lats(n) > 0.0_r8) then + ic = c_inh_send + else + ic = c_ish_send + endif + budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*ifrac(n)*data(n) + end do + end if + end subroutine diag_ice_send - contains - - subroutine diag_ice_send(FB, fldname, nf, areas, lats, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_Field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - ip = period_inst - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(data) - if (lats(n) > 0.0_r8) then - ic = c_inh_send - else - ic = c_ish_send - endif - budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*ifrac(n)*data(n) - end do - end if - end subroutine diag_ice_send - - subroutine diag_ice_send_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - - ! local variables - integer :: n, ip - type(ESMF_Field) :: lfield - real(r8), pointer :: data(:,:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (lats(n) > 0.0_r8) then - ic = c_inh_send - else - ic = c_ish_send - endif - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*ifrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*ifrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*ifrac(n)*data(3,n) - end do - end if - end subroutine diag_ice_send_wiso + subroutine diag_ice_send_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf_16O + integer , intent(in) :: nf_18O + integer , intent(in) :: nf_HDO + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc - end subroutine med_phases_diag_ice_med2ice + ! local variables + integer :: n, ic, ip + type(ESMF_Field) :: lfield + real(r8), pointer :: data(:,:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data, dim=2) + if (lats(n) > 0.0_r8) then + ic = c_inh_send + else + ic = c_ish_send + endif + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*ifrac(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*ifrac(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*ifrac(n)*data(3,n) + end do + end if + end subroutine diag_ice_send_wiso !=============================================================================== subroutine med_phases_diag_print(gcomp, rc) From 924b4662404fcff685146249fef110f1f87ee4cd Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 1 Jun 2021 07:52:07 -0600 Subject: [PATCH 45/54] remove debug print statement --- mediator/med_diag_mod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 9f9d37877..c996f4354 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -2325,8 +2325,6 @@ subroutine med_diag_print_summary(data, ip, date, tod) ice_area_sh = data(f_area,c_ish_recv,ip) sum_area = atm_area + lnd_area + ocn_area + ice_area_nh + ice_area_sh write(diagunit,FA1) budget_diags%fields(f_area)%name, atm_area, lnd_area, ocn_area, ice_area_nh, ice_area_sh, sum_area - write(diagUnit,*) 'counter: ',budget_counter(f_area, c_atm_recv, ip) - ! write out net heat budgets write(diagunit,*) ' ' From c21623b8a99c40aec23cbe27706ebade5b8b4840 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 2 Jun 2021 15:33:11 -0600 Subject: [PATCH 46/54] remove the version ifdef and add the CASE_HASH variable --- cime_config/config_component.xml | 7 +++++++ mediator/esmFlds.F90 | 13 ------------- mediator/esmFldsExchange_hafs_mod.F90 | 19 ------------------- mediator/med.F90 | 13 +------------ 4 files changed, 8 insertions(+), 44 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index f69aa441e..075e9fc09 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -186,6 +186,13 @@ username of user who created case + + char + case_desc + env_case.xml + Unique identifier for case + + diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 13ed53c14..58dfb5d19 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -363,12 +363,8 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num use ESMF , only : ESMF_StateGet, ESMF_LogFoundError use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_LOGERR_PASSTHRU use ESMF , only : ESMF_LOGMSG_INFO, ESMF_StateRemove, ESMF_SUCCESS -#if ESMF_VERSION_MAJOR >= 8 -#if ESMF_VERSION_MINOR > 0 use ESMF , only : ESMF_STATEINTENT_IMPORT, ESMF_STATEINTENT_EXPORT, ESMF_StateIntent_Flag use ESMF , only : ESMF_RC_ARG_BAD, ESMF_LogSetError, operator(==) -#endif -#endif ! input/output variables type(ESMF_State) , intent(inout) :: state type(med_fldlist_type), intent(in) :: fldList @@ -386,11 +382,7 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num character(CS) :: shortname character(CS) :: stdname character(ESMF_MAXSTR) :: transferActionAttr -#if ESMF_VERSION_MAJOR >= 8 -#if ESMF_VERSION_MINOR > 0 type(ESMF_StateIntent_Flag) :: stateIntent -#endif -#endif character(ESMF_MAXSTR) :: transferAction character(ESMF_MAXSTR), pointer :: StandardNameList(:) => null() character(ESMF_MAXSTR), pointer :: ConnectedList(:) => null() @@ -454,9 +446,6 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num #endif nflds = size(fldList%flds) - transferActionAttr="TransferActionGeomObject" -#if ESMF_VERSION_MAJOR >= 8 -#if ESMF_VERSION_MINOR > 0 call ESMF_StateGet(state, stateIntent=stateIntent, rc=rc) if (stateIntent==ESMF_STATEINTENT_EXPORT) then transferActionAttr="ProducerTransferAction" @@ -470,8 +459,6 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num rcToReturn=rc) return ! bail out endif -#endif -#endif do n = 1, nflds shortname = fldList%flds(n)%shortname diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 1786f3684..22ef604af 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -930,28 +930,9 @@ subroutine esmFldsExchange_hafs_attr(gcomp, hafs_attr, rc) rc = ESMF_SUCCESS ! Query component for name, verbosity, and diagnostic values -#if ESMF_VERSION_MAJOR >= 8 call NUOPC_CompGet(gcomp, name=cname, verbosity=verbosity, & diagnostic=diagnostic, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return -#else - call ESMF_GridCompGet(gcomp, name=cname, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_AttributeGet(gcomp, name="Verbosity", value=cvalue, & - defaultValue="0", convention="NUOPC", purpose="Instance", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - verbosity = ESMF_UtilString2Int(cvalue, & - specialStringList=(/"off ","low ","high","max "/), & - specialValueList=(/0,9985,32513,131071/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_AttributeGet(gcomp, name="Diagnostic", value=cvalue, & - defaultValue="0", convention="NUOPC", purpose="Instance", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - diagnostic = ESMF_UtilString2Int(cvalue, & - specialStringList=(/"off ","max "/), & - specialValueList=(/0,131071/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return -#endif !---------------------------------------------------------- ! Initialize system type diff --git a/mediator/med.F90 b/mediator/med.F90 index f382c0521..93953ab6e 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -990,12 +990,9 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_VM, ESMF_SUCCESS use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_TimeInterval use ESMF , only : ESMF_VMGet, ESMF_StateIsCreated, ESMF_GridCompGet -#if ESMF_VERSION_MAJOR >= 8 -#if ESMF_VERSION_MINOR > 0 use ESMF , only : ESMF_StateSet, ESMF_StateIntent_Import, ESMF_StateIntent_Export use ESMF , only : ESMF_StateIntent_Flag -#endif -#endif + ! Input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -1026,24 +1023,16 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) ! Realize States do n = 1,ncomps if (ESMF_StateIsCreated(is_local%wrap%NStateImp(n), rc=rc)) then -#if ESMF_VERSION_MAJOR >= 8 -#if ESMF_VERSION_MINOR > 0 call ESMF_StateSet(is_local%wrap%NStateImp(n), stateIntent=ESMF_StateIntent_Import, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#endif -#endif call med_fldList_Realize(is_local%wrap%NStateImp(n), fldListFr(n), & is_local%wrap%flds_scalar_name, is_local%wrap%flds_scalar_num, & tag=subname//':Fr_'//trim(compname(n)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n), rc=rc)) then -#if ESMF_VERSION_MAJOR >= 8 -#if ESMF_VERSION_MINOR > 0 call ESMF_StateSet(is_local%wrap%NStateExp(n), stateIntent=ESMF_StateIntent_Export, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#endif -#endif call med_fldList_Realize(is_local%wrap%NStateExp(n), fldListTo(n), & is_local%wrap%flds_scalar_name, is_local%wrap%flds_scalar_num, & tag=subname//':To_'//trim(compname(n)), rc=rc) From 0a9702c82d158e533c09a6aec01d267a78b8d269 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 2 Jun 2021 18:59:36 -0400 Subject: [PATCH 47/54] fix uninitialized values for AccumCnts --- mediator/med.F90 | 2 -- mediator/med_internalstate_mod.F90 | 4 ++-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 3dfd8031e..467c85163 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1984,7 +1984,6 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_reset(is_local%wrap%FBImpAccum(n1,n1), value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - is_local%wrap%FBImpAccumCnt(n1) = 0 ! Create export accumulation field bundles call FB_init(is_local%wrap%FBExpAccum(n1), is_local%wrap%flds_scalar_name, & @@ -1993,7 +1992,6 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_reset(is_local%wrap%FBExpAccum(n1), value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - is_local%wrap%FBExpAccumCnt(n1) = 0 ! Create mesh info data call med_meshinfo_create(is_local%wrap%FBImp(n1,n1), & diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 83558c9d1..d1bc1c4b6 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -87,12 +87,12 @@ module med_internalstate_mod ! Accumulators for export field bundles type(ESMF_FieldBundle) :: FBExpAccum(ncomps) ! Accumulator for various components export on their grid - integer :: FBExpAccumCnt(ncomps) ! Accumulator counter for each FBExpAccum + integer :: FBExpAccumCnt(ncomps) = 0 ! Accumulator counter for each FBExpAccum logical :: FBExpAccumFlag(ncomps) = .false. ! Accumulator flag, if true accumulation was done ! Accumulators for import field bundles type(ESMF_FieldBundle) :: FBImpAccum(ncomps,ncomps) ! Accumulator for various components import - integer :: FBImpAccumCnt(ncomps) ! Accumulator counter for each FBImpAccum + integer :: FBImpAccumCnt(ncomps) = 0 ! Accumulator counter for each FBImpAccum ! Component Mesh info type(mesh_info_type) :: mesh_info(ncomps) From d480ecc39880952abf4e3178abcbb99d2fc15780 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 4 Jun 2021 13:08:26 -0600 Subject: [PATCH 48/54] Fix namelist variables that weren't being set With my upcoming fix for https://github.com/ESMCI/cime/issues/3984, I was getting some failures due to namelist variables that weren't properly defined. (1) mediator_read_restart: since this is set in the code rather than via the normal mechanism, I think it's appropriate to have skip_default_entry="true" here. (2) ESP's pio_netcdf_format: I'm not positive that the way I've set it is correct, but it seems more correct than before. --- cime_config/namelist_definition_drv.xml | 2 +- cime_config/namelist_definition_modelio.xml | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 94a821d79..f0dca561f 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -571,7 +571,7 @@ - + logical expdef DRIVER_attributes diff --git a/cime_config/namelist_definition_modelio.xml b/cime_config/namelist_definition_modelio.xml index ea5d47f0a..35af19567 100644 --- a/cime_config/namelist_definition_modelio.xml +++ b/cime_config/namelist_definition_modelio.xml @@ -166,6 +166,7 @@ $ROF_PIO_NETCDF_FORMAT $GLC_PIO_NETCDF_FORMAT $WAV_PIO_NETCDF_FORMAT + $ESP_PIO_NETCDF_FORMAT From e47915764744aee005acd462691c030e1a1a1617 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 8 Jun 2021 13:30:21 -0600 Subject: [PATCH 49/54] it turns out that the mpi module does not support functions in the only clause - this is supported in mpi_f08, but that module also changes the type of mpi variables in fortran --- drivers/cime/esmApp.F90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/drivers/cime/esmApp.F90 b/drivers/cime/esmApp.F90 index 523e2cec1..1516ffa10 100644 --- a/drivers/cime/esmApp.F90 +++ b/drivers/cime/esmApp.F90 @@ -12,12 +12,7 @@ program esmApp use ESMF, only : ESMF_LOGKIND_MULTI_ON_ERROR, ESMF_LogKind_Flag use ESMF, only : ESMF_VMGet, ESMF_VM, ESMF_InitializePreMPI -#ifndef NO_MPI2 - use mpi, only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init_thread, MPI_FINALIZE, MPI_BCAST - use mpi, only : MPI_COMM_RANK, MPI_THREAD_SERIALIZED, MPI_LOGICAL -#else use mpi -#endif use NUOPC, only : NUOPC_FieldDictionarySetup use ensemble_driver, only : SetServices use shr_pio_mod, only : shr_pio_init1 From c95b935c5da2149501711e8c4982519771e10a4b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 11 Jun 2021 10:57:11 -0600 Subject: [PATCH 50/54] validation bug fixes --- mediator/esmFldsExchange_cesm_mod.F90 | 2 +- mediator/fd_cesm.yaml | 4 ++++ mediator/med.F90 | 19 +++++++++++++++--- mediator/med_internalstate_mod.F90 | 1 + mediator/med_phases_history_mod.F90 | 12 ++++++++++- mediator/med_phases_prep_atm_mod.F90 | 29 +++++++++++++++++++++++++++ 6 files changed, 62 insertions(+), 5 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 8253fe951..d01ce7465 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1979,7 +1979,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListFr(compocn)%flds, 'Faoo_fco2_ocn') call addfld(fldListTo(compatm)%flds, 'Faoo_fco2_ocn') else - call addmap(fldListFr(compocn)%flds, 'Faoo_fco2_ocn', compatm, mapconsf, 'one', ocn2atm_fmap) + call addmap(fldListFr(compocn)%flds, 'Faoo_fco2_ocn', compatm, mapconsd, 'one', ocn2atm_fmap) ! custom merge in med_phases_prep_atm end if endif diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index ab4c5cd9a..1a4889bc0 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -43,6 +43,10 @@ canonical_units: N m-2 description: mediator export # + - standard_name: area + canonical_units: radians**2 + description: mediator area for component + # #----------------------------------- # section: land export #----------------------------------- diff --git a/mediator/med.F90 b/mediator/med.F90 index 2ced7ad41..fe90f26ee 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -664,7 +664,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) ! TransferOfferGeomObject Attribute. use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_SUCCESS, ESMF_LogFoundAllocError - use ESMF , only : ESMF_StateIsCreated + use ESMF , only : ESMF_StateIsCreated use ESMF , only : ESMF_LogMsg_Info, ESMF_LogWrite use ESMF , only : ESMF_END_ABORT, ESMF_Finalize use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise, NUOPC_AddNestedState @@ -2022,7 +2022,7 @@ subroutine DataInitialize(gcomp, rc) ! Create mesh info data call med_meshinfo_create(is_local%wrap%FBImp(n1,n1), & - is_local%wrap%mesh_info(n1), rc=rc) + is_local%wrap%mesh_info(n1), is_local%wrap%FBArea(n1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -2580,17 +2580,19 @@ end subroutine SetRunClock !----------------------------------------------------------------------------- - subroutine med_meshinfo_create(FB, mesh_info, rc) + subroutine med_meshinfo_create(FB, mesh_info, FBArea, rc) use ESMF , only : ESMF_Array, ESMF_ArrayCreate, ESMF_ArrayDestroy, ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_DistGrid, ESMF_FieldBundle, ESMF_FieldRegridGetArea, ESMF_FieldBundleGet use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LogWrite, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_FieldCreate, ESMF_FieldBundleCreate, ESMF_FieldBundleAdd use med_internalstate_mod , only : mesh_info_type ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FB type(mesh_info_type) , intent(inout) :: mesh_info + type(ESMF_FieldBundle) , intent(inout) :: FBArea integer , intent(out) :: rc ! local variables @@ -2641,6 +2643,17 @@ subroutine med_meshinfo_create(FB, mesh_info, rc) end do deallocate(ownedElemCoords) + ! Create field bundle with areas so that this can be output to mediator history file + lfield = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_r8, name='area', meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + FBArea = ESMF_FieldBundleCreate(rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(FBArea, (/lfield/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr(:) = mesh_info%areas(:) + end subroutine med_meshinfo_create !----------------------------------------------------------------------------- diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 7ca821d3c..9891d9ce7 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -98,6 +98,7 @@ module med_internalstate_mod ! Component Mesh info type(mesh_info_type) :: mesh_info(ncomps) + type(ESMF_FieldBundle) :: FBArea(ncomps) ! needed for mediator history writes end type InternalStateStruct diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7cfe09b57..7a8c4f62b 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -409,6 +409,7 @@ subroutine med_phases_history_write(gcomp, rc) nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + ! write component mediator fractions if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then nx = is_local%wrap%nx(n) ny = is_local%wrap%ny(n) @@ -416,7 +417,12 @@ subroutine med_phases_history_write(gcomp, rc) nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='Med_frac_'//trim(compname(n)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - endif + ! write component mediator areas + nx = is_local%wrap%nx(n) + ny = is_local%wrap%ny(n) + call med_io_write(hist_file, iam, is_local%wrap%FBArea(n), & + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='MED_'//trim(compname(n)), rc=rc) + end if enddo if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then nx = is_local%wrap%nx(compocn) @@ -453,6 +459,10 @@ subroutine med_phases_history_write(gcomp, rc) end if enddo + ! Write out areas to history file + do n = 1,ncomps + end do + call med_io_close(hist_file, iam, 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 ba1a18962..e26f3b5f1 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -44,6 +44,8 @@ subroutine med_phases_prep_atm(gcomp, rc) type(InternalState) :: is_local real(R8), pointer :: dataPtr1(:) => null() real(R8), pointer :: dataPtr2(:) => null() + real(R8), pointer :: ifrac(:) => null() + real(R8), pointer :: ofrac(:) => null() integer :: i, j, n, n1, ncnt character(len=*),parameter :: subname='(med_phases_prep_atm)' !------------------------------------------------------------------------------- @@ -190,6 +192,33 @@ subroutine med_phases_prep_atm(gcomp, rc) end do end if + ! Note - the following needs a custom merge since Faoo_fco2_ocn is scaled by (ifrac+ofrac) + ! in the merge to the atm + if ( FB_FldChk(is_local%wrap%FBExp(compatm) , 'Faoo_fco2_ocn', rc=rc) .and. & + FB_FldChk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fco2_ocn', rc=rc)) then + call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='ifrac', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=ifrac, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBFrac(compatm), fieldName='ofrac', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=ofrac, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compatm), fieldName='Faoo_fco2_ocn', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compatm), fieldName='Faoo_fco2_ocn', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr2) + dataptr2(n) = (ifrac(n) + ofrac(n)) * dataptr1(n) + end do + end if + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if From d5b824646d3d1e3973f8dfb00335c25624bdc9b7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 14 Jun 2021 16:10:37 -0600 Subject: [PATCH 51/54] removed extraneous do loop --- mediator/med_phases_history_mod.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7a8c4f62b..893393d2c 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -459,10 +459,6 @@ subroutine med_phases_history_write(gcomp, rc) end if enddo - ! Write out areas to history file - do n = 1,ncomps - end do - call med_io_close(hist_file, iam, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 65045d27a0e8476260734910b08b0e2581c56a45 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 15 Jun 2021 07:13:54 -0600 Subject: [PATCH 52/54] change this from INFO to ERROR --- mediator/med_map_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index ee9371550..e1dab5e84 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -817,7 +817,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & //', mapnorm '//trim(mapnorm_mapindex) & //' set; cannot set mapnorm to '//trim(packed_data(mapindex)%mapnorm) & //' '//trim(fieldnamelist(nf)) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_ERROR) call ESMF_Finalize(endflag=ESMF_END_ABORT) end if end if @@ -989,7 +989,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d ! ----------------------------------- ! Copy the src fields into the packed field bundle ! ----------------------------------- - + call t_startf('MED:'//trim(subname)//' copy from src') ! First get the pointer for the packed source data From 11bcd200a6faf27ad97c7f34b943da6da247443a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 17 Jun 2021 08:03:38 -0600 Subject: [PATCH 53/54] esmf aware threading now works with esmf 8.2.0b10 or newer --- cime_config/buildexe | 15 +++++++++++++++ drivers/cime/esm.F90 | 8 -------- 2 files changed, 15 insertions(+), 8 deletions(-) diff --git a/cime_config/buildexe b/cime_config/buildexe index 476bee765..06e9e077f 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -76,6 +76,21 @@ def _main_func(): gmake_args += " MED_PRESENT=FALSE" if esmf_aware_threading: gmake_args += " USER_CPPDEFS=-DESMF_AWARE_THREADING" + esmfmkfile = os.getenv("ESMFMKFILE") + expect(esmfmkfile and os.path.isfile(esmfmkfile),"ESMFMKFILE not found {}".format(esmfmkfile)) + with open(esmfmkfile, 'r') as f: + major = None + minor = None + for line in f.readlines(): + if 'ESMF_VERSION' in line: + 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") gmake_args += " IAC_PRESENT=FALSE" expect((num_esp is None) or (int(num_esp) == 1), "ESP component restricted to one instance") diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index ecf6d931d..e1a18f135 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -981,14 +981,6 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/MaxCount", value=nthrds, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return -! call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/MinStackSize", value='40MiB', rc=rc) -! if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (nthrds == 1) then - call ESMF_InfoSet(info, key="/NUOPC/Hint/PePerPet/OpenMpHandling", value='none', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_rootpe', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) rootpe From bce1ecdc83713e7fe1814299ddbea9c5ba5db01c Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 17 Jun 2021 09:30:01 -0600 Subject: [PATCH 54/54] move the version check to buildnml for faster feedback to user --- cime_config/buildexe | 15 --------------- cime_config/buildnml | 18 ++++++++++++++++++ 2 files changed, 18 insertions(+), 15 deletions(-) diff --git a/cime_config/buildexe b/cime_config/buildexe index 06e9e077f..476bee765 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -76,21 +76,6 @@ def _main_func(): gmake_args += " MED_PRESENT=FALSE" if esmf_aware_threading: gmake_args += " USER_CPPDEFS=-DESMF_AWARE_THREADING" - esmfmkfile = os.getenv("ESMFMKFILE") - expect(esmfmkfile and os.path.isfile(esmfmkfile),"ESMFMKFILE not found {}".format(esmfmkfile)) - with open(esmfmkfile, 'r') as f: - major = None - minor = None - for line in f.readlines(): - if 'ESMF_VERSION' in line: - 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") gmake_args += " IAC_PRESENT=FALSE" expect((num_esp is None) or (int(num_esp) == 1), "ESP component restricted to one instance") diff --git a/cime_config/buildnml b/cime_config/buildnml index af6ba9011..00b3dad35 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -516,6 +516,24 @@ def buildnml(case, caseroot, component): if component != "drv": raise AttributeError +# Do a check here of ESMF VERSION, requires 8.1.0 or newer (8.2.0 or newer for esmf_aware_threading) + esmf_aware_threading = case.get_value("ESMF_AWARE_THREADING") + esmfmkfile = os.getenv("ESMFMKFILE") + expect(esmfmkfile and os.path.isfile(esmfmkfile),"ESMFMKFILE not found {}".format(esmfmkfile)) + with open(esmfmkfile, 'r') as f: + major = None + minor = None + for line in f.readlines(): + if 'ESMF_VERSION' in line: + 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") + confdir = os.path.join(case.get_value("CASEBUILD"), "cplconf") if not os.path.isdir(confdir): os.makedirs(confdir)